diff options
author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
---|---|---|
committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
commit | fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch) | |
tree | bdda434976bc09c864f2e4fa6f16ba1952b1e555 /sys/clio | |
download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz |
Initial commit
Diffstat (limited to 'sys/clio')
71 files changed, 3027 insertions, 0 deletions
diff --git a/sys/clio/README b/sys/clio/README new file mode 100644 index 00000000..757b5550 --- /dev/null +++ b/sys/clio/README @@ -0,0 +1,98 @@ +CLIO - Command Language I/O. + +This is the interface between IRAF applications and the IRAF command +language. To an application, the CL appears to be a database managing named +"psets" (parameter sets) containing parameters. CLIO is used by the +application to read and write these parameters. The parameter sets are +predefined at the CL level rather than being dynamically defined by the +application. + + +EXTERNAL ROUTINES + + clseti (clio-param, value) + value = clstati (clio-param) + + value = clget[bcsilrdx] (param) + clput[bcsilrdx] (param, value) + clgstr (param, outstr, maxch) + clpstr (param, value) + nelem|EOF = clgl[bcsilrdx] (param, value) + nchars|EOF = clglstr (param, outstr, maxch) + + key|EOF = clgcur (param, wx, wy, wcs, key, strval, maxch) + nitems = clgkey (param, key, strval, maxch) + kwindex = clgwrd (param, keyword, maxchar, dictionary) + + pp = clopset (pset) + clcpset (pp) + pval = clgpset[bcsilrdx] (pp, param) + clppset[bcsilrdx] (pp, param, pval) + clgpseta (pp, pname, outstr, maxch) + clppseta (pp, pname, sval) + cllpset (pp, fd, format) + clepset (pp) + + +OBSOLETE ROUTINES + + list = clpopn[isu] (param) + clpcls (list) + clprew (list) + nelem = clplen (list) + nchars = clgfil (list, fname, maxch) + + clgpset (pp, pname, outstr, maxch) + clppset (pp, pname, sval) + + +RESTRICTED ROUTINES + + clcmd (cmd) + clcmdw (cmd) + + clopen (stdin, stdout, stderr, device, devtype) + zclsps (chan, status) + zardps (ps, buf, maxbytes, offset) + zawrps (ps, buf, nbytes, offset) + zawtps (ps, status) + zsttps (ps, what, lvalue) + + clc_init () + clc_compress () + clc_free (marker) + clc_mark (marker) + clc_newtask (taskname) + clc_enter (param, value) + nchars = clc_fetch (param, outstr, maxch) + sym = clc_find (param, outstr, maxch) + clc_list (fd, pset, format) + clc_scan (cmd) + + gexfls () + gexfls_set (stream, gp_value, epa_gflush) + gexfls_clear (stream) + + +INTERNAL ROUTINES + + key|EOF = rdukey (keystr, maxch) + charp = clpset_parname (pp, parname) + status = cl_psio_request (cmd, arg1, arg2) + clreqpar (param) + + +INTERFACE PARAMETERS + + # clstati parameters (read only). + CL_PRTYPE # parent process type (see below) + CL_PCACHE # symtab descriptor of param cache + + # Process type codes. + PR_CONNECTED # connected subprocess + PR_DETACHED # detached subprocess + PR_HOST # subprocess spawned by host + + # Process interpreter mode codes (used by ONENTRY and the iraf main). + PR_NOEXIT # run interpreter in Iraf Main + PR_EXIT # skip interpreter, shutdown process diff --git a/sys/clio/clcache.x b/sys/clio/clcache.x new file mode 100644 index 00000000..2d6df333 --- /dev/null +++ b/sys/clio/clcache.x @@ -0,0 +1,490 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include <clio.h> + +.help clcache +.nf ___________________________________________________________________________ +CLCACHE -- A package for cacheing the values of static parameters, i.e., +parameters with values fixed at task invocation time. + +The purpose of this package is to improve the runtime performance of the +parameter passing mechanism. The runtime semantics of the CLIO interface are +not affected. Transmission of the static parameters during task invocation +can save many runtime context switches, saving seconds of clock time when +running tasks which have many (dozens of) parameters. + + + clc_init () # initialize the cache + clc_compress () # rebuild the cache + clc_newtask (taskname) # set name of root pset + clc_mark (sp) # mark cache status + clc_free (sp) # free to last mark + + clc_enter (param, value) # cache a parameter + nchars = clc_fetch (param, out, maxch) # fetch cached parameter + symp = clc_find (param, out, maxch) # find cached parameter + + clc_scan (cmd) # scan a param=value stmt + clc_list (fd, pset, format) # list params to a file + +The cache is initialized by the IRAF main with CLC_INIT during process +startup and whenever a new task is run. Parameter value pairs are entered +into the cache with CLC_ENTER during processing of the command line. +Runtime get parameter requests from the task are satisfied from the cache if +possible, querying the CL only if the cached value cannot be found. Note +that query mode and list type parameters are never cached since they do not +have static values. + +A task can be called either with named parameters or with unnamed, positional +parameters. In the latter case the parameters are passed as "$1", "$2", etc. +If we receive one or more numbered parameters they will be entered into the +symbol table in the usual way but a list of offsets of the positional +arguments will be saved in the clio common. Subsequent runtime parameter +requests will be satisfied by trying to find the parameter by name in the +symbol table, returning the next positional argument if the named parameter +cannot be found. This is the mechanism used by the CL to satisfy requests +for parameters from a task which has no parameter file. + +The values of all parameters are saved in the cache in string format. Since +all parameters come from the CL in string format this makes for an easy +interface to the high level CLIO code. The internal storage format for the +cache is a SYMTAB hash table, simplifying the implementation and providing +optimal performance. There is no fixed limit on the size of the cache. +.endhelp _____________________________________________________________________ + +# SYMTAB default allocation parameters (non-limiting). +define LEN_INDEX 128 # nbuckets in symtab hash index +define LEN_STAB 512 # initial symbol table size +define SZ_SBUF 2048 # initial string buffer size + + +# Symbol table structure (not much to it). + +define LEN_SYMSTRUCT 1 +define SYM_VALUE Memi[$1] # sbuf offset of value string + + +# CLC_INIT -- Initialize the parameter cache. Called during process +# startup. May be called repeatedly to reinitialize the cache. + +procedure clc_init() + +pointer stopen() +bool first_time +data first_time /true/ +include "clio.com" +errchk stopen + +begin + if (first_time) { + cl_stp = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF) + first_time = false + } else + call stfree (cl_stp, cl_stmark) + + call stmark (cl_stp, cl_stmark) + call aclri (cl_posarg, MAX_POSARGS) + cl_nposargs = 0 + cl_nextarg = 1 +end + + +# CLC_NEWTASK -- Set the name of the task whose parameters are to be +# entered into the cache (the taskname is the root pset). + +procedure clc_newtask (taskname) + +char taskname[ARB] # name of the task being run + +int gstrcpy() +include "clio.com" + +begin + cl_psetop = gstrcpy (taskname, cl_psetname, SZ_PSETNAMEBUF) + 2 + cl_psetindex[1] = 1 + cl_npsets = 1 +end + + +# CLC_MARK -- Mark storage in the cache for subsequent restoration by +# clc_free. + +procedure clc_mark (marker) + +pointer marker # receives marked position +include "clio.com" + +begin + call stmark (cl_stp, marker) +end + + +# CLC_FREE -- Free storage in the cache back to the marked position. Any +# positional arguments are lost. + +procedure clc_free (marker) + +pointer marker # marked position +include "clio.com" + +begin + call stfree (cl_stp, marker) + cl_nposargs = 0 + cl_nextarg = 1 + call aclri (cl_posarg, MAX_POSARGS) +end + + +# CLC_ENTER -- Enter a parameter-value pair into the cache. If the parameter +# is an unnamed positional parameter ($N) it is entered in the usual way +# with name $N, but its symtab pointer is also saved in the positional argument +# list. It is safe to save the pointer rather than the index because tasks +# which do not have pfiles never have more than a few arguments, hence the +# symtab will not be reallocated during entry. +# +# If the parameter name is of the form psetname.paramname, extract the pset +# name and add it to the list of pset names for the task. The order in which +# the pset names are defined will be the order in which they are later searched +# when satifying ambiguous references (where the psetname is not specified). + +procedure clc_enter (param, value) + +char param[ARB] # parameter name +char value[ARB] # parameter value string + +pointer sym +int off, ch, pp, op, ip, n +bool streq() +pointer stenter() +int stpstr(), ctoi() +errchk stenter, syserrs +include "clio.com" + +begin + sym = stenter (cl_stp, param, LEN_SYMSTRUCT) + SYM_VALUE(sym) = stpstr (cl_stp, value, 0) + + if (param[1] == '$') { + # Positional argument (no pfile/pset). + + ip = 2 + if (ctoi (param, ip, n) > 0) { + n = max(1, min(MAX_POSARGS, n)) + cl_posarg[n] = sym + cl_nposargs = max (cl_nposargs, n) + } + + } else { + # Check if the parameter name includes the psetname prefix, + # and if so, append the pset name to the pset name list if + # not already there. + + pp = cl_psetop + op = pp + + # Extract psetname. + do ip = 1, SZ_PNAME { + ch = param[ip] + if (ch == EOS) { + return # no psetname given + } else if (ch == '.') { + cl_psetname[op] = EOS + break + } else { + cl_psetname[op] = ch + op = op + 1 + } + } + + # If pset already in list we are done. + ch = param[1] + do ip = cl_npsets, 1, -1 { + off = cl_psetindex[ip] + if (cl_psetname[off] == ch) + if (streq (cl_psetname[pp], cl_psetname[off])) + return + } + + # Pset not found, so enter new pset name into list. + cl_npsets = cl_npsets + 1 + if (cl_npsets > MAX_PSETS) + call syserrs (SYS_CLNPSETS, cl_psetname[pp]) + + cl_psetindex[cl_npsets] = pp + cl_psetop = op + 1 + if (cl_psetop > SZ_PSETNAMEBUF) + call syserrs (SYS_CLPSETOOS, cl_psetname[pp]) + } +end + + +# CLC_FETCH -- Search the CL parameter cache for the named parameter and +# return its value if found. If the parameter is not found and there are +# positional arguments, return the value of the next positional argument. +# The number of characters in the output string is returned as the function +# value if the parameter is found, else ERR is returned. + +int procedure clc_fetch (param, outstr, maxch) + +char param[ARB] # parameter to be fetched +char outstr[maxch] # receives value string of parameter +int maxch + +pointer sym, vp +int gstrcpy() +pointer strefsbuf(), clc_find() +include "clio.com" + +begin + # Search the symbol table for the named parameter. + sym = clc_find (param, outstr, maxch) + + # If the named parameter could not be found using the given name or + # in any pset in the table, use the next positional argument if there + # is one. + + while (sym == NULL) + if (cl_nextarg <= cl_nposargs) { + sym = cl_posarg[cl_nextarg] + cl_nextarg = cl_nextarg + 1 + } else { + outstr[1] = EOS + return (ERR) + } + + vp = strefsbuf (cl_stp, SYM_VALUE(sym)) + return (gstrcpy (Memc[vp], outstr, maxch)) +end + + +# CLC_FIND -- Search the CL parameter cache for the named parameter and +# return its symtab pointer and full name if found. + +pointer procedure clc_find (param, outstr, maxch) + +char param[ARB] # parameter to be fetched +char outstr[maxch] # receives full name of parameter +int maxch + +pointer sym +int op, ip, ch, i +pointer stfind() +include "clio.com" + +begin + # Look first for the named parameter, and if that is not found, + # search each pset for the named parameter, i.e., prepend the name + # of each pset to produce a name of the form "pset.param", and + # look that up in the symbol table. The first entry in the pset + # name list is the name of the task itself. + + sym = stfind (cl_stp, param) + if (sym == NULL) { + do i = 1, cl_npsets { + op = 1 + + # Start with pset name. + do ip = cl_psetindex[i], SZ_PSETNAMEBUF { + ch = cl_psetname[ip] + if (ch == EOS) + break + else { + cl_pname[op] = ch + op = op + 1 + } + } + + # Add dot delimiter. + cl_pname[op] = '.' + op = op + 1 + + # Lastly add the parameter name. + do ip = 1, SZ_FNAME { + ch = param[ip] + if (ch == EOS) + break + else { + cl_pname[op] = ch + op = op + 1 + } + } + + # Look it up in the symbol table. + cl_pname[op] = EOS + sym = stfind (cl_stp, cl_pname) + if (sym != NULL) + break + } + } else + call strcpy (param, cl_pname, SZ_FNAME) + + if (sym != NULL) + call strcpy (cl_pname, outstr, maxch) + + return (sym) +end + + +# CLC_SCAN -- Extract the param and value substrings from a param=value +# statement and enter them into the CL parameter cache. + +procedure clc_scan (cmd) + +char cmd[ARB] #I command to be scanned + +int ip +pointer sp, param, value, op, nchars +int stridx(), ctowrd() + +begin + call smark (sp) + call salloc (param, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_COMMAND, TY_CHAR) + + # Skip any leading whitespace. + for (ip=1; IS_WHITE(cmd[ip]); ip=ip+1) + ; + + # Do nothing if blank line or comment. + if (cmd[ip] == EOS || cmd[ip] == '\n' || cmd[ip] == '#') { + call sfree (sp) + return + } + + # Extract the param field. + op = param + while (IS_ALNUM (cmd[ip]) || stridx (cmd[ip], "_.$") > 0) { + Memc[op] = cmd[ip] + op = op + 1 + ip = ip + 1 + } + Memc[op] = EOS + + # Advance past the assignment operator. + while (IS_WHITE (cmd[ip]) || cmd[ip] == '=') + ip = ip + 1 + + # Get the value string. + nchars = ctowrd (cmd, ip, Memc[value], SZ_COMMAND) + + # Enter the param=value pair into the CL parameter cache. + call clc_enter (Memc[param], Memc[value]) + + call sfree (sp) +end + + +# CLC_LIST -- List the parameters in the named pset to an output file using +# a caller supplied format. If no pset is specified the entire contents of +# the parameter cache are output. A sample format is "set %s = \"%s\"\n". + +procedure clc_list (fd, pset, format) + +int fd #I output file +char pset[ARB] #I pset to be listed, or EOS for full cache +char format[ARB] #I output format - one %s each for param,value + +int nsyms, i +pointer sp, syms, sympset, ip, op, sym, np + +bool strne() +pointer sthead(), stnext(), stname(), strefsbuf() +include "clio.com" + +begin + # Count the number of parameters. + nsyms = 0 + for (sym=sthead(cl_stp); sym != NULL; sym=stnext(cl_stp,sym)) + nsyms = nsyms + 1 + + call smark (sp) + call salloc (syms, nsyms, TY_POINTER) + call salloc (sympset, SZ_FNAME, TY_CHAR) + + # Get a reversed list of symbol pointers. + op = syms + nsyms - 1 + for (sym=sthead(cl_stp); sym != NULL; sym=stnext(cl_stp,sym)) { + Memi[op] = sym + op = op - 1 + } + + # Output the list. + do i = 1, nsyms { + sym = Memi[syms+i-1] + np = stname (cl_stp, sym) + + # Check the pset name if the user named a specific pset. + if (pset[1] != EOS) { + # Get the pset name of the parameter. + op = sympset + for (ip=np; Memc[ip] != EOS && Memc[ip] != '.'; ip=ip+1) { + Memc[op] = Memc[ip] + op = op + 1 + } + Memc[op] = EOS + + # Skip if the wrong pset. + if (strne (Memc[sympset], pset)) + next + } + + call fprintf (fd, format) + call pargstr (Memc[np]) + call pargstr (Memc[strefsbuf(cl_stp,SYM_VALUE(sym))]) + } + + call sfree (sp) +end + + +# CLC_COMPRESS -- Compress the parameter cache. Since every parameter +# modification results in a new parameter entry (redef), the symbol table +# can grow quite large if there are many clput type parameter accesses. +# This operator rebuilds the parameter cache eliminating all old entries. + +procedure clc_compress () + +pointer n_st, o_st +pointer sym, newsym, np, vp + +int stpstr() +pointer strefsbuf(), stopen(), stname() +pointer sthead(), stnext(), stfind(), stenter() +errchk stopen, stenter, stpstr +include "clio.com" + +begin + n_st = stopen ("clcache", LEN_INDEX, LEN_STAB, SZ_SBUF) + o_st = cl_stp + + # Copy the symbol table, saving only the most recent entry for + # each symbol. + + for (sym=sthead(o_st); sym != NULL; sym=stnext(o_st,sym)) { + np = stname (o_st, sym) + if (stfind (n_st, Memc[np]) == NULL) { + vp = strefsbuf (o_st, SYM_VALUE(sym)) + newsym = stenter (n_st, Memc[np], LEN_SYMSTRUCT) + SYM_VALUE(newsym) = stpstr (n_st, Memc[vp], 0) + } + } + + # Copy back the saved symbols. The "push/pop" way in which we use + # the temporary symbol table to save the symbols automatically + # preserves the original symbol table ordering. + + call stfree (o_st, cl_stmark) + call stmark (o_st, cl_stmark) + + for (sym=sthead(n_st); sym != NULL; sym=stnext(n_st,sym)) { + np = stname (n_st, sym) + vp = strefsbuf (n_st, SYM_VALUE(sym)) + newsym = stenter (o_st, Memc[np], LEN_SYMSTRUCT) + SYM_VALUE(newsym) = stpstr (o_st, Memc[vp], 0) + } + + call stclose (n_st) + call stsqueeze (o_st) +end diff --git a/sys/clio/clclose.x b/sys/clio/clclose.x new file mode 100644 index 00000000..7d2b6cbf --- /dev/null +++ b/sys/clio/clclose.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <config.h> + +# CLCLOSE -- "Close" the CL files (shut down CLIO). Called by the IRAF Main +# upon process shutdown. + +procedure clclose () + +int fd + +begin + # Remove buffers for the standard streams. + do fd = 1, FIRST_FD-1 + call frmbfs (fd) +end diff --git a/sys/clio/clcmd.x b/sys/clio/clcmd.x new file mode 100644 index 00000000..99e21340 --- /dev/null +++ b/sys/clio/clcmd.x @@ -0,0 +1,35 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <clset.h> + +# CLCMD -- Send a command line to the CL. Virtually any general command +# may be sent to the CL, providing a great deal of high level power at the +# compiled task level. Sending an explicit command to the CL, however, +# requires that the task have detailed knowledge of the capabilities of +# the CL and of the syntax of the command language. This means that the task +# is very dependent on the CL and may no longer work if the CL is modified, +# or if there is more than one version of the CL in use in a system. For +# this reason CLCMD should only be used where it is truely necessary, +# usually only in system utilities (for example, in a task like MAKE). + +procedure clcmd (cmd) + +char cmd[ARB] + +int junk +int oscmd(), clstati() +errchk syserr + +begin + if (cmd[1] == '!') + junk = oscmd (cmd[2], "", "", "") + else if (clstati (CL_PRTYPE) != PR_CONNECTED) + call syserr (SYS_CLCMDNC) + else { + call flush (STDOUT) + call putline (CLOUT, cmd) + call putci (CLOUT, '\n') + call flush (CLOUT) + } +end diff --git a/sys/clio/clcmdw.x b/sys/clio/clcmdw.x new file mode 100644 index 00000000..ca8dfc4c --- /dev/null +++ b/sys/clio/clcmdw.x @@ -0,0 +1,28 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <clset.h> + +# CLCMDW -- Send a command line to the CL and wait for completion. + +procedure clcmdw (cmd) + +char cmd[ARB] +char junkstr[1] + +int junk +int oscmd(), clstati() +errchk syserr + +begin + if (cmd[1] == '!') + junk = oscmd (cmd[2], "", "", "") + else if (clstati (CL_PRTYPE) != PR_CONNECTED) + call syserr (SYS_CLCMDNC) + else { + call flush (STDOUT) + call putline (CLOUT, cmd) + call putci (CLOUT, '\n') + call clgstr ("cl.version", junkstr, 1) # wait for completion + } +end diff --git a/sys/clio/clcpset.x b/sys/clio/clcpset.x new file mode 100644 index 00000000..c6200b66 --- /dev/null +++ b/sys/clio/clcpset.x @@ -0,0 +1,11 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLCPSET -- Close a pset. + +procedure clcpset (pp) + +pointer pp # pset descriptor + +begin + call mfree (pp, TY_STRUCT) +end diff --git a/sys/clio/clepset.x b/sys/clio/clepset.x new file mode 100644 index 00000000..df0dce03 --- /dev/null +++ b/sys/clio/clepset.x @@ -0,0 +1,48 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <clio.h> +include "clpset.h" + +# CLEPSET -- Edit a pset. What exactly this operation implies depends +# upon the CL. To the application, it means any external operation which +# can modify the pset. + +procedure clepset (pp) + +pointer pp #I pset descriptor + +pointer sp, lbuf +bool streq() +int getlline() +errchk flush, getlline, clc_scan + +begin + call smark (sp) + call salloc (lbuf, SZ_COMMAND, TY_CHAR) + + # Edit pset and dump edited version back to CLIN. It is not + # necessary to write the pset to the CL before editing as the + # cache is "write-through" and any clputs will already have + # updated the CL version of the pset as well as the cache version. + + call flush (STDOUT) + call fprintf (CLOUT, "eparam %s; dparam %s > %s\n") + call pargstr (PS_PSETNAME(pp)) + call pargstr (PS_PSETNAME(pp)) + call pargstr (IPCOUT) + call flush (CLOUT) + + # Parse the new "param = value" statements returned by dparam and + # update the parameter cache. + + while (getlline (CLIN, Memc[lbuf], SZ_COMMAND) != EOF) + if (streq (Memc[lbuf], IPCDONEMSG)) + break + else + call clc_scan (Memc[lbuf]) + + # Delete the old parameter entries. + call clc_compress() + + call sfree (sp) +end diff --git a/sys/clio/clgcur.x b/sys/clio/clgcur.x new file mode 100644 index 00000000..7ceeb868 --- /dev/null +++ b/sys/clio/clgcur.x @@ -0,0 +1,110 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# CLGCUR -- Return the next cursor value from a list structured cursor type +# parameter. The format of a cursor value is as follows: +# +# X Y WCS KEY [SVAL] +# +# X,Y x and y cursor coordinates +# WCS wcs in which cursor coordinates are given +# KEY key(stroke) value associated with cursor read +# SVAL optional string associated with given key +# +# All fields need not be given, and extra fields may be supplied and will be +# either ignored or returned in SVAL. The X-Y-WCS fields may be omitted +# (in which case the input is KEY-[SVAL]), causing INDEF INDEF 0 KEY SVAL to be +# returned, exactly as if the INDEF INDEF 0 had been typed in. The number of +# fields read is returned as the function value; EOF is returned when the end +# of the cursor list is reached. + +int procedure clgcur (param, wx, wy, wcs, key, strval, maxch) + +char param[ARB] # parameter to be read +real wx, wy # cursor coordinates +int wcs # wcs to which coordinates belong +int key # keystroke value of cursor event +char strval[ARB] # string value, if any +int maxch + +char ch +pointer sp, buf, ip +int nitems, op, delim +int ctor(), ctoi(), cctoc(), clglstr(), stridx() +define quit_ 91 + +begin + call smark (sp) + call salloc (buf, SZ_LINE + maxch, TY_CHAR) + + # Flush any buffered text or graphics output. + call flush (STDERR) + call flush (STDOUT) + call gexfls() + + # Read the cursor. + if (clglstr (param, Memc[buf], SZ_LINE + maxch) == EOF) { + call sfree (sp) + return (EOF) + } + + ip = buf + nitems = 0 + while (IS_WHITE (Memc[ip])) + ip = ip + 1 + + if (IS_PRINT(Memc[ip]) && stridx (Memc[ip], "+-.0123456789") == 0) { + # The X-Y-WCS fields have been omitted; supply default values. + wx = INDEF + wy = INDEF + wcs = 0 + nitems = 3 + + } else { + # Decode the X-Y-WCS fields. + if (ctor (Memc, ip, wx) == 0) + goto quit_ + nitems = nitems + 1 + if (ctor (Memc, ip, wy) == 0) + goto quit_ + nitems = nitems + 1 + if (ctoi (Memc, ip, wcs) == 0) + goto quit_ + nitems = nitems + 1 + } + + # Get the KEY field. + if (cctoc (Memc, ip, ch) == 0) + goto quit_ + key = ch + nitems = nitems + 1 + + # Get the optional SVAL field. + while (IS_WHITE (Memc[ip])) + ip = ip + 1 + + if (Memc[ip] != '\n' && Memc[ip] != EOS) { + # Check for a quoted string. + if (Memc[ip] == '"' || Memc[ip] == '\'') { + delim = Memc[ip] + ip = ip + 1 + } else + delim = 0 + + # Extract the string value. + op = 1 + while (op <= maxch && Memc[ip] != '\n' && Memc[ip] != EOS && + Memc[ip] != delim) { + strval[op] = Memc[ip] + op = op + 1 + ip = ip + 1 + } + strval[op] = EOS + nitems = nitems + 1 + } + +quit_ + call sfree (sp) + return (nitems) +end diff --git a/sys/clio/clgetb.x b/sys/clio/clgetb.x new file mode 100644 index 00000000..4e75ec31 --- /dev/null +++ b/sys/clio/clgetb.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGETB -- Get a boolean parameter from the CL. + +bool procedure clgetb (param) + +char param[ARB] +bool bval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + call syserrs (SYS_CLEOFNLP, param) + else { + call gargb (bval) + if (nscan() != 1) + call syserrs (SYS_CLNOTBOOL, param) + } + + return (bval) +end diff --git a/sys/clio/clgetc.x b/sys/clio/clgetc.x new file mode 100644 index 00000000..36259ec4 --- /dev/null +++ b/sys/clio/clgetc.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGETC -- Get a character constant from the CL. + +char procedure clgetc (param) + +char param[ARB] +char cval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + call syserrs (SYS_CLEOFNLP, param) + else { + call gargc (cval) + if (nscan() != 1) + call syserrs (SYS_CLNOTCC, param) + } + + return (cval) +end diff --git a/sys/clio/clgetd.x b/sys/clio/clgetd.x new file mode 100644 index 00000000..12657a74 --- /dev/null +++ b/sys/clio/clgetd.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGETD -- Get a double precision floating parameter from the CL. + +double procedure clgetd (param) + +char param[ARB] +double dval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + call syserrs (SYS_CLEOFNLP, param) + else { + call gargd (dval) + if (nscan() != 1) + call syserrs (SYS_CLNOTNUM, param) + } + + return (dval) +end diff --git a/sys/clio/clgeti.x b/sys/clio/clgeti.x new file mode 100644 index 00000000..eb3c0019 --- /dev/null +++ b/sys/clio/clgeti.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGETI -- Get an integer valued parameter from the CL. + +int procedure clgeti (param) + +char param[ARB] +double dval, clgetd() + +begin + dval = clgetd (param) + if (IS_INDEFD (dval)) + return (INDEFI) + else + return (int(dval)) +end diff --git a/sys/clio/clgetl.x b/sys/clio/clgetl.x new file mode 100644 index 00000000..90a64d40 --- /dev/null +++ b/sys/clio/clgetl.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGETL -- Get a long integer parameter from the CL. + +long procedure clgetl (param) + +char param[ARB] +double dval, clgetd() + +begin + dval = clgetd (param) + if (IS_INDEFD (dval)) + return (INDEFL) + else + return (long(dval)) +end diff --git a/sys/clio/clgetr.x b/sys/clio/clgetr.x new file mode 100644 index 00000000..e8fb0a4b --- /dev/null +++ b/sys/clio/clgetr.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGETR -- Get a single precision floating parameter from the CL. + +real procedure clgetr (param) + +char param[ARB] +double dval, clgetd() + +begin + dval = clgetd (param) + if (IS_INDEFD (dval)) + return (INDEFR) + else + return (real(dval)) +end diff --git a/sys/clio/clgets.x b/sys/clio/clgets.x new file mode 100644 index 00000000..4cc00ab7 --- /dev/null +++ b/sys/clio/clgets.x @@ -0,0 +1,16 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGETS -- Get a short integer valued parameter from the CL. + +short procedure clgets (param) + +char param[ARB] +double dval, clgetd() + +begin + dval = clgetd (param) + if (IS_INDEFD (dval)) + return (INDEFS) + else + return (short(dval)) +end diff --git a/sys/clio/clgetx.x b/sys/clio/clgetx.x new file mode 100644 index 00000000..68e2b068 --- /dev/null +++ b/sys/clio/clgetx.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGETX -- Get a complex parameter from the CL. + +complex procedure clgetx (param) + +char param[ARB] +complex xval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + call syserrs (SYS_CLEOFNLP, param) + else { + call gargx (xval) + if (nscan() != 1) + call syserrs (SYS_CLNOTNUM, param) + } + + return (xval) +end diff --git a/sys/clio/clgfil.x b/sys/clio/clgfil.x new file mode 100644 index 00000000..62d40dd1 --- /dev/null +++ b/sys/clio/clgfil.x @@ -0,0 +1,144 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fset.h> + +.help clpopn[isu], clplen, clgfil, clpcls +.nf ___________________________________________________________________________ +Expand a filename template given as the string value of a CL parameter. + + clpopni - open a sorted input list or open list "STDIN" + clpopns - open a sorted list + clpopnu - open an unsorted list + clpcls - close a list + clplen - get number of filenames in list + clgfil - get next filename from list + clprew - rewind the list + +The CLPOPNI procedure creates a dummy list containing the single filename +"STDIN" if the standard input is redirected. +.endhelp ______________________________________________________________________ + + +# CLPOPNI -- Open an input list (sorted list of input files). If the standard +# input has been redirected, create a dummy list containing the single file +# name "STDIN", and do not try to access the template parameter. + +int procedure clpopni (param) + +char param[ARB] # CL filename template parameter +int sort +pointer sp, template, list +int fntopnb(), fstati() + +begin + call smark (sp) + call salloc (template, SZ_COMMAND, TY_CHAR) + + sort = YES + + if (fstati (STDIN, F_REDIR) == YES) + list = fntopnb ("STDIN", sort) + else { + call clgstr (param, Memc[template], SZ_COMMAND) + list = fntopnb (Memc[template], sort) + } + + call sfree (sp) + return (list) +end + + +# CLPOPNS -- Open a sorted list (sorted list of files, not associated with any +# particular byte stream). + +int procedure clpopns (param) + +char param[ARB] # CL filename template parameter +int sort +pointer sp, template, list +int fntopnb() + +begin + call smark (sp) + call salloc (template, SZ_COMMAND, TY_CHAR) + + sort = YES + + call clgstr (param, Memc[template], SZ_COMMAND) + list = fntopnb (Memc[template], sort) + + call sfree (sp) + return (list) +end + + +# CLPOPNU -- Open an unsorted list (unsorted list of files, not associated +# with any particular stream). + +int procedure clpopnu (param) + +char param[ARB] # CL filename template parameter +int sort +pointer sp, template, list +int fntopnb() + +begin + call smark (sp) + call salloc (template, SZ_COMMAND, TY_CHAR) + + sort = NO + + call clgstr (param, Memc[template], SZ_COMMAND) + list = fntopnb (Memc[template], sort) + + call sfree (sp) + return (list) +end + + +# CLPLEN -- Return the number of file names in the list. + +int procedure clplen (list) + +pointer list +int fntlenb() + +begin + return (fntlenb (list)) +end + + +# CLGFIL -- Return the next filename from the list. + +int procedure clgfil (list, fname, maxch) + +int list # list descriptor +char fname[ARB] # output string +int maxch +int fntgfnb() + +begin + return (fntgfnb (list, fname, maxch)) +end + + +# CLPCLS -- Close a filename list and return all storage. + +procedure clpcls (list) + +int list # list descriptor + +begin + call fntclsb (list) +end + + +# GLPREW -- Rewind the filename list. + +procedure clprew (list) + +int list # list descriptor + +begin + call fntrewb (list) +end diff --git a/sys/clio/clgkey.x b/sys/clio/clgkey.x new file mode 100644 index 00000000..c631076e --- /dev/null +++ b/sys/clio/clgkey.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> +include <clset.h> + +# CLGKEY -- Return the next keystroke value from a list structured `ukey' type +# parameter. + +int procedure clgkey (param, key, strval, maxch) + +char param[ARB] # parameter to be read +int key # keystroke value of cursor event +char strval[ARB] # string value, if any +int maxch + +char ch +int nitems, op +pointer sp, buf, ip +int cctoc(), clglstr() +int clstati(), rdukey() +define quit_ 91 + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + # Flush any buffered text output. + call flush (STDERR) + call flush (STDOUT) + + # Read the keyboard in raw mode. + if (clstati (CL_PRTYPE) == PR_CONNECTED) { + if (clglstr (param, Memc[buf], SZ_LINE) == EOF) { + call sfree (sp) + return (EOF) + } + } else { + if (rdukey (Memc[buf], SZ_LINE) == EOF) { + call sfree (sp) + return (EOF) + } + } + + ip = buf + nitems = 0 + if (cctoc (Memc, ip, ch) == 0) + goto quit_ + key = ch + nitems = nitems + 1 + + while (IS_WHITE (Memc[ip])) + ip = ip + 1 + if (Memc[ip] != '\n' && Memc[ip] != EOS) { + op = 1 + while (op <= maxch && Memc[ip] != '\n' && Memc[ip] != EOS) { + strval[op] = Memc[ip] + op = op + 1 + ip = ip + 1 + } + strval[op] = EOS + nitems = nitems + 1 + } + +quit_ + call sfree (sp) + return (nitems) +end diff --git a/sys/clio/clglpb.x b/sys/clio/clglpb.x new file mode 100644 index 00000000..313e630b --- /dev/null +++ b/sys/clio/clglpb.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGLPB -- Get a list structured boolean parameter from the CL. + +int procedure clglpb (param, bval) + +char param[ARB] +bool bval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + return (EOF) + else { + call gargb (bval) + if (nscan() != 1) + call syserrs (SYS_CLNOTBOOL, param) + } + + return (1) +end diff --git a/sys/clio/clglpc.x b/sys/clio/clglpc.x new file mode 100644 index 00000000..ad28f906 --- /dev/null +++ b/sys/clio/clglpc.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGLPC -- Get a list structured character constant parameter from the CL. + +int procedure clglpc (param, cval) + +char param[ARB] +char cval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + return (EOF) + else { + call gargc (cval) + if (nscan() != 1) + call syserrs (SYS_CLNOTCC, param) + } + + return (1) +end diff --git a/sys/clio/clglpd.x b/sys/clio/clglpd.x new file mode 100644 index 00000000..e9064790 --- /dev/null +++ b/sys/clio/clglpd.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGLPD -- Get a list structured double precision floating parameter from +# the CL. + +int procedure clglpd (param, dval) + +char param[ARB] +double dval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + return (EOF) + else { + call gargd (dval) + if (nscan() != 1) + call syserrs (SYS_CLNOTNUM, param) + } + + return (1) +end diff --git a/sys/clio/clglpi.x b/sys/clio/clglpi.x new file mode 100644 index 00000000..3b3d6800 --- /dev/null +++ b/sys/clio/clglpi.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGLPI -- Get a list structured integer valued parameter from the CL. + +int procedure clglpi (param, ival) + +char param[ARB] +int ival, stat, clglpd() +double dval + +begin + stat = clglpd (param, dval) + if (IS_INDEFD (dval)) + ival = INDEFI + else + ival = int (dval) + return (stat) +end diff --git a/sys/clio/clglpl.x b/sys/clio/clglpl.x new file mode 100644 index 00000000..f486092b --- /dev/null +++ b/sys/clio/clglpl.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGLPL -- Get a list structured long integer valued parameter from the CL. + +int procedure clglpl (param, lval) + +char param[ARB] +long lval +int stat, clglpd() +double dval + +begin + stat = clglpd (param, dval) + if (IS_INDEFD (dval)) + lval = INDEFL + else + lval = long (dval) + return (stat) +end diff --git a/sys/clio/clglpr.x b/sys/clio/clglpr.x new file mode 100644 index 00000000..2572041c --- /dev/null +++ b/sys/clio/clglpr.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGLPR -- Get a list structured single precision floating valued parameter +# from the CL. + +int procedure clglpr (param, rval) + +char param[ARB] +real rval +int stat, clglpd() +double dval + +begin + stat = clglpd (param, dval) + if (IS_INDEFD (dval)) + rval = INDEFR + else + rval = real (dval) + return (stat) +end diff --git a/sys/clio/clglps.x b/sys/clio/clglps.x new file mode 100644 index 00000000..d7179eb3 --- /dev/null +++ b/sys/clio/clglps.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGLPS -- Get a list structured short integer valued parameter from the CL. + +int procedure clglps (param, sval) + +char param[ARB] +short sval +int stat, clglpd() +double dval + +begin + stat = clglpd (param, dval) + if (IS_INDEFD (dval)) + sval = INDEFS + else + sval = short (dval) + return (stat) +end diff --git a/sys/clio/clglpx.x b/sys/clio/clglpx.x new file mode 100644 index 00000000..04e597d1 --- /dev/null +++ b/sys/clio/clglpx.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGLPX -- Get a list structured complex parameter from the CL. + +int procedure clglpx (param, xval) + +char param[ARB] +complex xval +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + return (EOF) + else { + call gargx (xval) + if (nscan() != 1) + call syserrs (SYS_CLNOTNUM, param) + } + + return (1) +end diff --git a/sys/clio/clglstr.x b/sys/clio/clglstr.x new file mode 100644 index 00000000..f60b58c9 --- /dev/null +++ b/sys/clio/clglstr.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLGLSTR -- Get a list structured string parameter from the CL. + +int procedure clglstr (param, outstr, maxch) + +char param[ARB], outstr[maxch] +int maxch +int clscan(), nscan(), strlen() + +begin + if (clscan (param) == EOF) + return (EOF) + else { + call gargstr (outstr, maxch) + if (nscan() != 1) + outstr[1] = EOS + } + + return (strlen (outstr)) +end diff --git a/sys/clio/clgpset.x b/sys/clio/clgpset.x new file mode 100644 index 00000000..a8dd1d85 --- /dev/null +++ b/sys/clio/clgpset.x @@ -0,0 +1,19 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSET -- Get the string value of the named pset parameter. +# [OBSOLETE ROUTINE - see clgpseta.x] + +procedure clgpset (pp, pname, outstr, maxch) + +pointer pp # pset descriptor +char pname[ARB] # parameter name +char outstr[maxch] # output string +int maxch # max chars out + +pointer clpset_parname() + +begin + call clgstr (PARNAME(pp,pname), outstr, maxch) +end diff --git a/sys/clio/clgpseta.x b/sys/clio/clgpseta.x new file mode 100644 index 00000000..277165d1 --- /dev/null +++ b/sys/clio/clgpseta.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETA -- Get the string value of the named pset parameter. + +procedure clgpseta (pp, pname, outstr, maxch) + +pointer pp # pset descriptor +char pname[ARB] # parameter name +char outstr[maxch] # output string +int maxch # max chars out + +pointer clpset_parname() + +begin + call clgstr (PARNAME(pp,pname), outstr, maxch) +end diff --git a/sys/clio/clgpsetb.x b/sys/clio/clgpsetb.x new file mode 100644 index 00000000..651f5306 --- /dev/null +++ b/sys/clio/clgpsetb.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETB -- Get the boolean value of a pset parameter. + +bool procedure clgpsetb (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +bool clgetb() + +begin + return (clgetb (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsetc.x b/sys/clio/clgpsetc.x new file mode 100644 index 00000000..fe54715e --- /dev/null +++ b/sys/clio/clgpsetc.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETC -- Get the char value of a pset parameter. + +char procedure clgpsetc (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +char clgetc() + +begin + return (clgetc (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsetd.x b/sys/clio/clgpsetd.x new file mode 100644 index 00000000..dfd39372 --- /dev/null +++ b/sys/clio/clgpsetd.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETD -- Get the double value of a pset parameter. + +double procedure clgpsetd (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +double clgetd() + +begin + return (clgetd (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpseti.x b/sys/clio/clgpseti.x new file mode 100644 index 00000000..c39d102b --- /dev/null +++ b/sys/clio/clgpseti.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETI -- Get the int value of a pset parameter. + +int procedure clgpseti (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +int clgeti() + +begin + return (clgeti (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsetl.x b/sys/clio/clgpsetl.x new file mode 100644 index 00000000..374f0851 --- /dev/null +++ b/sys/clio/clgpsetl.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETL -- Get the long integer value of a pset parameter. + +long procedure clgpsetl (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +long clgetl() + +begin + return (clgetl (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsetr.x b/sys/clio/clgpsetr.x new file mode 100644 index 00000000..598a2c42 --- /dev/null +++ b/sys/clio/clgpsetr.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETR -- Get the real value of a pset parameter. + +real procedure clgpsetr (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +real clgetr() + +begin + return (clgetr (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsets.x b/sys/clio/clgpsets.x new file mode 100644 index 00000000..9210a8b2 --- /dev/null +++ b/sys/clio/clgpsets.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETS -- Get the short integer value of a pset parameter. + +short procedure clgpsets (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +short clgets() + +begin + return (clgets (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgpsetx.x b/sys/clio/clgpsetx.x new file mode 100644 index 00000000..b20fda29 --- /dev/null +++ b/sys/clio/clgpsetx.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLGPSETX -- Get the complex value of a pset parameter. + +complex procedure clgpsetx (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # parameter name + +pointer clpset_parname() +complex clgetx() + +begin + return (clgetx (PARNAME(pp,parname))) +end diff --git a/sys/clio/clgstr.x b/sys/clio/clgstr.x new file mode 100644 index 00000000..c8ec9ebd --- /dev/null +++ b/sys/clio/clgstr.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGSTR -- Get a string parameter from the CL. + +procedure clgstr (param, outstr, maxch) + +char param[ARB], outstr[maxch] +int maxch +int clscan(), nscan() + +begin + if (clscan (param) == EOF) + call syserr (SYS_CLEOFNLP) + else { + call gargstr (outstr, maxch) + if (nscan() != 1) + outstr[1] = EOS + } +end diff --git a/sys/clio/clgwrd.x b/sys/clio/clgwrd.x new file mode 100644 index 00000000..0dd6ee49 --- /dev/null +++ b/sys/clio/clgwrd.x @@ -0,0 +1,33 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> + +# CLGWRD -- Get a keyword parameter from the CL, and match it against +# a dictionary of legal keywords. Any unambiguous abbreviation is +# accepted. The full keyword string is returned in keyword, and the +# word index of the keyword in the dictionary is returned as the function +# value. + +int procedure clgwrd (param, keyword, maxchar, dictionary) + +char param[ARB] # CL parameter string +char keyword[ARB] # String matched in dictionary +int maxchar # Maximum size of str +char dictionary[ARB] # Dictionary string + +pointer sp, abbrev +int kwindex, strdic() + +begin + call smark (sp) + call salloc (abbrev, SZ_FNAME, TY_CHAR) + + call clgstr (param, Memc[abbrev], maxchar) + kwindex = strdic (Memc[abbrev], keyword, maxchar, dictionary) + + if (kwindex <= 0) + call syserrs (SYS_CLGWRD, Memc[abbrev]) + + call sfree (sp) + return (kwindex) +end diff --git a/sys/clio/clio.com b/sys/clio/clio.com new file mode 100644 index 00000000..78567dd0 --- /dev/null +++ b/sys/clio/clio.com @@ -0,0 +1,18 @@ +# CLIO parameters. + +int cl_prtype # parent process type +pointer cl_stp # clcache symbol table pointer +int cl_stmark # stmark value for initial table +int cl_nposargs # number of $1, $2 type task parameters +int cl_nextarg # index into posarg list +pointer cl_posarg[MAX_POSARGS] # symtab offsets of positional args +int ps_status[MAX_PSEUDOFILES] # for pseudofile drivers +int cl_npsets # number of psets for task (>= 1) +int cl_psetop # next char in pset name buffer +int cl_psetindex[MAX_PSETS] # index of pset names (1 = taskname) +char cl_psetname[SZ_PSETNAMEBUF] # char storage for pset names +char cl_pname[SZ_PNAME] # handy buffer for param names + +common /clio_com/ cl_prtype, cl_stp, cl_stmark, cl_nposargs, cl_nextarg, + cl_posarg, ps_status, cl_npsets, cl_psetop, cl_psetindex, cl_psetname, + cl_pname diff --git a/sys/clio/cllpset.x b/sys/clio/cllpset.x new file mode 100644 index 00000000..aa06a57a --- /dev/null +++ b/sys/clio/cllpset.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLLPSET -- List a pset. Each param,value pair is written to the output +# file using the caller supplied format, e.g., "set %s = \"%s\"\n". + +procedure cllpset (pp, fd, format) + +pointer pp #I pset descriptor +int fd #I output file +char format[ARB] #I format, one %s each for param, value + +begin + call clc_compress() + call clc_list (fd, PS_PSETNAME(pp), format) +end diff --git a/sys/clio/clopen.x b/sys/clio/clopen.x new file mode 100644 index 00000000..a83bb753 --- /dev/null +++ b/sys/clio/clopen.x @@ -0,0 +1,124 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <config.h> +include <ttset.h> +include <fset.h> +include <knet.h> + +# CLOPEN -- "Open" the CL files (initialize CLIO). Called by the IRAF Main +# upon process startup. The CL device may be either the CL process, +# communicating with the current process via intertask communications +# (via ZARDCL, ZAWRCL), or a text file or terminal. "Open" the files CLIN +# and CLOUT, and the standard pseudofiles STDIN, STDOUT, STDERR, STDGRAPH, +# STDIMAGE, STDPLOT, and PSIOCTRL. + +procedure clopen (stdin_chan, stdout_chan, stderr_chan, device, devtype) + +int stdin_chan # OS channel for the process standard input +int stdout_chan # OS channel for the process standard output +int stderr_chan # OS channel for the standard error output +int device # zlocpr EPA of the driver read routine +int devtype # device type (text or binary) + +int fd, psmode, chan, devepa +int fsetfd(), locpr() +extern zardps(), zardnu(), zgetty(), zgettt() + +begin + if (devtype == BINARY_FILE) + psmode = WRITE_ONLY + else + psmode = APPEND + + # Allocate and initialize the standard (predefined) file descriptors. + # FSETFD performs only the standard initialization. The remainder + # of the code initializes the device dependent parameters. + + fd = fsetfd (CLIN, "CLIN", READ_ONLY, devtype) + fd = fsetfd (CLOUT, "CLOUT", psmode, devtype) + fd = fsetfd (STDIN, "STDIN", READ_ONLY, devtype) + fd = fsetfd (STDOUT, "STDOUT", psmode, devtype) + fd = fsetfd (STDERR, "STDERR", psmode, devtype) + fd = fsetfd (STDGRAPH, "STDGRAPH", READ_WRITE, BINARY_FILE) + fd = fsetfd (STDIMAGE, "STDIMAGE", READ_WRITE, BINARY_FILE) + fd = fsetfd (STDPLOT, "STDPLOT", READ_WRITE, BINARY_FILE) + fd = fsetfd (PSIOCTRL, "PSIOCTRL", READ_WRITE, BINARY_FILE) + + # Set the entry point addresses of the device Z-routines for each + # of the special files. If the process channels are text files + # (character files or a terminal) the pseudofiles are connected to + # real files (no multiplexing). Graphics i/o is connected to the + # null file if the process channels are textual, hence graphics + # output is discarded (unless redirected) when a task is run stand + # alone. If the device we are passed is the kernel terminal driver + # TY, connect the VOS logical terminal driver TT instead. + + if (device == locpr (zgetty)) { + devepa = locpr (zgettt) + call zsettt (stdin_chan, TT_KINCHAN, stdin_chan) + call zsettt (stdout_chan, TT_KOUTCHAN, stdout_chan) + } else + devepa = device + + call fseti (CLIN, F_DEVICE, devepa) + call fseti (CLOUT, F_DEVICE, devepa) + + if (devtype == TEXT_FILE) { + # Set device drivers for the textual pseudofiles. + do fd = STDIN, STDERR + call fseti (fd, F_DEVICE, devepa) + + # Connect the graphics streams to the null file. + do fd = STDGRAPH, PSIOCTRL + call fseti (fd, F_DEVICE, locpr(zardnu)) + + } else { + # Connect the pseudofiles to the pseudofile driver. + do fd = STDIN, PSIOCTRL + call fseti (fd, F_DEVICE, locpr(zardps)) + } + + # Associate a device channel with the two IPC streams and with each + # pseudofile. + + call fseti (CLIN, F_CHANNEL, stdin_chan) + call fseti (CLOUT, F_CHANNEL, stdout_chan) + + if (devtype == TEXT_FILE) { + call fseti (STDIN, F_CHANNEL, stdin_chan) + call fseti (STDOUT, F_CHANNEL, stdout_chan) + call fseti (STDERR, F_CHANNEL, stdout_chan) + + # Open a null file on each graphics stream. + do fd = STDGRAPH, PSIOCTRL { + call zopnnu ("", READ_WRITE, chan) + call fseti (fd, F_CHANNEL, chan) + } + + } else { + # The channel code for a pseudofile is used for the pseudofile code, + # since the actual i/o is always on channels CLIN and CLOUT. + + do fd = STDIN, PSIOCTRL + call fseti (fd, F_CHANNEL, fd) + } + + call fseti (STDERR, F_FLUSHNL, YES) # flush error messages + # call fseti (CLOUT, F_FLUSHNL, YES) # flush CL commands + + # Get device block size, and the minimum optimal buffer size for + # efficient sequential i/o. + + do fd = CLIN, PSIOCTRL # device parameters + call fgdev_param (fd) + + # Seek is needed to set the proper logical offset for each file, + # as well as to seek to the end of a text file if no CL. + + call seek (CLIN, BOFL) + call seek (CLOUT, EOFL) + call seek (STDIN, BOFL) + + do fd = STDOUT, PSIOCTRL + call seek (fd, EOFL) +end diff --git a/sys/clio/clopset.x b/sys/clio/clopset.x new file mode 100644 index 00000000..f06ae0b9 --- /dev/null +++ b/sys/clio/clopset.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLOPSET -- Open a named pset. + +pointer procedure clopset (pset) + +char pset[ARB] # pset name (name of CL pset parameter) +pointer pp +errchk malloc + +begin + call malloc (pp, LEN_PSETDES, TY_STRUCT) + call strcpy (pset, PS_PSETNAME(pp), SZ_PSPSETNAME) + + return (pp) +end diff --git a/sys/clio/clppset.x b/sys/clio/clppset.x new file mode 100644 index 00000000..b5d2691f --- /dev/null +++ b/sys/clio/clppset.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSET -- Set the string value of the named pset parameter. +# [OBSOLETE ROUTINE - see clppseta.x] + +procedure clppset (pp, pname, sval) + +pointer pp # pset descriptor +char pname[ARB] # parameter name +char sval[ARB] # string value of parameter + +pointer clpset_parname() + +begin + call clpstr (PARNAME(pp,pname), sval) +end diff --git a/sys/clio/clppseta.x b/sys/clio/clppseta.x new file mode 100644 index 00000000..4fad477c --- /dev/null +++ b/sys/clio/clppseta.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETA -- Set the string value of the named pset parameter. + +procedure clppseta (pp, pname, sval) + +pointer pp # pset descriptor +char pname[ARB] # parameter name +char sval[ARB] # string value of parameter + +pointer clpset_parname() + +begin + call clpstr (PARNAME(pp,pname), sval) +end diff --git a/sys/clio/clppsetb.x b/sys/clio/clppsetb.x new file mode 100644 index 00000000..5ada363f --- /dev/null +++ b/sys/clio/clppsetb.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETB -- Set the boolean value of a pset parameter. + +procedure clppsetb (pp, parname, bval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +bool bval # new value of parameter + +pointer clpset_parname() + +begin + call clputb (PARNAME(pp,parname), bval) +end diff --git a/sys/clio/clppsetc.x b/sys/clio/clppsetc.x new file mode 100644 index 00000000..46ebcf22 --- /dev/null +++ b/sys/clio/clppsetc.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETC -- Set the char value of a pset parameter. + +procedure clppsetc (pp, parname, cval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +char cval # new value of parameter + +pointer clpset_parname() + +begin + call clputc (PARNAME(pp,parname), cval) +end diff --git a/sys/clio/clppsetd.x b/sys/clio/clppsetd.x new file mode 100644 index 00000000..b7fd3376 --- /dev/null +++ b/sys/clio/clppsetd.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETD -- Set the double value of a pset parameter. + +procedure clppsetd (pp, parname, dval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +double dval # new value of parameter + +pointer clpset_parname() + +begin + call clputd (PARNAME(pp,parname), dval) +end diff --git a/sys/clio/clppseti.x b/sys/clio/clppseti.x new file mode 100644 index 00000000..6cb06daf --- /dev/null +++ b/sys/clio/clppseti.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETI -- Set the integer value of a pset parameter. + +procedure clppseti (pp, parname, ival) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +int ival # new value of parameter + +pointer clpset_parname() + +begin + call clputi (PARNAME(pp,parname), ival) +end diff --git a/sys/clio/clppsetl.x b/sys/clio/clppsetl.x new file mode 100644 index 00000000..23ebae92 --- /dev/null +++ b/sys/clio/clppsetl.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETL -- Set the long integer value of a pset parameter. + +procedure clppsetl (pp, parname, lval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +long lval # new value of parameter + +pointer clpset_parname() + +begin + call clputl (PARNAME(pp,parname), lval) +end diff --git a/sys/clio/clppsetr.x b/sys/clio/clppsetr.x new file mode 100644 index 00000000..b917549d --- /dev/null +++ b/sys/clio/clppsetr.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETR -- Set the real value of a pset parameter. + +procedure clppsetr (pp, parname, rval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +real rval # new value of parameter + +pointer clpset_parname() + +begin + call clputr (PARNAME(pp,parname), rval) +end diff --git a/sys/clio/clppsets.x b/sys/clio/clppsets.x new file mode 100644 index 00000000..ef48bfb3 --- /dev/null +++ b/sys/clio/clppsets.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETS -- Set the short integer value of a pset parameter. + +procedure clppsets (pp, parname, sval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +short sval # new value of parameter + +pointer clpset_parname() + +begin + call clputs (PARNAME(pp,parname), sval) +end diff --git a/sys/clio/clppsetx.x b/sys/clio/clppsetx.x new file mode 100644 index 00000000..64815812 --- /dev/null +++ b/sys/clio/clppsetx.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPPSETX -- Set the complex value of a pset parameter. + +procedure clppsetx (pp, parname, xval) + +pointer pp # pset descriptor +char parname[ARB] # parameter name +complex xval # new value of parameter + +pointer clpset_parname() + +begin + call clputx (PARNAME(pp,parname), xval) +end diff --git a/sys/clio/clpset.h b/sys/clio/clpset.h new file mode 100644 index 00000000..df52e366 --- /dev/null +++ b/sys/clio/clpset.h @@ -0,0 +1,12 @@ +# CLPSET.H -- CL pset access package header file. + +define SZ_PSPSETNAME 31 +define SZ_PSPARNAME 63 + +define LEN_PSETDES 96 +define PS_PSETNAMEP P2C($1) # pset name pointer +define PS_PSETNAME Memc[P2C($1)] # pset name +define PS_PARNAMEP (P2C($1)+SZ_PSPSETNAME+1) # pointer to tempbuf +define PS_PARNAME Memc[P2C($1)+SZ_PSPSETNAME+1] # temp buffer + +define PARNAME Memc[clpset_parname($1,$2)] diff --git a/sys/clio/clpsetnm.x b/sys/clio/clpsetnm.x new file mode 100644 index 00000000..6854d94b --- /dev/null +++ b/sys/clio/clpsetnm.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "clpset.h" + +# CLPSET_PARNAME -- Return a pointer to the full name (pset.parname) of a +# parameter in the referenced pset. + +pointer procedure clpset_parname (pp, parname) + +pointer pp # pset descriptor +char parname[ARB] # name of parameter in pset + +pointer op +int gstrcpy() + +begin + op = PS_PARNAMEP(pp) + if (Memc[PS_PSETNAMEP(pp)] != EOS) { + op = op + gstrcpy (PS_PSETNAME(pp), Memc[op], SZ_PSPARNAME) + Memc[op] = '.'; op = op + 1 + } + call strcpy (parname, Memc[op], SZ_PSPARNAME-(op-PS_PARNAMEP(pp))) + + return (PS_PARNAMEP(pp)) +end diff --git a/sys/clio/clpstr.x b/sys/clio/clpstr.x new file mode 100644 index 00000000..d040fe5d --- /dev/null +++ b/sys/clio/clpstr.x @@ -0,0 +1,26 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPSTR -- Put a string type parameter to the CL. + +procedure clpstr (param, value) + +char param[ARB] # param name +char value[ARB] # new value + +pointer sp, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (pname, SZ_FNAME, TY_CHAR) + + call fprintf (CLOUT, "%s=\"%s\"\n") + call pargstr (param) + call pargstr (value) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], value) + + call sfree (sp) +end diff --git a/sys/clio/clputb.x b/sys/clio/clputb.x new file mode 100644 index 00000000..dcc99ad8 --- /dev/null +++ b/sys/clio/clputb.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPUTB -- Put a boolean valued parameter to the CL. + +procedure clputb (param, bval) + +char param[ARB] +bool bval + +pointer sp, value, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + + # Update the parameter in the CL. + call sprintf (Memc[value], SZ_FNAME, "%b") + call pargb (bval) + call fprintf (CLOUT, "%s = %s\n") + call pargstr (param) + call pargstr (Memc[value]) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], Memc[value]) + + call sfree (sp) +end diff --git a/sys/clio/clputc.x b/sys/clio/clputc.x new file mode 100644 index 00000000..333160fe --- /dev/null +++ b/sys/clio/clputc.x @@ -0,0 +1,36 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# CLPUTC -- Put a character constant type parameter to the CL. + +procedure clputc (param, cval) + +char param[ARB] +char cval + +pointer sp, value, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + + # Character constants are stored as strings in the CL. Add single + # quotes about the character value to deimit the string. The + # character may be represented as a single character or as an escape + # sequence. + + call sprintf (Memc[value], SZ_FNAME, "'%c'") + call pargc (cval) + call fprintf (CLOUT, "%s = %s\n") + call pargstr (param) + call pargstr (Memc[value]) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], Memc[value]) + + call sfree (sp) +end diff --git a/sys/clio/clputd.x b/sys/clio/clputd.x new file mode 100644 index 00000000..71403bd9 --- /dev/null +++ b/sys/clio/clputd.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPUTD -- Put a double precision parameter to the CL. + +procedure clputd (param, dval) + +char param[ARB] +double dval + +pointer sp, value, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + + # Update the parameter in the CL. + call sprintf (Memc[value], SZ_FNAME, "%g") + call pargd (dval) + call fprintf (CLOUT, "%s = %s\n") + call pargstr (param) + call pargstr (Memc[value]) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], Memc[value]) + + call sfree (sp) +end diff --git a/sys/clio/clputi.x b/sys/clio/clputi.x new file mode 100644 index 00000000..d7c9fc29 --- /dev/null +++ b/sys/clio/clputi.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPUTI -- Set a CL parameter of type integer. + +procedure clputi (param, value) + +char param[ARB] # parameter to be set +int value # new value +long lval + +begin + lval = value + if (IS_INDEFI (value)) + lval = INDEFL + + call clputl (param, lval) +end + + +# CLPUTS -- Set a CL parameter of type short. + +procedure clputs (param, value) + +char param[ARB] # parameter to be set +short value # new value +long lval + +begin + lval = value + if (IS_INDEFS (value)) + lval = INDEFL + + call clputl (param, lval) +end + + +# CLPUTL -- Put a long integer parameter to the CL. + +procedure clputl (param, lval) + +char param[ARB] +long lval + +pointer sp, value, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + + # Update the parameter in the CL. + call sprintf (Memc[value], SZ_FNAME, "%d") + call pargl (lval) + call fprintf (CLOUT, "%s = %s\n") + call pargstr (param) + call pargstr (Memc[value]) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], Memc[value]) + + call sfree (sp) +end diff --git a/sys/clio/clputr.x b/sys/clio/clputr.x new file mode 100644 index 00000000..4ee37caf --- /dev/null +++ b/sys/clio/clputr.x @@ -0,0 +1,18 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPUTR -- Put a real valued parameter to the CL. + +procedure clputr (param, rval) + +char param[ARB] +real rval +double dval + +begin + if (IS_INDEFR(rval)) + dval = INDEFD + else + dval = rval + + call clputd (param, dval) +end diff --git a/sys/clio/clputx.x b/sys/clio/clputx.x new file mode 100644 index 00000000..7bbe66e7 --- /dev/null +++ b/sys/clio/clputx.x @@ -0,0 +1,30 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# CLPUTX -- Put a complex type parameter to the CL. + +procedure clputx (param, xval) + +char param[ARB] +complex xval + +pointer sp, value, pname +pointer clc_find() + +begin + call smark (sp) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (pname, SZ_FNAME, TY_CHAR) + + # Update the parameter in the CL. + call sprintf (Memc[value], SZ_FNAME, "%z") + call pargx (xval) + call fprintf (CLOUT, "%s = %s\n") + call pargstr (param) + call pargstr (Memc[value]) + + # If the parameter is in the cache, update the cached value as well. + if (clc_find (param, Memc[pname], SZ_FNAME) != NULL) + call clc_enter (Memc[pname], Memc[value]) + + call sfree (sp) +end diff --git a/sys/clio/clreqpar.x b/sys/clio/clreqpar.x new file mode 100644 index 00000000..9817c0bf --- /dev/null +++ b/sys/clio/clreqpar.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <clset.h> + +# CLREQPAR -- Request a parameter from the CL. + +procedure clreqpar (param) + +char param[ARB] +int clstati() + +begin + call flush (STDOUT) + + if (clstati (CL_PRTYPE) == PR_CONNECTED) { + call putline (CLOUT, "=") + call putline (CLOUT, param) + call putline (CLOUT, "\n") + } else { + call putline (CLOUT, param) + call putline (CLOUT, ": ") + } + + call flush (CLOUT) +end diff --git a/sys/clio/clseti.x b/sys/clio/clseti.x new file mode 100644 index 00000000..c676fb19 --- /dev/null +++ b/sys/clio/clseti.x @@ -0,0 +1,23 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <clset.h> +include <syserr.h> +include <clio.h> + +# CLSETI -- Set a CLIO option of type integer. Called by the IRAF Main +# upon process startup to set the CL_PRTYPE flag. + +procedure clseti (parameter, value) + +int parameter # CLIO parameter being queried +int value # value of parameter (output) +include "clio.com" + +begin + switch (parameter) { + case CL_PRTYPE: + cl_prtype = value + default: + call syserrs (SYS_CLSETUKNPAR, "clseti") + } +end diff --git a/sys/clio/clstati.x b/sys/clio/clstati.x new file mode 100644 index 00000000..05ea76bb --- /dev/null +++ b/sys/clio/clstati.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <clio.h> +include <clset.h> + +# CLSTATI -- Get the value of an integer CLIO parameter. Currently there is +# only one CLIO parameter, the process type of the parent (connected, detached, +# or host). + +int procedure clstati (parameter) + +int parameter +include "clio.com" + +begin + switch (parameter) { + case CL_PRTYPE: + return (cl_prtype) + case CL_PCACHE: + return (cl_stp) + default: + call syserrs (SYS_CLSTATUS, "clstati") + } +end diff --git a/sys/clio/doc/clio.hd b/sys/clio/doc/clio.hd new file mode 100644 index 00000000..4b5b00f2 --- /dev/null +++ b/sys/clio/doc/clio.hd @@ -0,0 +1,40 @@ +# Help directory for the CLIO (command language i/o) system package. + +$clio = "sys$clio/" + +clcmd hlp = clcmd.hlp, src = clio$clcmd.x +clgetb hlp = clget.hlp, src = clio$clgetb.x +clgetc hlp = clget.hlp, src = clio$clgetc.x +clgetd hlp = clget.hlp, src = clio$clgetd.x +clgeti hlp = clget.hlp, src = clio$clgeti.x +clgetl hlp = clget.hlp, src = clio$clgetl.x +clgetr hlp = clget.hlp, src = clio$clgetr.x +clgets hlp = clget.hlp, src = clio$clgets.x +clgetx hlp = clget.hlp, src = clio$clgetx.x +clgfil hlp = clgfil.hlp, src = clio$clgfil.x +clglpb hlp = clglp.hlp, src = clio$clglpb.x +clglpc hlp = clglp.hlp, src = clio$clglpc.x +clglpd hlp = clglp.hlp, src = clio$clglpd.x +clglpi hlp = clglp.hlp, src = clio$clglpi.x +clglpl hlp = clglp.hlp, src = clio$clglpl.x +clglpr hlp = clglp.hlp, src = clio$clglpr.x +clglps hlp = clglp.hlp, src = clio$clglps.x +clglpx hlp = clglp.hlp, src = clio$clglpx.x +clglstr hlp = clglp.hlp, src = clio$clglstr.x +clgstr hlp = clget.hlp, src = clio$clgstr.x +clgwrd hlp = clget.hlp, src = clio$clgwrd.x +clpcls hlp = clgfil.hlp, src = clio$clgfil.x +clplen hlp = clgfil.hlp, src = clio$clgfil.x +clpopni hlp = clgfil.hlp, src = clio$clgfil.x +clpopns hlp = clgfil.hlp, src = clio$clgfil.x +clpopnu hlp = clgfil.hlp, src = clio$clgfil.x +clprew hlp = clgfil.hlp, src = clio$clgfil.x +clpstr hlp = clput.hlp, src = clio$clpstr.x +clputb hlp = clput.hlp, src = clio$clputb.x +clputc hlp = clput.hlp, src = clio$clputc.x +clputd hlp = clput.hlp, src = clio$clputd.x +clputi hlp = clput.hlp, src = clio$clputi.x +clputr hlp = clput.hlp, src = clio$clputr.x +clputx hlp = clput.hlp, src = clio$clputx.x +clseti hlp = clseti.hlp, src = clio$clseti.x +clstati hlp = clstati.hlp, src = clio$clstati.x diff --git a/sys/clio/doc/clio.men b/sys/clio/doc/clio.men new file mode 100644 index 00000000..f7f24059 --- /dev/null +++ b/sys/clio/doc/clio.men @@ -0,0 +1,16 @@ + clcmd - Send a command to the CL (restricted) +clget[bcsilrdx] - Get the value of a CL parameter + clpopni - Open a sorted input filename template + clpopns - Open a sorted filename template or namelist + clpopnu - Open an unsorted filename template or namelist + clplen - Number of elements in a list opened with clpopn[isu] + clgfil - Get a file from a list opened with clpopn[isu] + clpcls - Close a list opened with clpopn[isu] +clglp[bcsilrdx] - Get the next value from a list-structured CL parameter + clglstr - Get the next value from a string list-structured CL parameter + clgstr - Get the value of a CL string type parameter + clgwrd - Get the first word from a string valued CL parameter + clpstr - Set the value of a string valued CL parameter +clput[bcsilrdx] - Set the value of a CL parameter + clseti - Set the value of a CLIO parameter + clstati - Get the value of a CLIO parameter diff --git a/sys/clio/gexfls.x b/sys/clio/gexfls.x new file mode 100644 index 00000000..5eadf759 --- /dev/null +++ b/sys/clio/gexfls.x @@ -0,0 +1,58 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# GEXFLS -- Externally callable procedure for flushing graphics output. +# Called by the CLIO procedure CLGCUR to flush graphics output prior to +# a cursor read. The main complication is that since CLGCUR is part of +# the CLIO package and may be used in a program that does not generate +# any graphics, we do not want to directly reference any GIO procedures +# since this would force the linker to load much of GIO. + +procedure gexfls() + +int gflush +pointer gp[2] +common /gxflcm/ gp, gflush + +begin + if (gflush != NULL) { + if (gp[1] != NULL) + call zcall1 (gflush, gp[1]) + if (gp[2] != NULL) + call zcall1 (gflush, gp[2]) + } +end + + +# GEXFLS_SET -- Set pointers to the gflush procedure for a stream. + +procedure gexfls_set (stream, gp_value, epa_gflush) + +int stream # graphics stream +pointer gp_value # graphics descriptor +int epa_gflush # EPA of the gflush procedure + +int gflush +pointer gp[2] +common /gxflcm/ gp, gflush + +begin + if (stream == STDGRAPH || stream == STDIMAGE) { + gp[stream-STDGRAPH+1] = gp_value + gflush = epa_gflush + } +end + + +# GEXFLS_CLEAR -- Clear the pointer to the gflush procedure for a stream. + +procedure gexfls_clear (stream) + +int stream # graphics stream +int gflush +pointer gp[2] +common /gxflcm/ gp, gflush + +begin + if (stream == STDGRAPH || stream == STDIMAGE) + gp[stream-STDGRAPH+1] = NULL +end diff --git a/sys/clio/mkpkg b/sys/clio/mkpkg new file mode 100644 index 00000000..69aca042 --- /dev/null +++ b/sys/clio/mkpkg @@ -0,0 +1,75 @@ +# CLIO portion of the system library. + +$checkout libsys.a lib$ +$update libsys.a +$checkin libsys.a lib$ +$exit + +libsys.a: + clcache.x clio.com <clio.h> <ctype.h> + clclose.x <config.h> + clcmd.x <clset.h> + clcmdw.x <clset.h> + clcpset.x + clepset.x clpset.h <clio.h> + clgcur.x <ctype.h> + clgetb.x + clgetc.x + clgetd.x + clgeti.x + clgetl.x + clgetr.x + clgets.x + clgetx.x + clgfil.x <fset.h> + clgkey.x <clset.h> <ctype.h> + clglpb.x + clglpc.x + clglpd.x + clglpi.x + clglpl.x + clglpr.x + clglps.x + clglpx.x + clglstr.x + clgpset.x clpset.h + clgpseta.x clpset.h + clgpsetb.x clpset.h + clgpsetc.x clpset.h + clgpsetd.x clpset.h + clgpseti.x clpset.h + clgpsetl.x clpset.h + clgpsetr.x clpset.h + clgpsets.x clpset.h + clgpsetx.x clpset.h + clgstr.x + clgwrd.x + cllpset.x clpset.h + clopen.x <config.h> <fset.h> <knet.h> <ttset.h> + clopset.x clpset.h + clppset.x clpset.h + clppseta.x clpset.h + clppsetb.x clpset.h + clppsetc.x clpset.h + clppsetd.x clpset.h + clppseti.x clpset.h + clppsetl.x clpset.h + clppsetr.x clpset.h + clppsets.x clpset.h + clppsetx.x clpset.h + clpsetnm.x clpset.h + clpstr.x + clputb.x + clputc.x <ctype.h> + clputd.x + clputi.x + clputr.x + clputx.x + clreqpar.x <clset.h> + clseti.x clio.com <clio.h> <clset.h> + clstati.x clio.com <clio.h> <clset.h> + gexfls.x + rdukey.x <ctype.h> <fset.h> <ttset.h> + zfiocl.x clio.com <clio.h> <config.h> <ctype.h> <fio.h>\ + <fset.h> <knet.h> <mach.h> + ; diff --git a/sys/clio/rdukey.x b/sys/clio/rdukey.x new file mode 100644 index 00000000..5dc44801 --- /dev/null +++ b/sys/clio/rdukey.x @@ -0,0 +1,209 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <syserr.h> +include <ctype.h> +include <ttset.h> +include <fset.h> + +# RD_UKEY -- Read a user keystroke from the terminal. The "ukey" object is +# either a single key, or the : key plus associated string value. +# The value of a ukey parameter is returned as a string (as for rcursor) +# and is normally fetched by an applications program with CLGKEY. The +# format of the command string is +# +# ch strval +# +# where the `strval' is present only if CH=:, i.e., the command is a colon +# escape. Control keys are encoded as octal codes of the form \NNN. + +int procedure rdukey (keystr, maxch) + +char keystr[ARB] # receives keystroke command string +int maxch # max chars out + +int junk, ch +int delay, key, tty +pointer sp, buf, ip, op +bool rawmode_set, ucasein_set +bool playback_set, pbverify_set + +pointer ttyodes() +int fstati(), ttstati(), envgets(), getci() +define again_ 91 +define done_ 92 +errchk ttyodes, syserrs + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + call flush (STDERR) + call flush (STDOUT) + + # Note whether playback mode is in effect, and set raw mode if it + # is not already set. + + rawmode_set = (fstati (STDIN, F_RAW) == YES) + playback_set = (ttstati (STDIN, TT_PLAYBACK) == YES) + pbverify_set = (ttstati (STDIN, TT_PBVERIFY) == YES) + ucasein_set = (ttstati (STDIN, TT_UCASEIN) == YES) + + if (!rawmode_set) + call fseti (STDIN, F_RAW, YES) + if (playback_set) { + delay = ttstati (STDIN, TT_PBDELAY) + call ttseti (STDIN, TT_PBDELAY, 0) + } + + # Get keystroke. + tty = NULL +again_ + if (getci (STDIN, key) == EOF) + goto done_ + + if (tty == NULL && (key == ':' || playback_set)) { + junk = envgets ("terminal", Memc[buf], SZ_LINE) + tty = ttyodes (Memc[buf]) + if (tty == ERR) { + if (!rawmode_set) + call fseti (STDIN, F_RAW, NO) + call syserrs (SYS_TTYDEVNF, Memc[buf]) + } + } + + # If colon escape, clear the current line and read the string value. + # The read is performed in raw mode to avoid a line feed and scroll + # when the CR is typed. + + if (key == ':') { + call ttyclearln (STDOUT, tty) + call ttyputline (STDOUT, tty, "\r:", NO) + call flush (STDOUT) + + for (op=buf; getci (STDIN, ch) != EOF; ) { + if (ch == '\177' || ch == '\010') { + if (op > buf) { + op = op - 1 + Memc[op] = EOS + call ttyclearln (STDOUT, tty) + call ttyputline (STDOUT, tty, "\r:", NO) + call ttyputline (STDOUT, tty, Memc[buf], NO) + call flush (STDOUT) + } + } else if (ch == '\003') { + call ttyclearln (STDOUT, tty) + goto again_ + } else if (ch == '\n' || ch == '\r' || (op - buf) >= SZ_LINE) { + break + } else { + call putci (STDOUT, ch) + call flush (STDOUT) + if (ucasein_set && IS_UPPER(ch)) + Memc[op] = TO_LOWER(ch) + else + Memc[op] = ch + op = op + 1 + } + } + + Memc[op] = '\n'; op=op+1 + Memc[op] = EOS + + call flush (STDOUT) + + } else { + Memc[buf] = EOS + if (ucasein_set && IS_UPPER(key)) + key = TO_LOWER(key) + } + +done_ + # When we get here the key character has been set and the string + # value, if any, is in buf. If in playback mode with verify + # enabled, wait for the user to type a key before continuing. + + if (playback_set) { + call ttseti (STDIN, TT_PASSTHRU, YES) + + if (key != ':') { + if (!pbverify_set) + call zwmsec (delay) + call ttyso (STDOUT, tty, YES) + if (key > ' ') + call printf (" [key=%c]") + else + call printf (" [key=\\%o]") + call pargi (key) + call ttyso (STDOUT, tty, NO) + call flush (STDOUT) + } + + if (pbverify_set) { + # Read directly from user terminal in passthru mode. + while (getci (STDIN, ch) != EOF) + if (ch == ' ') { + break + } else if (ch == 'q' || ch == '\003') { + call putline (STDOUT, "\r[playback mode terminated]") + call flush (STDOUT) + call zwmsec (500) + call ttseti (STDIN, TT_PLAYBACK, NO) + break + } else if (ch == 'g') { + call ttseti (STDIN, TT_PBVERIFY, NO) + break + } else { + call ttyclearln (STDOUT, tty) + call ttyso (STDOUT, tty, YES) + call putline (STDOUT, + "\r[space=continue,q=quit,g=noverify]") + call ttyso (STDOUT, tty, NO) + call flush (STDOUT) + } + } else + call zwmsec (delay) + + call ttseti (STDIN, TT_PASSTHRU, NO) + call ttseti (STDIN, TT_PBDELAY, delay) + } + + if (tty != NULL) { + call ttyclearln (STDOUT, tty) + call ttycdes (tty) + } + + if (!rawmode_set) + call fseti (STDIN, F_RAW, NO) + + if (key == EOF || key == '\032' || key == '\004') { + call strcpy ("EOF\n", keystr, maxch) + call sfree (sp) + return (EOF) + + } else { + op = 1 + if (key > ' ') { + keystr[op] = key; op=op+1 + } else if (maxch >= 4) { + keystr[op] = '\\'; op=op+1 + keystr[op] = '0'; op=op+1 + keystr[op] = key / 8 + '0'; op=op+1 + keystr[op] = mod(key,8) + '0'; op=op+1 + } + + if (Memc[buf] != EOS && maxch > 1) { + keystr[op] = ' '; op=op+1 + for (ip=buf; op < maxch && Memc[ip] != EOS; ip=ip+1) { + keystr[op] = Memc[ip] + op = op + 1 + } + } + + # The return string value must be newline delimited. + keystr[op] = '\n'; op=op+1 + keystr[op] = EOS + + call sfree (sp) + return (op - 1) + } +end diff --git a/sys/clio/zfiocl.x b/sys/clio/zfiocl.x new file mode 100644 index 00000000..dde60fc9 --- /dev/null +++ b/sys/clio/zfiocl.x @@ -0,0 +1,317 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <knet.h> +include <mach.h> +include <config.h> +include <fset.h> +include <fio.h> +include <ctype.h> +include <clio.h> + +define SZ_NUMSTR 8 + +.help zfiocl +.nf __________________________________________________________________________ +ZFIOCL -- FIO z-routines (machine independent) for pseudofile i/o. The STDIN, +STDOUT, STDERR, and STDGRAPH streams are implemented as "pseudofiles" when a +process is run as a connected subprocess communicating with the parent process +via the IPC facilities. In such a configuration the standard i/o streams +(opened by the system [clopen] at process startup) are as follows: + + fd name description + + 1 CLIN IPC input from the parent [low level] + 2 CLOUT IPC output to the parent [low level] + 3 STDIN standard input + 4 STDOUT standard output + 5 STDERR standard error output + 6 STDGRAPH standard graphics output + 7 STDIMAGE standard greyscal output + 8 STDPLOT stdgraph plotter output + 9 PSIOCTRL pseudofile i/o control + +The CLIN and CLOUT streams are the FIO equivalents of the IPC channels, i.e., +they are connected to physical host i/o channels. The standard i/o streams +are multiplexed over the IPC channels by a packet passing protocol to the +parent process, which redirects each stream to an FIO file (which may in turn +be a pseudofile or a regular file). + +During execution of the child the parent has its command input switched to +the CLOUT stream of the child, and the child commands the parent. Commands +are sent over the IPC channels as an SPP text stream, i.e., unpacked ASCII +lines delimited by the newline character. Pseudofile data is sent as a +binary block preceded by a command to the parent to read so many chars from +the channel and pass it on to the indicated actual file. Typical output to +CLOUT might be as follows: + + param1 = + param2 = + xmit(4,34) + [34 chars of data] + +This example consists of three independent commands to the parent. The first +two are parameter requests and each is followed by a read from CLIN to get +the parameter value (which is returned in ASCII and is limited to a single +line). Syncronization occurs on the read. The binary data block in the +third command (XMIT) may contain arbitrary binary data, i.e., pseudofile +i/o is not limited to text. In the example shown the 34 chars of data will +be copied to the file associated by the parent with the STDOUT stream of +the child. The association of pseudofile codes at the IPC level with FIO +file descriptor codes is simple: the pseudofile codes are the same as the +fd codes. + +Although it is not relevant to a discussion of the pseudofile drivers, perhaps +we should mention what happens to these streams when a process is run stand +alone, i.e., no IPC channels. When a process is run stand-alone (prtype == +PR_HOST) CLIN, CLOUT, and the pseudofiles are connected to standard i/o +channels of the process as follows: + + CLIN,STDIN -> process_stdin + CLOUT,STDOUT -> process_stdout + STDERR -> process_stderr + STDGRAPH,etc. -> null file + +The standard i/o streams are normally limited to text data in stand alone +mode, since the process channels are normally connected to a terminal. Any +standard i/o stream may be redirected on the IRAF Main command line to +either a text or binary file, regardless of the process type (connected, +detached, or host). + +This file contains the FIO device drivers for each pseudofile. The device +codes are SI, SO, SE, and SG. ZARDBF, ZAWRBF, ZAWTBF, and ZSTTBF entry +points are supplied for each device. +.endhelp _____________________________________________________________________ + + +# ZCLSPS -- Dummy close procedure for all pseudofile streams. + +procedure zclsps (chan, status) + +int chan +int status + +begin + status = ERR +end + + +# ZARDPS -- "Asynchronous" read primitive for a pseudofile. The read is +# initiated by sending the following command to the parent: +# +# xfer(ps,maxchars)\n +# +# where "ps" is the pseudofile code (3=STDIN, etc.) and "maxchars" is the +# maximum number of chars to be returned. The parent responds with the actual +# number of chars to be sent, followed by newline, followed by the block of +# data, i.e.: +# +# CLOUT CLIN +# xfer(3,512)\n +# 40\n +# [40 chars of data] +# +# The parent responds by writing to the child's CLIN. +# +# NOTE1 -- Since this is a device driver (effectively a kernel procedure despite +# the machine independence) only low level procedures may be used, else a +# recursive call may result. +# NOTE2 -- There are some subtleties inherent in all this which are not obvious +# at first glance. Since CLIN and STDIN both read from the same IPC, some care +# is required to ensure that one stream does not steal messages intended for +# the other. Fortunately this is not our concern here, but rather that of the +# high level code. + +procedure zardps (ps, buf, maxbytes, offset) + +int ps # pseudofile +char buf[ARB] # buffer to receive data +int maxbytes, maxchars # capacity of buffer +long offset # ignored at present + +char numstr[SZ_NUMSTR] +int nbytes, nchars, ndigits, ip, clin_chan, raw_mode +int ctoi(), cl_psio_request(), fstati() +include "clio.com" +define ioerr_ 91 + +begin + if (ps == STDOUT || ps == STDERR) + goto ioerr_ + clin_chan = fstati (CLIN, F_CHANNEL) + raw_mode = fstati (ps, F_RAW) + + # Send the XFER command to the parent. If raw mode is in effect on + # the pseudofile, request only a single char. + + if (raw_mode == YES) + maxchars = 1 + else + maxchars = maxbytes / SZB_CHAR + + if (cl_psio_request ("xfer", ps, maxchars) == ERR) + goto ioerr_ + + # Get the number of chars to be read. + call zardpr (clin_chan, numstr, SZ_NUMSTR * SZB_CHAR, offset) + call zawtpr (clin_chan, nbytes) + + if (nbytes < 0) + goto ioerr_ + else + ndigits = nbytes / SZB_CHAR + + # Decode count of chars in data block, a simple positive integer + # constant followed by a newline. The case of a single digit + # (nchars < 10) is optimized. + + if (ndigits == 0) + nchars = 0 + else if (ndigits == 1) + nchars = TO_INTEG (numstr[1]) + else { + numstr[ndigits+1] = EOS + ip = 1 + if (ctoi (numstr, ip, nchars) <= 0) + goto ioerr_ + } + + # Read the data. + nbytes = nchars * SZB_CHAR + if (nchars == 0) + ps_status[ps] = 0 # EOF + else { + call zardpr (clin_chan, buf, nbytes, offset) + call zawtpr (clin_chan, ps_status[ps]) + } + return +ioerr_ + ps_status[ps] = ERR + return +end + + +# ZAWRPS -- Write primitive for a pseudofile. The write is initiated by +# sending the following command to the CL: +# +# xmit(ps,nchars)\n +# +# where "ps" is the pseudofile number, and "nchars" is the number of chars +# of binary data to be read from CLOUT and copied to the file connected to +# pseudofile "ps" by the parent. + +procedure zawrps (ps, buf, nbytes, offset) + +int ps # pseudofile +char buf[ARB] # buffer to receive data +int nbytes # capacity of buffer +long offset # ignored at present + +int nchars, clout_chan +int cl_psio_request(), fstati() +include "clio.com" +define ioerr_ 91 + +begin + if (ps == STDIN) + goto ioerr_ + clout_chan = fstati (CLOUT, F_CHANNEL) + + # Send the XMIT command to the parent. + nchars = nbytes / SZB_CHAR + if (cl_psio_request ("xmit", ps, nchars) == ERR) + goto ioerr_ + + # Send the data block. + call zawrpr (clout_chan, buf, nbytes, offset) + call zawtpr (clout_chan, ps_status[ps]) + return +ioerr_ + ps_status[ps] = ERR + return +end + + +# ZAWTPS -- Wait for i/o to a pseudofile (required by the FIO interface, +# though pseudofile i/o is not really asynchronous). + +procedure zawtps (ps, status) + +int ps # pseudofile code +int status # nbytes transferred in last packed (output) +include "clio.com" + +begin + status = ps_status[ps] +end + + +# ZSTTPS -- Channel status of a pseudofile. With the exception of the optimal +# buffer size for STDERR we default to the IPC status parameters, since i/o +# is ultimately over IPC channels to the parent process. + +procedure zsttps (ps, what, lvalue) + +int ps # pseudofile +int what # status parameter requested +long lvalue # output value (long) + +int fstati() + +begin + if (ps == STDERR && what == FSTT_OPTBUFSIZE) + lvalue = SZ_LINE * SZB_CHAR + else + call zsttpr (fstati(CLIN,F_CHANNEL), what, lvalue) +end + + +# CL_PSIO_REQUEST -- Output "cmd(arg1,arg2)\n" to CLOUT. Called by CL_ZARDPS +# and CL_ZAWRPS to send the XMIT and XFER commands to the CL, when writing to +# or reading from a pseudofile. + +int procedure cl_psio_request (cmd, arg1, arg2) + +char cmd[ARB] # e.g. "xmit" or "xfer" +int arg1, arg2 # integer arguments + +int ip, status, clout_chan +pointer obuf, sp, op +long offset +int itoc(), fstati() +define output {Memc[op]=$1;op=op+1} + +begin + call smark (sp) + call salloc (obuf, SZ_PATHNAME, TY_CHAR) + + clout_chan = fstati (CLOUT, F_CHANNEL) + + op = obuf + for (ip=1; cmd[ip] != EOS; ip=ip+1) + output (cmd[ip]) + + # Encode argument list. Arguments are assumed to always be + # nonnegative. Optimized for simple single digit numbers. + + output ('(') + if (arg1 < 10) + output (TO_DIGIT (arg1)) + else + op = op + itoc (arg1, Memc[op], SZ_PATHNAME-(op-obuf)) + + output (',') + + if (arg2 < 10) + output (TO_DIGIT (arg2)) + else + op = op + itoc (arg2, Memc[op], SZ_PATHNAME-(op-obuf)) + + output (')') + output ('\n') + + call zawrpr (clout_chan, Memc[obuf], (op-obuf) * SZB_CHAR, offset) + call zawtpr (clout_chan, status) + + call sfree (sp) + return (status) +end |