diff options
Diffstat (limited to 'pkg/tbtables/tbrcmp.x')
-rw-r--r-- | pkg/tbtables/tbrcmp.x | 288 |
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 |