From: ceriel <none@none>
Date: Fri, 22 May 1987 17:15:09 +0000 (+0000)
Subject: Added RealConversion
X-Git-Tag: release-5-5~4101
X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=9294fb9b8ccec35e3cb2f146159e8492850296ad;p=ack.git

Added RealConversion
---

diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST
index 186416c44..05d106755 100644
--- a/lang/m2/libm2/LIST
+++ b/lang/m2/libm2/LIST
@@ -6,6 +6,7 @@ ASCII.mod
 FIFFEF.e
 MathLib0.mod
 Processes.mod
+RealConver.mod
 RealInOut.mod
 Storage.mod
 Conversion.mod
diff --git a/lang/m2/libm2/Makefile b/lang/m2/libm2/Makefile
index 6e109b5f5..1b2dbf2f1 100644
--- a/lang/m2/libm2/Makefile
+++ b/lang/m2/libm2/Makefile
@@ -3,7 +3,7 @@ DEFDIR = $(HOME)/lib/m2
 
 SOURCES =	ASCII.def FIFFEF.def MathLib0.def Processes.def \
 		RealInOut.def Storage.def Arguments.def Conversion.def \
-		random.def Semaphores.def Unix.def \
+		random.def Semaphores.def Unix.def RealConver.def \
 		Strings.def InOut.def Terminal.def TTY.def
 
 all:
diff --git a/lang/m2/libm2/RealConver.def b/lang/m2/libm2/RealConver.def
new file mode 100644
index 000000000..12241e9da
--- /dev/null
+++ b/lang/m2/libm2/RealConver.def
@@ -0,0 +1,27 @@
+DEFINITION MODULE RealConversions;
+
+  PROCEDURE StringToReal(str: ARRAY OF CHAR; VAR r: REAL; VAR ok: BOOLEAN);
+  (* Convert string "str" to a real number "r" according to the syntax:
+     
+	['+'|'-'] digit {digit} ['.' digit {digit}]
+	['E' ['+'|'-'] digit [digit]]
+
+     ok := "conversion succeeded"
+     Leading blanks are skipped;
+     Input terminates with a blank or any control character.
+  *)
+
+  PROCEDURE RealToString(r: REAL;
+			 digits, width: INTEGER;
+			 VAR str: ARRAY OF CHAR;
+			 VAR ok: BOOLEAN);
+  (* Convert real number "r" to string "str", either in fixed-point or
+     exponent notation.
+     "digits" is the number digits to the right of the decimal point,
+     "width" is the maximum width of the notation.
+     If digits < 0, exponent notation is used, otherwise fixed-point.
+     If fewer than "width" characters are needed, leading blanks are inserted.
+     If the representation does not fit in "width", then ok is set to FALSE.
+  *)
+
+END RealConversions.
diff --git a/lang/m2/libm2/RealConver.mod b/lang/m2/libm2/RealConver.mod
new file mode 100644
index 000000000..8d510e175
--- /dev/null
+++ b/lang/m2/libm2/RealConver.mod
@@ -0,0 +1,294 @@
+IMPLEMENTATION MODULE RealConversions;
+
+  FROM FIFFEF IMPORT FIF, FEF;
+
+  PROCEDURE RealToString(r: REAL;
+		width, digits: INTEGER;
+		VAR str: ARRAY OF CHAR;
+		VAR ok: BOOLEAN);
+    VAR	pointpos: INTEGER;
+	i: CARDINAL;
+	ecvtflag: BOOLEAN;
+	intpart, fractpart: REAL;
+	ind1, ind2 : CARDINAL;
+	sign: BOOLEAN;
+	tmp : CHAR;
+	ndigits: CARDINAL;
+	dummy, dig: REAL;
+
+  BEGIN
+	DEC(width);
+	IF digits < 0 THEN
+		ecvtflag := TRUE;
+		ndigits := -digits;
+	ELSE
+		ecvtflag := FALSE;
+		ndigits := digits;
+	END;
+	IF HIGH(str) < ndigits + 3 THEN str[0] := 0C; ok := FALSE; RETURN END;
+	pointpos := 0;
+	sign := r < 0.0;
+	IF sign THEN r := -r END;
+	r := FIF(r, 1.0, intpart);
+	pointpos := 0;
+	ind1 := 0;
+	ok := TRUE;
+	(*
+	  Do integer part, which is now in "intpart". "r" now contains the
+	  fraction part.
+	*)
+	IF intpart # 0.0 THEN
+		ind2 := 0;
+		WHILE intpart # 0.0 DO
+			IF ind2 > HIGH(str) THEN
+				IF NOT ecvtflag THEN
+					str[0] := 0C;
+					ok := FALSE;
+					RETURN;
+				END;
+				FOR ind1 := 1 TO HIGH(str) DO
+					str[ind1-1] := str[ind1];
+				END;
+				DEC(ind2);
+			END;
+			dummy := FIF(FIF(intpart, 0.1, intpart),10.0, dig);
+			IF (dummy > 0.5) AND (dig < 9.0) THEN
+				dig := dig + 1.0;
+			END;
+			str[ind2] := CHR(TRUNC(dig+0.5) + ORD('0'));
+			INC(ind2);
+			INC(pointpos);
+		END;
+		i := 0;
+		ind1 := ind2;
+		WHILE ind2 > i DO
+			DEC(ind2);
+			tmp := str[i];
+			str[i] := str[ind2];
+			str[ind2] := tmp;
+			INC(i);
+		END;
+	ELSE
+		INC(pointpos);
+		IF r > 0.0 THEN
+			WHILE r < 1.0 DO
+				fractpart := r;
+				r := r * 10.0;
+				DEC(pointpos);
+			END;
+		END;
+	END;
+	ind2 := ndigits;
+	IF NOT ecvtflag THEN 
+		IF INTEGER(ind2) + pointpos < 0 THEN
+			ind2 := ndigits;
+			FOR i := 0 TO ndigits DO str[i] := '0'; END;
+			ind1 := ndigits+1;
+		ELSE
+			ind2 := INTEGER(ind2) + pointpos
+		END;
+	END;
+	IF ind2 > HIGH(str) THEN
+		ok := FALSE;
+		str[0] := 0C;
+		RETURN;
+	END;
+	WHILE ind1 <= ind2 DO
+		fractpart := FIF(fractpart, 10.0, r);
+		str[ind1] := CHR(TRUNC(r)+ORD('0'));
+		INC(ind1);
+	END;
+	ind1 := ind2;
+	str[ind2] := CHR(ORD(str[ind2])+5);
+	WHILE str[ind2] > '9' DO
+		str[ind2] := '0';
+		IF ind2 > 0 THEN
+			DEC(ind2);
+			str[ind2] := CHR(ORD(str[ind2])+1);
+		ELSE
+			str[ind2] := '1';
+			INC(pointpos);
+			IF NOT ecvtflag THEN
+				IF ind1 > 0 THEN str[ind1] := '0'; END;
+				INC(ind1);
+			END;
+		END;
+	END;
+	str[ind1] := 0C;
+	IF ecvtflag THEN
+		FOR i := ind1 TO 2 BY -1 DO
+			str[i] := str[i-1];
+		END;
+		str[1] := '.';
+		INC(ind1);
+		IF sign THEN
+			FOR i := ind1 TO 1 BY -1 DO
+				str[i] := str[i-1];
+			END;
+			INC(ind1);
+			str[0] := '-';
+		END;
+		IF (ind1 + 4) > HIGH(str) THEN
+			str[0] := 0C;
+			ok := FALSE;
+			RETURN;
+		END;
+		str[ind1] := 'E'; INC(ind1);
+		DEC(pointpos);
+		IF pointpos < 0 THEN
+			pointpos := -pointpos;
+			str[ind1] := '-';
+		ELSE
+			str[ind1] := '+';
+		END;
+		INC(ind1);
+		str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100));
+		pointpos := pointpos MOD 100;
+		INC(ind1);
+		str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10));
+		INC(ind1);
+		str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10));
+	ELSE
+		IF pointpos <= 0 THEN
+			FOR i := ind1 TO 1 BY -1 DO
+				str[i+CARDINAL(-pointpos)] := str[i-1];
+			END;
+			FOR i := 0 TO CARDINAL(-pointpos) DO
+				str[i] := '0';
+			END;
+			ind1 := ind1 + CARDINAL(1 - pointpos);
+			pointpos := 1;
+		END;
+		FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO
+			str[i] := str[i-1];
+		END;
+		IF ndigits = 0 THEN
+			str[pointpos] := 0C;
+		ELSE
+			str[pointpos] := '.';
+		END;
+		IF sign THEN
+			FOR i := ind1 TO 0 BY -1 DO
+				str[i+1] := str[i];
+			END;
+			str[0] := '-';
+			INC(ind1);
+		END;
+	END;
+	IF ind1 > CARDINAL(width) THEN
+		ok := FALSE;
+		str[0] := 0C;
+		RETURN;
+	END;
+	IF ind1 < CARDINAL(width) THEN
+		FOR i := ind1 TO 0 BY -1 DO
+			str[i + CARDINAL(width) - ind1] := str[i];
+		END;
+		FOR i := 0 TO CARDINAL(width)-(ind1+1) DO
+			str[i] := ' ';
+		END;
+		ind1 := CARDINAL(width);
+	END;
+	IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END;
+
+  END RealToString;
+
+	
+  PROCEDURE StringToReal(str: ARRAY OF CHAR;
+			 VAR r: REAL; VAR ok: BOOLEAN);
+
+    CONST	BIG = 1.0E17;
+    TYPE	SETOFCHAR = SET OF CHAR;
+    VAR		pow10 : INTEGER;
+		i : INTEGER;
+		e : REAL;
+		ch : CHAR;
+		signed: BOOLEAN;
+		signedexp: BOOLEAN;
+		iB: CARDINAL;
+
+    PROCEDURE dig(ch: CARDINAL);
+    BEGIN
+	IF r>BIG THEN INC(pow10) ELSE r:= 10.0*r + FLOAT(ch) END;
+    END dig;
+
+  BEGIN
+	r := 0.0;
+	pow10 := 0;
+	iB := 0;
+	ok := TRUE;
+	signed := FALSE;
+	WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO
+		INC(iB);
+		IF iB > HIGH(str) THEN
+			ok := FALSE;
+			RETURN;
+		END;
+	END;
+	IF str[iB] = '-' THEN signed := TRUE; INC(iB)
+	ELSIF str[iB] = '+' THEN INC(iB)
+	END;
+	ch := str[iB]; INC(iB);
+	IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
+	REPEAT
+		dig(ORD(ch));
+		IF iB <= HIGH(str) THEN
+			ch := str[iB]; INC(iB);
+		END;
+	UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
+	IF (ch = '.') AND (iB <= HIGH(str)) THEN
+		ch := str[iB]; INC(iB);
+		IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
+		REPEAT
+			dig(ORD(ch));
+			DEC(pow10);
+			IF iB <= HIGH(str) THEN
+				ch := str[iB]; INC(iB);
+			END;
+		UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
+	END;
+	IF (ch = 'E') OR (ch = 'e') THEN
+		IF iB > HIGH(str) THEN
+			ok := FALSE;
+			RETURN;
+		ELSE
+			ch := str[iB]; INC(iB);
+		END;
+		i := 0;
+		signedexp := FALSE;
+		IF (ch = '-') OR (ch = '+') THEN
+			signedexp := ch = '-';
+			IF iB > HIGH(str) THEN
+				ok := FALSE;
+				RETURN;
+			ELSE
+				ch := str[iB]; INC(iB);
+			END;
+		END;
+		IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
+		REPEAT
+			i := i*10 + INTEGER(ORD(ch) - ORD('0'));
+			IF iB <= HIGH(str) THEN
+				ch := str[iB]; INC(iB);
+			END;
+		UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
+		IF signedexp THEN i := -i END;
+		pow10 := pow10 + i;
+	END;
+	IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END;
+	e := 1.0;
+	DEC(i);
+	WHILE i >= 0 DO
+		e := e * 10.0;
+		DEC(i)
+	END;
+	IF pow10<0 THEN
+		r := r / e;
+	ELSE
+		r := r * e;
+	END;
+	IF signed THEN r := -r; END;
+	IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END
+  END StringToReal;
+
+END RealConversions.
diff --git a/lang/m2/libm2/RealInOut.def b/lang/m2/libm2/RealInOut.def
index 0cc67da1b..c7eb7eb1a 100644
--- a/lang/m2/libm2/RealInOut.def
+++ b/lang/m2/libm2/RealInOut.def
@@ -6,7 +6,7 @@ DEFINITION MODULE RealInOut;
   (* Read a real number "x" according to the syntax:
      
 	['+'|'-'] digit {digit} ['.' digit {digit}]
-	['E' ['+'|'-'] digit [digit]]
+	[('E'|'e') ['+'|'-'] digit {digit}]
 
      Done := "a number was read".
      Input terminates with a blank or any control character.
@@ -20,6 +20,6 @@ DEFINITION MODULE RealInOut;
   *)
 
   PROCEDURE WriteRealOct(x: REAL);
-  (* Write x in octal form with exponent and mantissa.
+  (* Write x in octal words.
   *)
 END RealInOut.
diff --git a/lang/m2/libm2/RealInOut.mod b/lang/m2/libm2/RealInOut.mod
index a106a6971..d74c8a7d2 100644
--- a/lang/m2/libm2/RealInOut.mod
+++ b/lang/m2/libm2/RealInOut.mod
@@ -1,220 +1,46 @@
 IMPLEMENTATION MODULE RealInOut;
 
-  FROM FIFFEF IMPORT FIF, FEF;
   IMPORT InOut;
+  IMPORT RealConversions;
+  FROM SYSTEM IMPORT WORD;
 
-  CONST	NDIG = 80;
-
-  TYPE	string = ARRAY[0..NDIG+6] OF CHAR;
-
-  PROCEDURE cvt(arg: REAL;
-		ndigits: INTEGER;
-		VAR decpt: INTEGER;
-		VAR sign: BOOLEAN;
-		eflag: BOOLEAN;
-		VAR buf: string);
-    VAR	r2, i: INTEGER;
-	fi, fj: REAL;
-	ind1, ind2 : INTEGER;
-  BEGIN
-	IF ndigits < 0 THEN ndigits := 0 END;
-	IF ndigits >= NDIG-1 THEN ndigits := NDIG-2; END;
-	r2 := 0;
-	sign := arg < 0.0;
-	ind1 := 0;
-	IF sign THEN arg := -arg END;
-	arg := FIF(arg, 1.0, fi);
-	(*
-	  Do integer part, which is now in "fi". "arg" now contains the
-	  fraction part.
-	*)
-	IF fi # 0.0 THEN
-		ind2 := NDIG;
-		WHILE fi # 0.0 DO
-			DEC(ind2);
-			buf[ind2] := CHR(TRUNC((FIF(fi, 0.1, fi) +
-						0.03
-					       ) * 10.0
-					      ) + ORD('0')
-					);
-			INC(r2);
-		END;
-		WHILE ind2 < NDIG DO
-			buf[ind1] := buf[ind2];
-			INC(ind1);
-			INC(ind2);
-		END;
-	ELSIF arg > 0.0 THEN
-		WHILE arg*10.0 < 1.0 DO
-			arg := arg * 10.0;
-			fj := arg;
-			DEC(r2);
-		END;
-	END;
-	ind2 := ndigits;
-	IF NOT eflag THEN ind2 := ind2 + r2 END;
-	decpt := r2;
-	IF ind2 < 0 THEN
-		buf[0] := 0C;
-		RETURN;
-	END;
-	WHILE (ind1 <= ind2) AND (ind1 < NDIG) DO
-		arg := FIF(arg, 10.0, fj);
-		buf[ind1] := CHR(TRUNC(fj)+ORD('0'));
-		INC(ind1);
-	END;
-	IF ind2 >= NDIG THEN
-		buf[NDIG-1] := 0C;
-		RETURN;
-	END;
-	ind1 := ind2;
-	buf[ind2] := CHR(ORD(buf[ind2])+5);
-	WHILE buf[ind2] > '9' DO
-		buf[ind2] := '0';
-		IF ind2 > 0 THEN
-			DEC(ind2);
-			buf[ind2] := CHR(ORD(buf[ind2])+1);
-		ELSE
-			buf[ind2] := '1';
-			INC(decpt);
-			IF NOT eflag THEN
-				IF ind1 > 0 THEN buf[ind1] := '0'; END;
-				INC(ind1);
-			END;
-		END;
-	END;
-	buf[ind1] := 0C;
-  END cvt;
-
-  PROCEDURE ecvt(arg: REAL;
-		 ndigits: INTEGER;
-		 VAR decpt: INTEGER;
-		 VAR sign: BOOLEAN;
-		 VAR buf: string);
-  BEGIN
-	cvt(arg, ndigits, decpt, sign, TRUE, buf);
-  END ecvt;
-
-  PROCEDURE fcvt(arg: REAL;
-		 ndigits: INTEGER;
-		 VAR decpt: INTEGER;
-		 VAR sign: BOOLEAN;
-		 VAR buf: string);
-  BEGIN
-	cvt(arg, ndigits, decpt, sign, FALSE, buf);
-  END fcvt;
+  CONST	MAXNDIG = 32;
+	MAXWIDTH = MAXNDIG+7;
+  TYPE	RBUF = ARRAY [0..MAXWIDTH+1] OF CHAR;
 
   PROCEDURE WriteReal(arg: REAL; ndigits: CARDINAL);
-    VAR buf, cvtbuf: string;
-	ind1, ind2: INTEGER;
-	d,i: INTEGER;
-	sign: BOOLEAN;
+    VAR buf : RBUF;
+	ok : BOOLEAN;
 
   BEGIN
-	IF ndigits-6 < 2 THEN i := 2 ELSE i := ndigits-6; END;
-	ecvt(arg,i,d,sign,cvtbuf);
-	IF sign THEN buf[0] := '-' ELSE buf[0] := ' ' END;
-	ind1 := 1;
-	ind2 := 0;
-	IF cvtbuf[ind2] = '0' THEN INC(d); END;
-	buf[ind1] := cvtbuf[ind2]; INC(ind1); INC(ind2);
-	buf[ind1] := '.'; INC(ind1);
-	FOR i := i-1 TO 1 BY -1 DO
-		buf[ind1] := cvtbuf[ind2]; INC(ind1); INC(ind2);
-	END;
-	buf[ind1] := 'E'; INC(ind1);
-	DEC(d);
-	IF d < 0 THEN
-		d := -d;
-		buf[ind1] := '-';
-	ELSE
-		buf[ind1] := '+';
-	END;
-	INC(ind1);
-	buf[ind1] := CHR(ORD('0') + CARDINAL(d DIV 10));
-	buf[ind1+1] := CHR(ORD('0') + CARDINAL(d MOD 10));
-	buf[ind1+2] := 0C;
+	IF ndigits > MAXWIDTH THEN ndigits := MAXWIDTH; END;
+	IF ndigits < 10 THEN ndigits := 10; END;
+	RealConversions.RealToString(arg, ndigits, -(ndigits - 7), buf, ok);
 	InOut.WriteString(buf);
   END WriteReal;
 
   PROCEDURE ReadReal(VAR x: REAL);
-    CONST	BIG = 1.0E17;
-    VAR		r : REAL;
-		pow10 : INTEGER;
-		i : INTEGER;
-		e : REAL;
-		ch : CHAR;
-		signed: BOOLEAN;
-		signedexp: BOOLEAN;
-		Buf: ARRAY[0..512] OF CHAR;
-		iB: INTEGER;
-
-    PROCEDURE dig(ch: CARDINAL);
-    BEGIN
-	IF r>BIG THEN INC(pow10) ELSE r:= 10.0*r + FLOAT(ch) END;
-    END dig;
-
-    PROCEDURE isdig(ch: CHAR) : BOOLEAN;
-    BEGIN
-	RETURN (ch >= '0') AND (ch <= '9');
-    END isdig;
+    VAR	Buf: ARRAY[0..512] OF CHAR;
+	ok: BOOLEAN;
 
   BEGIN
-	r := 0.0;
-	pow10 := 0;
 	InOut.ReadString(Buf);
-	iB := 0;
-	signed := FALSE;
-	IF Buf[0] = '-' THEN signed := TRUE; INC(iB)
-	ELSIF Buf[0] = '+' THEN INC(iB)
-	END;
-	ch := Buf[iB]; INC(iB);
-	IF NOT isdig(ch) THEN Done := FALSE; RETURN END;
-	REPEAT
-		dig(ORD(ch));
-		ch := Buf[iB]; INC(iB);
-	UNTIL NOT isdig(ch);
-	IF ch = '.' THEN
-		ch := Buf[iB]; INC(iB);
-		IF NOT isdig(ch) THEN Done := FALSE; RETURN END;
-		REPEAT
-			dig(ORD(ch));
-			DEC(pow10);
-			ch := Buf[iB]; INC(iB);
-		UNTIL NOT isdig(ch);
-	END;
-	IF ch = 'E' THEN
-		ch := Buf[iB]; INC(iB);
-		i := 0;
-		signedexp := FALSE;
-		IF ch = '-' THEN signedexp := TRUE; ch:= Buf[iB]; INC(iB)
-		ELSIF Buf[iB] = '+' THEN ch := Buf[iB]; INC(iB)
-		END;
-		IF NOT isdig(ch) THEN Done := FALSE; RETURN END;
-		REPEAT
-			i := i*10 + INTEGER(ORD(ch) - ORD('0'));
-			ch := Buf[iB]; INC(iB);
-		UNTIL NOT isdig(ch);
-		IF signedexp THEN i := -i END;
-		pow10 := pow10 + i;
-	END;
-	IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END;
-	e := 1.0;
-	DEC(i);
-	WHILE i >= 0 DO
-		e := e * 10.0;
-		DEC(i)
-	END;
-	IF pow10<0 THEN
-		r := r / e;
-	ELSE
-		r := r * e;
-	END;
-	IF signed THEN x := -r; ELSE x := r END;
+	RealConversions.StringToReal(Buf, x, ok);
+	Done := ok;
   END ReadReal;
 
+  PROCEDURE wroct(x: ARRAY OF WORD);
+  VAR	i: CARDINAL;
+  BEGIN
+	FOR i := 0 TO HIGH(x) DO
+		InOut.WriteOct(CARDINAL(x[i]), 0);
+		InOut.WriteString("  ");
+	END;
+  END wroct;
+
   PROCEDURE WriteRealOct(x: REAL);
   BEGIN
+	wroct(x);
   END WriteRealOct;
 
 BEGIN