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

---
 pkg/utilities/nttools/copyone/isdouble.x | 37 ++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100644 pkg/utilities/nttools/copyone/isdouble.x

(limited to 'pkg/utilities/nttools/copyone/isdouble.x')

diff --git a/pkg/utilities/nttools/copyone/isdouble.x b/pkg/utilities/nttools/copyone/isdouble.x
new file mode 100644
index 00000000..4ee128cc
--- /dev/null
+++ b/pkg/utilities/nttools/copyone/isdouble.x
@@ -0,0 +1,37 @@
+include	<ctype.h>
+include	<mach.h>
+
+# IS_DOUBLE -- Check to see if a real number is actually double precision
+#
+# B.Simon	15-Dec-94	First Code
+
+int procedure is_double (token)
+
+char	token[ARB]	# i: token containing number
+#--
+int	ic, ndigit
+
+begin
+	# Count number of digits in mantissa and look for D exponent
+
+	ndigit = 0
+	for (ic = 1; token[ic] != EOS; ic = ic + 1) {
+	    if (token[ic] == 'D' || token[ic] == 'd') {
+		return (TY_DOUBLE)
+
+	    } else if (token[ic] == 'E' || token[ic] == 'e') { 
+		break
+	    }
+
+	    if (IS_DIGIT(token[ic]))
+		ndigit = ndigit + 1
+	}
+
+	# If no D exponent, set the type according to the number of digits
+
+	if (ndigit > NDIGITS_RP) {
+	    return (TY_DOUBLE)
+	} else {
+	    return (TY_REAL)
+	}
+end
-- 
cgit