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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
include "../tcs.h"
# TCS_RDARY -- Read an array using the column selector
$if (datatype == c)
procedure tcs_rdaryt (tp, descrip, irow, maxch, maxbuf, nbuf, buffer)
$else
procedure tcs_rdary$t (tp, descrip, irow, maxbuf, nbuf, buffer)
$endif
pointer tp # i: table descriptor
pointer descrip # i: column selector
int irow # i: table row number
$if (datatype == c)
int maxch # i: max length of string
$endif
int maxbuf # i: declared length of buffer
int nbuf # o: length of output array
$if (datatype == c)
char buffer[maxch,ARB] # o: array of values
$else
PIXEL buffer[ARB] # o: array of values
$endif
#--
int idim, ndim, pdim, plen, psize, off
int axsize, axlen[MAXDIM], axpos[MAXDIM]
$if (datatype == c)
int tbagtt()
$else
int tbagt$t()
$endif
begin
if (TCS_DIMEN(descrip) == 0) {
# Column is a scalar, use a scalar read routine
if (maxbuf > 0) {
nbuf = 1
$if (datatype == c)
call tbegtt (tp, TCS_COLUMN(descrip), irow, buffer, maxch)
$else
call tbegt$t (tp, TCS_COLUMN(descrip), irow, buffer)
$endif
} else {
nbuf = 0
}
} else {
# Compute size and dimensionality of the largest contigous
# piece that can be read from the array
call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
pdim = 0
psize = 1
do idim = 1, TCS_DIMEN(descrip) {
if (TCS_INC(descrip,idim) > 1)
break
pdim = pdim + 1
plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
psize = psize * plen
if (plen < axlen[idim])
break
}
# Compute offset to first element to be read into array
off = 0
do idim = ndim-1, 1, -1
off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
off = off + TCS_FIRST(descrip,1)
# Save position of first element to be read in array
do idim = 1 , ndim
axpos[idim] = TCS_FIRST(descrip,idim)
nbuf = 1
repeat {
# Adjust piece size for possible overflow
if (nbuf + psize > maxbuf)
psize = maxbuf - (nbuf - 1)
# Read chunk from array
$if (datatype == c)
psize = tbagtt (tp, TCS_COLUMN(descrip), irow,
buffer[1,nbuf], maxch, off, psize)
$else
psize = tbagt$t (tp, TCS_COLUMN(descrip), irow,
buffer[nbuf], off, psize)
$endif
# Exit if array is full
nbuf = nbuf + psize
if (nbuf > maxbuf)
break
# Compute offset to next piece to read into array
axsize = 1
for (idim = 1; idim <= ndim; idim = idim + 1) {
if (idim > pdim) {
axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
if (axpos[idim] + TCS_INC(descrip,idim) <=
TCS_LAST(descrip,idim)) {
off = off + axsize * TCS_INC(descrip,idim)
break
} else {
axpos[idim] = TCS_FIRST(descrip,idim)
off = off - axsize * (TCS_LAST(descrip,idim) -
TCS_FIRST(descrip,idim))
}
}
axsize = axsize * axlen[idim]
}
# Exit if array has been traversed
if (idim > ndim)
break
}
nbuf = nbuf - 1
}
end
|
