FIFFEF.e
MathLib0.mod
Processes.mod
+RealConver.mod
RealInOut.mod
Storage.mod
Conversion.mod
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:
--- /dev/null
+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.
--- /dev/null
+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.
(* 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.
*)
PROCEDURE WriteRealOct(x: REAL);
- (* Write x in octal form with exponent and mantissa.
+ (* Write x in octal words.
*)
END RealInOut.
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
public / ack.git / commitdiff