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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
|
# This file contains ttr_trans and ttr_flip. The former copies data
# from one table to another and transposes rows and columns, while the
# latter copies data without transposing. Either routine may also flip
# rows and/or columns, i.e. first input row to last output row, or first
# input column to last input column.
#
# Phil Hodge, 30-Nov-1994 Subroutines created.
# ttr_trans -- copy data from input to output
# This routine transposes a table.
procedure ttr_trans (itp, otp, icp, ocp,
irows, icols, orows, ocols, op, dtype, nelem)
pointer itp # i: pointer to input table struct
pointer otp # i: pointer to output table struct
pointer icp[icols] # i: array of pointers to input column descriptors
pointer ocp[irows] # i: array of pointers to output column descriptors
int irows # i: number of rows in input table
int icols # i: number of columns in input table
int orows # i: number of rows in output table
int ocols # i: number of columns in output table
int op[2] # i: mapping of (columns,rows) from input to output
int dtype # i: data type of column
int nelem # i: length of array stored at each row,column
#--
pointer sp
pointer buf # scratch for copying array entries
int clen # length of char string (= -dtype)
int i, j # loop indices for input table
int oi, oj # loop indices for output table
int oj_start # starting value for oj
int oi_incr, oj_incr # increments in oi, oj
# buffers for copying one element:
pointer cbuf
double dbuf
real rbuf
int ibuf
short sbuf
bool bbuf
int nret # number of array elements actually read and written
int tbagtd(), tbagtr(), tbagti(), tbagts(), tbagtb(), tbagtt()
errchk tbegtd, tbegtr, tbegti, tbegts, tbegtb, tbegtt,
tbeptd, tbeptr, tbepti, tbepts, tbeptb, tbeptt,
tbagtd, tbagtr, tbagti, tbagts, tbagtb, tbagtt,
tbaptd, tbaptr, tbapti, tbapts, tbaptb, tbaptt
begin
call smark (sp)
# Assign values for the beginning and increment for the loops
# on oi and oj.
if (op[1] > 0) {
oi = 1
oi_incr = 1
} else {
oi = ocols # = irows
oi_incr = -1
}
if (op[2] > 0) {
oj_start = 1
oj_incr = 1
} else {
oj_start = orows # = icols
oj_incr = -1
}
if (dtype < 0)
clen = -dtype
if (nelem == 1) {
if (dtype == TY_REAL) {
do j = 1, irows {
oj = oj_start # oj, not oi, because we're transposing
do i = 1, icols {
call tbegtr (itp, icp[i], j, rbuf)
call tbeptr (otp, ocp[oi], oj, rbuf)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_DOUBLE) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
call tbegtd (itp, icp[i], j, dbuf)
call tbeptd (otp, ocp[oi], oj, dbuf)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_INT) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
call tbegti (itp, icp[i], j, ibuf)
call tbepti (otp, ocp[oi], oj, ibuf)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_SHORT) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
call tbegts (itp, icp[i], j, sbuf)
call tbepts (otp, ocp[oi], oj, sbuf)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_BOOL) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
call tbegtb (itp, icp[i], j, bbuf)
call tbeptb (otp, ocp[oi], oj, bbuf)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype < 0) {
call salloc (cbuf, SZ_LINE, TY_CHAR)
do j = 1, irows {
oj = oj_start
do i = 1, icols {
call tbegtt (itp, icp[i], j, Memc[cbuf], SZ_LINE)
call tbeptt (otp, ocp[oi], oj, Memc[cbuf])
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else {
call error (1, "invalid data type")
}
} else { # each entry is an array
if (dtype > 0)
call salloc (buf, nelem, dtype)
if (dtype == TY_REAL) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagtr (itp, icp[i], j, Memr[buf], 1, nelem)
call tbaptr (otp, ocp[oi], oj, Memr[buf], 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_DOUBLE) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagtd (itp, icp[i], j, Memd[buf], 1, nelem)
call tbaptd (otp, ocp[oi], oj, Memd[buf], 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_INT) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagti (itp, icp[i], j, Memi[buf], 1, nelem)
call tbapti (otp, ocp[oi], oj, Memi[buf], 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_SHORT) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagts (itp, icp[i], j, Mems[buf], 1, nelem)
call tbapts (otp, ocp[oi], oj, Mems[buf], 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype == TY_BOOL) {
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagtb (itp, icp[i], j, Memb[buf], 1, nelem)
call tbaptb (otp, ocp[oi], oj, Memb[buf], 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else if (dtype < 0) {
call salloc (buf, (clen+1) * nelem, TY_CHAR) # add 1 for EOS
do j = 1, irows {
oj = oj_start
do i = 1, icols {
nret = tbagtt (itp, icp[i], j, Memc[buf], clen,
1, nelem)
call tbaptt (otp, ocp[oi], oj, Memc[buf], clen, 1, nret)
oj = oj + oj_incr
}
oi = oi + oi_incr
}
} else {
call error (1, "invalid data type")
}
}
call sfree (sp)
end
# ttr_flip -- copy data from input to output
# This routine copies a table without transposing.
# irows and icols are the numbers of rows and columns in both the
# input and output tables.
# Note that if we are reversing the order of the columns (horizontal flip),
# the last column of the input table was defined first, so the flip in
# column order is taken care of by the relative order of the elements of
# the arrays icp and ocp.
procedure ttr_flip (itp, otp, icp, ocp, irows, icols, op)
pointer itp # i: pointer to input table struct
pointer otp # i: pointer to output table struct
pointer icp[icols] # i: array of pointers to input column descriptors
pointer ocp[ARB] # i: array of pointers to output column descriptors
int irows # i: number of rows in input table
int icols # i: number of columns in input table
int op[2] # i: mapping of (columns,rows) from input to output
#--
int j # loop index for input row number
int oj, oj_incr # loop index and increment for output row number
errchk tbrcpy, tbrcsc
begin
# Assign values for the beginning and increment for the loop
# on output row number.
if (op[2] > 0) {
oj = 1
oj_incr = 1
} else {
oj = irows
oj_incr = -1
}
# Copy the data from input to output.
if (op[1] > 0) {
# Retain column order.
do j = 1, irows {
call tbrcpy (itp, otp, j, oj)
oj = oj + oj_incr
}
} else { # op[1] < 0
# Reverse column order.
do j = 1, irows {
call tbrcsc (itp, otp, icp, ocp, j, oj, icols)
oj = oj + oj_incr
}
}
end
|
