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 KOSAPI, sys := SYSTEM;
 20 
IMPORT KOSAPI, 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 70... Line 70...
70 
    DEC(i);
 70 
    DEC(i);
71 
    Char(a[i])
 71 
    Char(a[i])
72 
  UNTIL i = 0
 72 
  UNTIL i = 0
73 
END WriteInt;
 73 
END WriteInt;
Line 74... Line 74...
74 
 
 74 
 
75 
PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN;
 75 
PROCEDURE IsNan(AValue: REAL): BOOLEAN;
76 
VAR h, l: SET;
 76 
VAR h, l: SET;
77 
BEGIN
 77 
BEGIN
78 
  sys.GET(sys.ADR(AValue), l);
 78 
  sys.GET(sys.ADR(AValue), l);
79 
  sys.GET(sys.ADR(AValue) + 4, h)
 79 
  sys.GET(sys.ADR(AValue) + 4, h)
80 
  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
 80 
  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
Line 81... Line 81...
81 
END IsNan;
 81 
END IsNan;
82 
 
 82 
 
83 
PROCEDURE IsInf(x: LONGREAL): BOOLEAN;
 83 
PROCEDURE IsInf(x: REAL): BOOLEAN;
Line 84... Line 84...
84 
  RETURN ABS(x) = sys.INF(LONGREAL)
 84 
  RETURN ABS(x) = sys.INF()
85 
END IsInf;
 85 
END IsInf;
86 
 
 86 
 
Line 95... Line 95...
95 
    END;
 95 
    END;
96 
    String("-2147483648")
 96 
    String("-2147483648")
97 
  END
 97 
  END
98 
END Int;
 98 
END Int;
Line 99... Line 99...
99 
 
 99 
 
100 
PROCEDURE OutInf(x: LONGREAL; width: INTEGER);
 100 
PROCEDURE OutInf(x: REAL; width: INTEGER);
101 
VAR s: ARRAY 4 OF CHAR; i: INTEGER;
 101 
VAR s: ARRAY 5 OF CHAR; i: INTEGER;
102 
BEGIN
 102 
BEGIN
103 
  IF IsNan(x) THEN
 103 
  IF IsNan(x) THEN
104 
    s := "Nan";
 104 
    s := "Nan";
105 
    INC(width)
 105 
    INC(width)
106 
  ELSIF IsInf(x) & (x > 0.0D0) THEN
 106 
  ELSIF IsInf(x) & (x > 0.0) THEN
107 
    s := "+Inf"
 107 
    s := "+Inf"
108 
  ELSIF IsInf(x) & (x < 0.0D0) THEN
 108 
  ELSIF IsInf(x) & (x < 0.0) THEN
109 
    s := "-Inf"
 109 
    s := "-Inf"
110 
  END;
 110 
  END;
111 
  FOR i := 1 TO width - 4 DO
 111 
  FOR i := 1 TO width - 4 DO
112 
    Char(" ")
 112 
    Char(" ")
Line 118... Line 118...
118 
BEGIN
 118 
BEGIN
119 
  Char(0DX);
 119 
  Char(0DX);
120 
  Char(0AX)
 120 
  Char(0AX)
121 
END Ln;
 121 
END Ln;
Line 122... Line 122...
122 
 
 122 
 
123 
PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER);
 123 
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
124 
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN;
 124 
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
125 
BEGIN
 125 
BEGIN
126 
  IF IsNan(x) OR IsInf(x) THEN
 126 
  IF IsNan(x) OR IsInf(x) THEN
127 
    OutInf(x, width)
 127 
    OutInf(x, width)
128 
  ELSIF p < 0 THEN
 128 
  ELSIF p < 0 THEN
129 
    Realp(x, width)
 129 
    Realp(x, width)
130 
  ELSE
 130 
  ELSE
131 
    len := 0;
 131 
    len := 0;
132 
    minus := FALSE;
 132 
    minus := FALSE;
133 
    IF x < 0.0D0 THEN
 133 
    IF x < 0.0 THEN
134 
      minus := TRUE;
 134 
      minus := TRUE;
135 
      INC(len);
 135 
      INC(len);
136 
      x := ABS(x)
 136 
      x := ABS(x)
137 
    END;
 137 
    END;
138 
    e := 0;
 138 
    e := 0;
139 
    WHILE x >= 10.0D0 DO
 139 
    WHILE x >= 10.0 DO
140 
      x := x / 10.0D0;
 140 
      x := x / 10.0;
141 
      INC(e)
 141 
      INC(e)
142 
    END;
 142 
    END;
143 
    IF e >= 0 THEN
 143 
    IF e >= 0 THEN
144 
      len := len + e + p + 1;
 144 
      len := len + e + p + 1;
145 
      IF x > 9.0D0 + d THEN
 145 
      IF x > 9.0 + d THEN
146 
	INC(len)
 146 
        INC(len)
147 
      END;
 147 
      END;
148 
      IF p > 0 THEN
 148 
      IF p > 0 THEN
149 
	INC(len)
 149 
        INC(len)
Line 156... Line 156...
156 
    END;
 156 
    END;
157 
    IF minus THEN
 157 
    IF minus THEN
158 
      Char("-")
 158 
      Char("-")
159 
    END;
 159 
    END;
160 
    y := x;
 160 
    y := x;
161 
    WHILE (y < 1.0D0) & (y # 0.0D0) DO
 161 
    WHILE (y < 1.0) & (y # 0.0) DO
162 
      y := y * 10.0D0;
 162 
      y := y * 10.0;
163 
      DEC(e)
 163 
      DEC(e)
164 
    END;
 164 
    END;
165 
    IF e < 0 THEN
 165 
    IF e < 0 THEN
166 
      IF x - LONG(FLT(FLOOR(x))) > d THEN
 166 
      IF x - FLT(FLOOR(x)) > d THEN
167 
	Char("1");
 167 
        Char("1");
168 
	x := 0.0D0
 168 
        x := 0.0
169 
      ELSE
 169 
      ELSE
170 
	Char("0");
 170 
        Char("0");
171 
	x := x * 10.0D0
 171 
        x := x * 10.0
172 
      END
 172 
      END
173 
    ELSE
 173 
    ELSE
174 
      WHILE e >= 0 DO
 174 
      WHILE e >= 0 DO
175 
	IF x - LONG(FLT(FLOOR(x))) > d THEN
 175 
        IF x - FLT(FLOOR(x)) > d THEN
176 
	  IF x > 9.0D0 THEN
 176 
          IF x > 9.0 THEN
177 
	    String("10")
 177 
            String("10")
178 
	  ELSE
 178 
          ELSE
179 
	    Char(CHR(FLOOR(x) + ORD("0") + 1))
 179 
            Char(CHR(FLOOR(x) + ORD("0") + 1))
180 
	  END;
 180 
          END;
181 
	  x := 0.0D0
 181 
          x := 0.0
182 
	ELSE
 182 
        ELSE
183 
	  Char(CHR(FLOOR(x) + ORD("0")));
 183 
          Char(CHR(FLOOR(x) + ORD("0")));
184 
	  x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0
 184 
          x := (x - FLT(FLOOR(x))) * 10.0
185 
	END;
 185 
        END;
186 
	DEC(e)
 186 
        DEC(e)
187 
      END
 187 
      END
188 
    END;
 188 
    END;
189 
    IF p > 0 THEN
 189 
    IF p > 0 THEN
190 
      Char(".")
 190 
      Char(".")
191 
    END;
 191 
    END;
192 
    WHILE p > 0 DO
 192 
    WHILE p > 0 DO
193 
      IF x - LONG(FLT(FLOOR(x))) > d THEN
 193 
      IF x - FLT(FLOOR(x)) > d THEN
194 
	Char(CHR(FLOOR(x) + ORD("0") + 1));
 194 
        Char(CHR(FLOOR(x) + ORD("0") + 1));
195 
	x := 0.0D0
 195 
        x := 0.0
196 
      ELSE
 196 
      ELSE
197 
	Char(CHR(FLOOR(x) + ORD("0")));
 197 
        Char(CHR(FLOOR(x) + ORD("0")));
198 
	x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0
 198 
        x := (x - FLT(FLOOR(x))) * 10.0
199 
      END;
 199 
      END;
200 
      DEC(p)
 200 
      DEC(p)
201 
    END
 201 
    END
202 
  END
 202 
  END
203 
END _FixReal;
 203 
END _FixReal;
Line 204... Line 204...
204 
 
 204 
 
205 
PROCEDURE Real*(x: LONGREAL; width: INTEGER);
 205 
PROCEDURE Real*(x: REAL; width: INTEGER);
206 
VAR e, n, i: INTEGER; minus: BOOLEAN;
 206 
VAR e, n, i: INTEGER; minus: BOOLEAN;
207 
BEGIN
 207 
BEGIN
208 
  IF IsNan(x) OR IsInf(x) THEN
 208 
  IF IsNan(x) OR IsInf(x) THEN
209 
    OutInf(x, width)
 209 
    OutInf(x, width)
Line 215... Line 215...
215 
      width := 23
 215 
      width := 23
216 
    ELSIF width < 9 THEN
 216 
    ELSIF width < 9 THEN
217 
      width := 9
 217 
      width := 9
218 
    END;
 218 
    END;
219 
    width := width - 5;
 219 
    width := width - 5;
220 
    IF x < 0.0D0 THEN
 220 
    IF x < 0.0 THEN
221 
      x := -x;
 221 
      x := -x;
222 
      minus := TRUE
 222 
      minus := TRUE
223 
    ELSE
 223 
    ELSE
224 
      minus := FALSE
 224 
      minus := FALSE
225 
    END;
 225 
    END;
226 
    WHILE x >= 10.0D0 DO
 226 
    WHILE x >= 10.0 DO
227 
      x := x / 10.0D0;
 227 
      x := x / 10.0;
228 
      INC(e)
 228 
      INC(e)
229 
    END;
 229 
    END;
230 
    WHILE (x < 1.0D0) & (x # 0.0D0) DO
 230 
    WHILE (x < 1.0) & (x # 0.0) DO
231 
      x := x * 10.0D0;
 231 
      x := x * 10.0;
232 
      DEC(e)
 232 
      DEC(e)
233 
    END;
 233 
    END;
234 
    IF x > 9.0D0 + d THEN
 234 
    IF x > 9.0 + d THEN
235 
      x := 1.0D0;
 235 
      x := 1.0;
236 
      INC(e)
 236 
      INC(e)
237 
    END;
 237 
    END;
238 
    FOR i := 1 TO n DO
 238 
    FOR i := 1 TO n DO
239 
      Char(" ")
 239 
      Char(" ")
240 
    END;
 240 
    END;
Line 258... Line 258...
258 
    END;
 258 
    END;
259 
    Int(e, 0)
 259 
    Int(e, 0)
260 
  END
 260 
  END
261 
END Real;
 261 
END Real;
Line 262... Line 262...
262 
 
 262 
 
263 
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER);
 263 
PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
264 
BEGIN
 264 
BEGIN
265 
  Realp := Real;
 265 
  Realp := Real;
266 
  _FixReal(x, width, p)
 266 
  _FixReal(x, width, p)
Line 280... Line 280...
280 
 
 280 
 
281 
VAR info: info_struct; res: INTEGER;
 281 
VAR info: info_struct; res: INTEGER;
282 
BEGIN
 282 
BEGIN
283 
  info.subfunc := 7;
 283 
  info.subfunc := 7;
284 
  info.flags := 0;
 284 
  info.flags := 0;
285 
  info.param := sys.ADR(" ");
 285 
  info.param := sys.SADR(" ");
286 
  info.rsrvd1 := 0;
 286 
  info.rsrvd1 := 0;
287 
  info.rsrvd2 := 0;
 287 
  info.rsrvd2 := 0;
288 
  info.fname := "/rd/1/develop/board";
 288 
  info.fname := "/rd/1/develop/board";
289 
  res := KOSAPI.sysfunc2(70, sys.ADR(info))
 289 
  res := KOSAPI.sysfunc2(70, sys.ADR(info))