Initial commit

1 files changed, 1004 insertions, 0 deletions

diff --git a/sys/fio/fntgfn.x b/sys/fio/fntgfn.x
new file mode 100644
index 00000000..3f2ba5de
--- /dev/null
+++ b/sys/fio/fntgfn.x
@@ -0,0 +1,1004 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<pattern.h>
+include	<syserr.h>
+include	<diropen.h>
+
+.help fntgfn
+.nf _________________________________________________________________________
+File Name Template Package
+
+This package contains routines to expand a file name template string into a
+list of file names, and to access the individual elements of the list.  The
+template is a list of file names, patterns, and/or list file names.  The
+concatenation operator may be used within input list elements to form new
+output filenames.  String substitution may also be used to form new filenames.
+
+Sample template string:
+
+	alpha, *.x, data* // .pix, [a-m]*, @list_file
+
+This template would be expanded as the file "alpha", followed in successive
+calls by all the files in the current directory whose names end in ".x",
+followed by all files whose names begin with "data" with the extension ".pix"
+appended, and so on.  The @ character signifies a list file (file containing
+regular file names).
+
+String substitution uses the first string given for the template, expands
+the template, and for each filename generated by the template, substitutes
+the second string to generate a new filename.  Some examples follow.
+
+	*.%x%y%			change extension to `y'
+	*%%_abc%.imh		append `_abc' to root
+	nite%1%2%.1024.imh	change `nite1' to `nite2'
+
+Main entry points:
+
+	fntopnb - expand template and open a buffered filename list
+	fntgfnb - get next filename from buffered list (sequential)
+	fntrfnb - get next filename from buffered list (random)
+	fntclsb - close buffered list
+	fntlenb - get number of filenames in a buffered list
+	fntrewb - rewind the list
+
+Low Level Entry Points:
+
+	 fntopn - open an unbuffered filename list
+	 fntgfn - get next filename from unbuffered list
+	 fntcls - close unbuffered list
+
+The B suffix routines are the highest level and most convenient to use.
+The remaining routines expand a template "on the fly" and do not permit
+sorting or determination of the length of the list.
+.endhelp ____________________________________________________________________
+
+# FNTB descriptor structure.
+define	LEN_FNTBHDR		5
+define	FNTB_MAGIC		5164
+define	B_MAGIC			Memi[$1]
+define	B_SBUFPTR		Memi[$1+1]	# string buffer pointer
+define	B_NSTR			Memi[$1+2]	# number of strings
+define	B_STRNUM		Memi[$1+3]	# used to read list
+define	B_STRINDX		Memi[$1+$2-1+4]	# index of string
+
+# FNTU descriptor structure.
+define	LEN_FNTUHDR		(10+1024+256)
+define	FNTU_MAGIC		5664
+define	U_MAGIC			Memi[$1]
+define	U_FILDES		Memi[$1+1]
+define	U_TEMPLATE		Memi[$1+2]	# pointer
+define	U_TEMPLATE_INDEX	Memi[$1+3]
+define	U_PATTERN		(P2C($1+10))
+define	U_LDIR			(P2C($1+1034))
+
+# Special characters and size limiting definitions.
+define	TOK_DELIM		','		# token delimiter
+define	LIST_FILE_CHAR		'@'		# @listfile
+define	CH_EDIT			'%'		# string substitution metachar
+define	SZ_PATTERN		1023
+define	SZ_LDIR			255
+define	SZ_PATSTR		1023
+define	MAX_EDIT		8
+define	MAX_PATTERNS		8
+
+# Tokens.
+define	EO_TEMPLATE		1
+define	LIST_FILE		2
+define	PATTERN_STRING		3
+define	FILE_NAME		4
+
+# Size limiting definitions (initial buffer sizes).
+define	SZ_DEFSTRBUF		2048		# default string buffer size
+define	LEN_INDEXVECTOR		256		# initial length of index vector
+
+
+# FNTOPNB -- General open buffered list routine, for any type of filename list.
+# Expand template into string buffer, sort if so indicated.
+
+int procedure fntopnb (template, sort)
+
+char	template[ARB]		# filename template
+int	sort			# sort expanded patterns
+
+int	nedit[MAX_PATTERNS], junk, nchars
+bool	is_template[MAX_PATTERNS], is_edit[MAX_PATTERNS], sortlist, is_url
+pointer	sp, pbuf, fname, rname, extn, ebuf, sbuf, list, ip, op, ep, pp
+pointer	patp[MAX_PATTERNS], flist[MAX_PATTERNS], editp[MAX_EDIT]
+int	nlists, npat, nstr, maxstr, nextch, sz_sbuf, ix, first_string, ch, i
+int	fntopn(), fntgfn(), fnt_getpat(), gstrcpy(), fnt_edit(), stridx()
+int	patmake(), patmatch(), strncmp()
+errchk	fntopn, fntgfn, syserr, malloc, realloc
+
+begin
+	call smark (sp)
+	call salloc (rname, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (extn,  SZ_FNAME, TY_CHAR)
+	call salloc (pbuf,  SZ_LINE, TY_CHAR)
+	call salloc (ebuf,  SZ_LINE, TY_CHAR)
+
+	# Allocate list descriptor.
+	call malloc (list, LEN_FNTBHDR + LEN_INDEXVECTOR, TY_INT)
+	call malloc (sbuf, SZ_DEFSTRBUF, TY_CHAR)
+
+	B_MAGIC(list) = FNTB_MAGIC
+	maxstr = LEN_INDEXVECTOR
+	sz_sbuf = SZ_DEFSTRBUF
+	nextch = 1				# offset into string buffer
+	nstr = 0
+
+	# Read the file names into the string buffer.  Dynamically adjust
+	# the size of the string buffer and/or index vector as necessary.
+	# There must always be at least SZ_FNAME chars left in the string
+	# buffer.  The outer loop is over comma delimited fields of the
+	# filename template.  The inner loop is over individual filenames.
+
+	ix = 1
+	while (fnt_getpat (template, ix, patp, npat, pbuf, SZ_LINE) > 0) {
+	    first_string = nstr + 1
+	    sortlist = (sort == YES)
+	    nlists = 0
+	    ep = ebuf
+
+	    # Each piece of the current comma delimited template may consist
+	    # of several sublists to be independently expanded and concatenated
+	    # to form each output filename.  The lists must either be degenerate
+	    # (a simple string) or actual lists to be expanded with FNTOPN.
+
+	    do i = 1, npat {
+		is_template[i] = false
+		is_edit[i] = false
+		nedit[i] = 0
+		op = patp[i]
+
+		# Examine sublist to see if it is a template or a string
+		# constant.  If template, open file list.  Template
+		# metacharacters may be escaped to be included in filenames.
+		# If the pattern contains edit substitution sequences it
+		# must be processed to remove the substitution strings.
+
+		is_url = false
+		for (ip=op;  Memc[ip] != EOS;  ip=ip+1) {
+		    ch = Memc[ip]
+
+		    if (ch == ':' && strncmp (Memc[ip+1], "//", 2) == 0) {
+			# URL string.
+			is_template[i] = false
+			is_edit[i] = false
+			is_url = true
+		    } else if (!is_url && stridx (Memc[ip], "@*?[%") > 0) {
+			if (ip > patp[i] && Memc[ip-1] == '\\') {
+			    Memc[op-1] = ch
+			    ip = ip + 1
+			    ch = Memc[ip]
+			} else if (ch == CH_EDIT) {
+			    is_edit[i] = true
+			} else {
+			    if (ch == '@' && op == ip)
+				sortlist = false
+			    if (!is_url)
+			        is_template[i] = true
+			}
+		    }
+
+		    Memc[op] = ch
+		    op = op + 1
+		}
+
+		Memc[op] = EOS
+
+		# Open filename template if pattern contained metacharacters.
+		# A string constant containing edit string substitution is a
+		# special case, eg. "file%%_2%.ext".
+
+		if (is_template[i] || is_edit[i]) {
+		    editp[i] = ep
+		    call fnt_mkpat (Memc[patp[i]], Memc[fname], SZ_FNAME,
+			ep, nedit[i])
+		    flist[i] = fntopn (Memc[fname])
+
+		    # In the case of a string constant edit we do not really
+		    # have a file template, but we open one anyhow just to
+		    # make use of the common code and the descriptor.
+
+		    if (!is_template[i]) {
+			# Encode the pattern (containing the %%).
+			junk = patmake (Memc[fname], Memc[U_PATTERN(flist[i])],
+			    SZ_PATTERN)
+
+			# Strip the %% from the pattern, leaving the "input"
+			# filename in patp[i].
+
+			op = patp[i]
+			for (ip=fname;  Memc[ip] != EOS;  ip=ip+1)
+			    if (Memc[ip] != CH_EDIT) {
+				Memc[op] = Memc[ip]
+				op = op + 1
+			    }
+			Memc[op] = EOS
+
+			# Now match the stripped pattern against the %%
+			# pattern.  This sets up U_PATTERN for the edit.
+
+			junk = patmatch (Memc[patp[i]],
+			    Memc[U_PATTERN(flist[i])])
+		    } else
+			nlists = nlists + 1
+		}
+	    }
+
+	    # Expand the template into a sequence of filenames in the string
+	    # buffer, saving the indices of the list elements in the STRINDX
+	    # array.  Reallocate a larger buffer if necessary.  If the sublists
+	    # are not all the same length the shortest list will terminate the
+	    # output list.
+
+	    repeat {
+		# Concatenate the next element from each sublist; the sublists
+		# may be either real lists or string constants.  Concatenate
+		# only to the root filename.
+
+		Memc[extn] = EOS
+		op = fname
+
+		do i = 1, npat {
+		    # Save first extension field encountered and set op to
+		    # end of root.
+
+		    if (Memc[extn] == EOS)
+			for (ip=op-1;  ip > fname;  ip=ip-1)
+			    if (Memc[ip] == '.') {
+				call strcpy (Memc[ip], Memc[extn], SZ_FNAME)
+				op = ip
+				break
+			    }
+
+		    # Concatenate the next file element.  This can be either a
+		    # file name from a file template, a constant file name from
+		    # a string edit expression, or a simple string constant.
+
+		    if (!is_url && (is_template[i] || is_edit[i])) {
+			ip = rname
+			pp = flist[i]
+			if (is_template[i]) {
+			    if (fntgfn (pp, Memc[rname], SZ_FNAME) == EOF) {
+				op = fname
+				break
+
+			    } else if (U_FILDES(pp) != NULL) {
+				# Reading from a directory or list; set offset
+				# of substring to be edited to exclude any
+				# ldir prefix, since this will not have been
+				# used for the pattern match.
+
+				nchars = gstrcpy (Memc[U_LDIR(pp)],Memc[op],ARB)
+				op = op + nchars
+				ip = ip + nchars
+			    }
+			} else
+			    call strcpy (Memc[patp[i]], Memc[rname], SZ_FNAME)
+
+			op = op + fnt_edit (Memc[ip], Memc[op], editp[i],
+			    nedit[i], Memc[U_PATTERN(pp)])
+
+		    } else {
+			op = op + gstrcpy (Memc[patp[i]], Memc[op], ARB)
+		    }
+		}
+
+		# End of list if nothing returned.
+		if (op == fname)
+		    break
+
+		# Tack extension back on.
+		if (Memc[extn] != EOS)
+		    op = op + gstrcpy (Memc[extn], Memc[op], ARB)
+
+		# Need more room for list element pointers?
+		nstr = nstr + 1
+		if (nstr > maxstr) {
+		    maxstr = maxstr + LEN_INDEXVECTOR
+		    call realloc (list, LEN_FNTBHDR + maxstr, TY_INT)
+		}
+
+		# Out of space in string buffer?
+		if (nextch + (op - fname) >= sz_sbuf) {
+		    sz_sbuf = sz_sbuf + SZ_DEFSTRBUF
+		    call realloc (sbuf, sz_sbuf, TY_CHAR)
+		}
+
+		# Save index of list element, move chars to string buffer.
+		# Allow space for the EOS after each string.
+
+		B_STRINDX(list,nstr) = nextch
+		nextch = nextch +
+		    gstrcpy (Memc[fname], Memc[sbuf+nextch-1], ARB) + 1
+
+	    } until (nlists == 0)
+
+	    do i = 1, npat
+		if (is_template[i] || is_edit[i])
+		    call fntcls (flist[i])
+
+	    # If sorting is desired and the pattern did not specify an explicit
+	    # list (e.g., "@listfile"), sort the last batch of filenames.
+
+	    if (sortlist && nstr > first_string)
+		call strsrt (B_STRINDX(list,first_string), Memc[sbuf],
+		    nstr - first_string + 1)
+	}
+
+	# Update the string buffer descriptor, return unused buffer space.
+	# Rewind the list in preparation for reading (set strnum=1).
+
+	call realloc (sbuf, nextch, TY_CHAR)
+	call realloc (list, LEN_FNTBHDR + nstr, TY_INT)
+
+	B_NSTR(list)	= nstr
+	B_STRNUM(list)	= 1
+	B_SBUFPTR(list)	= sbuf
+
+	call sfree (sp)
+	return (list)
+end
+
+
+# FNT_MKPAT -- Take a pattern string possibly containing %a%b% string
+# substitution sequences, returning a pattern string as required for PATMAKE,
+# and a sequence of substitution strings for later use by FNT_EDIT to edit
+# filenames matched by FNTGFN.
+
+procedure fnt_mkpat (pat, patstr, maxch, ep, nedit)
+
+char	pat[ARB]		# pattern with embedded substitution sequences
+char	patstr[maxch]		# receives pattern as req'd by PATMAKE
+int	maxch
+pointer	ep			# where to put substitution string chars
+int	nedit			# number of substitution chars
+
+int	nhat
+int	ip, op
+
+begin
+	nedit = 0
+	nhat  = 0
+	op    = 1
+
+	for (ip=1;  pat[ip] != EOS;  ip=ip+1) {
+	    if (pat[ip] == CH_EDIT) {
+		if (ip > 1 && pat[ip-1] == '\\') {
+		    # Moved escaped metacharacter to pattern string.
+		    patstr[op] = pat[ip]
+		    op = op + 1
+
+		} else if (nhat > 0) {
+		    # Copy substitution string to ebuf.
+		    patstr[op] = pat[ip]
+		    op = op + 1
+		    nedit = nedit + 1
+
+		    ip = ip + 1
+		    while (pat[ip] != EOS && pat[ip] != CH_EDIT) {
+			Memc[ep] = pat[ip]
+			ep = ep + 1
+			ip = ip + 1
+		    }
+
+		    Memc[ep] = EOS
+		    ep = ep + 1
+		    if (pat[ip] == EOS)
+			ip = ip - 1
+		    nhat = 0
+
+		} else {
+		    patstr[op] = pat[ip]
+		    op = op + 1
+		    nhat = nhat + 1
+		}
+
+	    } else {
+		patstr[op] = pat[ip]
+		op = op + 1
+		if (op > maxch)
+		    break
+	    }
+	}
+
+	patstr[op] = EOS
+end
+
+
+# FNT_EDIT -- Perform string substitution on a matched filename, using the
+# list of substitution strings written by FNT_MKPAT, the first of which is
+# pointed to by EDITP.  The regions to be replaced were marked symbolically
+# by the CH_EDIT characters in the user supplied pattern.  The actual indices
+# of these regions depend upon the actual filename and are saved by the
+# pattern matching code in the encoded pattern buffer PATBUF, for retrieval
+# by PATINDEX.  Carry out the substitution and return the length of the
+# output string as the function argument.
+
+int procedure fnt_edit (in, out, editp, nedit, patbuf)
+
+char	in[ARB]			# input string to be edited
+char	out[ARB]		# receives edited string
+pointer	editp			# pointer to first substitution string
+int	nedit			# number of edits required
+char	patbuf[ARB]		# encoded pattern
+
+pointer	ep
+int	ip1, ip2, ip, op, i
+int	patindex()
+
+begin
+	ep = editp - 1
+	ip = 1
+	op = 1
+
+	do i = 1, nedit {
+	    # Get indices of first and last+1 characters to be substituted for
+	    # in the input string.
+
+	    ip1 = patindex (patbuf, (i-1) * 2 + 1)
+	    ip2 = patindex (patbuf, (i-1) * 2 + 2)
+	    if (ip1 == 0 || ip2 == 0 || ip1 > ip2)
+		break		# cannot happen
+
+	    # Copy up to first char to be replaced.
+	    for (;  ip < ip1;  ip=ip+1) {
+		out[op] = in[ip]
+		op = op + 1
+	    }
+
+	    # Append substitution string.
+	    for (ep=ep+1;  Memc[ep] != EOS;  ep=ep+1) {
+		out[op] = Memc[ep]
+		op = op + 1
+	    }
+
+	    # Continue at character IP2 in the input string.
+	    ip = ip2
+	}
+
+	# Copy remainder of input string to the output string.
+	for (;  in[ip] != EOS;  ip=ip+1) {
+	    out[op] = in[ip]
+	    op = op + 1
+	}
+
+	out[op] = EOS
+	return (op - 1)
+end
+
+
+# FNTGFNB -- Return the next filename from the list.
+
+int procedure fntgfnb (list, fname, maxch)
+
+pointer	list			# list descriptor pointer
+char	fname[ARB]		# output filename
+int	maxch
+
+pointer	strptr
+int	file_number
+int	gstrcpy()
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	file_number = B_STRNUM(list)
+	if (file_number > B_NSTR(list))
+	    return (EOF)
+	else {
+	    B_STRNUM(list) = file_number + 1
+	    strptr = B_SBUFPTR(list) + B_STRINDX(list,file_number) - 1
+	    return (gstrcpy (Memc[strptr], fname, maxch))
+	}
+end
+
+
+# FNTRFNB -- Return the indexed filename from the list.  For applications
+# which need to access the list at random.  Returns len(fname) or EOF for
+# references to nonexistent list elements.
+
+int procedure fntrfnb (list, index, fname, maxch)
+
+pointer	list			# list descriptor pointer
+int	index			# index of list element to be returned
+char	fname[ARB]		# output filename
+int	maxch
+
+pointer	strptr
+int	gstrcpy()
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	if (index < 1 || index > B_NSTR(list))
+	    return (EOF)
+	else {
+	    strptr = B_SBUFPTR(list) + B_STRINDX(list,index) - 1
+	    return (gstrcpy (Memc[strptr], fname, maxch))
+	}
+end
+
+
+# FNTCLSB -- Close a buffered list and return all storage.
+
+procedure fntclsb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	call mfree (B_SBUFPTR(list), TY_CHAR)
+	call mfree (list, TY_INT)
+end
+
+
+# FNTREWB -- Rewind a buffered filename list.
+
+procedure fntrewb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	B_STRNUM(list) = 1
+end
+
+
+# FNTLENB -- Return the number of filenames in the list.
+
+int procedure fntlenb (list)
+
+pointer	list			# list descriptor pointer
+errchk	syserr
+
+begin
+	if (B_MAGIC(list) != FNTB_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	return (B_NSTR(list))
+end
+
+
+# FNT_GETPAT -- Return the next comma delimited field from the template string
+# with any leading or trailing whitespace stripped off.  The field may consist
+# of a simple string constant, a filename template, or a sequence of either
+# delimited by concatenation operators //.  We do not make any distinction here
+# between string constants and patterns; return the \ with all escape sequences
+# as this will be stripped by the higher level code if used to include pattern
+# matching metacharacters in filenames.
+
+int procedure fnt_getpat (template, ix, patp, npat, sbuf, maxch)
+
+char	template[ARB]		# template from which to extract field
+int	ix			# next char in template
+pointer	patp[MAX_PATTERNS]	# receives pointers to sublists (patterns)
+int	npat			# receives number of PATP elements set
+pointer	sbuf			# used to store output strings
+int	maxch			# maxch chars out
+
+int	ch, peek
+bool	is_url
+pointer	op
+
+int	strncmp(), stridx()
+errchk	syserr
+
+begin
+	while (IS_WHITE(template[ix]) || template[ix] == ',')
+	    ix = ix + 1
+
+	patp[1] = sbuf
+	npat = 1
+	op = sbuf
+	is_url = false
+
+	#for (ch=template[ix];  ch != EOS && ch != ',';  ch=template[ix]) {
+	for (ch=template[ix];  ch != EOS;  ch=template[ix]) {
+	    peek = template[ix+1]
+	    if (IS_WHITE (ch)) {
+		# Ignore all whitespace.
+		ix = ix + 1
+		next
+
+	    } else if ((is_url && ch == ',')) {
+		if (stridx (peek, "+-.0123456789") == 0) {
+		    break
+		} else {
+		    # Keep a comma in a URL followed by a digit
+		    Memc[op] = ','
+		    op = op + 1
+		    ix = ix + 1
+		}
+
+	    } else if (!is_url && ch == ',') {
+		break
+
+	    } else if (ch == '\\' && template[ix+1] == ',') {
+		# Escape a comma.
+		Memc[op] = ','
+		op = op + 1
+		ix = ix + 2
+
+	    } else if (!is_url && (ch == '/' && template[ix+1] == '/')) {
+		# Concatenation operator: start a new sublist.
+		Memc[op] = EOS
+		op = op + 1
+		ix = ix + 2
+		npat = npat + 1
+		if (npat > MAX_PATTERNS)
+		    call syserr (SYS_FNTMAXPAT)
+		patp[npat] = op
+
+	    } else if (ch == ':' && strncmp ("//", template[ix+1], 2) == 0) {
+		# Start of URL string, deposit in output list.
+		Memc[op] = ch
+		op = op + 1
+		ix = ix + 1
+		is_url = true
+
+	    } else {
+		# Ordinary character, deposit in output list.
+		Memc[op] = ch
+		op = op + 1
+		ix = ix + 1
+	    }
+
+	    if (op - sbuf > maxch)
+		break
+	}
+
+	Memc[op] = EOS
+	return (op - sbuf)
+end
+
+
+# FNTGFN -- Get the next file name from the named parameter (template).
+# This is the guy that does all the work.  A file name may be selected from
+# a directory file or list file by pattern matching, or may come from the
+# template list string itself.
+
+int procedure fntgfn (pp, outstr, maxch)
+
+pointer	pp			# pattern pointer
+char	outstr[ARB]		# output filename
+int	maxch
+
+bool	match
+pointer	ip, sp, linebuf, fname, patstr
+int	nchars, token, first_ch, last_ch, status
+
+bool	streq()
+int	getline(), gpatmatch(), patmake(), nowhite(), gstrcat()
+int	fnt_read_template(), fnt_open_list()
+errchk	salloc, getline, close, fnt_open_list, syserr
+
+begin
+	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	call smark (sp)					# get buffers
+	call salloc (linebuf, SZ_LINE, TY_CHAR)
+	call salloc (patstr, SZ_PATSTR, TY_CHAR)
+	call salloc (fname, SZ_PATHNAME, TY_CHAR)
+
+	repeat {
+	    # Read file names from either list file or directory file, until
+	    # one is found which matches pattern, or until EOF is reached.
+	    # Make sure pattern matches the ENTIRE file name string, rather
+	    # than a substring.
+
+	    if (U_FILDES(pp) != NULL) {			# reading from a file?
+		while (getline (U_FILDES(pp), Memc[linebuf]) != EOF) {
+		    for (ip=linebuf;  IS_WHITE (Memc[ip]);  ip=ip+1)
+			;
+		    nchars = nowhite (Memc[ip], Memc[fname], maxch)
+		    if (nchars == 0)			# skip blank lines
+			next
+
+		    # If the encoded pattern is the null string match anything.
+		    if (Memc[U_PATTERN(pp)] == EOS) {
+			match = true
+		    } else if (gpatmatch (Memc[fname], Memc[U_PATTERN(pp)],
+			first_ch, last_ch) > 0) {
+			match = (first_ch == 1 && last_ch == nchars)
+		    } else
+			match = false
+
+		    if (match) {
+			call strcpy (Memc[U_LDIR(pp)], outstr, maxch)
+			nchars = gstrcat (Memc[fname], outstr, maxch)
+			call sfree (sp)
+			return (nchars)
+		    }
+		}
+
+		call close (U_FILDES(pp))
+		U_FILDES(pp) = NULL
+	    }
+
+	    switch (fnt_read_template (pp, Memc[linebuf], SZ_LINE, token)) {
+	    case EO_TEMPLATE:
+		nchars = EOF
+		outstr[1] = EOS
+		call sfree (sp)
+		return (nchars)
+
+	    case LIST_FILE, PATTERN_STRING:
+		# Break the pattern string into a list file or directory
+		# name and a pattern.
+
+		if (token == PATTERN_STRING) {
+		    Memc[patstr] = '^'
+		    ip = patstr + 1
+		} else
+		    ip = patstr
+
+		U_FILDES(pp) = fnt_open_list (Memc[linebuf], Memc[ip],
+		    SZ_PATSTR-1, Memc[fname], Memc[U_LDIR(pp)], token)
+
+		# Encode the pattern.  If the pattern is matchall set encoded
+		# pattern string to NULL and pattern matching will be skipped.
+
+		if (streq (Memc[patstr], "?*"))
+		    Memc[U_PATTERN(pp)] = EOS
+		else {
+		    status = patmake (Memc[patstr], Memc[U_PATTERN(pp)],
+			SZ_PATTERN)
+		    if (status == ERR)
+			call syserr (SYS_FNTBADPAT)
+		}
+		
+	    default:					# simple file name
+		nchars = nowhite (Memc[linebuf], outstr, maxch)
+		if (nchars > 0) {
+		    call sfree (sp)
+		    return (nchars)
+		}
+	    }
+	}
+end
+
+
+# FNT_READ_TEMPLATE -- Get next token from template string, return integer
+# code identifying the type of token.
+
+int procedure fnt_read_template (pp, outstr, maxch, token)
+
+pointer	pp				#I pointer to param descriptor
+char	outstr[maxch]			#O receives token
+int	maxch				#I max chars out
+int	token				#O token type code
+
+int	nseen, i
+pointer	ip, ip_start, op, cp
+int	stridx(), strncmp()
+
+begin
+	ip = U_TEMPLATE_INDEX(pp)			# retrieve pointer
+	while (IS_WHITE (Memc[ip]))
+	    ip = ip + 1
+
+
+	switch (Memc[ip]) {
+	case EOS:
+	    op = 1
+	    token = EO_TEMPLATE
+
+	case LIST_FILE_CHAR:				# list file spec
+	    ip = ip + 1					# skip the @
+	    for (op=1;  Memc[ip] != TOK_DELIM && Memc[ip] != EOS;  op=op+1) {
+		outstr[op] = Memc[ip]
+		ip = ip + 1
+	    }
+	    token = LIST_FILE
+	    if (Memc[ip] == TOK_DELIM)
+		ip = ip + 1
+
+	default:					# fname or pat string
+	    token = FILE_NAME
+	    # Extract token.  Determine if regular file name or pattern string.
+	    # Disable metacharacters not useful for file name patterns.
+
+	    ip_start = ip
+	    for (op=1;  Memc[ip] != EOS;  ip=ip+1) {
+		if (Memc[ip] == CH_ESCAPE && Memc[ip+1] != EOS) {
+		    # Escape sequence.  Pass both the escape and the escaped
+		    # character on to the lower level code.
+
+		    outstr[op] = CH_ESCAPE
+		    op = op + 1
+		    ip = ip + 1
+
+		} else if (Memc[ip] == TOK_DELIM) {
+		    ip = ip + 1
+		    break
+
+		} else if (Memc[ip] == FNLDIR_CHAR || Memc[ip] == '/') {
+		    token = FILE_NAME
+
+		} else if (Memc[ip] == '*') {
+		    # Map "*" into "?*".
+		    token = PATTERN_STRING
+		    outstr[op] = '?'
+		    op = op + 1
+
+		} else if (Memc[ip] == '%') {
+		    # The % metacharacter must appear twice (not three times,
+		    # as the high level code strips the subsitution field) to
+		    # be recognized as the pattern substitution metacharacter.
+
+		    nseen = 0
+		    do i = 1, ARB {
+			cp = ip_start + i - 1
+			if (Memc[cp] == EOS || Memc[cp] == TOK_DELIM)
+			    break
+			else if (Memc[cp] == '%' && Memc[cp-1] != '\\')
+			    nseen = nseen + 1
+		    }
+		    if (nseen < 2) {
+			outstr[op] = CH_ESCAPE
+			op = op + 1
+		    }
+		} else if (stridx (Memc[ip], "[?{") > 0)
+		    token = PATTERN_STRING
+
+		outstr[op] = Memc[ip]
+		op = op + 1
+	    }
+	}
+	    
+	# Remove any trailing whitespace.
+	op = op - 1
+	while (op > 0 && IS_WHITE (outstr[op]))
+	    op = op - 1
+	outstr[op+1] = EOS
+
+	if (op > 0)
+	    if (outstr[op] == FNLDIR_CHAR || outstr[op] == '/')
+		token = PATTERN_STRING
+
+	U_TEMPLATE_INDEX(pp) = ip			# update pointer
+
+	return (token)
+end
+
+
+# FNT_OPEN_LIST -- Open list file or directory.  If reading from a directory,
+# open the current directory if a directory name is not given.  Extract
+# pattern string (if any), and return in PATSTR.  If no pattern string is
+# given, return a pattern which will match all files in the list.
+
+int procedure fnt_open_list (str, patstr, maxch, fname, ldir, ftype)
+
+int	maxch, ftype
+char	ldir[SZ_LDIR]
+char	str[ARB], patstr[maxch], fname[SZ_FNAME]
+int	fd, ip, op, fnt_delim, pat_start, dirmode
+int	open(), diropen()
+errchk	open, diropen, fpathname
+
+begin
+	op = 1
+	fnt_delim = NULL
+	pat_start = NULL
+
+	# Search for a valid directory prefix.
+	for (ip=1;  str[ip] != EOS;  ip=ip+1) {
+	    fname[op] = str[ip]
+	    if (ftype != LIST_FILE)
+		if (fname[op] == FNLDIR_CHAR || fname[op] == '//')
+		    if (op == 1 || fname[op-1] != '\\') {
+			fnt_delim = op
+			pat_start = ip + 1
+		    }
+	    op = op + 1
+	}
+	fname[op] = EOS
+
+	if (ftype == LIST_FILE) {
+	    if (fnt_delim != NULL)
+		fname[fnt_delim] = EOS
+	    fd = open (fname, READ_ONLY, TEXT_FILE)
+	    ldir[1] = EOS
+
+	} else {
+	    if (fnt_delim != NULL)		# specific directory
+		fname[fnt_delim+1] = EOS
+	    else				# current directory
+		fname[1] = EOS
+	    call fpathname (fname, ldir, SZ_LDIR)
+
+	    dirmode = SKIP_HIDDEN_FILES
+	    if (pat_start != NULL) {
+		if (str[pat_start] == '.')
+		    dirmode = PASS_HIDDEN_FILES
+	    } else if (ftype != LIST_FILE && str[1] == '.')
+		dirmode = PASS_HIDDEN_FILES
+
+	    fd = diropen (ldir, dirmode)
+	    call strcpy (fname, ldir, SZ_LDIR)
+	}
+
+	# If pattern string is appended to list file name, extract
+	# it, otherwise set the default pattern "match all" (*).
+
+	op = 1
+	if (pat_start != NULL)
+	    ip = pat_start
+	else if (ftype != LIST_FILE)
+	    ip = 1
+
+	for (;  str[ip] != EOS;  ip=ip+1) {
+	    patstr[op] = str[ip]
+	    op = op + 1
+	}
+
+	# No pattern string given, default to "?*".
+	if (op == 1) {
+	    patstr[1] = CH_ANY
+	    patstr[2] = CH_CLOSURE
+	    op = 3
+	}
+	patstr[op] = EOS
+
+	return (fd)
+end
+
+
+# FNTOPN -- Open and initialize the template descriptor.
+
+pointer procedure fntopn (template)
+
+char	template[ARB]
+
+pointer	pp
+int	nchars
+int	strlen()
+errchk	calloc, malloc
+
+begin
+	nchars = strlen (template)
+
+	call calloc (pp, LEN_FNTUHDR, TY_STRUCT)
+	call malloc (U_TEMPLATE(pp), nchars, TY_CHAR)
+
+	call strcpy (template, Memc[U_TEMPLATE(pp)], nchars)
+	U_TEMPLATE_INDEX(pp) = U_TEMPLATE(pp)
+	U_MAGIC(pp) = FNTU_MAGIC
+
+	return (pp)
+end
+
+
+# FNTCLS -- Close the template descriptor, return space.
+
+procedure fntcls (pp)
+
+pointer	pp
+errchk	syserr
+
+begin
+	if (pp == NULL || U_MAGIC(pp) != FNTU_MAGIC)
+	    call syserr (SYS_FNTMAGIC)
+
+	if (U_FILDES(pp) != NULL)
+	    call close (U_FILDES(pp))
+
+	call mfree (U_TEMPLATE(pp), TY_CHAR)
+	call mfree (pp, TY_STRUCT)
+end