diff options
Diffstat (limited to 'noao/digiphot/photcal/mctable')
32 files changed, 6251 insertions, 0 deletions
diff --git a/noao/digiphot/photcal/mctable/mctable.hlp b/noao/digiphot/photcal/mctable/mctable.hlp new file mode 100644 index 00000000..cdf1fdac --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctable.hlp @@ -0,0 +1,90 @@ +.help mctable Aug89 +Multicolumn Table Handler. + +This package contains routines to handle a contiguous memory buffer as a +table with one or more columns. The number of columns is fixed at creation +time, but the number of rows can increase dynamicaly if needed. The table +data type is fixed at creation time as well. +.sp +This package makes a distinction between the physical and logical size of +the table. The first one is the amount of memory allocated to the table, and +can increase if more space is needed. The physical size of a table can +increase dinamycaly when entering data and can decrease up to the logical +size unless the table is freed. +The logical size is the amount of memory used by the data in the table, +and is always less or equal to the physical size. The logical size of a +table can also increase dinamycaly when entering data, and is zero +if no data have been entered. +.sp +The procedures mct_maxrow() and mct_maxcol() return the amount of physical +memory used by the table, and the procedures mct_nrows() and mct_ncols() return +the highest row and column (in the highest row) used by the data in the table, +i.e. the logical size. +.sp +The physical size can be reduced up to the logical size with the mct_shrink() +procedure. This returns to the system any unused memory used by the table. +This procedures should ne used with tables that are not intended to grow +anymore. +.sp +The logical size can be set to zero with the mct_reset() procedure. This +procedure clears all the counters used to keep track of the logical size +of the table, and also fills all the physical memory with INDEF values. +.sp +The mct_clear() procedure fills all the physical memory with a specified +value, but does not modify the logical size of the table. +.sp +It is possible to enter data into the table either sequentially, randomly, +or a combination of both. The mct_put() procedures enter data randomly into +the table at given row and column. The mct_sput() procedures enter data +sequentially into the table after the highest row and column, i.e., they +start after the last element in table, increasing the logical size by one +element. The physical size is increased automaticaly if needed. +.sp +Data can be retrieved from the table as a pointer to the whole data buffer, +a pointer to a single row, randomly, or sequentially. The mct_getbuf() returns +a pointer to the data buffer, the mct_getrow() returns a pointer to the +beginning of a given row, the mct_get() procedures return a single data +value for a given row and column, and the mct_sget() procedures return the +next single data value. Sequential retrieval starts from the last retrieval +made, either sequential or ramdom. The mct_rew() procedure can be used to +reset the sequential retrieval counters. +.sp +A table can be saved into a file and restored later with the mct_save() and +mct_restore() procedures. These procedures use the file name instead of a +file descriptor. When saving only the WRITE_ONLY, READ_WRITE, NEW_FILE, and +TEMP_FILE file modes are allowed. +.sp +.nf +Entry points: + + mct_alloc (table, nrows, ncols, type) Allocate table space + mct_free (table) Free table space + mct_shrink (table) Free unused memory + mct_copy (itable, otable) Copy table + + mct_save (fname, fmode, table) Save table to file + mct_restore (fname, table) Restore table from file + + mct_rew (table) Reset seq. (get) counters + mct_reset (table) Reset all table counters + + mct_clear[csilrdxp] (table, value) Clear table with value + +nrows = mct_nrows (table) Return highest row used +ncols = mct_ncols (table) Return highest col. used + +nrow = mct_maxrow (table) Return max. number of rows +ncols = mct_maxcol (table) Return max. number of col. + +type = mct_type (table) Return table type + +pval = mct_getbuf (table) Get buffer pointer +pval = mct_getrow (table, row) Get row pointer + +value = mct_get[csilrdxp] (table, row, col) Get value randomly + mct_put[csilrdxp] (table, row, col, value) Put value randomly + + mct_sput[csilrdxp] (table, value) Put value sequentially +stat = mct_sget[csilrdxp] (table, value) Get value sequentially +.fi +.endhelp diff --git a/noao/digiphot/photcal/mctable/mctalloc.x b/noao/digiphot/photcal/mctable/mctalloc.x new file mode 100644 index 00000000..82c6c93c --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctalloc.x @@ -0,0 +1,48 @@ +include "../lib/mctable.h" + + +# MCT_ALLOC - Allocate table space, reset all table counters, and clear +# table values to INDEF. + +procedure mct_alloc (table, nrows, ncols, type) + +pointer table # table descriptor (output) +int nrows # number of rows +int ncols # number of columns +int type # data type + +errchk mct_reset() + +begin + # Test number of rows and colums. + if (nrows < 1) + call error (0, "mct_alloc: Zero or negative rows") + if (ncols < 1) + call error (0, "mct_alloc: Zero or negative columns") + + # Check for supported data types. + if (type != TY_CHAR && + type != TY_SHORT && type != TY_INT && type != TY_LONG && + type != TY_REAL && type != TY_DOUBLE && + type != TY_COMPLEX && + type != TY_POINTER) + call error (0, "mct_alloc: Unknown type") + + # Allocate table structure and initialize it. The only + # value that can change in the future is the maximum number + # of rows. All others will remain constant. + + call malloc (table, LEN_MCTABLE, TY_STRUCT) + MCT_MAGIC (table) = MAGIC + MCT_TYPE (table) = type + MCT_MAXROW (table) = nrows + MCT_MAXCOL (table) = ncols + MCT_INCROWS (table) = GROWFACTOR (nrows) + + # Allocate data buffer and undefine it. + call malloc (MCT_DATA (table), nrows * ncols, type) + call mct_indef (table, MCT_DATA (table), nrows * ncols) + + # Reset table. + call mct_reset (table) +end diff --git a/noao/digiphot/photcal/mctable/mctclear.gx b/noao/digiphot/photcal/mctable/mctclear.gx new file mode 100644 index 00000000..58eacba9 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctclear.gx @@ -0,0 +1,33 @@ +include "../lib/mctable.h" + + +$for (csilrdxp) +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clear$t (table, value) + +pointer table # table descriptor +PIXEL value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_PIXEL) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + $if (datatype == p) + call amovki (value, Memi[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) + $else + call amovk$t (value, Mem$t[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) + $endif +end +$endfor diff --git a/noao/digiphot/photcal/mctable/mctclear.x b/noao/digiphot/photcal/mctable/mctclear.x new file mode 100644 index 00000000..0c9e9080 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctclear.x @@ -0,0 +1,195 @@ +include "../lib/mctable.h" + + + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clearc (table, value) + +pointer table # table descriptor +char value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_CHAR) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovkc (value, Memc[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clears (table, value) + +pointer table # table descriptor +short value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_SHORT) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovks (value, Mems[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_cleari (table, value) + +pointer table # table descriptor +int value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_INT) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovki (value, Memi[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clearl (table, value) + +pointer table # table descriptor +long value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_LONG) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovkl (value, Meml[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clearr (table, value) + +pointer table # table descriptor +real value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_REAL) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovkr (value, Memr[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_cleard (table, value) + +pointer table # table descriptor +double value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_DOUBLE) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovkd (value, Memd[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clearx (table, value) + +pointer table # table descriptor +complex value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_COMPLEX) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovkx (value, Memx[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end + +# MCT_CLEAR - Clear all table values with given value. Do not reset any +# table counter. + +procedure mct_clearp (table, value) + +pointer table # table descriptor +pointer value # value + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_clear: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_clear: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_POINTER) + call error (0, "mct_clear: Wrong table type") + + # Move value to data buffer + call amovki (value, Memi[MCT_DATA (table)], + MCT_MAXROW (table) * MCT_MAXCOL (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctcopy.gx b/noao/digiphot/photcal/mctable/mctcopy.gx new file mode 100644 index 00000000..c30f321a --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctcopy.gx @@ -0,0 +1,63 @@ +include "../lib/mctable.h" + + +# MCT_COPY - Copy one table into another. The destination table is allocated +# or reallocated if necessary. + +procedure mct_copy (itable, otable) + +pointer itable # input table descriptor +pointer otable # output table descriptor + +int isize, osize # table sizes + +errchk mct_alloc() + +begin + # Check input pointer and magic number. + if (itable == NULL) + call error (0, "mct_copy: Null input table pointer") + if (MCT_MAGIC (itable) != MAGIC) + call error (0, "mct_copy: Bad input magic number") + + # Compute input table size. + isize = MCT_MAXROW (itable) * MCT_MAXCOL (itable) + + # Check output pointer. Try to minimize space allocation. + if (otable == NULL) + call mct_alloc (otable, MCT_MAXROW (itable), MCT_MAXCOL (itable), + MCT_TYPE (itable)) + else if (MCT_MAGIC (otable) == MAGIC) { + osize = MCT_MAXROW (otable) * MCT_MAXCOL (otable) + if (isize != osize || MCT_TYPE (itable) != MCT_TYPE (otable)) + call realloc (MCT_DATA (otable), isize, MCT_TYPE (itable)) + } else + call error (0, "mct_copy: Bad output magic number") + + # Copy structure. + MCT_MAGIC (otable) = MCT_MAGIC (itable) + MCT_TYPE (otable) = MCT_TYPE (itable) + MCT_MAXROW (otable) = MCT_MAXROW (itable) + MCT_MAXCOL (otable) = MCT_MAXCOL (itable) + MCT_INCROWS (otable) = MCT_INCROWS (itable) + MCT_NPROWS (otable) = MCT_NPROWS (itable) + MCT_NPCOLS (otable) = MCT_NPCOLS (itable) + MCT_NGROWS (otable) = MCT_NGROWS (itable) + MCT_NGCOLS (otable) = MCT_NGCOLS (itable) + + # Copy data buffer. + switch (MCT_TYPE (otable)) { + $for (csilrdxp) + case TY_PIXEL: + $if (datatype == p) + call amovi (Memi[MCT_DATA (itable)], Memi[MCT_DATA (otable)], + isize) + $else + call amov$t (Mem$t[MCT_DATA (itable)], Mem$t[MCT_DATA (otable)], + isize) + $endif + $endfor + default: + call error (0, "mct_copy: Unknown table type") + } +end diff --git a/noao/digiphot/photcal/mctable/mctcopy.x b/noao/digiphot/photcal/mctable/mctcopy.x new file mode 100644 index 00000000..bcf54f9c --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctcopy.x @@ -0,0 +1,86 @@ +include "../lib/mctable.h" + + +# MCT_COPY - Copy one table into another. The destination table is allocated +# or reallocated if necessary. + +procedure mct_copy (itable, otable) + +pointer itable # input table descriptor +pointer otable # output table descriptor + +int isize, osize # table sizes + +errchk mct_alloc() + +begin + # Check input pointer and magic number. + if (itable == NULL) + call error (0, "mct_copy: Null input table pointer") + if (MCT_MAGIC (itable) != MAGIC) + call error (0, "mct_copy: Bad input magic number") + + # Compute input table size. + isize = MCT_MAXROW (itable) * MCT_MAXCOL (itable) + + # Check output pointer. Try to minimize space allocation. + if (otable == NULL) + call mct_alloc (otable, MCT_MAXROW (itable), MCT_MAXCOL (itable), + MCT_TYPE (itable)) + else if (MCT_MAGIC (otable) == MAGIC) { + osize = MCT_MAXROW (otable) * MCT_MAXCOL (otable) + if (isize != osize || MCT_TYPE (itable) != MCT_TYPE (otable)) + call realloc (MCT_DATA (otable), isize, MCT_TYPE (itable)) + } else + call error (0, "mct_copy: Bad output magic number") + + # Copy structure. + MCT_MAGIC (otable) = MCT_MAGIC (itable) + MCT_TYPE (otable) = MCT_TYPE (itable) + MCT_MAXROW (otable) = MCT_MAXROW (itable) + MCT_MAXCOL (otable) = MCT_MAXCOL (itable) + MCT_INCROWS (otable) = MCT_INCROWS (itable) + MCT_NPROWS (otable) = MCT_NPROWS (itable) + MCT_NPCOLS (otable) = MCT_NPCOLS (itable) + MCT_NGROWS (otable) = MCT_NGROWS (itable) + MCT_NGCOLS (otable) = MCT_NGCOLS (itable) + + # Copy data buffer. + switch (MCT_TYPE (otable)) { + + case TY_CHAR: + call amovc (Memc[MCT_DATA (itable)], Memc[MCT_DATA (otable)], + isize) + + case TY_SHORT: + call amovs (Mems[MCT_DATA (itable)], Mems[MCT_DATA (otable)], + isize) + + case TY_INT: + call amovi (Memi[MCT_DATA (itable)], Memi[MCT_DATA (otable)], + isize) + + case TY_LONG: + call amovl (Meml[MCT_DATA (itable)], Meml[MCT_DATA (otable)], + isize) + + case TY_REAL: + call amovr (Memr[MCT_DATA (itable)], Memr[MCT_DATA (otable)], + isize) + + case TY_DOUBLE: + call amovd (Memd[MCT_DATA (itable)], Memd[MCT_DATA (otable)], + isize) + + case TY_COMPLEX: + call amovx (Memx[MCT_DATA (itable)], Memx[MCT_DATA (otable)], + isize) + + case TY_POINTER: + call amovi (Memi[MCT_DATA (itable)], Memi[MCT_DATA (otable)], + isize) + + default: + call error (0, "mct_copy: Unknown table type") + } +end diff --git a/noao/digiphot/photcal/mctable/mctfree.x b/noao/digiphot/photcal/mctable/mctfree.x new file mode 100644 index 00000000..f7f3e2c0 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctfree.x @@ -0,0 +1,20 @@ +include "../lib/mctable.h" + + +# MCT_FREE - Free table structure and data buffer associated with it. + +procedure mct_free (table) + +pointer table # table descriptor + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_free: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_free: Bad magic number") + + # Free the table. + call mfree (MCT_DATA (table), MCT_TYPE (table)) + call mfree (table, TY_STRUCT) +end diff --git a/noao/digiphot/photcal/mctable/mctget.gx b/noao/digiphot/photcal/mctable/mctget.gx new file mode 100644 index 00000000..f79379c8 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctget.gx @@ -0,0 +1,46 @@ +include "../lib/mctable.h" + + +$for (csilrdxp) +# MCT_GET - Get a single value from the table (generic). + +PIXEL procedure mct_get$t (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_PIXEL) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + $if (datatype == p) + return (MEMP[mct_getrow (table, row) + col - 1]) + $else + return (Mem$t[mct_getrow (table, row) + col - 1]) + $endif +end +$endfor diff --git a/noao/digiphot/photcal/mctable/mctget.x b/noao/digiphot/photcal/mctable/mctget.x new file mode 100644 index 00000000..1ca2b9fa --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctget.x @@ -0,0 +1,307 @@ +include "../lib/mctable.h" + + + +# MCT_GET - Get a single value from the table (generic). + +char procedure mct_getc (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_CHAR) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Memc[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +short procedure mct_gets (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_SHORT) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Mems[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +int procedure mct_geti (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_INT) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Memi[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +long procedure mct_getl (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_LONG) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Meml[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +real procedure mct_getr (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_REAL) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Memr[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +double procedure mct_getd (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_DOUBLE) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Memd[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +complex procedure mct_getx (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_COMPLEX) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (Memx[mct_getrow (table, row) + col - 1]) +end + +# MCT_GET - Get a single value from the table (generic). + +pointer procedure mct_getp (table, row, col) + +pointer table # table descriptor +int row # row number +int col # column number + +pointer mct_getrow() +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_get: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_get: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_POINTER) + call error (0, "mct_get: Wrong table type") + + # Check the row and column range. + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_get: Bad row number") + if (row == MCT_NPROWS (table) && (col < 1 || col > MCT_NPCOLS (table))) + call error (0, "mct_get: Bad column number at last row") + if (row != MCT_NPROWS (table) && (col < 1 || col > MCT_MAXCOL (table))) + call error (0, "mct_get: Bad column number") + + # Update the counters. + MCT_NGROWS (table) = row + MCT_NGCOLS (table) = col + + # Return value. + return (MEMP[mct_getrow (table, row) + col - 1]) +end diff --git a/noao/digiphot/photcal/mctable/mctgetbuf.x b/noao/digiphot/photcal/mctable/mctgetbuf.x new file mode 100644 index 00000000..a9c6dbbb --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctgetbuf.x @@ -0,0 +1,23 @@ +include "../lib/mctable.h" + + +# MCT_GETBUF - Get pointer to data buffer. + +pointer procedure mct_getbuf (table) + +pointer table # table descriptor + +pointer mct_getrow() + +errchk mct_getrow() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_getbuf: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_getbuf: Bad magic number") + + # Return pointer to data buffer. + return (mct_getrow (table, 1)) +end diff --git a/noao/digiphot/photcal/mctable/mctgetrow.x b/noao/digiphot/photcal/mctable/mctgetrow.x new file mode 100644 index 00000000..bc46b06e --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctgetrow.x @@ -0,0 +1,25 @@ +include "../lib/mctable.h" + + +# MCT_GETROW - Get pointer to row data values. + +pointer procedure mct_getrow (table, row) + +pointer table # table descriptor +int row # row number + +begin + # Check the pointer and magic number. + if (table == NULL) + call error (0, "mct_getrow: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_getrow: Bad magic number") + + # Return the pointer to a row buffer, or NULL. + # if row is out of range + if (row < 1 || row > MCT_NPROWS (table)) + call error (0, "mct_getrow: Bad row number") + + # Return row pointer. + return (MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctindef.x b/noao/digiphot/photcal/mctable/mctindef.x new file mode 100644 index 00000000..f3e3427c --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctindef.x @@ -0,0 +1,40 @@ +include "../lib/mctable.h" + + +# MCT_INDEF - Fill table buffer with undefined values, acording to the +# data type used. + +procedure mct_indef (table, buffer, npts) + +pointer table # table descriptor +pointer buffer # buffer to clear +int npts # number of untis to clear + +char cval +short sval + +begin + # Clear according to data type. + switch (MCT_TYPE (table)) { + case TY_CHAR: + cval = '\000' + call amovkc (cval, Memc[buffer], npts) + case TY_SHORT: + sval = INDEFS + call amovks (sval, Mems[buffer], npts) + case TY_INT: + call amovki (INDEFI, Memi[buffer], npts) + case TY_LONG: + call amovkl (INDEFL, Meml[buffer], npts) + case TY_REAL: + call amovkr (INDEFR, Memr[buffer], npts) + case TY_DOUBLE: + call amovkd (INDEFD, Memd[buffer], npts) + case TY_COMPLEX: + call amovkx (INDEFX, Memx[buffer], npts) + case TY_POINTER: + call amovki (NULL, Memi[buffer], npts) + default: + call error (0, "mct_indef: Unknown data type") + } +end diff --git a/noao/digiphot/photcal/mctable/mctmaxcol.x b/noao/digiphot/photcal/mctable/mctmaxcol.x new file mode 100644 index 00000000..74f341ae --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctmaxcol.x @@ -0,0 +1,19 @@ +include "../lib/mctable.h" + + +# MCT_MAXCOL - Return the maximum number of columns in the table. + +int procedure mct_maxcol (table) + +pointer table # table descriptor + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_maxcol: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_maxcol: Bad magic number") + + # Return max number of columns + return (MCT_MAXCOL (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctmaxrow.x b/noao/digiphot/photcal/mctable/mctmaxrow.x new file mode 100644 index 00000000..25d21067 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctmaxrow.x @@ -0,0 +1,19 @@ +include "../lib/mctable.h" + + +# MCT_MAXROW - Return the maximum number of rows of the table. + +int procedure mct_maxrow (table) + +pointer table # table descriptor + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_mxrow: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_mxrow: Bad magic number") + + # Return max number of rows. + return (MCT_MAXROW (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctncols.x b/noao/digiphot/photcal/mctable/mctncols.x new file mode 100644 index 00000000..65baea8d --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctncols.x @@ -0,0 +1,20 @@ +include "../lib/mctable.h" + + +# MCT_NCOLS - Return the highest column number for the highest row, entered +# into the table + +int procedure mct_ncols (table) + +pointer table # table descriptor + +begin + # Check the pointer and magic number. + if (table == NULL) + call error (0, "mct_ncols: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_ncols: Bad magic number") + + # Return column counter. + return (MCT_NPCOLS (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctnrows.x b/noao/digiphot/photcal/mctable/mctnrows.x new file mode 100644 index 00000000..06c688c9 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctnrows.x @@ -0,0 +1,19 @@ +include "../lib/mctable.h" + + +# MCT_NROWS - Return the highest row number entered into the table + +int procedure mct_nrows (table) + +pointer table # table descriptor + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_nrows: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_nrows: Bad magic number") + + # Return row counter. + return (MCT_NPROWS (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctput.gx b/noao/digiphot/photcal/mctable/mctput.gx new file mode 100644 index 00000000..893678b1 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctput.gx @@ -0,0 +1,68 @@ +include "../lib/mctable.h" + +$for (csilrdxp) +# MCT_PUT - Put value randomly (generic) + +procedure mct_put$t (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +PIXEL value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_PIXEL) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_PIXEL) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + $if (datatype == p) + MEMP[base + col - 1] = value + $else + Mem$t[base + col - 1] = value + $endif +end +$endfor diff --git a/noao/digiphot/photcal/mctable/mctput.x b/noao/digiphot/photcal/mctable/mctput.x new file mode 100644 index 00000000..8c3c91f2 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctput.x @@ -0,0 +1,490 @@ +include "../lib/mctable.h" + + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putc (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +char value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_CHAR) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_CHAR) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Memc[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_puts (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +short value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_SHORT) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_SHORT) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Mems[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_puti (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +int value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_INT) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_INT) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Memi[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putl (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +long value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_LONG) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_LONG) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Meml[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putr (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +real value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_REAL) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_REAL) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Memr[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putd (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +double value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_DOUBLE) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_DOUBLE) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Memd[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putx (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +complex value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_COMPLEX) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_COMPLEX) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + Memx[base + col - 1] = value +end + +# MCT_PUT - Put value randomly (generic) + +procedure mct_putp (table, row, col, value) + +pointer table # table descriptor +int row # row number +int col # column number +pointer value # data value + +int offset +pointer base +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_put: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_put: Bad magic number") + + # Check the table type. + if (MCT_TYPE (table) != TY_POINTER) + call error (0, "mct_put: Wrong table type") + + # Test row and column values. + if (row < 1) + call error (0, "mct_put: Row number less than one") + if (col < 1 || col > MCT_MAXCOL (table)) + call error (0, "mct_put: Column out of range") + + # Reallocate space if necessary. + if (row > MCT_MAXROW (table)) { + + # Compute offset of new area. + offset = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Recompute new number of rows and reallocate buffer. + MCT_MAXROW (table) = MCT_MAXROW (table) + MCT_INCROWS (table) + call realloc (MCT_DATA (table), + MCT_MAXROW (table) * MCT_MAXCOL (table), TY_POINTER) + + # Compute base address of new area and clear it with INDEF. + base = MCT_DATA (table) + offset + call mct_indef (table, base, + MCT_INCROWS (table) * MCT_MAXCOL (table)) + } + + # Update row and column counter, only if the new entries are beyond + # the old limits. + + if (row > MCT_NPROWS (table)) { + MCT_NPROWS (table) = row + MCT_NPCOLS (table) = col + } else if (col > MCT_NPCOLS (table)) + MCT_NPCOLS (table) = col + + # Enter variable. + base = MCT_DATA (table) + (row - 1) * MCT_MAXCOL (table) + MEMP[base + col - 1] = value +end diff --git a/noao/digiphot/photcal/mctable/mctreset.x b/noao/digiphot/photcal/mctable/mctreset.x new file mode 100644 index 00000000..c90959d2 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctreset.x @@ -0,0 +1,28 @@ +include "../lib/mctable.h" + + +# MCT_RESET - Reset table counters, and set all table values to INDEF. + +procedure mct_reset (table) + +pointer table # table descriptor + +errchk mct_indef() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_reset: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_reset: Bad magic number") + + # Clear table counters. + MCT_NPCOLS (table) = 0 + MCT_NPROWS (table) = 0 + MCT_NGCOLS (table) = 0 + MCT_NGROWS (table) = 0 + + # Clear table buffer. + call mct_indef (table, MCT_DATA (table), + MCT_NPROWS (table) * MCT_NPCOLS (table)) +end diff --git a/noao/digiphot/photcal/mctable/mctrestore.gx b/noao/digiphot/photcal/mctable/mctrestore.gx new file mode 100644 index 00000000..2e0a807f --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctrestore.gx @@ -0,0 +1,135 @@ +include "../lib/mctable.h" + + +# MCT_RESTORE - Restore table from a text file. + +procedure mct_restore (fname, table) + +char fname[ARB] # file name +pointer table # table descriptor + +char cval +short sval +int fd, magic, type, row, col, nprows, npcols +int maxcol, maxrow, lastcol, ival +long lval +pointer pval +real rval +double dval +complex xval + +int open(), fscan(), nscan() +errchk mct_alloc() +errchk mct_putc(), mct_puts(), mct_puti(), mct_putl() +errchk mct_putr(), mct_putd(), mct_putx(), mct_putp() + +begin + # Open file. + iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) + call error (0, "mct_restore: Cannot open file") + + # Read and check magic number. + if (fscan (fd) != EOF) { + call gargi (magic) + if (magic != MAGIC) + call error (0, "mct_restore: Bad magic number") + } else + call error (0, "mct_restore: Unexpected end of file (magic)") + + # Read type. + if (fscan (fd) != EOF) + call gargi (type) + else + call error (0, "mct_restore: Unexpected end of file (type)") + + # Read max number of rows. + if (fscan (fd) != EOF) + call gargi (maxrow) + else + call error (0, "mct_restore: Unexpected end of file (maxrow)") + + # Read max number of columns. + if (fscan (fd) != EOF) + call gargi (maxcol) + else + call error (0, "mct_restore: Unexpected end of file (maxcol)") + + # Discard row increment. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (incrows)") + + # Read number of rows entered. + if (fscan (fd) != EOF) + call gargi (nprows) + else + call error (0, "mct_restore: Unexpected end of file (nprows)") + + # Read number of columns entered. + if (fscan (fd) != EOF) + call gargi (npcols) + else + call error (0, "mct_restore: Unexpected end of file (npcols)") + + # Read number of rows gotten. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (ngrows)") + + # Read number of columns gotten + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (ngcols)") + + # Discard data pointer. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (pointer)") + + # Allocate table. + call mct_alloc (table, maxrow, maxcol, type) + + # Loop over rows. + lastcol = maxcol + do row = 1, nprows { + + # In the last row the column loop should go only until the + # highest column. + if (row == nprows) + lastcol = npcols + + # Start scanning next line. + if (fscan (fd) == EOF) + call error (0, "mct_restore: Unexpected end of file (row)") + + # Loop over columns. + for (col = 1; col <= lastcol; col = col + 1) { + + # Read data. + switch (MCT_TYPE (table)) { + $for (csilrdxp) + case TY_PIXEL: + $if (datatype == p) + call gargi ($tval) + $else + call garg$t ($tval) + $endif + call mct_put$t (table, row, col, $tval) + $endfor + default: + call error (0, "mct_save: Unknown data type") + } + + # Check column read. + if (nscan () != col) + call error (0, "mct_restore: Unexpcted end of file (col)") + } + } + + # Close file. + call close (fd) +end diff --git a/noao/digiphot/photcal/mctable/mctrestore.x b/noao/digiphot/photcal/mctable/mctrestore.x new file mode 100644 index 00000000..f080afd6 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctrestore.x @@ -0,0 +1,159 @@ +include "../lib/mctable.h" + + +# MCT_RESTORE - Restore table from a text file. + +procedure mct_restore (fname, table) + +char fname[ARB] # file name +pointer table # table descriptor + +char cval +short sval +int fd, magic, type, row, col, nprows, npcols +int maxcol, maxrow, lastcol, ival +long lval +pointer pval +real rval +double dval +complex xval + +int open(), fscan(), nscan() +errchk mct_alloc() +errchk mct_putc(), mct_puts(), mct_puti(), mct_putl() +errchk mct_putr(), mct_putd(), mct_putx(), mct_putp() + +begin + # Open file. + iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) + call error (0, "mct_restore: Cannot open file") + + # Read and check magic number. + if (fscan (fd) != EOF) { + call gargi (magic) + if (magic != MAGIC) + call error (0, "mct_restore: Bad magic number") + } else + call error (0, "mct_restore: Unexpected end of file (magic)") + + # Read type. + if (fscan (fd) != EOF) + call gargi (type) + else + call error (0, "mct_restore: Unexpected end of file (type)") + + # Read max number of rows. + if (fscan (fd) != EOF) + call gargi (maxrow) + else + call error (0, "mct_restore: Unexpected end of file (maxrow)") + + # Read max number of columns. + if (fscan (fd) != EOF) + call gargi (maxcol) + else + call error (0, "mct_restore: Unexpected end of file (maxcol)") + + # Discard row increment. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (incrows)") + + # Read number of rows entered. + if (fscan (fd) != EOF) + call gargi (nprows) + else + call error (0, "mct_restore: Unexpected end of file (nprows)") + + # Read number of columns entered. + if (fscan (fd) != EOF) + call gargi (npcols) + else + call error (0, "mct_restore: Unexpected end of file (npcols)") + + # Read number of rows gotten. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (ngrows)") + + # Read number of columns gotten + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (ngcols)") + + # Discard data pointer. + if (fscan (fd) != EOF) + call gargi (ival) + else + call error (0, "mct_restore: Unexpected end of file (pointer)") + + # Allocate table. + call mct_alloc (table, maxrow, maxcol, type) + + # Loop over rows. + lastcol = maxcol + do row = 1, nprows { + + # In the last row the column loop should go only until the + # highest column. + if (row == nprows) + lastcol = npcols + + # Start scanning next line. + if (fscan (fd) == EOF) + call error (0, "mct_restore: Unexpected end of file (row)") + + # Loop over columns. + for (col = 1; col <= lastcol; col = col + 1) { + + # Read data. + switch (MCT_TYPE (table)) { + + case TY_CHAR: + call gargc (cval) + call mct_putc (table, row, col, cval) + + case TY_SHORT: + call gargs (sval) + call mct_puts (table, row, col, sval) + + case TY_INT: + call gargi (ival) + call mct_puti (table, row, col, ival) + + case TY_LONG: + call gargl (lval) + call mct_putl (table, row, col, lval) + + case TY_REAL: + call gargr (rval) + call mct_putr (table, row, col, rval) + + case TY_DOUBLE: + call gargd (dval) + call mct_putd (table, row, col, dval) + + case TY_COMPLEX: + call gargx (xval) + call mct_putx (table, row, col, xval) + + case TY_POINTER: + call gargi (pval) + call mct_putp (table, row, col, pval) + + default: + call error (0, "mct_save: Unknown data type") + } + + # Check column read. + if (nscan () != col) + call error (0, "mct_restore: Unexpcted end of file (col)") + } + } + + # Close file. + call close (fd) +end diff --git a/noao/digiphot/photcal/mctable/mctrew.x b/noao/digiphot/photcal/mctable/mctrew.x new file mode 100644 index 00000000..a7ad2ad5 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctrew.x @@ -0,0 +1,20 @@ +include "../lib/mctable.h" + + +# MCT_REW - Rewinding the sequential get counters. + +procedure mct_rew (table) + +pointer table # table descriptor + +begin + # Check the pointer and magic number. + if (table == NULL) + call error (0, "mct_rew: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_rew: Bad magic number") + + # Clear get counters. + MCT_NGCOLS (table) = 0 + MCT_NGROWS (table) = 0 +end diff --git a/noao/digiphot/photcal/mctable/mctsave.x b/noao/digiphot/photcal/mctable/mctsave.x new file mode 100644 index 00000000..dc71fd56 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctsave.x @@ -0,0 +1,113 @@ +include "../lib/mctable.h" + + +# MCT_SAVE - Save table into a text file + +procedure mct_save (fname, fmode, table) + +char fname[ARB] # file name +int fmode # file mode +pointer table # table descriptor + +int fd # file descriptor +int row, col +int nrows, lastcol + +int open() +char mct_getc() +short mct_gets() +int mct_geti() +long mct_getl() +real mct_getr() +double mct_getd() +complex mct_getx() +pointer mct_getp() + +errchk mct_getc(), mct_gets(), mct_geti(), mct_getl() +errchk mct_getr(), mct_getd(), mct_getx(), mct_getp() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_save: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_save: Bad magic number") + + # Check file mode. + if (fmode != WRITE_ONLY && fmode != NEW_FILE && + fmode != NEW_FILE && fmode != TEMP_FILE) + call error (0, "mct_save: Bad file mode") + + # Open file. + iferr (fd = open (fname, fmode, TEXT_FILE)) + call error (0, "mct_save: Cannot open file") + + # Write table structure. + call fprintf (fd, "%d # MCT_MAGIC\n") + call pargi (MCT_MAGIC (table)) + call fprintf (fd, "%d # MCT_TYPE\n") + call pargi (MCT_TYPE (table)) + call fprintf (fd, "%d # MCT_MAXROW\n") + call pargi (MCT_MAXROW (table)) + call fprintf (fd, "%d # MCT_MAXCOL\n") + call pargi (MCT_MAXCOL (table)) + call fprintf (fd, "%d # MCT_INCROWS\n") + call pargi (MCT_INCROWS (table)) + call fprintf (fd, "%d # MCT_NPROWS\n") + call pargi (MCT_NPROWS (table)) + call fprintf (fd, "%d # MCT_NPCOLS\n") + call pargi (MCT_NPCOLS (table)) + call fprintf (fd, "%d # MCT_NGROWS\n") + call pargi (MCT_NGROWS (table)) + call fprintf (fd, "%d # MCT_NGCOLS\n") + call pargi (MCT_NGCOLS (table)) + call fprintf (fd, "%d # MCT_DATA\n") + call pargi (MCT_DATA (table)) + + # Loop over rows. + nrows = MCT_NPROWS (table) + lastcol = MCT_MAXCOL (table) + do row = 1, nrows { + + # In the last row the column loop should go only until the highest + # column. + if (row == nrows) + lastcol = MCT_NPCOLS (table) + + # Loop over columns. + for (col = 1; col <= lastcol; col = col + 1) { + switch (MCT_TYPE (table)) { + case TY_CHAR: + call fprintf (fd, "%c ") + call pargc (mct_getc (table, row, col)) + case TY_SHORT: + call fprintf (fd, "%d ") + call pargs (mct_gets (table, row, col)) + case TY_INT: + call fprintf (fd, "%d ") + call pargi (mct_geti (table, row, col)) + case TY_LONG: + call fprintf (fd, "%d ") + call pargl (mct_getl (table, row, col)) + case TY_REAL: + call fprintf (fd, "%g ") + call pargr (mct_getr (table, row, col)) + case TY_DOUBLE: + call fprintf (fd, "%g ") + call pargd (mct_getd (table, row, col)) + case TY_COMPLEX: + call fprintf (fd, "%z ") + call pargx (mct_getx (table, row, col)) + case TY_POINTER: + call fprintf (fd, "%d ") + call pargi (mct_getp (table, row, col)) + default: + call error (0, "mct_save: Unknown data type") + } + } + call fprintf (fd, "\n") + } + + # Close file. + call close (fd) +end diff --git a/noao/digiphot/photcal/mctable/mctsget.gx b/noao/digiphot/photcal/mctable/mctsget.gx new file mode 100644 index 00000000..3f8d6bfb --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctsget.gx @@ -0,0 +1,42 @@ +include "../lib/mctable.h" + + +$for (csilrdxp) +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sget$t (table, value) + +pointer table # table descriptor +PIXEL value # data value (output) + +int row, col # next row, and column +PIXEL mct_get$t() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_PIXEL) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_get$t (table, row, col)) + return (EOF) + else + return (OK) +end +$endfor diff --git a/noao/digiphot/photcal/mctable/mctsget.x b/noao/digiphot/photcal/mctable/mctsget.x new file mode 100644 index 00000000..b0361841 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctsget.x @@ -0,0 +1,307 @@ +include "../lib/mctable.h" + + + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetc (table, value) + +pointer table # table descriptor +char value # data value (output) + +int row, col # next row, and column +char mct_getc() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_CHAR) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getc (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgets (table, value) + +pointer table # table descriptor +short value # data value (output) + +int row, col # next row, and column +short mct_gets() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_SHORT) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_gets (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgeti (table, value) + +pointer table # table descriptor +int value # data value (output) + +int row, col # next row, and column +int mct_geti() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_INT) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_geti (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetl (table, value) + +pointer table # table descriptor +long value # data value (output) + +int row, col # next row, and column +long mct_getl() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_LONG) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getl (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetr (table, value) + +pointer table # table descriptor +real value # data value (output) + +int row, col # next row, and column +real mct_getr() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_REAL) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getr (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetd (table, value) + +pointer table # table descriptor +double value # data value (output) + +int row, col # next row, and column +double mct_getd() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_DOUBLE) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getd (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetx (table, value) + +pointer table # table descriptor +complex value # data value (output) + +int row, col # next row, and column +complex mct_getx() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_COMPLEX) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getx (table, row, col)) + return (EOF) + else + return (OK) +end + +# MCT_SGET - Get value sequentally (generic) + +int procedure mct_sgetp (table, value) + +pointer table # table descriptor +pointer value # data value (output) + +int row, col # next row, and column +pointer mct_getp() + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_sget: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sget: Bad magic number") + + # Check table type. + if (MCT_TYPE (table) != TY_POINTER) + call error (0, "mct_sget: Wrong table type") + + # Get next position. + row = max (MCT_NGROWS (table), 1) + col = MCT_NGCOLS (table) + 1 + + # Test if it's necessary to go to the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Get value and return status. + iferr (value = mct_getp (table, row, col)) + return (EOF) + else + return (OK) +end diff --git a/noao/digiphot/photcal/mctable/mctshrink.x b/noao/digiphot/photcal/mctable/mctshrink.x new file mode 100644 index 00000000..6a88f230 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctshrink.x @@ -0,0 +1,31 @@ +include "../lib/mctable.h" + + +# MCT_SHRINK - Free unused table memory + +procedure mct_shrink (table) + +pointer table # table descriptor + +int lsize, psize + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_shrink: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_shrink: Bad magic number") + + # Compute aproximate logical size, and exact physical + # sizes. This might produce a little bit of space wasted. + + lsize = MCT_NPROWS (table) * MCT_MAXCOL (table) + psize = MCT_MAXROW (table) * MCT_MAXCOL (table) + + # Reallocate table sapace and update physical size. + if (lsize != psize) { + call realloc (MCT_DATA (table), lsize, MCT_TYPE (table)) + MCT_MAXROW (table) = MCT_NPROWS (table) + MCT_INCROWS (table) = GROWFACTOR (MCT_MAXROW (table)) + } +end diff --git a/noao/digiphot/photcal/mctable/mctsput.gx b/noao/digiphot/photcal/mctable/mctsput.gx new file mode 100644 index 00000000..5b1b92f2 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctsput.gx @@ -0,0 +1,40 @@ +include "../lib/mctable.h" + + +$for (csilrdxp) +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sput$t (table, value) + +pointer table # table descriptor +PIXEL value # data value + +int row, col # nxt row, and column +errchk mct_put$t + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_PIXEL) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_put$t (table, row, col, value) +end +$endfor diff --git a/noao/digiphot/photcal/mctable/mctsput.x b/noao/digiphot/photcal/mctable/mctsput.x new file mode 100644 index 00000000..e5adbba5 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mctsput.x @@ -0,0 +1,291 @@ +include "../lib/mctable.h" + + + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputc (table, value) + +pointer table # table descriptor +char value # data value + +int row, col # nxt row, and column +errchk mct_putc + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_CHAR) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putc (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputs (table, value) + +pointer table # table descriptor +short value # data value + +int row, col # nxt row, and column +errchk mct_puts + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_SHORT) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_puts (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputi (table, value) + +pointer table # table descriptor +int value # data value + +int row, col # nxt row, and column +errchk mct_puti + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_INT) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_puti (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputl (table, value) + +pointer table # table descriptor +long value # data value + +int row, col # nxt row, and column +errchk mct_putl + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_LONG) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putl (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputr (table, value) + +pointer table # table descriptor +real value # data value + +int row, col # nxt row, and column +errchk mct_putr + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_REAL) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putr (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputd (table, value) + +pointer table # table descriptor +double value # data value + +int row, col # nxt row, and column +errchk mct_putd + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_DOUBLE) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putd (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputx (table, value) + +pointer table # table descriptor +complex value # data value + +int row, col # nxt row, and column +errchk mct_putx + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_COMPLEX) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putx (table, row, col, value) +end + +# MCT_SPUT - Put value sequentally (generic) + +procedure mct_sputp (table, value) + +pointer table # table descriptor +pointer value # data value + +int row, col # nxt row, and column +errchk mct_putp + +begin + # Check pointer and magic number + if (table == NULL) + call error (0, "mct_sput: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_sput: Bad magic number") + + # Check table type + if (MCT_TYPE (table) != TY_POINTER) + call error (0, "mct_sput: Wrong table type") + + # Get next position + row = max (MCT_NPROWS (table), 1) + col = MCT_NPCOLS (table) + 1 + + # Test if it's necessary to go to + # the next row. + if (col > MCT_MAXCOL (table)) { + col = 1 + row = row + 1 + } + + # Enter value + call mct_putp (table, row, col, value) +end diff --git a/noao/digiphot/photcal/mctable/mcttype.x b/noao/digiphot/photcal/mctable/mcttype.x new file mode 100644 index 00000000..a31bbf10 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mcttype.x @@ -0,0 +1,19 @@ +include "../lib/mctable.h" + + +# MCT_TYPE - Return table type. + +int procedure mct_type (table) + +pointer table # table descriptor + +begin + # Check pointer and magic number. + if (table == NULL) + call error (0, "mct_type: Null table pointer") + if (MCT_MAGIC (table) != MAGIC) + call error (0, "mct_type: Bad magic number") + + # Return type. + return (MCT_TYPE (table)) +end diff --git a/noao/digiphot/photcal/mctable/mkpkg b/noao/digiphot/photcal/mctable/mkpkg new file mode 100644 index 00000000..a9e1e7d0 --- /dev/null +++ b/noao/digiphot/photcal/mctable/mkpkg @@ -0,0 +1,71 @@ +# mctable mkpkg file (Mon Jan 21 14:53:01 CST 1991) + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +generic: + $set GEN = "$$generic -k -t csilrdxp" + + $ifnewer (mctclear.gx, mctclear.x) + $generic -k -o mctclear.x mctclear.gx + $endif + $ifnewer (mctcopy.gx, mctcopy.x) + $generic -k -o mctcopy.x mctcopy.gx + $endif + $ifnewer (mctget.gx, mctget.x) + $generic -k -o mctget.x mctget.gx + $endif + $ifnewer (mctput.gx, mctput.x) + $generic -k -o mctput.x mctput.gx + $endif + $ifnewer (mctrestore.gx, mctrestore.x) + $generic -k -o mctrestore.x mctrestore.gx + $endif + $ifnewer (mctsget.gx, mctsget.x) + $generic -k -o mctsget.x mctsget.gx + $endif + $ifnewer (mctsput.gx, mctsput.x) + $generic -k -o mctsput.x mctsput.gx + $endif + + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + mctalloc.x "../lib/mctable.h" + mctclear.x "../lib/mctable.h" + mctcopy.x "../lib/mctable.h" + mctfree.x "../lib/mctable.h" + mctget.x "../lib/mctable.h" + mctgetbuf.x "../lib/mctable.h" + mctgetrow.x "../lib/mctable.h" + mctindef.x "../lib/mctable.h" + mctmaxcol.x "../lib/mctable.h" + mctmaxrow.x "../lib/mctable.h" + mctncols.x "../lib/mctable.h" + mctnrows.x "../lib/mctable.h" + mctput.x "../lib/mctable.h" + mctreset.x "../lib/mctable.h" + mctrestore.x "../lib/mctable.h" + mctrew.x "../lib/mctable.h" + mctsave.x "../lib/mctable.h" + mctsget.x "../lib/mctable.h" + mctshrink.x "../lib/mctable.h" + mctsput.x "../lib/mctable.h" + mcttype.x "../lib/mctable.h" + ; + +zzdebug: + $ifeq (USE_GENERIC, yes) + $ifnewer (zzdebug.gx, zzdebug.x) + $generic -k -o zzdebug.x zzdebug.gx + $endif + $endif + + $omake zzdebug.x + $link zzdebug.o ../../libpkg.a -o zzdebug.e + $delete zzdebug.o + ; diff --git a/noao/digiphot/photcal/mctable/zzdebug.gx b/noao/digiphot/photcal/mctable/zzdebug.gx new file mode 100644 index 00000000..b7c091a7 --- /dev/null +++ b/noao/digiphot/photcal/mctable/zzdebug.gx @@ -0,0 +1,1318 @@ +include <ctotok.h> +include <error.h> +include <ctype.h> +include "mctable.h" + +task mctable = t_mctable + +# Types +define TYPES "|char|short|int|long|real|double|complex|pointer|" +define TYPE_CHAR 1 +define TYPE_SHORT 2 +define TYPE_INT 3 +define TYPE_LONG 4 +define TYPE_REAL 5 +define TYPE_DOUBLE 6 +define TYPE_COMPLEX 7 +define TYPE_POINTER 8 + +# File modes +define MODES "|write_only|read_write|new_file|temp_file|" +define MODE_WRITE_ONLY 1 +define MODE_READ_WRITE 2 +define MODE_NEW_FILE 3 +define MODE_TEMP_FILE 4 + +# Commands +define COMMANDS "|allocate|free|copy|save|restore|\ + |reset|shrink|clear|nrows|ncols|maxrows|maxcol|type|\ + |getbuf|getrow|getrandom|putrandom|\ + |rewind|getsequential|putsequential|\ + |data|header|help|tables|time|quit|" +define ALLOCATE 1 +define FREE 2 +define COPY 3 +define SAVE 4 +define RESTORE 5 +# newline 6 +define RESET 7 +define SHRINK 8 +define CLEAR 9 +define NROWS 10 +define NCOLS 11 +define MAXROW 12 +define MAXCOL 13 +define TYPE 14 +# newline 15 +define GETBUF 16 +define GETROW 17 +define GETRAN 18 +define PUTRAN 19 +# newline 20 +define REWIND 21 +define GETSEQ 22 +define PUTSEQ 23 +# newline 24 +define DATA 25 +define HEADER 26 +define HELP 27 +define TABLES 28 +define TIME 29 +define QUIT 30 + +# Max number of tables +define MAX_TABLES 10 + + +# MCTABLE -- Test MCTABLE package. + +procedure t_mctable() + +bool timeit # time commands ? +char line[SZ_LINE] # input line +char key[SZ_FNAME] +char cmd[SZ_LINE] # command string +int ncmd # command number +int i, ip +long svtime[2] +pointer table[MAX_TABLES] # table pointers + +int getline() +int strdic(), strlen() +int strext() + +begin + # Clear table pointers + call amovki (NULL, table, MAX_TABLES) + + # Do not time commands + timeit = false + + # Print initial message + call printf ("Multicolumn table test program\n") + call printf ("Type `help` to get a list of commands\n\n") + + # Loop reading commands + repeat { + + # Get next command + call printf ("mctable> ") + call flush (STDOUT) + if (getline (STDIN, line) == EOF) { + call printf ("\n") + break + } + line[strlen (line)] = EOS + + # Extract command from line + ip = 1 + if (strext (line, ip, " ", YES, cmd, SZ_LINE) == 0) + next + ncmd = strdic (cmd, cmd, SZ_LINE, COMMANDS) + if (ncmd == 0) { + call eprintf ("Unknown or ambiguous command (%s)\n") + call pargstr (cmd) + next + } + + # Time command + if (timeit) + call sys_mtime (svtime) + + switch (ncmd) { + case ALLOCATE: + call zzallocate (table, line, ip) + + case FREE: + call zzfree (table, line, ip) + + case COPY: + call zzcopy (table, line, ip) + + case SAVE: + call zzsave (table, line, ip) + + case RESTORE: + call zzrestore (table, line, ip) + + case RESET: + call zzreset (table, line, ip) + + case SHRINK: + call zzshrink (table, line, ip) + + case CLEAR: + call zzclear (table, line, ip) + + case NROWS: + call zznrows (table, line, ip) + + case NCOLS: + call zzncols (table, line, ip) + + case MAXROW: + call zzmaxrow (table, line, ip) + + case MAXCOL: + call zzmaxcol (table, line, ip) + + case TYPE: + call zztype (table, line, ip) + + case GETBUF: + call zzgetbuf (table, line, ip) + + case GETROW: + call zzgetrow (table, line, ip) + + case GETRAN: + call zzgetran (table, line, ip) + + case PUTRAN: + call zzputran (table, line, ip) + + case REWIND: + call zzrewind (table, line, ip) + + case GETSEQ: + call zzgetseq (table, line, ip) + + case PUTSEQ: + call zzputseq (table, line, ip) + + case DATA: + call zzdata (table, line, ip) + + case HEADER: + call zzheader (table, line, ip) + + case HELP: + call zzhelp (STDOUT) + + case TABLES: + call printf ("table..\n") + do i = 1, MAX_TABLES { + call printf ("%d\t%d\n") + call pargi (i) + call pargi (table[i]) + } + call flush (STDOUT) + + case TIME: + timeit = !timeit + if (timeit) + call printf ("time..\n") + else + call printf ("do not time..\n") + call flush (STDOUT) + + case QUIT: + call printf ("quit..\n") + call flush (STDOUT) + return + + default: + call eprintf ("Syntax error\n") + } + + if (timeit) + call sys_ptime (STDOUT, key, svtime) + } +end + + +# ZZALLOCATE -- Allocate table. + +procedure zzallocate (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # character pointer + +int tnum, nrows, ncols, type + +begin + call printf ("allocate..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, nrows) + call zzgeti (line, ip, ncols) + } then { + call erract (EA_WARN) + return + } + + iferr (call mct_alloc (table[tnum], nrows, ncols, type)) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) allocated, nrows = (%d), ncols = (%d), type = (%d)\n") + call pargi (tnum) + call pargi (nrows) + call pargi (ncols) + call pargi (type) + + call flush (STDOUT) +end + + +# ZZFREE -- Free table. + +procedure zzfree (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("free..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_free (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) freed\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZCOPY -- Copy one table into another. + +procedure zzcopy (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum1, tnum2 + +begin + call printf ("copy..\n") + iferr { + call zzgtable (line, ip, tnum1) + call zzgtable (line, ip, tnum2) + } then { + call erract (EA_WARN) + return + } + iferr (call mct_copy (table[tnum1], table[tnum2])) { + call erract (EA_WARN) + return + } + call printf ("Table (%d) copied into table (%d)\n") + call pargi (tnum1) + call pargi (tnum2) + + call flush (STDOUT) +end + + +# ZZSAVE -- Save table into a file. + +procedure zzsave (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +char fname[SZ_FNAME] +int fmode, tnum + +begin + call printf ("save..\n") + iferr { + call zzgtable (line, ip, tnum) + call zzgstr (line, ip, fname) + call zzgmode (line, ip, fmode) + } then { + call erract (EA_WARN) + return + } + iferr (call mct_save (fname, fmode, table[tnum])) { + call erract (EA_WARN) + return + } + call printf ("Table (%d) saved into file (%s)\n") + call pargi (tnum) + call pargstr (fname) + + call flush (STDOUT) +end + + +# ZZRESTORE -- Restore table from a file. + +procedure zzrestore (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +char fname[SZ_FNAME] +int tnum + +begin + call printf ("restore..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgstr (line, ip, fname, SZ_FNAME) + } then { + call erract (EA_WARN) + return + } + + iferr (call mct_restore (fname, table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) restored from file (%s)\n") + call pargi (tnum) + call pargstr (fname) + + call flush (STDOUT) +end + + +# ZZRESET -- Reset table counters. + +procedure zzreset (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("reset..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_reset (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) reseted\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZSHRINK -- Shibk table. + +procedure zzshrink (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("shrink..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_shrink (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) shrunk\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZCLEAR -- Clear table. + +procedure zzclear (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum +$for (csilrdxp) +PIXEL $tval +$endfor + +begin + call printf ("clear..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + call zzget$t (line, ip, $tval) + $endfor + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + iferr (call mct_clear$t (table[tnum], $tval)) { + call erract (EA_WARN) + return + } + $endfor + } + + call printf ("Table (%d) cleared\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZNROWS -- Get number of rows in table. + +procedure zznrows (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, nrows + +int mct_nrows() + +begin + call printf ("nrows..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (nrows = mct_nrows (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), nrows = (%d)\n") + call pargi (tnum) + call pargi (nrows) + + call flush (STDOUT) +end + + +# ZZNCOLS -- Get number of columns in table. + +procedure zzncols (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, ncols + +int mct_ncols() + +begin + call printf ("ncols..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (ncols = mct_ncols (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), ncols = (%d)\n") + call pargi (tnum) + call pargi (ncols) + + call flush (STDOUT) +end + + +# ZZMAXROW -- Get maximum number of rows in table. + +procedure zzmaxrow (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, nrows + +int mct_maxrow() + +begin + call printf ("maxrow..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (nrows = mct_maxrow (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), maxrow = (%d)\n") + call pargi (tnum) + call pargi (nrows) + + call flush (STDOUT) +end + + +# ZZMAXCOL -- Get maximum number of columns in table. + +procedure zzmaxcol (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, ncols + +int mct_maxcol() + +begin + call printf ("maxcol..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (ncols = mct_maxcol (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), maxcol = (%d)\n") + call pargi (tnum) + call pargi (ncols) + + call flush (STDOUT) +end + + +# ZZTYPE -- Get table type. + +procedure zztype (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, type + +int mct_type() + +begin + call printf ("type..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (type = mct_type (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), type = (%d)\n") + call pargi (tnum) + call pargi (type) + + call flush (STDOUT) +end + + +# ZZGETBUF -- Get data buffer pointer. + +procedure zzgetbuf (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum +pointer pval + +pointer mct_getbuf() + +begin + call printf ("getbuf..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (pval = mct_getbuf (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), buffer = (%d)\n") + call pargi (tnum) + call pargi (pval) + + call flush (STDOUT) +end + + +# ZZGETROW -- Get row pointer. + +procedure zzgetrow (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, row +pointer pval + +pointer mct_getrow() + +begin + call printf ("getrow..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgeti (line, ip, row) + } then { + call erract (EA_WARN) + return + } + + iferr (pval = mct_getrow (table[tnum], row)) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), row buffer (%d) = (%d)\n") + call pargi (tnum) + call pargi (row) + call pargi (pval) + + call flush (STDOUT) +end + + +# ZZGETRAN -- Get value randomly from table. + +procedure zzgetran (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, row, col +$for (csilrdxp) +PIXEL $tval +$endfor + +$for (csilrdxp) +PIXEL mct_get$t() +$endfor + +begin + call printf ("getrandom..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, row) + call zzgeti (line, ip, col) + } then { + call erract (EA_WARN) + return + } + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + iferr ($tval = mct_get$t (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + $if (datatype == p) + call pargi ($tval) + $else + call parg$t ($tval) + $endif + $endfor + } + + call flush (STDOUT) +end + + +# ZZPUTRAN -- Put value randomly in table. + +procedure zzputran (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, row, col +$for (csilrdxp) +PIXEL $tval +$endfor + +begin + call printf ("putrandom..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, row) + call zzgeti (line, ip, col) + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + call zzget$t (line, ip, $tval) + $endfor + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + iferr (call mct_put$t (table[tnum], row, col, $tval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + $if (datatype == p) + call pargi ($tval) + $else + call parg$t ($tval) + $endif + $endfor + } + + call flush (STDOUT) +end + + +# ZZREWIND -- Rewind table. + +procedure zzrewind (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("rewind..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_rew (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) rewound\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZGETSEQ -- Get value sequentialy from table. + +procedure zzgetseq (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, stat +$for (csilrdxp) +PIXEL $tval +$endfor + +$for (csilrdxp) +int mct_sget$t() +$endfor + +begin + call printf ("getsequential..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + } then { + call erract (EA_WARN) + return + } + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + iferr (stat = mct_sget$t (table[tnum], $tval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + $if (datatype == p) + call pargi ($tval) + $else + call parg$t ($tval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + $endif + $endfor + } + + call flush (STDOUT) +end + + +# ZZPUTSEQ -- Put value sequentaly. + +procedure zzputseq (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum +$for (csilrdxp) +PIXEL $tval +$endfor + +begin + call printf ("putsequential..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + call zzget$t (line, ip, $tval) + $endfor + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + iferr (call mct_sput$t (table[tnum], $tval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + $if (datatype == p) + call pargi ($tval) + $else + call parg$t ($tval) + $endif + $endfor + } + + call flush (STDOUT) +end + + +# ZZDATA -- Display table data. + +procedure zzdata (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, type, offset +int row, row1, row2, col +$for (csilrdxp) +PIXEL $tval +$endfor + +begin + call printf ("data..\n") + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + iferr (call zzgeti (line, ip, row1)) + row1 = 1 + else + row1 = min (max (row1, 1), MCT_MAXROW (table[tnum])) + iferr (call zzgeti (line, ip, row2)) + row2 = MCT_MAXROW (table[tnum]) + else + row2 = max (min (row2, MCT_MAXROW (table[tnum])), row1) + +call eprintf ("table[%d]=%d\n") +call pargi (tnum) +call pargi (table[tnum]) + + if (table[tnum] == NULL) { + call eprintf ("ERROR: Null table pointer\n") + return + } + if (MCT_DATA (table[tnum]) == NULL) { + call eprintf ("ERROR: Null data pointer\n") + return + } + + type = MCT_TYPE (table[tnum]) + + call printf ("(%d x %d) -> (%d:%d)\n") + call pargi (MCT_MAXROW (table[tnum])) + call pargi (MCT_MAXCOL (table[tnum])) + call pargi (row1) + call pargi (row2) + + do row = row1, row2 { + + call printf ("%d\t") + call pargi (row) + + do col = 1, MCT_MAXCOL (table[tnum]) { + + offset = MCT_MAXCOL (table[tnum]) * (row - 1) + col - 1 + + switch (type) { + $for (csilrdxp) + case TY_PIXEL: + $if (datatype == p) + $tval = Memi[MCT_DATA (table[tnum]) + offset] + $else + $tval = Mem$t[MCT_DATA (table[tnum]) + offset] + $endif + call printf (" %g") + $if (datatype == p) + call pargi ($tval) + $else + call parg$t ($tval) + $endif + $endfor + } + } + + call printf ("\n") + call flush (STDOUT) + } + + call flush (STDOUT) +end + + +# ZZHEADER -- Print table header. + +procedure zzheader (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("header..\n") + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + if (table[tnum] == NULL) { + call eprintf ("ERROR: Null table pointer\n") + return + } + call printf ("magic %d\n") + call pargi (MCT_MAGIC (table[tnum])) + call printf ("type %d\n") + call pargi (MCT_TYPE (table[tnum])) + call printf ("incrow %d\n") + call pargi (MCT_INCROWS (table[tnum])) + call printf ("maxrow %d\n") + call pargi (MCT_MAXROW (table[tnum])) + call printf ("maxcol %d\n") + call pargi (MCT_MAXCOL (table[tnum])) + call printf ("nprows %d\n") + call pargi (MCT_NPROWS (table[tnum])) + call printf ("npcols %d\n") + call pargi (MCT_NPCOLS (table[tnum])) + call printf ("ngrows %d\n") + call pargi (MCT_NGROWS (table[tnum])) + call printf ("ngcols %d\n") + call pargi (MCT_NGCOLS (table[tnum])) + call printf ("data %d\n") + call pargi (MCT_DATA (table[tnum])) + + call flush (STDOUT) +end + + +# ZZHELP -- Print command dictionary for interpreter. + +procedure zzhelp () + +begin + call printf ("help..\n") + call printf ("allocate <table> <type> <nrows> <ncols>\n") + call printf ("free <table>\n") + call printf ("copy <table> <table>\n\n") + call printf ("save <table> <fname> <fmode>\n") + call printf ("restore <table> <fname>\n\n") + call printf ("reset <table>\n") + call printf ("rewind <table>\n") + call printf ("clear <table> <value>\n\n") + call printf ("maxrow <table>\n") + call printf ("maxcol <table>\n") + call printf ("nrows <table>\n") + call printf ("ncols <table>\n") + call printf ("type <table>\n\n") + call printf ("getbuf <table>\n") + call printf ("getrow <table> <row>\n\n") + call printf ("getrandom <table> <type> <row> <col>\n") + call printf ("putrandom <table> <type> <row> <col> <value>\n\n") + call printf ("putsequential <table> <type> <value>\n") + call printf ("getsequential <table> <type>\n\n") + call printf ("tables\n") + call printf ("header <table>\n") + call printf ("data <table> <row1> <row2>\n") + call printf ("help\n") + call printf ("quit\n") + call printf ("\nwhere:\n") + call printf (" <table> = 1..10\n") + call printf (" <type> = %s\n") + call pargstr (TYPES) + call printf (" <fmode> = %s\n") + call pargstr (MODES) + + call flush (STDOUT) +end + + +# ZZGTABLE -- Get table number and check its range. + +procedure zzgtable (line, ip, num) + +char line[ARB] # command line +int ip # input character pointer +int num # table number + +errchk zzgeti() + +begin + call zzgeti (line, ip, num) + if (num < 1 || num > MAX_TABLES) + call error (0, "Table number out of range") +end + + +# ZZGTYPE -- Convert from string to integer type + +procedure zzgtype (line, ip, type) + +char line[ARB] # input line +int ip # input character pointer +int type # table type (output) + +char strval[SZ_LINE] +int ntype + +int strdic() + +begin + call zzgstr (line, ip, strval, SZ_LINE) + + ntype = strdic (strval, strval, SZ_LINE, TYPES) + + switch (ntype) { + case TYPE_CHAR: + type = TY_CHAR + case TYPE_SHORT: + type = TY_SHORT + case TYPE_INT: + type = TY_INT + case TYPE_LONG: + type = TY_LONG + case TYPE_REAL: + type = TY_REAL + case TYPE_DOUBLE: + type = TY_DOUBLE + case TYPE_COMPLEX: + type = TY_COMPLEX + case TYPE_POINTER: + type = TY_POINTER + default: + call error (0, "Unknown table type") + } +end + + +# ZZGMODE -- Get mode string and convert it into a file mode. + +procedure zzgmode (line, ip, mode) + +char line[ARB] # input line +int ip # input character pointer +int mode # file mode (output) + +char strval[SZ_LINE] +int nmode + +int strdic() + +begin + call zzgstr (line, ip, strval, SZ_LINE) + + nmode = strdic (strval, strval, SZ_LINE, MODES) + + switch (nmode) { + case MODE_WRITE_ONLY: + mode = WRITE_ONLY + case MODE_READ_WRITE: + mode = READ_WRITE + case MODE_NEW_FILE: + mode = NEW_FILE + case MODE_TEMP_FILE: + mode = TEMP_FILE + default: + call error (0, "zzgmode: Unknown file mode") + } +end + + +$for (csilrdxp) +# ZZGET -- Get number from command line + +procedure zzget$t (line, ip, $tval) + +char line[ARB] # command line +int ip # input character pointer +PIXEL $tval # number + +char number[SZ_LINE] +int op + +$if (datatype == csp) +$if (datatype == c) +int cctoc() +$endif +$if (datatype == s) +int ctoi() +$endif +$if (datatype == p) +int ctoi() +$endif +$else +int cto$t() +$endif +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + $if (datatype == csp) + $if (datatype == c) + if (cctoc (number, op, cval) == 0) + call error (0, "zzget: Impossible number conversion\n") + $endif + $if (datatype == s) + if (ctoi (number, op, int (sval)) == 0) + call error (0, "zzget: Impossible number conversion\n") + $endif + $if (datatype == p) + if (ctoi (number, op, pval) == 0) + call error (0, "zzget: Impossible number conversion\n") + $endif + $else + if (cto$t (number, op, $tval) == 0) + call error (0, "zzget: Impossible number conversion\n") + $endif +end +$endfor + + +# ZZGSTR -- Get string from command line + +int procedure zzgstr (line, ip, strval, maxch) + +char line[ARB] # command line +int ip # input character pointer +char strval[maxch] # output string +int maxch # max number of characters + +int strext() + +begin + if (strext (line, ip, " ", YES, strval, maxch) == 0) + call error (0, "Missing string parameter") +end diff --git a/noao/digiphot/photcal/mctable/zzdebug.x b/noao/digiphot/photcal/mctable/zzdebug.x new file mode 100644 index 00000000..e234e6d0 --- /dev/null +++ b/noao/digiphot/photcal/mctable/zzdebug.x @@ -0,0 +1,2066 @@ +include <ctotok.h> +include <error.h> +include <ctype.h> +include "../lib/mctable.h" + +task mctable = t_mctable + +# Types +define TYPES "|char|short|int|long|real|double|complex|pointer|" +define TYPE_CHAR 1 +define TYPE_SHORT 2 +define TYPE_INT 3 +define TYPE_LONG 4 +define TYPE_REAL 5 +define TYPE_DOUBLE 6 +define TYPE_COMPLEX 7 +define TYPE_POINTER 8 + +# File modes +define MODES "|write_only|read_write|new_file|temp_file|" +define MODE_WRITE_ONLY 1 +define MODE_READ_WRITE 2 +define MODE_NEW_FILE 3 +define MODE_TEMP_FILE 4 + +# Commands +define COMMANDS "|allocate|free|copy|save|restore|\ + |reset|shrink|clear|nrows|ncols|maxrows|maxcol|type|\ + |getbuf|getrow|getrandom|putrandom|\ + |rewind|getsequential|putsequential|\ + |data|header|help|tables|time|quit|" +define ALLOCATE 1 +define FREE 2 +define COPY 3 +define SAVE 4 +define RESTORE 5 +# newline 6 +define RESET 7 +define SHRINK 8 +define CLEAR 9 +define NROWS 10 +define NCOLS 11 +define MAXROW 12 +define MAXCOL 13 +define TYPE 14 +# newline 15 +define GETBUF 16 +define GETROW 17 +define GETRAN 18 +define PUTRAN 19 +# newline 20 +define REWIND 21 +define GETSEQ 22 +define PUTSEQ 23 +# newline 24 +define DATA 25 +define HEADER 26 +define HELP 27 +define TABLES 28 +define TIME 29 +define QUIT 30 + +# Max number of tables +define MAX_TABLES 10 + + +# MCTABLE -- Test MCTABLE package. + +procedure t_mctable() + +bool timeit # time commands ? +char line[SZ_LINE] # input line +char key[SZ_FNAME] +char cmd[SZ_LINE] # command string +int ncmd # command number +int i, ip +long svtime[2] +pointer table[MAX_TABLES] # table pointers + +int getline() +int strdic(), strlen() +int strext() + +begin + # Clear table pointers + call amovki (NULL, table, MAX_TABLES) + + # Do not time commands + timeit = false + + # Print initial message + call printf ("Multicolumn table test program\n") + call printf ("Type `help` to get a list of commands\n\n") + + # Loop reading commands + repeat { + + # Get next command + call printf ("mctable> ") + call flush (STDOUT) + if (getline (STDIN, line) == EOF) { + call printf ("\n") + break + } + line[strlen (line)] = EOS + + # Extract command from line + ip = 1 + if (strext (line, ip, " ", YES, cmd, SZ_LINE) == 0) + next + ncmd = strdic (cmd, cmd, SZ_LINE, COMMANDS) + if (ncmd == 0) { + call eprintf ("Unknown or ambiguous command (%s)\n") + call pargstr (cmd) + next + } + + # Time command + if (timeit) + call sys_mtime (svtime) + + switch (ncmd) { + case ALLOCATE: + call zzallocate (table, line, ip) + + case FREE: + call zzfree (table, line, ip) + + case COPY: + call zzcopy (table, line, ip) + + case SAVE: + call zzsave (table, line, ip) + + case RESTORE: + call zzrestore (table, line, ip) + + case RESET: + call zzreset (table, line, ip) + + case SHRINK: + call zzshrink (table, line, ip) + + case CLEAR: + call zzclear (table, line, ip) + + case NROWS: + call zznrows (table, line, ip) + + case NCOLS: + call zzncols (table, line, ip) + + case MAXROW: + call zzmaxrow (table, line, ip) + + case MAXCOL: + call zzmaxcol (table, line, ip) + + case TYPE: + call zztype (table, line, ip) + + case GETBUF: + call zzgetbuf (table, line, ip) + + case GETROW: + call zzgetrow (table, line, ip) + + case GETRAN: + call zzgetran (table, line, ip) + + case PUTRAN: + call zzputran (table, line, ip) + + case REWIND: + call zzrewind (table, line, ip) + + case GETSEQ: + call zzgetseq (table, line, ip) + + case PUTSEQ: + call zzputseq (table, line, ip) + + case DATA: + call zzdata (table, line, ip) + + case HEADER: + call zzheader (table, line, ip) + + case HELP: + call zzhelp () + + case TABLES: + call printf ("table..\n") + do i = 1, MAX_TABLES { + call printf ("%d\t%d\n") + call pargi (i) + call pargi (table[i]) + } + call flush (STDOUT) + + case TIME: + timeit = !timeit + if (timeit) + call printf ("time..\n") + else + call printf ("do not time..\n") + call flush (STDOUT) + + case QUIT: + call printf ("quit..\n") + call flush (STDOUT) + return + + default: + call eprintf ("Syntax error\n") + } + + if (timeit) + call sys_ptime (STDOUT, key, svtime) + } +end + + +# ZZALLOCATE -- Allocate table. + +procedure zzallocate (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # character pointer + +int tnum, nrows, ncols, type + +begin + call printf ("allocate..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, nrows) + call zzgeti (line, ip, ncols) + } then { + call erract (EA_WARN) + return + } + + iferr (call mct_alloc (table[tnum], nrows, ncols, type)) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) allocated, nrows = (%d), ncols = (%d), type = (%d)\n") + call pargi (tnum) + call pargi (nrows) + call pargi (ncols) + call pargi (type) + + call flush (STDOUT) +end + + +# ZZFREE -- Free table. + +procedure zzfree (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("free..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_free (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) freed\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZCOPY -- Copy one table into another. + +procedure zzcopy (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum1, tnum2 + +begin + call printf ("copy..\n") + iferr { + call zzgtable (line, ip, tnum1) + call zzgtable (line, ip, tnum2) + } then { + call erract (EA_WARN) + return + } + iferr (call mct_copy (table[tnum1], table[tnum2])) { + call erract (EA_WARN) + return + } + call printf ("Table (%d) copied into table (%d)\n") + call pargi (tnum1) + call pargi (tnum2) + + call flush (STDOUT) +end + + +# ZZSAVE -- Save table into a file. + +procedure zzsave (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +char fname[SZ_FNAME] +int fmode, tnum + +begin + call printf ("save..\n") + iferr { + call zzgtable (line, ip, tnum) + call zzgstr (line, ip, fname, SZ_FNAME) + call zzgmode (line, ip, fmode) + } then { + call erract (EA_WARN) + return + } + iferr (call mct_save (fname, fmode, table[tnum])) { + call erract (EA_WARN) + return + } + call printf ("Table (%d) saved into file (%s)\n") + call pargi (tnum) + call pargstr (fname) + + call flush (STDOUT) +end + + +# ZZRESTORE -- Restore table from a file. + +procedure zzrestore (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +char fname[SZ_FNAME] +int tnum + +begin + call printf ("restore..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgstr (line, ip, fname, SZ_FNAME) + } then { + call erract (EA_WARN) + return + } + + iferr (call mct_restore (fname, table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) restored from file (%s)\n") + call pargi (tnum) + call pargstr (fname) + + call flush (STDOUT) +end + + +# ZZRESET -- Reset table counters. + +procedure zzreset (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("reset..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_reset (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) reseted\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZSHRINK -- Shibk table. + +procedure zzshrink (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("shrink..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_shrink (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) shrunk\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZCLEAR -- Clear table. + +procedure zzclear (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + +begin + call printf ("clear..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + switch (type) { + + case TY_CHAR: + call zzgetc (line, ip, cval) + + case TY_SHORT: + call zzgets (line, ip, sval) + + case TY_INT: + call zzgeti (line, ip, ival) + + case TY_LONG: + call zzgetl (line, ip, lval) + + case TY_REAL: + call zzgetr (line, ip, rval) + + case TY_DOUBLE: + call zzgetd (line, ip, dval) + + case TY_COMPLEX: + call zzgetx (line, ip, xval) + + case TY_POINTER: + call zzgetp (line, ip, pval) + + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + + case TY_CHAR: + iferr (call mct_clearc (table[tnum], cval)) { + call erract (EA_WARN) + return + } + + case TY_SHORT: + iferr (call mct_clears (table[tnum], sval)) { + call erract (EA_WARN) + return + } + + case TY_INT: + iferr (call mct_cleari (table[tnum], ival)) { + call erract (EA_WARN) + return + } + + case TY_LONG: + iferr (call mct_clearl (table[tnum], lval)) { + call erract (EA_WARN) + return + } + + case TY_REAL: + iferr (call mct_clearr (table[tnum], rval)) { + call erract (EA_WARN) + return + } + + case TY_DOUBLE: + iferr (call mct_cleard (table[tnum], dval)) { + call erract (EA_WARN) + return + } + + case TY_COMPLEX: + iferr (call mct_clearx (table[tnum], xval)) { + call erract (EA_WARN) + return + } + + case TY_POINTER: + iferr (call mct_clearp (table[tnum], pval)) { + call erract (EA_WARN) + return + } + + } + + call printf ("Table (%d) cleared\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZNROWS -- Get number of rows in table. + +procedure zznrows (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, nrows + +int mct_nrows() + +begin + call printf ("nrows..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (nrows = mct_nrows (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), nrows = (%d)\n") + call pargi (tnum) + call pargi (nrows) + + call flush (STDOUT) +end + + +# ZZNCOLS -- Get number of columns in table. + +procedure zzncols (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, ncols + +int mct_ncols() + +begin + call printf ("ncols..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (ncols = mct_ncols (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), ncols = (%d)\n") + call pargi (tnum) + call pargi (ncols) + + call flush (STDOUT) +end + + +# ZZMAXROW -- Get maximum number of rows in table. + +procedure zzmaxrow (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, nrows + +int mct_maxrow() + +begin + call printf ("maxrow..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (nrows = mct_maxrow (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), maxrow = (%d)\n") + call pargi (tnum) + call pargi (nrows) + + call flush (STDOUT) +end + + +# ZZMAXCOL -- Get maximum number of columns in table. + +procedure zzmaxcol (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, ncols + +int mct_maxcol() + +begin + call printf ("maxcol..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (ncols = mct_maxcol (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), maxcol = (%d)\n") + call pargi (tnum) + call pargi (ncols) + + call flush (STDOUT) +end + + +# ZZTYPE -- Get table type. + +procedure zztype (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, type + +int mct_type() + +begin + call printf ("type..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (type = mct_type (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), type = (%d)\n") + call pargi (tnum) + call pargi (type) + + call flush (STDOUT) +end + + +# ZZGETBUF -- Get data buffer pointer. + +procedure zzgetbuf (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum +pointer pval + +pointer mct_getbuf() + +begin + call printf ("getbuf..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (pval = mct_getbuf (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), buffer = (%d)\n") + call pargi (tnum) + call pargi (pval) + + call flush (STDOUT) +end + + +# ZZGETROW -- Get row pointer. + +procedure zzgetrow (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, row +pointer pval + +pointer mct_getrow() + +begin + call printf ("getrow..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgeti (line, ip, row) + } then { + call erract (EA_WARN) + return + } + + iferr (pval = mct_getrow (table[tnum], row)) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d), row buffer (%d) = (%d)\n") + call pargi (tnum) + call pargi (row) + call pargi (pval) + + call flush (STDOUT) +end + + +# ZZGETRAN -- Get value randomly from table. + +procedure zzgetran (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, row, col + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + + +char mct_getc() + +short mct_gets() + +int mct_geti() + +long mct_getl() + +real mct_getr() + +double mct_getd() + +complex mct_getx() + +pointer mct_getp() + + +begin + call printf ("getrandom..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, row) + call zzgeti (line, ip, col) + } then { + call erract (EA_WARN) + return + } + + switch (type) { + + case TY_CHAR: + iferr (cval = mct_getc (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargc (cval) + + case TY_SHORT: + iferr (sval = mct_gets (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargs (sval) + + case TY_INT: + iferr (ival = mct_geti (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargi (ival) + + case TY_LONG: + iferr (lval = mct_getl (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargl (lval) + + case TY_REAL: + iferr (rval = mct_getr (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargr (rval) + + case TY_DOUBLE: + iferr (dval = mct_getd (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargd (dval) + + case TY_COMPLEX: + iferr (xval = mct_getx (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargx (xval) + + case TY_POINTER: + iferr (pval = mct_getp (table[tnum], row, col)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table get (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargi (pval) + + } + + call flush (STDOUT) +end + + +# ZZPUTRAN -- Put value randomly in table. + +procedure zzputran (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, row, col + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + +begin + call printf ("putrandom..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + call zzgeti (line, ip, row) + call zzgeti (line, ip, col) + switch (type) { + + case TY_CHAR: + call zzgetc (line, ip, cval) + + case TY_SHORT: + call zzgets (line, ip, sval) + + case TY_INT: + call zzgeti (line, ip, ival) + + case TY_LONG: + call zzgetl (line, ip, lval) + + case TY_REAL: + call zzgetr (line, ip, rval) + + case TY_DOUBLE: + call zzgetd (line, ip, dval) + + case TY_COMPLEX: + call zzgetx (line, ip, xval) + + case TY_POINTER: + call zzgetp (line, ip, pval) + + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + + case TY_CHAR: + iferr (call mct_putc (table[tnum], row, col, cval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargc (cval) + + case TY_SHORT: + iferr (call mct_puts (table[tnum], row, col, sval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargs (sval) + + case TY_INT: + iferr (call mct_puti (table[tnum], row, col, ival)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargi (ival) + + case TY_LONG: + iferr (call mct_putl (table[tnum], row, col, lval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargl (lval) + + case TY_REAL: + iferr (call mct_putr (table[tnum], row, col, rval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargr (rval) + + case TY_DOUBLE: + iferr (call mct_putd (table[tnum], row, col, dval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargd (dval) + + case TY_COMPLEX: + iferr (call mct_putx (table[tnum], row, col, xval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargx (xval) + + case TY_POINTER: + iferr (call mct_putp (table[tnum], row, col, pval)) { + call erract (EA_WARN) + return + } + + call printf ( + "Table put (%d), type = (%d), row = (%d), col = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (row) + call pargi (col) + call pargi (pval) + + } + + call flush (STDOUT) +end + + +# ZZREWIND -- Rewind table. + +procedure zzrewind (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("rewind..\n") + + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + + iferr (call mct_rew (table[tnum])) { + call erract (EA_WARN) + return + } + + call printf ("Table (%d) rewound\n") + call pargi (tnum) + + call flush (STDOUT) +end + + +# ZZGETSEQ -- Get value sequentialy from table. + +procedure zzgetseq (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum, stat + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + + +int mct_sgetc() + +int mct_sgets() + +int mct_sgeti() + +int mct_sgetl() + +int mct_sgetr() + +int mct_sgetd() + +int mct_sgetx() + +int mct_sgetp() + + +begin + call printf ("getsequential..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + } then { + call erract (EA_WARN) + return + } + + switch (type) { + + case TY_CHAR: + iferr (stat = mct_sgetc (table[tnum], cval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargc (cval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_SHORT: + iferr (stat = mct_sgets (table[tnum], sval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargs (sval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_INT: + iferr (stat = mct_sgeti (table[tnum], ival)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargi (ival) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_LONG: + iferr (stat = mct_sgetl (table[tnum], lval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargl (lval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_REAL: + iferr (stat = mct_sgetr (table[tnum], rval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargr (rval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_DOUBLE: + iferr (stat = mct_sgetd (table[tnum], dval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargd (dval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_COMPLEX: + iferr (stat = mct_sgetx (table[tnum], xval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargx (xval) + if (stat == EOF) + call pargstr ("EOF") + else if (stat == OK) + call pargstr ("OK") + else + call pargstr ("???") + + case TY_POINTER: + iferr (stat = mct_sgetp (table[tnum], pval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table getsequential (%d), type = (%s), value = (%g) (stat=%s)\n") + call pargi (tnum) + call pargi (type) + call pargi (pval) + + } + + call flush (STDOUT) +end + + +# ZZPUTSEQ -- Put value sequentaly. + +procedure zzputseq (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int type, tnum + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + +begin + call printf ("putsequential..\n") + + iferr { + call zzgtable (line, ip, tnum) + call zzgtype (line, ip, type) + switch (type) { + + case TY_CHAR: + call zzgetc (line, ip, cval) + + case TY_SHORT: + call zzgets (line, ip, sval) + + case TY_INT: + call zzgeti (line, ip, ival) + + case TY_LONG: + call zzgetl (line, ip, lval) + + case TY_REAL: + call zzgetr (line, ip, rval) + + case TY_DOUBLE: + call zzgetd (line, ip, dval) + + case TY_COMPLEX: + call zzgetx (line, ip, xval) + + case TY_POINTER: + call zzgetp (line, ip, pval) + + } + } then { + call erract (EA_WARN) + return + } + + switch (type) { + + case TY_CHAR: + iferr (call mct_sputc (table[tnum], cval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargc (cval) + + case TY_SHORT: + iferr (call mct_sputs (table[tnum], sval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargs (sval) + + case TY_INT: + iferr (call mct_sputi (table[tnum], ival)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (ival) + + case TY_LONG: + iferr (call mct_sputl (table[tnum], lval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargl (lval) + + case TY_REAL: + iferr (call mct_sputr (table[tnum], rval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargr (rval) + + case TY_DOUBLE: + iferr (call mct_sputd (table[tnum], dval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargd (dval) + + case TY_COMPLEX: + iferr (call mct_sputx (table[tnum], xval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargx (xval) + + case TY_POINTER: + iferr (call mct_sputp (table[tnum], pval)) { + call erract (EA_WARN) + return + } + call printf ( + "Table putsequential (%d), type = (%d), value = (%g)\n") + call pargi (tnum) + call pargi (type) + call pargi (pval) + + } + + call flush (STDOUT) +end + + +# ZZDATA -- Display table data. + +procedure zzdata (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum, type, offset +int row, row1, row2, col + +char cval + +short sval + +int ival + +long lval + +real rval + +double dval + +complex xval + +pointer pval + + +begin + call printf ("data..\n") + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + iferr (call zzgeti (line, ip, row1)) + row1 = 1 + else + row1 = min (max (row1, 1), MCT_MAXROW (table[tnum])) + iferr (call zzgeti (line, ip, row2)) + row2 = MCT_MAXROW (table[tnum]) + else + row2 = max (min (row2, MCT_MAXROW (table[tnum])), row1) + +call eprintf ("table[%d]=%d\n") +call pargi (tnum) +call pargi (table[tnum]) + + if (table[tnum] == NULL) { + call eprintf ("ERROR: Null table pointer\n") + return + } + if (MCT_DATA (table[tnum]) == NULL) { + call eprintf ("ERROR: Null data pointer\n") + return + } + + type = MCT_TYPE (table[tnum]) + + call printf ("(%d x %d) -> (%d:%d)\n") + call pargi (MCT_MAXROW (table[tnum])) + call pargi (MCT_MAXCOL (table[tnum])) + call pargi (row1) + call pargi (row2) + + do row = row1, row2 { + + call printf ("%d\t") + call pargi (row) + + do col = 1, MCT_MAXCOL (table[tnum]) { + + offset = MCT_MAXCOL (table[tnum]) * (row - 1) + col - 1 + + switch (type) { + + case TY_CHAR: + cval = Memc[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargc (cval) + + case TY_SHORT: + sval = Mems[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargs (sval) + + case TY_INT: + ival = Memi[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargi (ival) + + case TY_LONG: + lval = Meml[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargl (lval) + + case TY_REAL: + rval = Memr[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargr (rval) + + case TY_DOUBLE: + dval = Memd[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargd (dval) + + case TY_COMPLEX: + xval = Memx[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargx (xval) + + case TY_POINTER: + pval = Memi[MCT_DATA (table[tnum]) + offset] + call printf (" %g") + call pargi (pval) + + } + } + + call printf ("\n") + call flush (STDOUT) + } + + call flush (STDOUT) +end + + +# ZZHEADER -- Print table header. + +procedure zzheader (table, line, ip) + +pointer table[MAX_TABLES] # table array +char line[ARB] # command line +int ip # input character pointer + +int tnum + +begin + call printf ("header..\n") + iferr (call zzgtable (line, ip, tnum)) { + call erract (EA_WARN) + return + } + if (table[tnum] == NULL) { + call eprintf ("ERROR: Null table pointer\n") + return + } + call printf ("magic %d\n") + call pargi (MCT_MAGIC (table[tnum])) + call printf ("type %d\n") + call pargi (MCT_TYPE (table[tnum])) + call printf ("incrow %d\n") + call pargi (MCT_INCROWS (table[tnum])) + call printf ("maxrow %d\n") + call pargi (MCT_MAXROW (table[tnum])) + call printf ("maxcol %d\n") + call pargi (MCT_MAXCOL (table[tnum])) + call printf ("nprows %d\n") + call pargi (MCT_NPROWS (table[tnum])) + call printf ("npcols %d\n") + call pargi (MCT_NPCOLS (table[tnum])) + call printf ("ngrows %d\n") + call pargi (MCT_NGROWS (table[tnum])) + call printf ("ngcols %d\n") + call pargi (MCT_NGCOLS (table[tnum])) + call printf ("data %d\n") + call pargi (MCT_DATA (table[tnum])) + + call flush (STDOUT) +end + + +# ZZHELP -- Print command dictionary for interpreter. + +procedure zzhelp () + +begin + call printf ("help..\n") + call printf ("allocate <table> <type> <nrows> <ncols>\n") + call printf ("free <table>\n") + call printf ("copy <table> <table>\n\n") + call printf ("save <table> <fname> <fmode>\n") + call printf ("restore <table> <fname>\n\n") + call printf ("reset <table>\n") + call printf ("rewind <table>\n") + call printf ("clear <table> <value>\n\n") + call printf ("maxrow <table>\n") + call printf ("maxcol <table>\n") + call printf ("nrows <table>\n") + call printf ("ncols <table>\n") + call printf ("type <table>\n\n") + call printf ("getbuf <table>\n") + call printf ("getrow <table> <row>\n\n") + call printf ("getrandom <table> <type> <row> <col>\n") + call printf ("putrandom <table> <type> <row> <col> <value>\n\n") + call printf ("putsequential <table> <type> <value>\n") + call printf ("getsequential <table> <type>\n\n") + call printf ("tables\n") + call printf ("header <table>\n") + call printf ("data <table> <row1> <row2>\n") + call printf ("help\n") + call printf ("quit\n") + call printf ("\nwhere:\n") + call printf (" <table> = 1..10\n") + call printf (" <type> = %s\n") + call pargstr (TYPES) + call printf (" <fmode> = %s\n") + call pargstr (MODES) + + call flush (STDOUT) +end + + +# ZZGTABLE -- Get table number and check its range. + +procedure zzgtable (line, ip, num) + +char line[ARB] # command line +int ip # input character pointer +int num # table number + +errchk zzgeti() + +begin + call zzgeti (line, ip, num) + if (num < 1 || num > MAX_TABLES) + call error (0, "Table number out of range") +end + + +# ZZGTYPE -- Convert from string to integer type + +procedure zzgtype (line, ip, type) + +char line[ARB] # input line +int ip # input character pointer +int type # table type (output) + +char strval[SZ_LINE] +int ntype + +int strdic() + +begin + call zzgstr (line, ip, strval, SZ_LINE) + + ntype = strdic (strval, strval, SZ_LINE, TYPES) + + switch (ntype) { + case TYPE_CHAR: + type = TY_CHAR + case TYPE_SHORT: + type = TY_SHORT + case TYPE_INT: + type = TY_INT + case TYPE_LONG: + type = TY_LONG + case TYPE_REAL: + type = TY_REAL + case TYPE_DOUBLE: + type = TY_DOUBLE + case TYPE_COMPLEX: + type = TY_COMPLEX + case TYPE_POINTER: + type = TY_POINTER + default: + call error (0, "Unknown table type") + } +end + + +# ZZGMODE -- Get mode string and convert it into a file mode. + +procedure zzgmode (line, ip, mode) + +char line[ARB] # input line +int ip # input character pointer +int mode # file mode (output) + +char strval[SZ_LINE] +int nmode + +int strdic() + +begin + call zzgstr (line, ip, strval, SZ_LINE) + + nmode = strdic (strval, strval, SZ_LINE, MODES) + + switch (nmode) { + case MODE_WRITE_ONLY: + mode = WRITE_ONLY + case MODE_READ_WRITE: + mode = READ_WRITE + case MODE_NEW_FILE: + mode = NEW_FILE + case MODE_TEMP_FILE: + mode = TEMP_FILE + default: + call error (0, "zzgmode: Unknown file mode") + } +end + + + +# ZZGET -- Get number from command line + +procedure zzgetc (line, ip, cval) + +char line[ARB] # command line +int ip # input character pointer +char cval # number + +char number[SZ_LINE] +int op + +int cctoc() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (cctoc (number, op, cval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgets (line, ip, sval) + +char line[ARB] # command line +int ip # input character pointer +short sval # number + +char number[SZ_LINE] +int op + +int ctoi() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctoi (number, op, int (sval)) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgeti (line, ip, ival) + +char line[ARB] # command line +int ip # input character pointer +int ival # number + +char number[SZ_LINE] +int op + +int ctoi() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctoi (number, op, ival) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgetl (line, ip, lval) + +char line[ARB] # command line +int ip # input character pointer +long lval # number + +char number[SZ_LINE] +int op + +int ctol() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctol (number, op, lval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgetr (line, ip, rval) + +char line[ARB] # command line +int ip # input character pointer +real rval # number + +char number[SZ_LINE] +int op + +int ctor() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctor (number, op, rval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgetd (line, ip, dval) + +char line[ARB] # command line +int ip # input character pointer +double dval # number + +char number[SZ_LINE] +int op + +int ctod() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctod (number, op, dval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgetx (line, ip, xval) + +char line[ARB] # command line +int ip # input character pointer +complex xval # number + +char number[SZ_LINE] +int op + +int ctox() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctox (number, op, xval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + +# ZZGET -- Get number from command line + +procedure zzgetp (line, ip, pval) + +char line[ARB] # command line +int ip # input character pointer +pointer pval # number + +char number[SZ_LINE] +int op + +int ctoi() +int strext() + +begin + if (strext (line, ip, " ", YES, number, SZ_LINE) == 0) + call error (0, "Missing numeric parameter\n") + + op = 1 + if (ctoi (number, op, pval) == 0) + call error (0, "zzget: Impossible number conversion\n") +end + + + +# ZZGSTR -- Get string from command line + +procedure zzgstr (line, ip, strval, maxch) + +char line[ARB] # command line +int ip # input character pointer +char strval[maxch] # output string +int maxch # max number of characters + +int strext() + +begin + if (strext (line, ip, " ", YES, strval, maxch) == 0) + call error (0, "Missing string parameter") +end |