1,5 → 1,5 |
(* |
Copyright 2016 Anton Krotov |
(* |
Copyright 2016, 2018 Anton Krotov |
|
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
21,11 → 21,11 |
|
CONST |
|
d = 1.0D0 - 5.0D-12; |
d = 1.0 - 5.0E-12; |
|
VAR |
|
Realp: PROCEDURE (x: LONGREAL; width: INTEGER); |
Realp: PROCEDURE (x: REAL; width: INTEGER); |
|
PROCEDURE Char*(c: CHAR); |
BEGIN |
67,7 → 67,7 |
UNTIL i = 0 |
END WriteInt; |
|
PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN; |
PROCEDURE IsNan(AValue: REAL): BOOLEAN; |
VAR h, l: SET; |
BEGIN |
sys.GET(sys.ADR(AValue), l); |
75,8 → 75,8 |
RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) |
END IsNan; |
|
PROCEDURE IsInf(x: LONGREAL): BOOLEAN; |
RETURN ABS(x) = sys.INF(LONGREAL) |
PROCEDURE IsInf(x: REAL): BOOLEAN; |
RETURN ABS(x) = sys.INF() |
END IsInf; |
|
PROCEDURE Int*(x, width: INTEGER); |
92,15 → 92,15 |
END |
END Int; |
|
PROCEDURE OutInf(x: LONGREAL; width: INTEGER); |
VAR s: ARRAY 4 OF CHAR; i: INTEGER; |
PROCEDURE OutInf(x: REAL; width: INTEGER); |
VAR s: ARRAY 5 OF CHAR; i: INTEGER; |
BEGIN |
IF IsNan(x) THEN |
s := "Nan"; |
INC(width) |
ELSIF IsInf(x) & (x > 0.0D0) THEN |
ELSIF IsInf(x) & (x > 0.0) THEN |
s := "+Inf" |
ELSIF IsInf(x) & (x < 0.0D0) THEN |
ELSIF IsInf(x) & (x < 0.0) THEN |
s := "-Inf" |
END; |
FOR i := 1 TO width - 4 DO |
115,8 → 115,8 |
Char(0AX) |
END Ln; |
|
PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER); |
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN; |
PROCEDURE _FixReal(x: REAL; width, p: INTEGER); |
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; |
BEGIN |
IF IsNan(x) OR IsInf(x) THEN |
OutInf(x, width) |
125,19 → 125,19 |
ELSE |
len := 0; |
minus := FALSE; |
IF x < 0.0D0 THEN |
IF x < 0.0 THEN |
minus := TRUE; |
INC(len); |
x := ABS(x) |
END; |
e := 0; |
WHILE x >= 10.0D0 DO |
x := x / 10.0D0; |
WHILE x >= 10.0 DO |
x := x / 10.0; |
INC(e) |
END; |
IF e >= 0 THEN |
len := len + e + p + 1; |
IF x > 9.0D0 + d THEN |
IF x > 9.0 + d THEN |
INC(len) |
END; |
IF p > 0 THEN |
153,30 → 153,30 |
Char("-") |
END; |
y := x; |
WHILE (y < 1.0D0) & (y # 0.0D0) DO |
y := y * 10.0D0; |
WHILE (y < 1.0) & (y # 0.0) DO |
y := y * 10.0; |
DEC(e) |
END; |
IF e < 0 THEN |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
IF x - FLT(FLOOR(x)) > d THEN |
Char("1"); |
x := 0.0D0 |
x := 0.0 |
ELSE |
Char("0"); |
x := x * 10.0D0 |
x := x * 10.0 |
END |
ELSE |
WHILE e >= 0 DO |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
IF x > 9.0D0 THEN |
IF x - FLT(FLOOR(x)) > d THEN |
IF x > 9.0 THEN |
String("10") |
ELSE |
Char(CHR(FLOOR(x) + ORD("0") + 1)) |
END; |
x := 0.0D0 |
x := 0.0 |
ELSE |
Char(CHR(FLOOR(x) + ORD("0"))); |
x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 |
x := (x - FLT(FLOOR(x))) * 10.0 |
END; |
DEC(e) |
END |
185,12 → 185,12 |
Char(".") |
END; |
WHILE p > 0 DO |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
IF x - FLT(FLOOR(x)) > d THEN |
Char(CHR(FLOOR(x) + ORD("0") + 1)); |
x := 0.0D0 |
x := 0.0 |
ELSE |
Char(CHR(FLOOR(x) + ORD("0"))); |
x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 |
x := (x - FLT(FLOOR(x))) * 10.0 |
END; |
DEC(p) |
END |
197,7 → 197,7 |
END |
END _FixReal; |
|
PROCEDURE Real*(x: LONGREAL; width: INTEGER); |
PROCEDURE Real*(x: REAL; width: INTEGER); |
VAR e, n, i: INTEGER; minus: BOOLEAN; |
BEGIN |
IF IsNan(x) OR IsInf(x) THEN |
212,22 → 212,22 |
width := 9 |
END; |
width := width - 5; |
IF x < 0.0D0 THEN |
IF x < 0.0 THEN |
x := -x; |
minus := TRUE |
ELSE |
minus := FALSE |
END; |
WHILE x >= 10.0D0 DO |
x := x / 10.0D0; |
WHILE x >= 10.0 DO |
x := x / 10.0; |
INC(e) |
END; |
WHILE (x < 1.0D0) & (x # 0.0D0) DO |
x := x * 10.0D0; |
WHILE (x < 1.0) & (x # 0.0) DO |
x := x * 10.0; |
DEC(e) |
END; |
IF x > 9.0D0 + d THEN |
x := 1.0D0; |
IF x > 9.0 + d THEN |
x := 1.0; |
INC(e) |
END; |
FOR i := 1 TO n DO |
255,7 → 255,7 |
END |
END Real; |
|
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER); |
PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
BEGIN |
Realp := Real; |
_FixReal(x, width, p) |