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
|
include <tbset.h>
define HARMLESS 0.1d0
define MAXROWS 10000
# T_TCALC -- perform arithmetic operation on columns of a table
#
# B.Simon 03-May-91 Original
# B.Simon 24-Jun-97 Long columns done in pieces
# B.Simon 16-Jul-97 Error message for string columns
# B.Simon 30-Mar-00 Allow wild cards in table names
procedure t_tcalc()
#--
pointer table # input/output table name
pointer outcol # output column
pointer equals # expression
pointer colunits # output col units
pointer colfmt # output col format
pointer datatype # output col datatype
include "../tabvar.com"
bool done
double nil
pointer sp, tp, list, buffer, colptr, code
int nrows, nbuf, coltype, exptype
string badtype "Invalid data type for output column"
int tbnget(), tbpsta(), tbcigi()
pointer tbnopenp(), tbtopn(), vex_compile()
extern tabvar
begin
call smark (sp)
call salloc (table, SZ_FNAME, TY_CHAR)
call salloc (outcol, SZ_FNAME, TY_CHAR)
call salloc (equals, SZ_FNAME, TY_CHAR)
call salloc (datatype, SZ_FNAME, TY_CHAR)
call salloc (colunits, SZ_FNAME, TY_CHAR)
call salloc (colfmt, SZ_FNAME, TY_CHAR)
list = tbnopenp ("table")
call clgstr ("outcol", Memc[outcol], SZ_FNAME)
call clgstr ("equals", Memc[equals], SZ_FNAME)
code = vex_compile (Memc[equals])
while (tbnget (list, Memc[table], SZ_FNAME) != EOF) {
tp = tbtopn (Memc[table], READ_WRITE, 0)
nrows = tbpsta (tp, TBL_NROWS)
call tbcfnd (tp, Memc[outcol], colptr, 1)
if (colptr != NULL) {
coltype = tbcigi (colptr, TBL_COL_DATATYPE)
} else {
call clgstr ("datatype", Memc[datatype], SZ_FNAME)
call clgstr ("colunits", Memc[colunits], SZ_FNAME)
call clgstr ("colfmt" , Memc[colfmt], SZ_FNAME)
switch (Memc[datatype]) {
case 'r':
coltype = TY_REAL
case 'd':
coltype = TY_DOUBLE
case 's':
coltype = TY_SHORT
case 'i':
coltype = TY_INT
default:
call tbtclo (tp)
call error (1, badtype)
}
call tbbftp (Memc[colfmt], Memc[colfmt])
call tbcdef (tp, colptr, Memc[outcol], Memc[colunits],
Memc[colfmt], coltype, 1, 1)
}
# Initialize common block used by tabvar()
tabptr = tp
firstrow = 1
lastrow = MAXROWS
nullval = HARMLESS
done = false
nil = HARMLESS
repeat {
if (lastrow >= nrows) {
done = true
lastrow = nrows
}
nbuf = (lastrow - firstrow) + 1
call vex_eval (code, tabvar, nil, exptype)
switch (coltype) {
case TY_SHORT, TY_INT, TY_LONG:
call malloc (buffer, nbuf, TY_INT)
call vex_copyi (code, INDEFI, Memi[buffer], nbuf)
call tbcpti (tp, colptr, Memi[buffer], firstrow, lastrow)
call mfree (buffer, TY_INT)
case TY_REAL:
call malloc (buffer, nbuf, TY_REAL)
call vex_copyr (code, INDEFR, Memr[buffer], nbuf)
call tbcptr (tp, colptr, Memr[buffer], firstrow, lastrow)
call mfree (buffer, TY_REAL)
case TY_DOUBLE:
call malloc (buffer, nbuf, TY_DOUBLE)
call vex_copyd (code, INDEFD, Memd[buffer], nbuf)
call tbcptd (tp, colptr, Memd[buffer], firstrow, lastrow)
call mfree (buffer, TY_DOUBLE)
default:
call tbtclo (tp)
call error (1, badtype)
}
firstrow = firstrow + MAXROWS
lastrow = lastrow + MAXROWS
} until (done)
call tbtclo(tp)
}
call vex_free (code)
call sfree (sp)
end
|
