Initial commit

12 files changed, 738 insertions, 0 deletions

diff --git a/sys/gty/README b/sys/gty/README
new file mode 100644
index 00000000..6687b5ce
--- /dev/null
+++ b/sys/gty/README
@@ -0,0 +1,8 @@
+# GTY -- This directory contains the generalized termcap style database
+# reader.  Adapted from iraf$sys/tty/.
+
+		  gty = gtyopen (termcap_file, device, ufields)
+		       gtyclose (gty)
+		   cp = gtycaps (gty)
+	     pval = gtyget[bir] (gty, cap)
+	       nchars = gtygets (gty, cap, outstr, maxch)
diff --git a/sys/gty/gty.h b/sys/gty/gty.h
new file mode 100644
index 00000000..72516859
--- /dev/null
+++ b/sys/gty/gty.h
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTY package definitions.
+
+define	MAX_TC_NESTING	8		# max nesting of tc=term references
+
+# Mapping function used to map capcodes ("cm", etc.) into unique integers.
+define	ENCODE		($1[1]*128+$1[2])
+
+# TTY descriptor structure.  Full termcap entry is the 'caplist' string.
+# The caplist is indexed at open time to permit a binary search for
+# capabilities at run time.
+
+define	T_MEMINCR	512		# increment if overflow occurs
+define	T_OFFCAP	415		# struct offset to caplist field
+define	MAX_CAPS	200		# maximum capabilities
+define	LEN_DEFTTY	1024		# initial length of tty structure
+
+define	T_LEN		Memi[$1]	# length of tty structure
+define	T_OP		Memi[$1+1]	# offset into caplist
+define	T_NCAPS		Memi[$1+11]	# number of capabilities
+define	T_CAPLEN	Memi[$1+12]	# length of caplist, chars
+			# (extra space)
+define	T_CAPCODE	Memi[$1+15]	# cap code array: c1*128+c2
+define	T_CAPINDEX	Memi[$1+215]	# cap index array
+define	T_CAPLIST	Memc[P2C($1+415)]	# termcap entry
diff --git a/sys/gty/gtycaps.x b/sys/gty/gtycaps.x
new file mode 100644
index 00000000..ad9b4828
--- /dev/null
+++ b/sys/gty/gtycaps.x
@@ -0,0 +1,13 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include "gty.h"
+
+# GTYCAPS -- Return a pointer to the caplist field of an open GTY descriptor.
+
+pointer procedure gtycaps (gty)
+
+pointer gty                     # tty descriptor
+
+begin
+        return (P2C (gty + T_OFFCAP))
+end
diff --git a/sys/gty/gtyclose.x b/sys/gty/gtyclose.x
new file mode 100644
index 00000000..c8ddd67d
--- /dev/null
+++ b/sys/gty/gtyclose.x
@@ -0,0 +1,11 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYCLOSE -- Close the tty terminal descriptor opened with TTYOPEN.
+
+procedure gtyclose (tty)
+
+pointer	tty
+
+begin
+	call mfree (tty, TY_STRUCT)
+end
diff --git a/sys/gty/gtygetb.x b/sys/gty/gtygetb.x
new file mode 100644
index 00000000..53d5f31e
--- /dev/null
+++ b/sys/gty/gtygetb.x
@@ -0,0 +1,15 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYGETB -- Determine whether or not a capability exists for a device.
+# If there is any entry at all, the capability exists.
+
+bool procedure gtygetb (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+pointer	ip
+int	gty_find_capability()
+
+begin
+	return (gty_find_capability (tty, cap, ip) == YES)
+end
diff --git a/sys/gty/gtygeti.x b/sys/gty/gtygeti.x
new file mode 100644
index 00000000..9b196a7e
--- /dev/null
+++ b/sys/gty/gtygeti.x
@@ -0,0 +1,27 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# GTYGETI -- Get an integer valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as an integer, zero is
+# returned.  Integer capabilities have the format ":xx#dd:".
+
+int procedure gtygeti (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+int	ival
+pointer	ip
+int	gty_find_capability(), ctoi()
+
+begin
+	if (gty_find_capability (tty, cap, ip) == NO)
+	    return (0)
+	else if (Memc[ip] != '#')
+	    return (0)
+	else {
+	    ip = ip + 1				# skip the '#'
+	    if (ctoi (Memc, ip, ival) == 0)
+		return (0)
+	    else
+		return (ival)
+	}
+end
diff --git a/sys/gty/gtygetr.x b/sys/gty/gtygetr.x
new file mode 100644
index 00000000..fb50f3e0
--- /dev/null
+++ b/sys/gty/gtygetr.x
@@ -0,0 +1,41 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<mach.h>
+
+# GTYGETR -- Get a real valued capability.  If the capability is not
+# found for the device, or cannot be interpreted as a number, zero is
+# returned.  Real valued capabilities have the format ":xx#num:".
+
+real procedure gtygetr (tty, cap)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+
+char	numstr[MAX_DIGITS]
+int	np, op
+pointer	ip
+double	dval
+int	gty_find_capability(), ctod()
+
+begin
+	if (gty_find_capability (tty, cap, ip) == NO)
+	    return (0.0)
+	else if (Memc[ip] != '#')
+	    return (0.0)
+	else {
+	    # Extract the number into numstr.  Cannot convert in place in
+	    # the table because the ":" delimiter will by interpreted by
+	    # ctod as for a sexagesimal number.
+	    op = 1
+	    for (ip=ip+1;  op <= MAX_DIGITS && Memc[ip] != ':';  ip=ip+1) {
+		numstr[op] = Memc[ip]
+		op = op + 1
+	    }
+	    numstr[op] = EOS
+	    np = 1
+	    if (ctod (numstr, np, dval) == 0)
+		return (0.0)
+	    else
+		return (dval)
+	}
+end
diff --git a/sys/gty/gtygets.x b/sys/gty/gtygets.x
new file mode 100644
index 00000000..1f66cf88
--- /dev/null
+++ b/sys/gty/gtygets.x
@@ -0,0 +1,70 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<chars.h>
+
+# GTYGETS -- Get the string value of a capability.  Process all termcap escapes.
+# These are:
+# 
+# 	\E		ascii esc (escape)
+# 	^X		control-X (i.e., ^C=03B, ^Z=032B, etc.)
+# 	\[nrtbf]	newline, return, tab, backspace, formfeed
+# 	\ddd		octal value of character
+# 	\^		the character ^
+# 	\\		the character \
+# 
+# The character ':' may not be placed directly in a capability string; it
+# should be given as \072 instead.  The null character is represented as \200;
+# all characters are masked to 7 bits upon output by TTYPUTS, hence \200
+# is sent to the terminal as NUL.
+
+int procedure gtygets (tty, cap, outstr, maxch)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character capability name
+char	outstr[ARB]		# receives cap string
+int	maxch			# size of outstr
+
+char	ch
+pointer	ip
+int	op, junk, temp
+int	gty_find_capability(), cctoc()
+
+begin
+	op = 1
+
+	if (gty_find_capability (tty, cap, ip) == YES) {
+	    # Skip the '=' which follows the two character capability name.
+	    if (Memc[ip] == '=')
+		ip = ip + 1
+
+	    # Extract the string, processing all escapes.
+	    for (ch=Memc[ip];  ch != ':';  ch=Memc[ip]) {
+		if (ch == '^') {
+		    ip = ip + 1
+		    temp = Memc[ip]
+		    ch = mod (temp, 40B)
+		} else if (ch == '\\') {
+		    switch (Memc[ip+1]) {
+		    case 'E':
+			ip = ip + 1
+			ch = ESC
+		    case '^', ':', '\\':
+			ip = ip + 1
+			ch = Memc[ip]
+		    default:
+			junk = cctoc (Memc, ip, ch)
+			ip = ip - 1
+		    }
+		}
+
+		outstr[op] = ch
+		op = op + 1
+		ip = ip + 1
+		if (op >= maxch)
+		    break
+	    }
+	}
+
+	outstr[op] = EOS
+	return (op-1)
+end
diff --git a/sys/gty/gtyindex.x b/sys/gty/gtyindex.x
new file mode 100644
index 00000000..b91456ca
--- /dev/null
+++ b/sys/gty/gtyindex.x
@@ -0,0 +1,167 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<syserr.h>
+include	<chars.h>
+include	"gty.h"
+
+# GTY_INDEX_CAPS -- Prepare an index into the caplist string, stored in
+# the tty descriptor.  Each two character capability name maps into a unique
+# integer code, called the capcode.  We prepare a list of capcodes, keeping
+# only the first such code encountered in the case of multiple entries.
+# The offset of the capability in the caplist string is associated with each
+# capcode.  When these lists have been prepared, they are sorted to permit
+# a binary search for capabilities at runtime.
+
+procedure gty_index_caps (tty, t_capcode, t_capindex, ncaps)
+
+pointer	tty
+int	t_capcode[ARB], t_capindex[ARB]
+int	ncaps
+
+pointer	ip, caplist
+int	i, swap, capcode, temp
+int	gty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	ip = caplist
+
+	# Scan the caplist and prepare the capcode and capindex lists.
+	for (ncaps=0;  ncaps <= MAX_CAPS;  ) {
+	    # Advance to the next capability field.  Normal exit occurs
+	    # when ':' is followed immediately by EOS.
+
+	    while (Memc[ip] != ':' && Memc[ip] != EOS)
+		ip = ip + 1
+	    if (Memc[ip+1] == EOS || Memc[ip] == EOS)
+		break
+
+	    ip = ip + 1					# skip the ':'
+	    capcode = gty_encode_capability (Memc[ip])
+
+	    # Is the capcode already in the list?  If not found, add it to
+	    # the list.
+	    for (i=1;  i <= ncaps && t_capcode[i] != capcode;  i=i+1)
+		;
+	    if (i > ncaps) {				# not found
+		ncaps = ncaps + 1
+		t_capcode[ncaps] = capcode
+		t_capindex[ncaps] = ip - caplist + 1
+	    }
+	}
+
+	if (ncaps > MAX_CAPS)
+	    call syserr (SYS_TTYOVFL)
+
+	# A simple interchange sort is sufficient here, even though it would
+	# not be hard to interface to qsort.  The longest termcap entries are
+	# about 50 caps, and the time req'd to sort such a short list is
+	# negligible compared to the time spent searching the termcap file.
+
+	if (ncaps > 1)
+	    repeat {
+		swap = 0
+		do i = 1, ncaps-1
+		    if (t_capcode[i] > t_capcode[i+1]) {
+			temp = t_capcode[i]
+			t_capcode[i] = t_capcode[i+1]
+			t_capcode[i+1] = temp
+			temp = t_capindex[i]
+			t_capindex[i] = t_capindex[i+1]
+			t_capindex[i+1] = temp
+			swap = 1
+		    }
+	    } until (swap == 0)
+end
+
+
+# GTY_FIND_CAPABILITY -- Search the caplist for the named capability.
+# If found, return the char pointer IP to the first char of the value field,
+# and YES as the function value.  If the first char in the capability string
+# is '@', the capability "is not present".
+
+int procedure gty_find_capability (tty, cap, ip)
+
+pointer	tty			# tty descriptor
+char	cap[ARB]		# two character name of capability
+pointer	ip			# pointer to capability string
+
+int	capcode, capnum
+int	gty_binsearch(), gty_encode_capability()
+pointer	coerce()
+errchk	syserr
+
+begin
+	if (tty == NULL)
+	    call syserr (SYS_TTYINVDES)
+
+	capcode = gty_encode_capability (cap)
+	capnum = gty_binsearch (capcode, T_CAPCODE(tty), T_NCAPS(tty))
+
+	if (capnum > 0) {
+	    # Add 2 to skip the two capname chars.
+	    ip = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR) +
+		T_CAPINDEX(tty+capnum-1) - 1 + 2
+	    if (Memc[ip] != '@')
+		return (YES)
+	}
+
+	return (NO)
+end
+
+
+# GTY_BINSEARCH -- Perform a binary search of the capcode array for the
+# indicated capability.  Return the array index of the capability if found,
+# else zero.
+
+int procedure gty_binsearch (capcode, t_capcode, ncaps)
+
+int	capcode
+int	t_capcode[ARB], ncaps
+int	low, high, pos, ntrips
+define	err_ 91
+
+begin
+	pos = 0
+	low = 1
+	high = ncaps
+	if (high < low)
+	    goto err_
+
+	# Cut range of search in half until code is found, or until range
+	# vanishes (high - low <= 1).  If neither high or low is the one,
+	# code is not found in the list.
+
+	do ntrips = 1, ncaps {
+	    pos = (high - low) / 2 + low
+	    if (t_capcode[low] == capcode)
+		return (low)
+	    else if (t_capcode[high] == capcode)
+		return (high)
+	    else if (pos == low)			# (high-low)/2 == 0
+		return (0)				# not found
+	    else if (t_capcode[pos] < capcode)
+		low = pos
+	    else
+		high = pos
+	}
+
+	# Search cannot fail to converge unless there is a bug in the software
+	# somewhere.
+err_
+	call syserr (SYS_TTYBINSRCH)
+end
+
+
+# GTY_ENCODE_CAPABILITY -- Encode the two character capability string
+# as a unique integer value.
+
+int procedure gty_encode_capability (cap)
+
+char	cap[ARB]
+
+begin
+	return (ENCODE(cap))
+end
diff --git a/sys/gty/gtyopen.x b/sys/gty/gtyopen.x
new file mode 100644
index 00000000..d566f2d1
--- /dev/null
+++ b/sys/gty/gtyopen.x
@@ -0,0 +1,305 @@
+include	<error.h>
+include	<syserr.h>
+include	<ctype.h>
+include	<chars.h>
+include	"gty.h"
+
+# GTYOPEN -- Scan the named TERMCAP style file for the entry for the named
+# device, and if found allocate a TTY descriptor structure, leaving the
+# termcap entry for the device in the descriptor.  If any UFIELDS are given
+# these will be prepended to the output device capability list, overriding
+# the device file entries.  If no termcap file is named (null string) then
+# UFIELDS is taken as the device entry and opened on a GTY descriptor.
+
+pointer procedure gtyopen (termcap_file, device, ufields)
+
+char	termcap_file[ARB]	#I termcap file to be scanned
+char	device[ARB]		#I name of device to be extracted
+char	ufields[ARB]		#I user specified capabilities
+
+int	nchars, ip
+pointer	caplist, tty, op
+errchk	calloc, realloc, gty_index_caps
+pointer	coerce()
+int	strlen()
+
+begin
+	# Allocate and initialize the tty descriptor structure.
+	call calloc (tty, LEN_DEFTTY, TY_STRUCT)
+
+	T_LEN(tty) = LEN_DEFTTY
+	T_OP(tty) = 1
+
+	# Place any user specified capabilities in the caplist.  These will
+	# override any values given in the file entry.
+
+	for (ip=1;  ufields[ip] != EOS && ufields[ip] != ':';  ip=ip+1)
+	    ;
+	nchars = strlen (ufields[ip])
+	if (nchars > 0) {
+	    caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	    call strcpy (ufields[ip], Memc[caplist], T_LEN(tty) - T_OFFCAP)
+	    op = caplist + nchars
+	    if (Memc[op-1] == ':')
+		op = op - 1
+	    Memc[op] = EOS
+	    T_OP(tty) = op - caplist + 1
+	    T_CAPLEN(tty) = T_OP(tty)
+	}
+
+	# Scan the source file, if given.
+	if (termcap_file[1] != EOS)
+	    iferr (call gty_scan_termcap_file (tty, termcap_file, device)) {
+		call mfree (tty, TY_STRUCT)
+		call erract (EA_ERROR)
+	    }
+
+	# Call realloc to return any unused space in the descriptor.
+	T_LEN(tty) = T_OFFCAP + (T_OP(tty) + SZ_STRUCT-1) / SZ_STRUCT
+	call realloc (tty, T_LEN(tty), TY_STRUCT)
+
+	# Prepare index of fields in the descriptor, so that we can more
+	# efficiently search for fields later.
+
+	call gty_index_caps (tty, T_CAPCODE(tty), T_CAPINDEX(tty),
+	    T_NCAPS(tty))
+
+	return (tty)
+end
+
+
+# TTY_SCAN_TERMCAP_FILE -- Open and scan the named TERMCAP format database
+# file for the named device.  Fetch termcap entry, expanding any and all
+# "tc" references by repeatedly rescanning file.
+
+procedure gty_scan_termcap_file (tty, termcap_file, devname)
+
+pointer	tty			# tty descriptor structure
+char	termcap_file[ARB]	# termcap format file to be scanned
+char	devname[ARB]		# termcap entry to be scanned for
+
+int	fd, ntc
+pointer	sp, device, ip, op, caplist
+int	open(), strlen(), strncmp()
+pointer	coerce()
+errchk	open, syserrs
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+
+	fd = open (termcap_file, READ_ONLY, TEXT_FILE)
+	call strcpy (devname, Memc[device], SZ_FNAME)
+
+	ntc = 0
+	repeat {
+	    iferr (call gty_fetch_entry (fd, Memc[device], tty)) {
+		call close (fd)
+		call erract (EA_ERROR)
+	    }
+
+	    # Back up to start of last field in entry.
+	    caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	    ip = caplist + T_OP(tty)-1 - 2
+	    while (ip > caplist && Memc[ip] != ':')
+		ip = ip - 1
+
+	    # If last field is "tc", backup op so that the tc field gets
+	    # overwritten with the referenced entry.
+
+	    if (strncmp (Memc[ip+1], "tc", 2) == 0) {
+		# Check for recursive tc reference.
+		ntc = ntc + 1
+		if (ntc > MAX_TC_NESTING) {
+		    call close (fd)
+		    call syserrs (SYS_TTYTC, Memc[device])
+		}
+
+		# Set op to point to the ":" in ":tc=file".
+		T_OP(tty) = ip - caplist + 1
+
+		# Get device name from tc field, and loop again to fetch new
+		# entry.
+		ip = ip + strlen (":tc=")
+		for (op=device;  Memc[ip] != EOS && Memc[ip] != ':';  ip=ip+1) {
+		    Memc[op] = Memc[ip]
+		    op = op + 1
+		}
+		Memc[op] = EOS
+		call seek (fd, BOFL)
+	    } else
+		break
+	}
+
+	call close (fd)
+	call sfree (sp)
+end
+
+
+# GTY_FETCH_ENTRY -- Search the termcap file for the named entry, then read
+# the colon delimited capabilities list into the caplist field of the tty
+# descriptor.  If the caplist field fills up, allocate more space.
+
+procedure gty_fetch_entry (fd, device, tty)
+
+int	fd
+char	device[ARB]
+pointer	tty
+
+char	ch, lastch
+bool	device_found
+pointer	sp, ip, op, otop, lbuf, alias, caplist
+
+char	getc()
+bool	streq()
+pointer	coerce()
+int	getline(), gty_extract_alias()
+errchk	getline, getc, realloc, salloc
+define	errtn_ 91
+
+begin
+	call smark (sp)
+	call salloc (lbuf,  SZ_LINE,  TY_CHAR)
+	call salloc (alias, SZ_FNAME, TY_CHAR)
+
+	# Locate entry.  First line of each termcap entry contains a list
+	# of aliases for the device.  Only first lines and comment lines
+	# are left justified.
+
+	repeat {
+	    # Skip comment and continuation lines and blank lines.
+	    device_found = false
+
+	    if (getc (fd, ch) == EOF)
+		goto errtn_
+
+	    if (ch == '\n') {
+		# Skip a blank line.
+		next
+	    } else if (ch == '#' || IS_WHITE (ch)) {
+		# Discard the rest of the line and continue.
+		if (getline (fd, Memc[lbuf]) == EOF)
+		    goto errtn_
+		next
+	    }
+
+	    # Extract list of aliases.  The first occurrence of ':' marks
+	    # the end of the alias list and the beginning of the caplist.
+
+	    Memc[lbuf] = ch
+	    op = lbuf + 1
+
+	    for (;  getc(fd,ch) != ':';  op=op+1) {
+		Memc[op] = ch
+		if (ch == EOF || ch == '\n') {
+		    goto errtn_
+		}
+	    }
+	    Memc[op] = EOS
+
+	    ip = lbuf
+	    while (gty_extract_alias (Memc, ip, Memc[alias], SZ_FNAME) > 0) {
+		if (device[1] == EOS || streq (Memc[alias], device)) {
+		    device_found = true
+		    break
+		} else if (Memc[ip] == '|')
+		    ip = ip + 1				# skip delimiter
+	    }
+
+	    # Skip rest of line if no match.
+	    if (!device_found) {
+		if (getline (fd, Memc[lbuf]) == EOF) {
+		    goto errtn_
+		}
+	    }
+	} until (device_found)
+
+	# Caplist begins at first ':'.  Each line has some whitespace at the
+	# beginning which should be skipped.  Escaped newline implies
+	# continuation.
+
+	caplist = coerce (tty + T_OFFCAP, TY_STRUCT, TY_CHAR)
+	op = caplist + T_OP(tty) - 1
+	otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR)
+
+	# We are already positioned to the start of the caplist.
+	Memc[op] = ':'
+	op = op + 1
+	lastch = ':'
+
+	# Extract newline terminated caplist string.
+	while (getc (fd, ch) != EOF) {
+	    if (ch == '\\') {				# escaped newline?
+		if (getc (fd, ch) == '\n') {
+		    while (getc (fd, ch) != EOF)
+			if (!IS_WHITE(ch))
+			    break
+		    if (ch == EOF || ch == '\n')
+			goto errtn_
+		    # Avoid null entries ("::").
+		    if (ch == ':' && lastch == ':')
+			next
+		    else
+			Memc[op] = ch
+		} else {				# no, keep both chars
+		    Memc[op] = '\\'
+		    op = op + 1
+		    Memc[op] = ch
+		}
+	    } else if (ch == '\n') {			# normal exit
+		Memc[op] = EOS
+		T_OP(tty) = op - caplist + 1
+		T_CAPLEN(tty) = T_OP(tty)
+		call sfree (sp)
+		return
+	    } else
+		Memc[op] = ch
+
+	    # Increase size of buffer if necessary.  Note that realloc may 
+	    # move the buffer, so we must recalculate op and otop.
+
+	    lastch = ch
+	    op = op + 1
+	    if (op >= otop) {
+		T_OP(tty) = op - caplist + 1
+		T_LEN(tty) = T_LEN(tty) + T_MEMINCR
+		call realloc (tty, T_LEN(tty), TY_STRUCT)
+		op = caplist + T_OP(tty) - 1
+		otop = coerce (tty + T_LEN(tty), TY_STRUCT, TY_CHAR)
+	    }
+	}
+
+errtn_
+ 	call sfree (sp)
+	call syserrs (SYS_TTYDEVNF, device)
+end
+
+
+# GTY_EXTRACT_ALIAS -- Extract a device alias string from the header of
+# a termcap entry.  The alias string is terminated by '|' or ':'.  Leave
+# ip pointing at the delimiter.  Return number of chars in alias string.
+
+int procedure gty_extract_alias (str, ip, outstr, maxch)
+
+char	str[ARB]		# first line of termcap entry
+int	ip			# on input, first char of alias
+char	outstr[ARB]
+int	maxch
+
+char	ch
+int	op
+
+begin
+	op = 1
+	for (ch=str[ip];  ch != '|' && ch != ':' && ch != EOS;  ch=str[ip]) {
+	    outstr[op] = ch
+	    op = min (maxch, op) + 1
+	    ip = ip + 1
+	}
+	outstr[op] = EOS
+
+	if (ch == EOS)
+	    return (0)
+	else
+	    return (op-1)
+end
diff --git a/sys/gty/mkpkg b/sys/gty/mkpkg
new file mode 100644
index 00000000..20dff77f
--- /dev/null
+++ b/sys/gty/mkpkg
@@ -0,0 +1,29 @@
+# Update the GTY portion of libsys.a.
+
+$checkout libsys.a lib$
+$update   libsys.a
+$checkin  libsys.a lib$
+$exit
+
+zzdebug:
+	$checkout libsys.a lib$
+	$update   libsys.a
+	$checkin  libsys.a lib$
+
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+	$omake	zzdebug.x
+	$link	-z zzdebug.o
+	;
+
+libsys.a:
+	#$set	XFLAGS = "$(XFLAGS) -qx"
+
+	gtycaps.x	gty.h
+	gtyclose.x	
+	gtygetb.x	
+	gtygeti.x	
+	gtygetr.x	<mach.h>
+	gtygets.x	<chars.h>
+	gtyindex.x	gty.h <chars.h>
+	gtyopen.x	gty.h <chars.h> <ctype.h> <error.h>
+	;
diff --git a/sys/gty/zzdebug.x b/sys/gty/zzdebug.x
new file mode 100644
index 00000000..c8171b4c
--- /dev/null
+++ b/sys/gty/zzdebug.x
@@ -0,0 +1,26 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+task	dump = t_dump
+
+# DUMP -- Dump a termcap (GTY) device entry.
+
+procedure t_dump()
+
+char	fname[SZ_FNAME]
+char	device[SZ_FNAME]
+char	ufields[SZ_LINE]
+
+pointer	gty
+pointer	gtyopen()
+pointer	gtycaps()
+
+begin
+	call clgstr ("fname", fname, SZ_FNAME)
+	call clgstr ("device", device, SZ_FNAME)
+	call clgstr ("ufields", ufields, SZ_LINE)
+
+	gty = gtyopen (fname, device, ufields)
+	call printf ("%s\n")
+	    call pargstr (Memc[gtycaps(gty)])
+	call gtyclose (gty)
+end