From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001
From: Joseph Hunkeler <jhunkeler@gmail.com>
Date: Wed, 8 Jul 2015 20:46:52 -0400
Subject: Initial commit

---
 sys/fmtio/gctox.x | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 81 insertions(+)
 create mode 100644 sys/fmtio/gctox.x

(limited to 'sys/fmtio/gctox.x')

diff --git a/sys/fmtio/gctox.x b/sys/fmtio/gctox.x
new file mode 100644
index 00000000..2a23a917
--- /dev/null
+++ b/sys/fmtio/gctox.x
@@ -0,0 +1,81 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<ctype.h>
+include	<chars.h>
+include	<lexnum.h>
+
+define	OCTAL		8
+define	DECIMAL		10
+define	HEX		16
+
+
+# GCTOX -- General character string to complex.  Any legal number, e.g.,
+# integer, floating point, complex, or character constant, is decoded and
+# returned as a complex.
+
+int procedure gctox (str, ip, oxval)
+
+char	str[ARB]		# input string
+int	ip			# pointer into input string
+complex	oxval			# output complex
+
+char	ch
+double	dval
+complex	xval
+long	lval
+int	ip_save, radix, nchars, vtype
+int	ctox(), cctoc(), ctod(), gctol(), lexnum()
+
+begin
+	vtype = TY_DOUBLE				# val to be returned
+	while (IS_WHITE (str[ip]))
+	    ip = ip + 1
+
+	ip_save = ip
+	ch = str[ip]					# first nonwhite
+
+	if (ch == '(') {				# complex number?
+	    if (ctox (str, ip, xval) <= 0)
+		return (0)				# not a number
+	    else
+		vtype = TY_COMPLEX
+
+	} else if (ch == SQUOTE || ch == ESCAPE) {
+	    if (cctoc (str, ip, ch) <= 0)		# character constant?
+		return (0)
+	    else
+		dval = ch
+
+	} else {				# determine type of number
+	    switch (lexnum (str, ip, nchars)) {
+	    case LEX_OCTAL:
+		radix = OCTAL
+	    case LEX_DECIMAL:
+		radix = DECIMAL
+	    case LEX_HEX:
+		radix = HEX
+	    case LEX_REAL:
+		radix = TY_REAL
+	    default:
+		return (0)
+	    }
+
+	    if (radix == TY_REAL)		# perform the conversion
+		nchars = ctod (str, ip, dval)
+	    else {
+		nchars = gctol (str, ip, lval, radix)
+		dval = lval
+		if (IS_INDEFL (lval))
+		    dval = INDEFD
+	    }
+	}
+
+	if (vtype == TY_DOUBLE) {
+	    oxval = dval
+	    if (IS_INDEFD (dval))
+		oxval = INDEFX
+	} else
+	    oxval = xval
+
+	return (ip - ip_save)
+end
-- 
cgit