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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
include <tbset.h>
# tbcga[] -- get an array of elements
# This routine gets an array of values, all elements from all selected rows.
# The number of elements in one row may have been reduced by the use of an
# array section, however, in which case only elements in the section will
# be copied to output.
#
# The function value will be the actual number of elements returned
# in the output buffer. It is an error if the output buffer is not
# large enough to contain all of the values.
#
# Phil Hodge, 5-Mar-1998 Function created.
# Phil Hodge, 18-Jun-1998 Error check the subroutines.
int procedure tbcgad (tp, cp, buffer, nelem)
pointer tp # i: pointer to table descriptor
pointer cp # i: pointer to column descriptor
double buffer[ARB] # o: values read from table
int nelem # i: maximum number of elements to read
#--
pointer descrip # column selector descriptor
int nrows # number of selected rows
int row # loop index for selected row number
int nvals # number of elements in one cell
int nret # number returned, should be the same as nvals
int i
int tbagtd()
errchk tbagtd(), tbegtd(), tcs_rdaryd()
begin
# Get descrip, nvals, and nrows.
call tbcnel1 (tp, cp, descrip, nvals, nrows)
# Set nret because tbegtd doesn't return it.
if (nvals == 1)
nret = 1
if (nvals * nrows > nelem)
call error (1, "tbcgad: output buffer is too small")
i = 1
do row = 1, nrows {
if (descrip == NULL) {
if (nvals == 1)
call tbegtd (tp, cp, row, buffer[i])
else
nret = tbagtd (tp, cp, row, buffer[i], 1, nvals)
} else {
call tcs_rdaryd (tp, descrip, row, nelem-i+1, nret, buffer[i])
}
if (nret != nvals)
call error (1, "tbcgad: not all elements read from column")
i = i + nvals
}
return (i - 1)
end
int procedure tbcgar (tp, cp, buffer, nelem)
pointer tp # i: pointer to table descriptor
pointer cp # i: pointer to column descriptor
real buffer[ARB] # o: values read from table
int nelem # i: maximum number of elements to read
#--
pointer descrip # column selector descriptor
int nrows # number of selected rows
int row # loop index for selected row number
int nvals # number of elements in one cell
int nret # number returned, should be the same as nvals
int i
int tbagtr()
errchk tbagtr(), tbegtr(), tcs_rdaryr()
begin
# Get descrip, nvals, and nrows.
call tbcnel1 (tp, cp, descrip, nvals, nrows)
# Set nret because tbegtd doesn't return it.
if (nvals == 1)
nret = 1
if (nvals * nrows > nelem)
call error (1, "tbcgar: output buffer is too small")
i = 1
do row = 1, nrows {
if (descrip == NULL) {
if (nvals == 1)
call tbegtr (tp, cp, row, buffer[i])
else
nret = tbagtr (tp, cp, row, buffer[i], 1, nvals)
} else {
call tcs_rdaryr (tp, descrip, row, nelem-i+1, nret, buffer[i])
}
if (nret != nvals)
call error (1, "tbcgar: not all elements read from column")
i = i + nvals
}
return (i - 1)
end
|