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
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
include "tbtables.h" # for TBL_IS_INDEFD
include <tbset.h>
# TBRCMP -- Comparison function used to sort table rows
#
# This procedure returns an integer indicating the order of two rows.
# The value of the integer is set according to the following scheme:
#
# if row1 < row2, order = -1
# if row1 == row2, order = 0
# if row1 > row2, order = 1
#
# The comparison is done on the columns whose pointers are passed in the
# colptr array. The first column in the array is the most significant.
# Subsequent columns are used to break ties in the order of the previous
# columns. Nulls are considered to be larger than any other value. Case is
# ignored in the sort order if fold is set to true.
#
# A column that contains arrays is treated much like an array of columns.
# The arrays of values for the two rows are gotten, and they are compared
# element by element. The first element that does not match determines
# the order. One aspect of this that may not be intuitive is that if one
# array is padded with nulls to make it effectively shorter than the other,
# and the non-null elements all match, the shorter array will be considered
# to be larger, since nulls are larger than any other value.
#
# B.Simon 22-Jan-1990 First Code
# Phil Hodge 22-Jan-1993 Use IS_INDEF instead of == INDEF.
# Phil Hodge 1-Apr-1993 Include short datatype.
# Phil Hodge 2-Jun-1997 Replace IS_INDEFD with TBL_IS_INDEFD.
# Phil Hodge 18-Jan-1999 Add a section for comparing arrays;
# get boolean as short and check for indef.
int procedure tbrcmp (tp, numcols, colptr, fold, row1, row2)
pointer tp # i: Table descriptor
int numcols # i: Number of columns to sort on
pointer colptr[ARB] # i: Array of column descriptors
bool fold # i: Fold upper and lower case when sorting
int row1 # i: Index to first row to compare
int row2 # i: Index to second row to compare
#--
int datatype # data type of column
int nelem # number of elements in array (or one if scalar)
double dval1, dval2
int ival1, ival2
short sval1, sval2
pointer str1, str2
real rval1, rval2
pointer sp2 # stack pointer for ptr1 & ptr2
pointer ptr1, ptr2 # pointers to arrays of values
int i # loop index
int icol, order
pointer sp, cp
int tbcigi(), strcmp()
begin
# Allocate dynamic memory for strings
call smark (sp)
call salloc (str1, SZ_LINE, TY_CHAR)
call salloc (str2, SZ_LINE, TY_CHAR)
# Loop over each column until the two rows don't match
order = 0
for (icol = 1; icol <= numcols && order == 0; icol = icol + 1) {
cp = colptr[icol]
datatype = tbcigi (cp, TBL_COL_DATATYPE)
nelem = tbcigi (cp, TBL_COL_LENDATA)
if (nelem == 1) {
switch (datatype) {
case TY_INT,TY_LONG:
call tbegti (tp, cp, row1, ival1)
call tbegti (tp, cp, row2, ival2)
if (ival1 == ival2)
order = 0
else if (IS_INDEFI (ival1))
order = 1
else if (IS_INDEFI (ival2))
order = -1
else if (ival1 > ival2)
order = 1
else if (ival1 < ival2)
order = -1
case TY_SHORT,TY_BOOL:
# note: boolean true --> YES (1), false --> NO (0)
call tbegts (tp, cp, row1, sval1)
call tbegts (tp, cp, row2, sval2)
if (sval1 == sval2)
order = 0
else if (IS_INDEFS (sval1))
order = 1
else if (IS_INDEFS (sval2))
order = -1
else if (sval1 > sval2)
order = 1
else if (sval1 < sval2)
order = -1
case TY_REAL:
call tbegtr (tp, cp, row1, rval1)
call tbegtr (tp, cp, row2, rval2)
if (rval1 == rval2)
order = 0
else if (IS_INDEFR (rval1))
order = 1
else if (IS_INDEFR (rval2))
order = -1
else if (rval1 > rval2)
order = 1
else if (rval1 < rval2)
order = -1
case TY_DOUBLE:
call tbegtd (tp, cp, row1, dval1)
call tbegtd (tp, cp, row2, dval2)
if (dval1 == dval2)
order = 0
else if (TBL_IS_INDEFD (dval1))
order = 1
else if (TBL_IS_INDEFD (dval2))
order = -1
else if (dval1 > dval2)
order = 1
else if (dval1 < dval2)
order = -1
default:
call tbegtt (tp, cp, row1, Memc[str1], SZ_LINE)
call tbegtt (tp, cp, row2, Memc[str2], SZ_LINE)
if (fold) {
call strlwr (Memc[str1])
call strlwr (Memc[str2])
}
if (Memc[str1] == Memc[str2]) {
order = strcmp (Memc[str1], Memc[str2])
if (order != 0)
order = sign (1, order)
} else if (Memc[str1] == EOS) {
order = 1
} else if (Memc[str2] == EOS) {
order = -1
} else {
order = sign (1, int (Memc[str1] - Memc[str2]))
}
}
} else { # the current column contains arrays
call smark (sp2) # just for ptr1 & ptr2
switch (datatype) {
case TY_INT,TY_LONG:
call salloc (ptr1, nelem, TY_INT)
call salloc (ptr2, nelem, TY_INT)
call tbagti (tp, cp, row1, Memi[ptr1], 1, nelem)
call tbagti (tp, cp, row2, Memi[ptr2], 1, nelem)
do i = 0, nelem-1 {
if (Memi[ptr1+i] == Memi[ptr2+i])
order = 0
else if (IS_INDEFI (Memi[ptr1+i]))
order = 1
else if (IS_INDEFI (Memi[ptr2+i]))
order = -1
else if (Memi[ptr1+i] > Memi[ptr2+i])
order = 1
else if (Memi[ptr1+i] < Memi[ptr2+i])
order = -1
if (order != 0)
break
}
case TY_SHORT,TY_BOOL:
call salloc (ptr1, nelem, TY_SHORT)
call salloc (ptr2, nelem, TY_SHORT)
call tbagts (tp, cp, row1, Mems[ptr1], 1, nelem)
call tbagts (tp, cp, row2, Mems[ptr2], 1, nelem)
do i = 0, nelem-1 {
if (Mems[ptr1+i] == Mems[ptr2+i])
order = 0
else if (IS_INDEFS (Mems[ptr1+i]))
order = 1
else if (IS_INDEFS (Mems[ptr2+i]))
order = -1
else if (Mems[ptr1+i] > Mems[ptr2+i])
order = 1
else if (Mems[ptr1+i] < Mems[ptr2+i])
order = -1
if (order != 0)
break
}
case TY_REAL:
call salloc (ptr1, nelem, TY_REAL)
call salloc (ptr2, nelem, TY_REAL)
call tbagtr (tp, cp, row1, Memr[ptr1], 1, nelem)
call tbagtr (tp, cp, row2, Memr[ptr2], 1, nelem)
do i = 0, nelem-1 {
if (Memr[ptr1+i] == Memr[ptr2+i])
order = 0
else if (IS_INDEFR (Memr[ptr1+i]))
order = 1
else if (IS_INDEFR (Memr[ptr2+i]))
order = -1
else if (Memr[ptr1+i] > Memr[ptr2+i])
order = 1
else if (Memr[ptr1+i] < Memr[ptr2+i])
order = -1
if (order != 0)
break
}
case TY_DOUBLE:
call salloc (ptr1, nelem, TY_DOUBLE)
call salloc (ptr2, nelem, TY_DOUBLE)
call tbagtd (tp, cp, row1, Memd[ptr1], 1, nelem)
call tbagtd (tp, cp, row2, Memd[ptr2], 1, nelem)
do i = 0, nelem-1 {
if (Memd[ptr1+i] == Memd[ptr2+i])
order = 0
else if (TBL_IS_INDEFD (Memd[ptr1+i]))
order = 1
else if (TBL_IS_INDEFD (Memd[ptr2+i]))
order = -1
else if (Memd[ptr1+i] > Memd[ptr2+i])
order = 1
else if (Memd[ptr1+i] < Memd[ptr2+i])
order = -1
if (order != 0)
break
}
default:
do i = 1, nelem {
call tbagtt (tp, cp, row1, Memc[str1], SZ_LINE, i, i)
call tbagtt (tp, cp, row2, Memc[str2], SZ_LINE, i, i)
if (fold) {
call strlwr (Memc[str1])
call strlwr (Memc[str2])
}
if (Memc[str1] == Memc[str2]) {
order = strcmp (Memc[str1], Memc[str2])
if (order != 0)
order = sign (1, order)
} else if (Memc[str1] == EOS) {
order = 1
} else if (Memc[str2] == EOS) {
order = -1
} else {
order = sign (1, int (Memc[str1] - Memc[str2]))
}
if (order != 0)
break
}
}
call sfree (sp2)
}
}
call sfree (sp)
return (order)
end
|
