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
|
include <tbset.h>
# WPROJECT -- Copy selected columns and rows to output table
#
# B.Simon 19-Oct-87 First Code
# B.Simon 30-Apr-1999 Replace call to unique with nextuniq
procedure wproject (itp, otp, numptr, colptr, uniq)
pointer itp # i: Input table descriptor
pointer otp # i: Output table descriptor
int numptr # i: Number of column pointers
pointer colptr[ARB] # i: Array of column pointers
bool uniq # i: Only output unique rows?
#--
int iptr, irow, jrow, nrow
int colnum[1], datatype[1], lendata[1], lenfmt[1]
pointer sp, ocp, newcol, colname, colunits, colfmt
int tbpsta()
begin
# Set up arrays in dynamic memory
call smark (sp)
call salloc (newcol, numptr, TY_INT)
call salloc (colname, SZ_COLNAME, TY_CHAR)
call salloc (colunits, SZ_COLUNITS, TY_CHAR)
call salloc (colfmt, SZ_COLFMT, TY_CHAR)
# Copy column information from the input table to the output table
do iptr = 1, numptr {
call tbcinf (colptr[iptr], colnum, Memc[colname], Memc[colunits],
Memc[colfmt], datatype[1], lendata[1], lenfmt[1])
call tbcdef (otp, ocp, Memc[colname], Memc[colunits], Memc[colfmt],
datatype[1], lendata[1], 1)
Memi[newcol+iptr-1] = ocp
}
# Copy the table columns a row at a time
call tbtcre (otp)
call tbhcal (itp, otp)
irow = 1
jrow = 1
nrow = tbpsta (itp, TBL_NROWS)
while (irow <= nrow) {
call tbrcsc (itp, otp, colptr, Memi[newcol], irow, jrow, numptr)
if (uniq) {
call nextuniq (itp, numptr, colptr, irow)
} else {
irow = irow + 1
}
jrow = jrow + 1
}
call sfree (sp)
end
|