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
|
include <tbset.h>
# TXTCPY -- Copy data from single row in 3D table to columns
# in the output 2D table.
#
#
# This code is adapted from B.Simon's 04-Nov-94 version of tcopy.
#
#
#
# Revision history:
# ----------------
#
# 22-Nov-96 - Task created (I.Busko)
procedure txtcpy (itp, otp, irow, icp, ocp, ncols, compact)
pointer itp # i: pointer to descriptor of input table
pointer otp # i: pointer to descriptor of output table
int irow # i: row in input table
pointer icp[ncols] # i: array of pointers for input columns
pointer ocp[ncols] # i: array of pointers for output columns
int ncols # i: number of columns in input table
bool compact # i: write scalars as header keywords ?
#--
int icol, dlen, dtype, maxlen, maxch, nbuf
pointer sp, buf, errmsg, colname
string badtype "Unsupported column data type (%s)"
int tcs_intinfo(), tcs_totsize()
begin
# Number of rows in output table must match the
# largest array size in input table.
maxlen = 0
do icol = 1, ncols {
dlen = tcs_totsize (icp[icol])
if (dlen > maxlen)
maxlen = dlen
}
# Main loop: process each column.
do icol = 1, ncols {
# Determine datatype of table column
# and allocate a buffer to match.
dtype = tcs_intinfo (icp[icol], TBL_COL_DATATYPE)
maxch = 1
if (dtype < 0) {
maxch = - dtype
dtype = TY_CHAR
}
call smark (sp)
call salloc (buf, maxlen*(maxch + 1), dtype)
# Read data from input table and
# write it to output table.
switch (dtype) {
case TY_BOOL:
call tcs_rdaryb (itp, icp[icol], irow, maxlen, nbuf, Memb[buf])
call txtcptb (otp, ocp[icol], Memb[buf], 1, nbuf, icol, compact)
case TY_CHAR:
call tcs_rdaryt (itp, icp[icol], irow, maxch, maxlen,
nbuf, Memc[buf])
call txtcptt (otp, ocp[icol], Memc[buf], maxch, 1, nbuf,
icol, compact)
case TY_SHORT:
call tcs_rdarys (itp, icp[icol], irow, maxlen, nbuf, Mems[buf])
call txtcpts (otp, ocp[icol], Mems[buf], 1, nbuf, icol, compact)
case TY_INT, TY_LONG:
call tcs_rdaryi (itp, icp[icol], irow, maxlen, nbuf, Memi[buf])
call txtcpti (otp, ocp[icol], Memi[buf], 1, nbuf, icol, compact)
case TY_REAL:
call tcs_rdaryr (itp, icp[icol], irow, maxlen, nbuf, Memr[buf])
call txtcptr (otp, ocp[icol], Memr[buf], 1, nbuf, icol, compact)
case TY_DOUBLE:
call tcs_rdaryd (itp, icp[icol], irow, maxlen, nbuf, Memd[buf])
call txtcptd (otp, ocp[icol], Memd[buf], 1, nbuf, icol, compact)
default:
# Unsupported type, write error message
call salloc (colname, SZ_COLNAME, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
call tcs_txtinfo (icp[icol], TBL_COL_NAME,
Memc[colname], SZ_COLNAME)
call sprintf (Memc[errmsg], SZ_LINE, badtype)
call pargstr (Memc[colname])
call error (1, Memc[errmsg])
}
call sfree (sp)
}
end
|
