aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/tbrcmp.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/tbtables/tbrcmp.x')
-rw-r--r--pkg/tbtables/tbrcmp.x288
1 files changed, 288 insertions, 0 deletions
diff --git a/pkg/tbtables/tbrcmp.x b/pkg/tbtables/tbrcmp.x
new file mode 100644
index 00000000..2014a429
--- /dev/null
+++ b/pkg/tbtables/tbrcmp.x
@@ -0,0 +1,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