KMR
kmrutil.c
Go to the documentation of this file.
1 /* kmrutil.c (2014-02-04) */
2 /* Copyright (C) 2012-2016 RIKEN AICS */
3 
4 /** \file kmrutil.c Utilities. */
5 
6 /* _GNU_SOURCE is needed for "strnlen()" (it is POSIX Issue 7
7  2006). */
8 
9 #if defined(__linux__)
10 #define _GNU_SOURCE
11 #endif
12 
13 #include <mpi.h>
14 #include <stdio.h>
15 #include <stdlib.h>
16 #include <unistd.h>
17 #include <string.h>
18 #include <strings.h>
19 #include <time.h>
20 #include <ctype.h>
21 #include <errno.h>
22 #include <fcntl.h>
23 #include <sys/types.h>
24 #include <sys/stat.h>
25 #include <sys/resource.h>
26 #include "kmr.h"
27 #include "kmrimpl.h"
28 
29 #define MIN(a,b) (((a)<(b))?(a):(b))
30 #define MAX(a,b) (((a)>(b))?(a):(b))
31 #define NEVERHERE 0
32 
33 /* Copy of constant values to make accessible from dlopen(). */
34 
35 int kmr_kv_field_bad = KMR_KV_BAD;
36 int kmr_kv_field_opaque = KMR_KV_OPAQUE;
37 int kmr_kv_field_cstring = KMR_KV_CSTRING;
38 int kmr_kv_field_integer = KMR_KV_INTEGER;
39 int kmr_kv_field_float8 = KMR_KV_FLOAT8;
40 int kmr_kv_field_pointer_owned = KMR_KV_POINTER_OWNED;
41 int kmr_kv_field_pointer_unmanaged = KMR_KV_POINTER_UNMANAGED;
42 
43 /* Issues warning. MR can be null (then verbosity is 5). MASK is 1
44  to 9; 1 for printed always (unsuppressible), 5 or less for printed
45  normally, 9 for printed only at highest verbosity. */
46 
47 void
48 kmr_warning(KMR *mr, unsigned int mask, char *m)
49 {
50  assert(1 <= mask && mask <= 9);
51  int rank = 0;
52  _Bool print = 1;
53  if (mr != 0) {
54  rank = mr->rank;
55  print = (mask <= mr->verbosity);
56  } else {
57  int cc = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
58  assert(cc == MPI_SUCCESS);
59  print = (mask <= 5);
60  }
61 
62  if (print) {
63  fprintf(stderr, ";;KMR [%05d] warning: %s.\n", rank, m);
64  fflush(0);
65  }
66 }
67 
68 void
69 kmr_error_at_site(KMR *mr, char *m, struct kmr_code_line *site)
70 {
71  int rank;
72  if (mr != 0) {
73  rank = mr->rank;
74  } else {
75  rank = 0;
76  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
77  /* Ignore error. */
78  }
79 
80  if (site != 0) {
81  fprintf(stderr, ";;KMR [%05d] error: %s: %s; at %s:%d\n",
82  rank, site->func, m, site->file, site->line);
83  fflush(0);
84  } else {
85  fprintf(stderr, ";;KMR [%05d] error: %s.\n", rank, m);
86  fflush(0);
87  }
88 
89  if (mr != 0 && mr->std_abort) {
90  abort();
91  } else {
92  (void)MPI_Abort(MPI_COMM_WORLD, 1);
93  }
94 }
95 
96 /* Aborts after printing a message. MR can be null. */
97 
98 void
99 kmr_error(KMR *mr, char *m)
100 {
101  kmr_error_at_site(mr, m, 0);
102 }
103 
104 void
105 kmr_error2(KMR *mr, char *m,
106  const char *file, const int line, const char *func)
107 {
108  struct kmr_code_line site = {.file = file, .line = line, .func = func};
109  kmr_error_at_site(mr, m, &site);
110 }
111 
112 void
113 kmr_error_kvs_at_site(KMR *mr, char *m, KMR_KVS *kvs,
114  struct kmr_code_line *site)
115 {
116  int rank = 0;
117  if (mr != 0) {
118  rank = mr->rank;
119  } else {
120  int cc = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
121  assert(cc == MPI_SUCCESS);
122  }
123 
124  if (site != 0 && kvs->c.info_line0.file != 0) {
125  struct kmr_code_line *info = &kvs->c.info_line0;
126  fprintf(stderr, ";;KMR [%05d] error: %s: %s"
127  " (kvs allocated at %s:%d: %s); at %s:%d\n",
128  rank, site->func, m, info->file, info->line, info->func,
129  site->file, site->line);
130  fflush(0);
131  } else if (kvs->c.info_line0.file != 0) {
132  struct kmr_code_line *info = &kvs->c.info_line0;
133  fprintf(stderr, ";;KMR [%05d] error: %s"
134  " (kvs allocated at %s:%d: %s)\n",
135  rank, m, info->file, info->line, info->func);
136  fflush(0);
137  } else if (site != 0) {
138  fprintf(stderr, ";;KMR [%05d] error: %s: %s; at %s:%d\n",
139  rank, site->func, m, site->file, site->line);
140  fflush(0);
141  } else {
142  fprintf(stderr, ";;KMR [%05d] error: %s\n",
143  rank, m);
144  fflush(0);
145  }
146 
147  if (mr != 0 && mr->std_abort) {
148  abort();
149  } else {
150  (void)MPI_Abort(MPI_COMM_WORLD, 1);
151  }
152 }
153 
154 void
155 kmr_error_kvs(KMR *mr, char *m, KMR_KVS *kvs)
156 {
157  kmr_error_kvs_at_site(mr, m, kvs, 0);
158 }
159 
160 void
161 kmr_error_kvs2(KMR *mr, char *m, KMR_KVS *kvs,
162  const char *file, const int line, const char *func)
163 {
164  struct kmr_code_line site = {.file = file, .line = line, .func = func};
165  kmr_error_kvs_at_site(mr, m, kvs, &site);
166 }
167 
168 void
169 kmr_error_mpi(KMR *mr, char *m, int errorcode)
170 {
171  int rank = 0;
172  if (mr != 0) {
173  rank = mr->rank;
174  } else {
175  int cc = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
176  assert(cc == MPI_SUCCESS);
177  }
178 
179  int len;
180  char s[MPI_MAX_ERROR_STRING];
181  int cc = MPI_Error_string(errorcode, s, &len);
182  if (cc != MPI_SUCCESS) {
183  snprintf(s, MPI_MAX_ERROR_STRING, "(unknown MPI error)");
184  }
185  fprintf(stderr, ";;KMR [%05d] %s: %s\n", rank, m, s);
186  fflush(stderr);
187 }
188 
189 /** Modifies the string end with by "..." for indicating truncation,
190  used on the result of snprintf. */
191 
192 void
193 kmr_string_truncation(KMR *mr, size_t sz, char *s)
194 {
195  assert(sz >= 4);
196  size_t m = strlen(s);
197  if (m == (sz - 1)) {
198  s[sz - 4] = '.';
199  s[sz - 3] = '.';
200  s[sz - 2] = '.';
201  assert(s[sz - 1] == 0);
202  }
203 }
204 
205 /** Returns itself; this is for Fortran-binding. */
206 
207 char *
209 {
210  return s;
211 }
212 
213 char *
214 kmr_ptrstr_ff(char *s)
215 {
216  return s;
217 }
218 
219 long
220 kmr_ptrint_ff(void *p)
221 {
222  return (long)p;
223 }
224 
225 void *
226 kmr_intptr_ff(long p)
227 {
228  return (void *)p;
229 }
230 
231 long
232 kmr_dblint_ff(double v)
233 {
234  union {double d; long i;} vv = {.d = v};
235  return vv.i;
236 }
237 
238 double
239 kmr_intdbl_ff(long v)
240 {
241  union {double d; long i;} vv = {.i = v};
242  return vv.d;
243 }
244 
245 long
246 kmr_strint_ff(char *p)
247 {
248  /*printf("str->int(%lx,s=%s)\n", (long)p, p);*/
249  return (long)(void *)p;
250 }
251 
252 /** Fills the character array S by the contents at the pointer value
253  integer P by the length N. It returns the string length in C
254  limited by N. */
255 
256 int
257 kmr_intstr_ff(long p, char *s, int n)
258 {
259  /*printf("int->str(%lx,s=%s)\n", i, (char *)i);*/
260  char *x = (void *)p;
261  memcpy(s, x, (size_t)n);
262  return (int)strnlen(x, (size_t)n);
263 }
264 
265 static inline unsigned long
266 kmr_bitreverse(unsigned long bits)
267 {
268  bits = (((bits & 0xaaaaaaaaaaaaaaaaUL) >> 1)
269  | ((bits & 0x5555555555555555UL) << 1));
270  bits = (((bits & 0xccccccccccccccccUL) >> 2)
271  | ((bits & 0x3333333333333333UL) << 2));
272  bits = (((bits & 0xf0f0f0f0f0f0f0f0UL) >> 4)
273  | ((bits & 0x0f0f0f0f0f0f0f0fUL) << 4));
274  bits = (((bits & 0xff00ff00ff00ff00UL) >> 8)
275  | ((bits & 0x00ff00ff00ff00ffUL) << 8));
276  bits = (((bits & 0xffff0000ffff0000UL) >> 16)
277  | ((bits & 0x0000ffff0000ffffUL) << 16));
278  return ((bits >> 32) | (bits << 32));
279 }
280 
281 /** Fixes little-endian bits used in Fortran to host-endian. */
282 
283 unsigned long
284 kmr_fix_bits_endian_ff(unsigned long b)
285 {
286  static union {struct {_Bool b : 1;} s; unsigned long i;}
287  kmr_bitpos0 = {.s={.b=1}};
288  assert(kmr_bitpos0.i == 1 || kmr_bitpos0.i == 0x8000000000000000UL);
289  unsigned long optionbits;
290  if (kmr_bitpos0.i == 1) {
291  /* BIT-LE */
292  optionbits = b;
293  } else {
294  /* BIT-BE */
295  optionbits = kmr_bitreverse(b);
296  }
297  unsigned long optionmask = (kmr_optmask.bits
298  | kmr_foptmask.bits
299  | kmr_soptmask.bits);
300  assert((optionbits & ~optionmask) == 0);
301  return optionbits;
302 }
303 
304 int
305 kmr_get_nprocs(const KMR *mr)
306 {
307  assert(mr != 0);
308  return mr->nprocs;
309 }
310 
311 int
312 kmr_get_rank(const KMR *mr)
313 {
314  assert(mr != 0);
315  return mr->rank;
316 }
317 
318 int
319 kmr_get_nprocs_ff(const KMR_KVS *kvs)
320 {
321  assert(kvs != 0);
322  return kvs->c.mr->nprocs;
323 }
324 
325 int
326 kmr_get_rank_ff(const KMR_KVS *kvs)
327 {
328  assert(kvs != 0);
329  return kvs->c.mr->rank;
330 }
331 
332 int
333 kmr_get_key_type_ff(const KMR_KVS *kvs)
334 {
335  assert(kvs != 0);
336  return kvs->c.key_data;
337 }
338 
339 int
340 kmr_get_value_type_ff(const KMR_KVS *kvs)
341 {
342  assert(kvs != 0);
343  return kvs->c.value_data;
344 }
345 
346 /** Gets the number of key-value pairs locally on each rank. */
347 
348 int
350 {
351  kmr_assert_kvs_ok(kvs, 0, 1, 0);
352  assert(v != 0);
353  *v = kvs->c.element_count;
354  return MPI_SUCCESS;
355 }
356 
357 /** Returns a print string of a single option, to check the bits are
358  properly encoded in foreign language interfaces. */
359 
360 char *
362 {
363  if (o.nothreading) {
364  return "nothreading";
365  } else if (o.inspect) {
366  return "inspect";
367  } else if (o.keep_open) {
368  return "keep_open";
369  } else if (o.key_as_rank) {
370  return "key_as_rank";
371  } else if (o.rank_zero) {
372  return "rank_zero";
373  } else if (o.collapse) {
374  return "collapse";
375  } else if (o.take_ckpt) {
376  return "take_ckpt";
377  } else {
378  return 0;
379  }
380 }
381 
382 /** Returns a print string of a single option, to check the bits are
383  properly encoded in foreign language interfaces. */
384 
385 char *
387 {
388  if (o.each_rank) {
389  return "each_rank";
390  } else if (o.subdirectories) {
391  return "subdirectories";
392  } else if (o.list_file) {
393  return "list_file";
394  } else if (o.shuffle_names) {
395  return "shuffle_names";
396  } else {
397  return 0;
398  }
399 }
400 
401 /** Returns a print string of a single option, to check the bits are
402  properly encoded in foreign language interfaces. */
403 
404 char *
406 {
407  if (o.separator_space) {
408  return "separator_space";
409  } else if (o.reply_each) {
410  return "reply_each";
411  } else if (o.reply_root) {
412  return "reply_root";
413  } else if (o.one_by_one) {
414  return "one_by_one";
415  } else if (o.take_ckpt) {
416  return "take_ckpt";
417  } else {
418  return 0;
419  }
420 }
421 
422 /* ================================================================ */
423 
424 static int
425 kmr_k_node_by_rank(KMR *mr, kmr_k_position_t p)
426 {
427  int rank;
428  int cc = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
429  assert(cc == MPI_SUCCESS);
430  p[0] = 0;
431  p[1] = (unsigned short)rank;
432  p[2] = 0;
433  p[3] = 0;
434  return MPI_SUCCESS;
435 }
436 
437 /** Gets TOFU position (physical coordinates) of the node. Errors are
438  fatal (aborts). */
439 
440 int
442 {
443 #ifndef __K
444  int cc = kmr_k_node_by_rank(mr, p);
445  return cc;
446 #elif 0
447  if (!mr->onk) {
448  int cc = kmr_k_node_by_rank(mr, p);
449  return cc;
450  } else {
451  /* This code is for GM-1.2.0-12 and later (it is already
452  available, but is not default yet -- 2013-04). */
453  int cc;
454  int rank;
455  int x, y, z, a, b, c;
456  cc = MPI_Comm_rank(MPI_COMM_WORLD, &rank);
457  assert(cc == MPI_SUCCESS);
458  cc = FJMPI_Topology_sys_rank2xyzabc(rank, &x, &y, &z, &a, &b, &c);
459  assert(cc == MPI_SUCCESS);
460  p[0] = (unsigned short)x;
461  p[1] = (unsigned short)y;
462  p[2] = (unsigned short)z;
463  p[3] = (unsigned short)((a << 4) | (b << 2) | c);
464  printf("[%05d] Coord x=%d, y=%d, z=%d, a=%d, b=%d, c=%d\n",
465  rank, x, y, z, a, b, c);
466  return MPI_SUCCESS;
467  }
468 #else
469  if (!mr->onk) {
470  int cc = kmr_k_node_by_rank(mr, p);
471  return cc;
472  } else {
473  char *tofupos = "/proc/tofu/position";
474  char buf[128];
475  int fd;
476  do {
477  fd = open(tofupos, O_RDONLY, 0);
478  } while (fd == -1 && errno == EINTR);
479  if (fd == -1) {
480  char ee[80];
481  char *m = strerror(errno);
482  snprintf(ee, 80, "open(%s): %s", tofupos, m);
483  kmr_error(0, ee);
484  }
485  int cc = 0;
486  off_t rc = 0;
487  while (rc < sizeof(buf)) {
488  ssize_t cx;
489  do {
490  cx = read(fd, &buf[rc], (sizeof(buf) - rc));
491  } while (cx == -1 && errno == EINTR);
492  if (cx == 0) {
493  break;
494  }
495  if (cx == -1) {
496  char ee[80];
497  char *m = strerror(errno);
498  snprintf(ee, 80, "read(%s): %s", tofupos, m);
499  kmr_error(0, ee);
500  }
501  rc += cx;
502  }
503  do {
504  cc = close(fd);
505  } while (cc == -1 && errno == EINTR);
506  assert(rc > 18 && rc < sizeof(buf));
507  buf[rc] = 0;
508  unsigned int x, y, z, a, b, c;
509  char nl, gomi;
510  cc = sscanf(buf, "TOFU NODE ADDRESS:%d,%d,%d,%d,%d,%d%c%c",
511  &x, &y, &z, &a, &b, &c, &nl, &gomi);
512  assert(cc == 7 && nl == '\n');
513  assert(a <= 1 && b <= 2 && c <= 1);
514  p[0] = x;
515  p[1] = y;
516  p[2] = z;
517  p[3] = ((a << 4) | (b << 2) | c);
518  return MPI_SUCCESS;
519  }
520 #endif
521 }
522 
523 /* ================================================================ */
524 
525 /* Returns wall-time in sec. NEVER USE CLOCK_GETTIME(). It needs
526  "rt"-library and avoided. (It prefers POSIX clock_gettime() to
527  MPI_Wtime(), although Open-MPI reads CPU clock counter which may be
528  more precise. On K, the returned resolution is nsec, but it
529  actually changes at usec rate). */
530 
531 double
532 kmr_wtime()
533 {
534 #if 1
535  return MPI_Wtime();
536 #else
537 #ifdef CLOCK_REALTIME
538  static double t0 = 0.0;
539  struct timespec ts;
540  int cc;
541  if (t0 == 0.0) {
542  cc = clock_getres(CLOCK_REALTIME, &ts);
543  assert(cc == 0);
544  double timerres = (double)ts.tv_sec + ((double)ts.tv_nsec * 1e-9);
545  //printf("hr-timer resolution %e sec\n", timerres);
546  assert(timerres <= 1e-4);
547  cc = clock_gettime(CLOCK_REALTIME, &ts);
548  assert(cc == 0);
549  t0 = (double)ts.tv_sec + ((double)ts.tv_nsec * 1e-9);
550  assert(t0 != 0.0);
551  }
552  cc = clock_gettime(CLOCK_REALTIME, &ts);
553  assert(cc == 0);
554  double t1 = (double)ts.tv_sec + ((double)ts.tv_nsec * 1e-9);
555  return (t1 - t0);
556 #endif
557 #endif
558 }
559 
560 /** Searches a key entry like bsearch(3C), but returns a next greater
561  entry instead of null on no match. Thus, it may return a pointer
562  ((char *)base+(nel*size)) when a key is larger than all. */
563 
564 void *
565 kmr_bsearch(const void *key, const void *base, size_t nel, size_t size,
566  int (*compar)(const void *, const void *))
567 {
568  assert(key != 0 && base != 0 && compar != 0);
569  const char *lb = base;
570  size_t w = nel;
571  while (w != 0) {
572  const char *p = lb + (w >> 1) * size;
573  int r = (*compar)(key, p);
574  if (r == 0) {
575  return (void *)p;
576  } else if (r > 0) {
577  lb = p + size;
578  w--;
579  w >>= 1;
580  } else {
581  w >>= 1;
582  }
583  }
584  return (void *)lb;
585 }
586 
587 /* MISCELLANEOUS */
588 
589 /** STRDUP, but aborts on failure. */
590 
591 void *
592 kmr_strdup(char *s)
593 {
594  void *p = strdup(s);
595  if (p == 0) {
596  char ee[80];
597  char *m = strerror(errno);
598  snprintf(ee, 80, "strdup(%s): %s", s, m);
599  kmr_error(0, ee);
600  }
601  return p;
602 }
603 
604 //extern FILE *kmr_fopen(const char *n, const char *m);
605 //extern int kmr_fgetc(FILE *f);
606 
607 /** Does fopen, avoiding EINTR. */
608 
609 FILE *
610 kmr_fopen(const char *n, const char *m)
611 {
612  FILE *f = 0;
613  do {
614  f = fopen(n, m);
615  } while (f == 0 && errno == EINTR);
616  return f;
617 }
618 
619 /** Does fgetc, avoiding EINTR. */
620 
621 int
622 kmr_fgetc(FILE *f)
623 {
624  errno = 0;
625  int c;
626  do {
627  c = fgetc(f);
628  } while (c == EOF && errno == EINTR);
629  return c;
630 }
631 
632 /** Does getdtablesize(); it is defined, because it is not Posix. */
633 
634 int
636 {
637  int cc;
638  struct rlimit r;
639  cc = getrlimit(RLIMIT_NOFILE, &r);
640  int n;
641  if (cc == -1) {
642  char ee[80];
643  char *m = strerror(errno);
644  snprintf(ee, sizeof(ee), "getrlimit(RLIMIT_NOFILE) failed: %s", m);
645  kmr_warning(mr, 5, ee);
646  n = 20;
647  } else {
648  n = (int)r.rlim_cur;
649  }
650  return n;
651 }
652 
653 int
654 kmr_parse_int(char *s, int *r)
655 {
656  int v;
657  char gomi[sizeof(int)];
658  int cc = sscanf(s, "%d%c", &v, gomi);
659  if (cc == 1 && r != 0) {
660  *r = v;
661  }
662  return (cc == 1);
663 }
664 
665 int
666 kmr_parse_boolean(char *s, int *r)
667 {
668  int v = -1;
669  int vv;
670  char gomi[sizeof(int)];
671  if (strcasecmp(s, "true") == 0) {
672  v = 1;
673  } else if (strcasecmp(s, "false") == 0) {
674  v = 0;
675  } else if (sscanf(s, "%d%c", &vv, gomi) == 1) {
676  if (vv == 0 || vv == 1) {
677  v = vv;
678  }
679  }
680  if (v != -1 && r != 0) {
681  *r = v;
682  }
683  return (v != -1);
684 }
685 
686 static int
687 kmr_parse_size_t(char *s, size_t *r)
688 {
689  long v;
690  char gomi[sizeof(int)];
691  int cc = sscanf(s, "%ld%c", &v, gomi);
692  if (cc == 1 && r != 0) {
693  *r = (size_t)v;
694  }
695  return (cc == 1);
696 }
697 
698 /** Checks a key-value stream is sorted. When not LOCALLY, it
699  collects all the entries to rank-zero for checking. */
700 
701 int
702 kmr_assert_sorted(KMR_KVS *kvi, _Bool locally, _Bool shuffling, _Bool ranking)
703 {
704  int cc;
705  KMR *mr = kvi->c.mr;
706  int kcdc = kmr_ckpt_disable_ckpt(mr);
707  int rank = mr->rank;
708  kmr_sorter_t cmp = kmr_choose_sorter(kvi);
709  KMR_KVS *kvs1;
710  if (locally) {
711  kvs1 = kvi;
712  } else {
713  kvs1 = kmr_create_kvs(mr, kvi->c.key_data, kvi->c.value_data);
714  struct kmr_option rankzero = {.rank_zero = 1};
715  cc = kmr_replicate(kvi, kvs1, rankzero);
716  assert(cc == MPI_SUCCESS);
717  }
718  if (locally || rank == 0) {
719  long cnt = kvs1->c.element_count;
720  size_t evsz = (sizeof(struct kmr_kvs_entry *) * (size_t)cnt);
721  struct kmr_kvs_entry **ev = kmr_malloc(evsz);
722  cc = kmr_retrieve_kvs_entries(kvs1, ev, cnt);
723  assert(cc == MPI_SUCCESS);
724  for (long i = 1; i < cnt; i++) {
725  if (!shuffling) {
726  struct kmr_kv_box b0 = kmr_pick_kv(ev[i - 1], kvs1);
727  struct kmr_kv_box b1 = kmr_pick_kv(ev[i], kvs1);
728  assert(cmp(&b0, &b1) <= 0);
729  } else {
730  struct kmr_kv_box b0 = kmr_pick_kv(ev[i - 1], kvs1);
731  struct kmr_kv_box b1 = kmr_pick_kv(ev[i], kvs1);
732  int r0 = (ranking ? (int)b0.k.i : kmr_pitch_rank(b0, kvs1));
733  int r1 = (ranking ? (int)b1.k.i : kmr_pitch_rank(b1, kvs1));
734  assert(r0 <= r1);
735  }
736  }
737  kmr_free(ev, evsz);
738  }
739  if (!locally) {
740  assert(kvs1 != kvi);
741  cc = kmr_free_kvs(kvs1);
742  assert(cc == MPI_SUCCESS);
743  }
744  kmr_ckpt_enable_ckpt(mr, kcdc);
745  return MPI_SUCCESS;
746 }
747 
748 /* Scans a given string to find strings separated by nulls or
749  whitespaces, and returns the count and the strings. A string is
750  given by S and a length LEN (including null). The string will be
751  modified to change whitespaces to nulls. MAXARGC is the size of a
752  vector ARGV, limiting the maximum number of the arguments to
753  (MAXARGC-1), with one spare for a terminating null. ARGC is set to
754  the count and ARGV is filled with the arguments on return. ARGV
755  must have at least the size MAXARGC. When ARGV is null (and
756  MAXARGC is zero), it returns only the count in ARGC (without
757  counting a terminating null). The option WS means the separator
758  character is whatespaces instead of nulls. MSG is a message prefix
759  printed on errors. */
760 
761 int
762 kmr_scan_argv_strings(KMR *mr, char *s, size_t len, int maxargc,
763  int *argc, char **argv, _Bool ws, char *msg)
764 {
765  assert(s != 0 && len > 0);
766  assert(argc != 0 || argv != 0);
767  assert((maxargc != 0) == (argv != 0));
768  assert(!isblank('\0'));
769  if (s[len - 1] != 0) {
770  char ee[80];
771  snprintf(ee, sizeof(ee), ("%s: argument strings"
772  " not terminated with a null"), msg);
773  /*kmr_warning(mr, 5, ee);*/
774  kmr_error(mr, ee);
775  }
776  _Bool counting = (argv == 0);
777  char * const lim = &s[len - 1];
778  char *p = s;
779  int index = 0;
780  for (;;) {
781  while (p < lim && (ws && isblank(*p))) {
782  p++;
783  }
784  if (p == lim) {
785  break;
786  }
787  if (!counting && index < (maxargc - 1)) {
788  argv[index] = p;
789  }
790  index++;
791  while (p < lim && !(*p == 0 || (ws && isblank(*p)))) {
792  p++;
793  }
794  assert(p <= lim);
795  if (!counting && *p != 0) {
796  assert(ws && isblank(*p));
797  *p = 0;
798  }
799  if (p < lim) {
800  p++;
801  }
802  }
803  assert(p == lim);
804  if (!counting && index > (maxargc - 1)) {
805  char ee[80];
806  snprintf(ee, sizeof(ee),
807  ("%s: argument count exceeds the limit (%d)"), msg, maxargc);
808  kmr_error(mr, ee);
809  }
810  if (!counting && index < maxargc) {
811  argv[index] = 0;
812  }
813  if (argc != 0) {
814  *argc = index;
815  }
816  return MPI_SUCCESS;
817 }
818 
819 /* Sleeps for MSEC, but calls MPI_Testany() periodically. (It avoids
820  using MPI_STATUS_IGNORE in MPI_Testany() for a bug in some versions
821  of Open MPI (around 1.6.3)). */
822 
823 int
824 kmr_msleep(int msec, int interval)
825 {
826  assert(msec >= 1 && interval >= 1);
827  int gap = MIN(msec, interval);
828  double t0 = MPI_Wtime();
829  double t1 = (t0 + 1e-3 * msec);
830  for (;;) {
831  int index;
832  int ok;
833  MPI_Status st;
834  int cc = MPI_Testany(0, 0, &index, &ok, &st);
835  assert(cc == MPI_SUCCESS);
836  double t2 = MPI_Wtime();
837  if (t2 > t1) {
838  break;
839  }
840  usleep((useconds_t)(gap * 1000));
841  }
842  return MPI_SUCCESS;
843 }
844 
845 /* Frees memory by free() (3C). It is for calling free() safely from
846  users of the .so library, even if free() is substituted by
847  anything. */
848 
849 void
850 kmr_mfree(void *p, size_t sz)
851 {
852  kmr_free(p, sz);
853 }
854 
855 /* (mpi routines for python-ctypes) Returns a sizeof a MPI type given
856  by a string. */
857 
858 size_t
859 kmr_mpi_type_size(char *s)
860 {
861  if (strcasecmp(s, "MPI_Group") == 0) {
862  return sizeof(MPI_Group);
863  } else if (strcasecmp(s, "MPI_Comm") == 0) {
864  return sizeof(MPI_Comm);
865  } else if (strcasecmp(s, "MPI_Datatype") == 0) {
866  return sizeof(MPI_Datatype);
867  } else if (strcasecmp(s, "MPI_Request") == 0) {
868  return sizeof(MPI_Request);
869  } else if (strcasecmp(s, "MPI_Op") == 0) {
870  return sizeof(MPI_Op);
871  } else if (strcasecmp(s, "MPI_Errhandler") == 0) {
872  return sizeof(MPI_Errhandler);
873  } else if (strcasecmp(s, "MPI_Info") == 0) {
874  return sizeof(MPI_Info);
875  } else {
876  char ee[80];
877  snprintf(ee, sizeof(ee),
878  "kmr_mpi_type_size() unknown name (%s)", s);
879  kmr_warning(0, 5, ee);
880  return 0;
881  }
882 }
883 
884 /* (mpi routines for python-ctypes) Returns a value of some MPI named
885  constants given by a string. */
886 
887 uint64_t
888 kmr_mpi_constant_value(char *s)
889 {
890  assert(sizeof(MPI_Group) <= sizeof(uint64_t)
891  && sizeof(MPI_Comm) <= sizeof(uint64_t)
892  && sizeof(MPI_Datatype) <= sizeof(uint64_t)
893  && sizeof(MPI_Request) <= sizeof(uint64_t)
894  && sizeof(MPI_Op) <= sizeof(uint64_t)
895  && sizeof(MPI_Errhandler) <= sizeof(uint64_t)
896  && sizeof(MPI_Info) <= sizeof(uint64_t));
897 
898  if (strcasecmp(s, "MPI_COMM_WORLD") == 0) {
899  return (uint64_t)MPI_COMM_WORLD;
900  } else if (strcasecmp(s, "MPI_COMM_SELF") == 0) {
901  return (uint64_t)MPI_COMM_SELF;
902  } else if (strcasecmp(s, "MPI_COMM_NULL") == 0) {
903  return (uint64_t)MPI_COMM_NULL;
904  } else if (strcasecmp(s, "MPI_GROUP_NULL") == 0) {
905  return (uint64_t)MPI_GROUP_NULL;
906  } else if (strcasecmp(s, "MPI_DATATYPE_NULL") == 0) {
907  return (uint64_t)MPI_DATATYPE_NULL;
908  } else if (strcasecmp(s, "MPI_REQUEST_NULL") == 0) {
909  return (uint64_t)MPI_REQUEST_NULL;
910  } else if (strcasecmp(s, "MPI_OP_NULL") == 0) {
911  return (uint64_t)MPI_OP_NULL;
912  } else if (strcasecmp(s, "MPI_ERRHANDLER_NULL") == 0) {
913  return (uint64_t)MPI_ERRHANDLER_NULL;
914  } else if (strcasecmp(s, "MPI_GROUP_EMPTY") == 0) {
915  return (uint64_t)MPI_GROUP_EMPTY;
916  } else if (strcasecmp(s, "MPI_INFO_NULL") == 0) {
917  return (uint64_t)MPI_INFO_NULL;
918  } else {
919  char ee[80];
920  snprintf(ee, sizeof(ee),
921  "kmr_mpi_constant_value() unknown name (%s)", s);
922  kmr_warning(0, 5, ee);
923  return 0;
924  }
925 }
926 
927 /* ================================================================ */
928 
929 /** Copies the entry in the array. It should be used with the INSPECT
930  option for map, because the array entries may point into the input
931  key-value stream. It is a map-function. */
932 
933 int
935  const KMR_KVS *kvi, KMR_KVS *kvo, void *arg, const long i)
936 {
937  struct kmr_kv_box *v = arg;
938  v[i] = kv;
939  return MPI_SUCCESS;
940 }
941 
942 /* Reduces the argument integers to the maximum, only for a single
943  reduction (the all keys are the same). */
944 
945 int
946 kmr_imax_one_fn(const struct kmr_kv_box kv[], const long n,
947  const KMR_KVS *kvi, KMR_KVS *kvo, void *p)
948 {
949  assert(n > 0);
950  long *zz = p;
951  long m = 0;
952  for (long i = 0; i < n; i++) {
953  long v = kv[i].v.i;
954  m = MAX(v, m);
955  }
956  *zz = m;
957  return MPI_SUCCESS;
958 }
959 
960 int
961 kmr_isum_one_fn(const struct kmr_kv_box kv[], const long n,
962  const KMR_KVS *kvi, KMR_KVS *kvo, void *p)
963 {
964  assert(n > 0);
965  long *zz = p;
966  long m = 0;
967  for (long i = 0; i < n; i++) {
968  long v = kv[i].v.i;
969  m = v + m;
970  }
971  *zz = m;
972  return MPI_SUCCESS;
973 }
974 
975 /* ================================================================ */
976 
977 /* PREFERENCE/OPTIONS */
978 
979 /** Copies mpi-info entires into kvs. */
980 
981 int
982 kmr_copy_info_to_kvs(MPI_Info src, KMR_KVS *kvo)
983 {
984  kmr_assert_kvs_ok(0, kvo, 0, 1);
985  assert(src != MPI_INFO_NULL);
986  int cc;
987  int nkeys;
988  char key[MPI_MAX_INFO_KEY + 1];
989  char value[MPI_MAX_INFO_VAL + 1];
990  cc = MPI_Info_get_nkeys(src, &nkeys);
991  assert(cc == MPI_SUCCESS);
992  for (int i = 0; i < nkeys; i++) {
993  int vlen;
994  int flag;
995  cc = MPI_Info_get_nthkey(src, i, key);
996  assert(cc == MPI_SUCCESS);
997  cc = MPI_Info_get_valuelen(src, key, &vlen, &flag);
998  assert(cc == MPI_SUCCESS && flag != 0);
999  assert(vlen <= MPI_MAX_INFO_VAL);
1000  cc = MPI_Info_get(src, key, MPI_MAX_INFO_VAL, value, &flag);
1001  assert(cc == MPI_SUCCESS && flag != 0);
1002  cc = kmr_add_string(kvo, key, value);
1003  assert(cc == MPI_SUCCESS);
1004  }
1005  cc = kmr_add_kv_done(kvo);
1006  assert(cc == MPI_SUCCESS);
1007  return MPI_SUCCESS;
1008 }
1009 
1010 static int
1011 kmr_set_info_fn(const struct kmr_kv_box kv,
1012  const KMR_KVS *kvi, KMR_KVS *kvo, void *p, const long i)
1013 {
1014  MPI_Info *dstp = p;
1015  MPI_Info dst = *dstp;
1016  char *k = (char *)kv.k.p;
1017  char *v = (char *)kv.v.p;
1018  if (k[0] == 0) {
1019  kmr_warning(0, 5, "empty key string for MPI_Info_set(), ignored");
1020  } else if (v[0] == 0) {
1021  /* OPEN MPI (1.6.4) DOES NOT ALLOW EMPTY VALUE. */
1022  kmr_warning(0, 5, "empty value string for MPI_Info_set(), ignored");
1023  } else {
1024  int cc = MPI_Info_set(dst, (char *)kv.k.p, (char *)kv.v.p);
1025  assert(cc == MPI_SUCCESS);
1026  }
1027  return MPI_SUCCESS;
1028 }
1029 
1030 /** Copies kvs entires into mpi-info. It assumes keys/values are
1031  strings (no checks). It consumes KVI. */
1032 
1033 int
1034 kmr_copy_kvs_to_info(KMR_KVS *kvi, MPI_Info dst)
1035 {
1036  kmr_assert_kvs_ok(kvi, 0, 1, 0);
1037  int cc;
1038  struct kmr_option nothreading = {.nothreading = 1};
1039  cc = kmr_map(kvi, 0, &dst, nothreading, kmr_set_info_fn);
1040  assert(cc == MPI_SUCCESS);
1041  return MPI_SUCCESS;
1042 }
1043 
1044 /* Loads configuration options from preferences into INFO.
1045  Preferences are taken from a file with a name specified by an
1046  environment variable "KMROPTION" on rank0. */
1047 
1048 int
1049 kmr_load_preference(KMR *mr, MPI_Info info)
1050 {
1051  int cc;
1052  MPI_Info inforank0;
1053  cc = MPI_Info_create(&inforank0);
1054  assert(cc == MPI_SUCCESS);
1055  do {
1056  if (mr->rank == 0) {
1057  char *name = getenv("KMROPTION");
1058  if (name == 0) {
1059  break;
1060  }
1061  cc = kmr_load_properties(inforank0, name);
1062  if (cc != MPI_SUCCESS) {
1063  break;
1064  }
1065  }
1066  } while (0);
1067  KMR_KVS *kvs0 = kmr_create_kvs(mr, KMR_KV_OPAQUE, KMR_KV_OPAQUE);
1068  cc = kmr_copy_info_to_kvs(inforank0, kvs0);
1069  assert(cc == MPI_SUCCESS);
1070  KMR_KVS *kvs1 = kmr_create_kvs(mr, KMR_KV_OPAQUE, KMR_KV_OPAQUE);
1071  cc = kmr_replicate(kvs0, kvs1, kmr_noopt);
1072  assert(cc == MPI_SUCCESS);
1073  cc = kmr_copy_kvs_to_info(kvs1, info);
1074  assert(cc == MPI_SUCCESS);
1075  MPI_Info_free(&inforank0);
1076  if (0) {
1077  char ee[80];
1078  snprintf(ee, sizeof(ee), "[%05d]", mr->rank);
1079  printf("%s dumpinfo info...\n", ee);
1080  kmr_dump_mpi_info(ee, info);
1081  }
1082  return MPI_SUCCESS;
1083 }
1084 
1085 /* Checks configuration options. It takes merges of two mpi-infos,
1086  one from preferences and one given. The given one overrides
1087  preferences. */
1088 
1089 int
1090 kmr_check_options(KMR *mr, MPI_Info info)
1091 {
1092  int cc;
1093  /* Check options. */
1094  int n;
1095  if (info == MPI_INFO_NULL) {
1096  n = 0;
1097  } else {
1098  cc = MPI_Info_get_nkeys(info, &n);
1099  assert(cc == MPI_SUCCESS);
1100  }
1101 
1102  for (int i = 0; i < n; i++) {
1103  char k[MPI_MAX_INFO_KEY + 1];
1104  char v[MPI_MAX_INFO_VAL + 1];
1105  int flag;
1106  cc = MPI_Info_get_nthkey(info, i, k);
1107  assert(cc == MPI_SUCCESS);
1108  cc = MPI_Info_get(info, k, MPI_MAX_INFO_VAL, v, &flag);
1109  assert(cc == MPI_SUCCESS && flag != 0);
1110  if (flag == 1) {
1111  kmr_set_option_by_strings(mr, k, v);
1112  } else {
1113  char ee[80];
1114  snprintf(ee, 80, "option \"%s\" ignored", k);
1115  kmr_warning(mr, 1, ee);
1116  }
1117  }
1118 
1119  if (mr->verbosity == 9) {
1120  int r = mr->rank;
1121  printf("[%05d] Dumping KMR options:\n", r);
1122  printf("[%05d] verbosity=%d\n", r, mr->verbosity);
1123  printf("[%05d] sort_threads_depth=%d\n", r, mr->sort_threads_depth);
1124  printf("[%05d] onk=%d\n", r, mr->onk);
1125  printf("[%05d] atoa_threshold=%ld\n", r, mr->atoa_threshold);
1126  printf("[%05d] single_thread=%d\n", r, mr->single_thread);
1127  printf("[%05d] step_sync=%d\n", r, mr->step_sync);
1128  printf("[%05d] trace_file_io=%d\n", r, mr->trace_file_io);
1129  printf("[%05d] trace_map_ms=%d\n", r, mr->trace_map_ms);
1130  printf("[%05d] trace_map_spawn=%d\n", r, mr->trace_map_spawn);
1131  printf("[%05d] trace_alltoall=%d\n", r, mr->trace_alltoall);
1132  printf("[%05d] trace_kmrdp=%d\n", r, mr->trace_kmrdp);
1133  printf("[%05d] std_abort=%d\n", r, mr->std_abort);
1134  printf("[%05d] log_traces=%d\n", r, (mr->log_traces != 0));
1135  printf("[%05d] ckpt_enable=%d\n", r, mr->ckpt_enable);
1136  printf("[%05d] ckpt_selective=%d\n", r, mr->ckpt_selective);
1137  printf("[%05d] ckpt_no_fsync=%d\n", r, mr->ckpt_no_fsync);
1138  printf("[%05d] pushoff_block_size=%zd\n", r, mr->pushoff_block_size);
1139  printf("[%05d] pushoff_poll_rate=%d\n", r, mr->pushoff_poll_rate);
1140  printf("[%05d] pushoff_fast_notice=%d\n", r, mr->pushoff_fast_notice);
1141  printf("[%05d] kmrviz_trace=%d\n", r, mr->kmrviz_trace);
1142  }
1143  return MPI_SUCCESS;
1144 }
1145 
1146 /* Set an option in KMR context as given by a key and a value. */
1147 
1148 int
1149 kmr_set_option_by_strings(KMR *mr, char *k, char *v)
1150 {
1151  int x;
1152  if (strcasecmp("log_traces", k) == 0) {
1153  if (kmr_parse_boolean(v, &x)) {
1154  if (mr->log_traces == 0) {
1155  kmr_open_log(mr);
1156  }
1157  } else {
1158  kmr_warning(mr, 1, "option log_traces be boolean");
1159  }
1160  } else if (strcasecmp("sort_threads_depth", k) == 0) {
1161  if (kmr_parse_int(v, &x) && x >= 0) {
1162  mr->sort_threads_depth = x;
1163  } else {
1164  kmr_warning(mr, 1, ("option sort_threads_depth be"
1165  " non-negative integer"));
1166  }
1167  } else if (strcasecmp("verbosity", k) == 0) {
1168  if (kmr_parse_int(v, &x) && (1 <= x && x <= 9)) {
1169  mr->verbosity = (uint8_t)x;
1170  } else {
1171  kmr_warning(mr, 1, "option verbosity be 1-9");
1172  }
1173  } else if (strcasecmp("k", k) == 0) {
1174  if (kmr_parse_boolean(v, &x)) {
1175  mr->onk = (_Bool)x;
1176  } else {
1177  kmr_warning(mr, 1, "option k be boolean");
1178  }
1179  } else if (strcasecmp("single_thread", k) == 0) {
1180  if (kmr_parse_boolean(v, &x)) {
1181  mr->single_thread = (_Bool)x;
1182  } else {
1183  kmr_warning(mr, 1, "option single_thread be boolean");
1184  }
1185  } else if (strcasecmp("step_sync", k) == 0) {
1186  if (kmr_parse_boolean(v, &x)) {
1187  mr->step_sync = (_Bool)x;
1188  } else {
1189  kmr_warning(mr, 1, "option step_sync be boolean");
1190  }
1191  } else if (strcasecmp("trace_file_io", k) == 0) {
1192  if (kmr_parse_boolean(v, &x)) {
1193  mr->trace_file_io = (_Bool)x;
1194  } else {
1195  kmr_warning(mr, 1, "option trace_file_io be boolean");
1196  }
1197  } else if (strcasecmp("trace_map_ms", k) == 0) {
1198  if (kmr_parse_boolean(v, &x)) {
1199  mr->trace_map_ms = (_Bool)x;
1200  } else {
1201  kmr_warning(mr, 1, "option trace_map_ms be boolean");
1202  }
1203  } else if (strcasecmp("trace_map_spawn", k) == 0) {
1204  if (kmr_parse_boolean(v, &x)) {
1205  mr->trace_map_spawn = (_Bool)x;
1206  } else {
1207  kmr_warning(mr, 1, "option trace_map_spawn be boolean");
1208  }
1209  } else if (strcasecmp("std_abort", k) == 0) {
1210  if (kmr_parse_boolean(v, &x)) {
1211  mr->std_abort = (_Bool)x;
1212  } else {
1213  kmr_warning(mr, 1, "option std_abort be boolean");
1214  }
1215  } else if (strcasecmp("trace_alltoall", k) == 0) {
1216  if (kmr_parse_boolean(v, &x)) {
1217  mr->trace_alltoall = (_Bool)x;
1218  } else {
1219  kmr_warning(mr, 1, "option trace_alltoall be boolean");
1220  }
1221  } else if (strcasecmp("atoa_threshold", k) == 0) {
1222  if (kmr_parse_int(v, &x) && x >= 0) {
1223  mr->atoa_threshold = x;
1224  } else {
1225  kmr_warning(mr, 1, ("option atoa_threshold be"
1226  " non-negative integer"));
1227  }
1228  } else if (strcasecmp("spawn_max_processes", k) == 0) {
1229  if (kmr_parse_int(v, &x) && x >= 0) {
1230  mr->spawn_max_processes = x;
1231  } else {
1232  kmr_warning(mr, 1, ("option spawn_max_processes be"
1233  " non-negative integer"));
1234  }
1235  } else if (strcasecmp("ckpt_enable", k) == 0) {
1236  if (kmr_parse_boolean(v, &x)) {
1237  mr->ckpt_enable = (_Bool)x;
1238  } else {
1239  kmr_warning(mr, 1, "option ckpt_enable be boolean");
1240  }
1241  } else if (strcasecmp("ckpt_selective", k) == 0) {
1242  if (kmr_parse_boolean(v, &x)) {
1243  mr->ckpt_selective = (_Bool)x;
1244  } else {
1245  kmr_warning(mr, 1, "option ckpt_selective be boolean");
1246  }
1247  } else if (strcasecmp("ckpt_no_fsync", k) == 0) {
1248  if (kmr_parse_boolean(v, &x)) {
1249  mr->ckpt_no_fsync = (_Bool)x;
1250  } else {
1251  kmr_warning(mr, 1, "option ckpt_no_fsync be boolean");
1252  }
1253  } else if (strcasecmp("pushoff_block_size", k) == 0) {
1254  size_t z;
1255  if (kmr_parse_size_t(v, &z)) {
1256  mr->pushoff_block_size = z;
1257  }
1258  } else if (strcasecmp("pushoff_poll_rate", k) == 0) {
1259  if (kmr_parse_int(v, &x)) {
1260  mr->pushoff_poll_rate = x;
1261  }
1262  } else if (strcasecmp("pushoff_fast_notice", k) == 0) {
1263  if (kmr_parse_boolean(v, &x)) {
1264  mr->pushoff_fast_notice = (_Bool)x;
1265  } else {
1266  kmr_warning(mr, 1, "option pushoff_fast_notice be boolean");
1267  }
1268  } else if (strcasecmp("kmrviz_trace", k) == 0) {
1269  if (kmr_parse_boolean(v, &x)) {
1270  mr->kmrviz_trace = (_Bool)x;
1271  } else {
1272  kmr_warning(mr, 1, "option kmrviz_trace be boolean");
1273  }
1274  } else {
1275  char ee[80];
1276  snprintf(ee, 80, "option \"%s\" ignored", k);
1277  kmr_warning(mr, 1, ee);
1278  }
1279  return MPI_SUCCESS;
1280 }
1281 
1282 /* ================================================================ */
1283 
1284 /* Checks if a COMMAND is found. If SEARCH=true, it checks in the
1285  PATH directories. Or, it checks just existence of a file. MSG is
1286  a string prefixing to the trace messages. */
1287 
1288 static _Bool
1289 kmr_check_command_existence(KMR *mr, char *command, _Bool search, char *msg)
1290 {
1291  int cc;
1292  char ss[256];
1293  _Bool tracing7 = (mr->trace_map_spawn && (7 <= mr->verbosity));
1294  if (!search) {
1295  if (tracing7) {
1296  fprintf(stderr, (";;KMR [%05d] %s:"
1297  " checking a watch-program: %s\n"),
1298  mr->rank, msg, command);
1299  fflush(0);
1300  }
1301  do {
1302  cc = access(command, X_OK);
1303  } while (cc != 0 && errno == EINTR);
1304  if (cc != 0 && !(errno == ENOENT || errno == EACCES)) {
1305  char ee[80];
1306  char *m = strerror(errno);
1307  snprintf(ee, sizeof(ee), "access() returned: %s", m);
1308  kmr_warning(mr, 1, ee);
1309  }
1310  return (cc == 0);
1311  } else {
1312  _Bool fixed = 0;
1313  for (char *p = command; *p != 0; p++) {
1314  if (*p == '/') {
1315  fixed = 1;
1316  break;
1317  }
1318  }
1319  char *path = getenv("PATH");
1320  if (fixed || path == 0) {
1321  _Bool ok = kmr_check_command_existence(mr, command, 0, msg);
1322  return ok;
1323  }
1324  size_t s = strlen(path);
1325  char *buf = kmr_malloc(s + (size_t)1);
1326  memcpy(buf, path, (s + 1));
1327  _Bool ok = 0;
1328  char *prefix = buf;
1329  char *p = buf;
1330  while (p < &buf[s]) {
1331  while (p < &buf[s] && *p != ':') {
1332  p++;
1333  }
1334  if (*p == ':') {
1335  *p = 0;
1336  p++;
1337  } else {
1338  assert(*p == 0);
1339  }
1340  cc = snprintf(ss, sizeof(ss), "%s/%s", prefix, command);
1341  assert(cc < (int)sizeof(ss));
1342  ok = kmr_check_command_existence(mr, ss, 0, msg);
1343  if (ok) {
1344  break;
1345  }
1346  prefix = p;
1347  }
1348  kmr_free(buf, (s + 1));
1349  return ok;
1350  }
1351 }
1352 
1353 /* Assures a watch-program is available as a command, and returns a
1354  command string to it. It installs a new watch-program file in the
1355  home directory when it is not available. Home is taken from "HOME"
1356  or "PJM_JOBDIR". It works on the rank0 only. MSG is a string
1357  prefixing to the trace messages. */
1358 
1359 static char *
1360 kmr_install_watch_program_on_rank0(KMR *mr, char *msg)
1361 {
1362  char *name = "kmrwatch0";
1363  assert(mr->rank == 0);
1364  int cc;
1365  static char command[256];
1366  _Bool ok = 0;
1367  cc = snprintf(command, sizeof(command), "%s", name);
1368  assert(cc < (int)sizeof(command));
1369  ok = kmr_check_command_existence(mr, command, 1, msg);
1370  if (ok) {
1371  return command;
1372  }
1373  if (mr->kmr_installation_path != 0) {
1374  char *prefix = mr->kmr_installation_path;
1375  cc = snprintf(command, sizeof(command), "%s/bin/%s", prefix, name);
1376  assert(cc < (int)sizeof(command));
1377  ok = kmr_check_command_existence(mr, command, 0, msg);
1378  if (ok) {
1379  return command;
1380  }
1381  cc = snprintf(command, sizeof(command), "%s/lib/%s", prefix, name);
1382  assert(cc < (int)sizeof(command));
1383  ok = kmr_check_command_existence(mr, command, 0, msg);
1384  if (ok) {
1385  return command;
1386  }
1387  }
1388  if (mr->spawn_watch_prefix != 0) {
1389  char *prefix = mr->spawn_watch_prefix;
1390  cc = snprintf(command, sizeof(command), "%s/%s", prefix, name);
1391  assert(cc < (int)sizeof(command));
1392  ok = kmr_check_command_existence(mr, command, 0, msg);
1393  if (ok) {
1394  return command;
1395  }
1396  } else {
1397  char *prefix = 0;
1398  prefix = getenv("HOME");
1399  if (prefix == 0) {
1400  /* On K, HOME is not set but PJM_JOBDIR is. */
1401  prefix = getenv("PJM_JOBDIR");
1402  }
1403  if (prefix == 0) {
1404  kmr_error(mr, ("installing a watch-program:"
1405  " environment variable HOME not set."
1406  " Try setting spawn_watch_prefix"));
1407  }
1408  cc = snprintf(command, sizeof(command), "%s/%s", prefix, name);
1409  assert(cc < (int)sizeof(command));
1410  ok = kmr_check_command_existence(mr, command, 0, msg);
1411  if (ok) {
1412  return command;
1413  }
1414  }
1415 #if !defined(KMRBINEMBED)
1416  {
1417  cc = snprintf(command, sizeof(command), "%s", name);
1418  assert(cc < (int)sizeof(command));
1419  return command;
1420  }
1421 #else /*KMRBINEMBEDH*/
1422  {
1423  extern unsigned char kmr_binary_kmrwatch0_start[];
1424  extern unsigned char *kmr_binary_kmrwatch0_end;
1425  extern unsigned long kmr_binary_kmrwatch0_size;
1426  char *p0 = (void *)kmr_binary_kmrwatch0_start;
1427  char *p1 = (void *)kmr_binary_kmrwatch0_end;
1428  size_t sz = kmr_binary_kmrwatch0_size;
1429  assert((p1 - p0) == (long)sz);
1430  int fd;
1431  do {
1432  mode_t mode = (S_IRWXU|S_IRWXG|S_IRWXO);
1433  fd = open(command, (O_WRONLY|O_CREAT|O_TRUNC), mode);
1434  } while (fd == -1 && errno == EINTR);
1435  if (fd == -1) {
1436  char ee[160];
1437  char *m = strerror(errno);
1438  snprintf(ee, sizeof(ee), "open(%s): %s", command, m);
1439  kmr_error(mr, ee);
1440  }
1441  size_t ss = 0;
1442  while (ss < sz) {
1443  ssize_t xx = write(fd, &p0[ss], (sz - ss));
1444  if (xx == -1) {
1445  char ee[160];
1446  char *m = strerror(errno);
1447  snprintf(ee, sizeof(ee), "write(%s): %s", command, m);
1448  kmr_error(mr, ee);
1449  }
1450  if (xx == 0) {
1451  char ee[160];
1452  snprintf(ee, sizeof(ee), "write(%s): write by zero size",
1453  command);
1454  kmr_error(mr, ee);
1455  }
1456  ss += (size_t)xx;
1457  }
1458  cc = close(fd);
1459  assert(cc == 0);
1460  char ee[80];
1461  snprintf(ee, sizeof(ee),
1462  "a watch-program for spawning has been installed (%s)",
1463  command);
1464  kmr_warning(mr, 5, ee);
1465  return command;
1466  }
1467 #endif /*KMRBINEMBED*/
1468 }
1469 
1470 /* Assures a watch-program is available as a command, and stores its
1471  file name in the context as SPAWN_WATCH_PROGRAM. */
1472 
1473 int
1474 kmr_install_watch_program(KMR *mr, char *msg)
1475 {
1476  int cc;
1477  if (mr->spawn_watch_program == 0) {
1478  KMR_KVS *kvs0 = kmr_create_kvs(mr, KMR_KV_OPAQUE, KMR_KV_OPAQUE);
1479  if (mr->rank == 0) {
1480  char *command = kmr_install_watch_program_on_rank0(mr, msg);
1481  assert(command != 0 && command[0] != 0);
1482  cc = kmr_add_string(kvs0, "", command);
1483  assert(cc == MPI_SUCCESS);
1484  }
1485  cc = kmr_add_kv_done(kvs0);
1486  assert(cc == MPI_SUCCESS);
1487  KMR_KVS *kvs1 = kmr_create_kvs(mr, KMR_KV_OPAQUE, KMR_KV_OPAQUE);
1488  cc = kmr_replicate(kvs0, kvs1, kmr_noopt);
1489  assert(cc == MPI_SUCCESS);
1490  struct kmr_kv_box kv;
1491  cc = kmr_take_one(kvs1, &kv);
1492  assert(cc == MPI_SUCCESS);
1493  char *b = kmr_malloc((size_t)kv.vlen);
1494  memcpy(b, kv.v.p, (size_t)kv.vlen);
1495  mr->spawn_watch_program = b;
1496  cc = kmr_free_kvs(kvs1);
1497  assert(cc == MPI_SUCCESS);
1498  }
1499  return MPI_SUCCESS;
1500 }
1501 
1502 /* ================================================================ */
1503 
1504 /* DUMPERS */
1505 
1506 /** Puts the string of the key or value field into a buffer BUF as
1507  printable string. Ellipses appear if string does not fit in the
1508  buffer. */
1509 
1510 void
1511 kmr_dump_opaque(const char *p, int sz, char *buf, int buflen)
1512 {
1513  int printable = 1; /*printable*/
1514  int seezero = 0;
1515  for (int i = 0; i < sz; i++) {
1516  if (p[i] == 0) {
1517  seezero = 1;
1518  } else if (!isprint(p[i])) {
1519  printable = 0; /*unprintable*/
1520  break;
1521  } else {
1522  if (seezero && printable == 1) {
1523  printable = 2; /*null-in-the-middle*/
1524  }
1525  }
1526  }
1527  if (printable == 1) {
1528  int z = (int)strnlen(p, (size_t)sz);
1529  int n = MIN(z, ((int)buflen - 5 - 1));
1530  if (z == n) {
1531  snprintf(buf, (size_t)(n + 3), "\"%s\"", p);
1532  } else {
1533  snprintf(buf, (size_t)(n + 6), "\"%s...\"", p);
1534  }
1535  } else if (printable == 2) {
1536  int z = (int)strnlen(p, (size_t)sz);
1537  int n = MIN(z, (buflen - 5 - 1));
1538  if (z == n) {
1539  snprintf(buf, (size_t)(n + 6), "\"%s???\"", p);
1540  } else {
1541  snprintf(buf, (size_t)(n + 6), "\"%s...\"", p);
1542  }
1543  } else {
1544  int n = MIN(sz, ((buflen - 3 - 1) / 3));
1545  char *q = buf;
1546  for (int i = 0; i < n; i++) {
1547  snprintf(q, 4, "%02x ", (p[i] & 0xff));
1548  q += 3;
1549  }
1550  if (n != sz) {
1551  snprintf(q, 4, "...");
1552  }
1553  }
1554 }
1555 
1556 void
1557 kmr_dump_slot(union kmr_unit_sized e, int len, enum kmr_kv_field data,
1558  char *buf, int buflen)
1559 {
1560  switch (data) {
1561  case KMR_KV_BAD:
1562  assert(data != KMR_KV_BAD);
1563  break;
1564  case KMR_KV_INTEGER:
1565  snprintf(buf, (size_t)buflen, "%ld", e.i);
1566  break;
1567  case KMR_KV_FLOAT8:
1568  snprintf(buf, (size_t)buflen, "%e", e.d);
1569  break;
1570  case KMR_KV_OPAQUE:
1571  case KMR_KV_CSTRING:
1572  case KMR_KV_POINTER_OWNED:
1573  case KMR_KV_POINTER_UNMANAGED:
1574  kmr_dump_opaque(e.p, len, buf, buflen);
1575  break;
1576  default:
1577  assert(NEVERHERE);
1578  break;
1579  }
1580 }
1581 
1582 /** Dumps contents of a key-value. */
1583 
1584 int
1585 kmr_dump_kv(const struct kmr_kv_box kv, const KMR_KVS *kvs,
1586  char *buf, int buflen)
1587 {
1588  char kbuf[48], vbuf[48];
1589  kmr_dump_slot(kv.k, kv.klen, kvs->c.key_data, kbuf, sizeof(kbuf));
1590  kmr_dump_slot(kv.v, kv.vlen, kvs->c.value_data, vbuf, sizeof(vbuf));
1591  snprintf(buf, (size_t)buflen, "k[%d]=%s;v[%d]=%s", kv.klen, kbuf, kv.vlen, vbuf);
1592  return MPI_SUCCESS;
1593 }
1594 
1595 static int
1596 kmr_dump_kvs_fn(const struct kmr_kv_box kv,
1597  const KMR_KVS *kvs, KMR_KVS *kvso, void *p, const long i)
1598 {
1599  char b[80];
1600  kmr_dump_kv(kv, kvs, b, sizeof(b));
1601  printf("[%05d][%ld] %s\n", kvs->c.mr->rank, i, b);
1602  return MPI_SUCCESS;
1603 }
1604 
1605 /** Dumps contents of a key-value stream to stdout. Argument FLAG is
1606  nothing, ignored. */
1607 
1608 int
1609 kmr_dump_kvs(KMR_KVS *kvs, int flag)
1610 {
1611  assert(kvs->c.magic != KMR_KVS_BAD);
1612  int rank = kvs->c.mr->rank;
1613  printf("[%05d] element_count=%ld\n", rank, kvs->c.element_count);
1614  struct kmr_option opt = {.inspect = 1, .nothreading = 1};
1615  int kcdc = kmr_ckpt_disable_ckpt(kvs->c.mr);
1616  int cc = kmr_map_rank_by_rank(kvs, 0, 0, opt, kmr_dump_kvs_fn);
1617  assert(cc == MPI_SUCCESS);
1618  kmr_ckpt_enable_ckpt(kvs->c.mr, kcdc);
1619  return MPI_SUCCESS;
1620 }
1621 
1622 #if 0
1623 static int
1624 kmr_dump_kvs2_fn(const struct kmr_kv_box kv,
1625  const KMR_KVS *kvs, KMR_KVS *kvso, void *p, const long i)
1626 {
1627  char kbuf[48], vbuf[48];
1628  assert(kvs->c.magic != KMR_KVS_BAD);
1629  int rank = kvs->c.mr->rank;
1630  kmr_dump_slot(kv.k, kv.klen, kvs->c.key_data, kbuf, sizeof(kbuf));
1631  //kmr_dump_slot(kv.v, kv.vlen, , vbuf, sizeof(vbuf));
1632  printf("[%05d] k[%d]=%s;v[%d]=%s\n", rank, kv.klen, kbuf, kv.vlen, vbuf);
1633  return MPI_SUCCESS;
1634 }
1635 #endif
1636 
1637 /** Dumps contents of a key-value stream, with values are pairs. */
1638 
1639 #if 0
1640 static int
1641 kmr_dump_kvs_pair_value(KMR_KVS *kvs, int flag)
1642 {
1643  assert(kvs->c.magic != KMR_KVS_BAD);
1644  assert(kvs->c.value_data == KMR_KV_OPAQUE
1645  || kvs->c.value_data == KMR_KV_CSTRING);
1646  int rank = kvs->c.mr->rank;
1647  printf("[%05d] element_count=%ld\n", rank, kvs->c.element_count);
1648  struct kmr_option opt = {.inspect = 1};
1649  int cc = kmr_map_rank_by_rank(kvs, 0, 0, opt, kmr_dump_kvs2_fn);
1650  assert(cc == MPI_SUCCESS);
1651  return MPI_SUCCESS;
1652 }
1653 #endif
1654 
1655 /** Prints the total number of key-value pairs. It prints on the
1656  rank0 only. */
1657 
1658 int
1659 kmr_dump_kvs_stats(KMR_KVS *kvs, int level)
1660 {
1661  long v;
1662  kmr_get_element_count(kvs, &v);
1663  if (kvs->c.mr->rank == 0) {
1664  printf("element_count=%ld\n", v);
1665  }
1666  return MPI_SUCCESS;
1667 }
1668 
1669 int
1670 kmr_dump_keyed_records(const struct kmr_keyed_record *ev, KMR_KVS *kvi)
1671 {
1672  long cnt = kvi->c.element_count;
1673  for (long i = 0; i < cnt; i++) {
1674  int rank = kvi->c.mr->rank;
1675  char kbuf[48], vbuf[48];
1676  struct kmr_kv_box kv = kmr_pick_kv(ev[i].e, kvi);
1677  kmr_dump_slot(kv.k, kv.klen, kvi->c.key_data, kbuf, sizeof(kbuf));
1678  kmr_dump_slot(kv.v, kv.vlen, kvi->c.value_data, vbuf, sizeof(vbuf));
1679  printf("[%05d] h=%ld;k[%d]=%s;v[%d]=%s\n", rank,
1680  ev[i].v, kv.klen, kbuf, kv.vlen, vbuf);
1681  }
1682  return MPI_SUCCESS;
1683 }
1684 
1685 void
1686 kmr_print_options(struct kmr_option opt)
1687 {
1688  printf(".nothreading=%d,"
1689  " .inspect=%d,"
1690  " .keep_open=%d,"
1691  " .key_as_rank=%d,"
1692  " .rank_zero=%d,"
1693  " .take_ckpt=%d,"
1694  " .collapse=%d\n",
1695  opt.nothreading,
1696  opt.inspect,
1697  opt.keep_open,
1698  opt.key_as_rank,
1699  opt.rank_zero,
1700  opt.collapse,
1701  opt.take_ckpt);
1702 }
1703 
1704 void
1705 kmr_print_file_options(struct kmr_file_option opt)
1706 {
1707  printf(".each_rank=%d,"
1708  " .subdirectories=%d,"
1709  " .list_file=%d,"
1710  " .shuffle_names=%d\n",
1711  opt.each_rank,
1712  opt.subdirectories,
1713  opt.list_file,
1714  opt.shuffle_names);
1715 }
1716 
1717 void
1718 kmr_print_spawn_options(struct kmr_spawn_option opt)
1719 {
1720  printf((".separator_space=%d,"
1721  " .reply_each=%d,"
1722  " .reply_root=%d,"
1723  " .one_by_one=%d,"
1724  " .take_ckpt=%d\n"),
1725  opt.separator_space,
1726  opt.reply_each,
1727  opt.reply_root,
1728  opt.one_by_one,
1729  opt.take_ckpt);
1730 }
1731 
1732 void
1733 kmr_print_string(char *msg, char *s, int len)
1734 {
1735  /* LEN includes terminating zero. */
1736  assert(len >= 1);
1737  printf("%s(len=%d)=", msg, len);
1738  for (int i = 0; i < len; i++) {
1739  if (s[i] == 0) {
1740  printf("$");
1741  } else if (isblank(s[i])) {
1742  printf("_");
1743  } else if (isprint(s[i])) {
1744  printf("%c", s[i]);
1745  } else {
1746  printf("?");
1747  }
1748  }
1749  printf("\n");
1750 }
1751 
1752 /* Opens a file for trace logging. */
1753 
1754 void
1755 kmr_open_log(KMR *mr)
1756 {
1757  assert(mr->log_traces == 0);
1758  int cc;
1759  char file[256];
1760  cc = snprintf(file, sizeof(file), "./%s_%05d",
1761  KMR_TRACE_FILE_PREFIX, mr->rank);
1762  assert(cc < (int)sizeof(file));
1763  mr->log_traces = fopen(file, "w");
1764  if (mr->log_traces == 0) {
1765  char ee[80];
1766  char *m = strerror(errno);
1767  snprintf(ee, sizeof(ee),
1768  "Opening log file (%s) failed"
1769  " (disable tracing): %s",
1770  file, m);
1771  kmr_warning(mr, 1, ee);
1772  mr->log_traces = 0;
1773  }
1774  if (mr->log_traces != 0) {
1775  time_t ct = time(0);
1776  char *cs = ctime(&ct);
1777  fprintf(mr->log_traces, "kmr trace (%s)\n", cs);
1778  }
1779 }
1780 
1781 /* Trace Logging. */
1782 
1783 void
1784 kmr_log_map(KMR *mr, KMR_KVS *kvs, struct kmr_kv_box *ev,
1785  long i, long cnt, kmr_mapfn_t m, double dt)
1786 {
1787  assert(mr->log_traces != 0);
1788  if (mr->atwork != 0) {
1789  struct kmr_code_line *info = mr->atwork;
1790  char s[32];
1791  kmr_dump_slot(ev->k, ev->klen, kvs->c.key_data, s, sizeof(s));
1792  fprintf(mr->log_traces,
1793  "file:%s, line:%d, kmr_func:%s,"
1794  " user_func:%p, key:[%ld/%ld]%s, time:%.lf\n",
1795  info->file, info->line, info->func,
1796  (void *)(intptr_t)m, (i + 1), cnt, s, (dt * 1000.0));
1797  }
1798 }
1799 
1800 /* Trace Logging. */
1801 
1802 void
1803 kmr_log_reduce(KMR *mr, KMR_KVS *kvs, struct kmr_kv_box *ev,
1804  long n, kmr_redfn_t r, double dt)
1805 {
1806  assert(mr->log_traces != 0);
1807  if (mr->atwork != 0) {
1808  struct kmr_code_line *info = mr->atwork;
1809  char s[32];
1810  kmr_dump_slot(ev->k, ev->klen, kvs->c.key_data, s, sizeof(s));
1811  fprintf(mr->log_traces,
1812  "file:%s, line:%d, kmr_func:%s,"
1813  " user_func:%p, key:[%ld]%s, time:%.lf\n",
1814  info->file, info->line, info->func,
1815  (void *)(intptr_t)r, n, s, (dt * 1000.0));
1816  }
1817 }
1818 
1819 /* ================================================================ */
1820 
1821 /* CONFIGURATION */
1822 
1823 /* Puts property into MPI_Info. B points to the key, and &B[VALPOS]
1824  points to the value. END points to one past the 0-terminator. */
1825 
1826 static int
1827 kmr_put_property(MPI_Info info, char *b, int valpos, int end)
1828 {
1829  char *k = b;
1830  char *v = &b[valpos];
1831  /*printf("setting \"%s\"=\"%s\"\n", b, &b[valpos]);*/
1832  if (k[0] == 0) {
1833  kmr_warning(0, 5, "empty key string for MPI_Info_set(), ignored");
1834  } else if (v[0] == 0) {
1835  /* OPEN MPI (1.6.4) DOES NOT ALLOW EMPTY VALUE. */
1836  kmr_warning(0, 5, "empty value string for MPI_Info_set(), ignored");
1837  } else {
1838  int cc = MPI_Info_set(info, b, &b[valpos]);
1839  assert(cc == MPI_SUCCESS);
1840  }
1841  return MPI_SUCCESS;
1842 }
1843 
1844 /** Loads properties into MPI_Info (in Latin1 characters). It runs
1845  only on the main-thread. It returns MPI_SUCCESS normally. It
1846  stores only Latin1 strings because MPI_Info does. Refer to the
1847  JDK document "java.util.Properties.load()" for the ".properties"
1848  format. */
1849 
1850 int
1851 kmr_load_properties(MPI_Info info, char *filename)
1852 {
1853 #define CONTNL 0x010000
1854 #define kmr_load_properties_check_getc_error(C) \
1855  if ((C) == EOF && errno != 0) { \
1856  char *e = strerror(errno); \
1857  snprintf(ee, sizeof(ee), "loading properties (%s), fgetc(): %s", \
1858  filename, e); \
1859  kmr_warning(0, 1, ee); \
1860  fclose(f); \
1861  free(b); \
1862  return MPI_ERR_ARG; \
1863  }
1864 #define kmr_load_properties_reset() \
1865  {pos = -1; valpos = -1; scan = ForKey;}
1866 #define kmr_load_properties_grow() \
1867  if (pos >= (blen - 1)) { \
1868  blen *= 2; b = realloc(b, (size_t)blen); assert(b != 0); }
1869 #define kmr_load_properties_putc(C) { \
1870  assert(pos != -1); \
1871  b[pos++] = (char)(C); kmr_load_properties_grow(); }
1872 #define kmr_load_properties_hex(C) \
1873  (('0' <= (C) && (C) <= '9') \
1874  ? ((C) - '0') \
1875  : (('a' <= (C) && (C) <= 'f') \
1876  ? ((C) - 'a') : ((C) - 'A')))
1877 #define kmr_load_properties_replace_cr() \
1878  if (c == '\r') { \
1879  int c1 = kmr_fgetc(f); \
1880  kmr_load_properties_check_getc_error(c1); \
1881  if (c1 != '\n') { \
1882  ungetc(c1, f); \
1883  } \
1884  c = '\n'; \
1885  }
1886 
1887  char ee[160];
1888  int blen = 4096;
1889  char *b = kmr_malloc((size_t)blen);
1890 
1891  FILE *f = kmr_fopen(filename, "r");
1892  if (f == 0) {
1893  char *e = strerror(errno);
1894  char *cwd = getcwd(b, 64);
1895  snprintf(ee, sizeof(ee), "loading properties, fopen(%s): %s (cwd=%s)",
1896  filename, e, (cwd == 0 ? "?" : cwd));
1897  kmr_warning(0, 1, ee);
1898  return MPI_ERR_ARG;
1899  }
1900 
1901  errno = 0;
1902  enum {ForKey, Com, Key, KeySkp, ForSep, ForVal, Val, ValSkp} scan = ForKey;
1903  int pos = -1;
1904  int valpos = -1;
1905  kmr_load_properties_reset();
1906  int lines = 0;
1907 
1908  for (;;) {
1909  _Bool escaped = 0;
1910  int c = kmr_fgetc(f);
1911  kmr_load_properties_check_getc_error(c);
1912  if (c == EOF) {
1913  switch (scan) {
1914  case ForKey:
1915  assert(pos == -1 && valpos == -1);
1916  break;
1917  case Com:
1918  assert(pos == -1 && valpos == -1);
1919  break;
1920  case Key: case KeySkp:
1921  assert(pos != -1 && valpos == -1);
1922  kmr_put_property(info, b, valpos, pos);
1923  break;
1924  case ForSep: case ForVal: case Val: case ValSkp:
1925  assert(pos != -1 && valpos != -1);
1926  kmr_put_property(info, b, valpos, pos);
1927  break;
1928  }
1929  break;
1930  }
1931 
1932  /* Replace '\r\n' as a single '\n'. */
1933  kmr_load_properties_replace_cr();
1934 
1935  switch (c) {
1936  case '\\':
1937  {
1938  /* Look at a backslash. */
1939  escaped = 1;
1940  c = kmr_fgetc(f);
1941  kmr_load_properties_check_getc_error(c);
1942  if (c == EOF) {
1943  snprintf(ee, sizeof(ee),
1944  ("loading properties (%s),"
1945  " file ends with a backslash"), filename);
1946  kmr_warning(0, 1, ee);
1947  fclose(f);
1948  free(b);
1949  return MPI_ERR_ARG;
1950  }
1951  switch (c) {
1952  case '\n':
1953  lines++;
1954  c = CONTNL;
1955  break;
1956 
1957  case 'n': case 'r': case 't': case 'f':
1958  switch (c) {
1959  case 'n': c = '\n'; break;
1960  case 'r': c = '\r'; break;
1961  case 't': c = '\t'; break;
1962  case 'f': c = '\f'; break;
1963  }
1964  break;
1965 
1966  case 'u':
1967  {
1968  int c0 = kmr_fgetc(f);
1969  int c1 = kmr_fgetc(f);
1970  int c2 = kmr_fgetc(f);
1971  int c3 = kmr_fgetc(f);
1972  if (c1 == EOF || c2 == EOF || c3 == EOF) {
1973  if (errno != 0) {
1974  char *e = strerror(errno);
1975  snprintf(ee, sizeof(ee),
1976  ("loading properties (%s),"
1977  " fgetc(): %s"),
1978  filename, e);
1979  kmr_warning(0, 1, ee);
1980  fclose(f);
1981  free(b);
1982  return MPI_ERR_ARG;
1983  } else {
1984  snprintf(ee, sizeof(ee),
1985  ("loading properties (%s),"
1986  " file ends amid unicode (at line %d)"),
1987  filename, (lines + 1));
1988  kmr_warning(0, 1, ee);
1989  fclose(f);
1990  free(b);
1991  return MPI_ERR_ARG;
1992  }
1993  }
1994  if (!(isxdigit(c0) && isxdigit(c1)
1995  && isxdigit(c2) && isxdigit(c3))) {
1996  snprintf(ee, sizeof(ee),
1997  ("loading properties (%s),"
1998  " file includes bad character"
1999  " in unicode (at line %d)"),
2000  filename, (lines + 1));
2001  kmr_warning(0, 1, ee);
2002  fclose(f);
2003  free(b);
2004  return MPI_ERR_ARG;
2005  }
2006  c = (kmr_load_properties_hex(c0) << 12);
2007  c |= (kmr_load_properties_hex(c1) << 8);
2008  c |= (kmr_load_properties_hex(c2) << 4);
2009  c |= kmr_load_properties_hex(c3);
2010  assert(c >= 0);
2011  if (c >= 256) {
2012  snprintf(ee, sizeof(ee),
2013  ("loading properties (%s),"
2014  " file includes non-latin character"
2015  " in unicode (at line %d)"),
2016  filename, (lines + 1));
2017  kmr_warning(0, 1, ee);
2018  fclose(f);
2019  free(b);
2020  return MPI_ERR_ARG;
2021  }
2022  }
2023  break;
2024 
2025  default:
2026  break;
2027  }
2028 
2029  if (c == CONTNL) {
2030  switch (scan) {
2031  case ForKey:
2032  assert(pos == -1 && valpos == -1);
2033  break;
2034  case Com:
2035  assert(pos == -1 && valpos == -1);
2036  scan = ForKey;
2037  break;
2038  case Key: case KeySkp:
2039  assert(pos != -1 && valpos == -1);
2040  scan = KeySkp;
2041  break;
2042  case ForSep: case ForVal:
2043  assert(pos != -1 && valpos != -1);
2044  break;
2045  case Val: case ValSkp:
2046  assert(pos != -1 && valpos != -1);
2047  scan = ValSkp;
2048  break;
2049  }
2050  break;
2051  }
2052  }
2053  /* Fall thru with reading c as an ordinary character. */
2054 
2055  default:
2056  /* Look at an ordinary character. */
2057  /* (c is not in {CONTNL, " \n\t\f#!=:"}) */
2058  if (iscntrl(c) && !escaped) {
2059  snprintf(ee, sizeof(ee),
2060  ("loading properties (%s),"
2061  " file includes bad control code (at line %d)"),
2062  filename, (lines + 1));
2063  kmr_warning(0, 1, ee);
2064  fclose(f);
2065  free(b);
2066  return MPI_ERR_ARG;
2067  }
2068  switch (scan) {
2069  case ForKey:
2070  assert(pos == -1 && valpos == -1);
2071  pos = 0;
2072  kmr_load_properties_putc(c);
2073  scan = Key;
2074  break;
2075  case Com:
2076  assert(pos == -1 && valpos == -1);
2077  /*skip*/
2078  break;
2079  case Key: case KeySkp:
2080  assert(pos != -1 && valpos == -1);
2081  kmr_load_properties_putc(c);
2082  scan = Key;
2083  break;
2084  case ForSep: case ForVal: case Val: case ValSkp:
2085  assert(pos != -1 && valpos != -1);
2086  kmr_load_properties_putc(c);
2087  scan = Val;
2088  break;
2089  }
2090  break;
2091 
2092  case '\n':
2093  lines++;
2094  switch (scan) {
2095  case ForKey:
2096  assert(pos == -1 && valpos == -1);
2097  /*skip*/
2098  break;
2099  case Com:
2100  assert(pos == -1 && valpos == -1);
2101  scan = ForKey;
2102  break;
2103  case Key: case KeySkp:
2104  assert(pos != -1 && valpos == -1);
2105  kmr_load_properties_putc('\0');
2106  valpos = pos;
2107  kmr_load_properties_putc('\0');
2108  kmr_put_property(info, b, valpos, pos);
2109  kmr_load_properties_reset();
2110  break;
2111  case ForSep: case ForVal: case Val: case ValSkp:
2112  assert(pos != -1 && valpos != -1);
2113  kmr_load_properties_putc('\0');
2114  kmr_put_property(info, b, valpos, pos);
2115  kmr_load_properties_reset();
2116  break;
2117  }
2118  break;
2119 
2120  case ' ': case '\t': case '\f':
2121  switch (scan) {
2122  case ForKey:
2123  assert(pos == -1 && valpos == -1);
2124  break;
2125  case Com:
2126  assert(pos == -1 && valpos == -1);
2127  break;
2128  case Key:
2129  assert(pos != -1 && valpos == -1);
2130  kmr_load_properties_putc('\0');
2131  valpos = pos;
2132  scan = ForSep;
2133  break;
2134  case KeySkp:
2135  assert(pos != -1 && valpos == -1);
2136  break;
2137  case ForSep: case ForVal:
2138  assert(pos != -1 && valpos != -1);
2139  break;
2140  case Val:
2141  assert(pos != -1 && valpos != -1);
2142  kmr_load_properties_putc(c);
2143  break;
2144  case ValSkp:
2145  assert(pos != -1 && valpos != -1);
2146  break;
2147  }
2148  break;
2149 
2150  case '#': case '!':
2151  switch (scan) {
2152  case ForKey:
2153  assert(pos == -1 && valpos == -1);
2154  scan = Com;
2155  break;
2156  case Com:
2157  assert(pos == -1 && valpos == -1);
2158  break;
2159  case Key: case KeySkp:
2160  assert(pos != -1 && valpos == -1);
2161  kmr_load_properties_putc(c);
2162  scan = Key;
2163  break;
2164  case ForSep: case ForVal: case Val: case ValSkp:
2165  assert(pos != -1 && valpos != -1);
2166  kmr_load_properties_putc(c);
2167  scan = Val;
2168  break;
2169  }
2170  break;
2171 
2172  case '=': case ':':
2173  switch (scan) {
2174  case ForKey:
2175  assert(pos == -1 && valpos == -1);
2176  pos = 0;
2177  kmr_load_properties_putc('\0');
2178  valpos = pos;
2179  scan = ForVal;
2180  break;
2181  case Com:
2182  assert(pos == -1 && valpos == -1);
2183  break;
2184  case Key: case KeySkp:
2185  assert(pos != -1 && valpos == -1);
2186  kmr_load_properties_putc('\0');
2187  valpos = pos;
2188  scan = ForVal;
2189  break;
2190  case ForSep:
2191  assert(pos != -1 && valpos != -1);
2192  scan = ForVal;
2193  break;
2194  case ForVal: case Val: case ValSkp:
2195  assert(pos != -1 && valpos != -1);
2196  kmr_load_properties_putc(c);
2197  scan = Val;
2198  break;
2199  }
2200  break;
2201  }
2202  }
2203 
2204  fclose(f);
2205  free(b);
2206  return MPI_SUCCESS;
2207 }
2208 
2209 /** Dumps simply contents in MPI_Info. */
2210 
2211 int
2212 kmr_dump_mpi_info(char *prefix, MPI_Info info)
2213 {
2214  int cc;
2215  int nkeys;
2216  cc = MPI_Info_get_nkeys(info, &nkeys);
2217  assert(cc == MPI_SUCCESS);
2218  for (int i = 0; i < nkeys; i++) {
2219  char key[MPI_MAX_INFO_KEY + 1];
2220  char value[MPI_MAX_INFO_VAL + 1];
2221  int vlen;
2222  int flag;
2223  cc = MPI_Info_get_nthkey(info, i, key);
2224  assert(cc == MPI_SUCCESS);
2225  cc = MPI_Info_get_valuelen(info, key, &vlen, &flag);
2226  assert(cc == MPI_SUCCESS && flag != 0);
2227  assert(vlen <= MPI_MAX_INFO_VAL);
2228  cc = MPI_Info_get(info, key, MPI_MAX_INFO_VAL, value, &flag);
2229  assert(cc == MPI_SUCCESS && flag != 0);
2230  printf("%s \"%s\"=\"%s\"\n", prefix, key, value);
2231  }
2232  return MPI_SUCCESS;
2233 }
2234 
2235 /** Copies contents of MPI_Info. The destination info is modified. */
2236 
2237 int
2238 kmr_copy_mpi_info(MPI_Info src, MPI_Info dst)
2239 {
2240  int cc;
2241  int nkeys;
2242  cc = MPI_Info_get_nkeys(src, &nkeys);
2243  assert(cc == MPI_SUCCESS);
2244  for (int i = 0; i < nkeys; i++) {
2245  char key[MPI_MAX_INFO_KEY + 1];
2246  char value[MPI_MAX_INFO_VAL + 1];
2247  int vlen;
2248  int flag;
2249  cc = MPI_Info_get_nthkey(src, i, key);
2250  assert(cc == MPI_SUCCESS);
2251  cc = MPI_Info_get_valuelen(src, key, &vlen, &flag);
2252  assert(cc == MPI_SUCCESS && flag != 0);
2253  assert(vlen <= MPI_MAX_INFO_VAL);
2254  cc = MPI_Info_get(src, key, MPI_MAX_INFO_VAL, value, &flag);
2255  assert(cc == MPI_SUCCESS && flag != 0);
2256  /*printf("\"%s\"=\"%s\"\n", key, value);*/
2257  cc = MPI_Info_set(dst, key, value);
2258  assert(cc == MPI_SUCCESS);
2259  }
2260  return MPI_SUCCESS;
2261 }
2262 
2263 /*
2264 Copyright (C) 2012-2016 RIKEN AICS
2265 This library is distributed WITHOUT ANY WARRANTY. This library can be
2266 redistributed and/or modified under the terms of the BSD 2-Clause License.
2267 */
Key-Value Stream (abstract).
Definition: kmr.h:587
char * kmr_stringify_options(struct kmr_option o)
Returns a print string of a single option, to check the bits are properly encoded in foreign language...
Definition: kmrutil.c:361
int kmr_local_element_count(KMR_KVS *kvs, long *v)
Gets the number of key-value pairs locally on each rank.
Definition: kmrutil.c:349
Utilities Private Part (do not include from applications).
Options to Mapping, Shuffling, and Reduction.
Definition: kmr.h:613
int kmr_load_properties(MPI_Info info, char *filename)
Loads properties into MPI_Info (in Latin1 characters).
Definition: kmrutil.c:1851
void * kmr_bsearch(const void *key, const void *base, size_t nel, size_t size, int(*compar)(const void *, const void *))
Searches a key entry like bsearch(3C), but returns a next greater entry instead of null on no match...
Definition: kmrutil.c:565
#define kmr_malloc(Z)
Allocates memory, or aborts when failed.
Definition: kmrimpl.h:177
#define KMR_TRACE_FILE_PREFIX
Prefix to Trace Files.
Definition: kmrimpl.h:101
#define kmr_create_kvs(MR, KF, VF)
Makes a new key-value stream (of type KMR_KVS) with the specified field datatypes.
Definition: kmr.h:71
int kmr_dump_kvs_stats(KMR_KVS *kvs, int level)
Dumps contents of a key-value stream, with values are pairs.
Definition: kmrutil.c:1659
int kmr_retrieve_kvs_entries(KMR_KVS *kvs, struct kmr_kvs_entry **ev, long n)
Fills local key-value entries in an array for inspection.
Definition: kmrbase.c:2801
Keyed-Record for Sorting.
Definition: kmr.h:372
int kmr_add_kv_done(KMR_KVS *kvs)
Marks finished adding key-value pairs.
Definition: kmrbase.c:881
Definition: kmr.h:348
KMR Context.
Definition: kmr.h:222
FILE * kmr_fopen(const char *n, const char *m)
Does fopen, avoiding EINTR.
Definition: kmrutil.c:610
char * kmr_stringify_file_options(struct kmr_file_option o)
Returns a print string of a single option, to check the bits are properly encoded in foreign language...
Definition: kmrutil.c:386
int kmr_free_kvs(KMR_KVS *kvs)
Releases a key-value stream (type KMR_KVS).
Definition: kmrbase.c:621
unsigned short kmr_k_position_t[4]
Positions of node by (X,Y,Z,ABC), with ABC axes collapsed.
Definition: kmrimpl.h:126
int kmr_k_node(KMR *mr, kmr_k_position_t p)
Gets TOFU position (physical coordinates) of the node.
Definition: kmrutil.c:441
int kmr_copy_kvs_to_info(KMR_KVS *kvi, MPI_Info dst)
Copies kvs entires into mpi-info.
Definition: kmrutil.c:1034
kmr_kv_field
Datatypes of Keys or Values.
Definition: kmr.h:325
int kmr_take_one(KMR_KVS *kvi, struct kmr_kv_box *kv)
Extracts a single key-value pair locally in the key-value stream KVI.
Definition: kmrbase.c:1369
#define kmr_map(KVI, KVO, ARG, OPT, M)
Maps simply.
Definition: kmr.h:82
Handy Copy of a Key-Value Field.
Definition: kmr.h:358
Options to Mapping by Spawns.
Definition: kmr.h:662
int kmr_get_element_count(KMR_KVS *kvs, long *v)
Gets the total number of key-value pairs.
Definition: kmrmoreops.c:114
char * kmr_strptr_ff(char *s)
Returns itself; this is for Fortran-binding.
Definition: kmrutil.c:208
int kmr_ckpt_disable_ckpt(KMR *)
It temporally disables checkpoint/restart.
Definition: kmrckpt.c:2494
void * kmr_strdup(char *s)
STRDUP, but aborts on failure.
Definition: kmrutil.c:592
int kmr_copy_info_to_kvs(MPI_Info src, KMR_KVS *kvo)
Copies mpi-info entires into kvs.
Definition: kmrutil.c:982
int kmr_getdtablesize(KMR *mr)
Does getdtablesize(); it is defined, because it is not Posix.
Definition: kmrutil.c:635
int kmr_fgetc(FILE *f)
Does fgetc, avoiding EINTR.
Definition: kmrutil.c:622
KMR Interface.
unsigned long kmr_fix_bits_endian_ff(unsigned long b)
Fixes little-endian bits used in Fortran to host-endian.
Definition: kmrutil.c:284
int kmr_map_rank_by_rank(KMR_KVS *kvi, KMR_KVS *kvo, void *arg, struct kmr_option opt, kmr_mapfn_t m)
Maps sequentially with rank by rank for debugging.
Definition: kmrbase.c:1339
Options to Mapping on Files.
Definition: kmr.h:638
int kmr_copy_mpi_info(MPI_Info src, MPI_Info dst)
Copies contents of MPI_Info.
Definition: kmrutil.c:2238
void kmr_dump_opaque(const char *p, int sz, char *buf, int buflen)
Puts the string of the key or value field into a buffer BUF as printable string.
Definition: kmrutil.c:1511
Unit-Sized Storage.
Definition: kmr.h:340
char * kmr_stringify_spawn_options(struct kmr_spawn_option o)
Returns a print string of a single option, to check the bits are properly encoded in foreign language...
Definition: kmrutil.c:405
int kmr_replicate(KMR_KVS *kvi, KMR_KVS *kvo, struct kmr_option opt)
Replicates key-value pairs to be visible on all ranks, that is, it has the effect of bcast or all-gat...
Definition: kmrbase.c:2182
int kmr_add_string(KMR_KVS *kvs, const char *k, const char *v)
Adds a key-value pair of strings.
Definition: kmrbase.c:913
int kmr_intstr_ff(long p, char *s, int n)
Fills the character array S by the contents at the pointer value integer P by the length N...
Definition: kmrutil.c:257
int kmr_dump_kv(const struct kmr_kv_box kv, const KMR_KVS *kvs, char *buf, int buflen)
Dumps contents of a key-value.
Definition: kmrutil.c:1585
static struct kmr_kv_box kmr_pick_kv(struct kmr_kvs_entry *e, KMR_KVS *kvs)
Returns a handle to a key-value entry – a reverse of kmr_poke_kv().
Definition: kmrimpl.h:551
int(* kmr_redfn_t)(const struct kmr_kv_box kv[], const long n, const KMR_KVS *kvi, KMR_KVS *kvo, void *arg)
Reduce-function Type.
Definition: kmr.h:700
int kmr_ckpt_enable_ckpt(KMR *, int)
It temporally enables checkpoint/restart which has been disabled by calling kmr_ckpt_disable_ckpt().
Definition: kmrckpt.c:2515
void kmr_string_truncation(KMR *mr, size_t sz, char *s)
Modifies the string end with by "..." for indicating truncation, used on the result of snprintf...
Definition: kmrutil.c:193
int kmr_copy_to_array_fn(const struct kmr_kv_box kv, const KMR_KVS *kvi, KMR_KVS *kvo, void *arg, const long i)
Copies the entry in the array.
Definition: kmrutil.c:934
Information of Source Code Line.
Definition: kmr.h:107
int(* kmr_mapfn_t)(const struct kmr_kv_box kv, const KMR_KVS *kvi, KMR_KVS *kvo, void *arg, const long index)
Map-function Type.
Definition: kmr.h:689
int kmr_dump_mpi_info(char *prefix, MPI_Info info)
Dumps simply contents in MPI_Info.
Definition: kmrutil.c:2212
int kmr_assert_sorted(KMR_KVS *kvi, _Bool locally, _Bool shuffling, _Bool ranking)
Checks a key-value stream is sorted.
Definition: kmrutil.c:702
int kmr_dump_kvs(KMR_KVS *kvs, int flag)
Dumps contents of a key-value stream to stdout.
Definition: kmrutil.c:1609