87 |
$ setitimer(ITIMER_REAL, &value, NULL); |
$ setitimer(ITIMER_REAL, &value, NULL); |
88 |
$ } |
$ } |
89 |
$ |
$ |
90 |
|
$ static char hostname_string[75]; |
91 |
$ static char *hostname_id() |
$ static char *hostname_id() |
92 |
$ { char host[75], out[75]; |
$ { char host[75]; |
93 |
$ int res, rank; |
$ int res, rank; |
94 |
$ res = gethostname(host, sizeof(host)/sizeof(char)); |
$ res = gethostname(host, sizeof(host)/sizeof(char)); |
95 |
$ MPI_Initialized(&rank); |
$ MPI_Initialized(&rank); |
97 |
$ MPI_Comm_rank(MPI_COMM_WORLD, &rank); |
$ MPI_Comm_rank(MPI_COMM_WORLD, &rank); |
98 |
$ else rank = -1; |
$ else rank = -1; |
99 |
$ if (res == -1) { |
$ if (res == -1) { |
100 |
$ perror(res); |
$ perror("ParGCL: gethostname"); |
101 |
$ sprintf(host, "<unknown name>"); } |
$ sprintf(host, "<unknown name>"); } |
102 |
$ sprintf(out, "Processor %s (MPI rank/ID: %d)", host, rank); |
$ sprintf(hostname_string, "Processor %s (MPI rank/ID: %d)", host, rank); |
103 |
$ return out; |
$ return hostname_string; |
104 |
$ } |
$ } |
105 |
$ |
$ |
106 |
$ /* CCS modems dysfunctional again; check later if these have |
$ /* CCS modems dysfunctional again; check later if these have |
116 |
$ object array; |
$ object array; |
117 |
${ /* if ((enum type)type_map[page(array->st.st_self)] == t_contiguous) */ |
${ /* if ((enum type)type_map[page(array->st.st_self)] == t_contiguous) */ |
118 |
$ if (inheap(array->st.st_self)) |
$ if (inheap(array->st.st_self)) |
119 |
$ /* wfs recommends: if inheap(x->st.st_dim) |
$ /* wfs recommends: if inheap(x->st.st_dim) */ |
120 |
$ /*"since it might be that the string is in a saved image [where contig |
$ /*"since it might be that the string is in a saved image [where contig */ |
121 |
$ /* and relblock get converted to t_other and not gc'd], and so to be safe |
$ /* and relblock get converted to t_other and not gc'd], and so to be safe */ |
122 |
$ /* in those cases make this be contiguous.." */ |
$ /* in those cases make this be contiguous.." */ |
123 |
$ return Ct; |
$ return Ct; |
124 |
$ else return Cnil; |
$ else return Cnil; |
236 |
("int i" |
("int i" |
237 |
"char **argv" |
"char **argv" |
238 |
"MPI_Initialized(&i)" |
"MPI_Initialized(&i)" |
239 |
"if (i) {printf(\"MPI already initialized\\n\"); return;}" |
"if (i) {printf(\"MPI already initialized\\n\"); return -1;}" |
240 |
"argv = (char **)argv_obj->v.v_self" |
"argv = (char **)argv_obj->v.v_self" |
241 |
"for (i=0; i<argc; i++) argv[i] = (char *)((object)argv[i])->ust.ust_self" |
"for (i=0; i<argc; i++) argv[i] = (char *)((object)argv[i])->ust.ust_self" |
242 |
"/* master will remove p4 flags from argv & decrement argc */" |
"/* master will remove p4 flags from argv & decrement argc */" |
254 |
"else signal(SIGINT, SIG_IGN) /* else slave */" |
"else signal(SIGINT, SIG_IGN) /* else slave */" |
255 |
"signal( SIGALRM, &timeout ) /* assumes SIGALRM not used by GCL/GAP */" |
"signal( SIGALRM, &timeout ) /* assumes SIGALRM not used by GCL/GAP */" |
256 |
"signal( SIGBUS, &debug_test ); signal( SIGSEGV, &debug_test )" |
"signal( SIGBUS, &debug_test ); signal( SIGSEGV, &debug_test )" |
257 |
"settimer()") |
"settimer()" |
258 |
|
"return 0") |
259 |
"int returned; Single arg is a list of p4-style flags: |
"int returned; Single arg is a list of p4-style flags: |
260 |
ex.: '(\"-p4pg\" \"procgroup\" \"-p4dbg\" 99 \"-p4rdbg\" 99))" |
ex.: '(\"-p4pg\" \"procgroup\" \"-p4dbg\" 99 \"-p4rdbg\" 99))" |
261 |
) |
) |
323 |
(MPI-Get-processor-name-glue string) |
(MPI-Get-processor-name-glue string) |
324 |
((object "MPI_Get_processor_name_glue") (object string)) |
((object "MPI_Get_processor_name_glue") (object string)) |
325 |
("int resultlen" |
("int resultlen" |
326 |
"MPI_Get_processor_name((unsigned char *)string->st.st_self, &resultlen)" |
"MPI_Get_processor_name((char *)string->st.st_self, &resultlen)" |
327 |
"if (string->v.v_hasfillp) (string->st.st_fillp)=resultlen" |
"if (string->v.v_hasfillp) (string->st.st_fillp)=resultlen" |
328 |
"return(string)") |
"return(string)") |
329 |
"args: string; returns name in string. |
"args: string; returns name in string. |
343 |
|
|
344 |
(defglue (MPI-Abort errorcode) |
(defglue (MPI-Abort errorcode) |
345 |
((int "MPI_Abort_glue") (int errorcode)) |
((int "MPI_Abort_glue") (int errorcode)) |
346 |
("MPI_Abort(MPI_COMM_WORLD, errorcode)") |
("return MPI_Abort(MPI_COMM_WORLD, errorcode)") |
347 |
"errorcode arg; causes all processes to abort and return errorcode") |
"errorcode arg; causes all processes to abort and return errorcode") |
348 |
|
|
349 |
(defglue |
(defglue |
429 |
(getcwd (&optional (string (make-fill-string 256)))) |
(getcwd (&optional (string (make-fill-string 256)))) |
430 |
(getcwd-glue string) |
(getcwd-glue string) |
431 |
((object "mygetcwd") (object string)) |
((object "mygetcwd") (object string)) |
432 |
("char *cwd, *getcwd(), *buf" |
("char *cwd, *getcwd()" |
433 |
|
;;char *buf; |
434 |
;;if (type_of(vs_base[0]) == t_array) { |
;;if (type_of(vs_base[0]) == t_array) { |
435 |
;; vs_base[0]->a.a_dims[0] |
;; vs_base[0]->a.a_dims[0] |
436 |
;; } else { |
;; } else { |
450 |
(defglue |
(defglue |
451 |
(chdir (object path)) |
(chdir (object path)) |
452 |
((object "mychdir") (object path)) |
((object "mychdir") (object path)) |
453 |
("if (chdir((unsigned char *)path->st.st_self) == -1) {perror (\"chdir\"); return Cnil;}" |
("if (chdir((char *)path->st.st_self) == -1) {perror (\"chdir\"); return Cnil;}" |
454 |
"return Ct") |
"return Ct") |
455 |
"returns t if chdir was successful, else nil") |
"returns t if chdir was successful, else nil") |
456 |
|
|
459 |
|
|
460 |
(defglue |
(defglue |
461 |
(nice (int prio)) |
(nice (int prio)) |
462 |
((int "nice") (int prio)) |
((int "nice_internal") (int prio)) |
463 |
("int oldprio, success" |
("int oldprio, success" |
464 |
"oldprio = getpriority(PRIO_PROCESS,getpid())" |
"oldprio = getpriority(PRIO_PROCESS,getpid())" |
465 |
"success = setpriority(PRIO_PROCESS,getpid(),prio)" |
"success = setpriority(PRIO_PROCESS,getpid(),prio)" |