WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/Linux32/RTL.ob07


﻿(*
    Copyright 2016, 2017 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 RTL;
 
IMPORT sys := SYSTEM, API;
 
TYPE
 
  IntArray = ARRAY 2048 OF INTEGER;
  STRING = ARRAY 2048 OF CHAR;
  PROC = PROCEDURE;
 
VAR
 
  SelfName, rtab: INTEGER; CloseProc: PROC;
  init: BOOLEAN;
 
PROCEDURE [stdcall] _halt*(n: INTEGER);
BEGIN
  API.ExitProcess(n)
END _halt;
 
PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER);
BEGIN
  ptr := API._NEW(size);
  IF ptr # 0 THEN
    sys.PUT(ptr, t);
    INC(ptr, 4)
  END
END _newrec;
 
PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER);
BEGIN
  IF ptr # 0 THEN
    ptr := API._DISPOSE(ptr - 4)
  END
END _disprec;
 
PROCEDURE [stdcall] _rset*(y, x: INTEGER);
BEGIN
  sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800")
END _rset;
 
PROCEDURE [stdcall] _inset*(y, x: INTEGER);
BEGIN
  sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800")
END _inset;
 
PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER);
BEGIN
  table := rtab;
  sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00")
END _checktype;
 
PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER);
BEGIN
  sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D")
END _savearr;
 
PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN;
VAR res: BOOLEAN;
BEGIN
  res := dyn = stat;
  IF res THEN
    _savearr(size, source, dest)
  END
  RETURN res
END _saverec;
 
PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER);
VAR i, m: INTEGER;
BEGIN
  m := bsize * idx;
  FOR i := 4 TO Dim + 2 DO
    m := m * Arr[i]
  END;
  IF (Arr[3] > idx) & (idx >= 0) THEN
    Arr[3] := c + m
  ELSE
    Arr[3] := 0
  END
END _arrayidx;
 
PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER);
BEGIN
  IF (Arr[3] > idx) & (idx >= 0) THEN
    Arr[3] := bsize * idx + c
  ELSE
    Arr[3] := 0
  END
END _arrayidx1;
 
PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray);
VAR i, j, t: INTEGER;
BEGIN
  FOR i := 1 TO n DO
    t := Arr[0];
    FOR j := 0 TO m + n - 1 DO
      Arr[j] := Arr[j + 1]
    END;
    Arr[m + n] := t
  END
END _arrayrot;
 
 
 
 
 
 
 
 
 
PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
BEGIN
  sys.CODE("8B4508");     //  mov     eax, [ebp + 08h]
  sys.CODE("8B4D0C");     //  mov     ecx, [ebp + 0Ch]
  sys.CODE("48");         //  dec     eax
                          //  L1:
  sys.CODE("40");         //  inc     eax
  sys.CODE("803800");     //  cmp     byte ptr [eax], 0
  sys.CODE("7403");       //  jz      L2
  sys.CODE("E2F8");       //  loop    L1
  sys.CODE("40");         //  inc     eax
                          //  L2:
  sys.CODE("2B4508");     //  sub     eax, [ebp + 08h]
  sys.CODE("C9");         //  leave
  sys.CODE("C20800");     //  ret     08h
  RETURN 0
END _length;
 
PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
BEGIN
  _savearr(MIN(alen, blen), a, b);
  IF blen > alen THEN
    sys.PUT(b + alen, 0X)
  END
END _strcopy;
 
PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER; Res: BOOLEAN;
BEGIN
  i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
  IF i = 0 THEN
    i := _length(a) - _length(b)
  END;
  CASE op OF
  |0: Res := i = 0
  |1: Res := i # 0
  |2: Res := i < 0
  |3: Res := i > 0
  |4: Res := i <= 0
  |5: Res := i >= 0
  ELSE
  END
  RETURN Res
END _strcmp;
 
PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN;
VAR s: ARRAY 2 OF CHAR;
BEGIN
  s[0] := b;
  s[1] := 0X;
  RETURN _strcmp(op, s, a)
END _lstrcmp;
 
PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN;
VAR s: ARRAY 2 OF CHAR;
BEGIN
  s[0] := a;
  s[1] := 0X;
  RETURN _strcmp(op, b, s)
END _rstrcmp;
 
PROCEDURE Int(x: INTEGER; VAR str: STRING);
VAR i, a, b: INTEGER; c: CHAR;
BEGIN
  i := 0;
  a := 0;
  REPEAT
    str[i] := CHR(x MOD 10 + ORD("0"));
    x := x DIV 10;
    INC(i)
  UNTIL x = 0;
  b := i - 1;
  WHILE a < b DO
    c := str[a];
    str[a] := str[b];
    str[b] := c;
    INC(a);
    DEC(b)
  END;
  str[i] := 0X
END Int;
 
PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER);
VAR msg, int: STRING; pos, n: INTEGER;
 
  PROCEDURE StrAppend(s: STRING);
  VAR i, n: INTEGER;
  BEGIN
    n := LEN(s);
    i := 0;
    WHILE (i < n) & (s[i] # 0X) DO
      msg[pos] := s[i];
      INC(pos);
      INC(i)
    END
  END StrAppend;
 
BEGIN
  pos := 0;
  n := line MOD 16;
  line := line DIV 16;
  CASE n OF
  |1: StrAppend("assertion failure")
  |2: StrAppend("variable of a procedure type has NIL as value")
  |3: StrAppend("typeguard error")
  |4: StrAppend("inadmissible dynamic type")
  |5: StrAppend("index check error")
  |6: StrAppend("NIL pointer dereference")
  |7: StrAppend("invalid value in case statement")
  |8: StrAppend("division by zero")
  ELSE
  END;
  StrAppend(0DX);
  StrAppend(0AX);
  StrAppend("module ");
  StrAppend(modname);
  StrAppend(0DX);
  StrAppend(0AX);
  StrAppend("line ");
  Int(line, int);
  StrAppend(int);
  IF m = 2 THEN
    StrAppend(0DX);
    StrAppend(0AX);
    StrAppend("code ");
    Int(code, int);
    StrAppend(int)
  END;
  API.DebugMsg(sys.ADR(msg), SelfName);
  API.ExitThread(0)
END _assrt;
 
PROCEDURE [stdcall] _close*;
BEGIN
  IF CloseProc # NIL THEN
    CloseProc
  END
END _close;
 
PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
BEGIN
  IF ~init THEN
    API.zeromem(gsize, gadr);
    init := TRUE;
    API.init(esp);
    SelfName := self;
    rtab := rec;
    CloseProc := NIL
  END
END _init;
 
PROCEDURE SetClose*(proc: PROC);
BEGIN
  CloseProc := proc
END SetClose;
 
END RTL.

Rev 6613	Rev 7107
1	(*	1	(*
2	Copyright 2016 Anton Krotov	2	Copyright 2016, 2017 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 RTL;	18	MODULE RTL;
19		19
20	IMPORT sys := SYSTEM, API;	20	IMPORT sys := SYSTEM, API;
21		21
22	TYPE	22	TYPE
23		23
24	IntArray = ARRAY 2048 OF INTEGER;	24	IntArray = ARRAY 2048 OF INTEGER;
25	STRING = ARRAY 2048 OF CHAR;	25	STRING = ARRAY 2048 OF CHAR;
26	PROC = PROCEDURE;	26	PROC = PROCEDURE;
27		27
28	VAR	28	VAR
29		29
30	SelfName, rtab: INTEGER; CloseProc: PROC;	30	SelfName, rtab: INTEGER; CloseProc: PROC;
-		31	init: BOOLEAN;
31		32
32	PROCEDURE [stdcall] _halt*(n: INTEGER);	33	PROCEDURE [stdcall] _halt*(n: INTEGER);
33	BEGIN	34	BEGIN
34	API.ExitProcess(n)	35	API.ExitProcess(n)
35	END _halt;	36	END _halt;
36		37
37	PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER);	38	PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER);
38	BEGIN	39	BEGIN
39	ptr := API._NEW(size);	40	ptr := API._NEW(size);
40	IF ptr # 0 THEN	41	IF ptr # 0 THEN
41	sys.PUT(ptr, t);	42	sys.PUT(ptr, t);
42	INC(ptr, 4)	43	INC(ptr, 4)
43	END	44	END
44	END _newrec;	45	END _newrec;
45		46
46	PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER);	47	PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER);
47	BEGIN	48	BEGIN
48	IF ptr # 0 THEN	49	IF ptr # 0 THEN
49	ptr := API._DISPOSE(ptr - 4)	50	ptr := API._DISPOSE(ptr - 4)
50	END	51	END
51	END _disprec;	52	END _disprec;
52		53
53	PROCEDURE [stdcall] _rset*(y, x: INTEGER);	54	PROCEDURE [stdcall] _rset*(y, x: INTEGER);
54	BEGIN	55	BEGIN
55	sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800")	56	sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800")
56	END _rset;	57	END _rset;
57		58
58	PROCEDURE [stdcall] _inset*(y, x: INTEGER);	59	PROCEDURE [stdcall] _inset*(y, x: INTEGER);
59	BEGIN	60	BEGIN
60	sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800")	61	sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800")
61	END _inset;	62	END _inset;
62		63
63	PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER);	64	PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER);
64	BEGIN	65	BEGIN
65	table := rtab;	66	table := rtab;
66	sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00")	67	sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00")
67	END _checktype;	68	END _checktype;
68		69
69	PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER);	70	PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER);
70	BEGIN	71	BEGIN
71	sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D")	72	sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D")
72	END _savearr;	73	END _savearr;
73		74
74	PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN;	75	PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN;
75	VAR res: BOOLEAN;	76	VAR res: BOOLEAN;
76	BEGIN	77	BEGIN
77	res := dyn = stat;	78	res := dyn = stat;
78	IF res THEN	79	IF res THEN
79	_savearr(size, source, dest)	80	_savearr(size, source, dest)
80	END	81	END
81	RETURN res	82	RETURN res
82	END _saverec;	83	END _saverec;
83		84
84	PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER);	85	PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER);
85	VAR i, m: INTEGER;	86	VAR i, m: INTEGER;
86	BEGIN	87	BEGIN
87	m := bsize * idx;	88	m := bsize * idx;
88	FOR i := 4 TO Dim + 2 DO	89	FOR i := 4 TO Dim + 2 DO
89	m := m * Arr[i]	90	m := m * Arr[i]
90	END;	91	END;
91	IF (Arr[3] > idx) & (idx >= 0) THEN	92	IF (Arr[3] > idx) & (idx >= 0) THEN
92	Arr[3] := c + m	93	Arr[3] := c + m
93	ELSE	94	ELSE
94	Arr[3] := 0	95	Arr[3] := 0
95	END	96	END
96	END _arrayidx;	97	END _arrayidx;
97		98
98	PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER);	99	PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER);
99	BEGIN	100	BEGIN
100	IF (Arr[3] > idx) & (idx >= 0) THEN	101	IF (Arr[3] > idx) & (idx >= 0) THEN
101	Arr[3] := bsize * idx + c	102	Arr[3] := bsize * idx + c
102	ELSE	103	ELSE
103	Arr[3] := 0	104	Arr[3] := 0
104	END	105	END
105	END _arrayidx1;	106	END _arrayidx1;
106		107
107	PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray);	108	PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray);
108	VAR i, j, t: INTEGER;	109	VAR i, j, t: INTEGER;
109	BEGIN	110	BEGIN
110	FOR i := 1 TO n DO	111	FOR i := 1 TO n DO
111	t := Arr[0];	112	t := Arr[0];
112	FOR j := 0 TO m + n - 1 DO	113	FOR j := 0 TO m + n - 1 DO
113	Arr[j] := Arr[j + 1]	114	Arr[j] := Arr[j + 1]
114	END;	115	END;
115	Arr[m + n] := t	116	Arr[m + n] := t
116	END	117	END
117	END _arrayrot;	118	END _arrayrot;
118		-
119	PROCEDURE Min(a, b: INTEGER): INTEGER;	-
120	BEGIN	-
121	IF a > b THEN	-
122	a := b	-
123	END	-
124	RETURN a	-
125	END Min;	-
126		119
127	PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;	120	PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER;
128	BEGIN	121	BEGIN
129	sys.CODE("8B4508"); // mov eax, [ebp + 08h]	122	sys.CODE("8B4508"); // mov eax, [ebp + 08h]
130	sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch]	123	sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch]
131	sys.CODE("48"); // dec eax	124	sys.CODE("48"); // dec eax
132	// L1:	125	// L1:
133	sys.CODE("40"); // inc eax	126	sys.CODE("40"); // inc eax
134	sys.CODE("803800"); // cmp byte ptr [eax], 0	127	sys.CODE("803800"); // cmp byte ptr [eax], 0
135	sys.CODE("7403"); // jz L2	128	sys.CODE("7403"); // jz L2
136	sys.CODE("E2F8"); // loop L1	129	sys.CODE("E2F8"); // loop L1
137	sys.CODE("40"); // inc eax	130	sys.CODE("40"); // inc eax
138	// L2:	131	// L2:
139	sys.CODE("2B4508"); // sub eax, [ebp + 08h]	132	sys.CODE("2B4508"); // sub eax, [ebp + 08h]
140	sys.CODE("C9"); // leave	133	sys.CODE("C9"); // leave
141	sys.CODE("C20800"); // ret 08h	134	sys.CODE("C20800"); // ret 08h
142	RETURN 0	135	RETURN 0
143	END _length;	136	END _length;
144		137
145	PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);	138	PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER);
146	BEGIN	139	BEGIN
147	_savearr(Min(alen, blen), a, b);	140	_savearr(MIN(alen, blen), a, b);
148	IF blen > alen THEN	141	IF blen > alen THEN
149	sys.PUT(b + alen, 0X)	142	sys.PUT(b + alen, 0X)
150	END	143	END
151	END _strcopy;	144	END _strcopy;
152		145
153	PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;	146	PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN;
154	VAR i: INTEGER; Res: BOOLEAN;	147	VAR i: INTEGER; Res: BOOLEAN;
155	BEGIN	148	BEGIN
156	i := API.strncmp(sys.ADR(a), sys.ADR(b), Min(LEN(a), LEN(b)));	149	i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b)));
157	IF i = 0 THEN	150	IF i = 0 THEN
158	i := _length(a) - _length(b)	151	i := _length(a) - _length(b)
159	END;	152	END;
160	CASE op OF	153	CASE op OF
161	\|0: Res := i = 0	154	\|0: Res := i = 0
162	\|1: Res := i # 0	155	\|1: Res := i # 0
163	\|2: Res := i < 0	156	\|2: Res := i < 0
164	\|3: Res := i > 0	157	\|3: Res := i > 0
165	\|4: Res := i <= 0	158	\|4: Res := i <= 0
166	\|5: Res := i >= 0	159	\|5: Res := i >= 0
167	ELSE	160	ELSE
168	END	161	END
169	RETURN Res	162	RETURN Res
170	END _strcmp;	163	END _strcmp;
171		164
172	PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN;	165	PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN;
173	VAR s: ARRAY 2 OF CHAR;	166	VAR s: ARRAY 2 OF CHAR;
174	BEGIN	167	BEGIN
175	s[0] := b;	168	s[0] := b;
176	s[1] := 0X;	169	s[1] := 0X;
177	RETURN _strcmp(op, s, a)	170	RETURN _strcmp(op, s, a)
178	END _lstrcmp;	171	END _lstrcmp;
179		172
180	PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN;	173	PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN;
181	VAR s: ARRAY 2 OF CHAR;	174	VAR s: ARRAY 2 OF CHAR;
182	BEGIN	175	BEGIN
183	s[0] := a;	176	s[0] := a;
184	s[1] := 0X;	177	s[1] := 0X;
185	RETURN _strcmp(op, b, s)	178	RETURN _strcmp(op, b, s)
186	END _rstrcmp;	179	END _rstrcmp;
187		180
188	PROCEDURE Int(x: INTEGER; VAR str: STRING);	181	PROCEDURE Int(x: INTEGER; VAR str: STRING);
189	VAR i, a, b: INTEGER; c: CHAR;	182	VAR i, a, b: INTEGER; c: CHAR;
190	BEGIN	183	BEGIN
191	i := 0;	184	i := 0;
192	a := 0;	185	a := 0;
193	REPEAT	186	REPEAT
194	str[i] := CHR(x MOD 10 + ORD("0"));	187	str[i] := CHR(x MOD 10 + ORD("0"));
195	x := x DIV 10;	188	x := x DIV 10;
196	INC(i)	189	INC(i)
197	UNTIL x = 0;	190	UNTIL x = 0;
198	b := i - 1;	191	b := i - 1;
199	WHILE a < b DO	192	WHILE a < b DO
200	c := str[a];	193	c := str[a];
201	str[a] := str[b];	194	str[a] := str[b];
202	str[b] := c;	195	str[b] := c;
203	INC(a);	196	INC(a);
204	DEC(b)	197	DEC(b)
205	END;	198	END;
206	str[i] := 0X	199	str[i] := 0X
207	END Int;	200	END Int;
208		201
209	PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER);	202	PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER);
210	VAR msg, int: STRING; pos, n: INTEGER;	203	VAR msg, int: STRING; pos, n: INTEGER;
211		204
212	PROCEDURE StrAppend(s: STRING);	205	PROCEDURE StrAppend(s: STRING);
213	VAR i, n: INTEGER;	206	VAR i, n: INTEGER;
214	BEGIN	207	BEGIN
215	n := LEN(s);	208	n := LEN(s);
216	i := 0;	209	i := 0;
217	WHILE (i < n) & (s[i] # 0X) DO	210	WHILE (i < n) & (s[i] # 0X) DO
218	msg[pos] := s[i];	211	msg[pos] := s[i];
219	INC(pos);	212	INC(pos);
220	INC(i)	213	INC(i)
221	END	214	END
222	END StrAppend;	215	END StrAppend;
223		216
224	BEGIN	217	BEGIN
225	pos := 0;	218	pos := 0;
226	n := line MOD 16;	219	n := line MOD 16;
227	line := line DIV 16;	220	line := line DIV 16;
228	CASE n OF	221	CASE n OF
229	\|1: StrAppend("assertion failure")	222	\|1: StrAppend("assertion failure")
230	\|2: StrAppend("variable of a procedure type has NIL as value")	223	\|2: StrAppend("variable of a procedure type has NIL as value")
231	\|3: StrAppend("typeguard error")	224	\|3: StrAppend("typeguard error")
232	\|4: StrAppend("inadmissible dynamic type")	225	\|4: StrAppend("inadmissible dynamic type")
233	\|5: StrAppend("index check error")	226	\|5: StrAppend("index check error")
234	\|6: StrAppend("NIL pointer dereference")	227	\|6: StrAppend("NIL pointer dereference")
235	\|7: StrAppend("invalid value in case statement")	228	\|7: StrAppend("invalid value in case statement")
236	\|8: StrAppend("division by zero")	229	\|8: StrAppend("division by zero")
237	ELSE	230	ELSE
238	END;	231	END;
239	StrAppend(0DX);	232	StrAppend(0DX);
240	StrAppend(0AX);	233	StrAppend(0AX);
241	StrAppend("module ");	234	StrAppend("module ");
242	StrAppend(modname);	235	StrAppend(modname);
243	StrAppend(0DX);	236	StrAppend(0DX);
244	StrAppend(0AX);	237	StrAppend(0AX);
245	StrAppend("line ");	238	StrAppend("line ");
246	Int(line, int);	239	Int(line, int);
247	StrAppend(int);	240	StrAppend(int);
248	IF m = 2 THEN	241	IF m = 2 THEN
249	StrAppend(0DX);	242	StrAppend(0DX);
250	StrAppend(0AX);	243	StrAppend(0AX);
251	StrAppend("code ");	244	StrAppend("code ");
252	Int(code, int);	245	Int(code, int);
253	StrAppend(int)	246	StrAppend(int)
254	END;	247	END;
255	API.DebugMsg(sys.ADR(msg), SelfName)	248	API.DebugMsg(sys.ADR(msg), SelfName);
-		249	API.ExitThread(0)
256	END _assrt;	250	END _assrt;
257		251
258	PROCEDURE [stdcall] _close*;	252	PROCEDURE [stdcall] _close*;
259	BEGIN	253	BEGIN
260	IF CloseProc # NIL THEN	254	IF CloseProc # NIL THEN
261	CloseProc	255	CloseProc
262	END	256	END
263	END _close;	257	END _close;
264		258
265	PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);	259	PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER);
266	BEGIN	260	BEGIN
-		261	IF ~init THEN
267	API.zeromem(gsize, gadr);	262	API.zeromem(gsize, gadr);
-		263	init := TRUE;
268	API.init(esp);	264	API.init(esp);
269	SelfName := self;	265	SelfName := self;
270	rtab := rec;	266	rtab := rec;
271	CloseProc := NIL;	267	CloseProc := NIL
-		268	END
272	END _init;	269	END _init;
273		270
274	PROCEDURE SetClose*(proc: PROC);	271	PROCEDURE SetClose*(proc: PROC);
275	BEGIN	272	BEGIN
276	CloseProc := proc	273	CloseProc := proc
277	END SetClose;	274	END SetClose;
278		275
279	END RTL.	276	END RTL.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/Linux32/RTL.ob07 – Rev 6613 → 7107