1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
/* $Id: Pvmftasks.c,v 1.1 1997/06/27 16:34:40 pvmsrc Exp $ */
#ifdef WIN32
#include "..\..\include\pvm3.h"
#include "..\..\src\pvmwin.h"
#else
#include "pvm3.h"
#endif
#include "pvm_consts.h"
#include "../../src/bfunc.h"
void /*__stdcall*/ __fortran
PVMFTASKS
(where,
ntaskp,
tidp,
ptidp,
hostp,
flagp,
a_out_ptr,a_out_len,
infop)
int *where, *ntaskp, *tidp, *ptidp, *hostp, *flagp, *infop;
char * a_out_ptr; int a_out_len;
{
static struct pvmtaskinfo *tip = 0;
static int ntask = 0;
static int next = 0;
int cc;
struct pvmtaskinfo *tip2;
#ifndef WIN32
char *malloc();
#endif
/* if user sets ntaskp to -1 then pvmftasks() will be reset */
if (tip && (*ntaskp == -1)) {
free((char*)tip);
tip = 0;
}
if (!tip) {
if ((cc = pvm_tasks(*where, &ntask, &tip2)) < 0) {
*infop = cc;
return;
}
tip = (struct pvmtaskinfo*)malloc(ntask * sizeof(struct pvmtaskinfo));
BCOPY((char*)tip2, (char*)tip, ntask * sizeof(struct pvmtaskinfo));
next = 0;
}
if (next < ntask) {
*ntaskp = ntask;
*tidp = tip[next].ti_tid;
*ptidp = tip[next].ti_ptid;
*hostp = tip[next].ti_host;
*flagp = tip[next].ti_flag;
ctofstr(a_out_ptr, a_out_len, tip[next].ti_a_out);
*infop = 1;
next++;
}
/* can not return ti_pid without changing interface */
/* users needing this will have to use C */
if (next == ntask) {
free((char*)tip);
tip = 0;
}
}
|
