Initial commit

1 files changed, 232 insertions, 0 deletions

diff --git a/pkg/xtools/syshost.x b/pkg/xtools/syshost.x
new file mode 100644
index 00000000..8136e3ae
--- /dev/null
+++ b/pkg/xtools/syshost.x
@@ -0,0 +1,232 @@
+include	<clset.h>
+include	<ctotok.h>
+
+
+# SYSHOST -- If a task which calls this routine is executed from the host
+# command line (i.e. not through a CL) set any parameters not set on the
+# command line (e.g. with keyword=value or @file arguments).  The application
+# provides three files to search in order.  The first two are keyword=value
+# files and the last is a parameter file.  The parameter file may be encoded
+# as a compiled procedure (see txtcompile).  For this reason xt_txtopen is
+# used which transparently handles disk text files and text encoding
+# procedures.
+#
+# The process type is the return value.
+# The show_pset argument is the name of a boolean parameter to query
+# for showing the default parameter set.  The value of this is returned
+# for show_val.  If the parameter is not used (a null string) or was
+# not specified by the user the return value is false.
+
+int procedure syshost (keyfile1, keyfile2, parfile, show_pset, show_val)
+
+char	keyfile1[ARB]			#I Keyword file
+char	keyfile2[ARB]			#I Keyword file
+char	parfile[ARB]			#I Parameter file
+char	show_pset[ARB]			#I Parameter for requestiong show
+bool	show_val			#O Result of show request
+int	stat				#R Return value
+
+char	line[SZ_LINE], param[SZ_FNAME], value[SZ_LINE]
+int	i, ip, fd, tok
+
+bool	clgetb(), streq()
+int	clstati(), access(), fscan(), ctotok(), strncmp(), xt_txtopen()
+pointer	clc_find()
+errchk	xt_getpars, xt_txtopen
+
+begin
+	# Check if the task is called from the host.
+	stat = clstati (CL_PRTYPE)
+	if (stat != PR_HOST)
+	    return (stat)
+
+	# Read user keyword=value files.
+	if (keyfile1[1] != EOS && access(keyfile1,0,0) == YES)
+	    call xt_getpars (keyfile1)
+	if (keyfile2[1] != EOS && access(keyfile2,0,0) == YES)
+	    call xt_getpars (keyfile2)
+
+	# Read parameter file.
+	if (parfile[1] != EOS &&
+	    (access(parfile,0,0)==YES || strncmp (parfile, "proc:", 5)==0)) {
+
+	    # Open parameter file.
+	    fd = NULL
+	    fd = xt_txtopen (parfile)
+
+	    # Check for request to show default parameters.
+	    if (show_pset[1] != EOS && clc_find(show_pset,param,SZ_FNAME)>0)
+	        show_val = clgetb (show_pset)
+	    else
+	        show_val = false
+	    
+	    # Scan parameter file lines and parse them.
+	    while (fscan (fd) != EOF) {
+		call gargstr (line, SZ_LINE)
+
+		ip = 1
+		if (ctotok (line, ip, param, SZ_FNAME) != TOK_IDENTIFIER)
+		    next
+		if (streq (param, "mode"))
+		    next
+		for (i=0; i<3 && ctotok(line,ip,value,SZ_LINE)!=TOK_EOS;) {
+		    if (value[1] == ',')
+			i = i + 1
+		}
+		tok = ctotok (line, ip, value, SZ_LINE)
+		switch (tok) {
+		case TOK_NUMBER, TOK_STRING, TOK_IDENTIFIER:
+		    ;
+		default:
+		    value[1] = EOS
+		}
+
+		# Enter in clcache if not already defined.
+		if (clc_find (param, line, SZ_LINE) == NULL)
+		    call clc_enter (param, value)
+
+		# Show parameter if desired.
+		if (show_val) {
+		    switch (tok) {
+		    case TOK_STRING:
+			call printf ("%s = ""%s""\n")
+			    call pargstr (param)
+			    call pargstr (value)
+		    default:
+			call printf ("%s = %s\n")
+			    call pargstr (param)
+			    call pargstr (value)
+		    }
+		}
+	    }
+
+	    # Close parameter file.
+	    call xt_txtclose (fd)
+	}
+
+	return (stat)
+end
+
+
+# The following are copies of sys_getpars and sys_paramset with the
+# following changes.
+#   - Return an error rather than a warning for a bad syntax
+#   - Enter parameter in CL cache only if not previously set
+
+
+include	<ctype.h>
+
+define	SZ_VALSTR	1024
+define	SZ_CMDBUF	(SZ_COMMAND+1024)
+
+# XT_GETPARS -- Read a sequence of param=value parameter assignments from
+# the named file and enter them into the CLIO cache for the task.
+
+procedure xt_getpars (fname)
+
+char	fname			# pset file
+
+bool	skip
+int	lineno, fd
+pointer	sp, lbuf, err, ip
+int	open(), getlline()
+errchk	open, getlline
+
+begin
+	call smark (sp)
+	call salloc (lbuf, SZ_CMDBUF, TY_CHAR)
+
+	fd = open (fname, READ_ONLY, TEXT_FILE)
+
+	# Skip whitespace for param = value args in a par file.
+	skip = true
+
+	lineno = 0
+	while (getlline (fd, Memc[lbuf], SZ_CMDBUF) != EOF) {
+	    lineno = lineno + 1
+	    for (ip=lbuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+		;
+	    if (Memc[ip] == '#' || Memc[ip] == '\n')
+		next
+	    iferr (call xt_paramset (Memc, ip, skip)) {
+		for (;  Memc[ip] != EOS && Memc[ip] != '\n';  ip=ip+1)
+		    ;
+		Memc[ip] = EOS
+		call salloc (err, SZ_LINE, TY_CHAR)
+		call sprintf (Memc[err], SZ_LINE,
+		    "Bad param assignment, line %d: `%s'\n")
+		    call pargi (lineno)
+		    call pargstr (Memc[lbuf])
+		call close (fd)
+		call error (1, Memc[err])
+	    }
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# XT_PARAMSET -- Extract the param and value substrings from a param=value
+# or switch argument and enter them into the CL parameter cache.  (see also
+# clio.clcache).
+
+procedure xt_paramset (args, ip, skip)
+
+char	args[ARB]		# argument list
+int	ip			# pointer to first char of argument
+bool	skip			# skip whitespace within "param=value" args
+
+pointer	sp, param, value, op, clc_find()
+int	stridx()
+
+begin
+	call smark (sp)
+	call salloc (param, SZ_FNAME, TY_CHAR)
+	call salloc (value, SZ_VALSTR, TY_CHAR)
+
+	# Extract the param field.
+	op = param
+	while (IS_ALNUM (args[ip]) || stridx (args[ip], "_.$") > 0) {
+	    Memc[op] = args[ip]
+	    op = op + 1
+	    ip = ip + 1
+	}
+	Memc[op] = EOS
+
+	# Advance to the switch character or assignment operator.
+	while (IS_WHITE (args[ip]))
+	    ip = ip + 1
+
+	switch (args[ip]) {
+	case '+':
+	    # Boolean switch "yes".
+	    ip = ip + 1
+	    call strcpy ("yes", Memc[value], SZ_VALSTR)
+	
+	case '-':
+	    # Boolean switch "no".
+	    ip = ip + 1
+	    call strcpy ("no", Memc[value], SZ_VALSTR)
+
+	case '=':
+	    # Extract the value field.  This is either a quoted string or a
+	    # string delimited by any of the metacharacters listed below.
+
+	    ip = ip + 1
+	    if (skip) {
+		while (IS_WHITE (args[ip]))
+		    ip = ip + 1
+	    }
+	    call sys_gstrarg (args, ip, Memc[value], SZ_VALSTR)
+
+	default:
+	    call error (1, "IRAF Main: command syntax error")
+	}
+
+	# Enter the param=value pair into the CL parameter cache.
+	if (clc_find (Memc[param], Memc[param], SZ_FNAME) == NULL)
+	    call clc_enter (Memc[param], Memc[value])
+
+	call sfree (sp)
+end