aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/photcal/mctable/zzdebug.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/photcal/mctable/zzdebug.x')
-rw-r--r--noao/digiphot/photcal/mctable/zzdebug.x2066
1 files changed, 2066 insertions, 0 deletions
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
generated by cgit (git 2.34.1) at 2025-09-20 07:15:07 -0400