aboutsummaryrefslogtreecommitdiff
path: root/noao/astcat/src/debug
diff options
context:
space:
mode:
Diffstat (limited to 'noao/astcat/src/debug')
-rw-r--r--noao/astcat/src/debug/mkpkg15
-rw-r--r--noao/astcat/src/debug/t_acqctest.x304
-rw-r--r--noao/astcat/src/debug/t_acqftest.x244
-rw-r--r--noao/astcat/src/debug/t_acqitest.x220
-rw-r--r--noao/astcat/src/debug/t_adumpcat.x164
-rw-r--r--noao/astcat/src/debug/t_adumpim.x163
-rw-r--r--noao/astcat/src/debug/zzdebug.x142
7 files changed, 1252 insertions, 0 deletions
diff --git a/noao/astcat/src/debug/mkpkg b/noao/astcat/src/debug/mkpkg
new file mode 100644
index 00000000..9546b422
--- /dev/null
+++ b/noao/astcat/src/debug/mkpkg
@@ -0,0 +1,15 @@
+# Catalog query and access tools subdirectory
+
+$checkout libpkg.a ".."
+$update libpkg.a
+$checkin libpkg.a ".."
+$exit
+
+libpkg.a:
+ t_acqctest.x <pkg/cq.h>
+ t_acqftest.x <pkg/cq.h>
+ t_adumpcat.x <fset.h> <pkg/cq.h>
+ t_adumpim.x <mach.h> <fset.h> <pkg/cq.h>
+ t_acqitest.x <pkg/cq.h>
+ zzdebug.x <fset.h>
+ ;
diff --git a/noao/astcat/src/debug/t_acqctest.x b/noao/astcat/src/debug/t_acqctest.x
new file mode 100644
index 00000000..e59fb80d
--- /dev/null
+++ b/noao/astcat/src/debug/t_acqctest.x
@@ -0,0 +1,304 @@
+include <pkg/cq.h>
+
+# T_ACQCTEST -- Test basic catalog database access and query procedures.
+
+procedure t_acqctest ()
+
+double dval1, dval2
+real width, rval1, rval2
+long lval1, lval2
+pointer cq, sp, reclist, res
+int i, ip, catno, nqpars, parno, nres, recptr, nchars, foffset, fsize
+int ftype, nfields, ival1, ival2
+short sval1, sval2
+char database[SZ_FNAME], record[SZ_LINE], ra[SZ_FNAME], dec[SZ_FNAME]
+char str[SZ_FNAME], catalog[SZ_LINE]
+char qpname[CQ_SZ_QPNAME], qpvalue[CQ_SZ_QPVALUE], qpunits[CQ_SZ_QPUNITS]
+char qpformats[CQ_SZ_QPFMTS]
+
+real clgetr()
+pointer cq_map(), cq_query()
+int cq_stati(), cq_statt(), cq_setcat(), cq_setcatn(), cq_nqpars()
+int cq_gqpar(), cq_gqparn(), cq_sqpar(), ctod(), cq_rstati()
+int cq_gnrecord(), cq_grecord(), cq_finfon(), cq_finfo(), cq_fname()
+int cq_foffset(), cq_fsize(), cq_ftype(), cq_gvali(), cq_hinfo()
+int cq_gvalc(), cq_gvald(), cq_gvalr(), cq_gvall(), cq_gvals(), cq_hinfon()
+bool streq()
+
+begin
+ # Get the database and record names.
+ call clgstr ("record", record, SZ_LINE)
+ call clgstr ("ra", ra, SZ_FNAME)
+ call clgstr ("dec", dec, SZ_FNAME)
+ width = clgetr ("width")
+ call clgstr ("database", database, SZ_FNAME)
+
+ # Map the database.
+ cq = cq_map (database, READ_ONLY)
+
+ # Print the database file name and number of records.
+ call cq_stats (cq, CQCATDB, database, SZ_FNAME)
+ call printf ("\nDatabase: %s Nrecs: %d\n\n")
+ call pargstr (database)
+ call pargi (cq_stati (cq, CQNRECS))
+
+ # Print the record list.
+ call printf ("Szreclist = %d characters\n")
+ call pargi (cq_stati (cq, CQSZRECLIST))
+
+ call smark (sp)
+ call salloc (reclist, cq_stati(cq, CQSZRECLIST), TY_CHAR)
+ if (cq_statt (cq, CQRECLIST, Memc[reclist], cq_stati(cq,
+ CQSZRECLIST)) <= 0)
+ Memc[reclist] = EOS
+ call printf ("%s")
+ call pargstr (Memc[reclist])
+ call sfree (sp)
+
+ # Print the current catalog name and number.
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the current catalog by name.
+ catno = cq_setcat (cq, record)
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the same catalog by number.
+ catno = cq_setcatn (cq, catno)
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the query parameters. Don't worry about units in this case.
+ nqpars = cq_nqpars (cq)
+ do i = 1, nqpars {
+
+ # Get description of each query parameter.
+ parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS)
+ call printf ("parno: %d %s %s %s %s\n")
+ call pargi (parno)
+ call pargstr (qpname)
+ call pargstr (qpvalue)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ parno = cq_gqpar (cq, qpname, qpname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS)
+ call printf ("parno: %d %s %s %s %s\n")
+ call pargi (parno)
+ call pargstr (qpname)
+ call pargstr (qpvalue)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+
+
+ # Set the astrometric parameters.
+ if (streq (qpname, "ra")) {
+ ip = 1
+ if (ctod (ra, ip, dval1) > 0) {
+ call sprintf (ra, SZ_FNAME, qpformats)
+ call pargd (dval1)
+ }
+ parno = cq_sqpar (cq, qpname, ra)
+ } else if (streq (qpname, "dec")) {
+ ip = 1
+ if (ctod (dec, ip, dval1) > 0) {
+ if (dval1 >= 0.0) {
+ #dec[1] = '+'
+ #call sprintf (dec[2], SZ_FNAME - 1, qpformats)
+ call sprintf (dec, SZ_FNAME, qpformats)
+ } else {
+ call sprintf (dec, SZ_FNAME, qpformats)
+ }
+ call pargd (dval1)
+ }
+ parno = cq_sqpar (cq, qpname, dec)
+ } else if (streq (qpname, "width")) {
+ call sprintf (str, SZ_FNAME, qpformats)
+ call pargr (width)
+ parno = cq_sqpar (cq, qpname, str)
+ } else if (streq (qpname, "radius")) {
+ call sprintf (str, SZ_FNAME, qpformats)
+ call pargr (width / 2.0)
+ parno = cq_sqpar (cq, qpname, str)
+ }
+
+ }
+ call flush (STDOUT)
+
+ # Send the query and get back the results.
+ res = cq_query (cq)
+ if (res == NULL)
+ return
+
+ call cq_rstats (res, CQRADDRESS, str, SZ_FNAME)
+ call printf ("\nraddress: %s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQUERY, str, SZ_FNAME)
+ call printf ("rquery: %s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQPNAMES, str, SZ_FNAME)
+ call printf ("rqpnames:%s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQPVALUES, str, SZ_FNAME)
+ call printf ("rqpvalues:%s\n")
+ call pargstr (str)
+
+ # Get the number of header parameters.
+ nfields = cq_rstati (res, CQNHEADER)
+ call printf ("nheader = %d\n")
+ call pargi (nfields)
+
+ # Print the information for each field.
+ do i = 1, nfields {
+ if (cq_hinfon (res, i, qpname, CQ_SZ_QPNAME, record, SZ_LINE) <= 0)
+ next
+ call printf ("keyword: %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (record)
+ if (cq_hinfo (res, qpname, record, SZ_LINE) <= 0)
+ next
+ call printf ("keyword: %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (record)
+ }
+ call printf ("\n")
+
+ # Get the number of fields.
+ nfields = cq_rstati (res, CQNFIELDS)
+ call printf ("nfields = %d\n")
+ call pargi (nfields)
+
+ # Print the information for each field.
+ do i = 1, nfields {
+ if (cq_finfon (res, i, qpname, CQ_SZ_FNAME, foffset, fsize,
+ ftype, qpunits, CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0)
+ next
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ if (cq_finfo (res, qpname, foffset, fsize, ftype, qpunits,
+ CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0)
+ next
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ if (cq_fname (res, i, qpname, CQ_SZ_FNAME) <= 0)
+ next
+ foffset = cq_foffset (res, qpname)
+ fsize = cq_fsize (res, qpname)
+ ftype = cq_ftype (res, qpname)
+ call cq_funits (res, qpname, qpunits, CQ_SZ_FUNITS)
+ call cq_ffmts (res, qpname, qpformats, CQ_SZ_FFMTS)
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ }
+ call printf ("\n")
+
+ # Get the number of records.
+ nres = cq_rstati (res, CQRNRECS)
+ call printf ("nrecords = %d\n")
+ call pargi (nres)
+
+ # Loop through and print the records.
+ recptr = 0
+ while (recptr < nres) {
+ nchars = cq_gnrecord (res, record, SZ_LINE, recptr)
+ if (nchars == EOF)
+ break
+ call printf ("record %4d %4d %s")
+ call pargi (recptr)
+ call pargi (nchars)
+ call pargstr (record)
+ }
+
+ # Find and print records at random.
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, 1)
+ call printf ("\nrecord %4d %4d %s")
+ call pargi (1)
+ call pargi (nchars)
+ call pargstr (record)
+
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, (1 + nres) / 2)
+ call printf ("record %4d %4d %s")
+ call pargi ((1 + nres) / 2)
+ call pargi (nchars)
+ call pargstr (record)
+
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, nres)
+ call printf ("record %4d %4d %s")
+ call pargi (nres)
+ call pargi (nchars)
+ call pargstr (record)
+
+ # Loop through the records and decode the ra and dec fields as
+ # char, double precision, real precision, and integer fields.
+ call printf ("\nra dec\n")
+ do i = 1, nres {
+ call printf ("rec %d\n")
+ call pargi (i)
+ nchars = cq_gvalc (res, i, "ra", ra, SZ_FNAME)
+ nchars = cq_gvalc (res, i, "dec", dec, SZ_FNAME)
+ call printf (" %s %s\n")
+ call pargstr (ra)
+ call pargstr (dec)
+ nchars = cq_gvald (res, i, "ra", dval1)
+ nchars = cq_gvald (res, i, "dec", dval2)
+ call printf (" %h %h\n")
+ call pargd (dval1)
+ call pargd (dval2)
+ nchars = cq_gvalr (res, i, "ra", rval1)
+ nchars = cq_gvalr (res, i, "dec", rval2)
+ call printf (" %h %h\n")
+ call pargr (rval1)
+ call pargr (rval2)
+ nchars = cq_gvall (res, i, "ra", lval1)
+ nchars = cq_gvall (res, i, "dec", lval2)
+ call printf (" %h %h\n")
+ call pargl (lval1)
+ call pargl (lval2)
+ nchars = cq_gvali (res, i, "ra", ival1)
+ nchars = cq_gvali (res, i, "dec", ival2)
+ call printf (" %h %h\n")
+ call pargi (ival1)
+ call pargi (ival2)
+ nchars = cq_gvals (res, i, "ra", sval1)
+ nchars = cq_gvals (res, i, "dec", sval2)
+ call printf (" %h %h\n")
+ call pargs (sval1)
+ call pargs (sval2)
+ }
+
+ # Close the query descriptor.
+ call cq_rclose (res)
+
+ # Unmap the database.
+ call cq_unmap (cq)
+end
diff --git a/noao/astcat/src/debug/t_acqftest.x b/noao/astcat/src/debug/t_acqftest.x
new file mode 100644
index 00000000..fd896fb7
--- /dev/null
+++ b/noao/astcat/src/debug/t_acqftest.x
@@ -0,0 +1,244 @@
+include <pkg/cq.h>
+
+# T_ACQFTEXT -- Procedure to use the catalog access API routines to make
+# an astrometry text file look like the results of a database query.
+# There are two cases: 1) the astrometry file has a simple header record
+# generated by an astrometry package routine and 2) the calling program
+# get this information from another source and set it.
+
+procedure t_acqftest()
+
+double dval1, dval2
+real rval1, rval2
+long lval1, lval2
+int ival1, ival2
+short sval1, sval2
+
+pointer cq, res
+int i, catno, nqpars, fd, nlines, nfields, nres, foffset, fsize, ftype
+int recptr, nchars
+char textfile[SZ_FNAME], record[SZ_FNAME], database[SZ_FNAME]
+char catalog[SZ_FNAME], hdrtext[SZ_LINE], str[SZ_FNAME]
+char qpname[CQ_SZ_QPNAME], qpunits[CQ_SZ_QPUNITS], qpformats[CQ_SZ_QPFMTS]
+char ra[SZ_FNAME], dec[SZ_FNAME]
+
+pointer cq_map(), cq_fquery()
+int cq_setcat(), cq_stati(), cq_nqpars(), open(), at_gcathdr()
+int cq_rstati(), cq_finfon(), cq_finfo(), cq_fname()
+int cq_foffset(), cq_ftype(), cq_fsize(), cq_grecord(), cq_gnrecord()
+int cq_gvali(), at_pcathdr(), cq_hinfon(), cq_hinfo()
+int cq_gvald(), cq_gvalr(), cq_gvall(), cq_gvals(), cq_gvalc()
+
+begin
+ # Get the parameters.
+ call clgstr ("textfile", textfile, SZ_FNAME)
+ call clgstr ("record", record, SZ_FNAME)
+ call clgstr ("database", database, SZ_FNAME)
+
+ # Map the database.
+ cq = cq_map (database, READ_ONLY)
+
+ # Set the current catalog by name. In this case the catalog record
+ # is the dummy record "text".
+ catno = cq_setcat (cq, record)
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+ call flush (STDOUT)
+
+ # Get the number of query parameters. This should be zero in this
+ # case.
+ nqpars = cq_nqpars (cq)
+ call printf ("nqpars = %d\n")
+ call pargi (nqpars)
+
+ # Read the catalog header.
+ fd = open (textfile, READ_ONLY, TEXT_FILE)
+ nlines = at_gcathdr (fd, hdrtext, SZ_LINE)
+ call printf ("catalog header text: nlines = %d\n%s\n")
+ call pargi (nlines)
+ call pargstr (hdrtext)
+ call close (fd)
+
+ # If the catalog has no header then create one from the acatpars
+ # pset.
+ if (nlines <= 0) {
+ nlines = at_pcathdr ("acatpars", hdrtext, SZ_LINE)
+ call printf ("catalog header text: nlines = %d\n%s\n")
+ call pargi (nlines)
+ call pargstr (hdrtext)
+ }
+
+ # Read in the catalog and make it look like a query.
+ res = cq_fquery (cq, textfile, hdrtext)
+ if (res == NULL)
+ return
+
+ # Print basic query info.
+ call cq_rstats (res, CQRADDRESS, str, SZ_FNAME)
+ call printf ("\nraddress: %s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQUERY, str, SZ_FNAME)
+ call printf ("rquery: %s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQPNAMES, str, SZ_FNAME)
+ call printf ("rqpnames:%s\n")
+ call pargstr (str)
+ call cq_rstats (res, CQRQPVALUES, str, SZ_FNAME)
+ call printf ("rqpvalues:%s\n")
+ call pargstr (str)
+
+ # Get the number of keywords.
+ nfields = cq_rstati (res, CQNHEADER)
+ call printf ("nheader = %d\n")
+ call pargi (nfields)
+
+ # Print information for each keyword.
+ do i = 1, nfields {
+ if (cq_hinfon (res, i, qpname, CQ_SZ_QPNAME, record, SZ_LINE) <= 0)
+ next
+ call printf ("keyword: %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (record)
+ if (cq_hinfo (res, qpname, record, SZ_LINE) <= 0)
+ next
+ call printf ("keyword: %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (record)
+ }
+ call printf ("\n")
+
+ # Get the number of fields.
+ nfields = cq_rstati (res, CQNFIELDS)
+ call printf ("nfields = %d\n")
+ call pargi (nfields)
+
+ # Print the information for each field.
+ do i = 1, nfields {
+ if (cq_finfon (res, i, qpname, CQ_SZ_FNAME, foffset, fsize,
+ ftype, qpunits, CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0)
+ next
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ if (cq_finfo (res, qpname, foffset, fsize, ftype, qpunits,
+ CQ_SZ_FUNITS, qpformats, CQ_SZ_FFMTS) <= 0)
+ next
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ if (cq_fname (res, i, qpname, CQ_SZ_FNAME) <= 0)
+ next
+ foffset = cq_foffset (res, qpname)
+ fsize = cq_fsize (res, qpname)
+ ftype = cq_ftype (res, qpname)
+ call cq_funits (res, qpname, qpunits, CQ_SZ_FUNITS)
+ call cq_ffmts (res, qpname, qpformats, CQ_SZ_FFMTS)
+ call printf ("field: %d %s %d %d %d %s %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargi (foffset)
+ call pargi (fsize)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ }
+ call printf ("\n")
+
+ # Get the number of records.
+ nres = cq_rstati (res, CQRNRECS)
+ call printf ("nrecords = %d\n")
+ call pargi (nres)
+
+ # Loop through and print the records.
+ recptr = 0
+ while (recptr < nres) {
+ nchars = cq_gnrecord (res, record, SZ_LINE, recptr)
+ if (nchars == EOF)
+ break
+ call printf ("record %4d %4d %s")
+ call pargi (recptr)
+ call pargi (nchars)
+ call pargstr (record)
+ }
+
+ # Find and print records at random.
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, 1)
+ call printf ("\nrecord %4d %4d %s")
+ call pargi (1)
+ call pargi (nchars)
+ call pargstr (record)
+
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, (1 + nres) / 2)
+ call printf ("record %4d %4d %s")
+ call pargi ((1 + nres) / 2)
+ call pargi (nchars)
+ call pargstr (record)
+
+ record[1] = EOS
+ nchars = cq_grecord (res, record, SZ_LINE, nres)
+ call printf ("record %4d %4d %s")
+ call pargi (nres)
+ call pargi (nchars)
+ call pargstr (record)
+
+ # Loop through the records and decode the ra and dec fields as
+ # char, double precision, real precision, and integer fields.
+ call printf ("\nra dec\n")
+ do i = 1, nres {
+ call printf ("rec %d\n")
+ call pargi (i)
+ nchars = cq_gvalc (res, i, "ra", ra, SZ_FNAME)
+ nchars = cq_gvalc (res, i, "dec", dec, SZ_FNAME)
+ call printf (" %s %s\n")
+ call pargstr (ra)
+ call pargstr (dec)
+ nchars = cq_gvald (res, i, "ra", dval1)
+ nchars = cq_gvald (res, i, "dec", dval2)
+ call printf (" %h %h\n")
+ call pargd (dval1)
+ call pargd (dval2)
+ nchars = cq_gvalr (res, i, "ra", rval1)
+ nchars = cq_gvalr (res, i, "dec", rval2)
+ call printf (" %h %h\n")
+ call pargr (rval1)
+ call pargr (rval2)
+ nchars = cq_gvall (res, i, "ra", lval1)
+ nchars = cq_gvall (res, i, "dec", lval2)
+ call printf (" %h %h\n")
+ call pargl (lval1)
+ call pargl (lval2)
+ nchars = cq_gvali (res, i, "ra", ival1)
+ nchars = cq_gvali (res, i, "dec", ival2)
+ call printf (" %h %h\n")
+ call pargi (ival1)
+ call pargi (ival2)
+ nchars = cq_gvals (res, i, "ra", sval1)
+ nchars = cq_gvals (res, i, "dec", sval2)
+ call printf (" %h %h\n")
+ call pargs (sval1)
+ call pargs (sval2)
+ }
+
+
+ # Close the query.
+ call cq_rclose (res)
+
+ # Unmap the database.
+ call cq_unmap (cq)
+end
diff --git a/noao/astcat/src/debug/t_acqitest.x b/noao/astcat/src/debug/t_acqitest.x
new file mode 100644
index 00000000..56e532ec
--- /dev/null
+++ b/noao/astcat/src/debug/t_acqitest.x
@@ -0,0 +1,220 @@
+include <pkg/cq.h>
+
+# T_ACQITEST -- Test basic catalog database access and query procedures.
+
+procedure t_acqitest ()
+
+double dval1
+real width
+pointer cq, sp, reclist, res
+int i, ip, catno, nqpars, parno, ftype, nfields
+char database[SZ_FNAME], record[SZ_LINE], ra[SZ_FNAME], dec[SZ_FNAME]
+char str[SZ_FNAME], catalog[SZ_LINE], imname[SZ_LINE]
+char qpname[CQ_SZ_QPNAME], qkname[CQ_SZ_QPNAME], qpvalue[CQ_SZ_QPVALUE]
+char qpunits[CQ_SZ_QPUNITS], qpformats[CQ_SZ_QPFMTS]
+
+real clgetr()
+pointer cq_map(), cq_imquery()
+int cq_stati(), cq_statt(), cq_setcat(), cq_setcatn(), cq_nqpars()
+int cq_gqpar(), cq_gqparn(), cq_sqpar(), ctod(), cq_istati()
+int cq_winfon(), cq_winfo(), cq_kinfon(), cq_kinfo()
+bool streq()
+
+begin
+ # Get the database and record names.
+ call clgstr ("record", record, SZ_LINE)
+ call clgstr ("image", imname, SZ_LINE)
+ call clgstr ("ra", ra, SZ_FNAME)
+ call clgstr ("dec", dec, SZ_FNAME)
+ width = clgetr ("width")
+ call clgstr ("database", database, SZ_FNAME)
+
+ # Map the database.
+ cq = cq_map (database, READ_ONLY)
+
+ # Print the database file name and number of records.
+ call cq_stats (cq, CQCATDB, database, SZ_FNAME)
+ call printf ("\nDatabase: %s Nrecs: %d\n\n")
+ call pargstr (database)
+ call pargi (cq_stati (cq, CQNRECS))
+
+ # Print the record list.
+ call printf ("Szreclist = %d characters\n")
+ call pargi (cq_stati (cq, CQSZRECLIST))
+
+ call smark (sp)
+ call salloc (reclist, cq_stati(cq, CQSZRECLIST), TY_CHAR)
+ if (cq_statt (cq, CQRECLIST, Memc[reclist], cq_stati(cq,
+ CQSZRECLIST)) <= 0)
+ Memc[reclist] = EOS
+ call printf ("%s")
+ call pargstr (Memc[reclist])
+ call sfree (sp)
+
+ # Print the current catalog name and number.
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the current catalog by name.
+ catno = cq_setcat (cq, record)
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the same catalog by number.
+ catno = cq_setcatn (cq, catno)
+ call cq_stats (cq, CQCATNAME, catalog, SZ_LINE)
+ call printf ("\nCurrent catalog: %s index: %d\n\n")
+ call pargstr (catalog)
+ call pargi (cq_stati (cq, CQCATNO))
+
+ # Set the query parameters. Don't worry about units in this case.
+ nqpars = cq_nqpars (cq)
+ do i = 1, nqpars {
+
+ # Get description of each query parameter.
+ parno = cq_gqparn (cq, i, qpname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS)
+ call printf ("parno: %d %s %s %s %s\n")
+ call pargi (parno)
+ call pargstr (qpname)
+ call pargstr (qpvalue)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+ parno = cq_gqpar (cq, qpname, qpname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, qpunits, CQ_SZ_QPUNITS, qpformats, CQ_SZ_QPFMTS)
+ call printf ("parno: %d %s %s %s %s\n")
+ call pargi (parno)
+ call pargstr (qpname)
+ call pargstr (qpvalue)
+ call pargstr (qpunits)
+ call pargstr (qpformats)
+
+
+ # Set the astrometric parameters.
+ if (streq (qpname, "ra")) {
+ ip = 1
+ if (ctod (ra, ip, dval1) > 0) {
+ call sprintf (ra, SZ_FNAME, qpformats)
+ call pargd (dval1)
+ }
+ parno = cq_sqpar (cq, qpname, ra)
+ } else if (streq (qpname, "dec")) {
+ ip = 1
+ if (ctod (dec, ip, dval1) > 0) {
+ if (dval1 >= 0.0) {
+ #dec[1] = '+'
+ #call sprintf (dec[2], SZ_FNAME - 1, qpformats)
+ call sprintf (dec, SZ_FNAME, qpformats)
+ } else {
+ call sprintf (dec, SZ_FNAME, qpformats)
+ }
+ call pargd (dval1)
+ }
+ parno = cq_sqpar (cq, qpname, dec)
+ } else if (streq (qpname, "width")) {
+ call sprintf (str, SZ_FNAME, qpformats)
+ call pargr (width)
+ parno = cq_sqpar (cq, qpname, str)
+ } else if (streq (qpname, "radius")) {
+ call sprintf (str, SZ_FNAME, qpformats)
+ call pargr (width / 2.0)
+ parno = cq_sqpar (cq, qpname, str)
+ }
+
+ }
+ call flush (STDOUT)
+
+ # Send the query and get back the results.
+ res = cq_imquery (cq, imname)
+ if (res == NULL)
+ return
+
+ call cq_istats (res, CQIMADDRESS, str, SZ_FNAME)
+ call printf ("\nimaddress: %s\n")
+ call pargstr (str)
+ call cq_istats (res, CQIMQUERY, str, SZ_FNAME)
+ call printf ("imquery: %s\n")
+ call pargstr (str)
+ call cq_istats (res, CQIQPNAMES, str, SZ_FNAME)
+ call printf ("iqpnames:%s\n")
+ call pargstr (str)
+ call cq_istats (res, CQIQPVALUES, str, SZ_FNAME)
+ call printf ("iqpvalues:%s\n")
+ call pargstr (str)
+ call flush (STDOUT)
+
+ # Get the number of wcs parameters.
+ call printf ("nheader = 0\n")
+ nfields = cq_istati (res, CQNWCS)
+ call printf ("nheader = %d\n")
+ call pargi (nfields)
+ call flush (STDOUT)
+
+ # Print the information for each field.
+ do i = 1, nfields {
+ if (cq_winfon (res, i, qpname, CQ_SZ_QPNAME, qkname, CQ_SZ_QPNAME,
+ qpvalue, CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0)
+ next
+ call printf ("keyword: %d %s %s %s %d %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (qkname)
+ call pargstr (qpvalue)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ if (cq_winfo (res, qpname, qkname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0)
+ next
+ call printf ("keyword: %d %s %s %s %d %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (qkname)
+ call pargstr (qpvalue)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ }
+ call printf ("\n")
+ call flush (STDOUT)
+
+ # Get the number of fields.
+ nfields = cq_istati (res, CQNIMPARS)
+ call printf ("nfields = %d\n")
+ call pargi (nfields)
+ call flush (STDOUT)
+
+ # Print the information for each field.
+ do i = 1, nfields {
+ if (cq_kinfon (res, i, qpname, CQ_SZ_QPNAME, qkname, CQ_SZ_QPNAME,
+ qpvalue, CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0)
+ next
+ call printf ("keyword: %d %s %s %s %d %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (qkname)
+ call pargstr (qpvalue)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ if (cq_kinfo (res, qpname, qkname, CQ_SZ_QPNAME, qpvalue,
+ CQ_SZ_QPVALUE, ftype, qpunits, CQ_SZ_QPUNITS) <= 0)
+ next
+ call printf ("keyword: %d %s %s %s %d %s\n")
+ call pargi (i)
+ call pargstr (qpname)
+ call pargstr (qkname)
+ call pargstr (qpvalue)
+ call pargi (ftype)
+ call pargstr (qpunits)
+ }
+ call printf ("\n")
+ call flush (STDOUT)
+
+ # Close the query descriptor.
+ call cq_imclose (res)
+
+ # Unmap the database.
+ call cq_unmap (cq)
+end
diff --git a/noao/astcat/src/debug/t_adumpcat.x b/noao/astcat/src/debug/t_adumpcat.x
new file mode 100644
index 00000000..de2c9a1c
--- /dev/null
+++ b/noao/astcat/src/debug/t_adumpcat.x
@@ -0,0 +1,164 @@
+include <fset.h>
+include <pkg/cq.h>
+
+define DEF_SZPARS 15
+define DEF_SZBUF 32768
+
+procedure t_adumpcat()
+
+pointer sp, catalog, output, catdb, ra, dec, size
+pointer query, qpname, qpvalue, qpunits, qpformats, str, cq, buf
+int i, fd, ofd, nqpars, parno, nchars
+bool done
+pointer cq_map()
+int cq_setcat(), ndopen(), open(), cq_nqpars(), cq_gqparn(), read()
+int getline()
+bool streq()
+errchk ndopen()
+
+begin
+ # Allocate some working space.
+ call smark (sp)
+ call salloc (catalog, SZ_FNAME, TY_CHAR)
+ call salloc (output, SZ_FNAME, TY_CHAR)
+ call salloc (catdb, SZ_FNAME, TY_CHAR)
+ call salloc (ra, DEF_SZPARS, TY_CHAR)
+ call salloc (dec, DEF_SZPARS, TY_CHAR)
+ call salloc (size, DEF_SZPARS, TY_CHAR)
+ call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR)
+ call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR)
+ call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR)
+ call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR)
+ call salloc (query, SZ_LINE, TY_CHAR)
+ call salloc (str, SZ_LINE, TY_CHAR)
+ call salloc (buf, DEF_SZBUF, TY_CHAR)
+
+ # Get the parameters.
+ call clgstr ("catalog", Memc[catalog], SZ_FNAME)
+ call clgstr ("output", Memc[output], SZ_FNAME)
+ call clgstr ("ra", Memc[ra], DEF_SZPARS)
+ call clgstr ("dec", Memc[dec], DEF_SZPARS)
+ call clgstr ("size", Memc[size], DEF_SZPARS)
+ call clgstr ("catdb", Memc[catdb], SZ_FNAME)
+
+ # Map the catalog configuration file.
+ cq = cq_map (Memc[catdb], READ_ONLY)
+ if (cq == NULL) {
+ call eprintf ("Cannot open catalog configuration file %s\n")
+ call pargstr (Memc[catdb])
+ call sfree (sp)
+ return
+ }
+
+ # Locate the catalog record.
+ if (cq_setcat (cq, Memc[catalog]) <= 0) {
+ call eprintf ("Cannot locate catalog record %s\n")
+ call pargstr (Memc[catalog])
+ call cq_unmap (cq)
+ call sfree (sp)
+ return
+ }
+
+ # Connect to the HTTP server.
+ call cq_fgwrd (cq, "address", Memc[str], SZ_LINE)
+ iferr (fd = ndopen (Memc[str], READ_WRITE)) {
+ call eprintf ("Cannot access catalog %s at host %s\n")
+ call pargstr (Memc[catalog])
+ call pargstr (Memc[str])
+ call cq_unmap (cq)
+ call sfree (sp)
+ return
+ }
+
+ # Open the output file.
+ ofd = open (Memc[output], NEW_FILE, TEXT_FILE)
+
+ # Format the query without worrying about coordinate systems,
+ # or formats. Just assume that the user types in ra, dec, and
+ # size in the form expected by the server.
+ call cq_fgstr (cq, "query", Memc[query], SZ_LINE)
+ nqpars = cq_nqpars (cq)
+ call sprintf (Memc[str], SZ_LINE, Memc[query])
+ do i = 1, nqpars {
+
+ # Get description of each query parameter.
+ parno = cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME,
+ Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS,
+ Memc[qpformats], CQ_SZ_QPFMTS)
+
+ # Pass the parameters to the query string.
+ if (streq (Memc[qpname], "ra")) {
+ call pargstr (Memc[ra])
+ } else if (streq (Memc[qpname], "dec")) {
+ call pargstr (Memc[dec])
+ } else if (streq (Memc[qpname], "width")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "xwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "ywidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "rawidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "decwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "hwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "xhwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "yhwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "xrawidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "ydecwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "radius")) {
+ call pargstr (Memc[size])
+ } else {
+ call pargstr (Memc[qpvalue])
+ }
+
+ }
+
+ # Send the query.
+ call fprintf (fd, "%s")
+ call pargstr (Memc[str])
+ call flush (fd)
+ call fseti (fd, F_CANCEL, OK)
+
+ # Read the reply. Skip the HTTP header assuming it ends with a \n or
+ # a \r\n.
+ call cq_fgwrd (cq, "protocol", Memc[str], SZ_LINE)
+ if (streq (Memc[str], "http")) {
+ repeat {
+ nchars = getline (fd, Memc[buf])
+ if (nchars <= 0)
+ break
+ Memc[buf+nchars] = EOS
+ } until ((Memc[buf] == '\r' && Memc[buf+1] == '\n') ||
+ (Memc[buf] == '\n'))
+ }
+
+ # Read the reply.
+ repeat {
+ nchars = read (fd, Memc[buf], DEF_SZBUF)
+ if (nchars > 0) {
+ Memc[buf+nchars] = EOS
+ call write (ofd, Memc[buf], nchars)
+ done = false
+ } else {
+ done = true
+ }
+ } until (done)
+ call flush (ofd)
+
+ # Close the output.
+ call close (ofd)
+
+ # Close the network connection.
+ call close (fd)
+
+ # Unmap the database.
+ call cq_unmap (cq)
+
+ call sfree (sp)
+end
diff --git a/noao/astcat/src/debug/t_adumpim.x b/noao/astcat/src/debug/t_adumpim.x
new file mode 100644
index 00000000..e214b8fd
--- /dev/null
+++ b/noao/astcat/src/debug/t_adumpim.x
@@ -0,0 +1,163 @@
+include <mach.h>
+include <fset.h>
+include <pkg/cq.h>
+
+define DEF_SZPARS 15
+define DEF_SZBUF 28800
+
+# T_ADUMPIM -- Image survey access debugging routines.
+
+procedure t_adumpim()
+
+pointer sp, imsurvey, output, ra, dec, size, imdb, query, buf, str
+pointer qpname, qpvalue, qpunits, qpformats, cq
+int i, fd, ofd, nqpars, parno, nchars
+bool done
+
+pointer cq_map()
+int cq_setcat(), ndopen(), open(), cq_nqpars(), cq_gqparn(), strlen()
+int getline(), read()
+bool streq()
+errchk cq_fgeti()
+
+begin
+ # Allocate some working space.
+ call smark (sp)
+ call salloc (imsurvey, SZ_FNAME, TY_CHAR)
+ call salloc (output, SZ_FNAME, TY_CHAR)
+ call salloc (imdb, SZ_FNAME, TY_CHAR)
+ call salloc (ra, DEF_SZPARS, TY_CHAR)
+ call salloc (dec, DEF_SZPARS, TY_CHAR)
+ call salloc (size, DEF_SZPARS, TY_CHAR)
+ call salloc (query, SZ_LINE, TY_CHAR)
+ call salloc (qpname, CQ_SZ_QPNAME, TY_CHAR)
+ call salloc (qpvalue, CQ_SZ_QPVALUE, TY_CHAR)
+ call salloc (qpunits, CQ_SZ_QPUNITS, TY_CHAR)
+ call salloc (qpformats, CQ_SZ_QPFMTS, TY_CHAR)
+ call salloc (buf, 2*DEF_SZBUF, TY_CHAR)
+ call salloc (str, SZ_LINE, TY_CHAR)
+
+ # Get the parameters.
+ call clgstr ("imsurvey", Memc[imsurvey], SZ_FNAME)
+ call clgstr ("output", Memc[output], SZ_FNAME)
+ call clgstr ("ra", Memc[ra], DEF_SZPARS)
+ call clgstr ("dec", Memc[dec], DEF_SZPARS)
+ call clgstr ("size", Memc[size], DEF_SZPARS)
+ call clgstr ("imdb", Memc[imdb], SZ_FNAME)
+
+ # Map the image surfvey configuration file.
+ cq = cq_map (Memc[imdb], READ_ONLY)
+ if (cq == NULL) {
+ call eprintf ("Cannot open image survey configuration file %s\n")
+ call pargstr (Memc[imdb])
+ call sfree (sp)
+ return
+ }
+
+ # Locate the image survey record.
+ if (cq_setcat (cq, Memc[imsurvey]) <= 0) {
+ call eprintf ("Cannot locate image survey record %s\n")
+ call pargstr (Memc[imsurvey])
+ call cq_unmap (cq)
+ call sfree (sp)
+ return
+ }
+
+ # Connect to the HTTP server.
+ call cq_fgwrd (cq, "address", Memc[str], SZ_LINE)
+ iferr (fd = ndopen (Memc[str], READ_WRITE)) {
+ call eprintf ("Cannot access image server %s at host %s\n")
+ call pargstr (Memc[imsurvey])
+ call pargstr (Memc[str])
+ call cq_unmap (cq)
+ call sfree (sp)
+ return
+ }
+
+ # Open the output file.
+ #ofd = open (Memc[output], NEW_FILE, BINARY_FILE)
+ ofd = open (Memc[output], NEW_FILE, TEXT_FILE)
+
+ # Format the query without worrying about coordinate systems,
+ # or formats. Just assume that the user types in ra, dec, and
+ # size in the form expected by the server.
+
+ call cq_fgstr (cq, "query", Memc[query], SZ_LINE)
+ nqpars = cq_nqpars (cq)
+ call sprintf (Memc[str], SZ_LINE, Memc[query])
+ do i = 1, nqpars {
+
+ # Get description of each query parameter.
+ parno = cq_gqparn (cq, i, Memc[qpname], CQ_SZ_QPNAME,
+ Memc[qpvalue], CQ_SZ_QPVALUE, Memc[qpunits], CQ_SZ_QPUNITS,
+ Memc[qpformats], CQ_SZ_QPFMTS)
+
+ # Pass the parameters to the query string.
+ if (streq (Memc[qpname], "ra")) {
+ call pargstr (Memc[ra])
+ } else if (streq (Memc[qpname], "dec")) {
+ call pargstr (Memc[dec])
+ } else if (streq (Memc[qpname], "width")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "xwidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "ywidth")) {
+ call pargstr (Memc[size])
+ } else if (streq (Memc[qpname], "radius")) {
+ call pargstr (Memc[size])
+ } else {
+ call pargstr (Memc[qpvalue])
+ }
+
+ }
+
+ # Send the query. Note that since the communication mode and output
+ # file type are binary the command must be converted from IRAF chars
+ # type byte chars. Leave as text for now since it works for FITS
+ # files.
+
+ nchars = strlen (Memc[str])
+ #call chrpak (Memc[str], 1, Memc[str], 1, nchars)
+ #call awriteb (fd, Memc[str], nchars, 1)
+ #nread = awaitb (fd)
+ call write (fd, Memc[str], nchars)
+ call flush (fd)
+ call fseti (fd, F_CANCEL, OK)
+
+ # Read the reply. Skip the HTTP header assuming it ends with a \n or
+ # a \r\n.
+ call cq_fgstr (cq, "protocol", Memc[str], SZ_LINE)
+ if (streq (Memc[str], "http")) {
+ repeat {
+ nchars = getline (fd, Memc[buf])
+ if (nchars <= 0)
+ break
+ Memc[buf+nchars] = EOS
+ } until ((Memc[buf] == '\r' && Memc[buf+1] == '\n') ||
+ (Memc[buf] == '\n'))
+ }
+
+ repeat {
+ nchars = read (fd, Memc[buf], DEF_SZBUF)
+ if (nchars > 0) {
+ Memc[buf+nchars] = EOS
+ call write (ofd, Memc[buf], nchars)
+ done = false
+ } else {
+ done =true
+ }
+ } until (done)
+
+ call flush (ofd)
+
+ # Close the output image.
+ call close (ofd)
+
+ # Close the network connection.
+ call close (fd)
+
+ # Unmap the database.
+ call cq_unmap (cq)
+
+ call sfree (sp)
+end
diff --git a/noao/astcat/src/debug/zzdebug.x b/noao/astcat/src/debug/zzdebug.x
new file mode 100644
index 00000000..3ee5ad24
--- /dev/null
+++ b/noao/astcat/src/debug/zzdebug.x
@@ -0,0 +1,142 @@
+include <fset.h>
+
+# T_TEST2 -- Test Doug's idea of how to access a piece of memory as a
+# binary file using the pushback technique. This works but is a bit
+# inefficient.
+
+procedure t_test2()
+
+pointer inbuf, outbuf
+int i, fd, nchars, ntimes
+int open(), read()
+
+begin
+ # Allocate a char array.
+ call malloc (inbuf, 1000, TY_CHAR)
+ call malloc (outbuf, 200, TY_CHAR)
+ do i = 1, 1000
+ Memc[inbuf+i-1] = i
+
+ # Open char array as a binary file.
+ fd = open ("dev$null", READ_ONLY, BINARY_FILE)
+ call fseti (fd, F_PBBSIZE, 1008)
+ call unread (fd, Memc[inbuf], 1000)
+
+ # Try to read the data.
+ ntimes = 1
+ nchars = read (fd, Memc[outbuf], 200)
+ while (nchars != EOF) {
+ call printf ("ntimes=%d nchars=%d firstchar = %d\n")
+ call pargi (ntimes)
+ call pargi (nchars)
+ call pargi (int(Memc[outbuf]))
+ nchars = read (fd, Memc[outbuf], 200)
+ ntimes = ntimes + 1
+ }
+
+ call close (fd)
+
+ # Free char array.
+ call mfree (inbuf, TY_CHAR)
+ call mfree (outbuf, TY_CHAR)
+end
+
+
+# T_TEST3 -- Test Doug's idea of how to access a piece of memory as a
+# binary file using the spool file technique. This works but is still a bit
+# inefficient.
+
+procedure t_test3()
+
+pointer inbuf, outbuf
+int i, fd, ntimes, nchars
+int open(), read()
+
+begin
+ # Allocate a char array.
+ call malloc (inbuf, 1000, TY_CHAR)
+ call malloc (outbuf, 200, TY_CHAR)
+ do i = 1, 1000
+ Memc[inbuf+i-1] = i
+
+ # Open char array as a binary file.
+ fd = open ("dev$null", READ_WRITE, SPOOL_FILE)
+ call write (fd, Memc[inbuf], 1000)
+ call seek (fd, BOF)
+
+ # Try to read the data.
+ ntimes = 1
+ nchars = read (fd, Memc[outbuf], 200)
+ while (nchars != EOF) {
+ call printf ("ntimes=%d nchars=%d firstchar = %d\n")
+ call pargi (ntimes)
+ call pargi (nchars)
+ call pargi (int(Memc[outbuf]))
+ nchars = read (fd, Memc[outbuf], 200)
+ ntimes = ntimes + 1
+ }
+
+ call close (fd)
+
+ # Free char array.
+ call mfree (inbuf, TY_CHAR)
+ call mfree (outbuf, TY_CHAR)
+end
+
+# T_TEST5 -- Test Doug's idea of how to access a piece of memory as a
+# text file using the spool file technique. This works but is still a bit
+# inefficient.
+
+procedure t_test5()
+
+pointer inbuf, outbuf
+int i, fd, ntimes, nchars
+long note()
+int open(), getline()
+
+begin
+ # Allocate a char array.
+ call malloc (inbuf, 1000, TY_CHAR)
+ call malloc (outbuf, 200, TY_CHAR)
+ do i = 1, 200
+ Memc[inbuf+i-1] = 'a'
+ Memc[inbuf+199] = '\n'
+ do i = 201, 400
+ Memc[inbuf+i-1] = 'b'
+ Memc[inbuf+399] = '\n'
+ do i = 401, 600
+ Memc[inbuf+i-1] = 'c'
+ Memc[inbuf+599] = '\n'
+ do i = 601, 800
+ Memc[inbuf+i-1] = 'd'
+ Memc[inbuf+799] = '\n'
+ do i = 801, 1000
+ Memc[inbuf+i-1] = 'e'
+ Memc[inbuf+999] = '\n'
+
+ # Open char array as a binary file.
+ fd = open ("dev$null", READ_WRITE, SPOOL_FILE)
+ call write (fd, Memc[inbuf], 1000)
+ call seek (fd, BOF)
+
+ # Try to read the data.
+ ntimes = 1
+ #nchars = read (fd, Memc[outbuf], 200)
+ nchars = getline (fd, Memc[outbuf])
+ while (nchars != EOF) {
+ call printf ("ntimes=%d nchars=%d firstchar = %c seek=%d\n")
+ call pargi (ntimes)
+ call pargi (nchars)
+ call pargc (Memc[outbuf])
+ call pargl (note(fd))
+ #nchars = read (fd, Memc[outbuf], 200)
+ nchars = getline (fd, Memc[outbuf])
+ ntimes = ntimes + 1
+ }
+
+ call close (fd)
+
+ # Free char array.
+ call mfree (inbuf, TY_CHAR)
+ call mfree (outbuf, TY_CHAR)
+end
generated by cgit (git 2.34.1) at 2025-09-20 16:06:36 -0400