Subversion Repositories Kolibri OS

Rev

Rev 6647 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 6647 Rev 7597
Line 1... Line 1...
1 
(*
 1 
(*
2 
    Copyright 2016 Anton Krotov
 2 
    Copyright 2016, 2018 Anton Krotov
Line 3... Line 3...
3 
 
 3 
 
4 
    This program is free software: you can redistribute it and/or modify
 4 
    This program is free software: you can redistribute it and/or modify
5 
    it under the terms of the GNU Lesser General Public License as published by
 5 
    it under the terms of the GNU Lesser General Public License as published by
6 
    the Free Software Foundation, either version 3 of the License, or
 6 
    the Free Software Foundation, either version 3 of the License, or
Line 19... Line 19...
19 
 
 19 
 
Line 20... Line 20...
20 
IMPORT ConsoleLib, sys := SYSTEM;
 20 
IMPORT ConsoleLib, sys := SYSTEM;
Line 21... Line 21...
21 
 
 21 
 
Line 22... Line 22...
22 
CONST
 22 
CONST
Line 23... Line 23...
23 
 
 23 
 
Line 24... Line 24...
24 
  d = 1.0D0 - 5.0D-12;
 24 
  d = 1.0 - 5.0E-12;
25 
 
 25 
 
26 
VAR
 26 
VAR
27 
 
 27 
 
Line 65... Line 65...
65 
    DEC(i);
 65 
    DEC(i);
66 
    Char(a[i])
 66 
    Char(a[i])
67 
  UNTIL i = 0
 67 
  UNTIL i = 0
68 
END WriteInt;
 68 
END WriteInt;
Line 69... Line 69...
69 
 
 69 
 
70 
PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN;
 70 
PROCEDURE IsNan(AValue: REAL): BOOLEAN;
71 
VAR h, l: SET;
 71 
VAR h, l: SET;
72 
BEGIN
 72 
BEGIN
73 
  sys.GET(sys.ADR(AValue), l);
 73 
  sys.GET(sys.ADR(AValue), l);
74 
  sys.GET(sys.ADR(AValue) + 4, h)
 74 
  sys.GET(sys.ADR(AValue) + 4, h)
75 
  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
 75 
  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
Line 76... Line 76...
76 
END IsNan;
 76 
END IsNan;
77 
 
 77 
 
78 
PROCEDURE IsInf(x: LONGREAL): BOOLEAN;
 78 
PROCEDURE IsInf(x: REAL): BOOLEAN;
Line 79... Line 79...
79 
  RETURN ABS(x) = sys.INF(LONGREAL)
 79 
  RETURN ABS(x) = sys.INF()
80 
END IsInf;
 80 
END IsInf;
81 
 
 81 
 
Line 90... Line 90...
90 
    END;
 90 
    END;
91 
    String("-2147483648")
 91 
    String("-2147483648")
92 
  END
 92 
  END
93 
END Int;
 93 
END Int;
Line 94... Line 94...
94 
 
 94 
 
95 
PROCEDURE OutInf(x: LONGREAL; width: INTEGER);
 95 
PROCEDURE OutInf(x: REAL; width: INTEGER);
96 
VAR s: ARRAY 4 OF CHAR; i: INTEGER;
 96 
VAR s: ARRAY 5 OF CHAR; i: INTEGER;
97 
BEGIN
 97 
BEGIN
98 
  IF IsNan(x) THEN
 98 
  IF IsNan(x) THEN
99 
    s := "Nan";
 99 
    s := "Nan";
100 
    INC(width)
 100 
    INC(width)
101 
  ELSIF IsInf(x) & (x > 0.0D0) THEN
 101 
  ELSIF IsInf(x) & (x > 0.0) THEN
102 
    s := "+Inf"
 102 
    s := "+Inf"
103 
  ELSIF IsInf(x) & (x < 0.0D0) THEN
 103 
  ELSIF IsInf(x) & (x < 0.0) THEN
104 
    s := "-Inf"
 104 
    s := "-Inf"
105 
  END;
 105 
  END;
106 
  FOR i := 1 TO width - 4 DO
 106 
  FOR i := 1 TO width - 4 DO
107 
    Char(" ")
 107 
    Char(" ")
Line 113... Line 113...
113 
BEGIN
 113 
BEGIN
114 
  Char(0DX);
 114 
  Char(0DX);
115 
  Char(0AX)
 115 
  Char(0AX)
116 
END Ln;
 116 
END Ln;
Line 117... Line 117...
117 
 
 117 
 
118 
PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER);
 118 
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
119 
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN;
 119 
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
120 
BEGIN
 120 
BEGIN
121 
  IF IsNan(x) OR IsInf(x) THEN
 121 
  IF IsNan(x) OR IsInf(x) THEN
122 
    OutInf(x, width)
 122 
    OutInf(x, width)
123 
  ELSIF p < 0 THEN
 123 
  ELSIF p < 0 THEN
124 
    Realp(x, width)
 124 
    Realp(x, width)
125 
  ELSE
 125 
  ELSE
126 
    len := 0;
 126 
    len := 0;
127 
    minus := FALSE;
 127 
    minus := FALSE;
128 
    IF x < 0.0D0 THEN
 128 
    IF x < 0.0 THEN
129 
      minus := TRUE;
 129 
      minus := TRUE;
130 
      INC(len);
 130 
      INC(len);
131 
      x := ABS(x)
 131 
      x := ABS(x)
132 
    END;
 132 
    END;
133 
    e := 0;
 133 
    e := 0;
134 
    WHILE x >= 10.0D0 DO
 134 
    WHILE x >= 10.0 DO
135 
      x := x / 10.0D0;
 135 
      x := x / 10.0;
136 
      INC(e)
 136 
      INC(e)
137 
    END;
 137 
    END;
138 
    IF e >= 0 THEN
 138 
    IF e >= 0 THEN
139 
      len := len + e + p + 1;
 139 
      len := len + e + p + 1;
140 
      IF x > 9.0D0 + d THEN
 140 
      IF x > 9.0 + d THEN
141 
	INC(len)
 141 
        INC(len)
142 
      END;
 142 
      END;
143 
      IF p > 0 THEN
 143 
      IF p > 0 THEN
144 
	INC(len)
 144 
        INC(len)
Line 151... Line 151...
151 
    END;
 151 
    END;
152 
    IF minus THEN
 152 
    IF minus THEN
153 
      Char("-")
 153 
      Char("-")
154 
    END;
 154 
    END;
155 
    y := x;
 155 
    y := x;
156 
    WHILE (y < 1.0D0) & (y # 0.0D0) DO
 156 
    WHILE (y < 1.0) & (y # 0.0) DO
157 
      y := y * 10.0D0;
 157 
      y := y * 10.0;
158 
      DEC(e)
 158 
      DEC(e)
159 
    END;
 159 
    END;
160 
    IF e < 0 THEN
 160 
    IF e < 0 THEN
161 
      IF x - LONG(FLT(FLOOR(x))) > d THEN
 161 
      IF x - FLT(FLOOR(x)) > d THEN
162 
	Char("1");
 162 
        Char("1");
163 
	x := 0.0D0
 163 
        x := 0.0
164 
      ELSE
 164 
      ELSE
165 
	Char("0");
 165 
        Char("0");
166 
	x := x * 10.0D0
 166 
        x := x * 10.0
167 
      END
 167 
      END
168 
    ELSE
 168 
    ELSE
169 
      WHILE e >= 0 DO
 169 
      WHILE e >= 0 DO
170 
	IF x - LONG(FLT(FLOOR(x))) > d THEN
 170 
        IF x - FLT(FLOOR(x)) > d THEN
171 
	  IF x > 9.0D0 THEN
 171 
          IF x > 9.0 THEN
172 
	    String("10")
 172 
            String("10")
173 
	  ELSE
 173 
          ELSE
174 
	    Char(CHR(FLOOR(x) + ORD("0") + 1))
 174 
            Char(CHR(FLOOR(x) + ORD("0") + 1))
175 
	  END;
 175 
          END;
176 
	  x := 0.0D0
 176 
          x := 0.0
177 
	ELSE
 177 
        ELSE
178 
	  Char(CHR(FLOOR(x) + ORD("0")));
 178 
          Char(CHR(FLOOR(x) + ORD("0")));
179 
	  x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0
 179 
          x := (x - FLT(FLOOR(x))) * 10.0
180 
	END;
 180 
        END;
181 
	DEC(e)
 181 
        DEC(e)
182 
      END
 182 
      END
183 
    END;
 183 
    END;
184 
    IF p > 0 THEN
 184 
    IF p > 0 THEN
185 
      Char(".")
 185 
      Char(".")
186 
    END;
 186 
    END;
187 
    WHILE p > 0 DO
 187 
    WHILE p > 0 DO
188 
      IF x - LONG(FLT(FLOOR(x))) > d THEN
 188 
      IF x - FLT(FLOOR(x)) > d THEN
189 
	Char(CHR(FLOOR(x) + ORD("0") + 1));
 189 
        Char(CHR(FLOOR(x) + ORD("0") + 1));
190 
	x := 0.0D0
 190 
        x := 0.0
191 
      ELSE
 191 
      ELSE
192 
	Char(CHR(FLOOR(x) + ORD("0")));
 192 
        Char(CHR(FLOOR(x) + ORD("0")));
193 
	x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0
 193 
        x := (x - FLT(FLOOR(x))) * 10.0
194 
      END;
 194 
      END;
195 
      DEC(p)
 195 
      DEC(p)
196 
    END
 196 
    END
197 
  END
 197 
  END
198 
END _FixReal;
 198 
END _FixReal;
Line 199... Line 199...
199 
 
 199 
 
200 
PROCEDURE Real*(x: LONGREAL; width: INTEGER);
 200 
PROCEDURE Real*(x: REAL; width: INTEGER);
201 
VAR e, n, i: INTEGER; minus: BOOLEAN;
 201 
VAR e, n, i: INTEGER; minus: BOOLEAN;
202 
BEGIN
 202 
BEGIN
203 
  IF IsNan(x) OR IsInf(x) THEN
 203 
  IF IsNan(x) OR IsInf(x) THEN
204 
    OutInf(x, width)
 204 
    OutInf(x, width)
Line 210... Line 210...
210 
      width := 23
 210 
      width := 23
211 
    ELSIF width < 9 THEN
 211 
    ELSIF width < 9 THEN
212 
      width := 9
 212 
      width := 9
213 
    END;
 213 
    END;
214 
    width := width - 5;
 214 
    width := width - 5;
215 
    IF x < 0.0D0 THEN
 215 
    IF x < 0.0 THEN
216 
      x := -x;
 216 
      x := -x;
217 
      minus := TRUE
 217 
      minus := TRUE
218 
    ELSE
 218 
    ELSE
219 
      minus := FALSE
 219 
      minus := FALSE
220 
    END;
 220 
    END;
221 
    WHILE x >= 10.0D0 DO
 221 
    WHILE x >= 10.0 DO
222 
      x := x / 10.0D0;
 222 
      x := x / 10.0;
223 
      INC(e)
 223 
      INC(e)
224 
    END;
 224 
    END;
225 
    WHILE (x < 1.0D0) & (x # 0.0D0) DO
 225 
    WHILE (x < 1.0) & (x # 0.0) DO
226 
      x := x * 10.0D0;
 226 
      x := x * 10.0;
227 
      DEC(e)
 227 
      DEC(e)
228 
    END;
 228 
    END;
229 
    IF x > 9.0D0 + d THEN
 229 
    IF x > 9.0 + d THEN
230 
      x := 1.0D0;
 230 
      x := 1.0;
231 
      INC(e)
 231 
      INC(e)
232 
    END;
 232 
    END;
233 
    FOR i := 1 TO n DO
 233 
    FOR i := 1 TO n DO
234 
      Char(" ")
 234 
      Char(" ")
235 
    END;
 235 
    END;
Line 253... Line 253...
253 
    END;
 253 
    END;
254 
    Int(e, 0)
 254 
    Int(e, 0)
255 
  END
 255 
  END
256 
END Real;
 256 
END Real;
Line 257... Line 257...
257 
 
 257 
 
258 
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
 258 
PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
259 
BEGIN
 259 
BEGIN
260 
  Realp := Real;
 260 
  Realp := Real;
261 
  _FixReal(x, width, p)
 261 
  _FixReal(x, width, p)