aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/selector/generic
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/tbtables/selector/generic')
-rw-r--r--pkg/tbtables/selector/generic/mkpkg16
-rw-r--r--pkg/tbtables/selector/generic/tcsrdaryb.x116
-rw-r--r--pkg/tbtables/selector/generic/tcsrdaryc.x117
-rw-r--r--pkg/tbtables/selector/generic/tcsrdaryd.x116
-rw-r--r--pkg/tbtables/selector/generic/tcsrdaryi.x116
-rw-r--r--pkg/tbtables/selector/generic/tcsrdaryr.x116
-rw-r--r--pkg/tbtables/selector/generic/tcsrdarys.x116
7 files changed, 713 insertions, 0 deletions
diff --git a/pkg/tbtables/selector/generic/mkpkg b/pkg/tbtables/selector/generic/mkpkg
new file mode 100644
index 00000000..eaa97971
--- /dev/null
+++ b/pkg/tbtables/selector/generic/mkpkg
@@ -0,0 +1,16 @@
+# Update the generic routines in selector
+
+default:
+ $checkout libtbtables.a ../../
+ $update libtbtables.a
+ $checkin libtbtables.a ../../
+$exit
+
+libtbtables.a:
+ tcsrdaryb.x ../tcs.h
+ tcsrdaryc.x ../tcs.h
+ tcsrdaryd.x ../tcs.h
+ tcsrdaryi.x ../tcs.h
+ tcsrdaryr.x ../tcs.h
+ tcsrdarys.x ../tcs.h
+ ;
diff --git a/pkg/tbtables/selector/generic/tcsrdaryb.x b/pkg/tbtables/selector/generic/tcsrdaryb.x
new file mode 100644
index 00000000..b951ecf0
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdaryb.x
@@ -0,0 +1,116 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdaryb (tp, descrip, irow, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+bool buffer[ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagtb()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegtb (tp, TCS_COLUMN(descrip), irow, buffer)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagtb (tp, TCS_COLUMN(descrip), irow,
+ buffer[nbuf], off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
diff --git a/pkg/tbtables/selector/generic/tcsrdaryc.x b/pkg/tbtables/selector/generic/tcsrdaryc.x
new file mode 100644
index 00000000..33a2b610
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdaryc.x
@@ -0,0 +1,117 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdaryt (tp, descrip, irow, maxch, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxch # i: max length of string
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+char buffer[maxch,ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagtt()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegtt (tp, TCS_COLUMN(descrip), irow, buffer, maxch)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagtt (tp, TCS_COLUMN(descrip), irow,
+ buffer[1,nbuf], maxch, off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
diff --git a/pkg/tbtables/selector/generic/tcsrdaryd.x b/pkg/tbtables/selector/generic/tcsrdaryd.x
new file mode 100644
index 00000000..de054a3b
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdaryd.x
@@ -0,0 +1,116 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdaryd (tp, descrip, irow, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+double buffer[ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagtd()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegtd (tp, TCS_COLUMN(descrip), irow, buffer)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagtd (tp, TCS_COLUMN(descrip), irow,
+ buffer[nbuf], off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
diff --git a/pkg/tbtables/selector/generic/tcsrdaryi.x b/pkg/tbtables/selector/generic/tcsrdaryi.x
new file mode 100644
index 00000000..ee05ee36
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdaryi.x
@@ -0,0 +1,116 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdaryi (tp, descrip, irow, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+int buffer[ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagti()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegti (tp, TCS_COLUMN(descrip), irow, buffer)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagti (tp, TCS_COLUMN(descrip), irow,
+ buffer[nbuf], off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
diff --git a/pkg/tbtables/selector/generic/tcsrdaryr.x b/pkg/tbtables/selector/generic/tcsrdaryr.x
new file mode 100644
index 00000000..27a5ed13
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdaryr.x
@@ -0,0 +1,116 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdaryr (tp, descrip, irow, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+real buffer[ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagtr()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegtr (tp, TCS_COLUMN(descrip), irow, buffer)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagtr (tp, TCS_COLUMN(descrip), irow,
+ buffer[nbuf], off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
diff --git a/pkg/tbtables/selector/generic/tcsrdarys.x b/pkg/tbtables/selector/generic/tcsrdarys.x
new file mode 100644
index 00000000..1ae34565
--- /dev/null
+++ b/pkg/tbtables/selector/generic/tcsrdarys.x
@@ -0,0 +1,116 @@
+include "../tcs.h"
+
+# TCS_RDARY -- Read an array using the column selector
+
+procedure tcs_rdarys (tp, descrip, irow, maxbuf, nbuf, buffer)
+
+pointer tp # i: table descriptor
+pointer descrip # i: column selector
+int irow # i: table row number
+int maxbuf # i: declared length of buffer
+int nbuf # o: length of output array
+short buffer[ARB] # o: array of values
+#--
+int idim, ndim, pdim, plen, psize, off
+int axsize, axlen[MAXDIM], axpos[MAXDIM]
+
+int tbagts()
+
+begin
+ if (TCS_DIMEN(descrip) == 0) {
+ # Column is a scalar, use a scalar read routine
+
+ if (maxbuf > 0) {
+ nbuf = 1
+ call tbegts (tp, TCS_COLUMN(descrip), irow, buffer)
+ } else {
+ nbuf = 0
+ }
+
+ } else {
+ # Compute size and dimensionality of the largest contigous
+ # piece that can be read from the array
+
+ call tbciga (tp, TCS_COLUMN(descrip), ndim, axlen, MAXDIM)
+
+ pdim = 0
+ psize = 1
+ do idim = 1, TCS_DIMEN(descrip) {
+ if (TCS_INC(descrip,idim) > 1)
+ break
+
+ pdim = pdim + 1
+ plen = (TCS_LAST(descrip,idim) - TCS_FIRST(descrip,idim) + 1)
+ psize = psize * plen
+
+ if (plen < axlen[idim])
+ break
+ }
+
+ # Compute offset to first element to be read into array
+
+ off = 0
+ do idim = ndim-1, 1, -1
+ off = (off + TCS_FIRST(descrip,idim+1) - 1) * axlen[idim]
+
+ off = off + TCS_FIRST(descrip,1)
+
+ # Save position of first element to be read in array
+
+ do idim = 1 , ndim
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ nbuf = 1
+
+ repeat {
+
+ # Adjust piece size for possible overflow
+
+ if (nbuf + psize > maxbuf)
+ psize = maxbuf - (nbuf - 1)
+
+ # Read chunk from array
+
+ psize = tbagts (tp, TCS_COLUMN(descrip), irow,
+ buffer[nbuf], off, psize)
+
+ # Exit if array is full
+
+ nbuf = nbuf + psize
+ if (nbuf > maxbuf)
+ break
+
+ # Compute offset to next piece to read into array
+
+ axsize = 1
+ for (idim = 1; idim <= ndim; idim = idim + 1) {
+ if (idim > pdim) {
+ axpos[idim] = axpos[idim] + TCS_INC(descrip,idim)
+
+ if (axpos[idim] + TCS_INC(descrip,idim) <=
+ TCS_LAST(descrip,idim)) {
+
+ off = off + axsize * TCS_INC(descrip,idim)
+ break
+
+ } else {
+ axpos[idim] = TCS_FIRST(descrip,idim)
+
+ off = off - axsize * (TCS_LAST(descrip,idim) -
+ TCS_FIRST(descrip,idim))
+ }
+ }
+
+ axsize = axsize * axlen[idim]
+ }
+
+ # Exit if array has been traversed
+
+ if (idim > ndim)
+ break
+ }
+
+ nbuf = nbuf - 1
+ }
+end
+
generated by cgit (git 2.34.1) at 2025-09-20 08:56:23 -0400