/[gcl]/gcl/pargcl/src/mpi_glue.lsp
ViewVC logotype

Diff of /gcl/pargcl/src/mpi_glue.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by gene, Fri Oct 28 23:00:29 2005 UTC revision 1.2 by gene, Sat Oct 29 05:12:15 2005 UTC
# Line 87  $   value.it_value.tv_sec = logout_time Line 87  $   value.it_value.tv_sec = logout_time
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);
# Line 96  $    if ( rank == 1) Line 97  $    if ( rank == 1)
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
# Line 115  $ static object staticp(array) Line 116  $ static object staticp(array)
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;
# Line 235  $ static int MPI_Any_Tag () { return MPI Line 236  $ static int MPI_Any_Tag () { return MPI
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 */"
# Line 253  $ static int MPI_Any_Tag () { return MPI Line 254  $ static int MPI_Any_Tag () { return MPI
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    )    )
# Line 321  $ static int MPI_Any_Tag () { return MPI Line 323  $ static int MPI_Any_Tag () { return MPI
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.
# Line 341  $ static int MPI_Any_Tag () { return MPI Line 343  $ static int MPI_Any_Tag () { return MPI
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
# Line 427  $ static int MPI_Any_Tag () { return MPI Line 429  $ static int MPI_Any_Tag () { return MPI
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 {
# Line 447  $ static int MPI_Any_Tag () { return MPI Line 450  $ static int MPI_Any_Tag () { return MPI
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    
# Line 456  $ static int MPI_Any_Tag () { return MPI Line 459  $ static int MPI_Any_Tag () { return MPI
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)"

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26