int main() { pid_t pid = fork(); if (pid < 0) { fprintf(stderr, "error: fork(%d) %s\n", errno, strerror(errno)); return -1; } else if (pid == 0) { // child proc cproc(); _exit(-1); } else { // this proc fprintf(stderr, "wait cproc\n"); // If wait() returns due to a stopped or terminated child process, the process ID of the child is returned to the calling process. // Otherwise, a value of -1 is returned and errno is set to indicate the error. int status; if (waitpid(pid, &status, 0) < 0) { fprintf(stderr, "error: waitpid(%d) %s\n", errno, strerror(errno)); return 1; } if (WIFEXITED(status)) { int s = WEXITSTATUS(status); fprintf(stderr, "cproc's status=%04x\n", status); return s; } else { fprintf(stderr, "cproc's status=%04x\n", status); return 1; } } }
int scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what) { int (*cproc) () = cproc_ptr; SCM z, va0, lva, *plva; int k, kmax, kroll; ssize_t *vi, inc; size_t len; /* Prepare reference argument. */ if (SCM_I_ARRAYP (ra0)) { kmax = SCM_I_ARRAY_NDIM (ra0)-1; inc = kmax < 0 ? 0 : SCM_I_ARRAY_DIMS (ra0)[kmax].inc; va0 = make1array (SCM_I_ARRAY_V (ra0), inc); /* Find unroll depth */ for (kroll = max(0, kmax); kroll > 0; --kroll) { inc *= (UBND (ra0, kroll) - LBND (ra0, kroll) + 1); if (inc != SCM_I_ARRAY_DIMS (ra0)[kroll-1].inc) break; } } else { kroll = kmax = 0; va0 = ra0 = make1array (ra0, 1); } /* Prepare rest arguments. */ lva = SCM_EOL; plva = &lva; for (z = lra; !scm_is_null (z); z = SCM_CDR (z)) { SCM va1, ra1 = SCM_CAR (z); if (SCM_I_ARRAYP (ra1)) { if (kmax != SCM_I_ARRAY_NDIM (ra1) - 1) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); inc = kmax < 0 ? 0 : SCM_I_ARRAY_DIMS (ra1)[kmax].inc; va1 = make1array (SCM_I_ARRAY_V (ra1), inc); /* Check unroll depth. */ for (k = kmax; k > kroll; --k) { ssize_t l0 = LBND (ra0, k), u0 = UBND (ra0, k); if (l0 < LBND (ra1, k) || u0 > UBND (ra1, k)) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); inc *= (u0 - l0 + 1); if (inc != SCM_I_ARRAY_DIMS (ra1)[k-1].inc) { kroll = k; break; } } /* Check matching of not-unrolled axes. */ for (; k>=0; --k) if (LBND (ra0, k) < LBND (ra1, k) || UBND (ra0, k) > UBND (ra1, k)) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); } else { if (kmax != 0) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); va1 = make1array (ra1, 1); if (LBND (ra0, 0) < LBND (va1, 0) || UBND (ra0, 0) > UBND (va1, 0)) scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 (ra0)); } *plva = scm_cons (va1, SCM_EOL); plva = SCM_CDRLOC (*plva); } /* Check emptiness of not-unrolled axes. */ for (k = 0; k < kroll; ++k) if (0 == (UBND (ra0, k) - LBND (ra0, k) + 1)) return 1; /* Set unrolled size. */ for (len = 1; k <= kmax; ++k) len *= (UBND (ra0, k) - LBND (ra0, k) + 1); UBND (va0, 0) = len - 1; for (z = lva; !scm_is_null (z); z = SCM_CDR (z)) UBND (SCM_CAR (z), 0) = len - 1; /* Set starting indices and go. */ vi = scm_gc_malloc_pointerless (sizeof(ssize_t) * kroll, vi_gc_hint); for (k = 0; k < kroll; ++k) vi[k] = LBND (ra0, k); do { if (k == kroll) { SCM y = lra; SCM_I_ARRAY_SET_BASE (va0, cindk (ra0, vi, kroll)); for (z = lva; !scm_is_null (z); z = SCM_CDR (z), y = SCM_CDR (y)) SCM_I_ARRAY_SET_BASE (SCM_CAR (z), cindk (SCM_CAR (y), vi, kroll)); if (! (SCM_UNBNDP (data) ? cproc (va0, lva) : cproc (va0, data, lva))) return 0; --k; } else if (vi[k] < UBND (ra0, k)) { ++vi[k]; ++k; } else { vi[k] = LBND (ra0, k) - 1; --k; } } while (k >= 0); return 1; }