0,0 → 1,287 |
(* |
Copyright 2016 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 |
the Free Software Foundation, either version 3 of the License, or |
(at your option) any later version. |
|
This program is distributed in the hope that it will be useful, |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
GNU Lesser General Public License for more details. |
|
You should have received a copy of the GNU Lesser General Public License |
along with this program. If not, see <http://www.gnu.org/licenses/>. |
*) |
|
MODULE Debug; |
|
IMPORT KOSAPI, sys := SYSTEM; |
|
CONST |
|
d = 1.0D0 - 5.0D-12; |
|
VAR |
|
Realp: PROCEDURE (x: LONGREAL; width: INTEGER); |
|
PROCEDURE Char*(c: CHAR); |
VAR res: INTEGER; |
BEGIN |
res := KOSAPI.sysfunc3(63, 1, ORD(c)) |
END Char; |
|
PROCEDURE String*(s: ARRAY OF CHAR); |
VAR n, i: INTEGER; |
BEGIN |
n := LENGTH(s); |
FOR i := 0 TO n - 1 DO |
Char(s[i]) |
END |
END String; |
|
PROCEDURE WriteInt(x, n: INTEGER); |
VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN; |
BEGIN |
i := 0; |
IF n < 1 THEN |
n := 1 |
END; |
IF x < 0 THEN |
x := -x; |
DEC(n); |
neg := TRUE |
END; |
REPEAT |
a[i] := CHR(x MOD 10 + ORD("0")); |
x := x DIV 10; |
INC(i) |
UNTIL x = 0; |
WHILE n > i DO |
Char(" "); |
DEC(n) |
END; |
IF neg THEN |
Char("-") |
END; |
REPEAT |
DEC(i); |
Char(a[i]) |
UNTIL i = 0 |
END WriteInt; |
|
PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN; |
VAR h, l: SET; |
BEGIN |
sys.GET(sys.ADR(AValue), l); |
sys.GET(sys.ADR(AValue) + 4, h) |
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) |
END IsInf; |
|
PROCEDURE Int*(x, width: INTEGER); |
VAR i: INTEGER; |
BEGIN |
IF x # 80000000H THEN |
WriteInt(x, width) |
ELSE |
FOR i := 12 TO width DO |
Char(20X) |
END; |
String("-2147483648") |
END |
END Int; |
|
PROCEDURE OutInf(x: LONGREAL; width: INTEGER); |
VAR s: ARRAY 4 OF CHAR; i: INTEGER; |
BEGIN |
IF IsNan(x) THEN |
s := "Nan"; |
INC(width) |
ELSIF IsInf(x) & (x > 0.0D0) THEN |
s := "+Inf" |
ELSIF IsInf(x) & (x < 0.0D0) THEN |
s := "-Inf" |
END; |
FOR i := 1 TO width - 4 DO |
Char(" ") |
END; |
String(s) |
END OutInf; |
|
PROCEDURE Ln*; |
BEGIN |
Char(0DX); |
Char(0AX) |
END Ln; |
|
PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER); |
VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN; |
BEGIN |
IF IsNan(x) OR IsInf(x) THEN |
OutInf(x, width) |
ELSIF p < 0 THEN |
Realp(x, width) |
ELSE |
len := 0; |
minus := FALSE; |
IF x < 0.0D0 THEN |
minus := TRUE; |
INC(len); |
x := ABS(x) |
END; |
e := 0; |
WHILE x >= 10.0D0 DO |
x := x / 10.0D0; |
INC(e) |
END; |
IF e >= 0 THEN |
len := len + e + p + 1; |
IF x > 9.0D0 + d THEN |
INC(len) |
END; |
IF p > 0 THEN |
INC(len) |
END |
ELSE |
len := len + p + 2 |
END; |
FOR i := 1 TO width - len DO |
Char(" ") |
END; |
IF minus THEN |
Char("-") |
END; |
y := x; |
WHILE (y < 1.0D0) & (y # 0.0D0) DO |
y := y * 10.0D0; |
DEC(e) |
END; |
IF e < 0 THEN |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
Char("1"); |
x := 0.0D0 |
ELSE |
Char("0"); |
x := x * 10.0D0 |
END |
ELSE |
WHILE e >= 0 DO |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
IF x > 9.0D0 THEN |
String("10") |
ELSE |
Char(CHR(FLOOR(x) + ORD("0") + 1)) |
END; |
x := 0.0D0 |
ELSE |
Char(CHR(FLOOR(x) + ORD("0"))); |
x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 |
END; |
DEC(e) |
END |
END; |
IF p > 0 THEN |
Char(".") |
END; |
WHILE p > 0 DO |
IF x - LONG(FLT(FLOOR(x))) > d THEN |
Char(CHR(FLOOR(x) + ORD("0") + 1)); |
x := 0.0D0 |
ELSE |
Char(CHR(FLOOR(x) + ORD("0"))); |
x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 |
END; |
DEC(p) |
END |
END |
END FixReal; |
|
PROCEDURE Real*(x: LONGREAL; width: INTEGER); |
VAR e, n, i: INTEGER; minus: BOOLEAN; |
BEGIN |
IF IsNan(x) OR IsInf(x) THEN |
OutInf(x, width) |
ELSE |
e := 0; |
n := 0; |
IF width > 23 THEN |
n := width - 23; |
width := 23 |
ELSIF width < 9 THEN |
width := 9 |
END; |
width := width - 5; |
IF x < 0.0D0 THEN |
x := -x; |
minus := TRUE |
ELSE |
minus := FALSE |
END; |
WHILE x >= 10.0D0 DO |
x := x / 10.0D0; |
INC(e) |
END; |
WHILE (x < 1.0D0) & (x # 0.0D0) DO |
x := x * 10.0D0; |
DEC(e) |
END; |
IF x > 9.0D0 + d THEN |
x := 1.0D0; |
INC(e) |
END; |
FOR i := 1 TO n DO |
Char(" ") |
END; |
IF minus THEN |
x := -x |
END; |
FixReal(x, width, width - 3); |
Char("E"); |
IF e >= 0 THEN |
Char("+") |
ELSE |
Char("-"); |
e := ABS(e) |
END; |
IF e < 100 THEN |
Char("0") |
END; |
IF e < 10 THEN |
Char("0") |
END; |
Int(e, 0) |
END |
END Real; |
|
PROCEDURE Open*; |
TYPE |
|
info_struct = RECORD |
subfunc: INTEGER; |
flags: INTEGER; |
param: INTEGER; |
rsrvd1: INTEGER; |
rsrvd2: INTEGER; |
fname: ARRAY 1024 OF CHAR |
END; |
|
VAR info: info_struct; res: INTEGER; |
BEGIN |
info.subfunc := 7; |
info.flags := 0; |
info.param := sys.ADR(" "); |
info.rsrvd1 := 0; |
info.rsrvd2 := 0; |
info.fname := "/rd/1/develop/board"; |
res := KOSAPI.sysfunc2(70, sys.ADR(info)) |
END Open; |
|
BEGIN |
Realp := Real |
END Debug. |