WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/KolibriOS/Debug.ob07


(*
    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
    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 .
*)
 
MODULE Debug;
 
IMPORT KOSAPI, sys := SYSTEM;
 
CONST
 
  d = 1.0 - 5.0E-12;
 
VAR
 
  Realp: PROCEDURE (x: REAL; 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: REAL): 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: REAL): BOOLEAN;
  RETURN ABS(x) = sys.INF()
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: 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.0) THEN
    s := "+Inf"
  ELSIF IsInf(x) & (x < 0.0) 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: REAL; width, p: INTEGER);
VAR e, len, i: INTEGER; y: REAL; 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.0 THEN
      minus := TRUE;
      INC(len);
      x := ABS(x)
    END;
    e := 0;
    WHILE x >= 10.0 DO
      x := x / 10.0;
      INC(e)
    END;
    IF e >= 0 THEN
      len := len + e + p + 1;
      IF x > 9.0 + 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.0) & (y # 0.0) DO
      y := y * 10.0;
      DEC(e)
    END;
    IF e < 0 THEN
      IF x - FLT(FLOOR(x)) > d THEN
        Char("1");
        x := 0.0
      ELSE
        Char("0");
        x := x * 10.0
      END
    ELSE
      WHILE e >= 0 DO
        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.0
        ELSE
          Char(CHR(FLOOR(x) + ORD("0")));
          x := (x - FLT(FLOOR(x))) * 10.0
        END;
        DEC(e)
      END
    END;
    IF p > 0 THEN
      Char(".")
    END;
    WHILE p > 0 DO
      IF x - FLT(FLOOR(x)) > d THEN
        Char(CHR(FLOOR(x) + ORD("0") + 1));
        x := 0.0
      ELSE
        Char(CHR(FLOOR(x) + ORD("0")));
        x := (x - FLT(FLOOR(x))) * 10.0
      END;
      DEC(p)
    END
  END
END _FixReal;
 
PROCEDURE Real*(x: REAL; 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.0 THEN
      x := -x;
      minus := TRUE
    ELSE
      minus := FALSE
    END;
    WHILE x >= 10.0 DO
      x := x / 10.0;
      INC(e)
    END;
    WHILE (x < 1.0) & (x # 0.0) DO
      x := x * 10.0;
      DEC(e)
    END;
    IF x > 9.0 + d THEN
      x := 1.0;
      INC(e)
    END;
    FOR i := 1 TO n DO
      Char(" ")
    END;
    IF minus THEN
      x := -x
    END;
    Realp := Real;
    _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 FixReal*(x: REAL; width, p: INTEGER);
BEGIN
  Realp := Real;
  _FixReal(x, width, p)
END FixReal;
 
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.SADR(" ");
  info.rsrvd1 := 0;
  info.rsrvd2 := 0;
  info.fname := "/rd/1/develop/board";
  res := KOSAPI.sysfunc2(70, sys.ADR(info))
END Open;
 
END Debug.

Rev 7597	Rev 7696
1	(*	1	(*
2	Copyright 2016, 2018 Anton Krotov	2	Copyright 2016, 2018 Anton Krotov
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
7	(at your option) any later version.	7	(at your option) any later version.
8		8
9	This program is distributed in the hope that it will be useful,	9	This program is distributed in the hope that it will be useful,
10	but WITHOUT ANY WARRANTY; without even the implied warranty of	10	but WITHOUT ANY WARRANTY; without even the implied warranty of
11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the	11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12	GNU Lesser General Public License for more details.	12	GNU Lesser General Public License for more details.
13		13
14	You should have received a copy of the GNU Lesser General Public License	14	You should have received a copy of the GNU Lesser General Public License
15	along with this program. If not, see .	15	along with this program. If not, see .
16	*)	16	*)
17		17
18	MODULE Debug;	18	MODULE Debug;
19		19
20	IMPORT KOSAPI, sys := SYSTEM;	20	IMPORT KOSAPI, sys := SYSTEM;
21		21
22	CONST	22	CONST
23		23
24	d = 1.0 - 5.0E-12;	24	d = 1.0 - 5.0E-12;
25		25
26	VAR	26	VAR
27		27
28	Realp: PROCEDURE (x: REAL; width: INTEGER);	28	Realp: PROCEDURE (x: REAL; width: INTEGER);
29		29
30	PROCEDURE Char*(c: CHAR);	30	PROCEDURE Char*(c: CHAR);
31	VAR res: INTEGER;	31	VAR res: INTEGER;
32	BEGIN	32	BEGIN
33	res := KOSAPI.sysfunc3(63, 1, ORD(c))	33	res := KOSAPI.sysfunc3(63, 1, ORD(c))
34	END Char;	34	END Char;
35		35
36	PROCEDURE String*(s: ARRAY OF CHAR);	36	PROCEDURE String*(s: ARRAY OF CHAR);
37	VAR n, i: INTEGER;	37	VAR n, i: INTEGER;
38	BEGIN	38	BEGIN
39	n := LENGTH(s);	39	n := LENGTH(s);
40	FOR i := 0 TO n - 1 DO	40	FOR i := 0 TO n - 1 DO
41	Char(s[i])	41	Char(s[i])
42	END	42	END
43	END String;	43	END String;
44		44
45	PROCEDURE WriteInt(x, n: INTEGER);	45	PROCEDURE WriteInt(x, n: INTEGER);
46	VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;	46	VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
47	BEGIN	47	BEGIN
48	i := 0;	48	i := 0;
49	IF n < 1 THEN	49	IF n < 1 THEN
50	n := 1	50	n := 1
51	END;	51	END;
52	IF x < 0 THEN	52	IF x < 0 THEN
53	x := -x;	53	x := -x;
54	DEC(n);	54	DEC(n);
55	neg := TRUE	55	neg := TRUE
56	END;	56	END;
57	REPEAT	57	REPEAT
58	a[i] := CHR(x MOD 10 + ORD("0"));	58	a[i] := CHR(x MOD 10 + ORD("0"));
59	x := x DIV 10;	59	x := x DIV 10;
60	INC(i)	60	INC(i)
61	UNTIL x = 0;	61	UNTIL x = 0;
62	WHILE n > i DO	62	WHILE n > i DO
63	Char(" ");	63	Char(" ");
64	DEC(n)	64	DEC(n)
65	END;	65	END;
66	IF neg THEN	66	IF neg THEN
67	Char("-")	67	Char("-")
68	END;	68	END;
69	REPEAT	69	REPEAT
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;
74		74
75	PROCEDURE IsNan(AValue: REAL): 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} # {}))
81	END IsNan;	81	END IsNan;
82		82
83	PROCEDURE IsInf(x: REAL): BOOLEAN;	83	PROCEDURE IsInf(x: REAL): BOOLEAN;
84	RETURN ABS(x) = sys.INF()	84	RETURN ABS(x) = sys.INF()
85	END IsInf;	85	END IsInf;
86		86
87	PROCEDURE Int*(x, width: INTEGER);	87	PROCEDURE Int*(x, width: INTEGER);
88	VAR i: INTEGER;	88	VAR i: INTEGER;
89	BEGIN	89	BEGIN
90	IF x # 80000000H THEN	90	IF x # 80000000H THEN
91	WriteInt(x, width)	91	WriteInt(x, width)
92	ELSE	92	ELSE
93	FOR i := 12 TO width DO	93	FOR i := 12 TO width DO
94	Char(20X)	94	Char(20X)
95	END;	95	END;
96	String("-2147483648")	96	String("-2147483648")
97	END	97	END
98	END Int;	98	END Int;
99		99
100	PROCEDURE OutInf(x: REAL; width: INTEGER);	100	PROCEDURE OutInf(x: REAL; width: INTEGER);
101	VAR s: ARRAY 5 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.0) THEN	106	ELSIF IsInf(x) & (x > 0.0) THEN
107	s := "+Inf"	107	s := "+Inf"
108	ELSIF IsInf(x) & (x < 0.0) 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(" ")
113	END;	113	END;
114	String(s)	114	String(s)
115	END OutInf;	115	END OutInf;
116		116
117	PROCEDURE Ln*;	117	PROCEDURE Ln*;
118	BEGIN	118	BEGIN
119	Char(0DX);	119	Char(0DX);
120	Char(0AX)	120	Char(0AX)
121	END Ln;	121	END Ln;
122		122
123	PROCEDURE _FixReal(x: REAL; width, p: INTEGER);	123	PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
124	VAR e, len, i: INTEGER; y: REAL; 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.0 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.0 DO	139	WHILE x >= 10.0 DO
140	x := x / 10.0;	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.0 + 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)
150	END	150	END
151	ELSE	151	ELSE
152	len := len + p + 2	152	len := len + p + 2
153	END;	153	END;
154	FOR i := 1 TO width - len DO	154	FOR i := 1 TO width - len DO
155	Char(" ")	155	Char(" ")
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.0) & (y # 0.0) DO	161	WHILE (y < 1.0) & (y # 0.0) DO
162	y := y * 10.0;	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 - FLT(FLOOR(x)) > d THEN	166	IF x - FLT(FLOOR(x)) > d THEN
167	Char("1");	167	Char("1");
168	x := 0.0	168	x := 0.0
169	ELSE	169	ELSE
170	Char("0");	170	Char("0");
171	x := x * 10.0	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 - FLT(FLOOR(x)) > d THEN	175	IF x - FLT(FLOOR(x)) > d THEN
176	IF x > 9.0 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.0	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 - FLT(FLOOR(x))) * 10.0	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 - 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.0	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 - FLT(FLOOR(x))) * 10.0	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;
204		204
205	PROCEDURE Real*(x: REAL; 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)
210	ELSE	210	ELSE
211	e := 0;	211	e := 0;
212	n := 0;	212	n := 0;
213	IF width > 23 THEN	213	IF width > 23 THEN
214	n := width - 23;	214	n := width - 23;
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.0 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.0 DO	226	WHILE x >= 10.0 DO
227	x := x / 10.0;	227	x := x / 10.0;
228	INC(e)	228	INC(e)
229	END;	229	END;
230	WHILE (x < 1.0) & (x # 0.0) DO	230	WHILE (x < 1.0) & (x # 0.0) DO
231	x := x * 10.0;	231	x := x * 10.0;
232	DEC(e)	232	DEC(e)
233	END;	233	END;
234	IF x > 9.0 + d THEN	234	IF x > 9.0 + d THEN
235	x := 1.0;	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;
241	IF minus THEN	241	IF minus THEN
242	x := -x	242	x := -x
243	END;	243	END;
244	Realp := Real;	244	Realp := Real;
245	_FixReal(x, width, width - 3);	245	_FixReal(x, width, width - 3);
246	Char("E");	246	Char("E");
247	IF e >= 0 THEN	247	IF e >= 0 THEN
248	Char("+")	248	Char("+")
249	ELSE	249	ELSE
250	Char("-");	250	Char("-");
251	e := ABS(e)	251	e := ABS(e)
252	END;	252	END;
253	IF e < 100 THEN	253	IF e < 100 THEN
254	Char("0")	254	Char("0")
255	END;	255	END;
256	IF e < 10 THEN	256	IF e < 10 THEN
257	Char("0")	257	Char("0")
258	END;	258	END;
259	Int(e, 0)	259	Int(e, 0)
260	END	260	END
261	END Real;	261	END Real;
262		262
263	PROCEDURE FixReal*(x: REAL; 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)
267	END FixReal;	267	END FixReal;
268		268
269	PROCEDURE Open*;	269	PROCEDURE Open*;
270	TYPE	270	TYPE
271		271
272	info_struct = RECORD	272	info_struct = RECORD
273	subfunc: INTEGER;	273	subfunc: INTEGER;
274	flags: INTEGER;	274	flags: INTEGER;
275	param: INTEGER;	275	param: INTEGER;
276	rsrvd1: INTEGER;	276	rsrvd1: INTEGER;
277	rsrvd2: INTEGER;	277	rsrvd2: INTEGER;
278	fname: ARRAY 1024 OF CHAR	278	fname: ARRAY 1024 OF CHAR
279	END;	279	END;
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.SADR(" ");	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))
290	END Open;	290	END Open;
291		291
292	END Debug.	292	END Debug.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 – Rev 7597 → 7696