diff --git a/programs/develop/cedit/CEDIT b/programs/develop/cedit/CEDIT
index 04e92a5b0..3b4f16b51 100644
Binary files a/programs/develop/cedit/CEDIT and b/programs/develop/cedit/CEDIT differ
diff --git a/programs/develop/cedit/SRC/CEdit.ob07 b/programs/develop/cedit/SRC/CEdit.ob07
index 68478635f..6e007d379 100644
--- a/programs/develop/cedit/SRC/CEdit.ob07
+++ b/programs/develop/cedit/SRC/CEdit.ob07
@@ -28,7 +28,7 @@ IMPORT
RW, Ini, box_lib, Icons;
CONST
- header = "CEdit (14-jun-2021)";
+ header = "CEdit (15-jun-2021)";
ShellFilter = "";
EditFilter = "SH|ASM|TXT|INC|OB07|C|CPP|H|PAS|PP|LUA|INI";
@@ -78,15 +78,16 @@ CONST
btnTop = MainMenuHeight + 3;
toolBtnSize = 24;
toolbarDelim = 7;
+ iconPad = (toolBtnSize - Icons.SIZE) DIV 2;
TOP = btnTop + toolBtnSize + 7;
RIGHT = scrollWidth - 2;
- BOTTOM = scrollWidth + 25;
+ BOTTOM = scrollWidth + 18;
minWinWidth = 635; minWinHeight = 542;
SEARCH_PADDING = 10;
- searchLeft = 10;
+ searchLeft = 0;
EditBox_Width = 180;
EDITBOX_MAXCHARS = 500;
@@ -270,8 +271,6 @@ END Replaced;
PROCEDURE toolbarIcons;
-CONST
- iconPad = (toolBtnSize - Icons.SIZE) DIV 2;
VAR
x, color: INTEGER;
BEGIN
@@ -329,7 +328,7 @@ END toolbarIcons;
PROCEDURE WriteModified (x, y: INTEGER);
BEGIN
modified := text.modified;
- K.DrawRect(x, TOP + canvas.height + scrollWidth - 1, 9*fontWidth, BOTTOM - scrollWidth + 1, K.winColor);
+ K.DrawRect(x, TOP + canvas.height + scrollWidth - 1, 8*fontWidth, BOTTOM - scrollWidth + 1, K.winColor);
IF modified THEN
K.DrawText866(x, y, K.textColor, "modified")
END
@@ -353,7 +352,7 @@ BEGIN
WritePos(y);
IF modified # text.modified THEN
- WriteModified(width - 9*fontWidth, y)
+ WriteModified(width - 8*fontWidth, y)
END;
T.getScroll(text, scrollX, scrollY);
@@ -445,8 +444,6 @@ END SearchPanel;
PROCEDURE draw_window;
-CONST
- iconPad = (toolBtnSize - Icons.SIZE) DIV 2;
VAR
width, height, x, y: INTEGER;
@@ -527,13 +524,13 @@ BEGIN
INC(x, toolBtnSize + 5 + toolbarDelim);
drawToolbarBtn(btnBuild, x);
- Icons.draw(icons, 54, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
drawToolbarBtn(btnRun, x);
- Icons.draw(icons, 53, x + iconPad, btnTop + iconPad);
INC(x, toolBtnSize + 5);
+ toolbarIcons;
+
K.CreateButton(btnUp, LEFT + canvas.width - 1, TOP, scrollWidth - 1, scrollWidth, K.btnColor, 0X);
K.DrawText69(LEFT + canvas.width - 1 + (scrollWidth - 6) DIV 2, TOP + (scrollWidth - 9) DIV 2, K.btnTextColor, 18X);
K.CreateButton(btnDown, LEFT + canvas.width - 1, TOP + canvas.height - scrollWidth - 1, scrollWidth - 1, scrollWidth, K.btnColor, 0X);
@@ -549,19 +546,19 @@ BEGIN
y := (btnHeight - fontHeight) DIV 2 + btnTop;
CASE text.enc OF
- |E.UTF8: K.DrawText866(width - 6*fontWidth, y, K.textColor, "UTF-8")
- |E.UTF8BOM: K.DrawText866(width - 10*fontWidth, y, K.textColor, "UTF-8-BOM")
- |E.CP866: K.DrawText866(width - 6*fontWidth, y, K.textColor, "CP866")
- |E.W1251: K.DrawText866(width - 13*fontWidth, y, K.textColor, "Windows-1251")
+ |E.UTF8: K.DrawText866(width - 5*fontWidth, y, K.textColor, "UTF-8")
+ |E.UTF8BOM: K.DrawText866(width - 9*fontWidth, y, K.textColor, "UTF-8-BOM")
+ |E.CP866: K.DrawText866(width - 5*fontWidth, y, K.textColor, "CP866")
+ |E.W1251: K.DrawText866(width - 12*fontWidth, y, K.textColor, "Windows-1251")
END;
IF search THEN
SearchPanel(searchLeft, TOP)
END;
y := height - (BOTTOM - scrollWidth) + (BOTTOM - scrollWidth - 16) DIV 2;
- K.DrawRect(LEFT + 16*fontWidth, TOP + canvas.height + scrollWidth - 1, width - LEFT - 25*fontWidth, BOTTOM - scrollWidth + 1, K.winColor);
+ K.DrawRect(LEFT + 16*fontWidth, TOP + canvas.height + scrollWidth - 1, width - LEFT - 24*fontWidth, BOTTOM - scrollWidth + 1, K.winColor);
K.DrawText866(LEFT + 16*fontWidth, y, K.textColor, text.fileName);
- WriteModified(width - 9*fontWidth, y);
+ WriteModified(width - 8*fontWidth, y);
repaint
END;
K.EndDraw
@@ -753,7 +750,7 @@ PROCEDURE Search;
BEGIN
search := ~search;
IF search THEN
- LEFT := searchLeft + EditBox_Width + SEARCH_PADDING*3;
+ LEFT := searchLeft + EditBox_Width + SEARCH_PADDING*2 + 5;
IF T.search(text, searchText, cs, whole) THEN END
ELSE
LEFT := searchLeft;
@@ -1245,7 +1242,7 @@ BEGIN
winHeight := MAX(winHeight, minWinHeight);
cliWidth := winWidth;
cliHeight := winHeight;
- LEFT := 10;
+ LEFT := searchLeft;
canvas := G.CreateCanvas(winWidth - (LEFT + RIGHT + 10), winHeight - (TOP + BOTTOM + 4) - K.SkinHeight());
font1 := G.CreateFont(1, "", {});
font2 := G.CreateFont(2, "", {});
diff --git a/programs/develop/cedit/SRC/Icons.ob07 b/programs/develop/cedit/SRC/Icons.ob07
new file mode 100644
index 000000000..5fd2f5b3d
--- /dev/null
+++ b/programs/develop/cedit/SRC/Icons.ob07
@@ -0,0 +1,127 @@
+(*
+ Copyright 2021 Anton Krotov
+
+ This file is part of CEdit.
+
+ CEdit is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ CEdit 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 General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with CEdit. If not, see .
+*)
+
+MODULE Icons;
+
+IMPORT
+ LibImg, K := KolibriOS, SYSTEM;
+
+CONST
+ fileName = "/rd/1/Icons16.png";
+ SIZE* = 18;
+
+VAR
+ source: INTEGER;
+
+
+PROCEDURE copy (src, dst: INTEGER);
+VAR
+ src_sizeX, src_sizeY, dst_sizeX, dst_sizeY,
+ src_data, dst_data: INTEGER;
+BEGIN
+ LibImg.GetInf(src, src_sizeX, src_sizeY, src_data);
+ LibImg.GetInf(dst, dst_sizeX, dst_sizeY, dst_data);
+ ASSERT(src_sizeX = dst_sizeX);
+ ASSERT(src_sizeY = dst_sizeY);
+ SYSTEM.MOVE(src_data, dst_data, src_sizeX*src_sizeY*3)
+END copy;
+
+
+PROCEDURE load (): INTEGER;
+VAR
+ y: INTEGER;
+BEGIN
+ RETURN LibImg.LoadFromFile(fileName, SIZE, y)
+END load;
+
+
+PROCEDURE draw* (icons, n, x, y: INTEGER);
+VAR
+ sizeX, sizeY, data: INTEGER;
+BEGIN
+ LibImg.GetInf(icons, sizeX, sizeY, data);
+ K.DrawImage(data + SIZE*SIZE*3*n, SIZE, SIZE, x, y)
+END draw;
+
+
+PROCEDURE gray (icons: INTEGER);
+VAR
+ sizeX, sizeY, data, x, y: INTEGER;
+ b, g, r, gr: BYTE;
+BEGIN
+ LibImg.GetInf(icons, sizeX, sizeY, data);
+ FOR y := 0 TO sizeY - 1 DO
+ FOR x := 0 TO sizeX - 1 DO
+ SYSTEM.GET8(data, b);
+ SYSTEM.GET8(data + 1, g);
+ SYSTEM.GET8(data + 2, r);
+ gr := (r + g + b) DIV 3;
+ SYSTEM.PUT8(data, gr);
+ SYSTEM.PUT8(data + 1, gr);
+ SYSTEM.PUT8(data + 2, gr);
+ INC(data, 3);
+ END
+ END
+END gray;
+
+
+PROCEDURE iconsBackColor (icons: INTEGER);
+VAR
+ sizeX, sizeY, data, x, y: INTEGER;
+ b, g, r: BYTE;
+BEGIN
+ LibImg.GetInf(icons, sizeX, sizeY, data);
+ FOR y := 0 TO sizeY - 1 DO
+ FOR x := 0 TO sizeX - 1 DO
+ SYSTEM.GET8(data, b);
+ SYSTEM.GET8(data + 1, g);
+ SYSTEM.GET8(data + 2, r);
+ IF b + g + r = 765 THEN
+ b := K.toolbarColor MOD 256;
+ g := K.toolbarColor DIV 256 MOD 256;
+ r := K.toolbarColor DIV 65536 MOD 256
+ END;
+ SYSTEM.PUT8(data, b);
+ SYSTEM.PUT8(data + 1, g);
+ SYSTEM.PUT8(data + 2, r);
+ INC(data, 3);
+ END
+ END
+END iconsBackColor;
+
+
+PROCEDURE get* (VAR icons, grayIcons: INTEGER);
+BEGIN
+ IF source = 0 THEN
+ source := load();
+ icons := load();
+ grayIcons := load()
+ ELSE
+ copy(source, icons);
+ copy(source, grayIcons)
+ END;
+ gray(grayIcons);
+ iconsBackColor(icons);
+ iconsBackColor(grayIcons)
+END get;
+
+
+BEGIN
+ source := 0
+END Icons.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Compiler b/programs/develop/oberon07/Compiler
index b3bd70e60..a36067d15 100644
Binary files a/programs/develop/oberon07/Compiler and b/programs/develop/oberon07/Compiler differ
diff --git a/programs/develop/oberon07/Compiler.exe b/programs/develop/oberon07/Compiler.exe
index 5eb85f7c3..7a7530d0e 100644
Binary files a/programs/develop/oberon07/Compiler.exe and b/programs/develop/oberon07/Compiler.exe differ
diff --git a/programs/develop/oberon07/LICENSE b/programs/develop/oberon07/LICENSE
index e56a7ff74..7fd6e69d3 100644
--- a/programs/develop/oberon07/LICENSE
+++ b/programs/develop/oberon07/LICENSE
@@ -1,6 +1,6 @@
BSD 2-Clause License
-Copyright (c) 2018-2020, Anton Krotov
+Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
Redistribution and use in source and binary forms, with or without
diff --git a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
deleted file mode 100644
index 5f9e16808..000000000
--- a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
+++ /dev/null
@@ -1,520 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE RTL;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- bit_depth* = 32;
- maxint* = 7FFFFFFFH;
- minint* = 80000000H;
-
- WORD = bit_depth DIV 8;
- MAX_SET = bit_depth - 1;
-
-
-VAR
-
- name: INTEGER;
- types: INTEGER;
-
-
-PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
- 085H, 0C0H, (* test eax, eax *)
- 07EH, 019H, (* jle L *)
- 0FCH, (* cld *)
- 057H, (* push edi *)
- 056H, (* push esi *)
- 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
- 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
- 089H, 0C1H, (* mov ecx, eax *)
- 0C1H, 0E9H, 002H, (* shr ecx, 2 *)
- 0F3H, 0A5H, (* rep movsd *)
- 089H, 0C1H, (* mov ecx, eax *)
- 083H, 0E1H, 003H, (* and ecx, 3 *)
- 0F3H, 0A4H, (* rep movsb *)
- 05EH, (* pop esi *)
- 05FH (* pop edi *)
- (* L: *)
- )
-END _move;
-
-
-PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
-
-BEGIN
- IF len_src > len_dst THEN
- res := FALSE
- ELSE
- _move(len_src * base_size, dst, src);
- res := TRUE
- END
-
- RETURN res
-END _arrcpy;
-
-
-PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
- _move(MIN(len_dst, len_src) * chr_size, dst, src)
-END _strcpy;
-
-
-PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
-VAR
- i, n, k: INTEGER;
-
-BEGIN
- k := LEN(A) - 1;
- n := A[0];
- i := 0;
- WHILE i < k DO
- A[i] := A[i + 1];
- INC(i)
- END;
- A[k] := n
-END _rot;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-BEGIN
- IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
- IF b > MAX_SET THEN
- b := MAX_SET
- END;
- IF a < 0 THEN
- a := 0
- END;
- a := LSR(ASR(minint, b - a), MAX_SET - b)
- ELSE
- a := 0
- END
-
- RETURN a
-END _set;
-
-
-PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
-BEGIN
- SYSTEM.CODE(
- 031H, 0C0H, (* xor eax, eax *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *)
- 083H, 0F9H, 01FH, (* cmp ecx, 31 *)
- 077H, 003H, (* ja L *)
- 00FH, 0ABH, 0C8H (* bts eax, ecx *)
- (* L: *)
- )
-END _set1;
-
-
-PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
-BEGIN
- SYSTEM.CODE(
- 053H, (* push ebx *)
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
- 031H, 0D2H, (* xor edx, edx *)
- 085H, 0C0H, (* test eax, eax *)
- 074H, 018H, (* je L2 *)
- 07FH, 002H, (* jg L1 *)
- 0F7H, 0D2H, (* not edx *)
- (* L1: *)
- 089H, 0C3H, (* mov ebx, eax *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
- 0F7H, 0F9H, (* idiv ecx *)
- 085H, 0D2H, (* test edx, edx *)
- 074H, 009H, (* je L2 *)
- 031H, 0CBH, (* xor ebx, ecx *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07DH, 003H, (* jge L2 *)
- 048H, (* dec eax *)
- 001H, 0CAH, (* add edx, ecx *)
- (* L2: *)
- 05BH (* pop ebx *)
- )
-END _divmod;
-
-
-PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
-BEGIN
- ptr := API._NEW(size);
- IF ptr # 0 THEN
- SYSTEM.PUT(ptr, t);
- INC(ptr, WORD)
- END
-END _new;
-
-
-PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
-BEGIN
- IF ptr # 0 THEN
- ptr := API._DISPOSE(ptr - WORD)
- END
-END _dispose;
-
-
-PROCEDURE [stdcall] _length* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
- 048H, (* dec eax *)
- (* L1: *)
- 040H, (* inc eax *)
- 080H, 038H, 000H, (* cmp byte [eax], 0 *)
- 074H, 003H, (* jz L2 *)
- 0E2H, 0F8H, (* loop L1 *)
- 040H, (* inc eax *)
- (* L2: *)
- 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
- )
-END _length;
-
-
-PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
- 048H, (* dec eax *)
- 048H, (* dec eax *)
- (* L1: *)
- 040H, (* inc eax *)
- 040H, (* inc eax *)
- 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
- 074H, 004H, (* jz L2 *)
- 0E2H, 0F6H, (* loop L1 *)
- 040H, (* inc eax *)
- 040H, (* inc eax *)
- (* L2: *)
- 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
- 0D1H, 0E8H (* shr eax, 1 *)
- )
-END _lengthw;
-
-
-PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 056H, (* push esi *)
- 057H, (* push edi *)
- 053H, (* push ebx *)
- 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
- 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
- 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
- 031H, 0C9H, (* xor ecx, ecx *)
- 031H, 0D2H, (* xor edx, edx *)
- 0B8H,
- 000H, 000H, 000H, 080H, (* mov eax, minint *)
- (* L1: *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07EH, 017H, (* jle L3 *)
- 08AH, 00EH, (* mov cl, byte[esi] *)
- 08AH, 017H, (* mov dl, byte[edi] *)
- 046H, (* inc esi *)
- 047H, (* inc edi *)
- 04BH, (* dec ebx *)
- 039H, 0D1H, (* cmp ecx, edx *)
- 074H, 006H, (* je L2 *)
- 089H, 0C8H, (* mov eax, ecx *)
- 029H, 0D0H, (* sub eax, edx *)
- 0EBH, 006H, (* jmp L3 *)
- (* L2: *)
- 085H, 0C9H, (* test ecx, ecx *)
- 075H, 0E7H, (* jne L1 *)
- 031H, 0C0H, (* xor eax, eax *)
- (* L3: *)
- 05BH, (* pop ebx *)
- 05FH, (* pop edi *)
- 05EH, (* pop esi *)
- 05DH, (* pop ebp *)
- 0C2H, 00CH, 000H (* ret 12 *)
- )
- RETURN 0
-END strncmp;
-
-
-PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 056H, (* push esi *)
- 057H, (* push edi *)
- 053H, (* push ebx *)
- 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
- 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
- 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
- 031H, 0C9H, (* xor ecx, ecx *)
- 031H, 0D2H, (* xor edx, edx *)
- 0B8H,
- 000H, 000H, 000H, 080H, (* mov eax, minint *)
- (* L1: *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07EH, 01BH, (* jle L3 *)
- 066H, 08BH, 00EH, (* mov cx, word[esi] *)
- 066H, 08BH, 017H, (* mov dx, word[edi] *)
- 046H, (* inc esi *)
- 046H, (* inc esi *)
- 047H, (* inc edi *)
- 047H, (* inc edi *)
- 04BH, (* dec ebx *)
- 039H, 0D1H, (* cmp ecx, edx *)
- 074H, 006H, (* je L2 *)
- 089H, 0C8H, (* mov eax, ecx *)
- 029H, 0D0H, (* sub eax, edx *)
- 0EBH, 006H, (* jmp L3 *)
- (* L2: *)
- 085H, 0C9H, (* test ecx, ecx *)
- 075H, 0E3H, (* jne L1 *)
- 031H, 0C0H, (* xor eax, eax *)
- (* L3: *)
- 05BH, (* pop ebx *)
- 05FH, (* pop edi *)
- 05EH, (* pop esi *)
- 05DH, (* pop ebp *)
- 0C2H, 00CH, 000H (* ret 12 *)
- )
- RETURN 0
-END strncmpw;
-
-
-PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: CHAR;
-
-BEGIN
- res := strncmp(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmp;
-
-
-PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: WCHAR;
-
-BEGIN
- res := strncmpw(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2 * 2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1 * 2, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmpw;
-
-
-PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- c: CHAR;
- i: INTEGER;
-
-BEGIN
- i := 0;
- REPEAT
- SYSTEM.GET(pchar, c);
- s[i] := c;
- INC(pchar);
- INC(i)
- UNTIL c = 0X
-END PCharToStr;
-
-
-PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
- i, a: INTEGER;
-
-BEGIN
- i := 0;
- a := x;
- REPEAT
- INC(i);
- a := a DIV 10
- UNTIL a = 0;
-
- str[i] := 0X;
-
- REPEAT
- DEC(i);
- str[i] := CHR(x MOD 10 + ORD("0"));
- x := x DIV 10
- UNTIL x = 0
-END IntToStr;
-
-
-PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
- n1, n2: INTEGER;
-
-BEGIN
- n1 := LENGTH(s1);
- n2 := LENGTH(s2);
-
- ASSERT(n1 + n2 < LEN(s1));
-
- SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
- s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
-VAR
- s, temp: ARRAY 1024 OF CHAR;
-
-BEGIN
- CASE err OF
- | 1: s := "assertion failure"
- | 2: s := "NIL dereference"
- | 3: s := "bad divisor"
- | 4: s := "NIL procedure call"
- | 5: s := "type guard error"
- | 6: s := "index out of range"
- | 7: s := "invalid CASE"
- | 8: s := "array assignment error"
- | 9: s := "CHR out of range"
- |10: s := "WCHR out of range"
- |11: s := "BYTE out of range"
- END;
-
- append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
- append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
-
- API.DebugMsg(SYSTEM.ADR(s[0]), name);
-
- API.exit_thread(0)
-END _error;
-
-
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _isrec;
-
-
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-BEGIN
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- END
-
- RETURN p MOD 2
-END _is;
-
-
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _guardrec;
-
-
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(p, p);
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- ELSE
- p := 1
- END
-
- RETURN p MOD 2
-END _guard;
-
-
-PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
-END _dllentry;
-
-
-PROCEDURE [stdcall] _sofinit*;
-BEGIN
- API.sofinit
-END _sofinit;
-
-
-PROCEDURE [stdcall] _exit* (code: INTEGER);
-BEGIN
- API.exit(code)
-END _exit;
-
-
-PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
-VAR
- t0, t1, i, j: INTEGER;
-
-BEGIN
- SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
- API.init(param, code);
-
- types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
- ASSERT(types # 0);
- FOR i := 0 TO tcount - 1 DO
- FOR j := 0 TO tcount - 1 DO
- t0 := i; t1 := j;
-
- WHILE (t1 # 0) & (t1 # t0) DO
- SYSTEM.GET(_types + t1 * WORD, t1)
- END;
-
- SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
- END
- END;
-
- name := modname
-END _init;
-
-
-END RTL.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/API.ob07 b/programs/develop/oberon07/Lib/Linux32/API.ob07
deleted file mode 100644
index 754147401..000000000
--- a/programs/develop/oberon07/Lib/Linux32/API.ob07
+++ /dev/null
@@ -1,123 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE API;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- eol* = 0AX;
-
- BIT_DEPTH* = 32;
-
- RTLD_LAZY = 1;
-
-
-TYPE
-
- SOFINI = PROCEDURE;
-
-
-VAR
-
- MainParam*, libc*: INTEGER;
-
- dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER;
- dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER;
-
- exit*,
- exit_thread* : PROCEDURE [linux] (code: INTEGER);
- puts : PROCEDURE [linux] (pStr: INTEGER);
- malloc : PROCEDURE [linux] (size: INTEGER): INTEGER;
- free : PROCEDURE [linux] (ptr: INTEGER);
-
- fini: SOFINI;
-
-
-PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
-BEGIN
- puts(lpCaption);
- puts(lpText)
-END DebugMsg;
-
-
-PROCEDURE _NEW* (size: INTEGER): INTEGER;
-VAR
- res, ptr, words: INTEGER;
-
-BEGIN
- res := malloc(size);
- IF res # 0 THEN
- ptr := res;
- words := size DIV SYSTEM.SIZE(INTEGER);
- WHILE words > 0 DO
- SYSTEM.PUT(ptr, 0);
- INC(ptr, SYSTEM.SIZE(INTEGER));
- DEC(words)
- END
- END
-
- RETURN res
-END _NEW;
-
-
-PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
-BEGIN
- free(p)
- RETURN 0
-END _DISPOSE;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := dlsym(lib, SYSTEM.ADR(name[0]));
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init* (sp, code: INTEGER);
-BEGIN
- fini := NIL;
- SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
- SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
- MainParam := sp;
-
- libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
- GetSym(libc, "exit", SYSTEM.ADR(exit_thread));
- exit := exit_thread;
- GetSym(libc, "puts", SYSTEM.ADR(puts));
- GetSym(libc, "malloc", SYSTEM.ADR(malloc));
- GetSym(libc, "free", SYSTEM.ADR(free));
-END init;
-
-
-PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN 0
-END dllentry;
-
-
-PROCEDURE sofinit*;
-BEGIN
- IF fini # NIL THEN
- fini
- END
-END sofinit;
-
-
-PROCEDURE SetFini* (ProcFini: SOFINI);
-BEGIN
- fini := ProcFini
-END SetFini;
-
-
-END API.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/Args.ob07 b/programs/develop/oberon07/Lib/Linux32/Args.ob07
deleted file mode 100644
index cb3379a78..000000000
--- a/programs/develop/oberon07/Lib/Linux32/Args.ob07
+++ /dev/null
@@ -1,70 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Args;
-
-IMPORT SYSTEM, API;
-
-
-VAR
-
- argc*, envc*: INTEGER;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, len, ptr: INTEGER;
- c: CHAR;
-
-BEGIN
- i := 0;
- len := LEN(s) - 1;
- IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN
- SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
- REPEAT
- SYSTEM.GET(ptr, c);
- s[i] := c;
- INC(i);
- INC(ptr)
- UNTIL (c = 0X) OR (i = len)
- END;
- s[i] := 0X
-END GetArg;
-
-
-PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR);
-BEGIN
- IF (0 <= n) & (n < envc) THEN
- GetArg(n + argc + 1, s)
- ELSE
- s[0] := 0X
- END
-END GetEnv;
-
-
-PROCEDURE init;
-VAR
- ptr: INTEGER;
-
-BEGIN
- IF API.MainParam # 0 THEN
- envc := -1;
- SYSTEM.GET(API.MainParam, argc);
- REPEAT
- SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
- INC(envc)
- UNTIL ptr = 0
- ELSE
- envc := 0;
- argc := 0
- END
-END init;
-
-
-BEGIN
- init
-END Args.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/File.ob07 b/programs/develop/oberon07/Lib/Linux32/File.ob07
deleted file mode 100644
index f200014f5..000000000
--- a/programs/develop/oberon07/Lib/Linux32/File.ob07
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE File;
-
-IMPORT SYSTEM, Libdl, API;
-
-
-CONST
-
- OPEN_R* = "rb"; OPEN_W* = "wb"; OPEN_RW* = "r+b";
- SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
-
-
-VAR
-
- fwrite,
- fread : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fseek : PROCEDURE [linux] (file, offset, origin: INTEGER): INTEGER;
- ftell : PROCEDURE [linux] (file: INTEGER): INTEGER;
- fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose : PROCEDURE [linux] (file: INTEGER): INTEGER;
- remove : PROCEDURE [linux] (fname: INTEGER): INTEGER;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := Libdl.sym(lib, name);
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init;
-VAR
- libc: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
-
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fseek", SYSTEM.ADR(fseek));
- GetSym(libc, "ftell", SYSTEM.ADR(ftell));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "remove", SYSTEM.ADR(remove));
-END init;
-
-
-PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
- RETURN remove(SYSTEM.ADR(FName[0])) = 0
-END Delete;
-
-
-PROCEDURE Close* (F: INTEGER);
-BEGIN
- F := fclose(F)
-END Close;
-
-
-PROCEDURE Open* (FName, Mode: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.ADR(Mode[0]))
-END Open;
-
-
-PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
- RETURN Open(FName, OPEN_W)
-END Create;
-
-
-PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF fseek(F, Offset, Origin) = 0 THEN
- res := ftell(F)
- ELSE
- res := -1
- END
-
- RETURN res
-END Seek;
-
-
-PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
- RETURN fwrite(Buffer, 1, Count, F)
-END Write;
-
-
-PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
- RETURN fread(Buffer, 1, Count, F)
-END Read;
-
-
-PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
-VAR
- res, n, F: INTEGER;
-
-BEGIN
- res := 0;
- F := Open(FName, OPEN_R);
-
- IF F > 0 THEN
- Size := Seek(F, 0, SEEK_END);
- n := Seek(F, 0, SEEK_BEG);
- res := API._NEW(Size);
- IF (res = 0) OR (Read(F, res, Size) # Size) THEN
- IF res # 0 THEN
- res := API._DISPOSE(res);
- Size := 0
- END
- END;
- Close(F)
- END
-
- RETURN res
-END Load;
-
-
-BEGIN
- init
-END File.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 b/programs/develop/oberon07/Lib/Linux32/HOST.ob07
deleted file mode 100644
index 53676801f..000000000
--- a/programs/develop/oberon07/Lib/Linux32/HOST.ob07
+++ /dev/null
@@ -1,248 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE HOST;
-
-IMPORT SYSTEM, API, RTL;
-
-
-CONST
-
- slash* = "/";
- eol* = 0AX;
-
- bit_depth* = RTL.bit_depth;
- maxint* = RTL.maxint;
- minint* = RTL.minint;
-
- RTLD_LAZY = 1;
-
-
-TYPE
-
- TP = ARRAY 2 OF INTEGER;
-
-
-VAR
-
- maxreal*: REAL;
-
- argc: INTEGER;
-
- libc, librt: INTEGER;
-
- stdout: INTEGER;
-
- fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose : PROCEDURE [linux] (file: INTEGER): INTEGER;
- _chmod : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER;
- time : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
- clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
- exit : PROCEDURE [linux] (code: INTEGER);
-
-
-PROCEDURE ExitProcess* (code: INTEGER);
-BEGIN
- exit(code)
-END ExitProcess;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, len, ptr: INTEGER;
- c: CHAR;
-
-BEGIN
- i := 0;
- len := LEN(s) - 1;
- IF (n < argc) & (len > 0) THEN
- SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
- REPEAT
- SYSTEM.GET(ptr, c);
- s[i] := c;
- INC(i);
- INC(ptr)
- UNTIL (c = 0X) OR (i = len)
- END;
- s[i] := 0X
-END GetArg;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-VAR
- n: INTEGER;
-
-BEGIN
- GetArg(0, path);
- n := LENGTH(path) - 1;
- WHILE path[n] # slash DO
- DEC(n)
- END;
- path[n + 1] := 0X
-END GetCurrentDirectory;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
- IF res <= 0 THEN
- res := -1
- END
-
- RETURN res
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
- IF res <= 0 THEN
- res := -1
- END
-
- RETURN res
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb"))
-END FileCreate;
-
-
-PROCEDURE FileClose* (File: INTEGER);
-BEGIN
- File := fclose(File)
-END FileClose;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-VAR
- res: INTEGER;
-BEGIN
- res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *)
-END chmod;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb"))
-END FileOpen;
-
-
-PROCEDURE OutChar* (c: CHAR);
-VAR
- res: INTEGER;
-
-BEGIN
- res := fwrite(SYSTEM.ADR(c), 1, 1, stdout)
-END OutChar;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
-VAR
- tp: TP;
- res: INTEGER;
-
-BEGIN
- IF clock_gettime(0, tp) = 0 THEN
- res := tp[0] * 100 + tp[1] DIV 10000000
- ELSE
- res := 0
- END
-
- RETURN res
-END GetTickCount;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
- RETURN path[0] # slash
-END isRelative;
-
-
-PROCEDURE UnixTime* (): INTEGER;
- RETURN time(0)
-END UnixTime;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET32(SYSTEM.ADR(x), a);
- SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
- RETURN a
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-VAR
- h, l, s, e: INTEGER;
-
-BEGIN
- e := splitf(x, l, h);
-
- s := ASR(h, 31) MOD 2;
- e := (h DIV 100000H) MOD 2048;
- IF e <= 896 THEN
- h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
- REPEAT
- h := h DIV 2;
- INC(e)
- UNTIL e = 897;
- e := 896;
- l := (h MOD 8) * 20000000H;
- h := h DIV 8
- ELSIF (1151 <= e) & (e < 2047) THEN
- e := 1151;
- h := 0;
- l := 0
- ELSIF e = 2047 THEN
- e := 1151;
- IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
- h := 80000H;
- l := 0
- END
- END;
- DEC(e, 896)
-
- RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
-END d2s;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := API.dlsym(lib, SYSTEM.ADR(name[0]));
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-BEGIN
- maxreal := 1.9;
- PACK(maxreal, 1023);
- SYSTEM.GET(API.MainParam, argc);
-
- libc := API.libc;
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "chmod", SYSTEM.ADR(_chmod));
- GetSym(libc, "time", SYSTEM.ADR(time));
- GetSym(libc, "exit", SYSTEM.ADR(exit));
- GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout);
-
- librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
- GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
-END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/In.ob07 b/programs/develop/oberon07/Lib/Linux32/In.ob07
deleted file mode 100644
index f5b487754..000000000
--- a/programs/develop/oberon07/Lib/Linux32/In.ob07
+++ /dev/null
@@ -1,85 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE In;
-
-IMPORT SYSTEM, Libdl;
-
-
-CONST
-
- MAX_LEN = 10240;
-
-
-VAR
-
- Done*: BOOLEAN;
- s: ARRAY MAX_LEN + 4 OF CHAR;
-
- sscanf: PROCEDURE [linux] (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
- gets: PROCEDURE [linux] (buf: INTEGER);
-
-
-PROCEDURE String* (VAR str: ARRAY OF CHAR);
-BEGIN
- gets(SYSTEM.ADR(s[0]));
- COPY(s, str);
- str[LEN(str) - 1] := 0X;
- Done := TRUE
-END String;
-
-
-PROCEDURE Int* (VAR x: INTEGER);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%d"), SYSTEM.ADR(x)) = 1
-END Int;
-
-
-PROCEDURE Real* (VAR x: REAL);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
-END Real;
-
-
-PROCEDURE Char* (VAR x: CHAR);
-BEGIN
- String(s);
- x := s[0]
-END Char;
-
-
-PROCEDURE Ln*;
-BEGIN
- String(s)
-END Ln;
-
-
-PROCEDURE Open*;
-BEGIN
- Done := TRUE
-END Open;
-
-
-PROCEDURE init;
-VAR
- libc: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
- SYSTEM.PUT(SYSTEM.ADR(sscanf), Libdl.sym(libc, "sscanf"));
- ASSERT(sscanf # NIL);
- SYSTEM.PUT(SYSTEM.ADR(gets), Libdl.sym(libc, "gets"));
- ASSERT(gets # NIL);
-END init;
-
-
-BEGIN
- init
-END In.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07
deleted file mode 100644
index 497660a26..000000000
--- a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07
+++ /dev/null
@@ -1,106 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE LINAPI;
-
-IMPORT SYSTEM, API, Libdl;
-
-
-TYPE
-
- TP* = ARRAY 2 OF INTEGER;
- SOFINI* = PROCEDURE;
-
-
-VAR
-
- libc*, librt*: INTEGER;
-
- stdout*,
- stdin*,
- stderr* : INTEGER;
-
- malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER;
- free* : PROCEDURE [linux] (ptr: INTEGER);
- exit* : PROCEDURE [linux] (code: INTEGER);
- puts* : PROCEDURE [linux] (pStr: INTEGER);
- fwrite*,
- fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER;
- time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
-
- clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
-
-
-PROCEDURE SetFini* (ProcFini: SOFINI);
-BEGIN
- API.SetFini(ProcFini)
-END SetFini;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := Libdl.sym(lib, name);
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init;
-BEGIN
- libc := API.libc;
-
- GetSym(libc, "exit", SYSTEM.ADR(exit));
- GetSym(libc, "puts", SYSTEM.ADR(puts));
- GetSym(libc, "malloc", SYSTEM.ADR(malloc));
- GetSym(libc, "free", SYSTEM.ADR(free));
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "time", SYSTEM.ADR(time));
-
- GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout);
- GetSym(libc, "stdin", SYSTEM.ADR(stdin)); SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin);
- GetSym(libc, "stderr", SYSTEM.ADR(stderr)); SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr);
-
- librt := Libdl.open("librt.so.1", Libdl.LAZY);
-
- GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
-END init;
-
-
-PROCEDURE [stdcall-] syscall* (eax, ebx, ecx, edx, esi, edi: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 053H, (* push ebx *)
- 056H, (* push esi *)
- 057H, (* push edi *)
- 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
- 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *)
- 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
- 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *)
- 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *)
- 08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *)
- 0CDH, 080H, (* int 128 *)
- 05FH, (* pop edi *)
- 05EH, (* pop esi *)
- 05BH, (* pop ebx *)
- 0C9H, (* leave *)
- 0C2H, 018H, 000H (* ret 24 *)
- )
- RETURN 0
-END syscall;
-
-
-BEGIN
- init
-END LINAPI.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/Libdl.ob07 b/programs/develop/oberon07/Lib/Linux32/Libdl.ob07
deleted file mode 100644
index f8a5781d8..000000000
--- a/programs/develop/oberon07/Lib/Linux32/Libdl.ob07
+++ /dev/null
@@ -1,65 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Libdl;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- LAZY* = 1;
- NOW* = 2;
- BINDING_MASK* = 3;
- NOLOAD* = 4;
- LOCAL* = 0;
- GLOBAL* = 256;
- NODELETE* = 4096;
-
-
-VAR
-
- _close: PROCEDURE [linux] (handle: INTEGER): INTEGER;
- _error: PROCEDURE [linux] (): INTEGER;
-
-
-PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER;
- RETURN API.dlopen(SYSTEM.ADR(file[0]), mode)
-END open;
-
-
-PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER;
- RETURN API.dlsym(handle, SYSTEM.ADR(name[0]))
-END sym;
-
-
-PROCEDURE close* (handle: INTEGER): INTEGER;
- RETURN _close(handle)
-END close;
-
-
-PROCEDURE error* (): INTEGER;
- RETURN _error()
-END error;
-
-
-PROCEDURE init;
-VAR
- lib: INTEGER;
-
-BEGIN
- lib := open("libdl.so.2", LAZY);
- SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose"));
- ASSERT(_close # NIL);
- SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror"));
- ASSERT(_error # NIL)
-END init;
-
-
-BEGIN
- init
-END Libdl.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/Math.ob07 b/programs/develop/oberon07/Lib/Linux32/Math.ob07
deleted file mode 100644
index beb3bb884..000000000
--- a/programs/develop/oberon07/Lib/Linux32/Math.ob07
+++ /dev/null
@@ -1,450 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2013-2014, 2018-2020 Anton Krotov
- All rights reserved.
-*)
-
-MODULE Math;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- pi* = 3.141592653589793;
- e* = 2.718281828459045;
-
-
-PROCEDURE IsNan* (x: REAL): BOOLEAN;
-VAR
- h, l: SET;
-
-BEGIN
- SYSTEM.GET(SYSTEM.ADR(x), l);
- SYSTEM.GET(SYSTEM.ADR(x) + 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) = SYSTEM.INF()
-END IsInf;
-
-
-PROCEDURE Max (a, b: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF a > b THEN
- res := a
- ELSE
- res := b
- END
- RETURN res
-END Max;
-
-
-PROCEDURE Min (a, b: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF a < b THEN
- res := a
- ELSE
- res := b
- END
- RETURN res
-END Min;
-
-
-PROCEDURE SameValue (a, b: REAL): BOOLEAN;
-VAR
- eps: REAL;
- res: BOOLEAN;
-
-BEGIN
- eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
- IF a > b THEN
- res := (a - b) <= eps
- ELSE
- res := (b - a) <= eps
- END
- RETURN res
-END SameValue;
-
-
-PROCEDURE IsZero (x: REAL): BOOLEAN;
- RETURN ABS(x) <= 1.0E-12
-END IsZero;
-
-
-PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FAH, (* fsqrt *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END sqrt;
-
-
-PROCEDURE [stdcall] sin* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FEH, (* fsin *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END sin;
-
-
-PROCEDURE [stdcall] cos* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FFH, (* fcos *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END cos;
-
-
-PROCEDURE [stdcall] tan* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FBH, (* fsincos *)
- 0DEH, 0F9H, (* fdivp st1, st *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END tan;
-
-
-PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
- 0D9H, 0F3H, (* fpatan *)
- 0C9H, (* leave *)
- 0C2H, 010H, 000H (* ret 10h *)
- )
- RETURN 0.0
-END arctan2;
-
-
-PROCEDURE [stdcall] ln* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0D9H, 0EDH, (* fldln2 *)
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END ln;
-
-
-PROCEDURE [stdcall] log* (base, x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0D9H, 0E8H, (* fld1 *)
- 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0D9H, 0E8H, (* fld1 *)
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0DEH, 0F9H, (* fdivp st1, st *)
- 0C9H, (* leave *)
- 0C2H, 010H, 000H (* ret 10h *)
- )
- RETURN 0.0
-END log;
-
-
-PROCEDURE [stdcall] exp* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0EAH, (* fldl2e *)
- 0DEH, 0C9H, 0D9H, 0C0H,
- 0D9H, 0FCH, 0DCH, 0E9H,
- 0D9H, 0C9H, 0D9H, 0F0H,
- 0D9H, 0E8H, 0DEH, 0C1H,
- 0D9H, 0FDH, 0DDH, 0D9H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END exp;
-
-
-PROCEDURE [stdcall] round* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 07DH, 0F4H, 0D9H,
- 07DH, 0F6H, 066H, 081H,
- 04DH, 0F6H, 000H, 003H,
- 0D9H, 06DH, 0F6H, 0D9H,
- 0FCH, 0D9H, 06DH, 0F4H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END round;
-
-
-PROCEDURE [stdcall] frac* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 050H,
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0C0H, 0D9H, 03CH,
- 024H, 0D9H, 07CH, 024H,
- 002H, 066H, 081H, 04CH,
- 024H, 002H, 000H, 00FH,
- 0D9H, 06CH, 024H, 002H,
- 0D9H, 0FCH, 0D9H, 02CH,
- 024H, 0DEH, 0E9H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END frac;
-
-
-PROCEDURE sqri* (x: INTEGER): INTEGER;
- RETURN x * x
-END sqri;
-
-
-PROCEDURE sqrr* (x: REAL): REAL;
- RETURN x * x
-END sqrr;
-
-
-PROCEDURE arcsin* (x: REAL): REAL;
- RETURN arctan2(x, sqrt(1.0 - x * x))
-END arcsin;
-
-
-PROCEDURE arccos* (x: REAL): REAL;
- RETURN arctan2(sqrt(1.0 - x * x), x)
-END arccos;
-
-
-PROCEDURE arctan* (x: REAL): REAL;
- RETURN arctan2(x, 1.0)
-END arctan;
-
-
-PROCEDURE sinh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x - 1.0 / x) * 0.5
-END sinh;
-
-
-PROCEDURE cosh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x + 1.0 / x) * 0.5
-END cosh;
-
-
-PROCEDURE tanh* (x: REAL): REAL;
-BEGIN
- IF x > 15.0 THEN
- x := 1.0
- ELSIF x < -15.0 THEN
- x := -1.0
- ELSE
- x := exp(2.0 * x);
- x := (x - 1.0) / (x + 1.0)
- END
-
- RETURN x
-END tanh;
-
-
-PROCEDURE arsinh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x + 1.0))
-END arsinh;
-
-
-PROCEDURE arcosh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x - 1.0))
-END arcosh;
-
-
-PROCEDURE artanh* (x: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF SameValue(x, 1.0) THEN
- res := SYSTEM.INF()
- ELSIF SameValue(x, -1.0) THEN
- res := -SYSTEM.INF()
- ELSE
- res := 0.5 * ln((1.0 + x) / (1.0 - x))
- END
- RETURN res
-END artanh;
-
-
-PROCEDURE floor* (x: REAL): REAL;
-VAR
- f: REAL;
-
-BEGIN
- f := frac(x);
- x := x - f;
- IF f < 0.0 THEN
- x := x - 1.0
- END
- RETURN x
-END floor;
-
-
-PROCEDURE ceil* (x: REAL): REAL;
-VAR
- f: REAL;
-
-BEGIN
- f := frac(x);
- x := x - f;
- IF f > 0.0 THEN
- x := x + 1.0
- END
- RETURN x
-END ceil;
-
-
-PROCEDURE power* (base, exponent: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF exponent = 0.0 THEN
- res := 1.0
- ELSIF (base = 0.0) & (exponent > 0.0) THEN
- res := 0.0
- ELSE
- res := exp(exponent * ln(base))
- END
- RETURN res
-END power;
-
-
-PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
-VAR
- i: INTEGER;
- a: REAL;
-
-BEGIN
- a := 1.0;
-
- IF base # 0.0 THEN
- IF exponent # 0 THEN
- IF exponent < 0 THEN
- base := 1.0 / base
- END;
- i := ABS(exponent);
- WHILE i > 0 DO
- WHILE ~ODD(i) DO
- i := LSR(i, 1);
- base := sqrr(base)
- END;
- DEC(i);
- a := a * base
- END
- ELSE
- a := 1.0
- END
- ELSE
- ASSERT(exponent > 0);
- a := 0.0
- END
-
- RETURN a
-END ipower;
-
-
-PROCEDURE sgn* (x: REAL): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF x > 0.0 THEN
- res := 1
- ELSIF x < 0.0 THEN
- res := -1
- ELSE
- res := 0
- END
-
- RETURN res
-END sgn;
-
-
-PROCEDURE fact* (n: INTEGER): REAL;
-VAR
- res: REAL;
-
-BEGIN
- res := 1.0;
- WHILE n > 1 DO
- res := res * FLT(n);
- DEC(n)
- END
-
- RETURN res
-END fact;
-
-
-PROCEDURE DegToRad* (x: REAL): REAL;
- RETURN x * (pi / 180.0)
-END DegToRad;
-
-
-PROCEDURE RadToDeg* (x: REAL): REAL;
- RETURN x * (180.0 / pi)
-END RadToDeg;
-
-
-(* Return hypotenuse of triangle *)
-PROCEDURE hypot* (x, y: REAL): REAL;
-VAR
- a: REAL;
-
-BEGIN
- x := ABS(x);
- y := ABS(y);
- IF x > y THEN
- a := x * sqrt(1.0 + sqrr(y / x))
- ELSE
- IF x > 0.0 THEN
- a := y * sqrt(1.0 + sqrr(x / y))
- ELSE
- a := y
- END
- END
-
- RETURN a
-END hypot;
-
-
-END Math.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux32/Out.ob07 b/programs/develop/oberon07/Lib/Linux32/Out.ob07
deleted file mode 100644
index c723cf0e5..000000000
--- a/programs/develop/oberon07/Lib/Linux32/Out.ob07
+++ /dev/null
@@ -1,77 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Out;
-
-IMPORT SYSTEM, Libdl;
-
-
-VAR
-
- printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER);
- printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER);
- printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision: INTEGER; x: REAL);
-
-
-PROCEDURE Char* (x: CHAR);
-BEGIN
- printf1(SYSTEM.SADR("%c"), ORD(x))
-END Char;
-
-
-PROCEDURE String* (s: ARRAY OF CHAR);
-BEGIN
- printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
-END String;
-
-
-PROCEDURE Ln*;
-BEGIN
- printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX))
-END Ln;
-
-
-PROCEDURE Int* (x, width: INTEGER);
-BEGIN
- printf2(SYSTEM.SADR("%*d"), width, x)
-END Int;
-
-
-PROCEDURE Real* (x: REAL; width: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x)
-END Real;
-
-
-PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*f"), width, precision, x)
-END FixReal;
-
-
-PROCEDURE Open*;
-END Open;
-
-
-PROCEDURE init;
-VAR
- libc, printf: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
- printf := Libdl.sym(libc, "printf");
- ASSERT(printf # 0);
- SYSTEM.PUT(SYSTEM.ADR(printf1), printf);
- SYSTEM.PUT(SYSTEM.ADR(printf2), printf);
- SYSTEM.PUT(SYSTEM.ADR(printf3), printf);
-END init;
-
-
-BEGIN
- init
-END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/API.ob07 b/programs/develop/oberon07/Lib/Linux64/API.ob07
deleted file mode 100644
index fb0a96bfa..000000000
--- a/programs/develop/oberon07/Lib/Linux64/API.ob07
+++ /dev/null
@@ -1,123 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE API;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- eol* = 0AX;
-
- BIT_DEPTH* = 64;
-
- RTLD_LAZY = 1;
-
-
-TYPE
-
- SOFINI = PROCEDURE;
-
-
-VAR
-
- MainParam*, libc*: INTEGER;
-
- dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER;
- dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER;
-
- exit*,
- exit_thread* : PROCEDURE [linux] (code: INTEGER);
- puts : PROCEDURE [linux] (pStr: INTEGER);
- malloc : PROCEDURE [linux] (size: INTEGER): INTEGER;
- free : PROCEDURE [linux] (ptr: INTEGER);
-
- fini: SOFINI;
-
-
-PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
-BEGIN
- puts(lpCaption);
- puts(lpText)
-END DebugMsg;
-
-
-PROCEDURE _NEW* (size: INTEGER): INTEGER;
-VAR
- res, ptr, words: INTEGER;
-
-BEGIN
- res := malloc(size);
- IF res # 0 THEN
- ptr := res;
- words := size DIV SYSTEM.SIZE(INTEGER);
- WHILE words > 0 DO
- SYSTEM.PUT(ptr, 0);
- INC(ptr, SYSTEM.SIZE(INTEGER));
- DEC(words)
- END
- END
-
- RETURN res
-END _NEW;
-
-
-PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
-BEGIN
- free(p)
- RETURN 0
-END _DISPOSE;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := dlsym(lib, SYSTEM.ADR(name[0]));
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init* (sp, code: INTEGER);
-BEGIN
- fini := NIL;
- SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
- SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
- MainParam := sp;
-
- libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
- GetSym(libc, "exit", SYSTEM.ADR(exit_thread));
- exit := exit_thread;
- GetSym(libc, "puts", SYSTEM.ADR(puts));
- GetSym(libc, "malloc", SYSTEM.ADR(malloc));
- GetSym(libc, "free", SYSTEM.ADR(free));
-END init;
-
-
-PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN 0
-END dllentry;
-
-
-PROCEDURE sofinit*;
-BEGIN
- IF fini # NIL THEN
- fini
- END
-END sofinit;
-
-
-PROCEDURE SetFini* (ProcFini: SOFINI);
-BEGIN
- fini := ProcFini
-END SetFini;
-
-
-END API.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/Args.ob07 b/programs/develop/oberon07/Lib/Linux64/Args.ob07
deleted file mode 100644
index cb3379a78..000000000
--- a/programs/develop/oberon07/Lib/Linux64/Args.ob07
+++ /dev/null
@@ -1,70 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Args;
-
-IMPORT SYSTEM, API;
-
-
-VAR
-
- argc*, envc*: INTEGER;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, len, ptr: INTEGER;
- c: CHAR;
-
-BEGIN
- i := 0;
- len := LEN(s) - 1;
- IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN
- SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
- REPEAT
- SYSTEM.GET(ptr, c);
- s[i] := c;
- INC(i);
- INC(ptr)
- UNTIL (c = 0X) OR (i = len)
- END;
- s[i] := 0X
-END GetArg;
-
-
-PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR);
-BEGIN
- IF (0 <= n) & (n < envc) THEN
- GetArg(n + argc + 1, s)
- ELSE
- s[0] := 0X
- END
-END GetEnv;
-
-
-PROCEDURE init;
-VAR
- ptr: INTEGER;
-
-BEGIN
- IF API.MainParam # 0 THEN
- envc := -1;
- SYSTEM.GET(API.MainParam, argc);
- REPEAT
- SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
- INC(envc)
- UNTIL ptr = 0
- ELSE
- envc := 0;
- argc := 0
- END
-END init;
-
-
-BEGIN
- init
-END Args.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/File.ob07 b/programs/develop/oberon07/Lib/Linux64/File.ob07
deleted file mode 100644
index f200014f5..000000000
--- a/programs/develop/oberon07/Lib/Linux64/File.ob07
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE File;
-
-IMPORT SYSTEM, Libdl, API;
-
-
-CONST
-
- OPEN_R* = "rb"; OPEN_W* = "wb"; OPEN_RW* = "r+b";
- SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
-
-
-VAR
-
- fwrite,
- fread : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fseek : PROCEDURE [linux] (file, offset, origin: INTEGER): INTEGER;
- ftell : PROCEDURE [linux] (file: INTEGER): INTEGER;
- fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose : PROCEDURE [linux] (file: INTEGER): INTEGER;
- remove : PROCEDURE [linux] (fname: INTEGER): INTEGER;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := Libdl.sym(lib, name);
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init;
-VAR
- libc: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
-
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fseek", SYSTEM.ADR(fseek));
- GetSym(libc, "ftell", SYSTEM.ADR(ftell));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "remove", SYSTEM.ADR(remove));
-END init;
-
-
-PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
- RETURN remove(SYSTEM.ADR(FName[0])) = 0
-END Delete;
-
-
-PROCEDURE Close* (F: INTEGER);
-BEGIN
- F := fclose(F)
-END Close;
-
-
-PROCEDURE Open* (FName, Mode: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.ADR(Mode[0]))
-END Open;
-
-
-PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
- RETURN Open(FName, OPEN_W)
-END Create;
-
-
-PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF fseek(F, Offset, Origin) = 0 THEN
- res := ftell(F)
- ELSE
- res := -1
- END
-
- RETURN res
-END Seek;
-
-
-PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
- RETURN fwrite(Buffer, 1, Count, F)
-END Write;
-
-
-PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
- RETURN fread(Buffer, 1, Count, F)
-END Read;
-
-
-PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
-VAR
- res, n, F: INTEGER;
-
-BEGIN
- res := 0;
- F := Open(FName, OPEN_R);
-
- IF F > 0 THEN
- Size := Seek(F, 0, SEEK_END);
- n := Seek(F, 0, SEEK_BEG);
- res := API._NEW(Size);
- IF (res = 0) OR (Read(F, res, Size) # Size) THEN
- IF res # 0 THEN
- res := API._DISPOSE(res);
- Size := 0
- END
- END;
- Close(F)
- END
-
- RETURN res
-END Load;
-
-
-BEGIN
- init
-END File.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/HOST.ob07 b/programs/develop/oberon07/Lib/Linux64/HOST.ob07
deleted file mode 100644
index 66ab8b698..000000000
--- a/programs/develop/oberon07/Lib/Linux64/HOST.ob07
+++ /dev/null
@@ -1,254 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE HOST;
-
-IMPORT SYSTEM, API, RTL;
-
-
-CONST
-
- slash* = "/";
- eol* = 0AX;
-
- bit_depth* = RTL.bit_depth;
- maxint* = RTL.maxint;
- minint* = RTL.minint;
-
- RTLD_LAZY = 1;
-
-
-TYPE
-
- TP = ARRAY 2 OF INTEGER;
-
-
-VAR
-
- maxreal*: REAL;
-
- argc: INTEGER;
-
- libc, librt: INTEGER;
-
- stdout: INTEGER;
-
- fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose : PROCEDURE [linux] (file: INTEGER): INTEGER;
- _chmod : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER;
- time : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
- clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
- exit : PROCEDURE [linux] (code: INTEGER);
-
-
-PROCEDURE ExitProcess* (code: INTEGER);
-BEGIN
- exit(code)
-END ExitProcess;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, len, ptr: INTEGER;
- c: CHAR;
-
-BEGIN
- i := 0;
- len := LEN(s) - 1;
- IF (n < argc) & (len > 0) THEN
- SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
- REPEAT
- SYSTEM.GET(ptr, c);
- s[i] := c;
- INC(i);
- INC(ptr)
- UNTIL (c = 0X) OR (i = len)
- END;
- s[i] := 0X
-END GetArg;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-VAR
- n: INTEGER;
-
-BEGIN
- GetArg(0, path);
- n := LENGTH(path) - 1;
- WHILE path[n] # slash DO
- DEC(n)
- END;
- path[n + 1] := 0X
-END GetCurrentDirectory;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
- IF res <= 0 THEN
- res := -1
- END
-
- RETURN res
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
- IF res <= 0 THEN
- res := -1
- END
-
- RETURN res
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb"))
-END FileCreate;
-
-
-PROCEDURE FileClose* (File: INTEGER);
-BEGIN
- File := fclose(File)
-END FileClose;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-VAR
- res: INTEGER;
-BEGIN
- res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *)
-END chmod;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
- RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb"))
-END FileOpen;
-
-
-PROCEDURE OutChar* (c: CHAR);
-VAR
- res: INTEGER;
-
-BEGIN
- res := fwrite(SYSTEM.ADR(c), 1, 1, stdout)
-END OutChar;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
-VAR
- tp: TP;
- res: INTEGER;
-
-BEGIN
- IF clock_gettime(0, tp) = 0 THEN
- res := tp[0] * 100 + tp[1] DIV 10000000
- ELSE
- res := 0
- END
-
- RETURN res
-END GetTickCount;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
- RETURN path[0] # slash
-END isRelative;
-
-
-PROCEDURE UnixTime* (): INTEGER;
- RETURN time(0)
-END UnixTime;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- a := 0;
- b := 0;
- SYSTEM.GET32(SYSTEM.ADR(x), a);
- SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
- SYSTEM.GET(SYSTEM.ADR(x), res)
- RETURN res
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-VAR
- h, l, s, e: INTEGER;
-
-BEGIN
- e := splitf(x, l, h);
-
- s := ASR(h, 31) MOD 2;
- e := (h DIV 100000H) MOD 2048;
- IF e <= 896 THEN
- h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
- REPEAT
- h := h DIV 2;
- INC(e)
- UNTIL e = 897;
- e := 896;
- l := (h MOD 8) * 20000000H;
- h := h DIV 8
- ELSIF (1151 <= e) & (e < 2047) THEN
- e := 1151;
- h := 0;
- l := 0
- ELSIF e = 2047 THEN
- e := 1151;
- IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
- h := 80000H;
- l := 0
- END
- END;
- DEC(e, 896)
-
- RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
-END d2s;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := API.dlsym(lib, SYSTEM.ADR(name[0]));
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-BEGIN
- maxreal := 1.9;
- PACK(maxreal, 1023);
- SYSTEM.GET(API.MainParam, argc);
-
- libc := API.libc;
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "chmod", SYSTEM.ADR(_chmod));
- GetSym(libc, "time", SYSTEM.ADR(time));
- GetSym(libc, "exit", SYSTEM.ADR(exit));
- GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout);
-
- librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
- GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
-END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/In.ob07 b/programs/develop/oberon07/Lib/Linux64/In.ob07
deleted file mode 100644
index 73fa891d0..000000000
--- a/programs/develop/oberon07/Lib/Linux64/In.ob07
+++ /dev/null
@@ -1,85 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE In;
-
-IMPORT SYSTEM, Libdl;
-
-
-CONST
-
- MAX_LEN = 10240;
-
-
-VAR
-
- Done*: BOOLEAN;
- s: ARRAY MAX_LEN + 4 OF CHAR;
-
- sscanf: PROCEDURE [linux] (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
- gets: PROCEDURE [linux] (buf: INTEGER);
-
-
-PROCEDURE String* (VAR str: ARRAY OF CHAR);
-BEGIN
- gets(SYSTEM.ADR(s[0]));
- COPY(s, str);
- str[LEN(str) - 1] := 0X;
- Done := TRUE
-END String;
-
-
-PROCEDURE Int* (VAR x: INTEGER);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lld"), SYSTEM.ADR(x)) = 1
-END Int;
-
-
-PROCEDURE Real* (VAR x: REAL);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
-END Real;
-
-
-PROCEDURE Char* (VAR x: CHAR);
-BEGIN
- String(s);
- x := s[0]
-END Char;
-
-
-PROCEDURE Ln*;
-BEGIN
- String(s)
-END Ln;
-
-
-PROCEDURE Open*;
-BEGIN
- Done := TRUE
-END Open;
-
-
-PROCEDURE init;
-VAR
- libc: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
- SYSTEM.PUT(SYSTEM.ADR(sscanf), Libdl.sym(libc, "sscanf"));
- ASSERT(sscanf # NIL);
- SYSTEM.PUT(SYSTEM.ADR(gets), Libdl.sym(libc, "gets"));
- ASSERT(gets # NIL);
-END init;
-
-
-BEGIN
- init
-END In.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07
deleted file mode 100644
index 98e601926..000000000
--- a/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07
+++ /dev/null
@@ -1,101 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE LINAPI;
-
-IMPORT SYSTEM, API, Libdl;
-
-
-TYPE
-
- TP* = ARRAY 2 OF INTEGER;
- SOFINI* = PROCEDURE;
-
-
-VAR
-
- libc*, librt*: INTEGER;
-
- stdout*,
- stdin*,
- stderr* : INTEGER;
-
- malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER;
- free* : PROCEDURE [linux] (ptr: INTEGER);
- exit* : PROCEDURE [linux] (code: INTEGER);
- puts* : PROCEDURE [linux] (pStr: INTEGER);
- fwrite*,
- fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
- fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
- fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER;
- time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
-
- clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
-
-
-PROCEDURE SetFini* (ProcFini: SOFINI);
-BEGIN
- API.SetFini(ProcFini)
-END SetFini;
-
-
-PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
-VAR
- sym: INTEGER;
-
-BEGIN
- sym := Libdl.sym(lib, name);
- ASSERT(sym # 0);
- SYSTEM.PUT(VarAdr, sym)
-END GetSym;
-
-
-PROCEDURE init;
-BEGIN
- libc := API.libc;
-
- GetSym(libc, "exit", SYSTEM.ADR(exit));
- GetSym(libc, "puts", SYSTEM.ADR(puts));
- GetSym(libc, "malloc", SYSTEM.ADR(malloc));
- GetSym(libc, "free", SYSTEM.ADR(free));
- GetSym(libc, "fread", SYSTEM.ADR(fread));
- GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
- GetSym(libc, "fopen", SYSTEM.ADR(fopen));
- GetSym(libc, "fclose", SYSTEM.ADR(fclose));
- GetSym(libc, "time", SYSTEM.ADR(time));
-
- GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout);
- GetSym(libc, "stdin", SYSTEM.ADR(stdin)); SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin);
- GetSym(libc, "stderr", SYSTEM.ADR(stderr)); SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr);
-
- librt := Libdl.open("librt.so.1", Libdl.LAZY);
-
- GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
-END init;
-
-
-PROCEDURE [stdcall64-] syscall* (rax, rdi, rsi, rdx, r10, r8, r9: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *)
- 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *)
- 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *)
- 048H, 08BH, 055H, 028H, (* mov rdx, qword [rbp + 40] *)
- 04CH, 08BH, 055H, 030H, (* mov r10, qword [rbp + 48] *)
- 04CH, 08BH, 045H, 038H, (* mov r8, qword [rbp + 56] *)
- 04CH, 08BH, 04DH, 040H, (* mov r9, qword [rbp + 64] *)
- 00FH, 005H, (* syscall *)
- 0C9H, (* leave *)
- 0C2H, 038H, 000H (* ret 56 *)
- )
- RETURN 0
-END syscall;
-
-
-BEGIN
- init
-END LINAPI.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/Libdl.ob07 b/programs/develop/oberon07/Lib/Linux64/Libdl.ob07
deleted file mode 100644
index f8a5781d8..000000000
--- a/programs/develop/oberon07/Lib/Linux64/Libdl.ob07
+++ /dev/null
@@ -1,65 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Libdl;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- LAZY* = 1;
- NOW* = 2;
- BINDING_MASK* = 3;
- NOLOAD* = 4;
- LOCAL* = 0;
- GLOBAL* = 256;
- NODELETE* = 4096;
-
-
-VAR
-
- _close: PROCEDURE [linux] (handle: INTEGER): INTEGER;
- _error: PROCEDURE [linux] (): INTEGER;
-
-
-PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER;
- RETURN API.dlopen(SYSTEM.ADR(file[0]), mode)
-END open;
-
-
-PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER;
- RETURN API.dlsym(handle, SYSTEM.ADR(name[0]))
-END sym;
-
-
-PROCEDURE close* (handle: INTEGER): INTEGER;
- RETURN _close(handle)
-END close;
-
-
-PROCEDURE error* (): INTEGER;
- RETURN _error()
-END error;
-
-
-PROCEDURE init;
-VAR
- lib: INTEGER;
-
-BEGIN
- lib := open("libdl.so.2", LAZY);
- SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose"));
- ASSERT(_close # NIL);
- SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror"));
- ASSERT(_error # NIL)
-END init;
-
-
-BEGIN
- init
-END Libdl.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/Math.ob07 b/programs/develop/oberon07/Lib/Linux64/Math.ob07
deleted file mode 100644
index 42a5de5e7..000000000
--- a/programs/develop/oberon07/Lib/Linux64/Math.ob07
+++ /dev/null
@@ -1,480 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Math;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- pi* = 3.1415926535897932384626433832795028841972E0;
- e* = 2.7182818284590452353602874713526624977572E0;
-
- ZERO = 0.0E0;
- ONE = 1.0E0;
- HALF = 0.5E0;
- TWO = 2.0E0;
- sqrtHalf = 0.70710678118654752440E0;
- eps = 5.5511151E-17;
- ln2Inv = 1.44269504088896340735992468100189213E0;
- piInv = ONE / pi;
- Limit = 1.0536712E-8;
- piByTwo = pi / TWO;
-
- expoMax = 1023;
- expoMin = 1 - expoMax;
-
-
-VAR
-
- LnInfinity, LnSmall, large, miny: REAL;
-
-
-PROCEDURE [stdcall64] sqrt* (x: REAL): REAL;
-BEGIN
- ASSERT(x >= ZERO);
- SYSTEM.CODE(
- 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *)
- 05DH, (* pop rbp *)
- 0C2H, 08H, 00H (* ret 8 *)
- )
-
- RETURN 0.0
-END sqrt;
-
-
-PROCEDURE sqri* (x: INTEGER): INTEGER;
- RETURN x * x
-END sqri;
-
-
-PROCEDURE sqrr* (x: REAL): REAL;
- RETURN x * x
-END sqrr;
-
-
-PROCEDURE exp* (x: REAL): REAL;
-CONST
- c1 = 0.693359375E0;
- c2 = -2.1219444005469058277E-4;
- P0 = 0.249999999999999993E+0;
- P1 = 0.694360001511792852E-2;
- P2 = 0.165203300268279130E-4;
- Q1 = 0.555538666969001188E-1;
- Q2 = 0.495862884905441294E-3;
-
-VAR
- xn, g, p, q, z: REAL;
- n: INTEGER;
-
-BEGIN
- IF x > LnInfinity THEN
- x := SYSTEM.INF()
- ELSIF x < LnSmall THEN
- x := ZERO
- ELSIF ABS(x) < eps THEN
- x := ONE
- ELSE
- IF x >= ZERO THEN
- n := FLOOR(ln2Inv * x + HALF)
- ELSE
- n := FLOOR(ln2Inv * x - HALF)
- END;
-
- xn := FLT(n);
- g := (x - xn * c1) - xn * c2;
- z := g * g;
- p := ((P2 * z + P1) * z + P0) * g;
- q := (Q2 * z + Q1) * z + HALF;
- x := HALF + p / (q - p);
- PACK(x, n + 1)
- END
-
- RETURN x
-END exp;
-
-
-PROCEDURE ln* (x: REAL): REAL;
-CONST
- c1 = 355.0E0 / 512.0E0;
- c2 = -2.121944400546905827679E-4;
- P0 = -0.64124943423745581147E+2;
- P1 = 0.16383943563021534222E+2;
- P2 = -0.78956112887491257267E+0;
- Q0 = -0.76949932108494879777E+3;
- Q1 = 0.31203222091924532844E+3;
- Q2 = -0.35667977739034646171E+2;
-
-VAR
- zn, zd, r, z, w, p, q, xn: REAL;
- n: INTEGER;
-
-BEGIN
- ASSERT(x > ZERO);
-
- UNPK(x, n);
- x := x * HALF;
-
- IF x > sqrtHalf THEN
- zn := x - ONE;
- zd := x * HALF + HALF;
- INC(n)
- ELSE
- zn := x - HALF;
- zd := zn * HALF + HALF
- END;
-
- z := zn / zd;
- w := z * z;
- q := ((w + Q2) * w + Q1) * w + Q0;
- p := w * ((P2 * w + P1) * w + P0);
- r := z + z * (p / q);
- xn := FLT(n)
-
- RETURN (xn * c2 + r) + xn * c1
-END ln;
-
-
-PROCEDURE power* (base, exponent: REAL): REAL;
-BEGIN
- ASSERT(base > ZERO)
- RETURN exp(exponent * ln(base))
-END power;
-
-
-PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
-VAR
- i: INTEGER;
- a: REAL;
-
-BEGIN
- a := 1.0;
-
- IF base # 0.0 THEN
- IF exponent # 0 THEN
- IF exponent < 0 THEN
- base := 1.0 / base
- END;
- i := ABS(exponent);
- WHILE i > 0 DO
- WHILE ~ODD(i) DO
- i := LSR(i, 1);
- base := sqrr(base)
- END;
- DEC(i);
- a := a * base
- END
- ELSE
- a := 1.0
- END
- ELSE
- ASSERT(exponent > 0);
- a := 0.0
- END
-
- RETURN a
-END ipower;
-
-
-PROCEDURE log* (base, x: REAL): REAL;
-BEGIN
- ASSERT(base > ZERO);
- ASSERT(x > ZERO)
- RETURN ln(x) / ln(base)
-END log;
-
-
-PROCEDURE SinCos (x, y, sign: REAL): REAL;
-CONST
- ymax = 210828714;
- c1 = 3.1416015625E0;
- c2 = -8.908910206761537356617E-6;
- r1 = -0.16666666666666665052E+0;
- r2 = 0.83333333333331650314E-2;
- r3 = -0.19841269841201840457E-3;
- r4 = 0.27557319210152756119E-5;
- r5 = -0.25052106798274584544E-7;
- r6 = 0.16058936490371589114E-9;
- r7 = -0.76429178068910467734E-12;
- r8 = 0.27204790957888846175E-14;
-
-VAR
- n: INTEGER;
- xn, f, x1, g: REAL;
-
-BEGIN
- ASSERT(y < FLT(ymax));
-
- n := FLOOR(y * piInv + HALF);
- xn := FLT(n);
- IF ODD(n) THEN
- sign := -sign
- END;
- x := ABS(x);
- IF x # y THEN
- xn := xn - HALF
- END;
-
- x1 := FLT(FLOOR(x));
- f := ((x1 - xn * c1) + (x - x1)) - xn * c2;
-
- IF ABS(f) < Limit THEN
- x := sign * f
- ELSE
- g := f * f;
- g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g;
- g := f + f * g;
- x := sign * g
- END
-
- RETURN x
-END SinCos;
-
-
-PROCEDURE sin* (x: REAL): REAL;
-BEGIN
- IF x < ZERO THEN
- x := SinCos(x, -x, -ONE)
- ELSE
- x := SinCos(x, x, ONE)
- END
-
- RETURN x
-END sin;
-
-
-PROCEDURE cos* (x: REAL): REAL;
- RETURN SinCos(x, ABS(x) + piByTwo, ONE)
-END cos;
-
-
-PROCEDURE tan* (x: REAL): REAL;
-VAR
- s, c: REAL;
-
-BEGIN
- s := sin(x);
- c := sqrt(ONE - s * s);
- x := ABS(x) / (TWO * pi);
- x := x - FLT(FLOOR(x));
- IF (0.25 < x) & (x < 0.75) THEN
- c := -c
- END
-
- RETURN s / c
-END tan;
-
-
-PROCEDURE arctan2* (y, x: REAL): REAL;
-CONST
- P0 = 0.216062307897242551884E+3; P1 = 0.3226620700132512059245E+3;
- P2 = 0.13270239816397674701E+3; P3 = 0.1288838303415727934E+2;
- Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3;
- Q2 = 0.221050883028417680623E+3; Q3 = 0.3850148650835119501E+2;
- Sqrt3 = 1.7320508075688772935E0;
-
-VAR
- atan, z, z2, p, q: REAL;
- yExp, xExp, Quadrant: INTEGER;
-
-BEGIN
- IF ABS(x) < miny THEN
- ASSERT(ABS(y) >= miny);
- atan := piByTwo
- ELSE
- z := y;
- UNPK(z, yExp);
- z := x;
- UNPK(z, xExp);
-
- IF yExp - xExp >= expoMax - 3 THEN
- atan := piByTwo
- ELSIF yExp - xExp < expoMin + 3 THEN
- atan := ZERO
- ELSE
- IF ABS(y) > ABS(x) THEN
- z := ABS(x / y);
- Quadrant := 2
- ELSE
- z := ABS(y / x);
- Quadrant := 0
- END;
-
- IF z > TWO - Sqrt3 THEN
- z := (z * Sqrt3 - ONE) / (Sqrt3 + z);
- INC(Quadrant)
- END;
-
- IF ABS(z) < Limit THEN
- atan := z
- ELSE
- z2 := z * z;
- p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z;
- q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0;
- atan := p / q
- END;
-
- CASE Quadrant OF
- |0:
- |1: atan := atan + pi / 6.0
- |2: atan := piByTwo - atan
- |3: atan := pi / 3.0 - atan
- END
- END;
-
- IF x < ZERO THEN
- atan := pi - atan
- END
- END;
-
- IF y < ZERO THEN
- atan := -atan
- END
-
- RETURN atan
-END arctan2;
-
-
-PROCEDURE arcsin* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) <= ONE)
- RETURN arctan2(x, sqrt(ONE - x * x))
-END arcsin;
-
-
-PROCEDURE arccos* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) <= ONE)
- RETURN arctan2(sqrt(ONE - x * x), x)
-END arccos;
-
-
-PROCEDURE arctan* (x: REAL): REAL;
- RETURN arctan2(x, ONE)
-END arctan;
-
-
-PROCEDURE sinh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x - ONE / x) * HALF
-END sinh;
-
-
-PROCEDURE cosh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x + ONE / x) * HALF
-END cosh;
-
-
-PROCEDURE tanh* (x: REAL): REAL;
-BEGIN
- IF x > 15.0 THEN
- x := ONE
- ELSIF x < -15.0 THEN
- x := -ONE
- ELSE
- x := exp(TWO * x);
- x := (x - ONE) / (x + ONE)
- END
-
- RETURN x
-END tanh;
-
-
-PROCEDURE arsinh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x + ONE))
-END arsinh;
-
-
-PROCEDURE arcosh* (x: REAL): REAL;
-BEGIN
- ASSERT(x >= ONE)
- RETURN ln(x + sqrt(x * x - ONE))
-END arcosh;
-
-
-PROCEDURE artanh* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) < ONE)
- RETURN HALF * ln((ONE + x) / (ONE - x))
-END artanh;
-
-
-PROCEDURE sgn* (x: REAL): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF x > ZERO THEN
- res := 1
- ELSIF x < ZERO THEN
- res := -1
- ELSE
- res := 0
- END
-
- RETURN res
-END sgn;
-
-
-PROCEDURE fact* (n: INTEGER): REAL;
-VAR
- res: REAL;
-
-BEGIN
- res := ONE;
- WHILE n > 1 DO
- res := res * FLT(n);
- DEC(n)
- END
-
- RETURN res
-END fact;
-
-
-PROCEDURE DegToRad* (x: REAL): REAL;
- RETURN x * (pi / 180.0)
-END DegToRad;
-
-
-PROCEDURE RadToDeg* (x: REAL): REAL;
- RETURN x * (180.0 / pi)
-END RadToDeg;
-
-
-(* Return hypotenuse of triangle *)
-PROCEDURE hypot* (x, y: REAL): REAL;
-VAR
- a: REAL;
-
-BEGIN
- x := ABS(x);
- y := ABS(y);
- IF x > y THEN
- a := x * sqrt(1.0 + sqrr(y / x))
- ELSE
- IF x > 0.0 THEN
- a := y * sqrt(1.0 + sqrr(x / y))
- ELSE
- a := y
- END
- END
-
- RETURN a
-END hypot;
-
-
-BEGIN
- large := 1.9;
- PACK(large, expoMax);
- miny := ONE / large;
- LnInfinity := ln(large);
- LnSmall := ln(miny);
-END Math.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/Out.ob07 b/programs/develop/oberon07/Lib/Linux64/Out.ob07
deleted file mode 100644
index 6876dd4cd..000000000
--- a/programs/develop/oberon07/Lib/Linux64/Out.ob07
+++ /dev/null
@@ -1,87 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Out;
-
-IMPORT SYSTEM, Libdl;
-
-
-VAR
-
- printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER);
- printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER);
- printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision, x: INTEGER);
-
-
-PROCEDURE Char* (x: CHAR);
-BEGIN
- printf1(SYSTEM.SADR("%c"), ORD(x))
-END Char;
-
-
-PROCEDURE String* (s: ARRAY OF CHAR);
-BEGIN
- printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
-END String;
-
-
-PROCEDURE Ln*;
-BEGIN
- printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX))
-END Ln;
-
-
-PROCEDURE Int* (x, width: INTEGER);
-BEGIN
- printf2(SYSTEM.SADR("%*lld"), width, x)
-END Int;
-
-
-PROCEDURE intval (x: REAL): INTEGER;
-VAR
- i: INTEGER;
-
-BEGIN
- SYSTEM.GET(SYSTEM.ADR(x), i)
- RETURN i
-END intval;
-
-
-PROCEDURE Real* (x: REAL; width: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), intval(x))
-END Real;
-
-
-PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*f"), width, precision, intval(x))
-END FixReal;
-
-
-PROCEDURE Open*;
-END Open;
-
-
-PROCEDURE init;
-VAR
- libc, printf: INTEGER;
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- ASSERT(libc # 0);
- printf := Libdl.sym(libc, "printf");
- ASSERT(printf # 0);
- SYSTEM.PUT(SYSTEM.ADR(printf1), printf);
- SYSTEM.PUT(SYSTEM.ADR(printf2), printf);
- SYSTEM.PUT(SYSTEM.ADR(printf3), printf);
-END init;
-
-
-BEGIN
- init
-END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Linux64/RTL.ob07 b/programs/develop/oberon07/Lib/Linux64/RTL.ob07
deleted file mode 100644
index 7b6bbfb6a..000000000
--- a/programs/develop/oberon07/Lib/Linux64/RTL.ob07
+++ /dev/null
@@ -1,503 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE RTL;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- bit_depth* = 64;
- maxint* = 7FFFFFFFFFFFFFFFH;
- minint* = 8000000000000000H;
-
- WORD = bit_depth DIV 8;
- MAX_SET = bit_depth - 1;
-
-
-VAR
-
- name: INTEGER;
- types: INTEGER;
- sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER;
-
-
-PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *)
- 048H, 085H, 0C0H, (* test rax, rax *)
- 07EH, 020H, (* jle L *)
- 0FCH, (* cld *)
- 057H, (* push rdi *)
- 056H, (* push rsi *)
- 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *)
- 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *)
- 048H, 089H, 0C1H, (* mov rcx, rax *)
- 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *)
- 0F3H, 048H, 0A5H, (* rep movsd *)
- 048H, 089H, 0C1H, (* mov rcx, rax *)
- 048H, 083H, 0E1H, 007H, (* and rcx, 7 *)
- 0F3H, 0A4H, (* rep movsb *)
- 05EH, (* pop rsi *)
- 05FH (* pop rdi *)
- (* L: *)
- )
-END _move;
-
-
-PROCEDURE [stdcall64] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
-
-BEGIN
- IF len_src > len_dst THEN
- res := FALSE
- ELSE
- _move(len_src * base_size, dst, src);
- res := TRUE
- END
-
- RETURN res
-END _arrcpy;
-
-
-PROCEDURE [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
- _move(MIN(len_dst, len_src) * chr_size, dst, src)
-END _strcpy;
-
-
-PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER);
-VAR
- i, n, k: INTEGER;
-
-BEGIN
- k := LEN(A) - 1;
- n := A[0];
- i := 0;
- WHILE i < k DO
- A[i] := A[i + 1];
- INC(i)
- END;
- A[k] := n
-END _rot;
-
-
-PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER;
-BEGIN
- IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
- SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a)
- ELSE
- a := 0
- END
-
- RETURN a
-END _set;
-
-
-PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *)
-BEGIN
- SYSTEM.CODE(
- 048H, 031H, 0C0H, (* xor rax, rax *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *)
- 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *)
- 077H, 004H, (* ja L *)
- 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *)
- (* L: *)
- )
-END _set1;
-
-
-PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *)
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *)
- 048H, 031H, 0D2H, (* xor rdx, rdx *)
- 048H, 085H, 0C0H, (* test rax, rax *)
- 074H, 022H, (* je L2 *)
- 07FH, 003H, (* jg L1 *)
- 048H, 0F7H, 0D2H, (* not rdx *)
- (* L1: *)
- 049H, 089H, 0C0H, (* mov r8, rax *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *)
- 048H, 0F7H, 0F9H, (* idiv rcx *)
- 048H, 085H, 0D2H, (* test rdx, rdx *)
- 074H, 00EH, (* je L2 *)
- 049H, 031H, 0C8H, (* xor r8, rcx *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07DH, 006H, (* jge L2 *)
- 048H, 0FFH, 0C8H, (* dec rax *)
- 048H, 001H, 0CAH (* add rdx, rcx *)
- (* L2: *)
- )
-END _divmod;
-
-
-PROCEDURE [stdcall64] _new* (t, size: INTEGER; VAR ptr: INTEGER);
-BEGIN
- ptr := API._NEW(size);
- IF ptr # 0 THEN
- SYSTEM.PUT(ptr, t);
- INC(ptr, WORD)
- END
-END _new;
-
-
-PROCEDURE [stdcall64] _dispose* (VAR ptr: INTEGER);
-BEGIN
- IF ptr # 0 THEN
- ptr := API._DISPOSE(ptr - WORD)
- END
-END _dispose;
-
-
-PROCEDURE [stdcall64] _length* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
- 048H, 0FFH, 0C8H, (* dec rax *)
- (* L1: *)
- 048H, 0FFH, 0C0H, (* inc rax *)
- 080H, 038H, 000H, (* cmp byte [rax], 0 *)
- 074H, 005H, (* jz L2 *)
- 0E2H, 0F6H, (* loop L1 *)
- 048H, 0FFH, 0C0H, (* inc rax *)
- (* L2: *)
- 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *)
- )
-END _length;
-
-
-PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
- 048H, 083H, 0E8H, 002H, (* sub rax, 2 *)
- (* L1: *)
- 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
- 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *)
- 074H, 006H, (* jz L2 *)
- 0E2H, 0F4H, (* loop L1 *)
- 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
- (* L2: *)
- 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *)
- 048H, 0D1H, 0E8H (* shr rax, 1 *)
- )
-END _lengthw;
-
-
-PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
- 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
- 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
- 04DH, 031H, 0C9H, (* xor r9, r9 *)
- 04DH, 031H, 0D2H, (* xor r10, r10 *)
- 048H, 0B8H, 000H, 000H,
- 000H, 000H, 000H, 000H,
- 000H, 080H, (* movabs rax, minint *)
- (* L1: *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07EH, 024H, (* jle L3 *)
- 044H, 08AH, 009H, (* mov r9b, byte[rcx] *)
- 044H, 08AH, 012H, (* mov r10b, byte[rdx] *)
- 048H, 0FFH, 0C1H, (* inc rcx *)
- 048H, 0FFH, 0C2H, (* inc rdx *)
- 049H, 0FFH, 0C8H, (* dec r8 *)
- 04DH, 039H, 0D1H, (* cmp r9, r10 *)
- 074H, 008H, (* je L2 *)
- 04CH, 089H, 0C8H, (* mov rax, r9 *)
- 04CH, 029H, 0D0H, (* sub rax, r10 *)
- 0EBH, 008H, (* jmp L3 *)
- (* L2: *)
- 04DH, 085H, 0C9H, (* test r9, r9 *)
- 075H, 0DAH, (* jne L1 *)
- 048H, 031H, 0C0H, (* xor rax, rax *)
- (* L3: *)
- 05DH, (* pop rbp *)
- 0C2H, 018H, 000H (* ret 24 *)
- )
- RETURN 0
-END strncmp;
-
-
-PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
- 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
- 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
- 04DH, 031H, 0C9H, (* xor r9, r9 *)
- 04DH, 031H, 0D2H, (* xor r10, r10 *)
- 048H, 0B8H, 000H, 000H,
- 000H, 000H, 000H, 000H,
- 000H, 080H, (* movabs rax, minint *)
- (* L1: *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07EH, 028H, (* jle L3 *)
- 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *)
- 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *)
- 048H, 083H, 0C1H, 002H, (* add rcx, 2 *)
- 048H, 083H, 0C2H, 002H, (* add rdx, 2 *)
- 049H, 0FFH, 0C8H, (* dec r8 *)
- 04DH, 039H, 0D1H, (* cmp r9, r10 *)
- 074H, 008H, (* je L2 *)
- 04CH, 089H, 0C8H, (* mov rax, r9 *)
- 04CH, 029H, 0D0H, (* sub rax, r10 *)
- 0EBH, 008H, (* jmp L3 *)
- (* L2: *)
- 04DH, 085H, 0C9H, (* test r9, r9 *)
- 075H, 0D6H, (* jne L1 *)
- 048H, 031H, 0C0H, (* xor rax, rax *)
- (* L3: *)
- 05DH, (* pop rbp *)
- 0C2H, 018H, 000H (* ret 24 *)
- )
- RETURN 0
-END strncmpw;
-
-
-PROCEDURE [stdcall64] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: CHAR;
-
-BEGIN
- res := strncmp(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmp;
-
-
-PROCEDURE [stdcall64] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: WCHAR;
-
-BEGIN
- res := strncmpw(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2 * 2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1 * 2, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmpw;
-
-
-PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- c: CHAR;
- i: INTEGER;
-
-BEGIN
- i := 0;
- REPEAT
- SYSTEM.GET(pchar, c);
- s[i] := c;
- INC(pchar);
- INC(i)
- UNTIL c = 0X
-END PCharToStr;
-
-
-PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
- i, a: INTEGER;
-
-BEGIN
- i := 0;
- a := x;
- REPEAT
- INC(i);
- a := a DIV 10
- UNTIL a = 0;
-
- str[i] := 0X;
-
- REPEAT
- DEC(i);
- str[i] := CHR(x MOD 10 + ORD("0"));
- x := x DIV 10
- UNTIL x = 0
-END IntToStr;
-
-
-PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
- n1, n2: INTEGER;
-
-BEGIN
- n1 := LENGTH(s1);
- n2 := LENGTH(s2);
-
- ASSERT(n1 + n2 < LEN(s1));
-
- SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
- s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER);
-VAR
- s, temp: ARRAY 1024 OF CHAR;
-
-BEGIN
- CASE err OF
- | 1: s := "assertion failure"
- | 2: s := "NIL dereference"
- | 3: s := "bad divisor"
- | 4: s := "NIL procedure call"
- | 5: s := "type guard error"
- | 6: s := "index out of range"
- | 7: s := "invalid CASE"
- | 8: s := "array assignment error"
- | 9: s := "CHR out of range"
- |10: s := "WCHR out of range"
- |11: s := "BYTE out of range"
- END;
-
- append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
- append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
-
- API.DebugMsg(SYSTEM.ADR(s[0]), name);
-
- API.exit_thread(0)
-END _error;
-
-
-PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _isrec;
-
-
-PROCEDURE [stdcall64] _is* (t0, p: INTEGER): INTEGER;
-BEGIN
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- END
-
- RETURN p MOD 2
-END _is;
-
-
-PROCEDURE [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _guardrec;
-
-
-PROCEDURE [stdcall64] _guard* (t0, p: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(p, p);
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- ELSE
- p := 1
- END
-
- RETURN p MOD 2
-END _guard;
-
-
-PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
-END _dllentry;
-
-
-PROCEDURE [stdcall64] _sofinit*;
-BEGIN
- API.sofinit
-END _sofinit;
-
-
-PROCEDURE [stdcall64] _exit* (code: INTEGER);
-BEGIN
- API.exit(code)
-END _exit;
-
-
-PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
-VAR
- t0, t1, i, j: INTEGER;
-
-BEGIN
- API.init(param, code);
-
- types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
- ASSERT(types # 0);
- FOR i := 0 TO tcount - 1 DO
- FOR j := 0 TO tcount - 1 DO
- t0 := i; t1 := j;
-
- WHILE (t1 # 0) & (t1 # t0) DO
- SYSTEM.GET(_types + t1 * WORD, t1)
- END;
-
- SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
- END
- END;
-
- FOR i := 0 TO MAX_SET DO
- FOR j := 0 TO i DO
- sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i)
- END
- END;
-
- name := modname
-END _init;
-
-
-END RTL.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/MSP430/MSP430.ob07 b/programs/develop/oberon07/Lib/MSP430/MSP430.ob07
deleted file mode 100644
index 8cf8169b6..000000000
--- a/programs/develop/oberon07/Lib/MSP430/MSP430.ob07
+++ /dev/null
@@ -1,125 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE MSP430;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- iv = 0FFC0H;
-
- bsl = iv - 2;
- sp = bsl - 2;
- empty_proc = sp - 2;
- free_size = empty_proc - 2;
- free_adr = free_size - 2;
- bits = free_adr - 272;
- bits_offs = bits - 32;
- types = bits_offs - 2;
-
- ram = 200H;
-
- trap = ram;
- int = trap + 2;
-
-
- GIE* = {3};
- CPUOFF* = {4};
- OSCOFF* = {5};
- SCG0* = {6};
- SCG1* = {7};
-
-
-TYPE
-
- TInterrupt* = RECORD priority*: INTEGER; sr*: SET; pc*: INTEGER END;
-
- TTrapProc* = PROCEDURE (modNum, modName, err, line: INTEGER);
-
- TIntProc* = PROCEDURE (priority: INTEGER; interrupt: TInterrupt);
-
-
-PROCEDURE SetTrapProc* (TrapProc: TTrapProc);
-BEGIN
- SYSTEM.PUT(trap, TrapProc)
-END SetTrapProc;
-
-
-PROCEDURE SetIntProc* (IntProc: TIntProc);
-BEGIN
- SYSTEM.PUT(int, IntProc)
-END SetIntProc;
-
-
-PROCEDURE SetIntPC* (interrupt: TInterrupt; NewPC: INTEGER);
-BEGIN
- SYSTEM.PUT(SYSTEM.ADR(interrupt.pc), NewPC)
-END SetIntPC;
-
-
-PROCEDURE SetIntSR* (interrupt: TInterrupt; NewSR: SET);
-BEGIN
- SYSTEM.PUT(SYSTEM.ADR(interrupt.sr), NewSR)
-END SetIntSR;
-
-
-PROCEDURE [code] DInt*
- 0C232H; (* BIC #8, SR *)
-
-
-PROCEDURE [code] EInt*
- 0D232H; (* BIS #8, SR *)
-
-
-PROCEDURE [code] CpuOff*
- 0D032H, 16; (* BIS #16, SR *)
-
-
-PROCEDURE [code] Halt*
- 4032H, 0F0H; (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
-
-
-PROCEDURE [code] Restart*
- 4302H, (* MOV #0, SR *)
- 4210H, 0FFFEH; (* MOV 0FFFEH(SR), PC *)
-
-
-PROCEDURE [code] SetSR* (bits: SET)
- 0D112H, 2; (* BIS 2(SP), SR *)
-
-
-PROCEDURE [code] ClrSR* (bits: SET)
- 0C112H, 2; (* BIC 2(SP), SR *)
-
-
-PROCEDURE GetFreeFlash* (VAR address, size: INTEGER);
-BEGIN
- SYSTEM.GET(free_adr, address);
- SYSTEM.GET(free_size, size)
-END GetFreeFlash;
-
-
-PROCEDURE [code] Delay* (n: INTEGER)
- 4035H, 124, (* MOV #124, R5 *)
- (* L2: *)
- 4114H, 2, (* MOV 2(SP), R4 *)
- 8324H, (* SUB #2, R4 *)
- (* L1: *)
- 4303H, (* NOP *)
- 4303H, (* NOP *)
- 4303H, (* NOP *)
- 4303H, (* NOP *)
- 4303H, (* NOP *)
- 8314H, (* SUB #1, R4 *)
- 3800H - 7, (* JGE L1 *)
- 8315H, (* SUB #1, R5 *)
- 3800H - 12; (* JGE L2 *)
-
-
-END MSP430.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/API.ob07 b/programs/develop/oberon07/Lib/Windows32/API.ob07
deleted file mode 100644
index 437d08b89..000000000
--- a/programs/develop/oberon07/Lib/Windows32/API.ob07
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE API;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- eol* = 0DX + 0AX;
-
- SectionAlignment = 1000H;
-
- DLL_PROCESS_ATTACH = 1;
- DLL_THREAD_ATTACH = 2;
- DLL_THREAD_DETACH = 3;
- DLL_PROCESS_DETACH = 0;
-
- KERNEL = "kernel32.dll";
- USER = "user32.dll";
-
-
-TYPE
-
- DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
-
-
-VAR
-
- base*: INTEGER;
- heap: INTEGER;
-
- process_detach,
- thread_detach,
- thread_attach: DLL_ENTRY;
-
-
-PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
-PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
-PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
-PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
-PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER);
-PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-
-PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
-BEGIN
- MessageBoxA(0, lpText, lpCaption, 16)
-END DebugMsg;
-
-
-PROCEDURE _NEW* (size: INTEGER): INTEGER;
- RETURN HeapAlloc(heap, 8, size)
-END _NEW;
-
-
-PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
-BEGIN
- HeapFree(heap, 0, p)
- RETURN 0
-END _DISPOSE;
-
-
-PROCEDURE init* (reserved, code: INTEGER);
-BEGIN
- process_detach := NIL;
- thread_detach := NIL;
- thread_attach := NIL;
- base := code - SectionAlignment;
- heap := GetProcessHeap()
-END init;
-
-
-PROCEDURE exit* (code: INTEGER);
-BEGIN
- ExitProcess(code)
-END exit;
-
-
-PROCEDURE exit_thread* (code: INTEGER);
-BEGIN
- ExitThread(code)
-END exit_thread;
-
-
-PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := 0;
-
- CASE fdwReason OF
- |DLL_PROCESS_ATTACH:
- res := 1
- |DLL_THREAD_ATTACH:
- IF thread_attach # NIL THEN
- thread_attach(hinstDLL, fdwReason, lpvReserved)
- END
- |DLL_THREAD_DETACH:
- IF thread_detach # NIL THEN
- thread_detach(hinstDLL, fdwReason, lpvReserved)
- END
- |DLL_PROCESS_DETACH:
- IF process_detach # NIL THEN
- process_detach(hinstDLL, fdwReason, lpvReserved)
- END
- ELSE
- END
-
- RETURN res
-END dllentry;
-
-
-PROCEDURE sofinit*;
-END sofinit;
-
-
-PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY);
-BEGIN
- process_detach := _process_detach;
- thread_detach := _thread_detach;
- thread_attach := _thread_attach
-END SetDll;
-
-
-END API.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/Args.ob07 b/programs/develop/oberon07/Lib/Windows32/Args.ob07
deleted file mode 100644
index fd56e3b97..000000000
--- a/programs/develop/oberon07/Lib/Windows32/Args.ob07
+++ /dev/null
@@ -1,101 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Args;
-
-IMPORT SYSTEM, WINAPI;
-
-
-CONST
-
- MAX_PARAM = 1024;
-
-
-VAR
-
- Params: ARRAY MAX_PARAM, 2 OF INTEGER;
- argc*: INTEGER;
-
-
-PROCEDURE GetChar (adr: INTEGER): CHAR;
-VAR
- res: CHAR;
-
-BEGIN
- SYSTEM.GET(adr, res)
- RETURN res
-END GetChar;
-
-
-PROCEDURE ParamParse;
-VAR
- p, count, cond: INTEGER;
- c: CHAR;
-
-
- PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR): INTEGER;
- BEGIN
- IF (c <= 20X) & (c # 0X) THEN
- cond := A
- ELSIF c = 22X THEN
- cond := B
- ELSIF c = 0X THEN
- cond := 6
- ELSE
- cond := C
- END
-
- RETURN cond
- END ChangeCond;
-
-
-BEGIN
- p := WINAPI.GetCommandLineA();
- cond := 0;
- count := 0;
- WHILE (count < MAX_PARAM) & (cond # 6) DO
- c := GetChar(p);
- CASE cond OF
- |0: IF ChangeCond(0, 4, 1, cond, c) = 1 THEN Params[count, 0] := p END
- |1: IF ChangeCond(0, 3, 1, cond, c) IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
- |3: IF ChangeCond(3, 1, 3, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |4: IF ChangeCond(5, 0, 5, cond, c) = 5 THEN Params[count, 0] := p END
- |5: IF ChangeCond(5, 1, 5, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |6:
- END;
- INC(p)
- END;
- argc := count
-END ParamParse;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, j, len: INTEGER;
- c: CHAR;
-
-BEGIN
- j := 0;
- IF n < argc THEN
- i := Params[n, 0];
- len := LEN(s) - 1;
- WHILE (j < len) & (i <= Params[n, 1]) DO
- c := GetChar(i);
- IF c # '"' THEN
- s[j] := c;
- INC(j)
- END;
- INC(i)
- END
- END;
- s[j] := 0X
-END GetArg;
-
-
-BEGIN
- ParamParse
-END Args.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/Console.ob07 b/programs/develop/oberon07/Lib/Windows32/Console.ob07
deleted file mode 100644
index 83bf0f382..000000000
--- a/programs/develop/oberon07/Lib/Windows32/Console.ob07
+++ /dev/null
@@ -1,100 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Console;
-
-IMPORT SYSTEM, WINAPI, In, Out;
-
-
-CONST
-
- Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3;
- Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7;
- DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11;
- LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
-
-PROCEDURE SetCursor* (X, Y: INTEGER);
-BEGIN
- WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536)
-END SetCursor;
-
-
-PROCEDURE GetCursor* (VAR X, Y: INTEGER);
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
- X := ORD(ScrBufInfo.dwCursorPosition.X);
- Y := ORD(ScrBufInfo.dwCursorPosition.Y)
-END GetCursor;
-
-
-PROCEDURE Cls*;
-VAR
- fill: INTEGER;
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
- fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y);
- WINAPI.FillConsoleOutputCharacterA(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill));
- WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill));
- SetCursor(0, 0)
-END Cls;
-
-
-PROCEDURE SetColor* (FColor, BColor: INTEGER);
-BEGIN
- IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN
- WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor)
- END
-END SetColor;
-
-
-PROCEDURE GetCursorX* (): INTEGER;
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
- RETURN ORD(ScrBufInfo.dwCursorPosition.X)
-END GetCursorX;
-
-
-PROCEDURE GetCursorY* (): INTEGER;
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
- RETURN ORD(ScrBufInfo.dwCursorPosition.Y)
-END GetCursorY;
-
-
-PROCEDURE open*;
-BEGIN
- WINAPI.AllocConsole;
- hConsoleOutput := WINAPI.GetStdHandle(-11);
- In.Open;
- Out.Open
-END open;
-
-
-PROCEDURE exit* (b: BOOLEAN);
-BEGIN
- WINAPI.FreeConsole
-END exit;
-
-
-END Console.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/DateTime.ob07 b/programs/develop/oberon07/Lib/Windows32/DateTime.ob07
deleted file mode 100644
index 39bc64146..000000000
--- a/programs/develop/oberon07/Lib/Windows32/DateTime.ob07
+++ /dev/null
@@ -1,197 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE DateTime;
-
-IMPORT WINAPI, SYSTEM;
-
-
-CONST
-
- ERR* = -7.0E5;
-
-
-VAR
-
- DateTable: ARRAY 120000, 3 OF INTEGER;
- MonthsTable: ARRAY 13, 4 OF INTEGER;
-
-
-PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL;
-VAR
- d, bis: INTEGER;
- res: REAL;
-
-BEGIN
- res := ERR;
- IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
- (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
- (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) &
- (MSec >= 0) & (MSec <= 999) THEN
-
- bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
-
- IF Day <= MonthsTable[Month][2 + bis] THEN
- DEC(Year);
- d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) +
- MonthsTable[Month][bis] + Day - 693594;
- res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0
- END
- END
- RETURN res
-END Encode;
-
-
-PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
- d, t: INTEGER;
- L, R, M: INTEGER;
-
-BEGIN
- res := (Date >= -693593.0) & (Date < 2958466.0);
- IF res THEN
- d := FLOOR(Date);
- t := FLOOR((Date - FLT(d)) * 86400000.0);
- INC(d, 693593);
-
- L := 0;
- R := LEN(DateTable) - 1;
- M := (L + R) DIV 2;
-
- WHILE R - L > 1 DO
- IF d > DateTable[M][0] THEN
- L := M;
- M := (L + R) DIV 2
- ELSIF d < DateTable[M][0] THEN
- R := M;
- M := (L + R) DIV 2
- ELSE
- L := M;
- R := M
- END
- END;
-
- Year := DateTable[L][1];
- Month := DateTable[L][2];
- Day := d - DateTable[L][0] + 1;
-
- Hour := t DIV 3600000; t := t MOD 3600000;
- Min := t DIV 60000; t := t MOD 60000;
- Sec := t DIV 1000;
- MSec := t MOD 1000
- END
-
- RETURN res
-END Decode;
-
-
-PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER);
-VAR
- T: WINAPI.TSystemTime;
-
-BEGIN
- WINAPI.GetLocalTime(T);
- Year := ORD(T.Year);
- Month := ORD(T.Month);
- Day := ORD(T.Day);
- Hour := ORD(T.Hour);
- Min := ORD(T.Min);
- Sec := ORD(T.Sec);
- MSec := ORD(T.MSec)
-END Now;
-
-
-PROCEDURE NowEncode* (): REAL;
-VAR
- Year, Month, Day, Hour, Min, Sec, MSec: INTEGER;
-
-BEGIN
- Now(Year, Month, Day, Hour, Min, Sec, MSec)
- RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec)
-END NowEncode;
-
-
-PROCEDURE NowUnixTime* (): INTEGER;
- RETURN WINAPI.time(0)
-END NowUnixTime;
-
-
-PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER;
-VAR
- t: WINAPI.tm;
-
-BEGIN
- DEC(Year, 1900);
- DEC(Month);
- SYSTEM.GET(SYSTEM.ADR(Sec), t.sec);
- SYSTEM.GET(SYSTEM.ADR(Min), t.min);
- SYSTEM.GET(SYSTEM.ADR(Hour), t.hour);
- SYSTEM.GET(SYSTEM.ADR(Day), t.mday);
- SYSTEM.GET(SYSTEM.ADR(Month), t.mon);
- SYSTEM.GET(SYSTEM.ADR(Year), t.year);
-
- RETURN WINAPI.mktime(t)
-END UnixTime;
-
-
-PROCEDURE init;
-VAR
- day, year, month, i: INTEGER;
- Months: ARRAY 13 OF INTEGER;
-
-BEGIN
- Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30;
- Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31;
- Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31;
-
- day := 0;
- year := 1;
- month := 1;
- i := 0;
-
- WHILE year <= 10000 DO
- DateTable[i][0] := day;
- DateTable[i][1] := year;
- DateTable[i][2] := month;
- INC(day, Months[month]);
- IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN
- INC(day)
- END;
- INC(month);
- IF month > 12 THEN
- month := 1;
- INC(year)
- END;
- INC(i)
- END;
-
- MonthsTable[1][0] := 0;
- FOR i := 2 TO 12 DO
- MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1]
- END;
-
- FOR i := 1 TO 12 DO
- MonthsTable[i][2] := Months[i]
- END;
-
- Months[2] := 29;
- MonthsTable[1][1] := 0;
- FOR i := 2 TO 12 DO
- MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1]
- END;
-
- FOR i := 1 TO 12 DO
- MonthsTable[i][3] := Months[i]
- END
-
-END init;
-
-
-BEGIN
- init
-END DateTime.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/File.ob07 b/programs/develop/oberon07/Lib/Windows32/File.ob07
deleted file mode 100644
index b02f522a8..000000000
--- a/programs/develop/oberon07/Lib/Windows32/File.ob07
+++ /dev/null
@@ -1,139 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE File;
-
-IMPORT SYSTEM, WINAPI, API;
-
-
-CONST
-
- OPEN_R* = 0; OPEN_W* = 1; OPEN_RW* = 2;
- SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
-
-
-PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
- FindData: WINAPI.TWin32FindData;
- Handle: INTEGER;
- attr: SET;
-
-BEGIN
- Handle := WINAPI.FindFirstFileA(SYSTEM.ADR(FName[0]), FindData);
- IF Handle # -1 THEN
- WINAPI.FindClose(Handle);
- SYSTEM.GET32(SYSTEM.ADR(FindData.dwFileAttributes), attr);
- IF 4 IN attr THEN
- Handle := -1
- END
- END
-
- RETURN Handle # -1
-END Exists;
-
-
-PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.DeleteFileA(SYSTEM.ADR(FName[0])) # 0
-END Delete;
-
-
-PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
- RETURN WINAPI.CreateFileA(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
-END Create;
-
-
-PROCEDURE Close* (F: INTEGER);
-BEGIN
- WINAPI.CloseHandle(F)
-END Close;
-
-
-PROCEDURE Open* (FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER;
-VAR
- ofstr: WINAPI.OFSTRUCT;
-BEGIN
- RETURN WINAPI.OpenFile(SYSTEM.ADR(FName[0]), ofstr, Mode)
-END Open;
-
-
-PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
- RETURN WINAPI.SetFilePointer(F, Offset, 0, Origin)
-END Seek;
-
-
-PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END Read;
-
-
-PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END Write;
-
-
-PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
-VAR
- res, n, F: INTEGER;
-
-BEGIN
- res := 0;
- F := Open(FName, OPEN_R);
-
- IF F # -1 THEN
- Size := Seek(F, 0, SEEK_END);
- n := Seek(F, 0, SEEK_BEG);
- res := API._NEW(Size);
- IF (res = 0) OR (Read(F, res, Size) # Size) THEN
- IF res # 0 THEN
- res := API._DISPOSE(res);
- Size := 0
- END
- END;
- Close(F)
- END
-
- RETURN res
-END Load;
-
-
-PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.RemoveDirectoryA(SYSTEM.ADR(DirName[0])) # 0
-END RemoveDir;
-
-
-PROCEDURE ExistsDir* (DirName: ARRAY OF CHAR): BOOLEAN;
-VAR
- Code: SET;
-
-BEGIN
- Code := WINAPI.GetFileAttributesA(SYSTEM.ADR(DirName[0]))
- RETURN (Code # {0..31}) & (4 IN Code)
-END ExistsDir;
-
-
-PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.CreateDirectoryA(SYSTEM.ADR(DirName[0]), NIL) # 0
-END CreateDir;
-
-
-END File.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 b/programs/develop/oberon07/Lib/Windows32/HOST.ob07
deleted file mode 100644
index 045fce7ea..000000000
--- a/programs/develop/oberon07/Lib/Windows32/HOST.ob07
+++ /dev/null
@@ -1,333 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE HOST;
-
-IMPORT SYSTEM, RTL;
-
-
-CONST
-
- slash* = "\";
- eol* = 0DX + 0AX;
-
- bit_depth* = RTL.bit_depth;
- maxint* = RTL.maxint;
- minint* = RTL.minint;
-
- MAX_PARAM = 1024;
-
- OFS_MAXPATHNAME = 128;
-
-
-TYPE
-
- POverlapped = POINTER TO OVERLAPPED;
-
- OVERLAPPED = RECORD
-
- Internal: INTEGER;
- InternalHigh: INTEGER;
- Offset: INTEGER;
- OffsetHigh: INTEGER;
- hEvent: INTEGER
-
- END;
-
- OFSTRUCT = RECORD
-
- cBytes: CHAR;
- fFixedDisk: CHAR;
- nErrCode: WCHAR;
- Reserved1: WCHAR;
- Reserved2: WCHAR;
- szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
-
- END;
-
- PSecurityAttributes = POINTER TO TSecurityAttributes;
-
- TSecurityAttributes = RECORD
-
- nLength: INTEGER;
- lpSecurityDescriptor: INTEGER;
- bInheritHandle: INTEGER
-
- END;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
- Params: ARRAY MAX_PARAM, 2 OF INTEGER;
- argc: INTEGER;
-
- maxreal*: REAL;
-
-
-PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]
- _GetTickCount (): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
- _GetStdHandle (nStdHandle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]
- _GetCommandLine (): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "ReadFile"]
- _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "WriteFile"]
- _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]
- _CloseHandle (hObject: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]
- _CreateFile (
- lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
- lpSecurityAttributes: PSecurityAttributes;
- dwCreationDisposition, dwFlagsAndAttributes,
- hTemplateFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "OpenFile"]
- _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]
- _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "ExitProcess"]
- _ExitProcess (code: INTEGER);
-
-PROCEDURE [ccall, "msvcrt.dll", "time"]
- _time (ptr: INTEGER): INTEGER;
-
-
-PROCEDURE ExitProcess* (code: INTEGER);
-BEGIN
- _ExitProcess(code)
-END ExitProcess;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-VAR
- n: INTEGER;
-
-BEGIN
- n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));
- path[n] := slash;
- path[n + 1] := 0X
-END GetCurrentDirectory;
-
-
-PROCEDURE GetChar (adr: INTEGER): CHAR;
-VAR
- res: CHAR;
-
-BEGIN
- SYSTEM.GET(adr, res)
- RETURN res
-END GetChar;
-
-
-PROCEDURE ParamParse;
-VAR
- p, count, cond: INTEGER;
- c: CHAR;
-
-
- PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
- BEGIN
- IF (c <= 20X) & (c # 0X) THEN
- cond := A
- ELSIF c = 22X THEN
- cond := B
- ELSIF c = 0X THEN
- cond := 6
- ELSE
- cond := C
- END
- END ChangeCond;
-
-
-BEGIN
- p := _GetCommandLine();
- cond := 0;
- count := 0;
- WHILE (count < MAX_PARAM) & (cond # 6) DO
- c := GetChar(p);
- CASE cond OF
- |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END
- |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
- |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END
- |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |6:
- END;
- INC(p)
- END;
- argc := count
-END ParamParse;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, j, len: INTEGER;
- c: CHAR;
-
-BEGIN
- j := 0;
- IF n < argc THEN
- len := LEN(s) - 1;
- i := Params[n, 0];
- WHILE (j < len) & (i <= Params[n, 1]) DO
- c := GetChar(i);
- IF c # 22X THEN
- s[j] := c;
- INC(j)
- END;
- INC(i)
- END
- END;
- s[j] := 0X
-END GetArg;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
- RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
-END FileCreate;
-
-
-PROCEDURE FileClose* (F: INTEGER);
-BEGIN
- _CloseHandle(F)
-END FileClose;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
-VAR
- ofstr: OFSTRUCT;
- res: INTEGER;
-
-BEGIN
- res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);
- IF res = 0FFFFFFFFH THEN
- res := -1
- END
-
- RETURN res
-END FileOpen;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-END chmod;
-
-
-PROCEDURE OutChar* (c: CHAR);
-VAR
- count: INTEGER;
-BEGIN
- _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)
-END OutChar;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
- RETURN _GetTickCount() DIV 10
-END GetTickCount;
-
-
-PROCEDURE letter (c: CHAR): BOOLEAN;
- RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
-END letter;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
- RETURN ~(letter(path[0]) & (path[1] = ":"))
-END isRelative;
-
-
-PROCEDURE UnixTime* (): INTEGER;
- RETURN _time(0)
-END UnixTime;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET32(SYSTEM.ADR(x), a);
- SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
- RETURN a
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-VAR
- h, l, s, e: INTEGER;
-
-BEGIN
- e := splitf(x, l, h);
-
- s := ASR(h, 31) MOD 2;
- e := (h DIV 100000H) MOD 2048;
- IF e <= 896 THEN
- h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
- REPEAT
- h := h DIV 2;
- INC(e)
- UNTIL e = 897;
- e := 896;
- l := (h MOD 8) * 20000000H;
- h := h DIV 8
- ELSIF (1151 <= e) & (e < 2047) THEN
- e := 1151;
- h := 0;
- l := 0
- ELSIF e = 2047 THEN
- e := 1151;
- IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
- h := 80000H;
- l := 0
- END
- END;
- DEC(e, 896)
-
- RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
-END d2s;
-
-
-BEGIN
- maxreal := 1.9;
- PACK(maxreal, 1023);
- hConsoleOutput := _GetStdHandle(-11);
- ParamParse
-END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/In.ob07 b/programs/develop/oberon07/Lib/Windows32/In.ob07
deleted file mode 100644
index 3f5cc213c..000000000
--- a/programs/develop/oberon07/Lib/Windows32/In.ob07
+++ /dev/null
@@ -1,80 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE In;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- MAX_LEN = 1024;
-
-
-VAR
-
- Done*: BOOLEAN;
- hConsoleInput: INTEGER;
- s: ARRAY MAX_LEN + 4 OF CHAR;
-
-
-PROCEDURE [ccall, "msvcrt.dll", ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
-PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER;
-PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER);
-
-
-PROCEDURE String* (VAR str: ARRAY OF CHAR);
-VAR
- count: INTEGER;
-
-BEGIN
- ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0);
- IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN
- DEC(count, 2)
- END;
- s[count] := 0X;
- COPY(s, str);
- str[LEN(str) - 1] := 0X;
- Done := TRUE
-END String;
-
-
-PROCEDURE Int* (VAR x: INTEGER);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%d"), SYSTEM.ADR(x)) = 1
-END Int;
-
-
-PROCEDURE Real* (VAR x: REAL);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
-END Real;
-
-
-PROCEDURE Char* (VAR x: CHAR);
-BEGIN
- String(s);
- x := s[0]
-END Char;
-
-
-PROCEDURE Ln*;
-BEGIN
- String(s)
-END Ln;
-
-
-PROCEDURE Open*;
-BEGIN
- hConsoleInput := GetStdHandle(-10);
- Done := TRUE
-END Open;
-
-
-END In.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/Math.ob07 b/programs/develop/oberon07/Lib/Windows32/Math.ob07
deleted file mode 100644
index d6056af74..000000000
--- a/programs/develop/oberon07/Lib/Windows32/Math.ob07
+++ /dev/null
@@ -1,450 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2013-2014, 2018-2020 Anton Krotov
- All rights reserved.
-*)
-
-MODULE Math;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- pi* = 3.141592653589793;
- e* = 2.718281828459045;
-
-
-PROCEDURE IsNan* (x: REAL): BOOLEAN;
-VAR
- h, l: SET;
-
-BEGIN
- SYSTEM.GET(SYSTEM.ADR(x), l);
- SYSTEM.GET(SYSTEM.ADR(x) + 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) = SYSTEM.INF()
-END IsInf;
-
-
-PROCEDURE Max (a, b: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF a > b THEN
- res := a
- ELSE
- res := b
- END
- RETURN res
-END Max;
-
-
-PROCEDURE Min (a, b: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF a < b THEN
- res := a
- ELSE
- res := b
- END
- RETURN res
-END Min;
-
-
-PROCEDURE SameValue (a, b: REAL): BOOLEAN;
-VAR
- eps: REAL;
- res: BOOLEAN;
-
-BEGIN
- eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
- IF a > b THEN
- res := (a - b) <= eps
- ELSE
- res := (b - a) <= eps
- END
- RETURN res
-END SameValue;
-
-
-PROCEDURE IsZero (x: REAL): BOOLEAN;
- RETURN ABS(x) <= 1.0E-12
-END IsZero;
-
-
-PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FAH, (* fsqrt *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END sqrt;
-
-
-PROCEDURE [stdcall] sin* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FEH, (* fsin *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END sin;
-
-
-PROCEDURE [stdcall] cos* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FFH, (* fcos *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END cos;
-
-
-PROCEDURE [stdcall] tan* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0FBH, (* fsincos *)
- 0DEH, 0F9H, (* fdivp st1, st *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END tan;
-
-
-PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
- 0D9H, 0F3H, (* fpatan *)
- 0C9H, (* leave *)
- 0C2H, 010H, 000H (* ret 10h *)
- )
- RETURN 0.0
-END arctan2;
-
-
-PROCEDURE [stdcall] ln* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0D9H, 0EDH, (* fldln2 *)
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END ln;
-
-
-PROCEDURE [stdcall] log* (base, x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0D9H, 0E8H, (* fld1 *)
- 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0D9H, 0E8H, (* fld1 *)
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0F1H, (* fyl2x *)
- 0DEH, 0F9H, (* fdivp st1, st *)
- 0C9H, (* leave *)
- 0C2H, 010H, 000H (* ret 10h *)
- )
- RETURN 0.0
-END log;
-
-
-PROCEDURE [stdcall] exp* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0EAH, (* fldl2e *)
- 0DEH, 0C9H, 0D9H, 0C0H,
- 0D9H, 0FCH, 0DCH, 0E9H,
- 0D9H, 0C9H, 0D9H, 0F0H,
- 0D9H, 0E8H, 0DEH, 0C1H,
- 0D9H, 0FDH, 0DDH, 0D9H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END exp;
-
-
-PROCEDURE [stdcall] round* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 07DH, 0F4H, 0D9H,
- 07DH, 0F6H, 066H, 081H,
- 04DH, 0F6H, 000H, 003H,
- 0D9H, 06DH, 0F6H, 0D9H,
- 0FCH, 0D9H, 06DH, 0F4H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END round;
-
-
-PROCEDURE [stdcall] frac* (x: REAL): REAL;
-BEGIN
- SYSTEM.CODE(
- 050H,
- 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
- 0D9H, 0C0H, 0D9H, 03CH,
- 024H, 0D9H, 07CH, 024H,
- 002H, 066H, 081H, 04CH,
- 024H, 002H, 000H, 00FH,
- 0D9H, 06CH, 024H, 002H,
- 0D9H, 0FCH, 0D9H, 02CH,
- 024H, 0DEH, 0E9H,
- 0C9H, (* leave *)
- 0C2H, 008H, 000H (* ret 08h *)
- )
- RETURN 0.0
-END frac;
-
-
-PROCEDURE sqri* (x: INTEGER): INTEGER;
- RETURN x * x
-END sqri;
-
-
-PROCEDURE sqrr* (x: REAL): REAL;
- RETURN x * x
-END sqrr;
-
-
-PROCEDURE arcsin* (x: REAL): REAL;
- RETURN arctan2(x, sqrt(1.0 - x * x))
-END arcsin;
-
-
-PROCEDURE arccos* (x: REAL): REAL;
- RETURN arctan2(sqrt(1.0 - x * x), x)
-END arccos;
-
-
-PROCEDURE arctan* (x: REAL): REAL;
- RETURN arctan2(x, 1.0)
-END arctan;
-
-
-PROCEDURE sinh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x - 1.0 / x) * 0.5
-END sinh;
-
-
-PROCEDURE cosh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x + 1.0 / x) * 0.5
-END cosh;
-
-
-PROCEDURE tanh* (x: REAL): REAL;
-BEGIN
- IF x > 15.0 THEN
- x := 1.0
- ELSIF x < -15.0 THEN
- x := -1.0
- ELSE
- x := exp(2.0 * x);
- x := (x - 1.0) / (x + 1.0)
- END
-
- RETURN x
-END tanh;
-
-
-PROCEDURE arsinh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x + 1.0))
-END arsinh;
-
-
-PROCEDURE arcosh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x - 1.0))
-END arcosh;
-
-
-PROCEDURE artanh* (x: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF SameValue(x, 1.0) THEN
- res := SYSTEM.INF()
- ELSIF SameValue(x, -1.0) THEN
- res := -SYSTEM.INF()
- ELSE
- res := 0.5 * ln((1.0 + x) / (1.0 - x))
- END
- RETURN res
-END artanh;
-
-
-PROCEDURE floor* (x: REAL): REAL;
-VAR
- f: REAL;
-
-BEGIN
- f := frac(x);
- x := x - f;
- IF f < 0.0 THEN
- x := x - 1.0
- END
- RETURN x
-END floor;
-
-
-PROCEDURE ceil* (x: REAL): REAL;
-VAR
- f: REAL;
-
-BEGIN
- f := frac(x);
- x := x - f;
- IF f > 0.0 THEN
- x := x + 1.0
- END
- RETURN x
-END ceil;
-
-
-PROCEDURE power* (base, exponent: REAL): REAL;
-VAR
- res: REAL;
-
-BEGIN
- IF exponent = 0.0 THEN
- res := 1.0
- ELSIF (base = 0.0) & (exponent > 0.0) THEN
- res := 0.0
- ELSE
- res := exp(exponent * ln(base))
- END
- RETURN res
-END power;
-
-
-PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
-VAR
- i: INTEGER;
- a: REAL;
-
-BEGIN
- a := 1.0;
-
- IF base # 0.0 THEN
- IF exponent # 0 THEN
- IF exponent < 0 THEN
- base := 1.0 / base
- END;
- i := ABS(exponent);
- WHILE i > 0 DO
- WHILE ~ODD(i) DO
- i := LSR(i, 1);
- base := sqrr(base)
- END;
- DEC(i);
- a := a * base
- END
- ELSE
- a := 1.0
- END
- ELSE
- ASSERT(exponent > 0);
- a := 0.0
- END
-
- RETURN a
-END ipower;
-
-
-PROCEDURE sgn* (x: REAL): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF x > 0.0 THEN
- res := 1
- ELSIF x < 0.0 THEN
- res := -1
- ELSE
- res := 0
- END
-
- RETURN res
-END sgn;
-
-
-PROCEDURE fact* (n: INTEGER): REAL;
-VAR
- res: REAL;
-
-BEGIN
- res := 1.0;
- WHILE n > 1 DO
- res := res * FLT(n);
- DEC(n)
- END
-
- RETURN res
-END fact;
-
-
-PROCEDURE DegToRad* (x: REAL): REAL;
- RETURN x * (pi / 180.0)
-END DegToRad;
-
-
-PROCEDURE RadToDeg* (x: REAL): REAL;
- RETURN x * (180.0 / pi)
-END RadToDeg;
-
-
-(* Return hypotenuse of triangle *)
-PROCEDURE hypot* (x, y: REAL): REAL;
-VAR
- a: REAL;
-
-BEGIN
- x := ABS(x);
- y := ABS(y);
- IF x > y THEN
- a := x * sqrt(1.0 + sqrr(y / x))
- ELSE
- IF x > 0.0 THEN
- a := y * sqrt(1.0 + sqrr(x / y))
- ELSE
- a := y
- END
- END
-
- RETURN a
-END hypot;
-
-
-END Math.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/Out.ob07 b/programs/develop/oberon07/Lib/Windows32/Out.ob07
deleted file mode 100644
index 779527492..000000000
--- a/programs/develop/oberon07/Lib/Windows32/Out.ob07
+++ /dev/null
@@ -1,77 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Out;
-
-IMPORT SYSTEM;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
-
-PROCEDURE [ccall, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER);
-PROCEDURE [ccall, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER);
-PROCEDURE [ccall, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision: INTEGER; x: REAL);
-
-PROCEDURE [windows, "kernel32.dll", ""]
- WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER);
-
-PROCEDURE [windows, "kernel32.dll", ""]
- GetStdHandle (nStdHandle: INTEGER): INTEGER;
-
-
-PROCEDURE Char* (x: CHAR);
-BEGIN
- printf1(SYSTEM.SADR("%c"), ORD(x))
-END Char;
-
-
-PROCEDURE StringW* (s: ARRAY OF WCHAR);
-BEGIN
- WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0)
-END StringW;
-
-
-PROCEDURE String* (s: ARRAY OF CHAR);
-BEGIN
- printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
-END String;
-
-
-PROCEDURE Ln*;
-BEGIN
- printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10)))
-END Ln;
-
-
-PROCEDURE Int* (x, width: INTEGER);
-BEGIN
- printf2(SYSTEM.SADR("%*d"), width, x)
-END Int;
-
-
-PROCEDURE Real* (x: REAL; width: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x)
-END Real;
-
-
-PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*f"), width, precision, x)
-END FixReal;
-
-
-PROCEDURE Open*;
-BEGIN
- hConsoleOutput := GetStdHandle(-11)
-END Open;
-
-
-END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 b/programs/develop/oberon07/Lib/Windows32/RTL.ob07
deleted file mode 100644
index 5f9e16808..000000000
--- a/programs/develop/oberon07/Lib/Windows32/RTL.ob07
+++ /dev/null
@@ -1,520 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE RTL;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- bit_depth* = 32;
- maxint* = 7FFFFFFFH;
- minint* = 80000000H;
-
- WORD = bit_depth DIV 8;
- MAX_SET = bit_depth - 1;
-
-
-VAR
-
- name: INTEGER;
- types: INTEGER;
-
-
-PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
- 085H, 0C0H, (* test eax, eax *)
- 07EH, 019H, (* jle L *)
- 0FCH, (* cld *)
- 057H, (* push edi *)
- 056H, (* push esi *)
- 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
- 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
- 089H, 0C1H, (* mov ecx, eax *)
- 0C1H, 0E9H, 002H, (* shr ecx, 2 *)
- 0F3H, 0A5H, (* rep movsd *)
- 089H, 0C1H, (* mov ecx, eax *)
- 083H, 0E1H, 003H, (* and ecx, 3 *)
- 0F3H, 0A4H, (* rep movsb *)
- 05EH, (* pop esi *)
- 05FH (* pop edi *)
- (* L: *)
- )
-END _move;
-
-
-PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
-
-BEGIN
- IF len_src > len_dst THEN
- res := FALSE
- ELSE
- _move(len_src * base_size, dst, src);
- res := TRUE
- END
-
- RETURN res
-END _arrcpy;
-
-
-PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
- _move(MIN(len_dst, len_src) * chr_size, dst, src)
-END _strcpy;
-
-
-PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
-VAR
- i, n, k: INTEGER;
-
-BEGIN
- k := LEN(A) - 1;
- n := A[0];
- i := 0;
- WHILE i < k DO
- A[i] := A[i + 1];
- INC(i)
- END;
- A[k] := n
-END _rot;
-
-
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
-BEGIN
- IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
- IF b > MAX_SET THEN
- b := MAX_SET
- END;
- IF a < 0 THEN
- a := 0
- END;
- a := LSR(ASR(minint, b - a), MAX_SET - b)
- ELSE
- a := 0
- END
-
- RETURN a
-END _set;
-
-
-PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
-BEGIN
- SYSTEM.CODE(
- 031H, 0C0H, (* xor eax, eax *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *)
- 083H, 0F9H, 01FH, (* cmp ecx, 31 *)
- 077H, 003H, (* ja L *)
- 00FH, 0ABH, 0C8H (* bts eax, ecx *)
- (* L: *)
- )
-END _set1;
-
-
-PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
-BEGIN
- SYSTEM.CODE(
- 053H, (* push ebx *)
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
- 031H, 0D2H, (* xor edx, edx *)
- 085H, 0C0H, (* test eax, eax *)
- 074H, 018H, (* je L2 *)
- 07FH, 002H, (* jg L1 *)
- 0F7H, 0D2H, (* not edx *)
- (* L1: *)
- 089H, 0C3H, (* mov ebx, eax *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
- 0F7H, 0F9H, (* idiv ecx *)
- 085H, 0D2H, (* test edx, edx *)
- 074H, 009H, (* je L2 *)
- 031H, 0CBH, (* xor ebx, ecx *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07DH, 003H, (* jge L2 *)
- 048H, (* dec eax *)
- 001H, 0CAH, (* add edx, ecx *)
- (* L2: *)
- 05BH (* pop ebx *)
- )
-END _divmod;
-
-
-PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
-BEGIN
- ptr := API._NEW(size);
- IF ptr # 0 THEN
- SYSTEM.PUT(ptr, t);
- INC(ptr, WORD)
- END
-END _new;
-
-
-PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
-BEGIN
- IF ptr # 0 THEN
- ptr := API._DISPOSE(ptr - WORD)
- END
-END _dispose;
-
-
-PROCEDURE [stdcall] _length* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
- 048H, (* dec eax *)
- (* L1: *)
- 040H, (* inc eax *)
- 080H, 038H, 000H, (* cmp byte [eax], 0 *)
- 074H, 003H, (* jz L2 *)
- 0E2H, 0F8H, (* loop L1 *)
- 040H, (* inc eax *)
- (* L2: *)
- 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
- )
-END _length;
-
-
-PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
- 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
- 048H, (* dec eax *)
- 048H, (* dec eax *)
- (* L1: *)
- 040H, (* inc eax *)
- 040H, (* inc eax *)
- 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
- 074H, 004H, (* jz L2 *)
- 0E2H, 0F6H, (* loop L1 *)
- 040H, (* inc eax *)
- 040H, (* inc eax *)
- (* L2: *)
- 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
- 0D1H, 0E8H (* shr eax, 1 *)
- )
-END _lengthw;
-
-
-PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 056H, (* push esi *)
- 057H, (* push edi *)
- 053H, (* push ebx *)
- 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
- 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
- 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
- 031H, 0C9H, (* xor ecx, ecx *)
- 031H, 0D2H, (* xor edx, edx *)
- 0B8H,
- 000H, 000H, 000H, 080H, (* mov eax, minint *)
- (* L1: *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07EH, 017H, (* jle L3 *)
- 08AH, 00EH, (* mov cl, byte[esi] *)
- 08AH, 017H, (* mov dl, byte[edi] *)
- 046H, (* inc esi *)
- 047H, (* inc edi *)
- 04BH, (* dec ebx *)
- 039H, 0D1H, (* cmp ecx, edx *)
- 074H, 006H, (* je L2 *)
- 089H, 0C8H, (* mov eax, ecx *)
- 029H, 0D0H, (* sub eax, edx *)
- 0EBH, 006H, (* jmp L3 *)
- (* L2: *)
- 085H, 0C9H, (* test ecx, ecx *)
- 075H, 0E7H, (* jne L1 *)
- 031H, 0C0H, (* xor eax, eax *)
- (* L3: *)
- 05BH, (* pop ebx *)
- 05FH, (* pop edi *)
- 05EH, (* pop esi *)
- 05DH, (* pop ebp *)
- 0C2H, 00CH, 000H (* ret 12 *)
- )
- RETURN 0
-END strncmp;
-
-
-PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 056H, (* push esi *)
- 057H, (* push edi *)
- 053H, (* push ebx *)
- 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
- 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
- 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
- 031H, 0C9H, (* xor ecx, ecx *)
- 031H, 0D2H, (* xor edx, edx *)
- 0B8H,
- 000H, 000H, 000H, 080H, (* mov eax, minint *)
- (* L1: *)
- 085H, 0DBH, (* test ebx, ebx *)
- 07EH, 01BH, (* jle L3 *)
- 066H, 08BH, 00EH, (* mov cx, word[esi] *)
- 066H, 08BH, 017H, (* mov dx, word[edi] *)
- 046H, (* inc esi *)
- 046H, (* inc esi *)
- 047H, (* inc edi *)
- 047H, (* inc edi *)
- 04BH, (* dec ebx *)
- 039H, 0D1H, (* cmp ecx, edx *)
- 074H, 006H, (* je L2 *)
- 089H, 0C8H, (* mov eax, ecx *)
- 029H, 0D0H, (* sub eax, edx *)
- 0EBH, 006H, (* jmp L3 *)
- (* L2: *)
- 085H, 0C9H, (* test ecx, ecx *)
- 075H, 0E3H, (* jne L1 *)
- 031H, 0C0H, (* xor eax, eax *)
- (* L3: *)
- 05BH, (* pop ebx *)
- 05FH, (* pop edi *)
- 05EH, (* pop esi *)
- 05DH, (* pop ebp *)
- 0C2H, 00CH, 000H (* ret 12 *)
- )
- RETURN 0
-END strncmpw;
-
-
-PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: CHAR;
-
-BEGIN
- res := strncmp(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmp;
-
-
-PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: WCHAR;
-
-BEGIN
- res := strncmpw(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2 * 2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1 * 2, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmpw;
-
-
-PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- c: CHAR;
- i: INTEGER;
-
-BEGIN
- i := 0;
- REPEAT
- SYSTEM.GET(pchar, c);
- s[i] := c;
- INC(pchar);
- INC(i)
- UNTIL c = 0X
-END PCharToStr;
-
-
-PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
- i, a: INTEGER;
-
-BEGIN
- i := 0;
- a := x;
- REPEAT
- INC(i);
- a := a DIV 10
- UNTIL a = 0;
-
- str[i] := 0X;
-
- REPEAT
- DEC(i);
- str[i] := CHR(x MOD 10 + ORD("0"));
- x := x DIV 10
- UNTIL x = 0
-END IntToStr;
-
-
-PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
- n1, n2: INTEGER;
-
-BEGIN
- n1 := LENGTH(s1);
- n2 := LENGTH(s2);
-
- ASSERT(n1 + n2 < LEN(s1));
-
- SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
- s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
-VAR
- s, temp: ARRAY 1024 OF CHAR;
-
-BEGIN
- CASE err OF
- | 1: s := "assertion failure"
- | 2: s := "NIL dereference"
- | 3: s := "bad divisor"
- | 4: s := "NIL procedure call"
- | 5: s := "type guard error"
- | 6: s := "index out of range"
- | 7: s := "invalid CASE"
- | 8: s := "array assignment error"
- | 9: s := "CHR out of range"
- |10: s := "WCHR out of range"
- |11: s := "BYTE out of range"
- END;
-
- append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
- append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
-
- API.DebugMsg(SYSTEM.ADR(s[0]), name);
-
- API.exit_thread(0)
-END _error;
-
-
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _isrec;
-
-
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-BEGIN
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- END
-
- RETURN p MOD 2
-END _is;
-
-
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _guardrec;
-
-
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(p, p);
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- ELSE
- p := 1
- END
-
- RETURN p MOD 2
-END _guard;
-
-
-PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
-END _dllentry;
-
-
-PROCEDURE [stdcall] _sofinit*;
-BEGIN
- API.sofinit
-END _sofinit;
-
-
-PROCEDURE [stdcall] _exit* (code: INTEGER);
-BEGIN
- API.exit(code)
-END _exit;
-
-
-PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
-VAR
- t0, t1, i, j: INTEGER;
-
-BEGIN
- SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
- API.init(param, code);
-
- types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
- ASSERT(types # 0);
- FOR i := 0 TO tcount - 1 DO
- FOR j := 0 TO tcount - 1 DO
- t0 := i; t1 := j;
-
- WHILE (t1 # 0) & (t1 # t0) DO
- SYSTEM.GET(_types + t1 * WORD, t1)
- END;
-
- SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
- END
- END;
-
- name := modname
-END _init;
-
-
-END RTL.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 b/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07
deleted file mode 100644
index 1fe4efabc..000000000
--- a/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07
+++ /dev/null
@@ -1,224 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE WINAPI;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- OFS_MAXPATHNAME* = 128;
-
- KERNEL = "kernel32.dll";
- USER = "user32.dll";
- MSVCRT = "msvcrt.dll";
-
-
-TYPE
-
- DLL_ENTRY* = API.DLL_ENTRY;
-
- STRING = ARRAY 260 OF CHAR;
-
- TCoord* = RECORD
-
- X*, Y*: WCHAR
-
- END;
-
- TSmallRect* = RECORD
-
- Left*, Top*, Right*, Bottom*: WCHAR
-
- END;
-
- TConsoleScreenBufferInfo* = RECORD
-
- dwSize*: TCoord;
- dwCursorPosition*: TCoord;
- wAttributes*: WCHAR;
- srWindow*: TSmallRect;
- dwMaximumWindowSize*: TCoord
-
- END;
-
- TSystemTime* = RECORD
-
- Year*,
- Month*,
- DayOfWeek*,
- Day*,
- Hour*,
- Min*,
- Sec*,
- MSec*: WCHAR
-
- END;
-
- tm* = RECORD
-
- sec*,
- min*,
- hour*,
- mday*,
- mon*,
- year*,
- wday*,
- yday*,
- isdst*: SYSTEM.CARD32
-
- END;
-
- PSecurityAttributes* = POINTER TO TSecurityAttributes;
-
- TSecurityAttributes* = RECORD
-
- nLength*: SYSTEM.CARD32;
- lpSecurityDescriptor*: INTEGER;
- bInheritHandle*: SYSTEM.CARD32 (* BOOL *)
-
- END;
-
- TFileTime* = RECORD
-
- dwLowDateTime*,
- dwHighDateTime*: SYSTEM.CARD32
-
- END;
-
- TWin32FindData* = RECORD
-
- dwFileAttributes*: SYSTEM.CARD32;
- ftCreationTime*: TFileTime;
- ftLastAccessTime*: TFileTime;
- ftLastWriteTime*: TFileTime;
- nFileSizeHigh*: SYSTEM.CARD32;
- nFileSizeLow*: SYSTEM.CARD32;
- dwReserved0*: SYSTEM.CARD32;
- dwReserved1*: SYSTEM.CARD32;
- cFileName*: STRING;
- cAlternateFileName*: ARRAY 14 OF CHAR;
- dwFileType*: SYSTEM.CARD32;
- dwCreatorType*: SYSTEM.CARD32;
- wFinderFlags*: WCHAR
-
- END;
-
- OFSTRUCT* = RECORD
-
- cBytes*: BYTE;
- fFixedDisk*: BYTE;
- nErrCode*: WCHAR;
- Reserved1*: WCHAR;
- Reserved2*: WCHAR;
- szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR
-
- END;
-
- POverlapped* = POINTER TO OVERLAPPED;
-
- OVERLAPPED* = RECORD
-
- Internal*: INTEGER;
- InternalHigh*: INTEGER;
- Offset*: SYSTEM.CARD32;
- OffsetHigh*: SYSTEM.CARD32;
- hEvent*: INTEGER
-
- END;
-
-
-PROCEDURE [windows-, KERNEL, ""] SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputCharacterA* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetStdHandle* (nStdHandle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetLocalTime* (T: TSystemTime);
-
-PROCEDURE [windows-, KERNEL, ""] RemoveDirectoryA* (lpPathName: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetFileAttributesA* (lpPathName: INTEGER): SET;
-
-PROCEDURE [windows-, KERNEL, ""] CreateDirectoryA* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FindFirstFileA* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] DeleteFileA* (lpFileName: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FindClose* (hFindFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] CloseHandle* (hObject: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] CreateFileA* (
- lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
- lpSecurityAttributes: PSecurityAttributes;
- dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ReadConsoleA* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetCommandLineA* (): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GlobalFree* (hMem: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ExitProcess* (code: INTEGER);
-
-PROCEDURE [windows-, KERNEL, ""] WriteConsoleA* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetTickCount* (): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] Sleep* (dwMilliseconds: INTEGER);
-
-PROCEDURE [windows-, KERNEL, ""] FreeLibrary* (hLibModule: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetProcAddress* (hModule, name: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] LoadLibraryA* (name: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] AllocConsole* (): BOOLEAN;
-
-PROCEDURE [windows-, KERNEL, ""] FreeConsole* (): BOOLEAN;
-
-PROCEDURE [windows-, USER, ""] MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-PROCEDURE [windows-, USER, ""] MessageBoxW* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-PROCEDURE [windows-, USER, ""] CreateWindowExA* (
- dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y,
- nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER;
-
-PROCEDURE [ccall-, MSVCRT, ""] time* (ptr: INTEGER): INTEGER;
-
-PROCEDURE [ccall-, MSVCRT, ""] mktime* (time: tm): INTEGER;
-
-
-PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
-BEGIN
- API.SetDll(process_detach, thread_detach, thread_attach)
-END SetDllEntry;
-
-
-END WINAPI.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/API.ob07 b/programs/develop/oberon07/Lib/Windows64/API.ob07
deleted file mode 100644
index 437d08b89..000000000
--- a/programs/develop/oberon07/Lib/Windows64/API.ob07
+++ /dev/null
@@ -1,132 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE API;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- eol* = 0DX + 0AX;
-
- SectionAlignment = 1000H;
-
- DLL_PROCESS_ATTACH = 1;
- DLL_THREAD_ATTACH = 2;
- DLL_THREAD_DETACH = 3;
- DLL_PROCESS_DETACH = 0;
-
- KERNEL = "kernel32.dll";
- USER = "user32.dll";
-
-
-TYPE
-
- DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
-
-
-VAR
-
- base*: INTEGER;
- heap: INTEGER;
-
- process_detach,
- thread_detach,
- thread_attach: DLL_ENTRY;
-
-
-PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
-PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
-PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
-PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
-PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER);
-PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-
-PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
-BEGIN
- MessageBoxA(0, lpText, lpCaption, 16)
-END DebugMsg;
-
-
-PROCEDURE _NEW* (size: INTEGER): INTEGER;
- RETURN HeapAlloc(heap, 8, size)
-END _NEW;
-
-
-PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
-BEGIN
- HeapFree(heap, 0, p)
- RETURN 0
-END _DISPOSE;
-
-
-PROCEDURE init* (reserved, code: INTEGER);
-BEGIN
- process_detach := NIL;
- thread_detach := NIL;
- thread_attach := NIL;
- base := code - SectionAlignment;
- heap := GetProcessHeap()
-END init;
-
-
-PROCEDURE exit* (code: INTEGER);
-BEGIN
- ExitProcess(code)
-END exit;
-
-
-PROCEDURE exit_thread* (code: INTEGER);
-BEGIN
- ExitThread(code)
-END exit_thread;
-
-
-PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- res := 0;
-
- CASE fdwReason OF
- |DLL_PROCESS_ATTACH:
- res := 1
- |DLL_THREAD_ATTACH:
- IF thread_attach # NIL THEN
- thread_attach(hinstDLL, fdwReason, lpvReserved)
- END
- |DLL_THREAD_DETACH:
- IF thread_detach # NIL THEN
- thread_detach(hinstDLL, fdwReason, lpvReserved)
- END
- |DLL_PROCESS_DETACH:
- IF process_detach # NIL THEN
- process_detach(hinstDLL, fdwReason, lpvReserved)
- END
- ELSE
- END
-
- RETURN res
-END dllentry;
-
-
-PROCEDURE sofinit*;
-END sofinit;
-
-
-PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY);
-BEGIN
- process_detach := _process_detach;
- thread_detach := _thread_detach;
- thread_attach := _thread_attach
-END SetDll;
-
-
-END API.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/Args.ob07 b/programs/develop/oberon07/Lib/Windows64/Args.ob07
deleted file mode 100644
index 3d4ae39cf..000000000
--- a/programs/develop/oberon07/Lib/Windows64/Args.ob07
+++ /dev/null
@@ -1,101 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Args;
-
-IMPORT SYSTEM, WINAPI;
-
-
-CONST
-
- MAX_PARAM = 1024;
-
-
-VAR
-
- Params: ARRAY MAX_PARAM, 2 OF INTEGER;
- argc*: INTEGER;
-
-
-PROCEDURE GetChar (adr: INTEGER): CHAR;
-VAR
- res: CHAR;
-
-BEGIN
- SYSTEM.GET(adr, res)
- RETURN res
-END GetChar;
-
-
-PROCEDURE ParamParse;
-VAR
- p, count, cond: INTEGER;
- c: CHAR;
-
-
- PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR): INTEGER;
- BEGIN
- IF (c <= 20X) & (c # 0X) THEN
- cond := A
- ELSIF c = 22X THEN
- cond := B
- ELSIF c = 0X THEN
- cond := 6
- ELSE
- cond := C
- END
-
- RETURN cond
- END ChangeCond;
-
-
-BEGIN
- p := WINAPI.GetCommandLineA();
- cond := 0;
- count := 0;
- WHILE (count < MAX_PARAM) & (cond # 6) DO
- c := GetChar(p);
- CASE cond OF
- |0: IF ChangeCond(0, 4, 1, cond, c) = 1 THEN Params[count, 0] := p END
- |1: IF ChangeCond(0, 3, 1, cond, c) IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
- |3: IF ChangeCond(3, 1, 3, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |4: IF ChangeCond(5, 0, 5, cond, c) = 5 THEN Params[count, 0] := p END
- |5: IF ChangeCond(5, 1, 5, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |6:
- END;
- INC(p)
- END;
- argc := count
-END ParamParse;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, j, len: INTEGER;
- c: CHAR;
-
-BEGIN
- j := 0;
- IF n < argc THEN
- i := Params[n, 0];
- len := LEN(s) - 1;
- WHILE (j < len) & (i <= Params[n, 1]) DO
- c := GetChar(i);
- IF c # '"' THEN
- s[j] := c;
- INC(j)
- END;
- INC(i)
- END
- END;
- s[j] := 0X
-END GetArg;
-
-
-BEGIN
- ParamParse
-END Args.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/Console.ob07 b/programs/develop/oberon07/Lib/Windows64/Console.ob07
deleted file mode 100644
index d11e06db4..000000000
--- a/programs/develop/oberon07/Lib/Windows64/Console.ob07
+++ /dev/null
@@ -1,100 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Console;
-
-IMPORT SYSTEM, WINAPI, In, Out;
-
-
-CONST
-
- Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3;
- Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7;
- DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11;
- LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
-
-PROCEDURE SetCursor* (X, Y: INTEGER);
-BEGIN
- WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536)
-END SetCursor;
-
-
-PROCEDURE GetCursor* (VAR X, Y: INTEGER);
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
- X := ORD(ScrBufInfo.dwCursorPosition.X);
- Y := ORD(ScrBufInfo.dwCursorPosition.Y)
-END GetCursor;
-
-
-PROCEDURE Cls*;
-VAR
- fill: INTEGER;
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
- fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y);
- WINAPI.FillConsoleOutputCharacterA(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill));
- WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill));
- SetCursor(0, 0)
-END Cls;
-
-
-PROCEDURE SetColor* (FColor, BColor: INTEGER);
-BEGIN
- IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN
- WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor)
- END
-END SetColor;
-
-
-PROCEDURE GetCursorX* (): INTEGER;
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
- RETURN ORD(ScrBufInfo.dwCursorPosition.X)
-END GetCursorX;
-
-
-PROCEDURE GetCursorY* (): INTEGER;
-VAR
- ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
-
-BEGIN
- WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
- RETURN ORD(ScrBufInfo.dwCursorPosition.Y)
-END GetCursorY;
-
-
-PROCEDURE open*;
-BEGIN
- WINAPI.AllocConsole;
- hConsoleOutput := WINAPI.GetStdHandle(-11);
- In.Open;
- Out.Open
-END open;
-
-
-PROCEDURE exit* (b: BOOLEAN);
-BEGIN
- WINAPI.FreeConsole
-END exit;
-
-
-END Console.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/DateTime.ob07 b/programs/develop/oberon07/Lib/Windows64/DateTime.ob07
deleted file mode 100644
index f527c18f2..000000000
--- a/programs/develop/oberon07/Lib/Windows64/DateTime.ob07
+++ /dev/null
@@ -1,197 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE DateTime;
-
-IMPORT WINAPI, SYSTEM;
-
-
-CONST
-
- ERR* = -7.0E5;
-
-
-VAR
-
- DateTable: ARRAY 120000, 3 OF INTEGER;
- MonthsTable: ARRAY 13, 4 OF INTEGER;
-
-
-PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL;
-VAR
- d, bis: INTEGER;
- res: REAL;
-
-BEGIN
- res := ERR;
- IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
- (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
- (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) &
- (MSec >= 0) & (MSec <= 999) THEN
-
- bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
-
- IF Day <= MonthsTable[Month][2 + bis] THEN
- DEC(Year);
- d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) +
- MonthsTable[Month][bis] + Day - 693594;
- res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0
- END
- END
- RETURN res
-END Encode;
-
-
-PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
- d, t: INTEGER;
- L, R, M: INTEGER;
-
-BEGIN
- res := (Date >= -693593.0) & (Date < 2958466.0);
- IF res THEN
- d := FLOOR(Date);
- t := FLOOR((Date - FLT(d)) * 86400000.0);
- INC(d, 693593);
-
- L := 0;
- R := LEN(DateTable) - 1;
- M := (L + R) DIV 2;
-
- WHILE R - L > 1 DO
- IF d > DateTable[M][0] THEN
- L := M;
- M := (L + R) DIV 2
- ELSIF d < DateTable[M][0] THEN
- R := M;
- M := (L + R) DIV 2
- ELSE
- L := M;
- R := M
- END
- END;
-
- Year := DateTable[L][1];
- Month := DateTable[L][2];
- Day := d - DateTable[L][0] + 1;
-
- Hour := t DIV 3600000; t := t MOD 3600000;
- Min := t DIV 60000; t := t MOD 60000;
- Sec := t DIV 1000;
- MSec := t MOD 1000
- END
-
- RETURN res
-END Decode;
-
-
-PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER);
-VAR
- T: WINAPI.TSystemTime;
-
-BEGIN
- WINAPI.GetLocalTime(T);
- Year := ORD(T.Year);
- Month := ORD(T.Month);
- Day := ORD(T.Day);
- Hour := ORD(T.Hour);
- Min := ORD(T.Min);
- Sec := ORD(T.Sec);
- MSec := ORD(T.MSec)
-END Now;
-
-
-PROCEDURE NowEncode* (): REAL;
-VAR
- Year, Month, Day, Hour, Min, Sec, MSec: INTEGER;
-
-BEGIN
- Now(Year, Month, Day, Hour, Min, Sec, MSec)
- RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec)
-END NowEncode;
-
-
-PROCEDURE NowUnixTime* (): INTEGER;
- RETURN WINAPI.time(0)
-END NowUnixTime;
-
-
-PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER;
-VAR
- t: WINAPI.tm;
-
-BEGIN
- DEC(Year, 1900);
- DEC(Month);
- SYSTEM.GET(SYSTEM.ADR(Sec), t.sec);
- SYSTEM.GET(SYSTEM.ADR(Min), t.min);
- SYSTEM.GET(SYSTEM.ADR(Hour), t.hour);
- SYSTEM.GET(SYSTEM.ADR(Day), t.mday);
- SYSTEM.GET(SYSTEM.ADR(Month), t.mon);
- SYSTEM.GET(SYSTEM.ADR(Year), t.year);
-
- RETURN WINAPI.mktime(t)
-END UnixTime;
-
-
-PROCEDURE init;
-VAR
- day, year, month, i: INTEGER;
- Months: ARRAY 13 OF INTEGER;
-
-BEGIN
- Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30;
- Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31;
- Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31;
-
- day := 0;
- year := 1;
- month := 1;
- i := 0;
-
- WHILE year <= 10000 DO
- DateTable[i][0] := day;
- DateTable[i][1] := year;
- DateTable[i][2] := month;
- INC(day, Months[month]);
- IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN
- INC(day)
- END;
- INC(month);
- IF month > 12 THEN
- month := 1;
- INC(year)
- END;
- INC(i)
- END;
-
- MonthsTable[1][0] := 0;
- FOR i := 2 TO 12 DO
- MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1]
- END;
-
- FOR i := 1 TO 12 DO
- MonthsTable[i][2] := Months[i]
- END;
-
- Months[2] := 29;
- MonthsTable[1][1] := 0;
- FOR i := 2 TO 12 DO
- MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1]
- END;
-
- FOR i := 1 TO 12 DO
- MonthsTable[i][3] := Months[i]
- END
-
-END init;
-
-
-BEGIN
- init
-END DateTime.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/File.ob07 b/programs/develop/oberon07/Lib/Windows64/File.ob07
deleted file mode 100644
index 4e003eee3..000000000
--- a/programs/develop/oberon07/Lib/Windows64/File.ob07
+++ /dev/null
@@ -1,139 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE File;
-
-IMPORT SYSTEM, WINAPI, API;
-
-
-CONST
-
- OPEN_R* = 0; OPEN_W* = 1; OPEN_RW* = 2;
- SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
-
-
-PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
-VAR
- FindData: WINAPI.TWin32FindData;
- Handle: INTEGER;
- attr: SET;
-
-BEGIN
- Handle := WINAPI.FindFirstFileA(SYSTEM.ADR(FName[0]), FindData);
- IF Handle # -1 THEN
- WINAPI.FindClose(Handle);
- SYSTEM.GET32(SYSTEM.ADR(FindData.dwFileAttributes), attr);
- IF 4 IN attr THEN
- Handle := -1
- END
- END
-
- RETURN Handle # -1
-END Exists;
-
-
-PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.DeleteFileA(SYSTEM.ADR(FName[0])) # 0
-END Delete;
-
-
-PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
- RETURN WINAPI.CreateFileA(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
-END Create;
-
-
-PROCEDURE Close* (F: INTEGER);
-BEGIN
- WINAPI.CloseHandle(F)
-END Close;
-
-
-PROCEDURE Open* (FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER;
-VAR
- ofstr: WINAPI.OFSTRUCT;
-BEGIN
- RETURN WINAPI.OpenFile(SYSTEM.ADR(FName[0]), ofstr, Mode)
-END Open;
-
-
-PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
- RETURN WINAPI.SetFilePointer(F, Offset MOD 100000000H, SYSTEM.ADR(Offset) + 4, Origin)
-END Seek;
-
-
-PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END Read;
-
-
-PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END Write;
-
-
-PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
-VAR
- res, n, F: INTEGER;
-
-BEGIN
- res := 0;
- F := Open(FName, OPEN_R);
-
- IF F # -1 THEN
- Size := Seek(F, 0, SEEK_END);
- n := Seek(F, 0, SEEK_BEG);
- res := API._NEW(Size);
- IF (res = 0) OR (Read(F, res, Size) # Size) THEN
- IF res # 0 THEN
- res := API._DISPOSE(res);
- Size := 0
- END
- END;
- Close(F)
- END
-
- RETURN res
-END Load;
-
-
-PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.RemoveDirectoryA(SYSTEM.ADR(DirName[0])) # 0
-END RemoveDir;
-
-
-PROCEDURE ExistsDir* (DirName: ARRAY OF CHAR): BOOLEAN;
-VAR
- Code: SET;
-
-BEGIN
- Code := WINAPI.GetFileAttributesA(SYSTEM.ADR(DirName[0]))
- RETURN (Code # {0..31}) & (4 IN Code)
-END ExistsDir;
-
-
-PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
- RETURN WINAPI.CreateDirectoryA(SYSTEM.ADR(DirName[0]), NIL) # 0
-END CreateDir;
-
-
-END File.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/HOST.ob07 b/programs/develop/oberon07/Lib/Windows64/HOST.ob07
deleted file mode 100644
index 20301868c..000000000
--- a/programs/develop/oberon07/Lib/Windows64/HOST.ob07
+++ /dev/null
@@ -1,339 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE HOST;
-
-IMPORT SYSTEM, RTL;
-
-
-CONST
-
- slash* = "\";
- eol* = 0DX + 0AX;
-
- bit_depth* = RTL.bit_depth;
- maxint* = RTL.maxint;
- minint* = RTL.minint;
-
- MAX_PARAM = 1024;
-
- OFS_MAXPATHNAME = 128;
-
-
-TYPE
-
- POverlapped = POINTER TO OVERLAPPED;
-
- OVERLAPPED = RECORD
-
- Internal: INTEGER;
- InternalHigh: INTEGER;
- Offset: INTEGER;
- OffsetHigh: INTEGER;
- hEvent: INTEGER
-
- END;
-
- OFSTRUCT = RECORD
-
- cBytes: CHAR;
- fFixedDisk: CHAR;
- nErrCode: WCHAR;
- Reserved1: WCHAR;
- Reserved2: WCHAR;
- szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
-
- END;
-
- PSecurityAttributes = POINTER TO TSecurityAttributes;
-
- TSecurityAttributes = RECORD
-
- nLength: INTEGER;
- lpSecurityDescriptor: INTEGER;
- bInheritHandle: INTEGER
-
- END;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
- Params: ARRAY MAX_PARAM, 2 OF INTEGER;
- argc: INTEGER;
-
- maxreal*: REAL;
-
-
-PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]
- _GetTickCount (): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
- _GetStdHandle (nStdHandle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]
- _GetCommandLine (): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "ReadFile"]
- _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "WriteFile"]
- _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]
- _CloseHandle (hObject: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]
- _CreateFile (
- lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
- lpSecurityAttributes: PSecurityAttributes;
- dwCreationDisposition, dwFlagsAndAttributes,
- hTemplateFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "OpenFile"]
- _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]
- _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;
-
-PROCEDURE [windows, "kernel32.dll", "ExitProcess"]
- _ExitProcess (code: INTEGER);
-
-PROCEDURE [windows, "msvcrt.dll", "time"]
- _time (ptr: INTEGER): INTEGER;
-
-
-PROCEDURE ExitProcess* (code: INTEGER);
-BEGIN
- _ExitProcess(code)
-END ExitProcess;
-
-
-PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
-VAR
- n: INTEGER;
-
-BEGIN
- n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));
- path[n] := slash;
- path[n + 1] := 0X
-END GetCurrentDirectory;
-
-
-PROCEDURE GetChar (adr: INTEGER): CHAR;
-VAR
- res: CHAR;
-
-BEGIN
- SYSTEM.GET(adr, res)
- RETURN res
-END GetChar;
-
-
-PROCEDURE ParamParse;
-VAR
- p, count, cond: INTEGER;
- c: CHAR;
-
-
- PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
- BEGIN
- IF (c <= 20X) & (c # 0X) THEN
- cond := A
- ELSIF c = 22X THEN
- cond := B
- ELSIF c = 0X THEN
- cond := 6
- ELSE
- cond := C
- END
- END ChangeCond;
-
-
-BEGIN
- p := _GetCommandLine();
- cond := 0;
- count := 0;
- WHILE (count < MAX_PARAM) & (cond # 6) DO
- c := GetChar(p);
- CASE cond OF
- |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END
- |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
- |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END
- |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
- |6:
- END;
- INC(p)
- END;
- argc := count
-END ParamParse;
-
-
-PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- i, j, len: INTEGER;
- c: CHAR;
-
-BEGIN
- j := 0;
- IF n < argc THEN
- len := LEN(s) - 1;
- i := Params[n, 0];
- WHILE (j < len) & (i <= Params[n, 1]) DO
- c := GetChar(i);
- IF c # 22X THEN
- s[j] := c;
- INC(j)
- END;
- INC(i)
- END
- END;
- s[j] := 0X
-END GetArg;
-
-
-PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END FileRead;
-
-
-PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
- res := -1
- END
-
- RETURN res
-END FileWrite;
-
-
-PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
- RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
-END FileCreate;
-
-
-PROCEDURE FileClose* (F: INTEGER);
-BEGIN
- _CloseHandle(F)
-END FileClose;
-
-
-PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
-VAR
- ofstr: OFSTRUCT;
- res: INTEGER;
-
-BEGIN
- res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);
- IF res = 0FFFFFFFFH THEN
- res := -1
- END
-
- RETURN res
-END FileOpen;
-
-
-PROCEDURE chmod* (FName: ARRAY OF CHAR);
-END chmod;
-
-
-PROCEDURE OutChar* (c: CHAR);
-VAR
- count: INTEGER;
-BEGIN
- _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)
-END OutChar;
-
-
-PROCEDURE GetTickCount* (): INTEGER;
- RETURN _GetTickCount() DIV 10
-END GetTickCount;
-
-
-PROCEDURE letter (c: CHAR): BOOLEAN;
- RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
-END letter;
-
-
-PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
- RETURN ~(letter(path[0]) & (path[1] = ":"))
-END isRelative;
-
-
-PROCEDURE UnixTime* (): INTEGER;
- RETURN _time(0)
-END UnixTime;
-
-
-PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- a := 0;
- b := 0;
- SYSTEM.GET32(SYSTEM.ADR(x), a);
- SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
- SYSTEM.GET(SYSTEM.ADR(x), res)
- RETURN res
-END splitf;
-
-
-PROCEDURE d2s* (x: REAL): INTEGER;
-VAR
- h, l, s, e: INTEGER;
-
-BEGIN
- e := splitf(x, l, h);
-
- s := ASR(h, 31) MOD 2;
- e := (h DIV 100000H) MOD 2048;
- IF e <= 896 THEN
- h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
- REPEAT
- h := h DIV 2;
- INC(e)
- UNTIL e = 897;
- e := 896;
- l := (h MOD 8) * 20000000H;
- h := h DIV 8
- ELSIF (1151 <= e) & (e < 2047) THEN
- e := 1151;
- h := 0;
- l := 0
- ELSIF e = 2047 THEN
- e := 1151;
- IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
- h := 80000H;
- l := 0
- END
- END;
- DEC(e, 896)
-
- RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
-END d2s;
-
-
-BEGIN
- maxreal := 1.9;
- PACK(maxreal, 1023);
- hConsoleOutput := _GetStdHandle(-11);
- ParamParse
-END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/In.ob07 b/programs/develop/oberon07/Lib/Windows64/In.ob07
deleted file mode 100644
index 1e2b21f57..000000000
--- a/programs/develop/oberon07/Lib/Windows64/In.ob07
+++ /dev/null
@@ -1,80 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE In;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- MAX_LEN = 1024;
-
-
-VAR
-
- Done*: BOOLEAN;
- hConsoleInput: INTEGER;
- s: ARRAY MAX_LEN + 4 OF CHAR;
-
-
-PROCEDURE [windows, "msvcrt.dll", ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
-PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER;
-PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER);
-
-
-PROCEDURE String* (VAR str: ARRAY OF CHAR);
-VAR
- count: INTEGER;
-
-BEGIN
- ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0);
- IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN
- DEC(count, 2)
- END;
- s[count] := 0X;
- COPY(s, str);
- str[LEN(str) - 1] := 0X;
- Done := TRUE
-END String;
-
-
-PROCEDURE Int* (VAR x: INTEGER);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lld"), SYSTEM.ADR(x)) = 1
-END Int;
-
-
-PROCEDURE Real* (VAR x: REAL);
-BEGIN
- String(s);
- Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
-END Real;
-
-
-PROCEDURE Char* (VAR x: CHAR);
-BEGIN
- String(s);
- x := s[0]
-END Char;
-
-
-PROCEDURE Ln*;
-BEGIN
- String(s)
-END Ln;
-
-
-PROCEDURE Open*;
-BEGIN
- hConsoleInput := GetStdHandle(-10);
- Done := TRUE
-END Open;
-
-
-END In.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/Math.ob07 b/programs/develop/oberon07/Lib/Windows64/Math.ob07
deleted file mode 100644
index 42a5de5e7..000000000
--- a/programs/develop/oberon07/Lib/Windows64/Math.ob07
+++ /dev/null
@@ -1,480 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Math;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- pi* = 3.1415926535897932384626433832795028841972E0;
- e* = 2.7182818284590452353602874713526624977572E0;
-
- ZERO = 0.0E0;
- ONE = 1.0E0;
- HALF = 0.5E0;
- TWO = 2.0E0;
- sqrtHalf = 0.70710678118654752440E0;
- eps = 5.5511151E-17;
- ln2Inv = 1.44269504088896340735992468100189213E0;
- piInv = ONE / pi;
- Limit = 1.0536712E-8;
- piByTwo = pi / TWO;
-
- expoMax = 1023;
- expoMin = 1 - expoMax;
-
-
-VAR
-
- LnInfinity, LnSmall, large, miny: REAL;
-
-
-PROCEDURE [stdcall64] sqrt* (x: REAL): REAL;
-BEGIN
- ASSERT(x >= ZERO);
- SYSTEM.CODE(
- 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *)
- 05DH, (* pop rbp *)
- 0C2H, 08H, 00H (* ret 8 *)
- )
-
- RETURN 0.0
-END sqrt;
-
-
-PROCEDURE sqri* (x: INTEGER): INTEGER;
- RETURN x * x
-END sqri;
-
-
-PROCEDURE sqrr* (x: REAL): REAL;
- RETURN x * x
-END sqrr;
-
-
-PROCEDURE exp* (x: REAL): REAL;
-CONST
- c1 = 0.693359375E0;
- c2 = -2.1219444005469058277E-4;
- P0 = 0.249999999999999993E+0;
- P1 = 0.694360001511792852E-2;
- P2 = 0.165203300268279130E-4;
- Q1 = 0.555538666969001188E-1;
- Q2 = 0.495862884905441294E-3;
-
-VAR
- xn, g, p, q, z: REAL;
- n: INTEGER;
-
-BEGIN
- IF x > LnInfinity THEN
- x := SYSTEM.INF()
- ELSIF x < LnSmall THEN
- x := ZERO
- ELSIF ABS(x) < eps THEN
- x := ONE
- ELSE
- IF x >= ZERO THEN
- n := FLOOR(ln2Inv * x + HALF)
- ELSE
- n := FLOOR(ln2Inv * x - HALF)
- END;
-
- xn := FLT(n);
- g := (x - xn * c1) - xn * c2;
- z := g * g;
- p := ((P2 * z + P1) * z + P0) * g;
- q := (Q2 * z + Q1) * z + HALF;
- x := HALF + p / (q - p);
- PACK(x, n + 1)
- END
-
- RETURN x
-END exp;
-
-
-PROCEDURE ln* (x: REAL): REAL;
-CONST
- c1 = 355.0E0 / 512.0E0;
- c2 = -2.121944400546905827679E-4;
- P0 = -0.64124943423745581147E+2;
- P1 = 0.16383943563021534222E+2;
- P2 = -0.78956112887491257267E+0;
- Q0 = -0.76949932108494879777E+3;
- Q1 = 0.31203222091924532844E+3;
- Q2 = -0.35667977739034646171E+2;
-
-VAR
- zn, zd, r, z, w, p, q, xn: REAL;
- n: INTEGER;
-
-BEGIN
- ASSERT(x > ZERO);
-
- UNPK(x, n);
- x := x * HALF;
-
- IF x > sqrtHalf THEN
- zn := x - ONE;
- zd := x * HALF + HALF;
- INC(n)
- ELSE
- zn := x - HALF;
- zd := zn * HALF + HALF
- END;
-
- z := zn / zd;
- w := z * z;
- q := ((w + Q2) * w + Q1) * w + Q0;
- p := w * ((P2 * w + P1) * w + P0);
- r := z + z * (p / q);
- xn := FLT(n)
-
- RETURN (xn * c2 + r) + xn * c1
-END ln;
-
-
-PROCEDURE power* (base, exponent: REAL): REAL;
-BEGIN
- ASSERT(base > ZERO)
- RETURN exp(exponent * ln(base))
-END power;
-
-
-PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
-VAR
- i: INTEGER;
- a: REAL;
-
-BEGIN
- a := 1.0;
-
- IF base # 0.0 THEN
- IF exponent # 0 THEN
- IF exponent < 0 THEN
- base := 1.0 / base
- END;
- i := ABS(exponent);
- WHILE i > 0 DO
- WHILE ~ODD(i) DO
- i := LSR(i, 1);
- base := sqrr(base)
- END;
- DEC(i);
- a := a * base
- END
- ELSE
- a := 1.0
- END
- ELSE
- ASSERT(exponent > 0);
- a := 0.0
- END
-
- RETURN a
-END ipower;
-
-
-PROCEDURE log* (base, x: REAL): REAL;
-BEGIN
- ASSERT(base > ZERO);
- ASSERT(x > ZERO)
- RETURN ln(x) / ln(base)
-END log;
-
-
-PROCEDURE SinCos (x, y, sign: REAL): REAL;
-CONST
- ymax = 210828714;
- c1 = 3.1416015625E0;
- c2 = -8.908910206761537356617E-6;
- r1 = -0.16666666666666665052E+0;
- r2 = 0.83333333333331650314E-2;
- r3 = -0.19841269841201840457E-3;
- r4 = 0.27557319210152756119E-5;
- r5 = -0.25052106798274584544E-7;
- r6 = 0.16058936490371589114E-9;
- r7 = -0.76429178068910467734E-12;
- r8 = 0.27204790957888846175E-14;
-
-VAR
- n: INTEGER;
- xn, f, x1, g: REAL;
-
-BEGIN
- ASSERT(y < FLT(ymax));
-
- n := FLOOR(y * piInv + HALF);
- xn := FLT(n);
- IF ODD(n) THEN
- sign := -sign
- END;
- x := ABS(x);
- IF x # y THEN
- xn := xn - HALF
- END;
-
- x1 := FLT(FLOOR(x));
- f := ((x1 - xn * c1) + (x - x1)) - xn * c2;
-
- IF ABS(f) < Limit THEN
- x := sign * f
- ELSE
- g := f * f;
- g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g;
- g := f + f * g;
- x := sign * g
- END
-
- RETURN x
-END SinCos;
-
-
-PROCEDURE sin* (x: REAL): REAL;
-BEGIN
- IF x < ZERO THEN
- x := SinCos(x, -x, -ONE)
- ELSE
- x := SinCos(x, x, ONE)
- END
-
- RETURN x
-END sin;
-
-
-PROCEDURE cos* (x: REAL): REAL;
- RETURN SinCos(x, ABS(x) + piByTwo, ONE)
-END cos;
-
-
-PROCEDURE tan* (x: REAL): REAL;
-VAR
- s, c: REAL;
-
-BEGIN
- s := sin(x);
- c := sqrt(ONE - s * s);
- x := ABS(x) / (TWO * pi);
- x := x - FLT(FLOOR(x));
- IF (0.25 < x) & (x < 0.75) THEN
- c := -c
- END
-
- RETURN s / c
-END tan;
-
-
-PROCEDURE arctan2* (y, x: REAL): REAL;
-CONST
- P0 = 0.216062307897242551884E+3; P1 = 0.3226620700132512059245E+3;
- P2 = 0.13270239816397674701E+3; P3 = 0.1288838303415727934E+2;
- Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3;
- Q2 = 0.221050883028417680623E+3; Q3 = 0.3850148650835119501E+2;
- Sqrt3 = 1.7320508075688772935E0;
-
-VAR
- atan, z, z2, p, q: REAL;
- yExp, xExp, Quadrant: INTEGER;
-
-BEGIN
- IF ABS(x) < miny THEN
- ASSERT(ABS(y) >= miny);
- atan := piByTwo
- ELSE
- z := y;
- UNPK(z, yExp);
- z := x;
- UNPK(z, xExp);
-
- IF yExp - xExp >= expoMax - 3 THEN
- atan := piByTwo
- ELSIF yExp - xExp < expoMin + 3 THEN
- atan := ZERO
- ELSE
- IF ABS(y) > ABS(x) THEN
- z := ABS(x / y);
- Quadrant := 2
- ELSE
- z := ABS(y / x);
- Quadrant := 0
- END;
-
- IF z > TWO - Sqrt3 THEN
- z := (z * Sqrt3 - ONE) / (Sqrt3 + z);
- INC(Quadrant)
- END;
-
- IF ABS(z) < Limit THEN
- atan := z
- ELSE
- z2 := z * z;
- p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z;
- q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0;
- atan := p / q
- END;
-
- CASE Quadrant OF
- |0:
- |1: atan := atan + pi / 6.0
- |2: atan := piByTwo - atan
- |3: atan := pi / 3.0 - atan
- END
- END;
-
- IF x < ZERO THEN
- atan := pi - atan
- END
- END;
-
- IF y < ZERO THEN
- atan := -atan
- END
-
- RETURN atan
-END arctan2;
-
-
-PROCEDURE arcsin* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) <= ONE)
- RETURN arctan2(x, sqrt(ONE - x * x))
-END arcsin;
-
-
-PROCEDURE arccos* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) <= ONE)
- RETURN arctan2(sqrt(ONE - x * x), x)
-END arccos;
-
-
-PROCEDURE arctan* (x: REAL): REAL;
- RETURN arctan2(x, ONE)
-END arctan;
-
-
-PROCEDURE sinh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x - ONE / x) * HALF
-END sinh;
-
-
-PROCEDURE cosh* (x: REAL): REAL;
-BEGIN
- x := exp(x)
- RETURN (x + ONE / x) * HALF
-END cosh;
-
-
-PROCEDURE tanh* (x: REAL): REAL;
-BEGIN
- IF x > 15.0 THEN
- x := ONE
- ELSIF x < -15.0 THEN
- x := -ONE
- ELSE
- x := exp(TWO * x);
- x := (x - ONE) / (x + ONE)
- END
-
- RETURN x
-END tanh;
-
-
-PROCEDURE arsinh* (x: REAL): REAL;
- RETURN ln(x + sqrt(x * x + ONE))
-END arsinh;
-
-
-PROCEDURE arcosh* (x: REAL): REAL;
-BEGIN
- ASSERT(x >= ONE)
- RETURN ln(x + sqrt(x * x - ONE))
-END arcosh;
-
-
-PROCEDURE artanh* (x: REAL): REAL;
-BEGIN
- ASSERT(ABS(x) < ONE)
- RETURN HALF * ln((ONE + x) / (ONE - x))
-END artanh;
-
-
-PROCEDURE sgn* (x: REAL): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF x > ZERO THEN
- res := 1
- ELSIF x < ZERO THEN
- res := -1
- ELSE
- res := 0
- END
-
- RETURN res
-END sgn;
-
-
-PROCEDURE fact* (n: INTEGER): REAL;
-VAR
- res: REAL;
-
-BEGIN
- res := ONE;
- WHILE n > 1 DO
- res := res * FLT(n);
- DEC(n)
- END
-
- RETURN res
-END fact;
-
-
-PROCEDURE DegToRad* (x: REAL): REAL;
- RETURN x * (pi / 180.0)
-END DegToRad;
-
-
-PROCEDURE RadToDeg* (x: REAL): REAL;
- RETURN x * (180.0 / pi)
-END RadToDeg;
-
-
-(* Return hypotenuse of triangle *)
-PROCEDURE hypot* (x, y: REAL): REAL;
-VAR
- a: REAL;
-
-BEGIN
- x := ABS(x);
- y := ABS(y);
- IF x > y THEN
- a := x * sqrt(1.0 + sqrr(y / x))
- ELSE
- IF x > 0.0 THEN
- a := y * sqrt(1.0 + sqrr(x / y))
- ELSE
- a := y
- END
- END
-
- RETURN a
-END hypot;
-
-
-BEGIN
- large := 1.9;
- PACK(large, expoMax);
- miny := ONE / large;
- LnInfinity := ln(large);
- LnSmall := ln(miny);
-END Math.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/Out.ob07 b/programs/develop/oberon07/Lib/Windows64/Out.ob07
deleted file mode 100644
index 3903c1117..000000000
--- a/programs/develop/oberon07/Lib/Windows64/Out.ob07
+++ /dev/null
@@ -1,86 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE Out;
-
-IMPORT SYSTEM;
-
-
-VAR
-
- hConsoleOutput: INTEGER;
-
-PROCEDURE [windows, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER);
-PROCEDURE [windows, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER);
-PROCEDURE [windows, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision, x: INTEGER);
-
-PROCEDURE [windows, "kernel32.dll", ""]
- WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER);
-
-PROCEDURE [windows, "kernel32.dll", ""]
- GetStdHandle (nStdHandle: INTEGER): INTEGER;
-
-
-PROCEDURE Char* (x: CHAR);
-BEGIN
- printf1(SYSTEM.SADR("%c"), ORD(x))
-END Char;
-
-
-PROCEDURE StringW* (s: ARRAY OF WCHAR);
-BEGIN
- WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0)
-END StringW;
-
-
-PROCEDURE String* (s: ARRAY OF CHAR);
-BEGIN
- printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
-END String;
-
-
-PROCEDURE Ln*;
-BEGIN
- printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10)))
-END Ln;
-
-
-PROCEDURE Int* (x, width: INTEGER);
-BEGIN
- printf2(SYSTEM.SADR("%*lld"), width, x)
-END Int;
-
-
-PROCEDURE intval (x: REAL): INTEGER;
-VAR
- i: INTEGER;
-
-BEGIN
- SYSTEM.GET(SYSTEM.ADR(x), i)
- RETURN i
-END intval;
-
-
-PROCEDURE Real* (x: REAL; width: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), intval(x))
-END Real;
-
-
-PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
-BEGIN
- printf3(SYSTEM.SADR("%*.*f"), width, precision, intval(x))
-END FixReal;
-
-
-PROCEDURE Open*;
-BEGIN
- hConsoleOutput := GetStdHandle(-11)
-END Open;
-
-
-END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/RTL.ob07 b/programs/develop/oberon07/Lib/Windows64/RTL.ob07
deleted file mode 100644
index 7b6bbfb6a..000000000
--- a/programs/develop/oberon07/Lib/Windows64/RTL.ob07
+++ /dev/null
@@ -1,503 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2018-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE RTL;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- bit_depth* = 64;
- maxint* = 7FFFFFFFFFFFFFFFH;
- minint* = 8000000000000000H;
-
- WORD = bit_depth DIV 8;
- MAX_SET = bit_depth - 1;
-
-
-VAR
-
- name: INTEGER;
- types: INTEGER;
- sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER;
-
-
-PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *)
- 048H, 085H, 0C0H, (* test rax, rax *)
- 07EH, 020H, (* jle L *)
- 0FCH, (* cld *)
- 057H, (* push rdi *)
- 056H, (* push rsi *)
- 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *)
- 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *)
- 048H, 089H, 0C1H, (* mov rcx, rax *)
- 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *)
- 0F3H, 048H, 0A5H, (* rep movsd *)
- 048H, 089H, 0C1H, (* mov rcx, rax *)
- 048H, 083H, 0E1H, 007H, (* and rcx, 7 *)
- 0F3H, 0A4H, (* rep movsb *)
- 05EH, (* pop rsi *)
- 05FH (* pop rdi *)
- (* L: *)
- )
-END _move;
-
-
-PROCEDURE [stdcall64] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
-
-BEGIN
- IF len_src > len_dst THEN
- res := FALSE
- ELSE
- _move(len_src * base_size, dst, src);
- res := TRUE
- END
-
- RETURN res
-END _arrcpy;
-
-
-PROCEDURE [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
- _move(MIN(len_dst, len_src) * chr_size, dst, src)
-END _strcpy;
-
-
-PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER);
-VAR
- i, n, k: INTEGER;
-
-BEGIN
- k := LEN(A) - 1;
- n := A[0];
- i := 0;
- WHILE i < k DO
- A[i] := A[i + 1];
- INC(i)
- END;
- A[k] := n
-END _rot;
-
-
-PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER;
-BEGIN
- IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
- SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a)
- ELSE
- a := 0
- END
-
- RETURN a
-END _set;
-
-
-PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *)
-BEGIN
- SYSTEM.CODE(
- 048H, 031H, 0C0H, (* xor rax, rax *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *)
- 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *)
- 077H, 004H, (* ja L *)
- 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *)
- (* L: *)
- )
-END _set1;
-
-
-PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *)
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *)
- 048H, 031H, 0D2H, (* xor rdx, rdx *)
- 048H, 085H, 0C0H, (* test rax, rax *)
- 074H, 022H, (* je L2 *)
- 07FH, 003H, (* jg L1 *)
- 048H, 0F7H, 0D2H, (* not rdx *)
- (* L1: *)
- 049H, 089H, 0C0H, (* mov r8, rax *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *)
- 048H, 0F7H, 0F9H, (* idiv rcx *)
- 048H, 085H, 0D2H, (* test rdx, rdx *)
- 074H, 00EH, (* je L2 *)
- 049H, 031H, 0C8H, (* xor r8, rcx *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07DH, 006H, (* jge L2 *)
- 048H, 0FFH, 0C8H, (* dec rax *)
- 048H, 001H, 0CAH (* add rdx, rcx *)
- (* L2: *)
- )
-END _divmod;
-
-
-PROCEDURE [stdcall64] _new* (t, size: INTEGER; VAR ptr: INTEGER);
-BEGIN
- ptr := API._NEW(size);
- IF ptr # 0 THEN
- SYSTEM.PUT(ptr, t);
- INC(ptr, WORD)
- END
-END _new;
-
-
-PROCEDURE [stdcall64] _dispose* (VAR ptr: INTEGER);
-BEGIN
- IF ptr # 0 THEN
- ptr := API._DISPOSE(ptr - WORD)
- END
-END _dispose;
-
-
-PROCEDURE [stdcall64] _length* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
- 048H, 0FFH, 0C8H, (* dec rax *)
- (* L1: *)
- 048H, 0FFH, 0C0H, (* inc rax *)
- 080H, 038H, 000H, (* cmp byte [rax], 0 *)
- 074H, 005H, (* jz L2 *)
- 0E2H, 0F6H, (* loop L1 *)
- 048H, 0FFH, 0C0H, (* inc rax *)
- (* L2: *)
- 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *)
- )
-END _length;
-
-
-PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER);
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
- 048H, 083H, 0E8H, 002H, (* sub rax, 2 *)
- (* L1: *)
- 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
- 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *)
- 074H, 006H, (* jz L2 *)
- 0E2H, 0F4H, (* loop L1 *)
- 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
- (* L2: *)
- 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *)
- 048H, 0D1H, 0E8H (* shr rax, 1 *)
- )
-END _lengthw;
-
-
-PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
- 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
- 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
- 04DH, 031H, 0C9H, (* xor r9, r9 *)
- 04DH, 031H, 0D2H, (* xor r10, r10 *)
- 048H, 0B8H, 000H, 000H,
- 000H, 000H, 000H, 000H,
- 000H, 080H, (* movabs rax, minint *)
- (* L1: *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07EH, 024H, (* jle L3 *)
- 044H, 08AH, 009H, (* mov r9b, byte[rcx] *)
- 044H, 08AH, 012H, (* mov r10b, byte[rdx] *)
- 048H, 0FFH, 0C1H, (* inc rcx *)
- 048H, 0FFH, 0C2H, (* inc rdx *)
- 049H, 0FFH, 0C8H, (* dec r8 *)
- 04DH, 039H, 0D1H, (* cmp r9, r10 *)
- 074H, 008H, (* je L2 *)
- 04CH, 089H, 0C8H, (* mov rax, r9 *)
- 04CH, 029H, 0D0H, (* sub rax, r10 *)
- 0EBH, 008H, (* jmp L3 *)
- (* L2: *)
- 04DH, 085H, 0C9H, (* test r9, r9 *)
- 075H, 0DAH, (* jne L1 *)
- 048H, 031H, 0C0H, (* xor rax, rax *)
- (* L3: *)
- 05DH, (* pop rbp *)
- 0C2H, 018H, 000H (* ret 24 *)
- )
- RETURN 0
-END strncmp;
-
-
-PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER;
-BEGIN
- SYSTEM.CODE(
- 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
- 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
- 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
- 04DH, 031H, 0C9H, (* xor r9, r9 *)
- 04DH, 031H, 0D2H, (* xor r10, r10 *)
- 048H, 0B8H, 000H, 000H,
- 000H, 000H, 000H, 000H,
- 000H, 080H, (* movabs rax, minint *)
- (* L1: *)
- 04DH, 085H, 0C0H, (* test r8, r8 *)
- 07EH, 028H, (* jle L3 *)
- 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *)
- 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *)
- 048H, 083H, 0C1H, 002H, (* add rcx, 2 *)
- 048H, 083H, 0C2H, 002H, (* add rdx, 2 *)
- 049H, 0FFH, 0C8H, (* dec r8 *)
- 04DH, 039H, 0D1H, (* cmp r9, r10 *)
- 074H, 008H, (* je L2 *)
- 04CH, 089H, 0C8H, (* mov rax, r9 *)
- 04CH, 029H, 0D0H, (* sub rax, r10 *)
- 0EBH, 008H, (* jmp L3 *)
- (* L2: *)
- 04DH, 085H, 0C9H, (* test r9, r9 *)
- 075H, 0D6H, (* jne L1 *)
- 048H, 031H, 0C0H, (* xor rax, rax *)
- (* L3: *)
- 05DH, (* pop rbp *)
- 0C2H, 018H, 000H (* ret 24 *)
- )
- RETURN 0
-END strncmpw;
-
-
-PROCEDURE [stdcall64] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: CHAR;
-
-BEGIN
- res := strncmp(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmp;
-
-
-PROCEDURE [stdcall64] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
-VAR
- res: INTEGER;
- bRes: BOOLEAN;
- c: WCHAR;
-
-BEGIN
- res := strncmpw(str1, str2, MIN(len1, len2));
- IF res = minint THEN
- IF len1 > len2 THEN
- SYSTEM.GET(str1 + len2 * 2, c);
- res := ORD(c)
- ELSIF len1 < len2 THEN
- SYSTEM.GET(str2 + len1 * 2, c);
- res := -ORD(c)
- ELSE
- res := 0
- END
- END;
-
- CASE op OF
- |0: bRes := res = 0
- |1: bRes := res # 0
- |2: bRes := res < 0
- |3: bRes := res <= 0
- |4: bRes := res > 0
- |5: bRes := res >= 0
- END
-
- RETURN bRes
-END _strcmpw;
-
-
-PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
-VAR
- c: CHAR;
- i: INTEGER;
-
-BEGIN
- i := 0;
- REPEAT
- SYSTEM.GET(pchar, c);
- s[i] := c;
- INC(pchar);
- INC(i)
- UNTIL c = 0X
-END PCharToStr;
-
-
-PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
-VAR
- i, a: INTEGER;
-
-BEGIN
- i := 0;
- a := x;
- REPEAT
- INC(i);
- a := a DIV 10
- UNTIL a = 0;
-
- str[i] := 0X;
-
- REPEAT
- DEC(i);
- str[i] := CHR(x MOD 10 + ORD("0"));
- x := x DIV 10
- UNTIL x = 0
-END IntToStr;
-
-
-PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
-VAR
- n1, n2: INTEGER;
-
-BEGIN
- n1 := LENGTH(s1);
- n2 := LENGTH(s2);
-
- ASSERT(n1 + n2 < LEN(s1));
-
- SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
- s1[n1 + n2] := 0X
-END append;
-
-
-PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER);
-VAR
- s, temp: ARRAY 1024 OF CHAR;
-
-BEGIN
- CASE err OF
- | 1: s := "assertion failure"
- | 2: s := "NIL dereference"
- | 3: s := "bad divisor"
- | 4: s := "NIL procedure call"
- | 5: s := "type guard error"
- | 6: s := "index out of range"
- | 7: s := "invalid CASE"
- | 8: s := "array assignment error"
- | 9: s := "CHR out of range"
- |10: s := "WCHR out of range"
- |11: s := "BYTE out of range"
- END;
-
- append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
- append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
-
- API.DebugMsg(SYSTEM.ADR(s[0]), name);
-
- API.exit_thread(0)
-END _error;
-
-
-PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _isrec;
-
-
-PROCEDURE [stdcall64] _is* (t0, p: INTEGER): INTEGER;
-BEGIN
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- END
-
- RETURN p MOD 2
-END _is;
-
-
-PROCEDURE [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(t0 + t1 + types, t0)
- RETURN t0 MOD 2
-END _guardrec;
-
-
-PROCEDURE [stdcall64] _guard* (t0, p: INTEGER): INTEGER;
-BEGIN
- SYSTEM.GET(p, p);
- IF p # 0 THEN
- SYSTEM.GET(p - WORD, p);
- SYSTEM.GET(t0 + p + types, p)
- ELSE
- p := 1
- END
-
- RETURN p MOD 2
-END _guard;
-
-
-PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
- RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
-END _dllentry;
-
-
-PROCEDURE [stdcall64] _sofinit*;
-BEGIN
- API.sofinit
-END _sofinit;
-
-
-PROCEDURE [stdcall64] _exit* (code: INTEGER);
-BEGIN
- API.exit(code)
-END _exit;
-
-
-PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
-VAR
- t0, t1, i, j: INTEGER;
-
-BEGIN
- API.init(param, code);
-
- types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
- ASSERT(types # 0);
- FOR i := 0 TO tcount - 1 DO
- FOR j := 0 TO tcount - 1 DO
- t0 := i; t1 := j;
-
- WHILE (t1 # 0) & (t1 # t0) DO
- SYSTEM.GET(_types + t1 * WORD, t1)
- END;
-
- SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
- END
- END;
-
- FOR i := 0 TO MAX_SET DO
- FOR j := 0 TO i DO
- sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i)
- END
- END;
-
- name := modname
-END _init;
-
-
-END RTL.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 b/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07
deleted file mode 100644
index a6337b579..000000000
--- a/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07
+++ /dev/null
@@ -1,224 +0,0 @@
-(*
- BSD 2-Clause License
-
- Copyright (c) 2019-2020, Anton Krotov
- All rights reserved.
-*)
-
-MODULE WINAPI;
-
-IMPORT SYSTEM, API;
-
-
-CONST
-
- OFS_MAXPATHNAME* = 128;
-
- KERNEL = "kernel32.dll";
- USER = "user32.dll";
- MSVCRT = "msvcrt.dll";
-
-
-TYPE
-
- DLL_ENTRY* = API.DLL_ENTRY;
-
- STRING = ARRAY 260 OF CHAR;
-
- TCoord* = RECORD
-
- X*, Y*: WCHAR
-
- END;
-
- TSmallRect* = RECORD
-
- Left*, Top*, Right*, Bottom*: WCHAR
-
- END;
-
- TConsoleScreenBufferInfo* = RECORD
-
- dwSize*: TCoord;
- dwCursorPosition*: TCoord;
- wAttributes*: WCHAR;
- srWindow*: TSmallRect;
- dwMaximumWindowSize*: TCoord
-
- END;
-
- TSystemTime* = RECORD
-
- Year*,
- Month*,
- DayOfWeek*,
- Day*,
- Hour*,
- Min*,
- Sec*,
- MSec*: WCHAR
-
- END;
-
- tm* = RECORD
-
- sec*,
- min*,
- hour*,
- mday*,
- mon*,
- year*,
- wday*,
- yday*,
- isdst*: SYSTEM.CARD32
-
- END;
-
- PSecurityAttributes* = POINTER TO TSecurityAttributes;
-
- TSecurityAttributes* = RECORD
-
- nLength*: SYSTEM.CARD32;
- lpSecurityDescriptor*: INTEGER;
- bInheritHandle*: SYSTEM.CARD32 (* BOOL *)
-
- END;
-
- TFileTime* = RECORD
-
- dwLowDateTime*,
- dwHighDateTime*: SYSTEM.CARD32
-
- END;
-
- TWin32FindData* = RECORD
-
- dwFileAttributes*: SYSTEM.CARD32;
- ftCreationTime*: TFileTime;
- ftLastAccessTime*: TFileTime;
- ftLastWriteTime*: TFileTime;
- nFileSizeHigh*: SYSTEM.CARD32;
- nFileSizeLow*: SYSTEM.CARD32;
- dwReserved0*: SYSTEM.CARD32;
- dwReserved1*: SYSTEM.CARD32;
- cFileName*: STRING;
- cAlternateFileName*: ARRAY 14 OF CHAR;
- dwFileType*: SYSTEM.CARD32;
- dwCreatorType*: SYSTEM.CARD32;
- wFinderFlags*: WCHAR
-
- END;
-
- OFSTRUCT* = RECORD
-
- cBytes*: BYTE;
- fFixedDisk*: BYTE;
- nErrCode*: WCHAR;
- Reserved1*: WCHAR;
- Reserved2*: WCHAR;
- szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR
-
- END;
-
- POverlapped* = POINTER TO OVERLAPPED;
-
- OVERLAPPED* = RECORD
-
- Internal*: INTEGER;
- InternalHigh*: INTEGER;
- Offset*: SYSTEM.CARD32;
- OffsetHigh*: SYSTEM.CARD32;
- hEvent*: INTEGER
-
- END;
-
-
-PROCEDURE [windows-, KERNEL, ""] SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputCharacterA* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetStdHandle* (nStdHandle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] CloseHandle* (hObject: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetCommandLineA* (): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GlobalFree* (hMem: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ExitProcess* (code: INTEGER);
-
-PROCEDURE [windows-, KERNEL, ""] GetTickCount* (): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] Sleep* (dwMilliseconds: INTEGER);
-
-PROCEDURE [windows-, KERNEL, ""] FreeLibrary* (hLibModule: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetProcAddress* (hModule, name: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] LoadLibraryA* (name: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] AllocConsole* (): BOOLEAN;
-
-PROCEDURE [windows-, KERNEL, ""] FreeConsole* (): BOOLEAN;
-
-PROCEDURE [windows-, KERNEL, ""] GetLocalTime* (T: TSystemTime);
-
-PROCEDURE [windows-, KERNEL, ""] RemoveDirectoryA* (lpPathName: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] GetFileAttributesA* (lpPathName: INTEGER): SET;
-
-PROCEDURE [windows-, KERNEL, ""] CreateDirectoryA* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FindFirstFileA* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] DeleteFileA* (lpFileName: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] FindClose* (hFindFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] CreateFileA* (
- lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
- lpSecurityAttributes: PSecurityAttributes;
- dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] ReadConsoleA* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, KERNEL, ""] WriteConsoleA* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
-
-PROCEDURE [windows-, USER, ""] MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-PROCEDURE [windows-, USER, ""] MessageBoxW* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
-
-PROCEDURE [windows-, USER, ""] CreateWindowExA* (
- dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y,
- nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER;
-
-PROCEDURE [windows-, MSVCRT, ""] time* (ptr: INTEGER): INTEGER;
-
-PROCEDURE [windows-, MSVCRT, ""] mktime* (time: tm): INTEGER;
-
-
-PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
-BEGIN
- API.SetDll(process_detach, thread_detach, thread_attach)
-END SetDllEntry;
-
-
-END WINAPI.
\ No newline at end of file
diff --git a/programs/develop/oberon07/README.md b/programs/develop/oberon07/README.md
new file mode 100644
index 000000000..e2d394b37
--- /dev/null
+++ b/programs/develop/oberon07/README.md
@@ -0,0 +1,6 @@
+Oberon-07 compiler for x64 (Windows, Linux), x86 (Windows, Linux, KolibriOS), MSP430x{1,2}xx, STM32 Cortex-M3
+============================================
+**Links:**
+
+https://github.com/prospero78/obGraph (Тест графических возможностей компилятора Оберона-07)
+https://github.com/VadimAnIsaev/Oberon-07-additional-modules (Additional modules / Дополнительные модули)
diff --git a/programs/develop/oberon07/Samples/Linux/HW.ob07 b/programs/develop/oberon07/Samples/Linux/HW.ob07
deleted file mode 100644
index 382ab9ca2..000000000
--- a/programs/develop/oberon07/Samples/Linux/HW.ob07
+++ /dev/null
@@ -1,52 +0,0 @@
-MODULE HW;
-
-IMPORT SYSTEM, Libdl, Args;
-
-
-VAR
-
- libc: INTEGER;
- puts: PROCEDURE [linux] (pStr: INTEGER);
-
-
-PROCEDURE OutStringLn (s: ARRAY OF CHAR);
-BEGIN
- puts(SYSTEM.ADR(s[0]))
-END OutStringLn;
-
-
-PROCEDURE main;
-VAR
- i: INTEGER;
- s: ARRAY 80 OF CHAR;
-
-BEGIN
- OutStringLn("Hello");
-
- OutStringLn("");
- i := 0;
- WHILE i < Args.argc DO
- Args.GetArg(i, s);
- INC(i);
- OutStringLn(s)
- END;
-
- OutStringLn("");
- i := 0;
- WHILE i < Args.envc DO
- Args.GetEnv(i, s);
- INC(i);
- OutStringLn(s)
- END;
- OutStringLn("");
-
- OutStringLn("Bye")
-END main;
-
-
-BEGIN
- libc := Libdl.open("libc.so.6", Libdl.LAZY);
- SYSTEM.PUT(SYSTEM.ADR(puts), Libdl.sym(libc, "puts"));
- ASSERT(puts # NIL);
- main
-END HW.
diff --git a/programs/develop/oberon07/Samples/Linux/X11/animation/_unix.ob07 b/programs/develop/oberon07/Samples/Linux/X11/animation/_unix.ob07
deleted file mode 100644
index 0cd77749e..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/animation/_unix.ob07
+++ /dev/null
@@ -1,74 +0,0 @@
-MODULE _unix; (* connect to unix host *)
-IMPORT SYSTEM, API;
-
-(* how to find C declarations:
-- gcc -E preprocess only (to stdout) (preprocessor expand)
-- grep -r name /usr/include/*
-- ldd progfile
-- objdump -T progfile (-t) (-x)
-*)
-
-CONST RTLD_LAZY = 1;
- BIT_DEPTH* = API.BIT_DEPTH;
-
-VAR sym, libc, libdl :INTEGER;
-
- _dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
- _dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
- _dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
- _open* :PROCEDURE [linux] (name, flags, mode :INTEGER) :INTEGER;
- _close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
- _read* :PROCEDURE [linux] (fd, buf, sz :INTEGER): INTEGER;
- _write* :PROCEDURE [linux] (fd, buf, sz :INTEGER) :INTEGER;
- _exit* :PROCEDURE [linux] (n :INTEGER);
- _malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
- _select* :PROCEDURE [linux] (cnt, readfds, writefds, exceptfds, timeout :INTEGER) :INTEGER;
-
- (* error message to stderr *)
-PROCEDURE writeChar (c :CHAR);
-VAR ri :INTEGER;
-BEGIN ri := _write (2, SYSTEM.ADR(c), 1); ASSERT (ri = 1) END writeChar;
-
-PROCEDURE writeString (s :ARRAY OF CHAR);
-VAR i :INTEGER;
-BEGIN i := 0; WHILE s[i] # 0X DO writeChar (s[i]); INC(i) END; END writeString;
-
-PROCEDURE nl;
-BEGIN writeChar (0AX) END nl;
-
-
-PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
-BEGIN
- sym := _dlsym (lib, SYSTEM.ADR(name[0]));
- IF sym = 0 THEN writeString ("error: dlsym: "); writeString (name); nl END;
- ASSERT (sym # 0);
- SYSTEM.PUT (adr, sym)
-END getSymAdr;
-
-
-PROCEDURE finish*;
-VAR ri :INTEGER;
-BEGIN
- IF libc # 0 THEN ri := _dlclose (libc); libc := 0 END;
- IF libdl # 0 THEN ri := _dlclose (libdl); libdl := 0 END;
-END finish;
-
-
-BEGIN
- _dlopen := API.dlopen;
- _dlsym := API.dlsym;
- libc := _dlopen (SYSTEM.SADR("libc.so.6"), RTLD_LAZY); ASSERT (libc # 0);
- (* getSymAdr is not used for write() to get writeString() error message going *);
- sym := _dlsym (libc, SYSTEM.SADR("write")); ASSERT (sym # 0); SYSTEM.PUT (SYSTEM.ADR(_write), sym);
-
- libdl := _dlopen (SYSTEM.SADR("libdl.so.2"), RTLD_LAZY); ASSERT (libdl # 0);
- getSymAdr (libdl, "dlclose", SYSTEM.ADR(_dlclose));
-
- getSymAdr (libc, "open", SYSTEM.ADR(_open));
- getSymAdr (libc, "close", SYSTEM.ADR(_close));
- getSymAdr (libc, "read", SYSTEM.ADR(_read));
- getSymAdr (libc, "exit", SYSTEM.ADR(_exit));
- getSymAdr (libc, "malloc", SYSTEM.ADR(_malloc));
- getSymAdr (libc, "select", SYSTEM.ADR(_select));
-END _unix.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/animation/animation.ob07 b/programs/develop/oberon07/Samples/Linux/X11/animation/animation.ob07
deleted file mode 100644
index eaf840334..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/animation/animation.ob07
+++ /dev/null
@@ -1,89 +0,0 @@
-MODULE animation; (* moving turtle example *)
-(* demonstrates use of timeout and select() to display a moving turtle in an X11 window *)
-IMPORT SYSTEM, gr;
-
-CONST
- Side = 8; (* nr of pixels of a square side *)
-
-VAR base, stride, screenBufSize :INTEGER;
- currentX :INTEGER;
-
-
-PROCEDURE drawSquare (x, y, color :INTEGER);
-VAR p, i, j :INTEGER;
-BEGIN
- p := (y*stride + x*4)*Side;
- ASSERT (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize);
- p := base + p;
- FOR j := 0 TO Side-1 DO
- FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END;
- p := p + stride - Side*4;
- END;
-END drawSquare;
-
-
-PROCEDURE putLine (x : INTEGER; y: INTEGER;str : ARRAY OF CHAR);
-VAR z, x1: INTEGER;
-BEGIN
- FOR z := 0 TO LEN(str) - 1 DO
- x1 := (x + z) MOD 100;
- IF str[z] = "b" THEN drawSquare(x1, y, 0600000H); END; (* brown *)
- IF str[z] = "g" THEN drawSquare(x1, y, 000C000H); END; (* green *)
- END;
-END putLine;
-
-
-PROCEDURE turtlePicture (x , y : INTEGER);
-BEGIN
- putLine(x, y + 0 , "....bb........");
- putLine(x, y + 1 , "....bbb.......");
- putLine(x, y + 2 , "....bbbb......");
- putLine(x, y + 3 , ".bb..bbb......");
- putLine(x, y + 4 , ".bgggbbbgbbgb.");
- putLine(x, y + 5 , ".ggggggggbbbb.");
- putLine(x, y + 6 , "bggggggggbbbb.");
- putLine(x, y + 7 , ".ggggggg......");
- putLine(x, y + 8 , ".bb..bbb......");
- putLine(x, y + 9 , "....bbbb......");
- putLine(x, y + 10, ".....bbb......");
- putLine(x, y + 11, ".....bb.......")
-END turtlePicture;
-
-
-PROCEDURE drawAll;
-BEGIN
- gr.screenBegin;
- gr.clear (0C0F0FFH); (* light blue *)
- turtlePicture (currentX, 15);
- gr.screenEnd;
-END drawAll;
-
-
-PROCEDURE run*;
-VAR stop :BOOLEAN;
- ev :gr.EventPars;
- ch :CHAR;
-BEGIN
- base := gr.base; stride := gr.stride;
- gr.createWindow (800, 480);
- screenBufSize := gr.winHeight * stride;
- stop := FALSE; currentX := 15;
- drawAll;
- REPEAT
- gr.nextEvent (400, ev);
- IF ev[0] = gr.EventTimeOut THEN
- drawAll;
- INC (currentX, 4);
- ELSIF ev[0] = gr.EventKeyPressed THEN
- ch := CHR(ev[4]);
- IF (ch = "q") OR (ch = 0AX) OR (ch = " ") THEN stop := TRUE END;
- IF ev[2] = 9 (* ESC *) THEN stop := TRUE END;
- END;
- UNTIL stop;
- gr.finish;
-END run;
-
-BEGIN
- run;
-END animation.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/animation/gr.ob07 b/programs/develop/oberon07/Samples/Linux/X11/animation/gr.ob07
deleted file mode 100644
index c22e75e82..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/animation/gr.ob07
+++ /dev/null
@@ -1,292 +0,0 @@
-MODULE gr; (* connect to libX11 *)
-IMPORT SYSTEM, unix, out;
-
-(*
-X11 documentation in:
-- http://tronche.com/gui/x/xlib/ an X11 reference
-- http://www.sbin.org/doc/Xlib an X11 tutorial (this domain has disappeared)
-*)
-
-CONST
- InputOutput = 1;
- StructureNotifyMask = 20000H; (* input event mask *)
- ExposureMask = 8000H; KeyPressMask = 1; KeyReleaseMask = 2;
- ButtonPressMask = 4; ButtonReleaseMask = 8; (* PointerNotionMask *)
- ZPixmap = 2;
- Expose = 12; (* X event type *) ConfigureNotify = 22; KeyPress = 2; ButtonPress = 4;
-
- EventTimeOut* = 80; (* 0, 0, 0, 0 *)
- EventResize* = 81; (* 0, w, h, 0 *)
- EventKeyPressed* = 82; (* isPrintable, keyCode (X11 scan code), state, keySym (ASCII) *)
- EventKeyReleased* = 83; (* 0, keyCode, state, 0 *)
- EventButtonPressed* = 84; (* button, x, y, state *)
- EventButtonReleased* = 85; (* button, x, y, state *)
- (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *)
-
- bit64 = ORD(unix.BIT_DEPTH = 64);
-
-TYPE EventPars* = ARRAY 5 OF INTEGER;
- XEvent = RECORD
- val :ARRAY 192 OF BYTE (* union { ..., long pad[24]; } *)
- (* val :ARRAY 48 OF CARD32; *)
- END;
-
-VAR ScreenWidth*, ScreenHeight* :INTEGER;
- winWidth*, winHeight* :INTEGER; (* draw by writing to pixel buffer: *)
- base*, stride* :INTEGER; (* width, height, base ptr, stride in bytes, 32-bit RGB *)
- painting :BOOLEAN;
-
- libX11 :INTEGER; (* handle to dynamic library *)
- XOpenDisplay :PROCEDURE [linux] (name :INTEGER) :INTEGER;
- XCloseDisplay :PROCEDURE [linux] (display :INTEGER);
- XSynchronize :PROCEDURE [linux] (display, onoff :INTEGER) :INTEGER; (* return prev onoff *)
- XConnectionNumber :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XCreateWindow :PROCEDURE [linux] (display, parent_window, x, y, w, h, border_width, depth,
- class, visual, valuemask, attributes :INTEGER) :INTEGER; (* Window *)
- XDefaultScreen :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XDefaultGC :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* GC *)
- XDisplayWidth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XDisplayHeight :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XDefaultVisual :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* visual *)
- XDefaultRootWindow :PROCEDURE [linux] (display :INTEGER) :INTEGER; (* Window *)
- XDefaultDepth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XSelectInput :PROCEDURE [linux] (display, window, event_mask :INTEGER);
- XMapWindow :PROCEDURE [linux] (display, window :INTEGER);
- XNextEvent :PROCEDURE [linux] (display, XEvent_p :INTEGER);
- XPending :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XLookupString :PROCEDURE [linux] (key_event, buffer_return, buflen, keysym_return, status_in_out :INTEGER) :INTEGER;
- XCreateImage :PROCEDURE [linux] (display, visual, depth, format, offset, data,
- width, height, bitmap_pad, bytes_per_line :INTEGER) :INTEGER; (* ptr to XImage *)
- XPutImage :PROCEDURE [linux] (display, window, gc, image, sx, sy, dx, dy, w, h :INTEGER);
-
- display, screen, window, gc, img :INTEGER;
- connectionNr :INTEGER; (* fd of X11 socket *)
- readX11 :unix.fd_set; (* used by select() timeout on X11 socket *)
-
-
-PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
-VAR sym :INTEGER;
-BEGIN
- sym := unix.dlsym (lib, SYSTEM.ADR(name[0]));
- IF sym = 0 THEN out.formatStr ("error: dlsym: %", name); out.nl END;
- ASSERT (sym # 0);
- SYSTEM.PUT (adr, sym)
-END getSymAdr;
-
-
-PROCEDURE init;
-BEGIN
- display := XOpenDisplay (0);
- IF display = 0 THEN out.str ("error: can not open X11 display."); out.nl; out.exit(1) END;
- (* ri := XSynchronize (display, 1); *)
- connectionNr := XConnectionNumber (display); ASSERT (connectionNr < unix.FD_SETSIZE);
- NEW (readX11); unix.FD_ZERO(readX11); unix.FD_SET (connectionNr, readX11);
- screen := XDefaultScreen (display); gc := XDefaultGC (display, screen);
- ScreenWidth := XDisplayWidth (display, screen); ScreenHeight := XDisplayHeight (display, screen);
- base := unix.malloc (ScreenWidth * ScreenHeight * 4);
- IF base = 0 THEN
- out.formatInt2 ("error: can not allocate screen buffer % x %", ScreenWidth, ScreenHeight); out.nl; out.exit(1);
- END;
- stride := ScreenWidth * 4;
- img := XCreateImage (display, XDefaultVisual (display, screen), XDefaultDepth (display, screen),
- ZPixmap, 0, base, ScreenWidth, ScreenHeight, 32, 0);
-END init;
-
-
-PROCEDURE finish*;
-VAR ri :INTEGER;
-BEGIN
- IF display # 0 THEN XCloseDisplay(display); display := 0 END;
- IF libX11 # 0 THEN ri := unix.dlclose (libX11); libX11 := 0 END;
-END finish;
-
-
-PROCEDURE createWindow* (w, h :INTEGER);
-VAR eventMask :INTEGER;
-BEGIN
- IF (w > ScreenWidth) OR (h > ScreenHeight) THEN
- out.str ("error: X11.createWindow: window too large"); out.exit(1);
- END;
- ASSERT ((w >= 0) & (h >= 0));
- window := XCreateWindow (display, XDefaultRootWindow (display), 0, 0, w, h, 0,
- XDefaultDepth (display, screen), InputOutput, XDefaultVisual (display, screen), 0, 0);
- winWidth := w; winHeight := h;
- eventMask := StructureNotifyMask + ExposureMask + KeyPressMask + ButtonPressMask;
- XSelectInput (display, window, eventMask);
- XMapWindow (display, window);
-END createWindow;
-
-
-PROCEDURE screenBegin*;
- (* intended to enable future cooperation with iOS / MacOS *)
-BEGIN
- ASSERT (~painting); painting := TRUE
-END screenBegin;
-
-
-PROCEDURE screenEnd*;
-BEGIN
- ASSERT (painting);
- XPutImage (display, window, gc, img, 0, 0, 0, 0, winWidth, winHeight);
- painting := FALSE;
-END screenEnd;
-
-
-PROCEDURE readInt (e :XEvent; i :INTEGER) :INTEGER;
- (* treat XEvent byte array as int array *)
-VAR n :INTEGER;
-BEGIN
- ASSERT (i >= 0);
- ASSERT (i < 48);
- i := i * 4;
- n := e.val[i+3]*1000000H + e.val[i+2]*10000H + e.val[i+1]*100H + e.val[i];
-RETURN n
-END readInt;
-
-
-PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
-VAR _type, n, ri :INTEGER;
- event :XEvent;
- x, y, w, h :INTEGER;
- timeout :unix.timespec;
-BEGIN
-(* struct XEvent (64-bit):
-any: 4 type 8 serial 4 send_event 8 display 8 window 8 window
-expose: 40 any 4 x, y, w, h, count
-xconfigure: 48 any 4 x, y, w, h
-xkey / xbutton / xmotion: 48 any 8 sub_window 8 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
-*)
-(* struct XEvent (32-bit):
-any: 4 type 4 serial 4 send_event 4 display 4 window
-expose: 20 any 4 x, y, w, h, count
-xconfigure: 24 any 4 x, y, w, h
-xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
-*)
- _type := 0;
- WHILE _type = 0 DO
- IF (msTimeOut > 0) & (XPending(display) = 0) THEN
- timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
- ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
- IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
- END;
- IF _type = 0 THEN
- XNextEvent (display, SYSTEM.ADR(event));
- CASE readInt (event, 0) OF
- Expose :
- x := readInt (event, 5 + 5 * bit64); y := readInt (event, 6 + 5 * bit64);
- w := readInt (event, 7 + 5 * bit64); h := readInt (event, 8 + 5 * bit64);
- XPutImage (display, window, gc, img, x, y, x, y, w, h);
- | ConfigureNotify :
- w := readInt (event, 8 + 6 * bit64); h := readInt (event, 9 + 6 * bit64);
- IF (w # winWidth) & (h # winHeight) THEN
- ASSERT ((w >= 0) & (h >= 0));
- IF w > ScreenWidth THEN w := ScreenWidth END;
- IF h > ScreenHeight THEN h := ScreenHeight END;
- winWidth := w; winHeight := h;
- ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
- END;
- | KeyPress :
- _type := EventKeyPressed;
- x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0); (* KeySym *)
- IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END; (* isprint *)
- ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
- ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
- ev[4] := n; (* KeySym *)
- | ButtonPress :
- _type := EventButtonPressed;
- ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
- ev[2] := readInt (event, 8 + 8 * bit64); (* x *)
- ev[3] := readInt (event, 9 + 8 * bit64); (* y *)
- ev[4] := readInt (event, 12 + 8 * bit64); (* state *)
- ELSE
- END
- END
- END;
- ev[0] := _type
-END nextEvent;
-
-
-PROCEDURE clear* (color :INTEGER); (* fill window area with color *)
-VAR p, i, j :INTEGER;
-BEGIN
- FOR j := 0 TO winHeight-1 DO
- p := base + j*stride;
- FOR i := 0 TO winWidth-1 DO SYSTEM.PUT32 (p, color); INC (p, 4) END
- END
-END clear;
-
-
-(*
-PROCEDURE blitError (stride, x, y, w, h :INTEGER);
-BEGIN
- o.formatInt ("error: screen.blit (src, %)", stride);
- o.formatInt2 (", %, %", x, y);
- o.formatInt2 (", %, %) out of bounds", w, h); o.nl;
- ASSERT (FALSE)
-END blitError;
-
-PROCEDURE blit* (src, srcStride, x, y, w, h :INTEGER);
-VAR dstStride, p :INTEGER;
-BEGIN
- IF (x < 0) OR (y < 0) THEN blitError (srcStride, x, y, w, h) END;
- IF (w <= 0) OR (h <= 0) THEN blitError (srcStride, x, y, w, h) END;
- IF (x + w > ScreenWidth) OR (y + h > ScreenHeight) THEN blitError (srcStride, x, y, w, h) END;
-
- dstStride := ScreenWidth - w;
- p := ScreenBase + y * ScreenWidth + x * 4;
- REPEAT
- SYSTEM.COPY (src, p, w);
- INC (src, srcStride); INC (p, dstStride); DEC (h)
- UNTIL h = 0
-END blit;
-*)
-
-(*
-PROCEDURE setPixel* (x, y, color :INTEGER);
-VAR p :INTEGER;
-BEGIN
- ASSERT ((x >= 0) & (x < ScreenWidth) & (y >= 0) & (y < ScreenHeight));
- screenBegin; p := base + (y*ScreenWidth + x)*4; SYSTEM.PUT32 (p, color); p := p + 4 screenEnd
-END setPixel;
-*)
-
-(*
-PROCEDURE loop; (* example main loop *)
-VAR e :EventPars;
- stop :BOOLEAN;
-BEGIN
- createWindow (200, 200);
- stop := FALSE;
- REPEAT
- nextEvent (0, e);
- IF e[0] = EventKeyPressed THEN stop := TRUE END;
- UNTIL stop;
- XCloseDisplay (display);
-END loop;
-*)
-
-
-BEGIN
- libX11 := unix.dlopen (SYSTEM.SADR("libX11.so.6"), unix.RTLD_LAZY); ASSERT (libX11 # 0);
- getSymAdr (libX11, "XOpenDisplay", SYSTEM.ADR(XOpenDisplay));
- getSymAdr (libX11, "XCloseDisplay", SYSTEM.ADR(XCloseDisplay));
- getSymAdr (libX11, "XSynchronize", SYSTEM.ADR(XSynchronize));
- getSymAdr (libX11, "XConnectionNumber", SYSTEM.ADR(XConnectionNumber));
- getSymAdr (libX11, "XCreateWindow", SYSTEM.ADR(XCreateWindow));
- getSymAdr (libX11, "XDefaultScreen", SYSTEM.ADR(XDefaultScreen));
- getSymAdr (libX11, "XDefaultGC", SYSTEM.ADR(XDefaultGC));
- getSymAdr (libX11, "XDisplayWidth", SYSTEM.ADR(XDisplayWidth));
- getSymAdr (libX11, "XDisplayHeight", SYSTEM.ADR(XDisplayHeight));
- getSymAdr (libX11, "XDefaultVisual", SYSTEM.ADR(XDefaultVisual));
- getSymAdr (libX11, "XDefaultRootWindow", SYSTEM.ADR(XDefaultRootWindow));
- getSymAdr (libX11, "XDefaultDepth", SYSTEM.ADR(XDefaultDepth));
- getSymAdr (libX11, "XSelectInput", SYSTEM.ADR(XSelectInput));
- getSymAdr (libX11, "XMapWindow", SYSTEM.ADR(XMapWindow));
- getSymAdr (libX11, "XNextEvent", SYSTEM.ADR(XNextEvent));
- getSymAdr (libX11, "XPending", SYSTEM.ADR(XPending));
- getSymAdr (libX11, "XLookupString", SYSTEM.ADR(XLookupString));
- getSymAdr (libX11, "XCreateImage", SYSTEM.ADR(XCreateImage));
- getSymAdr (libX11, "XPutImage", SYSTEM.ADR(XPutImage));
- init;
-END gr.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/animation/out.ob07 b/programs/develop/oberon07/Samples/Linux/X11/animation/out.ob07
deleted file mode 100644
index ad8478ce9..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/animation/out.ob07
+++ /dev/null
@@ -1,142 +0,0 @@
-MODULE out; (* formatted output to stdout *)
-(* Wim Niemann, Jan Tuitman 06-OCT-2016 *)
-
-IMPORT SYSTEM, _unix;
-
-(* example: IMPORT o:=out;
- o.str("Hello, World!");o.nl;
- o.formatInt("n = %", 3);o.nl;
-*)
-
-(*
-The output functions buffer the characters in buf. This buffer is flushed when out.nl is
-called and also when the buffer is full.
-
-Calling flush once per line is far more efficient then one system call per
-character, but this is noticable only at very long outputs.
-*)
-
-CONST MAX = 63; (* last position in buf *)
-
-VAR len :INTEGER; (* string length in buf *)
- buf :ARRAY MAX+1 OF BYTE;
-
-PROCEDURE exit* (n :INTEGER);
- (* prevent IMPORT unix for many programs *)
-BEGIN _unix._exit(n) END exit;
-
-PROCEDURE writeChars;
- (* write buf to the output function and set to empty string *)
-VAR ri :INTEGER;
-BEGIN
- IF len > 0 THEN
- (* buf[len] := 0X; *)
- ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *)
- len := 0
- END
-END writeChars;
-
-PROCEDURE nl*; (* append a newline to buf and flush *)
-BEGIN
- IF len = MAX THEN writeChars END;
- buf[len] := 0AH; INC(len);
- (* unix: 0AX; Oberon: 0DX;
- Windows: IF len >= MAX-1 THEN 0DX 0AX; *)
- writeChars;
-END nl;
-
-PROCEDURE char* (c :CHAR);
- (* append char to the end of buf *)
-BEGIN
- IF len = MAX THEN writeChars END;
- buf[len] := ORD(c); INC(len)
-END char;
-
-PROCEDURE str* (t :ARRAY OF CHAR);
- (* append t to buf *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END
-END str;
-
-PROCEDURE int* (n :INTEGER);
- (* append integer; append n to d, return TRUE on overflow of d *)
-VAR j :INTEGER;
- sign :BOOLEAN;
- dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *)
-BEGIN
- sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END;
- IF n < 0 THEN
- str ("-2147483648");
- ELSE
- j := 0;
- REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0;
- IF sign THEN char ("-") END;
- REPEAT DEC(j); char(dig[j]) UNTIL j = 0;
- END
-END int;
-
-PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER);
- (* append formatted string t. Replace the first % by n *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n); INC(j);
- WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
-END formatInt;
-
-PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER);
- (* append formatted string t. Replace the first two % by n1 and n2 *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n1); INC(j);
- WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n2); INC(j);
- WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
- END
-END formatInt2;
-
-PROCEDURE formatStr* (t, u :ARRAY OF CHAR);
- (* append formatted string. Replace the first % in t by u *)
-VAR j, k :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END;
- INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
-END formatStr;
-
-PROCEDURE hex* (n, width :INTEGER);
- (* print width positions of n as hex string. If necessary, prefix with leading zeroes *)
- (* note: if n needs more positions than width, the first hex digits are not printed *)
-VAR j :INTEGER;
- dig :ARRAY 9 OF CHAR;
-BEGIN
- ASSERT(width > 0);
- ASSERT (width <= 8);
- dig[width] := 0X;
- REPEAT
- j := n MOD 16; n := n DIV 16;
- IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END;
- DEC(width); dig[width] := CHR(j)
- UNTIL width = 0;
- str (dig);
-END hex;
-
-PROCEDURE flush*;
-(* this routine comes at the end. It won't hardly ever be called
- because nl also flushes. It is present only in case you
- want to write a flushed string which does not end with nl. *)
-BEGIN writeChars END flush;
-
-(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules
- are not executed, so rely on zero initialisation by Modules.Load *)
-END out.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/animation/unix.ob07 b/programs/develop/oberon07/Samples/Linux/X11/animation/unix.ob07
deleted file mode 100644
index d74ed88c1..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/animation/unix.ob07
+++ /dev/null
@@ -1,74 +0,0 @@
-MODULE unix; (* connect to unix host *)
-IMPORT SYSTEM, _unix;
-(* provide some Oberon friendly POSIX without need for SYSTEM *)
-
-CONST RTLD_LAZY* = 1;
- O_RDONLY* = 0;
- O_NEWFILE* = 0C2H; (* O_RDWR | O_CREAT | O_EXCL *)
- (* O_RDONLY=0, O_WRONLY=1, O_RDWR=2, O_CREAT=0x40, O_EXCL=0x80, O_TRUNC=0x200 *)
- FD_SETSIZE* = 1024; (* fd for select() must be smaller than FD_SETSIZE *)
- BIT_DEPTH* = _unix.BIT_DEPTH;
- LEN_FD_SET = FD_SETSIZE DIV BIT_DEPTH;
-
-TYPE
- timespec* = RECORD
- tv_sec*, tv_usec* :INTEGER
- END;
- fd_set* = POINTER TO RECORD (* for select() *)
- bits* :ARRAY LEN_FD_SET OF SET (* 1024 bits *)
- END;
-
-VAR
- dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
- dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
- dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
- close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
- exit* :PROCEDURE [linux] (n :INTEGER);
- malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
-
-PROCEDURE open* (path :ARRAY OF CHAR; flag, perm :INTEGER) :INTEGER;
-BEGIN RETURN _unix._open (SYSTEM.ADR(path[0]), flag, perm) END open;
-
-PROCEDURE read* (fd :INTEGER; VAR buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
-BEGIN RETURN _unix._read (fd, SYSTEM.ADR(buf[0]), len) END read;
-
-PROCEDURE readByte* (fd :INTEGER; VAR n :BYTE) :INTEGER;
-BEGIN RETURN _unix._read (fd, SYSTEM.ADR(n), 1) END readByte;
-
-PROCEDURE write* (fd :INTEGER; buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
-BEGIN RETURN _unix._write (fd, SYSTEM.ADR(buf[0]), len) END write;
-
-PROCEDURE writeByte* (fd :INTEGER; n :BYTE) :INTEGER;
-BEGIN RETURN _unix._write (fd, SYSTEM.ADR(n), 1) END writeByte;
-
-
-PROCEDURE FD_ZERO* (VAR selectSet :fd_set);
-VAR i :INTEGER;
-BEGIN FOR i := 0 TO LEN_FD_SET-1 DO selectSet.bits[i] := {} END END FD_ZERO;
-
-PROCEDURE FD_SET* (fd :INTEGER; VAR selectSet :fd_set); (* set fd bit in a select() fd_set *)
-BEGIN INCL(selectSet.bits[fd DIV BIT_DEPTH], fd MOD BIT_DEPTH)
-END FD_SET;
-
-PROCEDURE select* (cnt :INTEGER; readfds, writefds, exceptfds :fd_set; timeout :timespec) :INTEGER;
-VAR n1, n2, n3 :INTEGER;
-BEGIN
- n1 := 0; IF readfds # NIL THEN n1 := SYSTEM.ADR (readfds.bits[0]) END;
- n2 := 0; IF writefds # NIL THEN n2 := SYSTEM.ADR (writefds.bits[0]) END;
- n3 := 0; IF exceptfds # NIL THEN n3 := SYSTEM.ADR (exceptfds.bits[0]) END;
-RETURN _unix._select (cnt, n1, n2, n3, SYSTEM.ADR(timeout))
-END select;
-
-
-PROCEDURE finish*;
-BEGIN _unix.finish; END finish;
-
-BEGIN
- dlopen := _unix._dlopen;
- dlsym := _unix._dlsym;
- dlclose := _unix._dlclose;
- close := _unix._close;
- exit := _unix._exit;
- malloc := _unix._malloc;
-END unix.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/_unix.ob07 b/programs/develop/oberon07/Samples/Linux/X11/filler/_unix.ob07
deleted file mode 100644
index 0cd77749e..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/_unix.ob07
+++ /dev/null
@@ -1,74 +0,0 @@
-MODULE _unix; (* connect to unix host *)
-IMPORT SYSTEM, API;
-
-(* how to find C declarations:
-- gcc -E preprocess only (to stdout) (preprocessor expand)
-- grep -r name /usr/include/*
-- ldd progfile
-- objdump -T progfile (-t) (-x)
-*)
-
-CONST RTLD_LAZY = 1;
- BIT_DEPTH* = API.BIT_DEPTH;
-
-VAR sym, libc, libdl :INTEGER;
-
- _dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
- _dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
- _dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
- _open* :PROCEDURE [linux] (name, flags, mode :INTEGER) :INTEGER;
- _close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
- _read* :PROCEDURE [linux] (fd, buf, sz :INTEGER): INTEGER;
- _write* :PROCEDURE [linux] (fd, buf, sz :INTEGER) :INTEGER;
- _exit* :PROCEDURE [linux] (n :INTEGER);
- _malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
- _select* :PROCEDURE [linux] (cnt, readfds, writefds, exceptfds, timeout :INTEGER) :INTEGER;
-
- (* error message to stderr *)
-PROCEDURE writeChar (c :CHAR);
-VAR ri :INTEGER;
-BEGIN ri := _write (2, SYSTEM.ADR(c), 1); ASSERT (ri = 1) END writeChar;
-
-PROCEDURE writeString (s :ARRAY OF CHAR);
-VAR i :INTEGER;
-BEGIN i := 0; WHILE s[i] # 0X DO writeChar (s[i]); INC(i) END; END writeString;
-
-PROCEDURE nl;
-BEGIN writeChar (0AX) END nl;
-
-
-PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
-BEGIN
- sym := _dlsym (lib, SYSTEM.ADR(name[0]));
- IF sym = 0 THEN writeString ("error: dlsym: "); writeString (name); nl END;
- ASSERT (sym # 0);
- SYSTEM.PUT (adr, sym)
-END getSymAdr;
-
-
-PROCEDURE finish*;
-VAR ri :INTEGER;
-BEGIN
- IF libc # 0 THEN ri := _dlclose (libc); libc := 0 END;
- IF libdl # 0 THEN ri := _dlclose (libdl); libdl := 0 END;
-END finish;
-
-
-BEGIN
- _dlopen := API.dlopen;
- _dlsym := API.dlsym;
- libc := _dlopen (SYSTEM.SADR("libc.so.6"), RTLD_LAZY); ASSERT (libc # 0);
- (* getSymAdr is not used for write() to get writeString() error message going *);
- sym := _dlsym (libc, SYSTEM.SADR("write")); ASSERT (sym # 0); SYSTEM.PUT (SYSTEM.ADR(_write), sym);
-
- libdl := _dlopen (SYSTEM.SADR("libdl.so.2"), RTLD_LAZY); ASSERT (libdl # 0);
- getSymAdr (libdl, "dlclose", SYSTEM.ADR(_dlclose));
-
- getSymAdr (libc, "open", SYSTEM.ADR(_open));
- getSymAdr (libc, "close", SYSTEM.ADR(_close));
- getSymAdr (libc, "read", SYSTEM.ADR(_read));
- getSymAdr (libc, "exit", SYSTEM.ADR(_exit));
- getSymAdr (libc, "malloc", SYSTEM.ADR(_malloc));
- getSymAdr (libc, "select", SYSTEM.ADR(_select));
-END _unix.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07 b/programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07
deleted file mode 100644
index 969cab918..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07
+++ /dev/null
@@ -1,221 +0,0 @@
-MODULE filler; (* filler game, color more fields than the opponent *)
-IMPORT SYSTEM, out, unix, gr;
-
-CONST
- Side = 14; (* nr of pixels of a field side *)
- width = 62; height = 48; (* board size *)
- nrFields = width * height;
- BackGroundColor = 0B0B050H;
-
-VAR fdRandom :INTEGER; (* /dev/urandom *)
- base, stride, screenBufSize :INTEGER;
- palette :ARRAY 6 OF INTEGER;
- field :ARRAY nrFields OF INTEGER; (* color 0..5 *)
- visit :ARRAY nrFields OF INTEGER; (* 0 unvisited, 1 neighbour to do, 2 done *)
- Acount, Acolor, Bcount, Bcolor :INTEGER; (* player conquered fields and current color *)
- rndSeed, rndIndex :INTEGER;
-
-PROCEDURE check (b :BOOLEAN; n :INTEGER);
-BEGIN
- IF ~b THEN
- out.formatInt ("internal check failed: filler.mod: %", n); out.nl;
- out.exit(1)
- END
-END check;
-
-PROCEDURE random6 () :INTEGER; (* return random 0..5 *)
-VAR n :INTEGER;
- b :BYTE;
-BEGIN
- IF rndIndex = 3 THEN
- (* 6 ^ 3 = 216 so 3 random6 nrs fit in one random byte, don't waste entropy *)
- n := unix.readByte (fdRandom, b); ASSERT (n = 1);
- rndSeed := b; rndIndex := 0;
- END;
- n := rndSeed MOD 6; rndSeed := rndSeed DIV 6; INC (rndIndex)
-RETURN n
-END random6;
-
-PROCEDURE drawRect (x, y, color :INTEGER);
-VAR p, i, j :INTEGER;
-BEGIN
- p := (y*stride + x*4)*Side;
- check (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize, 20);
- p := base + p;
- FOR j := 0 TO Side-1 DO
- FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END;
- p := p + stride - Side*4;
- END;
-END drawRect;
-
-PROCEDURE clearVisit;
-VAR i :INTEGER;
-BEGIN FOR i := 0 TO nrFields-1 DO visit[i] := 0 END; END clearVisit;
-
-PROCEDURE doNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
- (* helper routine for connect() *)
-BEGIN
- IF visit[i] = 0 THEN
- IF (v = 1) & (field[i] = old) THEN visit[i] := 1; changed := TRUE END;
- IF field[i] = new THEN visit[i] := 2; changed := TRUE END
- END
-END doNeighbour;
-(*
- all visit := 0; count := 0; visit[corner] := 1
- repeat
- changed := false;
- foreach:
- if (visit = 1) or (visit = 2) then
- curVisit = visit
- color := new; visit := 3; count++
- foreach neighbour:
- if visit = 0 then
- if curVisit = 1 then
- if color = old then visit := 1; changed := true
- if color = new then visit := 2; changed := true
- if curVisit = 2 then
- if color = new then visit := 2; changed := true
- until no changes
-*)
-PROCEDURE connect (old, new :INTEGER) :INTEGER;
-VAR count, i, x, y, v :INTEGER;
- changed :BOOLEAN;
-BEGIN
-out.formatInt2 ("connect: old new % % ", old+1, new+1);
- count := 0;
- REPEAT
- changed := FALSE;
- FOR i := 0 TO nrFields-1 DO
- v := visit[i];
- IF (v=1) OR (v=2) THEN
- field[i] := new; visit[i] := 3; INC(count);
- x := i MOD width; y := i DIV width;
- IF x > 0 THEN doNeighbour (i-1, old, new, v, changed) END;
- IF x < width-1 THEN doNeighbour (i+1, old, new, v, changed) END;
- IF y > 0 THEN doNeighbour (i-width, old, new, v, changed) END;
- IF y < height-1 THEN doNeighbour (i+width, old, new, v, changed) END;
- END
- END
- UNTIL ~changed
-RETURN count
-END connect;
-
-PROCEDURE doMaxGainNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
- (* helper routine for maxGain() *)
-BEGIN
- IF visit[i] = 0 THEN
- IF v = 1 THEN
- IF field[i] = old THEN visit[i] := 1 ELSE visit[i] := 2 END;
- changed := TRUE
- ELSE
- IF field[i] = new THEN visit[i] := 2; changed := TRUE END
- END
- END
-END doMaxGainNeighbour;
-(* v=1 & field=old -> visit := 1
- v=1 & field # old -> visit := 2
- v=2 & field = new -> visit := 2
-*)
-
-PROCEDURE maxGain (old :INTEGER) :INTEGER;
- (* return the color which will conquer the most fields *)
-VAR
- i, x, y, new, v :INTEGER;
- max :ARRAY 6 OF INTEGER;
- changed :BOOLEAN;
-BEGIN
- FOR i := 0 TO 5 DO max[i] := 0 END;
- REPEAT
- changed := FALSE;
- FOR i := 0 TO nrFields-1 DO
- v := visit[i];
- IF (v=1) OR (v=2) THEN
- visit[i] := 3; new := field[i]; INC (max[new]);
- x := i MOD width; y := i DIV width;
- IF x > 0 THEN doMaxGainNeighbour (i-1, old, new, v, changed) END;
- IF x < width-1 THEN doMaxGainNeighbour (i+1, old, new, v, changed) END;
- IF y > 0 THEN doMaxGainNeighbour (i-width, old, new, v, changed) END;
- IF y < height-1 THEN doMaxGainNeighbour (i+width, old, new, v, changed) END;
- END
- END
- UNTIL ~changed;
- x := -1; y := -1; max[Acolor] := -1; max[Bcolor] := -1;
-out.str ("maxGain"); out.nl;
-FOR i := 0 TO 5 DO out.formatInt2 (" % %", i+1, max[i]); out.nl END;
- FOR i := 0 TO 5 DO IF (max[i] > y) & (i # old) THEN x := i; y := max[i] END END
-RETURN x
-END maxGain;
-
-PROCEDURE drawAll;
-VAR x, y :INTEGER;
-BEGIN
- gr.screenBegin;
- gr.clear (BackGroundColor);
- FOR y := 0 TO 5 DO drawRect (0, 6 + y DIV 3 + 2*y, palette[y]) END;
- FOR y := 0 TO 47 DO
- FOR x := 0 TO 61 DO drawRect (x+2, y, palette[ field[y*width + x] ]) END
- END;
- gr.screenEnd;
-END drawAll;
-
-PROCEDURE run*;
-VAR stop :BOOLEAN;
- ev :gr.EventPars;
- x, y, i, old :INTEGER;
- ch :CHAR;
-BEGIN
- FOR i := 0 TO nrFields-1 DO field[i] := random6() END;
- Acolor := field[47*width]; field[47*width+1] := Acolor; field[46*width] := Acolor; field[46*width+1] := Acolor;
- Bcolor := field[width-1]; field[width-2] := Bcolor; field[2*width-2] := Bcolor; field[2*width-1] := Bcolor;
- base := gr.base; stride := gr.stride;
- gr.createWindow (1000, 700);
- screenBufSize := gr.winHeight * stride;
- stop := FALSE;
- drawAll;
- REPEAT
- gr.nextEvent (0, ev);
- IF ev[0] = gr.EventKeyPressed THEN
- (* o.formatInt("key pressed %",ev[2]);o.nl; *)
- (* ev[2]: q=24, ESC=9, CR=36 *)
- ch := CHR (ev[4]);
- IF ev[2] = 9 THEN stop := TRUE END; (* ESC *)
- (* IF ch = "q" THEN stop := TRUE END; *)
- IF (ch >= "1") & (ch <= "6") THEN
- i := ev[4] - ORD("1");
- IF (i # Acolor) & (i # Bcolor) THEN
- (* player A *)
- old := Acolor; Acolor := i;
-out.formatInt ("play color %", Acolor+1); out.nl;
- clearVisit; visit[47*width] := 1;
- Acount := connect (old, Acolor)
-;out.formatInt ("count A = %", Acount); out.nl; out.nl;
- (* player B *)
- clearVisit; visit[width-1] := 1; old := field[width-1];
- Bcolor := maxGain (old);
- clearVisit; visit[width-1] := 1;
- Bcount := connect (old, Bcolor);
-out.formatInt ("count B = %", Bcount); out.nl; out.nl;
- drawAll;
- END
- END;
- ELSIF ev[0] = gr.EventButtonPressed THEN
- x := ev[2] DIV Side; y := ev[3] DIV Side;
- END;
- UNTIL stop;
- gr.finish;
- unix.finish;
-END run;
-
-BEGIN
- fdRandom := unix.open ("/dev/urandom", unix.O_RDONLY, 0); ASSERT (fdRandom # -1);
- rndIndex := 3;
- (* a partial copy of the lexaloffle pico-8 16-color palette *)
- palette[0] := 0FF004DH; (* red *)
- palette[1] := 0FFA300H; (* orange *)
- palette[2] := 07E2553H; (* dark purple *)
- palette[3] := 0008751H; (* dark green *)
- palette[4] := 029ADFFH; (* blue *)
- palette[5] := 0FF77A8H; (* pink *)
- run;
-END filler.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/filler.txt b/programs/develop/oberon07/Samples/Linux/X11/filler/filler.txt
deleted file mode 100644
index 143a343e4..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/filler.txt
+++ /dev/null
@@ -1,15 +0,0 @@
-
-Filler game
-
-Player and computer each try to conquer the most fields.
-Player starts at left bottom and computer at right top.
-
-At each turn, a new color is chosen and area extended.
-
-Press 1 .. 6 to choose color. At the left side of the board the top
-color has nr 1 and the bottom color nr 6. The current colors of player
-and opponent can not be chosen. The current area receives the new color
-and is extended with all bordering areas of the chosen color.
-
-Have fun!
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07 b/programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07
deleted file mode 100644
index c22e75e82..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07
+++ /dev/null
@@ -1,292 +0,0 @@
-MODULE gr; (* connect to libX11 *)
-IMPORT SYSTEM, unix, out;
-
-(*
-X11 documentation in:
-- http://tronche.com/gui/x/xlib/ an X11 reference
-- http://www.sbin.org/doc/Xlib an X11 tutorial (this domain has disappeared)
-*)
-
-CONST
- InputOutput = 1;
- StructureNotifyMask = 20000H; (* input event mask *)
- ExposureMask = 8000H; KeyPressMask = 1; KeyReleaseMask = 2;
- ButtonPressMask = 4; ButtonReleaseMask = 8; (* PointerNotionMask *)
- ZPixmap = 2;
- Expose = 12; (* X event type *) ConfigureNotify = 22; KeyPress = 2; ButtonPress = 4;
-
- EventTimeOut* = 80; (* 0, 0, 0, 0 *)
- EventResize* = 81; (* 0, w, h, 0 *)
- EventKeyPressed* = 82; (* isPrintable, keyCode (X11 scan code), state, keySym (ASCII) *)
- EventKeyReleased* = 83; (* 0, keyCode, state, 0 *)
- EventButtonPressed* = 84; (* button, x, y, state *)
- EventButtonReleased* = 85; (* button, x, y, state *)
- (* mouse button 1-5 = Left, Middle, Right, Scroll wheel up, Scroll wheel down *)
-
- bit64 = ORD(unix.BIT_DEPTH = 64);
-
-TYPE EventPars* = ARRAY 5 OF INTEGER;
- XEvent = RECORD
- val :ARRAY 192 OF BYTE (* union { ..., long pad[24]; } *)
- (* val :ARRAY 48 OF CARD32; *)
- END;
-
-VAR ScreenWidth*, ScreenHeight* :INTEGER;
- winWidth*, winHeight* :INTEGER; (* draw by writing to pixel buffer: *)
- base*, stride* :INTEGER; (* width, height, base ptr, stride in bytes, 32-bit RGB *)
- painting :BOOLEAN;
-
- libX11 :INTEGER; (* handle to dynamic library *)
- XOpenDisplay :PROCEDURE [linux] (name :INTEGER) :INTEGER;
- XCloseDisplay :PROCEDURE [linux] (display :INTEGER);
- XSynchronize :PROCEDURE [linux] (display, onoff :INTEGER) :INTEGER; (* return prev onoff *)
- XConnectionNumber :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XCreateWindow :PROCEDURE [linux] (display, parent_window, x, y, w, h, border_width, depth,
- class, visual, valuemask, attributes :INTEGER) :INTEGER; (* Window *)
- XDefaultScreen :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XDefaultGC :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* GC *)
- XDisplayWidth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XDisplayHeight :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XDefaultVisual :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER; (* visual *)
- XDefaultRootWindow :PROCEDURE [linux] (display :INTEGER) :INTEGER; (* Window *)
- XDefaultDepth :PROCEDURE [linux] (display, screenNr :INTEGER) :INTEGER;
- XSelectInput :PROCEDURE [linux] (display, window, event_mask :INTEGER);
- XMapWindow :PROCEDURE [linux] (display, window :INTEGER);
- XNextEvent :PROCEDURE [linux] (display, XEvent_p :INTEGER);
- XPending :PROCEDURE [linux] (display :INTEGER) :INTEGER;
- XLookupString :PROCEDURE [linux] (key_event, buffer_return, buflen, keysym_return, status_in_out :INTEGER) :INTEGER;
- XCreateImage :PROCEDURE [linux] (display, visual, depth, format, offset, data,
- width, height, bitmap_pad, bytes_per_line :INTEGER) :INTEGER; (* ptr to XImage *)
- XPutImage :PROCEDURE [linux] (display, window, gc, image, sx, sy, dx, dy, w, h :INTEGER);
-
- display, screen, window, gc, img :INTEGER;
- connectionNr :INTEGER; (* fd of X11 socket *)
- readX11 :unix.fd_set; (* used by select() timeout on X11 socket *)
-
-
-PROCEDURE getSymAdr (lib :INTEGER; name :ARRAY OF CHAR; adr :INTEGER);
-VAR sym :INTEGER;
-BEGIN
- sym := unix.dlsym (lib, SYSTEM.ADR(name[0]));
- IF sym = 0 THEN out.formatStr ("error: dlsym: %", name); out.nl END;
- ASSERT (sym # 0);
- SYSTEM.PUT (adr, sym)
-END getSymAdr;
-
-
-PROCEDURE init;
-BEGIN
- display := XOpenDisplay (0);
- IF display = 0 THEN out.str ("error: can not open X11 display."); out.nl; out.exit(1) END;
- (* ri := XSynchronize (display, 1); *)
- connectionNr := XConnectionNumber (display); ASSERT (connectionNr < unix.FD_SETSIZE);
- NEW (readX11); unix.FD_ZERO(readX11); unix.FD_SET (connectionNr, readX11);
- screen := XDefaultScreen (display); gc := XDefaultGC (display, screen);
- ScreenWidth := XDisplayWidth (display, screen); ScreenHeight := XDisplayHeight (display, screen);
- base := unix.malloc (ScreenWidth * ScreenHeight * 4);
- IF base = 0 THEN
- out.formatInt2 ("error: can not allocate screen buffer % x %", ScreenWidth, ScreenHeight); out.nl; out.exit(1);
- END;
- stride := ScreenWidth * 4;
- img := XCreateImage (display, XDefaultVisual (display, screen), XDefaultDepth (display, screen),
- ZPixmap, 0, base, ScreenWidth, ScreenHeight, 32, 0);
-END init;
-
-
-PROCEDURE finish*;
-VAR ri :INTEGER;
-BEGIN
- IF display # 0 THEN XCloseDisplay(display); display := 0 END;
- IF libX11 # 0 THEN ri := unix.dlclose (libX11); libX11 := 0 END;
-END finish;
-
-
-PROCEDURE createWindow* (w, h :INTEGER);
-VAR eventMask :INTEGER;
-BEGIN
- IF (w > ScreenWidth) OR (h > ScreenHeight) THEN
- out.str ("error: X11.createWindow: window too large"); out.exit(1);
- END;
- ASSERT ((w >= 0) & (h >= 0));
- window := XCreateWindow (display, XDefaultRootWindow (display), 0, 0, w, h, 0,
- XDefaultDepth (display, screen), InputOutput, XDefaultVisual (display, screen), 0, 0);
- winWidth := w; winHeight := h;
- eventMask := StructureNotifyMask + ExposureMask + KeyPressMask + ButtonPressMask;
- XSelectInput (display, window, eventMask);
- XMapWindow (display, window);
-END createWindow;
-
-
-PROCEDURE screenBegin*;
- (* intended to enable future cooperation with iOS / MacOS *)
-BEGIN
- ASSERT (~painting); painting := TRUE
-END screenBegin;
-
-
-PROCEDURE screenEnd*;
-BEGIN
- ASSERT (painting);
- XPutImage (display, window, gc, img, 0, 0, 0, 0, winWidth, winHeight);
- painting := FALSE;
-END screenEnd;
-
-
-PROCEDURE readInt (e :XEvent; i :INTEGER) :INTEGER;
- (* treat XEvent byte array as int array *)
-VAR n :INTEGER;
-BEGIN
- ASSERT (i >= 0);
- ASSERT (i < 48);
- i := i * 4;
- n := e.val[i+3]*1000000H + e.val[i+2]*10000H + e.val[i+1]*100H + e.val[i];
-RETURN n
-END readInt;
-
-
-PROCEDURE nextEvent* (msTimeOut :INTEGER; VAR ev :EventPars);
-VAR _type, n, ri :INTEGER;
- event :XEvent;
- x, y, w, h :INTEGER;
- timeout :unix.timespec;
-BEGIN
-(* struct XEvent (64-bit):
-any: 4 type 8 serial 4 send_event 8 display 8 window 8 window
-expose: 40 any 4 x, y, w, h, count
-xconfigure: 48 any 4 x, y, w, h
-xkey / xbutton / xmotion: 48 any 8 sub_window 8 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
-*)
-(* struct XEvent (32-bit):
-any: 4 type 4 serial 4 send_event 4 display 4 window
-expose: 20 any 4 x, y, w, h, count
-xconfigure: 24 any 4 x, y, w, h
-xkey / xbutton / xmotion: 24 any 4 sub_window 4 time_ms 4 x, y, x_root, y_root 4 state 4 keycode/button
-*)
- _type := 0;
- WHILE _type = 0 DO
- IF (msTimeOut > 0) & (XPending(display) = 0) THEN
- timeout.tv_sec := msTimeOut DIV 1000; timeout.tv_usec := (msTimeOut MOD 1000) * 1000;
- ri := unix.select (connectionNr + 1, readX11, NIL, NIL, timeout); ASSERT (ri # -1);
- IF ri = 0 THEN _type := EventTimeOut; ev[1] := 0; ev[2] := 0; ev[3] := 0; ev[4] := 0 END;
- END;
- IF _type = 0 THEN
- XNextEvent (display, SYSTEM.ADR(event));
- CASE readInt (event, 0) OF
- Expose :
- x := readInt (event, 5 + 5 * bit64); y := readInt (event, 6 + 5 * bit64);
- w := readInt (event, 7 + 5 * bit64); h := readInt (event, 8 + 5 * bit64);
- XPutImage (display, window, gc, img, x, y, x, y, w, h);
- | ConfigureNotify :
- w := readInt (event, 8 + 6 * bit64); h := readInt (event, 9 + 6 * bit64);
- IF (w # winWidth) & (h # winHeight) THEN
- ASSERT ((w >= 0) & (h >= 0));
- IF w > ScreenWidth THEN w := ScreenWidth END;
- IF h > ScreenHeight THEN h := ScreenHeight END;
- winWidth := w; winHeight := h;
- ev[0] := EventResize; ev[1] := 0; ev[2] := w; ev[3] := h; ev[4] := 0;
- END;
- | KeyPress :
- _type := EventKeyPressed;
- x := XLookupString (SYSTEM.ADR(event), 0, 0, SYSTEM.ADR(n), 0); (* KeySym *)
- IF (n = 8) OR (n = 10) OR (n >= 32) & (n <= 126) THEN ev[1] := 1 ELSE ev[1] := 0; n := 0 END; (* isprint *)
- ev[2] := readInt (event, 13 + 8 * bit64); (* keycode *)
- ev[3] := readInt (event, 12 + 8 * bit64); (* state *)
- ev[4] := n; (* KeySym *)
- | ButtonPress :
- _type := EventButtonPressed;
- ev[1] := readInt (event, 13 + 8 * bit64); (* button *)
- ev[2] := readInt (event, 8 + 8 * bit64); (* x *)
- ev[3] := readInt (event, 9 + 8 * bit64); (* y *)
- ev[4] := readInt (event, 12 + 8 * bit64); (* state *)
- ELSE
- END
- END
- END;
- ev[0] := _type
-END nextEvent;
-
-
-PROCEDURE clear* (color :INTEGER); (* fill window area with color *)
-VAR p, i, j :INTEGER;
-BEGIN
- FOR j := 0 TO winHeight-1 DO
- p := base + j*stride;
- FOR i := 0 TO winWidth-1 DO SYSTEM.PUT32 (p, color); INC (p, 4) END
- END
-END clear;
-
-
-(*
-PROCEDURE blitError (stride, x, y, w, h :INTEGER);
-BEGIN
- o.formatInt ("error: screen.blit (src, %)", stride);
- o.formatInt2 (", %, %", x, y);
- o.formatInt2 (", %, %) out of bounds", w, h); o.nl;
- ASSERT (FALSE)
-END blitError;
-
-PROCEDURE blit* (src, srcStride, x, y, w, h :INTEGER);
-VAR dstStride, p :INTEGER;
-BEGIN
- IF (x < 0) OR (y < 0) THEN blitError (srcStride, x, y, w, h) END;
- IF (w <= 0) OR (h <= 0) THEN blitError (srcStride, x, y, w, h) END;
- IF (x + w > ScreenWidth) OR (y + h > ScreenHeight) THEN blitError (srcStride, x, y, w, h) END;
-
- dstStride := ScreenWidth - w;
- p := ScreenBase + y * ScreenWidth + x * 4;
- REPEAT
- SYSTEM.COPY (src, p, w);
- INC (src, srcStride); INC (p, dstStride); DEC (h)
- UNTIL h = 0
-END blit;
-*)
-
-(*
-PROCEDURE setPixel* (x, y, color :INTEGER);
-VAR p :INTEGER;
-BEGIN
- ASSERT ((x >= 0) & (x < ScreenWidth) & (y >= 0) & (y < ScreenHeight));
- screenBegin; p := base + (y*ScreenWidth + x)*4; SYSTEM.PUT32 (p, color); p := p + 4 screenEnd
-END setPixel;
-*)
-
-(*
-PROCEDURE loop; (* example main loop *)
-VAR e :EventPars;
- stop :BOOLEAN;
-BEGIN
- createWindow (200, 200);
- stop := FALSE;
- REPEAT
- nextEvent (0, e);
- IF e[0] = EventKeyPressed THEN stop := TRUE END;
- UNTIL stop;
- XCloseDisplay (display);
-END loop;
-*)
-
-
-BEGIN
- libX11 := unix.dlopen (SYSTEM.SADR("libX11.so.6"), unix.RTLD_LAZY); ASSERT (libX11 # 0);
- getSymAdr (libX11, "XOpenDisplay", SYSTEM.ADR(XOpenDisplay));
- getSymAdr (libX11, "XCloseDisplay", SYSTEM.ADR(XCloseDisplay));
- getSymAdr (libX11, "XSynchronize", SYSTEM.ADR(XSynchronize));
- getSymAdr (libX11, "XConnectionNumber", SYSTEM.ADR(XConnectionNumber));
- getSymAdr (libX11, "XCreateWindow", SYSTEM.ADR(XCreateWindow));
- getSymAdr (libX11, "XDefaultScreen", SYSTEM.ADR(XDefaultScreen));
- getSymAdr (libX11, "XDefaultGC", SYSTEM.ADR(XDefaultGC));
- getSymAdr (libX11, "XDisplayWidth", SYSTEM.ADR(XDisplayWidth));
- getSymAdr (libX11, "XDisplayHeight", SYSTEM.ADR(XDisplayHeight));
- getSymAdr (libX11, "XDefaultVisual", SYSTEM.ADR(XDefaultVisual));
- getSymAdr (libX11, "XDefaultRootWindow", SYSTEM.ADR(XDefaultRootWindow));
- getSymAdr (libX11, "XDefaultDepth", SYSTEM.ADR(XDefaultDepth));
- getSymAdr (libX11, "XSelectInput", SYSTEM.ADR(XSelectInput));
- getSymAdr (libX11, "XMapWindow", SYSTEM.ADR(XMapWindow));
- getSymAdr (libX11, "XNextEvent", SYSTEM.ADR(XNextEvent));
- getSymAdr (libX11, "XPending", SYSTEM.ADR(XPending));
- getSymAdr (libX11, "XLookupString", SYSTEM.ADR(XLookupString));
- getSymAdr (libX11, "XCreateImage", SYSTEM.ADR(XCreateImage));
- getSymAdr (libX11, "XPutImage", SYSTEM.ADR(XPutImage));
- init;
-END gr.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/out.ob07 b/programs/develop/oberon07/Samples/Linux/X11/filler/out.ob07
deleted file mode 100644
index ad8478ce9..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/out.ob07
+++ /dev/null
@@ -1,142 +0,0 @@
-MODULE out; (* formatted output to stdout *)
-(* Wim Niemann, Jan Tuitman 06-OCT-2016 *)
-
-IMPORT SYSTEM, _unix;
-
-(* example: IMPORT o:=out;
- o.str("Hello, World!");o.nl;
- o.formatInt("n = %", 3);o.nl;
-*)
-
-(*
-The output functions buffer the characters in buf. This buffer is flushed when out.nl is
-called and also when the buffer is full.
-
-Calling flush once per line is far more efficient then one system call per
-character, but this is noticable only at very long outputs.
-*)
-
-CONST MAX = 63; (* last position in buf *)
-
-VAR len :INTEGER; (* string length in buf *)
- buf :ARRAY MAX+1 OF BYTE;
-
-PROCEDURE exit* (n :INTEGER);
- (* prevent IMPORT unix for many programs *)
-BEGIN _unix._exit(n) END exit;
-
-PROCEDURE writeChars;
- (* write buf to the output function and set to empty string *)
-VAR ri :INTEGER;
-BEGIN
- IF len > 0 THEN
- (* buf[len] := 0X; *)
- ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *)
- len := 0
- END
-END writeChars;
-
-PROCEDURE nl*; (* append a newline to buf and flush *)
-BEGIN
- IF len = MAX THEN writeChars END;
- buf[len] := 0AH; INC(len);
- (* unix: 0AX; Oberon: 0DX;
- Windows: IF len >= MAX-1 THEN 0DX 0AX; *)
- writeChars;
-END nl;
-
-PROCEDURE char* (c :CHAR);
- (* append char to the end of buf *)
-BEGIN
- IF len = MAX THEN writeChars END;
- buf[len] := ORD(c); INC(len)
-END char;
-
-PROCEDURE str* (t :ARRAY OF CHAR);
- (* append t to buf *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END
-END str;
-
-PROCEDURE int* (n :INTEGER);
- (* append integer; append n to d, return TRUE on overflow of d *)
-VAR j :INTEGER;
- sign :BOOLEAN;
- dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *)
-BEGIN
- sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END;
- IF n < 0 THEN
- str ("-2147483648");
- ELSE
- j := 0;
- REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0;
- IF sign THEN char ("-") END;
- REPEAT DEC(j); char(dig[j]) UNTIL j = 0;
- END
-END int;
-
-PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER);
- (* append formatted string t. Replace the first % by n *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n); INC(j);
- WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
-END formatInt;
-
-PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER);
- (* append formatted string t. Replace the first two % by n1 and n2 *)
-VAR j :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n1); INC(j);
- WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- int(n2); INC(j);
- WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
- END
-END formatInt2;
-
-PROCEDURE formatStr* (t, u :ARRAY OF CHAR);
- (* append formatted string. Replace the first % in t by u *)
-VAR j, k :INTEGER;
-BEGIN
- j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
- IF t[j] = "%" THEN
- k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END;
- INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END
- END
-END formatStr;
-
-PROCEDURE hex* (n, width :INTEGER);
- (* print width positions of n as hex string. If necessary, prefix with leading zeroes *)
- (* note: if n needs more positions than width, the first hex digits are not printed *)
-VAR j :INTEGER;
- dig :ARRAY 9 OF CHAR;
-BEGIN
- ASSERT(width > 0);
- ASSERT (width <= 8);
- dig[width] := 0X;
- REPEAT
- j := n MOD 16; n := n DIV 16;
- IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END;
- DEC(width); dig[width] := CHR(j)
- UNTIL width = 0;
- str (dig);
-END hex;
-
-PROCEDURE flush*;
-(* this routine comes at the end. It won't hardly ever be called
- because nl also flushes. It is present only in case you
- want to write a flushed string which does not end with nl. *)
-BEGIN writeChars END flush;
-
-(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules
- are not executed, so rely on zero initialisation by Modules.Load *)
-END out.
-
diff --git a/programs/develop/oberon07/Samples/Linux/X11/filler/unix.ob07 b/programs/develop/oberon07/Samples/Linux/X11/filler/unix.ob07
deleted file mode 100644
index d74ed88c1..000000000
--- a/programs/develop/oberon07/Samples/Linux/X11/filler/unix.ob07
+++ /dev/null
@@ -1,74 +0,0 @@
-MODULE unix; (* connect to unix host *)
-IMPORT SYSTEM, _unix;
-(* provide some Oberon friendly POSIX without need for SYSTEM *)
-
-CONST RTLD_LAZY* = 1;
- O_RDONLY* = 0;
- O_NEWFILE* = 0C2H; (* O_RDWR | O_CREAT | O_EXCL *)
- (* O_RDONLY=0, O_WRONLY=1, O_RDWR=2, O_CREAT=0x40, O_EXCL=0x80, O_TRUNC=0x200 *)
- FD_SETSIZE* = 1024; (* fd for select() must be smaller than FD_SETSIZE *)
- BIT_DEPTH* = _unix.BIT_DEPTH;
- LEN_FD_SET = FD_SETSIZE DIV BIT_DEPTH;
-
-TYPE
- timespec* = RECORD
- tv_sec*, tv_usec* :INTEGER
- END;
- fd_set* = POINTER TO RECORD (* for select() *)
- bits* :ARRAY LEN_FD_SET OF SET (* 1024 bits *)
- END;
-
-VAR
- dlopen* :PROCEDURE [linux] (name, flags :INTEGER) :INTEGER;
- dlsym* :PROCEDURE [linux] (p, name :INTEGER) :INTEGER;
- dlclose* :PROCEDURE [linux] (p :INTEGER) :INTEGER;
- close* :PROCEDURE [linux] (fd :INTEGER) :INTEGER;
- exit* :PROCEDURE [linux] (n :INTEGER);
- malloc* :PROCEDURE [linux] (sz :INTEGER) :INTEGER;
-
-PROCEDURE open* (path :ARRAY OF CHAR; flag, perm :INTEGER) :INTEGER;
-BEGIN RETURN _unix._open (SYSTEM.ADR(path[0]), flag, perm) END open;
-
-PROCEDURE read* (fd :INTEGER; VAR buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
-BEGIN RETURN _unix._read (fd, SYSTEM.ADR(buf[0]), len) END read;
-
-PROCEDURE readByte* (fd :INTEGER; VAR n :BYTE) :INTEGER;
-BEGIN RETURN _unix._read (fd, SYSTEM.ADR(n), 1) END readByte;
-
-PROCEDURE write* (fd :INTEGER; buf :ARRAY OF BYTE; len :INTEGER) :INTEGER;
-BEGIN RETURN _unix._write (fd, SYSTEM.ADR(buf[0]), len) END write;
-
-PROCEDURE writeByte* (fd :INTEGER; n :BYTE) :INTEGER;
-BEGIN RETURN _unix._write (fd, SYSTEM.ADR(n), 1) END writeByte;
-
-
-PROCEDURE FD_ZERO* (VAR selectSet :fd_set);
-VAR i :INTEGER;
-BEGIN FOR i := 0 TO LEN_FD_SET-1 DO selectSet.bits[i] := {} END END FD_ZERO;
-
-PROCEDURE FD_SET* (fd :INTEGER; VAR selectSet :fd_set); (* set fd bit in a select() fd_set *)
-BEGIN INCL(selectSet.bits[fd DIV BIT_DEPTH], fd MOD BIT_DEPTH)
-END FD_SET;
-
-PROCEDURE select* (cnt :INTEGER; readfds, writefds, exceptfds :fd_set; timeout :timespec) :INTEGER;
-VAR n1, n2, n3 :INTEGER;
-BEGIN
- n1 := 0; IF readfds # NIL THEN n1 := SYSTEM.ADR (readfds.bits[0]) END;
- n2 := 0; IF writefds # NIL THEN n2 := SYSTEM.ADR (writefds.bits[0]) END;
- n3 := 0; IF exceptfds # NIL THEN n3 := SYSTEM.ADR (exceptfds.bits[0]) END;
-RETURN _unix._select (cnt, n1, n2, n3, SYSTEM.ADR(timeout))
-END select;
-
-
-PROCEDURE finish*;
-BEGIN _unix.finish; END finish;
-
-BEGIN
- dlopen := _unix._dlopen;
- dlsym := _unix._dlsym;
- dlclose := _unix._dlclose;
- close := _unix._close;
- exit := _unix._exit;
- malloc := _unix._malloc;
-END unix.
-
diff --git a/programs/develop/oberon07/Samples/MSP430/Blink.ob07 b/programs/develop/oberon07/Samples/MSP430/Blink.ob07
deleted file mode 100644
index 0434b7e21..000000000
--- a/programs/develop/oberon07/Samples/MSP430/Blink.ob07
+++ /dev/null
@@ -1,43 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- Мигает красный светодиод.
-
-*)
-MODULE Blink;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
-
-
-PROCEDURE inv_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) / bits)
-END inv_bits;
-
-
-BEGIN
- (* инициализация регистра P1DIR *)
- SYSTEM.PUT8(P1DIR, REDLED);
-
- (* бесконечный цикл *)
- WHILE TRUE DO
- (* изменить состояние светодиода *)
- inv_bits(P1OUT, REDLED);
- (* задержка *)
- MSP430.Delay(800)
- END
-END Blink.
diff --git a/programs/develop/oberon07/Samples/MSP430/Button.ob07 b/programs/develop/oberon07/Samples/MSP430/Button.ob07
deleted file mode 100644
index 2470ed4ee..000000000
--- a/programs/develop/oberon07/Samples/MSP430/Button.ob07
+++ /dev/null
@@ -1,103 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- Мигает зеленый светодиод.
- При нажатии на кнопку P1.3, включается/выключается красный светодиод.
-
-*)
-
-MODULE Button;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
- GREENLED = {6};
- BUTTON = {3};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
- P1IFG = 23H;
- P1IE = 25H;
- P1REN = 27H;
-
-
-PROCEDURE test_bits (mem: INTEGER; bits: SET): SET;
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b)
- RETURN bits * BITS(b)
-END test_bits;
-
-
-PROCEDURE set_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) + bits)
-END set_bits;
-
-
-PROCEDURE clr_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) - bits)
-END clr_bits;
-
-
-PROCEDURE inv_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) / bits)
-END inv_bits;
-
-
-(* обработчик прерываний *)
-PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
-BEGIN
- IF priority = 18 THEN (* прерывание от порта P1 *)
- IF test_bits(P1IFG, BUTTON) = BUTTON THEN (* нажата кнопка *)
- inv_bits(P1OUT, REDLED); (* изменить состояние светодиода *)
- MSP430.Delay(500); (* задержка для отпускания кнопки *)
- clr_bits(P1IFG, BUTTON) (* сбросить флаг прерывания *)
- END
- END
-END int;
-
-
-PROCEDURE main;
-BEGIN
- (* инициализация регистров порта P1 *)
- SYSTEM.PUT8(P1DIR, REDLED + GREENLED); (* выход *)
- set_bits(P1REN, BUTTON); (* включить подтягивающий резистор *)
- set_bits(P1OUT, BUTTON); (* подтяжка к питанию *)
- set_bits(P1IE, BUTTON); (* разрешить прерывания от кнопки *)
-
- MSP430.SetIntProc(int); (* назначить обработчик прерываний *)
- MSP430.EInt; (* разрешить прерывания *)
-
- (* бесконечный цикл *)
- WHILE TRUE DO
- inv_bits(P1OUT, GREENLED); (* изменить состояние светодиода *)
- MSP430.Delay(800) (* задержка *)
- END
-END main;
-
-
-BEGIN
- main
-END Button.
diff --git a/programs/develop/oberon07/Samples/MSP430/Flash.ob07 b/programs/develop/oberon07/Samples/MSP430/Flash.ob07
deleted file mode 100644
index 0b4e59bb5..000000000
--- a/programs/develop/oberon07/Samples/MSP430/Flash.ob07
+++ /dev/null
@@ -1,157 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- Запись флэш-памяти.
- При успешном завершении, включается зеленый светодиод,
- иначе - красный.
-
-*)
-
-MODULE Flash;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
- GREENLED = {6};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
-
- FERASE = {1}; (* режим "стереть" *)
- FWRITE = {6}; (* режим "записать" *)
-
-
-PROCEDURE set_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) + bits)
-END set_bits;
-
-
-PROCEDURE clr_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) - bits)
-END clr_bits;
-
-
-(*
- стирание и запись флэш-памяти
- adr - адрес
- value - значение для записи
- mode - режим (стереть/записать)
-*)
-PROCEDURE Write (adr, value: INTEGER; mode: SET);
-CONST
- (* сторожевой таймер *)
- WDTCTL = 0120H;
- WDTHOLD = {7};
- WDTPW = {9, 11, 12, 14};
-
- (* регистры контроллера флэш-памяти *)
- FCTL1 = 0128H;
- ERASE = {1};
- WRT = {6};
-
- FCTL2 = 012AH;
- FN0 = {0};
- FN1 = {1};
- FN2 = {2};
- FN3 = {3};
- FN4 = {4};
- FN5 = {5};
- FSSEL0 = {6};
- FSSEL1 = {7};
-
- FCTL3 = 012CH;
- LOCK = {4};
-
- FWKEY = {8, 10, 13, 15};
-
-VAR
- wdt: SET;
-
-BEGIN
- IF (mode = ERASE) OR (mode = WRT) THEN (* проверить заданный режим *)
- SYSTEM.GET(WDTCTL, wdt); (* сохранить значение регистра сторожевого таймера *)
- SYSTEM.PUT(WDTCTL, WDTPW + WDTHOLD); (* остановить сторожевой таймер *)
- SYSTEM.PUT(FCTL2, FWKEY + FSSEL1 + FN0); (* тактовый генератор контроллера флэш-памяти = SMCLK, делитель = 2 *)
- SYSTEM.PUT(FCTL3, FWKEY); (* сбросить флаг LOCK *)
- SYSTEM.PUT(FCTL1, FWKEY + mode); (* установить режим (записать или стереть) *)
- SYSTEM.PUT(adr, value); (* запись *)
- SYSTEM.PUT(FCTL1, FWKEY); (* сбросить режим *)
- SYSTEM.PUT(FCTL3, FWKEY + LOCK); (* установить LOCK *)
- SYSTEM.PUT(WDTCTL, WDTPW + wdt * {0..7}) (* восстановить сторожевой таймер *)
- END
-END Write;
-
-
-(* обработчик ошибок *)
-PROCEDURE trap (modNum, modName, err, line: INTEGER);
-BEGIN
- set_bits(P1OUT, REDLED) (* включить красный светодиод *)
-END trap;
-
-
-PROCEDURE main;
-CONST
- seg_adr = 0FC00H; (* адрес сегмента для стирания и записи (ДОЛЖЕН БЫТЬ СВОБОДНЫМ!) *)
-
-VAR
- adr, x, i: INTEGER;
-
- free: RECORD address, size: INTEGER END;
-
-BEGIN
- (* инициализация регистров порта P1 *)
- SYSTEM.PUT8(P1DIR, REDLED + GREENLED); (* выход *)
-
- (* выключить светодиоды *)
- clr_bits(P1OUT, REDLED + GREENLED);
-
- MSP430.SetTrapProc(trap); (* назначить обработчик ошибок *)
-
- ASSERT(seg_adr MOD 512 = 0); (* адрес сегмента должен быть кратным 512 *)
-
- MSP430.GetFreeFlash(free.address, free.size);
-
- (* проверить, свободен ли сегмент *)
- ASSERT(free.address <= seg_adr);
- ASSERT(seg_adr + 511 <= free.address + free.size);
-
- Write(seg_adr, 0, FERASE); (* стереть сегмент *)
-
- (* записать в сегмент числа 0..255 (256 слов) *)
- adr := seg_adr;
- FOR i := 0 TO 255 DO
- Write(adr, i, FWRITE);
- INC(adr, 2)
- END;
-
- (* проверить запись *)
- adr := seg_adr;
- FOR i := 0 TO 255 DO
- SYSTEM.GET(adr, x);
- ASSERT(x = i); (* если x # i, будет вызван обработчик ошибок *)
- INC(adr, 2)
- END;
-
- (* если нет ошибок, включить зеленый светодиод *)
- set_bits(P1OUT, GREENLED)
-END main;
-
-
-BEGIN
- main
-END Flash.
diff --git a/programs/develop/oberon07/Samples/MSP430/Restart.ob07 b/programs/develop/oberon07/Samples/MSP430/Restart.ob07
deleted file mode 100644
index 1f3f4c66a..000000000
--- a/programs/develop/oberon07/Samples/MSP430/Restart.ob07
+++ /dev/null
@@ -1,106 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- При нажатии на кнопку P1.3, инкрементируется
- переменная-счетчик перезапусков и программа
- перезапускается.
- В зависимости от четности счетчика перезапусков,
- включается зеленый или красный светодиод.
-
-*)
-
-MODULE Restart;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
- GREENLED = {6};
- BUTTON = {3};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
- P1IFG = 23H;
- P1IE = 25H;
- P1REN = 27H;
-
-
-VAR
-
- count: INTEGER; (* счетчик перезапусков *)
-
-
-PROCEDURE set_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) + bits)
-END set_bits;
-
-
-PROCEDURE clr_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) - bits)
-END clr_bits;
-
-
-PROCEDURE test_bits (mem: INTEGER; bits: SET): SET;
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b)
- RETURN bits * BITS(b)
-END test_bits;
-
-
-(* обработчик прерываний *)
-PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
-BEGIN
- IF priority = 18 THEN (* прерывание от порта P1 *)
- IF test_bits(P1IFG, BUTTON) = BUTTON THEN (* нажата кнопка *)
- INC(count); (* увеличить счетчик *)
- MSP430.Delay(500); (* задержка для отпускания кнопки *)
- clr_bits(P1IFG, BUTTON); (* сбросить флаг прерывания *)
- MSP430.Restart (* перезапустить программу *)
- END
- END
-END int;
-
-
-PROCEDURE main;
-BEGIN
- (* инициализация регистров порта P1 *)
- SYSTEM.PUT8(P1DIR, REDLED + GREENLED); (* выход *)
- set_bits(P1REN, BUTTON); (* включить подтягивающий резистор *)
- set_bits(P1OUT, BUTTON); (* подтяжка к питанию *)
- set_bits(P1IE, BUTTON); (* разрешить прерывания от кнопки *)
-
- (* выключить светодиоды *)
- clr_bits(P1OUT, REDLED + GREENLED);
-
- MSP430.SetIntProc(int); (* назначить обработчик прерываний *)
- MSP430.EInt; (* разрешить прерывания *)
-
- IF ODD(count) THEN
- set_bits(P1OUT, GREENLED) (* нечетное - вкл. зеленый *)
- ELSE
- set_bits(P1OUT, REDLED) (* четное - вкл. красный *)
- END
-
-END main;
-
-
-BEGIN
- main
-END Restart.
diff --git a/programs/develop/oberon07/Samples/MSP430/TimerA.ob07 b/programs/develop/oberon07/Samples/MSP430/TimerA.ob07
deleted file mode 100644
index e92090878..000000000
--- a/programs/develop/oberon07/Samples/MSP430/TimerA.ob07
+++ /dev/null
@@ -1,118 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- Светодиоды мигают по сигналам от таймера A
-
-*)
-
-MODULE TimerA;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
- GREENLED = {6};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
-
-
- (* регистры таймера A *)
- TACTL = 0160H;
-
- (* биты регистра TACTL *)
- TAIFG = {0};
- TAIE = {1};
- TACLR = {2};
- MC0 = {4};
- MC1 = {5};
- ID0 = {6};
- ID1 = {7};
- TASSEL0 = {8};
- TASSEL1 = {9};
-
- TAR = 0170H;
-
- TACCTL0 = 0162H;
-
- (* биты регистра TACCTL0 *)
- CCIE = {4};
- CAP = {8};
-
- TACCR0 = 0172H;
-
-
-PROCEDURE set_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) + bits)
-END set_bits;
-
-
-PROCEDURE clr_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) - bits)
-END clr_bits;
-
-
-PROCEDURE inv_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) / bits)
-END inv_bits;
-
-
-(* обработчик прерываний *)
-PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
-VAR
- x: SET;
-
-BEGIN
- IF priority = 24 THEN (* прерывание от таймера A *)
- SYSTEM.GET(TACTL, x); (* взять регистр TACTL *)
- IF TAIFG * x = TAIFG THEN (* прерывание было *)
- inv_bits(P1OUT, REDLED); (* изменить состояние светодиода *)
- inv_bits(P1OUT, GREENLED); (* изменить состояние светодиода *)
- SYSTEM.PUT(TACTL, x - TAIFG) (* сбросить флаг прерывания и обновить регистр TACTL *)
- END
- END
-END int;
-
-
-PROCEDURE main;
-BEGIN
- (* инициализация регистра P1DIR *)
- SYSTEM.PUT8(P1DIR, REDLED + GREENLED);
-
- (* начальное состояние светодиодов *)
- set_bits(P1OUT, GREENLED); (* включен *)
- clr_bits(P1OUT, REDLED); (* выключен *)
-
- MSP430.SetIntProc(int); (* назначить обработчик прерываний *)
- MSP430.EInt; (* разрешить прерывания *)
-
- (* инициализация регистров таймера A *)
- SYSTEM.PUT(TAR, 0);
- SYSTEM.PUT(TACCTL0, CCIE + CAP);
- SYSTEM.PUT(TACCR0, 1000);
- SYSTEM.PUT(TACTL, TAIE + MC0 + TASSEL0)
-END main;
-
-
-BEGIN
- main
-END TimerA.
diff --git a/programs/develop/oberon07/Samples/MSP430/TwoTimers.ob07 b/programs/develop/oberon07/Samples/MSP430/TwoTimers.ob07
deleted file mode 100644
index 5dfcad16c..000000000
--- a/programs/develop/oberon07/Samples/MSP430/TwoTimers.ob07
+++ /dev/null
@@ -1,143 +0,0 @@
-(*
-
-Пример для LaunchPad MSP-EXP430G2 Rev1.5
-
- Зеленый светодиод мигает по сигналам от таймера A,
- красный - по сигналам от сторожевого таймера в интервальном режиме
-
-*)
-
-MODULE TwoTimers;
-
-IMPORT SYSTEM, MSP430;
-
-
-CONST
-
- REDLED = {0};
- GREENLED = {6};
-
- (* регистры порта P1 *)
- P1OUT = 21H;
- P1DIR = 22H;
-
-
- (* регистр разрешения прерываний 1 *)
- IE1 = 00H;
-
- (* биты регистра IE1 *)
- WDTIE = {0};
- NMIIE = {4};
-
-
- (* регистр флагов прерываний 1 *)
- IFG1 = 02H;
-
- (* биты регистра IFG1 *)
- WDTIFG = {0};
- NMIIFG = {4};
-
-
- WDTCTL = 0120H; (* регистр сторожевого таймера *)
-
- (* биты регистра WDTCTL *)
- WDTIS0 = {0};
- WDTIS1 = {1};
- WDTSSEL = {2};
- WDTCNTCL = {3};
- WDTTMSEL = {4};
- WDTNMI = {5};
- WDTNMIES = {6};
- WDTHOLD = {7};
- WDTPW = {9, 11, 12, 14}; (* ключ защиты *)
-
-
- (* регистры таймера A *)
- TACTL = 0160H;
-
- (* биты регистра TACTL *)
- TAIFG = {0};
- TAIE = {1};
- TACLR = {2};
- MC0 = {4};
- MC1 = {5};
- ID0 = {6};
- ID1 = {7};
- TASSEL0 = {8};
- TASSEL1 = {9};
-
- TAR = 0170H;
-
- TACCTL0 = 0162H;
-
- (* биты регистра TACCTL0 *)
- CCIE = {4};
- CAP = {8};
-
- TACCR0 = 0172H;
-
-
-PROCEDURE set_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) + bits)
-END set_bits;
-
-
-PROCEDURE inv_bits (mem: INTEGER; bits: SET);
-VAR
- b: BYTE;
-
-BEGIN
- SYSTEM.GET(mem, b);
- SYSTEM.PUT8(mem, BITS(b) / bits)
-END inv_bits;
-
-
-(* обработчик прерываний *)
-PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
-VAR
- x: SET;
-
-BEGIN
- IF priority = 26 THEN (* прерывание от сторожевого таймера *)
- inv_bits(P1OUT, REDLED) (* изменить состояние светодиода *)
- ELSIF priority = 24 THEN (* прерывание от таймера A *)
- SYSTEM.GET(TACTL, x); (* взять регистр TACTL *)
- IF TAIFG * x = TAIFG THEN (* прерывание было *)
- inv_bits(P1OUT, GREENLED); (* изменить состояние светодиода *)
- SYSTEM.PUT(TACTL, x - TAIFG) (* сбросить флаг прерывания и обновить регистр TACTL *)
- END
- END
-END int;
-
-
-PROCEDURE main;
-BEGIN
- (* инициализация регистра P1DIR *)
- set_bits(P1DIR, REDLED + GREENLED);
-
- (* начальное состояние светодиодов - включены *)
- set_bits(P1OUT, REDLED + GREENLED);
-
- MSP430.SetIntProc(int); (* назначить обработчик прерываний *)
- MSP430.EInt; (* разрешить прерывания *)
-
- (* инициализация регистров таймера A *)
- SYSTEM.PUT(TAR, 0);
- SYSTEM.PUT(TACCTL0, CCIE + CAP);
- SYSTEM.PUT(TACCR0, 1500);
- SYSTEM.PUT(TACTL, TAIE + MC0 + TASSEL0);
-
- (* инициализация регистров сторожевого таймера *)
- set_bits(IE1, WDTIE);
- SYSTEM.PUT(WDTCTL, WDTPW + WDTIS1 + WDTSSEL + WDTCNTCL + WDTTMSEL)
-END main;
-
-
-BEGIN
- main
-END TwoTimers.
diff --git a/programs/develop/oberon07/Samples/STM32CM3/Blink.ob07 b/programs/develop/oberon07/Samples/STM32CM3/Blink.ob07
deleted file mode 100644
index e2cd4939d..000000000
--- a/programs/develop/oberon07/Samples/STM32CM3/Blink.ob07
+++ /dev/null
@@ -1,57 +0,0 @@
-(*
- Пример для STM32L152C-DISCO
-
- В зависимости от значения константы LED,
- мигает синий или зеленый светодиод.
-*)
-
-MODULE Blink;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- GPIOB = 40020400H;
- GPIOB_MODER = GPIOB;
- GPIOB_BSRR = GPIOB + 18H;
-
- RCC = 40023800H;
- RCC_AHBENR = RCC + 1CH;
-
- Blue = 6; (* PB6 *)
- Green = 7; (* PB7 *)
-
- LED = Blue;
-
-VAR
-
- x: SET;
- state: BOOLEAN;
-
-
-PROCEDURE Delay (x: INTEGER);
-BEGIN
- REPEAT
- DEC(x)
- UNTIL x = 0
-END Delay;
-
-
-BEGIN
- (* подключить GPIOB *)
- SYSTEM.GET(RCC_AHBENR, x);
- SYSTEM.PUT(RCC_AHBENR, x + {1});
-
- (* настроить PB6 или PB7 на выход *)
- SYSTEM.GET(GPIOB_MODER, x);
- SYSTEM.PUT(GPIOB_MODER, x - {LED * 2 - 1} + {LED * 2});
-
- state := FALSE;
- REPEAT
- (* включить или выключить светодиод *)
- SYSTEM.PUT(GPIOB_BSRR, {LED + 16 * ORD(state)});
- state := ~state;
- Delay(200000)
- UNTIL FALSE
-END Blink.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/STM32CM3/Button.ob07 b/programs/develop/oberon07/Samples/STM32CM3/Button.ob07
deleted file mode 100644
index aee25eb01..000000000
--- a/programs/develop/oberon07/Samples/STM32CM3/Button.ob07
+++ /dev/null
@@ -1,114 +0,0 @@
-(*
- Пример для STM32L152C-DISCO
-
- При нажатии на кнопку USER (PA0), меняется
- состояние светодиодов.
-*)
-
-MODULE Button;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- GPIOA = 40020000H;
- GPIOAMODER = GPIOA;
- GPIOAOTYPER = GPIOA + 04H;
- GPIOAOSPEEDR = GPIOA + 08H;
- GPIOAPUPDR = GPIOA + 0CH;
- GPIOAIDR = GPIOA + 10H;
- GPIOAODR = GPIOA + 14H;
- GPIOABSRR = GPIOA + 18H;
- GPIOALCKR = GPIOA + 1CH;
- GPIOAAFRL = GPIOA + 20H;
- GPIOAAFRH = GPIOA + 24H;
- GPIOABRR = GPIOA + 28H;
-
-
- GPIOB = 40020400H;
- GPIOBMODER = GPIOB;
- GPIOBOTYPER = GPIOB + 04H;
- GPIOBOSPEEDR = GPIOB + 08H;
- GPIOBPUPDR = GPIOB + 0CH;
- GPIOBIDR = GPIOB + 10H;
- GPIOBODR = GPIOB + 14H;
- GPIOBBSRR = GPIOB + 18H;
- GPIOBLCKR = GPIOB + 1CH;
- GPIOBAFRL = GPIOB + 20H;
- GPIOBAFRH = GPIOB + 24H;
- GPIOBBRR = GPIOB + 28H;
-
-
- RCC = 40023800H;
- RCC_CR = RCC;
- RCC_AHBENR = RCC + 1CH;
- RCC_APB2ENR = RCC + 20H;
- RCC_APB1ENR = RCC + 24H;
-
-
- NVIC = 0E000E100H;
- NVIC_ISER0 = NVIC;
- NVIC_ISER1 = NVIC + 04H;
- NVIC_ISER2 = NVIC + 08H;
-
- NVIC_ICER0 = NVIC + 80H;
- NVIC_ICER1 = NVIC + 84H;
- NVIC_ICER2 = NVIC + 88H;
-
-
- EXTI = 040010400H;
- EXTI_IMR = EXTI;
- EXTI_RTSR = EXTI + 08H;
- EXTI_FTSR = EXTI + 0CH;
- EXTI_PR = EXTI + 14H;
-
-
- LINE0 = {0};
-
- Blue = 6;
- Green = 7;
-
-
-VAR
- x: SET;
- state: INTEGER;
-
-
-(* обработчик прерываний от EXTI0 *)
-PROCEDURE PushButton [22];
-BEGIN
- SYSTEM.PUT(EXTI_PR, LINE0); (* сбросить флаг прерывания *)
- state := (state + 1) MOD 4;
- (* изменить состояние светодиодов *)
- CASE state OF
- |0: SYSTEM.PUT(GPIOBBSRR, {Blue + 16, Green + 16})
- |1: SYSTEM.PUT(GPIOBBSRR, {Blue, Green + 16})
- |2: SYSTEM.PUT(GPIOBBSRR, {Blue + 16, Green})
- |3: SYSTEM.PUT(GPIOBBSRR, {Blue, Green})
- END
-END PushButton;
-
-
-BEGIN
- state := 0;
-
- (* подключить GPIOA и GPIOB *)
- SYSTEM.GET(RCC_AHBENR, x);
- SYSTEM.PUT(RCC_AHBENR, x + {0, 1});
-
- (* настроить PB6 и PB7 на выход *)
- SYSTEM.GET(GPIOBMODER, x);
- SYSTEM.PUT(GPIOBMODER, x + {12, 14} - {13, 15});
-
- (* настроить PA0 на вход *)
- SYSTEM.GET(GPIOAMODER, x);
- SYSTEM.PUT(GPIOAMODER, x - {0, 1});
-
- (* разрешить прерывания от EXTI0 (позиция 6) *)
- SYSTEM.PUT(NVIC_ISER0, {6});
-
- (* разрешить прерывания от LINE0 по нарастающему краю импульса *)
- SYSTEM.PUT(EXTI_IMR, LINE0);
- SYSTEM.PUT(EXTI_RTSR, LINE0);
-END Button.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/STM32CM3/LCD.ob07 b/programs/develop/oberon07/Samples/STM32CM3/LCD.ob07
deleted file mode 100644
index 7a3db33cf..000000000
--- a/programs/develop/oberon07/Samples/STM32CM3/LCD.ob07
+++ /dev/null
@@ -1,366 +0,0 @@
-(*
- Пример для STM32L152C-DISCO
-
- Работа со встроенным ЖКИ.
-
- использовано:
- https://habr.com/ru/post/173709/
-*)
-
-MODULE LCD;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- GPIOA = 40020000H;
- GPIOAMODER = GPIOA;
- GPIOAOTYPER = GPIOA + 04H;
- GPIOAOSPEEDR = GPIOA + 08H;
- GPIOAPUPDR = GPIOA + 0CH;
- GPIOAIDR = GPIOA + 10H;
- GPIOAODR = GPIOA + 14H;
- GPIOABSRR = GPIOA + 18H;
- GPIOALCKR = GPIOA + 1CH;
- GPIOAAFRL = GPIOA + 20H;
- GPIOAAFRH = GPIOA + 24H;
- GPIOABRR = GPIOA + 28H;
-
-
- GPIOB = 40020400H;
- GPIOBMODER = GPIOB;
- GPIOBOTYPER = GPIOB + 04H;
- GPIOBOSPEEDR = GPIOB + 08H;
- GPIOBPUPDR = GPIOB + 0CH;
- GPIOBIDR = GPIOB + 10H;
- GPIOBODR = GPIOB + 14H;
- GPIOBBSRR = GPIOB + 18H;
- GPIOBLCKR = GPIOB + 1CH;
- GPIOBAFRL = GPIOB + 20H;
- GPIOBAFRH = GPIOB + 24H;
- GPIOBBRR = GPIOB + 28H;
-
-
- GPIOC = 40020800H;
- GPIOCMODER = GPIOC;
- GPIOCOTYPER = GPIOC + 04H;
- GPIOCOSPEEDR = GPIOC + 08H;
- GPIOCPUPDR = GPIOC + 0CH;
- GPIOCIDR = GPIOC + 10H;
- GPIOCODR = GPIOC + 14H;
- GPIOCBSRR = GPIOC + 18H;
- GPIOCLCKR = GPIOC + 1CH;
- GPIOCAFRL = GPIOC + 20H;
- GPIOCAFRH = GPIOC + 24H;
- GPIOCBRR = GPIOC + 28H;
-
-
- RCC = 40023800H;
- RCC_CR = RCC;
- RCC_AHBENR = RCC + 1CH;
- RCC_APB2ENR = RCC + 20H;
- RCC_APB1ENR = RCC + 24H;
- RCC_CSR = RCC + 34H;
-
-
- PWR = 40007000H;
- PWR_CR = PWR;
-
-
- LCD = 40002400H;
- LCD_CR = LCD;
- LCD_FCR = LCD + 04H;
- LCD_SR = LCD + 08H;
- LCD_RAM = LCD + 14H;
-
-
- AFM = 2;
-
- AF11 = 11;
-
- PinsA = {1..3, 8..10, 15};
- PinsB = {3..5, 8..15};
- PinsC = {0..3, 6..11};
-
- A = 0; H = 7;
- B = 1; J = 8;
- C = 2; K = 9;
- D = 3; M = 10;
- E = 4; N = 11;
- F = 5; P = 12;
- G = 6; Q = 13;
-
- DP = 14; COLON = 15; BAR = 16;
-
-
-VAR
- display: ARRAY 6, 17 OF INTEGER;
-
- digits: ARRAY 10 OF SET;
-
-
-PROCEDURE SetPinsMode (reg: INTEGER; pins: SET; mode: INTEGER);
-VAR
- x: SET;
- pin: INTEGER;
-
-BEGIN
- mode := mode MOD 4;
- SYSTEM.GET(reg, x);
- FOR pin := 0 TO 30 BY 2 DO
- IF (pin DIV 2) IN pins THEN
- x := x - {pin, pin + 1} + BITS(LSL(mode, pin))
- END
- END;
- SYSTEM.PUT(reg, x)
-END SetPinsMode;
-
-
-PROCEDURE SRBits (adr: INTEGER; setbits, resetbits: SET);
-VAR
- x: SET;
-
-BEGIN
- SYSTEM.GET(adr, x);
- SYSTEM.PUT(adr, x - resetbits + setbits)
-END SRBits;
-
-
-PROCEDURE SetBits (adr: INTEGER; bits: SET);
-VAR
- x: SET;
-
-BEGIN
- SYSTEM.GET(adr, x);
- SYSTEM.PUT(adr, x + bits)
-END SetBits;
-
-
-PROCEDURE ResetBits (adr: INTEGER; bits: SET);
-VAR
- x: SET;
-
-BEGIN
- SYSTEM.GET(adr, x);
- SYSTEM.PUT(adr, x - bits)
-END ResetBits;
-
-
-PROCEDURE TestBits (adr: INTEGER; bits: SET): BOOLEAN;
-VAR
- x: SET;
-
-BEGIN
- SYSTEM.GET(adr, x);
- RETURN x * bits = bits
-END TestBits;
-
-
-PROCEDURE Init;
-VAR
- i, j: INTEGER;
- seg: ARRAY 30 OF INTEGER;
-
-BEGIN
- FOR i := 0 TO 29 DO
- seg[i] := i
- END;
-
- FOR i := 3 TO 11 DO
- seg[i] := i + 4
- END;
-
- seg[18] := 17;
- seg[19] := 16;
-
- FOR i := 20 TO 23 DO
- seg[i] := i - 2
- END;
-
- j := 0;
- FOR i := 0 TO 5 DO
- display[i, A] := 256 + seg[28 - j];
- display[i, B] := 0 + seg[28 - j];
- display[i, C] := 256 + seg[j + 1];
- display[i, D] := 256 + seg[j];
- display[i, E] := 0 + seg[j];
- display[i, F] := 256 + seg[29 - j];
- display[i, G] := 0 + seg[29 - j];
- display[i, H] := 768 + seg[29 - j];
- display[i, J] := 768 + seg[28 - j];
- display[i, K] := 512 + seg[28 - j];
- display[i, M] := 0 + seg[j + 1];
- display[i, N] := 768 + seg[j];
- display[i, P] := 512 + seg[j];
- display[i, Q] := 512 + seg[29 - j];
- INC(j, 2)
- END;
-
- display[0, DP] := 768 + 1;
- display[1, DP] := 768 + 7;
- display[2, DP] := 768 + 9;
- display[3, DP] := 768 + 11;
-
- display[0, COLON] := 512 + 1;
- display[1, COLON] := 512 + 7;
- display[2, COLON] := 512 + 9;
- display[3, COLON] := 512 + 11;
-
- display[0, BAR] := 768 + 15;
- display[1, BAR] := 512 + 15;
- display[2, BAR] := 768 + 13;
- display[3, BAR] := 512 + 13;
-
- digits[0] := {A, B, C, D, E, F};
- digits[1] := {B, C};
- digits[2] := {A, B, M, G, E, D};
- digits[3] := {A, B, M, G, C, D};
- digits[4] := {F, G, M, B, C};
- digits[5] := {A, F, G, M, C, D};
- digits[6] := {A, F, G, M, C, D, E};
- digits[7] := {F, A, B, C};
- digits[8] := {A, B, C, D, E, F, G, M};
- digits[9] := {A, B, C, D, F, G, M};
-END Init;
-
-
-PROCEDURE ResetSeg (seg: INTEGER);
-BEGIN
- ResetBits(LCD_RAM + (seg DIV 256) * 2 * 4, {seg MOD 256})
-END ResetSeg;
-
-
-PROCEDURE SetSeg (seg: INTEGER);
-BEGIN
- SetBits(LCD_RAM + (seg DIV 256) * 2 * 4, {seg MOD 256})
-END SetSeg;
-
-
-PROCEDURE Digit (pos, dgt: INTEGER);
-VAR
- s: SET;
- i: INTEGER;
-
-BEGIN
- s := digits[dgt];
- FOR i := 0 TO 13 DO
- IF i IN s THEN
- SetSeg(display[pos, i])
- ELSE
- ResetSeg(display[pos, i])
- END
- END
-END Digit;
-
-
-PROCEDURE WhileBits (adr: INTEGER; bits: SET);
-BEGIN
- WHILE TestBits(adr, bits) DO END
-END WhileBits;
-
-
-PROCEDURE UntilBits (adr: INTEGER; bits: SET);
-BEGIN
- REPEAT UNTIL TestBits(adr, bits)
-END UntilBits;
-
-
-PROCEDURE main;
-VAR
- i: INTEGER;
-
-BEGIN
- Init;
-
- (* подключить GPIOA, GPIOB, GPIOC *)
- SetBits(RCC_AHBENR, {0, 1, 2});
-
- (* настроить на режим альтернативной функции *)
- SetPinsMode(GPIOAMODER, PinsA, AFM);
-
- (* 400 кГц *)
- SetPinsMode(GPIOAOSPEEDR, PinsA, 0);
-
- (* без подтягивающих резисторов *)
- SetPinsMode(GPIOAPUPDR, PinsA, 0);
-
- (* режим push-pull *)
- ResetBits(GPIOAOTYPER, PinsA);
-
- (* альтернативная функция AF11 = 0BH *)
- SYSTEM.PUT(GPIOAAFRL, 0BBB0H);
- SYSTEM.PUT(GPIOAAFRH, 0B0000BBBH);
-
- (* аналогично для GPIOB *)
- SetPinsMode(GPIOBMODER, PinsB, AFM);
- SetPinsMode(GPIOBOSPEEDR, PinsB, 0);
- SetPinsMode(GPIOBPUPDR, PinsB, 0);
- ResetBits(GPIOBOTYPER, PinsB);
- SYSTEM.PUT(GPIOBAFRL, 000BBB000H);
- SYSTEM.PUT(GPIOBAFRH, 0BBBBBBBBH);
-
- (* аналогично для GPIOC *)
- SetPinsMode(GPIOCMODER, PinsC, AFM);
- SetPinsMode(GPIOCOSPEEDR, PinsC, 0);
- SetPinsMode(GPIOCPUPDR, PinsC, 0);
- ResetBits(GPIOCOTYPER, PinsC);
- SYSTEM.PUT(GPIOCAFRL, 0BB00BBBBH);
- SYSTEM.PUT(GPIOCAFRH, 00000BBBBH);
-
- (* подключить контроллер ЖКИ *)
- SetBits(RCC_APB1ENR, {9, 28}); (* LCDEN = {9}; PWREN = {28} *)
-
- (* разрешить запись в регистр RCC_CSR *)
- SetBits(PWR_CR, {8}); (* DBP = {8} *)
-
- (* сбросить источник тактирования *)
- SetBits(RCC_CSR, {23}); (* RTCRST = {23} *)
-
- (* выбрать новый источник *)
- ResetBits(RCC_CSR, {23}); (* RTCRST = {23} *)
-
- (* включить НЧ генератор *)
- SetBits(RCC_CSR, {8}); (* LSEON = {8} *)
-
- (* ждать готовность НЧ генератора *)
- UntilBits(RCC_CSR, {9}); (* LSERDY = {9} *)
-
- (* выбрать НЧ генератор как источник тактирования *)
- SRBits(RCC_CSR, {16}, {17}); (* RCC_CSR[17:16] := 01b *)
-
- (* настроить контроллер ЖКИ *)
- SRBits(LCD_CR, {2, 3, 6, 7}, {4, 5}); (* MUX_SEG = {7}; BIAS1 = {6}; BIAS0 = {5}; DUTY2 = {4}; DUTY1 = {3}; DUTY0 = {2} *)
-
- (* Установить значения коэффициентов деления частоты тактового сигнала LCDCLK *)
- SRBits(LCD_FCR, {11, 18, 24}, {10..12, 18..25}); (* LCD_FCR[12:10] := 010b; LCD_FCR[21:18] := 0001b; LCD_FCR[25:22] := 0100b *)
-
- (* ждать синхронизацию регистра LCD_FCR *)
- UntilBits(LCD_SR, {5}); (* FCRSF = {5} *)
-
- (* выбрать внутренний источник напряжения для ЖКИ и разрешить его работу *)
- SRBits(LCD_CR, {0}, {1}); (* LCD_CR_VSEL = {1}; LCD_CR_LCDEN = {0} *)
-
- (* ждать готовность контроллера ЖКИ *)
- UntilBits(LCD_SR, {0, 4}); (* LCD_SR_RDY = {4}; LCD_SR_ENS = {0} *)
-
- (* ждать завершение предыдущей записи *)
- WhileBits(LCD_SR, {2}); (* LCD_SR_UDR = {2} *)
-
- (* начать запись *)
- FOR i := 0 TO 5 DO
- Digit(i, i + 1) (* 123456 *)
- END;
-
- SetSeg(display[1, DP]); (* 12.3456 *)
- SetSeg(display[3, COLON]); (* 12.34:56 *)
- SetSeg(display[0, BAR]); (* 12.34:56_ *)
-
- (* завершить запись *)
- SetBits(LCD_SR, {2}) (* LCD_SR_UDR = {2} *)
-END main;
-
-
-BEGIN
- main
-END LCD.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/STM32CM3/SysTick.ob07 b/programs/develop/oberon07/Samples/STM32CM3/SysTick.ob07
deleted file mode 100644
index 7db04948f..000000000
--- a/programs/develop/oberon07/Samples/STM32CM3/SysTick.ob07
+++ /dev/null
@@ -1,79 +0,0 @@
-(*
- Пример для STM32L152C-DISCO
-
- Светодиоды мигают по прерыванию от системного таймера.
-*)
-
-MODULE SysTick;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- GPIOB = 40020400H;
- GPIOBMODER = GPIOB;
- GPIOBOTYPER = GPIOB + 04H;
- GPIOBOSPEEDR = GPIOB + 08H;
- GPIOBPUPDR = GPIOB + 0CH;
- GPIOBIDR = GPIOB + 10H;
- GPIOBODR = GPIOB + 14H;
- GPIOBBSRR = GPIOB + 18H;
- GPIOBLCKR = GPIOB + 1CH;
- GPIOBAFRL = GPIOB + 20H;
- GPIOBAFRH = GPIOB + 24H;
- GPIOBBRR = GPIOB + 28H;
-
-
- RCC = 40023800H;
- RCC_CR = RCC;
- RCC_AHBENR = RCC + 1CH;
- RCC_APB2ENR = RCC + 20H;
- RCC_APB1ENR = RCC + 24H;
-
-
- STK = 0E000E010H;
- STK_CTRL = STK;
- ENABLE = {0};
- TICKINT = {1};
- CLKSOURCE = {2};
-
- STK_LOAD = STK + 04H;
- STK_VAL = STK + 08H;
- STK_CALIB = STK + 0CH;
-
-
- Blue = 6;
- Green = 7;
-
-
-VAR
-
- x: SET; state: BOOLEAN;
-
-
-(* обработчик прерываний от System tick timer *)
-PROCEDURE tick [15];
-BEGIN
- state := ~state;
- (* включить или выключить светодиоды *)
- SYSTEM.PUT(GPIOBBSRR, {Blue + 16 * ORD(state)});
- SYSTEM.PUT(GPIOBBSRR, {Green + 16 * ORD(state)})
-END tick;
-
-
-BEGIN
- state := FALSE;
-
- (* подключить GPIOB *)
- SYSTEM.GET(RCC_AHBENR, x);
- SYSTEM.PUT(RCC_AHBENR, x + {1});
-
- (* настроить PB6 и PB7 на выход *)
- SYSTEM.GET(GPIOBMODER, x);
- SYSTEM.PUT(GPIOBMODER, x + {12, 14} - {13, 15});
-
- (* настроить и запустить SysTick *)
- SYSTEM.PUT(STK_LOAD, 1048576);
- SYSTEM.PUT(STK_CTRL, ENABLE + TICKINT + CLKSOURCE);
-END SysTick.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/STM32CM3/TIM67.ob07 b/programs/develop/oberon07/Samples/STM32CM3/TIM67.ob07
deleted file mode 100644
index 64b536ea9..000000000
--- a/programs/develop/oberon07/Samples/STM32CM3/TIM67.ob07
+++ /dev/null
@@ -1,143 +0,0 @@
-(*
- Пример для STM32L152C-DISCO
-
- Синий светодиод мигает по прерыванию от таймера TIM6,
- зеленый - от TIM7.
-*)
-
-MODULE TIM67;
-
-IMPORT SYSTEM;
-
-
-CONST
-
- GPIOB = 40020400H;
- GPIOBMODER = GPIOB;
- GPIOBOTYPER = GPIOB + 04H;
- GPIOBOSPEEDR = GPIOB + 08H;
- GPIOBPUPDR = GPIOB + 0CH;
- GPIOBIDR = GPIOB + 10H;
- GPIOBODR = GPIOB + 14H;
- GPIOBBSRR = GPIOB + 18H;
- GPIOBLCKR = GPIOB + 1CH;
- GPIOBAFRL = GPIOB + 20H;
- GPIOBAFRH = GPIOB + 24H;
- GPIOBBRR = GPIOB + 28H;
-
-
- RCC = 40023800H;
- RCC_CR = RCC;
- RCC_AHBENR = RCC + 1CH;
- RCC_APB2ENR = RCC + 20H;
- RCC_APB1ENR = RCC + 24H;
-
-
- TIM6 = 40001000H;
- TIM6_CR1 = TIM6;
- CEN = {0};
- UDIS = {1};
- URS = {2};
- OPM = {3};
- ARPE = {7};
-
- TIM6_CR2 = TIM6 + 04H;
-
- TIM6_DIER = TIM6 + 0CH;
- UIE = {0};
-
- TIM6_SR = TIM6 + 10H;
- UIF = {0};
-
- TIM6_EGR = TIM6 + 14H;
- UG = {0};
-
- TIM6_CNT = TIM6 + 24H;
- TIM6_PSC = TIM6 + 28H;
- TIM6_ARR = TIM6 + 2CH;
-
-
- TIM7 = 40001400H;
- TIM7_CR1 = TIM7;
- TIM7_CR2 = TIM7 + 04H;
- TIM7_DIER = TIM7 + 0CH;
- TIM7_SR = TIM7 + 10H;
- TIM7_EGR = TIM7 + 14H;
- TIM7_CNT = TIM7 + 24H;
- TIM7_PSC = TIM7 + 28H;
- TIM7_ARR = TIM7 + 2CH;
-
-
- NVIC = 0E000E100H;
- NVIC_ISER0 = NVIC;
- NVIC_ISER1 = NVIC + 04H;
- NVIC_ISER2 = NVIC + 08H;
-
- NVIC_ICER0 = NVIC + 80H;
- NVIC_ICER1 = NVIC + 84H;
- NVIC_ICER2 = NVIC + 88H;
-
-
- BLUELED = 6;
- GREENLED = 7;
-
-
-VAR
- x: SET;
- state1, state2: BOOLEAN;
-
-
-(* обработчик прерываний от TIM6 *)
-PROCEDURE tim6 [59];
-BEGIN
- SYSTEM.PUT(TIM6_SR, 0); (* сбросить флаг прерывания *)
- state1 := ~state1;
- (* включить или выключить синий светодиод *)
- SYSTEM.PUT(GPIOBBSRR, {BLUELED + 16 * ORD(state1)})
-
-END tim6;
-
-
-(* обработчик прерываний от TIM7 *)
-PROCEDURE tim7 [60];
-BEGIN
- SYSTEM.PUT(TIM7_SR, 0); (* сбросить флаг прерывания *)
- state2 := ~state2;
- (* включить или выключить зеленый светодиод *)
- SYSTEM.PUT(GPIOBBSRR, {GREENLED + 16 * ORD(state2)})
-END tim7;
-
-
-BEGIN
- state1 := FALSE;
- state2 := FALSE;
-
- (* подключить GPIOB *)
- SYSTEM.GET(RCC_AHBENR, x);
- SYSTEM.PUT(RCC_AHBENR, x + {1});
-
- (* подключить TIM6 и TIM7 *)
- SYSTEM.GET(RCC_APB1ENR, x);
- SYSTEM.PUT(RCC_APB1ENR, x + {4, 5});
-
- (* настроить PB6 и PB7 на выход *)
- SYSTEM.GET(GPIOBMODER, x);
- SYSTEM.PUT(GPIOBMODER, x + {12, 14} - {13, 15});
-
- (* разрешить прерывания от таймеров TIM6 (позиция 43) и TIM7 (позиция 44) *)
- SYSTEM.PUT(NVIC_ISER1, {11, 12});
-
- (* настроить и запустить TIM6 *)
- SYSTEM.PUT(TIM6_ARR, 31);
- SYSTEM.PUT(TIM6_PSC, 65535);
- SYSTEM.PUT(TIM6_DIER, UIE);
- SYSTEM.GET(TIM6_CR1, x);
- SYSTEM.PUT(TIM6_CR1, x + CEN - (UDIS + URS + OPM + ARPE));
-
- (* настроить и запустить TIM7 *)
- SYSTEM.PUT(TIM7_ARR, 8000);
- SYSTEM.PUT(TIM7_PSC, 80);
- SYSTEM.PUT(TIM7_DIER, UIE);
- SYSTEM.GET(TIM7_CR1, x);
- SYSTEM.PUT(TIM7_CR1, x + CEN - (UDIS + URS + OPM + ARPE));
-END TIM67.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/Doors.ob07 b/programs/develop/oberon07/Samples/Windows/Console/Doors.ob07
deleted file mode 100644
index 838137411..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/Doors.ob07
+++ /dev/null
@@ -1,58 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(*
- There are 100 doors in a row that are all initially closed.
- You make 100 passes by the doors.
- The first time through, visit every door and toggle the door (if the door is closed, open it; if it is open, close it).
- The second time, only visit every 2nd door (door #2, #4, #6, ...), and toggle it.
- The third time, visit every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door.
- What state are the doors in after the last pass? Which are open, which are closed?
-*)
-MODULE Doors;
-
-IMPORT In, Out, Console;
-
-
-CONST
- CLOSED = FALSE;
- OPEN = TRUE;
-
-
-TYPE
- List = ARRAY 101 OF BOOLEAN;
-
-
-VAR
- Doors: List;
- I, J: INTEGER;
-
-
-BEGIN
- Console.open;
-
- FOR I := 1 TO 100 DO
- FOR J := 1 TO 100 DO
- IF J MOD I = 0 THEN
- IF Doors[J] = CLOSED THEN
- Doors[J] := OPEN
- ELSE
- Doors[J] := CLOSED
- END
- END
- END
- END;
- FOR I := 1 TO 100 DO
- Out.Int(I, 3);
- Out.String(" is ");
- IF Doors[I] = CLOSED THEN
- Out.String("Closed.")
- ELSE
- Out.String("Open.")
- END;
- Out.Ln
- END;
- In.Ln;
-
- Console.exit(TRUE)
-END Doors.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/HeapSort.ob07 b/programs/develop/oberon07/Samples/Windows/Console/HeapSort.ob07
deleted file mode 100644
index 745970ee4..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/HeapSort.ob07
+++ /dev/null
@@ -1,101 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* ********* Zonnon online collection ***********
- * Sorting: Heap Sort (Chapter 2, Example 2.8)
- *
- * This example is a part of Prof. Nikalus Wirth's book
- * www.zonnon.ethz.ch/usergroup
- * (c) ETH Zurich
- *)
-
-MODULE HeapSort;
-
-IMPORT In, Out, Console;
-
-
-CONST
- MAX_SIZE = 20;
-
-
-TYPE
- DefaultArray = ARRAY MAX_SIZE OF INTEGER;
-
-
-VAR
- MyArray: DefaultArray;
-
- (***** Implementation *****)
-
-PROCEDURE sift(VAR a: DefaultArray; L,R:INTEGER);
-VAR
- i, j, x: INTEGER;
-
-BEGIN
- i := L; j:= 2 * L; x:= a[L];
- IF (j < R) & (a[j] < a[j + 1]) THEN j := j + 1 END;
- WHILE (j <= R) & (x < a[j]) DO
- a[i] := a[j]; i := j; j := 2 * j;
- IF (j < R) & (a[j] < a[j + 1]) THEN j := j + 1 END
- END;
- a[i] := x
-END sift;
-
-
-PROCEDURE HeapSort(VAR a: DefaultArray; n: INTEGER);
-VAR
- L, R, x: INTEGER;
-
-BEGIN
- L := (n DIV 2); R := n - 1;
- WHILE L > 0 DO L := L - 1; sift(a, L, R) END;
- WHILE R > 0 DO
- x := a[0]; a[0] := a[R]; a[R]:= x;
- R := R - 1; sift(a, L, R)
- END
-END HeapSort;
-
-(***** Example support *****)
-
-PROCEDURE FillTheArray;
-VAR
- i: INTEGER;
-
-BEGIN
- FOR i := 0 TO MAX_SIZE - 1 DO
- MyArray[i] := ABS(10 - i)
- END
-END FillTheArray;
-
-
-PROCEDURE PrintTheArray;
-VAR
- i: INTEGER;
-
-BEGIN
- Out.String("Array:"); Out.Ln;
- FOR i := 0 TO MAX_SIZE - 1 DO
- Out.Int(MyArray[i], 2); Out.String(", ")
- END;
- Out.Ln
-END PrintTheArray;
-
-
-PROCEDURE Execute;
-BEGIN
- HeapSort(MyArray, MAX_SIZE)
-END Execute;
-
-
-BEGIN
- Console.open;
-
- Out.String("Example 2.8 (Heap sort)"); Out.Ln;
- FillTheArray;
- PrintTheArray;
- Execute;
- PrintTheArray;
- Out.String("Press Enter to continue"); In.Ln;
-
- Console.exit(TRUE)
-END HeapSort.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/Hello.ob07 b/programs/develop/oberon07/Samples/Windows/Console/Hello.ob07
deleted file mode 100644
index e40d3fe04..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/Hello.ob07
+++ /dev/null
@@ -1,13 +0,0 @@
-MODULE Hello;
-
-IMPORT Console, In, Out;
-
-
-BEGIN
- Console.open;
-
- Out.String("Hello, world!");
- In.Ln;
-
- Console.exit(TRUE)
-END Hello.
diff --git a/programs/develop/oberon07/Samples/Windows/Console/HelloRus.ob07 b/programs/develop/oberon07/Samples/Windows/Console/HelloRus.ob07
deleted file mode 100644
index 5036196bb..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/HelloRus.ob07
+++ /dev/null
@@ -1,26 +0,0 @@
-MODULE HelloRus;
-
-IMPORT Console, In, Out;
-
-
-PROCEDURE main;
-VAR
- str: ARRAY 10 OF WCHAR;
-
-BEGIN
- str := "Привет!";
- Out.StringW(str); Out.Ln;
- str[2] := "е";
- str[5] := "д";
- Out.StringW(str)
-END main;
-
-
-BEGIN
- Console.open;
-
- main;
- In.Ln;
-
- Console.exit(TRUE)
-END HelloRus.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/MagicSquares.ob07 b/programs/develop/oberon07/Samples/Windows/Console/MagicSquares.ob07
deleted file mode 100644
index 8dce19834..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/MagicSquares.ob07
+++ /dev/null
@@ -1,48 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* ********* Zonnon online collection ***********
- * Magic Squares
- *
- * This example is a part of Prof. Nikalus Wirth's book
- * www.zonnon.ethz.ch/usergroup
- * (c) ETH Zurich
- *)
-
-MODULE MagicSquares; (*NW 11.8.97*)
-
-IMPORT In, Out, Console;
-
-
-PROCEDURE Generate; (*magic square of order 3, 5, 7, ... *)
-VAR
- i, j, x, nx, nsq, n: INTEGER;
- M: ARRAY 13, 13 OF INTEGER;
-
-BEGIN
- Out.String("Enter magic square order(3, 5, 7, ..., 13): "); In.Int(n); nsq := n * n; x := 0;
- i := n DIV 2; j := n - 1;
- WHILE x < nsq DO
- nx := n + x; j := (j - 1) MOD n; INC(x);
- Out.Int(i, 1); Out.Char(9X);
- Out.Int(j, 1); Out.Ln;
- M[i, j] := x;
- WHILE x < nx DO
- i := (i + 1) MOD n; j := (j + 1) MOD n;
- INC(x); M[i, j] := x
- END
- END;
- FOR i := 0 TO n - 1 DO
- FOR j := 0 TO n - 1 DO Out.Int(M[i, j], 6) END;
- Out.Ln
- END
-END Generate;
-
-BEGIN
- Console.open;
-
- Generate;
- Out.String("Press Enter to continue"); In.Ln;
-
- Console.exit(TRUE)
-END MagicSquares.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/MultiplicationTables.ob07 b/programs/develop/oberon07/Samples/Windows/Console/MultiplicationTables.ob07
deleted file mode 100644
index 434e3724d..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/MultiplicationTables.ob07
+++ /dev/null
@@ -1,52 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(*
- Produce a formatted NxN multiplication table
- Only print the top half triangle of products
-*)
-
-MODULE MultiplicationTables;
-
-IMPORT In, Out, Console;
-
-
-CONST
- N = 18;
-
-
-VAR
- I, J: INTEGER;
-
-
-BEGIN
- Console.open;
-
- FOR J := 1 TO N - 1 DO
- Out.Int(J, 3);
- Out.String(" ")
- END;
- Out.Int(N, 3);
- Out.Ln;
- FOR J := 0 TO N - 1 DO
- Out.String("----")
- END;
- Out.String("+");
- Out.Ln;
- FOR I := 1 TO N DO
- FOR J := 1 TO N DO
- IF J < I THEN
- Out.String(" ")
- ELSE
- Out.Int(I * J, 3);
- Out.String(" ")
- END
- END;
- Out.String("| ");
- Out.Int(I, 2);
- Out.Ln
- END;
- In.Ln;
-
- Console.exit(TRUE)
-END MultiplicationTables.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/SierpinskiCarpet.ob07 b/programs/develop/oberon07/Samples/Windows/Console/SierpinskiCarpet.ob07
deleted file mode 100644
index 53e48b1eb..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/SierpinskiCarpet.ob07
+++ /dev/null
@@ -1,75 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-MODULE SierpinskiCarpet;
-
-IMPORT In, Out, Console;
-
-
-VAR
- order: INTEGER;
-
-
-PROCEDURE pow(b, n: INTEGER): INTEGER;
-VAR
- i, res: INTEGER;
-
-BEGIN
- res := 1;
- FOR i := 1 TO n DO
- res := res * b
- END
-
- RETURN res
-END pow;
-
-
-PROCEDURE in_carpet(x, y: INTEGER): BOOLEAN;
-VAR
- res, exit: BOOLEAN;
-
-BEGIN
- exit := FALSE;
- res := TRUE;
- WHILE (x > 0) & (y > 0) & (exit = FALSE) DO
- IF (x MOD 3 = 1) & (y MOD 3 = 1) THEN
- res := FALSE;
- exit := TRUE
- END;
- y := y DIV 3;
- x := x DIV 3
- END
-
- RETURN res
-END in_carpet;
-
-
-PROCEDURE PrintSierpinski(n: INTEGER);
-VAR
- i, j, l: INTEGER;
-
-BEGIN
- l := pow(3, n) - 1;
- FOR i := 0 TO l DO
- FOR j := 0 TO l DO
- IF in_carpet(i, j) THEN
- Out.Char("#")
- ELSE
- Out.Char(" ")
- END
- END;
- Out.Ln
- END
-END PrintSierpinski;
-
-
-BEGIN
- Console.open;
-
- Out.String("Input carpet order(0..3):");
- In.Int(order);
- PrintSierpinski(order);
- In.Ln;
-
- Console.exit(TRUE)
-END SierpinskiCarpet.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/SierpinskiTriangle.ob07 b/programs/develop/oberon07/Samples/Windows/Console/SierpinskiTriangle.ob07
deleted file mode 100644
index c72607ffe..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/SierpinskiTriangle.ob07
+++ /dev/null
@@ -1,44 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-MODULE SierpinskiTriangle;
-
-IMPORT In, Out, Console;
-
-
-VAR
- order: INTEGER;
-
-
-PROCEDURE PrintSierpinski(order: INTEGER);
-VAR
- x, y, k, size: INTEGER;
-
-BEGIN
- size := LSL(1, order) - 1;
- FOR y := size TO 0 BY -1 DO
- FOR k := 1 TO y DO
- Out.Char(" ")
- END;
- FOR x := 0 TO size - y DO
- IF BITS(x) * BITS(y) = {} THEN
- Out.String("* ")
- ELSE
- Out.String(" ")
- END
- END;
- Out.Ln
- END
-END PrintSierpinski;
-
-
-BEGIN
- Console.open;
-
- Out.String("Input triangle order(0..5):");
- In.Int(order);
- PrintSierpinski(order);
- In.Ln;
-
- Console.exit(TRUE)
-END SierpinskiTriangle.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/Sieve.ob07 b/programs/develop/oberon07/Samples/Windows/Console/Sieve.ob07
deleted file mode 100644
index a0a6460f3..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/Sieve.ob07
+++ /dev/null
@@ -1,51 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-
-(* This was taken from the CRITICAL MASS MODULA-3 examples *)
-
-(* The "Sieve" program demonstrates the use of arrays,
- loops and conditionals. *)
-
-MODULE Sieve;
-
-IMPORT In, Out, Console;
-
-(* Search in interval 2 to 1000 for prime numbers. *)
-CONST
- LastNum = 1000;
-
-(* "prime" is an array of booleans ranging from 2 to "LastNum". *)
-VAR
- prime: ARRAY LastNum + 2 OF BOOLEAN;
- i, j: INTEGER;
-
-BEGIN
- Console.open;
-
- Out.String("Primes in range 2.."); Out.Int(LastNum, 1); Out.Char(":"); Out.Ln;
-(* Initialize all elements of the array to "TRUE".
- (Note that we could have initialized the array during
- the assignment.) *)
- FOR i := 2 TO LastNum DO
- prime[i] := TRUE
- END;
-(* Loop through all integers between 2 and "LastNum". Print each prime
- number, starting from 2 and mark all numbers that are divisible by
- that prime number to "FALSE". Repeat the step until we've exhausted
- all the numbers in the interval.*)
- FOR i := 2 TO LastNum DO
- IF prime[i] THEN
- Out.Int(i, 3);
- Out.Char(" ");
- FOR j := i TO LastNum DO
- IF j MOD i = 0 THEN
- prime[j] := FALSE
- END
- END
- END
- END;
- Out.Ln; In.Ln;
-
- Console.exit(TRUE)
-END Sieve.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/SpiralMatrix.ob07 b/programs/develop/oberon07/Samples/Windows/Console/SpiralMatrix.ob07
deleted file mode 100644
index 223952085..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/SpiralMatrix.ob07
+++ /dev/null
@@ -1,56 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(*
- Produce a spiral array.
- A spiral array is a square arrangement of the first (Width * Height) natural numbers,
- where the numbers increase sequentially as you go around the edges of the array spiraling inwards.
-*)
-
-MODULE SpiralMatrix;
-
-IMPORT In, Out, Console;
-
-
-VAR
- Width, Height: INTEGER;
-
-
-PROCEDURE spiral(w, h, x, y: INTEGER): INTEGER;
-VAR
- res: INTEGER;
-
-BEGIN
- IF y # 0 THEN
- res := w + spiral(h - 1, w, y - 1, w - x - 1)
- ELSE
- res := x
- END
- RETURN res
-END spiral;
-
-
-PROCEDURE print_spiral(w, h: INTEGER);
-VAR
- i, j: INTEGER;
-
-BEGIN
- FOR i := 0 TO h - 1 DO
- FOR j := 0 TO w - 1 DO
- Out.Int(spiral(w, h, j, i), 4)
- END;
- Out.Ln
- END
-END print_spiral;
-
-
-BEGIN
- Console.open;
-
- Out.String("Input width of matrix(1, 2, 3, ...):"); In.Int(Width);
- Out.String("Input height of matrix:(1, 2, 3, ...)"); In.Int(Height);
- print_spiral(Width, Height);
- In.Ln;
-
- Console.exit(TRUE)
-END SpiralMatrix.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/TempConv.ob07 b/programs/develop/oberon07/Samples/Windows/Console/TempConv.ob07
deleted file mode 100644
index 6906af1e7..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/TempConv.ob07
+++ /dev/null
@@ -1,44 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* This program is a good example of proper formatting, it is *)
-(* easy to read and very easy to understand. It should be a *)
-(* snap to update a program that is well written like this. You *)
-(* should begin to develop good formatting practice early in *)
-(* your programming career. *)
-
-MODULE TempConv;
-
-IMPORT In, Out, Console;
-
-
-VAR
- Count : INTEGER; (* a variable used for counting *)
- Centigrade : INTEGER; (* the temperature in centigrade *)
- Farenheit : INTEGER; (* the temperature in farenheit *)
-
-BEGIN
- Console.open;
-
- Out.String("Farenheit to Centigrade temperature table");
- Out.Ln;
- Out.Ln;
- FOR Count := -2 TO 12 DO
- Centigrade := 10 * Count;
- Farenheit := 32 + Centigrade * 9 DIV 5;
- Out.String(" C =");
- Out.Int(Centigrade, 5);
- Out.String(" F =");
- Out.Int(Farenheit, 5);
- IF Centigrade = 0 THEN
- Out.String(" Freezing point of water");
- END;
- IF Centigrade = 100 THEN
- Out.String(" Boiling point of water");
- END;
- Out.Ln;
- END; (* of main loop *)
- In.Ln;
-
- Console.exit(TRUE)
-END TempConv.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/exp.ob07 b/programs/develop/oberon07/Samples/Windows/Console/exp.ob07
deleted file mode 100644
index 39807377a..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/exp.ob07
+++ /dev/null
@@ -1,117 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* Print first 'PRINT' digits of 'e'.
- *
- * Originally written in Pascal by Scott Hemphill
- * Rewritten in Modula-2 and modified by Andrew Cadach
- *
- *)
-
-MODULE exp;
-
-IMPORT In, Out, Console;
-
-
-CONST
- PRINT = 1024;
- DIGITS = PRINT + (PRINT + 31) DIV 32;
-
-
-TYPE
- number = ARRAY DIGITS + 1 OF INTEGER;
-
-
-VAR
- s, x: number;
- xs, i: INTEGER;
-
-
-PROCEDURE init (VAR x: number; n: INTEGER);
-VAR
- i: INTEGER;
-
-BEGIN
- x[0] := n;
- FOR i := 1 TO DIGITS DO x[i] := 0 END
-END init;
-
-
-PROCEDURE divide (VAR x: number; xs, n: INTEGER;
- VAR y: number; VAR ys: INTEGER);
-VAR
- i, c: INTEGER;
-
-BEGIN
- c := 0;
- FOR i := xs TO DIGITS DO
- c := 10 * c + x[i];
- y[i] := c DIV n;
- c := c MOD n
- END;
- ys := xs;
- WHILE (ys <= DIGITS) & (y[ys] = 0) DO INC(ys) END
-END divide;
-
-
-PROCEDURE add (VAR s, x: number; xs: INTEGER);
-VAR
- i, c: INTEGER;
-BEGIN
- c := 0;
- FOR i := DIGITS TO xs BY -1 DO
- c := c + s[i] + x[i];
- IF c >= 10 THEN
- s[i] := c - 10;
- c := 1
- ELSE
- s[i] := c;
- c := 0
- END
- END;
- i := xs;
- WHILE c # 0 DO
- DEC(i);
- c := c + s[i];
- IF c >= 10 THEN
- s[i] := c - 10;
- c := 1
- ELSE
- s[i] := c;
- c := 0
- END
- END
-END add;
-
-
-BEGIN
- Console.open;
-
- init(s, 0);
- init(x, 1);
- xs := 0;
- add(s, x, xs);
- i := 0;
- REPEAT
- INC(i);
- divide(x, xs, i, x, xs);
- add(s, x, xs);
- UNTIL xs > DIGITS;
- Out.Ln;
- Out.String (" e = ");
- Out.Char (CHR(s[0] + ORD("0")));
- Out.Char (".");
- FOR i := 1 TO PRINT DO
- Out.Char (CHR(s[i] + ORD("0")));
- IF i MOD 64 = 0 THEN
- Out.Ln;
- Out.Int (i, 5);
- Out.String (" ")
- END
- END;
- Out.Ln;
- Out.Ln;
- In.Ln;
-
- Console.exit(TRUE)
-END exp.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/fact.ob07 b/programs/develop/oberon07/Samples/Windows/Console/fact.ob07
deleted file mode 100644
index 7f059811a..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/fact.ob07
+++ /dev/null
@@ -1,59 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(*
- * Written by Andrew Cadach
- *
- * Recursive (extremely uneficient:-) implementation of factorial
- *
- * n * (n-1)!, n <> 0
- * By definition, n! =
- * 1, n = 0
- *
- *)
-
-MODULE fact;
-
-IMPORT In, Out, Console;
-
-
-CONST
- MAX_INTEGER = ROR(-2, 1);
-
-
-VAR
- i, r: INTEGER;
-
-
-PROCEDURE f (n: INTEGER): INTEGER;
-VAR
- Res: INTEGER;
-
-BEGIN
- IF n = 0 THEN
- Res := 1
- ELSE
- Res := n * f (n - 1)
- END
-
- RETURN Res
-END f;
-
-
-BEGIN
- Console.open;
-
- i := 0;
- REPEAT
- r := f(i);
- Out.String ("The factorial of ");
- Out.Int (i, 2);
- Out.String (" is ");
- Out.Int (r, 0);
- Out.Ln;
- INC(i)
- UNTIL r >= MAX_INTEGER DIV i;
- In.Ln;
-
- Console.exit(TRUE)
-END fact.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/hailst.ob07 b/programs/develop/oberon07/Samples/Windows/Console/hailst.ob07
deleted file mode 100644
index ebe93f3da..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/hailst.ob07
+++ /dev/null
@@ -1,117 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(*
- The Hailstone sequence of numbers can be generated
- from a starting positive integer, n by:
- IF n is 1 THEN the sequence ends.
- IF n is even THEN the next n of the sequence = n / 2
- IF n is odd THEN the next n of the sequence = (3 * n) + 1
- The (unproven) Collatz conjecture is that the hailstone sequence
- for any starting number always terminates.
-*)
-
-MODULE hailst;
-
-IMPORT In, Out, API, Console;
-
-
-CONST
- maxCard = ROR(-2, 1) DIV 3;
- List = 1;
- Count = 2;
- Max = 3;
-
-
-VAR
- a: INTEGER;
-
-
-PROCEDURE HALT(code: INTEGER);
-BEGIN
- In.Ln; Console.exit(TRUE); API.exit(code)
-END HALT;
-
-
-PROCEDURE HailStone(start, _type: INTEGER): INTEGER;
-VAR
- n, max, count, res: INTEGER;
- exit: BOOLEAN;
-
-BEGIN
- count := 1;
- n := start;
- max := n;
- exit := FALSE;
- WHILE exit # TRUE DO
- IF _type = List THEN
- Out.Int (n, 12);
- IF count MOD 6 = 0 THEN Out.Ln END
- END;
- IF n # 1 THEN
- IF ODD(n) THEN
- IF n < maxCard THEN
- n := 3 * n + 1;
- IF n > max THEN max := n END
- ELSE
- Out.String("Exceeding max value for type INTEGER at:");
- Out.Ln;
- Out.String("n = "); Out.Int(start, 1);
- Out.String(", count = "); Out.Int(count, 1);
- Out.String(", intermediate value ");
- Out.Int(n, 1);
- Out.String(". Aborting.");
- Out.Ln;
- HALT(2)
- END
- ELSE
- n := n DIV 2
- END;
- INC(count)
- ELSE
- exit := TRUE
- END
- END;
- IF _type = Max THEN res := max ELSE res := count END
-
- RETURN res
-END HailStone;
-
-
-PROCEDURE FindMax(num: INTEGER);
-VAR
- val, maxCount, maxVal, cnt: INTEGER;
-
-BEGIN
- maxCount := 0;
- maxVal := 0;
- FOR val := 2 TO num DO
- cnt := HailStone(val, Count);
- IF cnt > maxCount THEN
- maxVal := val;
- maxCount := cnt
- END
- END;
- Out.String("Longest sequence below "); Out.Int(num, 1);
- Out.String(" is "); Out.Int(HailStone(maxVal, Count), 1);
- Out.String(" for n = "); Out.Int(maxVal, 1);
- Out.String(" with an intermediate maximum of ");
- Out.Int(HailStone(maxVal, Max), 1);
- Out.Ln
-END FindMax;
-
-
-BEGIN
- Console.open;
-
- a := HailStone(27, List);
- Out.Ln;
- Out.String("Iterations total = "); Out.Int(HailStone(27, Count), 1);
- Out.String(" max value = "); Out.Int(HailStone(27, Max), 1);
- Out.Ln;
- FindMax(100000);
- Out.String("Done.");
- Out.Ln; In.Ln;
-
- Console.exit(TRUE)
-END hailst.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/postfix.ob07 b/programs/develop/oberon07/Samples/Windows/Console/postfix.ob07
deleted file mode 100644
index 309011d06..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/postfix.ob07
+++ /dev/null
@@ -1,123 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* Example program from Programming In Modula-2, N. Wirth., pg. 56, *)
-(* - no WINDOWS in this example *)
-
-(* this program translates a small language into postfix form
- * the language is
- *
- * expression = term { [ "+" | "-" ] term }
- *
- * term = factor { [ "*" | "/" ] factor }
- *
- * factor = letter | "(" expression ")"
- *
- * letter = "a" | 'b" | … | "z"
- *
- * try as input
- * a+b
- * a*b+c
- * a+b*c
- * a*(b/(c-d))
- *)
-
-MODULE postfix;
-
-IMPORT In, Out, Console;
-
-
-CONST
- OUT_LINE_SIZE = 80;
- IN_LINE_SIZE = 80;
-
-
-VAR
- ch : CHAR;
- i, index : INTEGER;
- out_line : ARRAY OUT_LINE_SIZE OF CHAR;
- in_line : ARRAY IN_LINE_SIZE OF CHAR;
- cur_ch : INTEGER;
-
-
-PROCEDURE NextChar(): CHAR;
-BEGIN
- INC(cur_ch)
- RETURN in_line[cur_ch - 1]
-END NextChar;
-
-
-PROCEDURE expression;
-VAR
- addop :CHAR;
-
-
- PROCEDURE term;
- VAR
- mulop :CHAR;
-
-
- PROCEDURE factor;
- BEGIN (* factor *)
- IF ch = "(" THEN
- ch := NextChar();
- expression;
- WHILE ch # ")" DO
- ch := NextChar()
- END (* WHILE *)
- ELSE
- WHILE (ch < "a") OR (ch > "z") DO
- ch := NextChar()
- END; (* WHILE *)
- out_line[index] := ch;
- index := index + 1
- END; (* IF *)
- ch := NextChar()
- END factor;
-
-
- BEGIN (* term *)
- factor;
- WHILE (ch = "*") OR (ch = "/") DO
- mulop := ch;
- ch := NextChar();
- factor;
- out_line[index] := mulop;
- index := index + 1
- END (* WHILE *)
- END term;
-
-
-BEGIN (* expression *)
- term;
- WHILE (ch = "+") OR (ch = "-") DO
- addop := ch;
- ch := NextChar();
- term;
- out_line[index] := addop;
- index := index + 1
- END (* WHILE *)
-END expression;
-
-
-BEGIN (* Postfix *)
- Console.open;
-
- index := 1; cur_ch := 0;
- Out.String("Enter expression:");
- In.String(in_line);
- ch := NextChar();
- WHILE ch > " " DO
- expression;
- FOR i := 1 TO index - 1 DO
- Out.Char(out_line[i])
- END; (* FOR *)
- Out.Ln;
- index := 1; cur_ch := 0;
- Out.String("Enter expression:");
- In.String(in_line);
- ch := NextChar()
- END; (* WHILE *)
-
- Console.exit(TRUE)
-END postfix.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/Windows/Console/sequence012.ob07 b/programs/develop/oberon07/Samples/Windows/Console/sequence012.ob07
deleted file mode 100644
index 782b26708..000000000
--- a/programs/develop/oberon07/Samples/Windows/Console/sequence012.ob07
+++ /dev/null
@@ -1,79 +0,0 @@
-(*
- adapted to Oberon-07 by 0CodErr, KolibriOS team
- *)
-(* Find sequence of digits 0, 1, 2 and of lengths 1 ... 90, such
- that they contain no two adjacent subsequences that are equal *)
-
-MODULE sequence012;
-
-IMPORT In, Out, Console;
-
-
-CONST
- maxlength = 75;
-
-
-VAR
- n: INTEGER;
- good: BOOLEAN;
- s: ARRAY maxlength OF INTEGER;
-
-
-PROCEDURE printsequence;
-VAR
- k: INTEGER;
-BEGIN
- Out.Char(" ");
- FOR k := 1 TO n DO Out.Int(s[k], 1) END;
- Out.Ln
-END printsequence;
-
-
-PROCEDURE changesequence;
-BEGIN
- IF s[n] = 3 THEN
- DEC(n);
- changesequence
- ELSE
- s[n] := s[n] + 1
- END
-END changesequence;
-
-
-PROCEDURE try;
-VAR
- i, l, nhalf: INTEGER;
-
-BEGIN
- IF n <= 1 THEN
- good := TRUE
- ELSE
- l := 0; nhalf := n DIV 2;
- REPEAT
- INC(l); i := 0;
- REPEAT
- good := s[n - i] # s[n - l - i];
- INC(i)
- UNTIL good OR (i = l)
- UNTIL ~good OR (l >= nhalf)
- END
-END try;
-
-
-BEGIN
- Console.open;
-
- n := 0;
- REPEAT
- INC(n);
- s[n] := 1; try;
- WHILE ~good DO
- changesequence;
- try
- END;
- printsequence
- UNTIL n >= maxlength - 1;
- In.Ln;
-
- Console.exit(TRUE)
-END sequence012.
\ No newline at end of file
diff --git a/programs/develop/oberon07/SelfKolibriOS.cmd b/programs/develop/oberon07/SelfKolibriOS.cmd
new file mode 100644
index 000000000..069ab78cd
--- /dev/null
+++ b/programs/develop/oberon07/SelfKolibriOS.cmd
@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 kosexe -out source\Compiler.kex -stk 2
+@pause
\ No newline at end of file
diff --git a/programs/develop/oberon07/doc/CC.txt b/programs/develop/oberon07/doc/CC.txt
new file mode 100644
index 000000000..0df944219
--- /dev/null
+++ b/programs/develop/oberon07/doc/CC.txt
@@ -0,0 +1,61 @@
+Условная компиляция
+
+синтаксис:
+
+ $IF "(" ident {"|" ident} ")"
+ <...>
+ {$ELSIF "(" ident {"|" ident} ")"}
+ <...>
+ [$ELSE]
+ <...>
+ $END
+
+ где ident:
+ - одно из возможных значений параметра в командной строке
+ - пользовательский идентификатор, переданный с ключом -def при компиляции
+ - один из возможных предопределенных идентификаторов:
+
+ WINDOWS - приложение Windows
+ LINUX - приложение Linux
+ KOLIBRIOS - приложение KolibriOS
+ CPU_X86 - приложение для процессора x86 (32-бит)
+ CPU_X8664 - приложение для процессора x86_64
+
+
+примеры:
+
+ $IF (win64con | win64gui | win64dll)
+ OS := "WIN64";
+ $ELSIF (win32con | win32gui | win32dll)
+ OS := "WIN32";
+ $ELSIF (linux64exe | linux64so)
+ OS := "LINUX64";
+ $ELSIF (linux32exe | linux32so)
+ OS := "LINUX32";
+ $ELSE
+ OS := "UNKNOWN";
+ $END
+
+
+ $IF (debug) (* -def debug *)
+ print("debug");
+ $END
+
+
+ $IF (WINDOWS)
+ $IF (CPU_X86)
+ (*windows 32*)
+
+ $ELSIF (CPU_X8664)
+ (*windows 64*)
+
+ $END
+ $ELSIF (LINUX)
+ $IF (CPU_X86)
+ (*linux 32*)
+
+ $ELSIF (CPU_X8664)
+ (*linux 64*)
+
+ $END
+ $END
\ No newline at end of file
diff --git a/programs/develop/oberon07/Docs/KOSLib.txt b/programs/develop/oberon07/doc/KOSLib.txt
similarity index 100%
rename from programs/develop/oberon07/Docs/KOSLib.txt
rename to programs/develop/oberon07/doc/KOSLib.txt
diff --git a/programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf b/programs/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf
similarity index 100%
rename from programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf
rename to programs/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf
diff --git a/programs/develop/oberon07/Docs/WinLib.txt b/programs/develop/oberon07/doc/WinLib.txt
similarity index 100%
rename from programs/develop/oberon07/Docs/WinLib.txt
rename to programs/develop/oberon07/doc/WinLib.txt
diff --git a/programs/develop/oberon07/Docs/x86.txt b/programs/develop/oberon07/doc/x86.txt
similarity index 83%
rename from programs/develop/oberon07/Docs/x86.txt
rename to programs/develop/oberon07/doc/x86.txt
index e26976fda..0fe277a8a 100644
--- a/programs/develop/oberon07/Docs/x86.txt
+++ b/programs/develop/oberon07/doc/x86.txt
@@ -25,6 +25,9 @@ UTF-8 с BOM-сигнатурой.
-stk размер стэка в мегабайтах (по умолчанию 2 Мб,
допустимо от 1 до 32 Мб)
-nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
+ -lower разрешить ключевые слова и встроенные идентификаторы в
+ нижнем регистре
+ -def <имя> задать символ условной компиляции
-ver версия программы (только для kosdll)
параметр -nochk задается в виде строки из символов:
@@ -71,6 +74,10 @@ UTF-8 с BOM-сигнатурой.
9. Добавлен синтаксис для импорта процедур из внешних библиотек
10. "Строки" можно заключать также в одиночные кавычки: 'строка'
11. Добавлен тип WCHAR
+12. Добавлена операция конкатенации строковых и символьных констант
+13. Возможен импорт модулей с указанием пути и имени файла
+14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+15. Имя процедуры в конце объявления (после END) необязательно
------------------------------------------------------------------------------
Особенности реализации
@@ -87,8 +94,8 @@ UTF-8 с BOM-сигнатурой.
BYTE 0 .. 255 1
WCHAR символ юникода (0X .. 0FFFFX) 2
-2. Максимальная длина идентификаторов - 1024 символов
-3. Максимальная длина строковых констант - 1024 символов (UTF-8)
+2. Максимальная длина идентификаторов - 255 символов
+3. Максимальная длина строковых констант - 511 символов (UTF-8)
4. Максимальная размерность открытых массивов - 5
5. Процедура NEW заполняет нулями выделенный блок памяти
6. Глобальные и локальные переменные инициализируются нулями
@@ -137,25 +144,45 @@ UTF-8 с BOM-сигнатурой.
PROCEDURE INF(): REAL
возвращает специальное вещественное значение "бесконечность"
+ PROCEDURE MOVE(Source, Dest, n: INTEGER)
+ Копирует n байт памяти из Source в Dest,
+ области Source и Dest не могут перекрываться
+
PROCEDURE GET(a: INTEGER;
VAR v: любой основной тип, PROCEDURE, POINTER)
v := Память[a]
+ PROCEDURE GET8(a: INTEGER;
+ VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+ PROCEDURE GET16(a: INTEGER;
+ VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
+
+ PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
+
PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
Память[a] := x;
Если x: BYTE или x: WCHAR, то значение x будет расширено
до 32 бит, для записи байтов использовать SYSTEM.PUT8,
для WCHAR -- SYSTEM.PUT16
- PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
+ PROCEDURE PUT8(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
Память[a] := младшие 8 бит (x)
- PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
+ PROCEDURE PUT16(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
Память[a] := младшие 16 бит (x)
- PROCEDURE MOVE(Source, Dest, n: INTEGER)
- Копирует n байт памяти из Source в Dest,
- области Source и Dest не могут перекрываться
+ PROCEDURE PUT32(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+ Память[a] := младшие 32 бит (x)
PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER)
Копирует n байт памяти из Source в Dest.
@@ -168,6 +195,8 @@ UTF-8 с BOM-сигнатурой.
например:
SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *)
+ Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не
+допускаются никакие явные операции, за исключением присваивания.
Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
@@ -176,15 +205,17 @@ UTF-8 с BOM-сигнатурой.
При объявлении процедурных типов и глобальных процедур, после ключевого
слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall],
-[ccall], [ccall16], [windows], [linux]. Например:
+[cdecl], [ccall], [windows], [linux], [oberon]. Например:
PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER;
- Если указан флаг [ccall16], то принимается соглашение ccall, но перед
+ Если указан флаг [ccall], то принимается соглашение cdecl, но перед
вызовом указатель стэка будет выравнен по границе 16 байт.
- Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall16].
+ Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall].
Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что
результат процедуры можно игнорировать (не допускается для типа REAL).
+ Если флаг не указан или указан флаг [oberon], то принимается внутреннее
+соглашение о вызове.
При объявлении типов-записей, после ключевого слова RECORD может быть
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
@@ -198,7 +229,7 @@ UTF-8 с BOM-сигнатурой.
Синтаксис оператора CASE:
CaseStatement =
- CASE Expression OF Сase {"|" Сase}
+ CASE Expression OF Case {"|" Case}
[ELSE StatementSequence] END.
Case = [CaseLabelList ":" StatementSequence].
CaseLabelList = CaseLabels {"," CaseLabels}.
@@ -226,7 +257,16 @@ ARRAY OF WCHAR допускаются все те же операции, как
ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
только тип CHAR. Для получения значения типа WCHAR, следует использовать
процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
-исходный код в кодировке UTF-8 c BOM.
+исходный код в кодировке UTF-8 с BOM.
+
+------------------------------------------------------------------------------
+ Конкатенация строковых и символьных констант
+
+ Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+ str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+ newline = 0DX + 0AX;
------------------------------------------------------------------------------
Проверка и охрана типа нулевого указателя
@@ -272,20 +312,30 @@ Oberon-реализациях выполнение такой операции
WCHR (n: INTEGER): WCHAR
Преобразование типа, аналогично CHR(n: INTEGER): CHAR
+------------------------------------------------------------------------------
+ Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+ IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+ IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
------------------------------------------------------------------------------
Импортированные процедуры
Синтаксис импорта:
- PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type;
+ PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
- callconv -- соглашение о вызове
- - "library" -- имя файла динамической библиотеки
- - "function" -- имя импортируемой процедуры
+ - library -- имя файла динамической библиотеки (строковая константа)
+ - function -- имя импортируемой процедуры (строковая константа), если
+ указана пустая строка, то имя процедуры = proc_name
например:
- PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
+ PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER);
PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN);
@@ -327,6 +377,8 @@ Oberon-реализациях выполнение такой операции
Вызов транслируется так:
Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+ Скрытые параметры необходимо учитывать при связи с внешними приложениями.
+
------------------------------------------------------------------------------
Модуль RTL
@@ -349,8 +401,11 @@ Oberon-реализациях выполнение такой операции
Разрешается экспортировать только процедуры. Для этого, процедура должна
находиться в главном модуле программы, и ее имя должно быть отмечено символом
-экспорта ("*"). KolibriOS DLL всегда экспортируют идентификаторы "version"
-(версия программы) и "lib_init" - адрес процедуры инициализации DLL:
+экспорта ("*"). Нельзя экспортировать процедуры, которые импортированы из
+других dll-библиотек.
+
+ KolibriOS DLL всегда экспортируют идентификаторы "version" (версия
+программы) и "lib_init" - адрес процедуры инициализации DLL:
PROCEDURE [stdcall] lib_init (): INTEGER
diff --git a/programs/develop/oberon07/Docs/x86_64.txt b/programs/develop/oberon07/doc/x86_64.txt
similarity index 83%
rename from programs/develop/oberon07/Docs/x86_64.txt
rename to programs/develop/oberon07/doc/x86_64.txt
index 9655412ac..c4a523f8c 100644
--- a/programs/develop/oberon07/Docs/x86_64.txt
+++ b/programs/develop/oberon07/doc/x86_64.txt
@@ -23,6 +23,9 @@ UTF-8 с BOM-сигнатурой.
-stk размер стэка в мегабайтах (по умолчанию 2 Мб,
допустимо от 1 до 32 Мб)
-nochk <"ptibcwra"> отключить проверки при выполнении
+ -lower разрешить ключевые слова и встроенные идентификаторы в
+ нижнем регистре
+ -def <имя> задать символ условной компиляции
параметр -nochk задается в виде строки из символов:
"p" - указатели
@@ -63,6 +66,10 @@ UTF-8 с BOM-сигнатурой.
9. Добавлен синтаксис для импорта процедур из внешних библиотек
10. "Строки" можно заключать также в одиночные кавычки: 'строка'
11. Добавлен тип WCHAR
+12. Добавлена операция конкатенации строковых и символьных констант
+13. Возможен импорт модулей с указанием пути и имени файла
+14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+15. Имя процедуры в конце объявления (после END) необязательно
------------------------------------------------------------------------------
Особенности реализации
@@ -79,8 +86,8 @@ UTF-8 с BOM-сигнатурой.
BYTE 0 .. 255 1
WCHAR символ юникода (0X .. 0FFFFX) 2
-2. Максимальная длина идентификаторов - 1024 символов
-3. Максимальная длина строковых констант - 1024 символов (UTF-8)
+2. Максимальная длина идентификаторов - 255 символов
+3. Максимальная длина строковых констант - 511 символов (UTF-8)
4. Максимальная размерность открытых массивов - 5
5. Процедура NEW заполняет нулями выделенный блок памяти
6. Глобальные и локальные переменные инициализируются нулями
@@ -129,29 +136,46 @@ UTF-8 с BOM-сигнатурой.
PROCEDURE INF(): REAL
возвращает специальное вещественное значение "бесконечность"
+ PROCEDURE MOVE(Source, Dest, n: INTEGER)
+ Копирует n байт памяти из Source в Dest,
+ области Source и Dest не могут перекрываться
+
PROCEDURE GET(a: INTEGER;
VAR v: любой основной тип, PROCEDURE, POINTER)
v := Память[a]
+ PROCEDURE GET8(a: INTEGER;
+ VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+ PROCEDURE GET16(a: INTEGER;
+ VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
+
+ PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
+ Эквивалентно
+ SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
+
PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
Память[a] := x;
Если x: BYTE или x: WCHAR, то значение x будет расширено
до 64 бит, для записи байтов использовать SYSTEM.PUT8,
для WCHAR -- SYSTEM.PUT16
- PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
+ PROCEDURE PUT8(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
Память[a] := младшие 8 бит (x)
- PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
+ PROCEDURE PUT16(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
Память[a] := младшие 16 бит (x)
- PROCEDURE PUT32(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
+ PROCEDURE PUT32(a: INTEGER;
+ x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
Память[a] := младшие 32 бит (x)
- PROCEDURE MOVE(Source, Dest, n: INTEGER)
- Копирует n байт памяти из Source в Dest,
- области Source и Dest не могут перекрываться
-
PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER)
Копирует n байт памяти из Source в Dest.
Эквивалентно
@@ -173,18 +197,19 @@ UTF-8 с BOM-сигнатурой.
Системные флаги
При объявлении процедурных типов и глобальных процедур, после ключевого
-слова PROCEDURE может быть указан флаг соглашения о вызове: [win64], [systemv],
-[windows], [linux].
+слова PROCEDURE может быть указан флаг соглашения о вызове:
+[win64], [systemv], [windows], [linux], [oberon], [ccall].
Например:
PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER;
Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv].
+ Флаг [ccall] - синоним для [win64] или [systemv] (зависит от целевой ОС).
Знак "-" после имени флага ([win64-], [linux-], ...) означает, что
результат процедуры можно игнорировать (не допускается для типа REAL).
- Если флаг не указан, то принимается внутреннее соглашение о вызове.
-[win64] и [systemv] используются для связи с операционной системой и внешними
-приложениями.
+ Если флаг не указан или указан флаг [oberon], то принимается внутреннее
+соглашение о вызове. [win64] и [systemv] используются для связи с
+операционной системой и внешними приложениями.
При объявлении типов-записей, после ключевого слова RECORD может быть
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
@@ -198,7 +223,7 @@ UTF-8 с BOM-сигнатурой.
Синтаксис оператора CASE:
CaseStatement =
- CASE Expression OF Сase {"|" Сase}
+ CASE Expression OF Case {"|" Case}
[ELSE StatementSequence] END.
Case = [CaseLabelList ":" StatementSequence].
CaseLabelList = CaseLabels {"," CaseLabels}.
@@ -226,7 +251,16 @@ ARRAY OF WCHAR допускаются все те же операции, как
ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
только тип CHAR. Для получения значения типа WCHAR, следует использовать
процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
-исходный код в кодировке UTF-8 c BOM.
+исходный код в кодировке UTF-8 с BOM.
+
+------------------------------------------------------------------------------
+ Конкатенация строковых и символьных констант
+
+ Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+ str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+ newline = 0DX + 0AX;
------------------------------------------------------------------------------
Проверка и охрана типа нулевого указателя
@@ -272,21 +306,32 @@ Oberon-реализациях выполнение такой операции
WCHR (n: INTEGER): WCHAR
Преобразование типа, аналогично CHR(n: INTEGER): CHAR
+------------------------------------------------------------------------------
+ Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+ IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+ IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
------------------------------------------------------------------------------
Импортированные процедуры
Синтаксис импорта:
- PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type;
+ PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
- callconv -- соглашение о вызове
- - "library" -- имя файла динамической библиотеки
- - "function" -- имя импортируемой процедуры
+ - library -- имя файла динамической библиотеки (строковая константа)
+ - function -- имя импортируемой процедуры (строковая константа), если
+ указана пустая строка, то имя процедуры = proc_name
например:
- PROCEDURE [win64, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
+ PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
+ PROCEDURE [windows, "kernel32.dll", ""] GetTickCount (): INTEGER;
В конце объявления может быть добавлено (необязательно) "END proc_name;"
@@ -301,7 +346,7 @@ Oberon-реализациях выполнение такой операции
соглашения о вызове:
VAR
- ExitProcess: PROCEDURE [win64] (code: INTEGER);
+ ExitProcess: PROCEDURE [windows] (code: INTEGER);
Для Linux, импортированные процедуры не реализованы.
@@ -321,6 +366,8 @@ Oberon-реализациях выполнение такой операции
Вызов транслируется так:
Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+ Скрытые параметры необходимо учитывать при связи с внешними приложениями.
+
------------------------------------------------------------------------------
Модуль RTL
@@ -343,4 +390,5 @@ Oberon-реализациях выполнение такой операции
Разрешается экспортировать только процедуры. Для этого, процедура должна
находиться в главном модуле программы, ее имя должно быть отмечено символом
-экспорта ("*") и должно быть указано соглашение о вызове.
\ No newline at end of file
+экспорта ("*") и должно быть указано соглашение о вызове. Нельзя
+экспортировать процедуры, которые импортированы из других dll-библиотек.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 b/programs/develop/oberon07/lib/KolibriOS/API.ob07
similarity index 94%
rename from programs/develop/oberon07/Lib/KolibriOS/API.ob07
rename to programs/develop/oberon07/lib/KolibriOS/API.ob07
index 3e1619a15..c740a95f3 100644
--- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07
+++ b/programs/develop/oberon07/lib/KolibriOS/API.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018, 2020, Anton Krotov
+ Copyright (c) 2018, 2020-2021, Anton Krotov
All rights reserved.
*)
@@ -13,6 +13,7 @@ IMPORT SYSTEM, K := KOSAPI;
CONST
eol* = 0DX + 0AX;
+ BIT_DEPTH* = 32;
MAX_SIZE = 16 * 400H;
HEAP_SIZE = 1 * 100000H;
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 b/programs/develop/oberon07/lib/KolibriOS/Args.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Args.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Args.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 b/programs/develop/oberon07/lib/KolibriOS/ColorDlg.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07
rename to programs/develop/oberon07/lib/KolibriOS/ColorDlg.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 b/programs/develop/oberon07/lib/KolibriOS/Console.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Console.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Console.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 b/programs/develop/oberon07/lib/KolibriOS/ConsoleLib.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07
rename to programs/develop/oberon07/lib/KolibriOS/ConsoleLib.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 b/programs/develop/oberon07/lib/KolibriOS/DateTime.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07
rename to programs/develop/oberon07/lib/KolibriOS/DateTime.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 b/programs/develop/oberon07/lib/KolibriOS/Debug.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Debug.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Debug.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 b/programs/develop/oberon07/lib/KolibriOS/File.ob07
similarity index 91%
rename from programs/develop/oberon07/Lib/KolibriOS/File.ob07
rename to programs/develop/oberon07/lib/KolibriOS/File.ob07
index d25a8d693..dc99a0c68 100644
--- a/programs/develop/oberon07/Lib/KolibriOS/File.ob07
+++ b/programs/develop/oberon07/lib/KolibriOS/File.ob07
@@ -1,5 +1,5 @@
(*
- Copyright 2016, 2018 Anton Krotov
+ Copyright 2016, 2018, 2021 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
@@ -91,6 +91,20 @@ BEGIN
END GetFileInfo;
+PROCEDURE FileSize* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+ Info: rFD;
+ res: INTEGER;
+BEGIN
+ IF GetFileInfo(FName, Info) THEN
+ res := Info.size
+ ELSE
+ res := -1
+ END
+ RETURN res
+END FileSize;
+
+
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
VAR
fd: rFD;
diff --git a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 b/programs/develop/oberon07/lib/KolibriOS/HOST.ob07
similarity index 92%
rename from programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
rename to programs/develop/oberon07/lib/KolibriOS/HOST.ob07
index a3280b46f..28c556100 100644
--- a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
+++ b/programs/develop/oberon07/lib/KolibriOS/HOST.ob07
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE HOST;
-IMPORT SYSTEM, K := KOSAPI, API, RTL;
+IMPORT SYSTEM, K := KOSAPI, API;
CONST
@@ -15,9 +15,9 @@ CONST
slash* = "/";
eol* = 0DX + 0AX;
- bit_depth* = RTL.bit_depth;
- maxint* = RTL.maxint;
- minint* = RTL.minint;
+ bit_depth* = API.BIT_DEPTH;
+ maxint* = ROR(-2, 1);
+ minint* = ROR(1, 1);
MAX_PARAM = 1024;
@@ -400,12 +400,9 @@ VAR
n: INTEGER;
BEGIN
- GetArg(0, path);
- n := LENGTH(path) - 1;
- WHILE path[n] # slash DO
- DEC(n)
- END;
- path[n + 1] := 0X
+ n := K.sysfunc4(30, 2, SYSTEM.ADR(path[0]), LEN(path) - 2);
+ path[n - 1] := slash;
+ path[n] := 0X
END GetCurrentDirectory;
diff --git a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 b/programs/develop/oberon07/lib/KolibriOS/In.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/In.ob07
rename to programs/develop/oberon07/lib/KolibriOS/In.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 b/programs/develop/oberon07/lib/KolibriOS/KOSAPI.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07
rename to programs/develop/oberon07/lib/KolibriOS/KOSAPI.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 b/programs/develop/oberon07/lib/KolibriOS/Math.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Math.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Math.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 b/programs/develop/oberon07/lib/KolibriOS/NetDevices.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07
rename to programs/develop/oberon07/lib/KolibriOS/NetDevices.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 b/programs/develop/oberon07/lib/KolibriOS/OpenDlg.ob07
similarity index 93%
rename from programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07
rename to programs/develop/oberon07/lib/KolibriOS/OpenDlg.ob07
index 82d6bfbc3..819d34dc7 100644
--- a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07
+++ b/programs/develop/oberon07/lib/KolibriOS/OpenDlg.ob07
@@ -1,5 +1,5 @@
(*
- Copyright 2016, 2018, 2020 Anton Krotov
+ Copyright 2016, 2018, 2020, 2021 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
@@ -19,12 +19,17 @@ MODULE OpenDlg;
IMPORT sys := SYSTEM, KOSAPI;
+CONST
+ topen* = 0;
+ tsave* = 1;
+ tdir* = 2;
+
TYPE
DRAW_WINDOW = PROCEDURE;
TDialog = RECORD
- _type,
+ _type*,
procinfo,
com_area_name,
com_area,
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 b/programs/develop/oberon07/lib/KolibriOS/Out.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Out.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Out.ob07
diff --git a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 b/programs/develop/oberon07/lib/KolibriOS/RTL.ob07
similarity index 79%
rename from programs/develop/oberon07/Lib/Linux32/RTL.ob07
rename to programs/develop/oberon07/lib/KolibriOS/RTL.ob07
index 5f9e16808..0818bca97 100644
--- a/programs/develop/oberon07/Lib/Linux32/RTL.ob07
+++ b/programs/develop/oberon07/lib/KolibriOS/RTL.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -12,12 +12,9 @@ IMPORT SYSTEM, API;
CONST
- bit_depth* = 32;
- maxint* = 7FFFFFFFH;
- minint* = 80000000H;
+ minint = ROR(1, 1);
- WORD = bit_depth DIV 8;
- MAX_SET = bit_depth - 1;
+ WORD = API.BIT_DEPTH DIV 8;
VAR
@@ -72,37 +69,63 @@ BEGIN
END _strcpy;
-PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
-VAR
- i, n, k: INTEGER;
-
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
BEGIN
- k := LEN(A) - 1;
- n := A[0];
- i := 0;
- WHILE i < k DO
- A[i] := A[i + 1];
- INC(i)
- END;
- A[k] := n
+ SYSTEM.CODE(
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *)
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *)
+ 049H, (* dec ecx *)
+ 053H, (* push ebx *)
+ 08BH, 018H, (* mov ebx, dword [eax] *)
+ (* L: *)
+ 08BH, 050H, 004H, (* mov edx, dword [eax + 4] *)
+ 089H, 010H, (* mov dword [eax], edx *)
+ 083H, 0C0H, 004H, (* add eax, 4 *)
+ 049H, (* dec ecx *)
+ 075H, 0F5H, (* jnz L *)
+ 089H, 018H, (* mov dword [eax], ebx *)
+ 05BH, (* pop ebx *)
+ 05DH, (* pop ebp *)
+ 0C2H, 008H, 000H (* ret 8 *)
+ )
END _rot;
-PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
BEGIN
- IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
- IF b > MAX_SET THEN
- b := MAX_SET
- END;
- IF a < 0 THEN
- a := 0
- END;
- a := LSR(ASR(minint, b - a), MAX_SET - b)
- ELSE
- a := 0
- END
-
- RETURN a
+ SYSTEM.CODE(
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *)
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *)
+ 039H, 0C8H, (* cmp eax, ecx *)
+ 07FH, 033H, (* jg L1 *)
+ 083H, 0F8H, 01FH, (* cmp eax, 31 *)
+ 07FH, 02EH, (* jg L1 *)
+ 085H, 0C9H, (* test ecx, ecx *)
+ 07CH, 02AH, (* jl L1 *)
+ 083H, 0F9H, 01FH, (* cmp ecx, 31 *)
+ 07EH, 005H, (* jle L3 *)
+ 0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *)
+ (* L3: *)
+ 085H, 0C0H, (* test eax, eax *)
+ 07DH, 002H, (* jge L2 *)
+ 031H, 0C0H, (* xor eax, eax *)
+ (* L2: *)
+ 089H, 0CAH, (* mov edx, ecx *)
+ 029H, 0C2H, (* sub edx, eax *)
+ 0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *)
+ 087H, 0CAH, (* xchg edx, ecx *)
+ 0D3H, 0F8H, (* sar eax, cl *)
+ 087H, 0CAH, (* xchg edx, ecx *)
+ 083H, 0E9H, 01FH, (* sub ecx, 31 *)
+ 0F7H, 0D9H, (* neg ecx *)
+ 0D3H, 0E8H, (* shr eax, cl *)
+ 05DH, (* pop ebp *)
+ 0C2H, 008H, 000H, (* ret 8 *)
+ (* L1: *)
+ 031H, 0C0H, (* xor eax, eax *)
+ 05DH, (* pop ebp *)
+ 0C2H, 008H, 000H (* ret 8 *)
+ )
END _set;
diff --git a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 b/programs/develop/oberon07/lib/KolibriOS/RasterWorks.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07
rename to programs/develop/oberon07/lib/KolibriOS/RasterWorks.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 b/programs/develop/oberon07/lib/KolibriOS/Read.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Read.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Read.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 b/programs/develop/oberon07/lib/KolibriOS/UnixTime.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07
rename to programs/develop/oberon07/lib/KolibriOS/UnixTime.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 b/programs/develop/oberon07/lib/KolibriOS/Vector.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Vector.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Vector.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 b/programs/develop/oberon07/lib/KolibriOS/Write.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/Write.ob07
rename to programs/develop/oberon07/lib/KolibriOS/Write.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 b/programs/develop/oberon07/lib/KolibriOS/kfonts.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07
rename to programs/develop/oberon07/lib/KolibriOS/kfonts.ob07
diff --git a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 b/programs/develop/oberon07/lib/KolibriOS/libimg.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/KolibriOS/libimg.ob07
rename to programs/develop/oberon07/lib/KolibriOS/libimg.ob07
diff --git a/programs/develop/oberon07/Lib/Math/CMath.ob07 b/programs/develop/oberon07/lib/Math/CMath.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/CMath.ob07
rename to programs/develop/oberon07/lib/Math/CMath.ob07
diff --git a/programs/develop/oberon07/Lib/Math/MathBits.ob07 b/programs/develop/oberon07/lib/Math/MathBits.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/MathBits.ob07
rename to programs/develop/oberon07/lib/Math/MathBits.ob07
diff --git a/programs/develop/oberon07/Lib/Math/MathRound.ob07 b/programs/develop/oberon07/lib/Math/MathRound.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/MathRound.ob07
rename to programs/develop/oberon07/lib/Math/MathRound.ob07
diff --git a/programs/develop/oberon07/Lib/Math/MathStat.ob07 b/programs/develop/oberon07/lib/Math/MathStat.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/MathStat.ob07
rename to programs/develop/oberon07/lib/Math/MathStat.ob07
diff --git a/programs/develop/oberon07/Lib/Math/Rand.ob07 b/programs/develop/oberon07/lib/Math/Rand.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/Rand.ob07
rename to programs/develop/oberon07/lib/Math/Rand.ob07
diff --git a/programs/develop/oberon07/Lib/Math/RandExt.ob07 b/programs/develop/oberon07/lib/Math/RandExt.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/Math/RandExt.ob07
rename to programs/develop/oberon07/lib/Math/RandExt.ob07
diff --git a/programs/develop/oberon07/Lib/RVM32I/FPU.ob07 b/programs/develop/oberon07/lib/RVM32I/FPU.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/RVM32I/FPU.ob07
rename to programs/develop/oberon07/lib/RVM32I/FPU.ob07
diff --git a/programs/develop/oberon07/Lib/RVM32I/HOST.ob07 b/programs/develop/oberon07/lib/RVM32I/HOST.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/RVM32I/HOST.ob07
rename to programs/develop/oberon07/lib/RVM32I/HOST.ob07
diff --git a/programs/develop/oberon07/Lib/RVM32I/Out.ob07 b/programs/develop/oberon07/lib/RVM32I/Out.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/RVM32I/Out.ob07
rename to programs/develop/oberon07/lib/RVM32I/Out.ob07
diff --git a/programs/develop/oberon07/Lib/RVM32I/RTL.ob07 b/programs/develop/oberon07/lib/RVM32I/RTL.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/RVM32I/RTL.ob07
rename to programs/develop/oberon07/lib/RVM32I/RTL.ob07
diff --git a/programs/develop/oberon07/Lib/RVM32I/Trap.ob07 b/programs/develop/oberon07/lib/RVM32I/Trap.ob07
similarity index 100%
rename from programs/develop/oberon07/Lib/RVM32I/Trap.ob07
rename to programs/develop/oberon07/lib/RVM32I/Trap.ob07
diff --git a/programs/develop/oberon07/Lib/STM32CM3/FPU.ob07 b/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07
similarity index 70%
rename from programs/develop/oberon07/Lib/STM32CM3/FPU.ob07
rename to programs/develop/oberon07/lib/RVMxI/32/FPU.ob07
index da30e4ea7..28069c4fe 100644
--- a/programs/develop/oberon07/Lib/STM32CM3/FPU.ob07
+++ b/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2020, Anton Krotov
+ Copyright (c) 2020-2021, Anton Krotov
All rights reserved.
*)
@@ -98,12 +98,12 @@ END mul2;
PROCEDURE add2 (b, a: INTEGER): INTEGER;
VAR
- ea, eb, e, d, r: INTEGER;
+ t, e, d: INTEGER;
BEGIN
- ea := (a DIV 800000H) MOD 256;
- eb := (b DIV 800000H) MOD 256;
- d := ea - eb;
+ e := (a DIV 800000H) MOD 256;
+ t := (b DIV 800000H) MOD 256;
+ d := e - t;
a := a MOD 800000H + 800000H;
b := b MOD 800000H + 800000H;
@@ -113,61 +113,56 @@ BEGIN
b := LSR(b, d)
ELSE
b := 0
- END;
- e := ea
+ END
ELSIF d < 0 THEN
IF d > -24 THEN
a := LSR(a, -d)
ELSE
a := 0
END;
- e := eb
- ELSE
- e := ea
+ e := t
END;
- r := a + b;
+ INC(a, b);
- IF r >= 1000000H THEN
- r := r DIV 2;
+ IF a >= 1000000H THEN
+ a := a DIV 2;
INC(e)
END;
IF e >= 255 THEN
e := 255;
- r := 800000H
+ a := 800000H
END
- RETURN (r - 800000H) + e * 800000H
+ RETURN (a - 800000H) + e * 800000H
END add2;
PROCEDURE sub2 (b, a: INTEGER): INTEGER;
VAR
- ea, eb, e, d, r, s: INTEGER;
+ t, e, d, s: INTEGER;
BEGIN
- ea := (a DIV 800000H) MOD 256;
- eb := (b DIV 800000H) MOD 256;
+ e := (a DIV 800000H) MOD 256;
+ t := (b DIV 800000H) MOD 256;
a := a MOD 800000H + 800000H;
b := b MOD 800000H + 800000H;
- d := ea - eb;
+ d := e - t;
IF (d > 0) OR (d = 0) & (a >= b) THEN
s := 0
ELSE
- ea := eb;
+ e := t;
d := -d;
- r := a;
+ t := a;
a := b;
- b := r;
+ b := t;
s := 80000000H
END;
- e := ea;
-
IF d > 0 THEN
IF d < 24 THEN
b := LSR(b, d)
@@ -176,32 +171,32 @@ BEGIN
END
END;
- r := a - b;
+ DEC(a, b);
- IF r = 0 THEN
+ IF a = 0 THEN
e := 0;
- r := 800000H;
+ a := 800000H;
s := 0
ELSE
- WHILE r < 800000H DO
- r := r * 2;
+ WHILE a < 800000H DO
+ a := a * 2;
DEC(e)
END
END;
IF e <= 0 THEN
e := 0;
- r := 800000H;
+ a := 800000H;
s := 0
END
- RETURN (r - 800000H) + e * 800000H + s
+ RETURN (a - 800000H) + e * 800000H + s
END sub2;
PROCEDURE zero (VAR x: INTEGER);
BEGIN
- IF BITS(x) * {23..30} = {} THEN
+ IF LSR(LSL(x, 1), 24) = 0 THEN
x := 0
END
END zero;
@@ -213,12 +208,13 @@ END isNaN;
PROCEDURE isInf (a: INTEGER): BOOLEAN;
- RETURN (a = INF) OR (a = NINF)
+ RETURN LSL(a, 1) = 0FF000000H
END isInf;
-PROCEDURE isNormal (a: INTEGER): BOOLEAN;
- RETURN (BITS(a) * {23..30} # {23..30}) & (BITS(a) * {23..30} # {})
+PROCEDURE isNormal (a, b: INTEGER): BOOLEAN;
+ RETURN (LSR(LSL(a, 1), 24) # 255) & (LSR(LSL(a, 1), 24) # 0) &
+ (LSR(LSL(b, 1), 24) # 255) & (LSR(LSL(b, 1), 24) # 0)
END isNormal;
@@ -229,16 +225,20 @@ VAR
BEGIN
zero(a); zero(b);
- IF isNormal(a) & isNormal(b) THEN
+ IF isNormal(a, b) THEN
- IF (a > 0) & (b > 0) THEN
- r := add2(b, a)
- ELSIF (a < 0) & (b < 0) THEN
- r := add2(b, a) + 80000000H
- ELSIF (a > 0) & (b < 0) THEN
- r := sub2(b, a)
- ELSIF (a < 0) & (b > 0) THEN
- r := sub2(a, b)
+ IF a > 0 THEN
+ IF b > 0 THEN
+ r := add2(b, a)
+ ELSE
+ r := sub2(b, a)
+ END
+ ELSE
+ IF b > 0 THEN
+ r := sub2(a, b)
+ ELSE
+ r := add2(b, a) + 80000000H
+ END
END
ELSIF isNaN(a) OR isNaN(b) THEN
@@ -270,16 +270,20 @@ VAR
BEGIN
zero(a); zero(b);
- IF isNormal(a) & isNormal(b) THEN
+ IF isNormal(a, b) THEN
- IF (a > 0) & (b > 0) THEN
- r := sub2(b, a)
- ELSIF (a < 0) & (b < 0) THEN
- r := sub2(a, b)
- ELSIF (a > 0) & (b < 0) THEN
- r := add2(b, a)
- ELSIF (a < 0) & (b > 0) THEN
- r := add2(b, a) + 80000000H
+ IF a > 0 THEN
+ IF b > 0 THEN
+ r := sub2(b, a)
+ ELSE
+ r := add2(b, a)
+ END
+ ELSE
+ IF b > 0 THEN
+ r := add2(b, a) + 80000000H
+ ELSE
+ r := sub2(a, b)
+ END
END
ELSIF isNaN(a) OR isNaN(b) THEN
@@ -313,11 +317,9 @@ VAR
BEGIN
zero(a); zero(b);
- IF isNormal(a) & isNormal(b) THEN
+ IF isNormal(a, b) THEN
r := mul2(b, a)
- ELSIF isNaN(a) OR isNaN(b) THEN
- r := NAN
- ELSIF (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
+ ELSIF isNaN(a) OR isNaN(b) OR (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
r := NAN
ELSIF isInf(a) OR isInf(b) THEN
r := INF + ORD(BITS(a) / BITS(b) - {0..30})
@@ -336,11 +338,9 @@ VAR
BEGIN
zero(a); zero(b);
- IF isNormal(a) & isNormal(b) THEN
+ IF isNormal(a, b) THEN
r := div2(b, a)
- ELSIF isNaN(a) OR isNaN(b) THEN
- r := NAN
- ELSIF isInf(a) & isInf(b) THEN
+ ELSIF isNaN(a) OR isNaN(b) OR isInf(a) & isInf(b) THEN
r := NAN
ELSIF isInf(a) THEN
r := INF + ORD(BITS(a) / BITS(b) - {0..30})
@@ -373,23 +373,18 @@ BEGIN
IF isNaN(a) OR isNaN(b) THEN
res := op = 1
- ELSIF (a < 0) & (b < 0) THEN
- CASE op OF
- |0: res := a = b
- |1: res := a # b
- |2: res := a > b
- |3: res := a >= b
- |4: res := a < b
- |5: res := a <= b
- END
ELSE
+ IF (a < 0) & (b < 0) THEN
+ INC(op, 6)
+ END;
+
CASE op OF
- |0: res := a = b
- |1: res := a # b
- |2: res := a < b
- |3: res := a <= b
- |4: res := a > b
- |5: res := a >= b
+ |0, 6: res := a = b
+ |1, 7: res := a # b
+ |2, 10: res := a < b
+ |3, 11: res := a <= b
+ |4, 8: res := a > b
+ |5, 9: res := a >= b
END
END
@@ -399,38 +394,38 @@ END cmp;
PROCEDURE flt* (x: INTEGER): INTEGER;
VAR
- n, y, r, s: INTEGER;
+ n, y, s: INTEGER;
BEGIN
IF x = 0 THEN
s := 0;
- r := 800000H;
+ x := 800000H;
n := -126
ELSIF x = 80000000H THEN
s := 80000000H;
- r := 800000H;
+ x := 800000H;
n := 32
ELSE
IF x < 0 THEN
- s := 80000000H
+ s := 80000000H;
+ x := -x
ELSE
s := 0
END;
n := 0;
- y := ABS(x);
- r := y;
+ y := x;
WHILE y > 0 DO
y := y DIV 2;
INC(n)
END;
IF n > 24 THEN
- r := LSR(r, n - 24)
+ x := LSR(x, n - 24)
ELSE
- r := LSL(r, 24 - n)
+ x := LSL(x, 24 - n)
END
END
- RETURN (r - 800000H) + (n + 126) * 800000H + s
+ RETURN (x - 800000H) + (n + 126) * 800000H + s
END flt;
diff --git a/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07 b/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07
new file mode 100644
index 000000000..6d3561092
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07
@@ -0,0 +1,185 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+ $IF (host_linux)
+
+ slash* = "/";
+ eol* = 0AX;
+
+ $ELSE
+
+ slash* = "\";
+ eol* = 0DX + 0AX;
+
+ $END
+
+ bit_depth* = 32;
+ maxint* = 7FFFFFFFH;
+ minint* = 80000000H;
+
+
+VAR
+
+ maxreal*: REAL;
+
+
+PROCEDURE syscall0 (fn: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall0;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall3;
+
+
+PROCEDURE syscall4 (fn, p1, p2, p3, p4: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall4;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+ code := syscall1(0, code)
+END ExitProcess;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall2(1, LEN(path), SYSTEM.ADR(path[0]))
+END GetCurrentDirectory;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+BEGIN
+ n := syscall3(2, n, LEN(s), SYSTEM.ADR(s[0]))
+END GetArg;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+ RETURN syscall4(3, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+ RETURN syscall4(4, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+ RETURN syscall2(5, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+BEGIN
+ F := syscall1(6, F)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+ RETURN syscall2(7, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall2(12, LEN(FName), SYSTEM.ADR(FName[0]))
+END chmod;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall1(8, ORD(c))
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+ RETURN syscall0(9)
+END GetTickCount;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+ RETURN syscall2(11, LEN(path), SYSTEM.ADR(path[0])) # 0
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+ RETURN syscall0(10)
+END UnixTime;
+
+
+PROCEDURE s2d (x: INTEGER; VAR h, l: INTEGER);
+VAR
+ s, e, f: INTEGER;
+BEGIN
+ s := ASR(x, 31) MOD 2;
+ f := x MOD 800000H;
+ e := (x DIV 800000H) MOD 256;
+ IF e = 255 THEN
+ e := 2047
+ ELSE
+ INC(e, 896)
+ END;
+ h := LSL(s, 31) + LSL(e, 20) + (f DIV 8);
+ l := (f MOD 8) * 20000000H
+END s2d;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+ i: INTEGER;
+BEGIN
+ SYSTEM.GET(SYSTEM.ADR(x), i)
+ RETURN i
+END d2s;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+BEGIN
+ s2d(d2s(x), b, a)
+ RETURN a
+END splitf;
+
+
+BEGIN
+ maxreal := 1.9;
+ PACK(maxreal, 127)
+END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/lib/RVMxI/32/Out.ob07 b/programs/develop/oberon07/lib/RVMxI/32/Out.ob07
new file mode 100644
index 000000000..aad7567e7
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/32/Out.ob07
@@ -0,0 +1,273 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2016, 2018, 2020, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT HOST, SYSTEM;
+
+
+PROCEDURE Char* (c: CHAR);
+BEGIN
+ HOST.OutChar(c)
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+VAR
+ i, n: INTEGER;
+
+BEGIN
+ n := LENGTH(s) - 1;
+ FOR i := 0 TO n DO
+ Char(s[i])
+ END
+END String;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+VAR
+ i, a: INTEGER;
+ str: ARRAY 12 OF CHAR;
+
+BEGIN
+ IF x = 80000000H THEN
+ COPY("-2147483648", str);
+ DEC(width, 11)
+ ELSE
+ i := 0;
+ IF x < 0 THEN
+ x := -x;
+ i := 1;
+ str[0] := "-"
+ END;
+
+ a := x;
+ REPEAT
+ INC(i);
+ a := a DIV 10
+ UNTIL a = 0;
+
+ str[i] := 0X;
+ DEC(width, i);
+
+ REPEAT
+ DEC(i);
+ str[i] := CHR(x MOD 10 + ORD("0"));
+ x := x DIV 10
+ UNTIL x = 0
+ END;
+
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ String(str)
+END Int;
+
+
+PROCEDURE Inf (x: REAL; width: INTEGER);
+VAR
+ s: ARRAY 5 OF CHAR;
+
+BEGIN
+ DEC(width, 4);
+ IF x # x THEN
+ s := " Nan"
+ ELSIF x = SYSTEM.INF() THEN
+ s := "+Inf"
+ ELSIF x = -SYSTEM.INF() THEN
+ s := "-Inf"
+ END;
+
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ String(s)
+END Inf;
+
+
+PROCEDURE Ln*;
+BEGIN
+ Char(0DX);
+ Char(0AX)
+END Ln;
+
+
+PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
+VAR
+ a, b: REAL;
+
+BEGIN
+ ASSERT(x > 0.0);
+ n := 0;
+ WHILE x < 1.0 DO
+ x := x * 10.0;
+ DEC(n)
+ END;
+
+ a := 10.0;
+ b := 1.0;
+
+ WHILE a <= x DO
+ b := a;
+ a := a * 10.0;
+ INC(n)
+ END;
+ x := x / b
+END unpk10;
+
+
+PROCEDURE _Real (x: REAL; width: INTEGER);
+VAR
+ n, k, p: INTEGER;
+
+BEGIN
+ p := MIN(MAX(width - 7, 1), 10);
+
+ width := width - p - 7;
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ IF x < 0.0 THEN
+ Char("-");
+ x := -x
+ ELSE
+ Char(20X)
+ END;
+
+ unpk10(x, n);
+
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ Char(".");
+
+ WHILE p > 0 DO
+ x := (x - FLT(k)) * 10.0;
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ DEC(p)
+ END;
+
+ Char("E");
+ IF n >= 0 THEN
+ Char("+")
+ ELSE
+ Char("-")
+ END;
+ n := ABS(n);
+ Char(CHR(n DIV 10 + 30H));
+ Char(CHR(n MOD 10 + 30H))
+END _Real;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+ IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
+ Inf(x, width)
+ ELSIF x = 0.0 THEN
+ WHILE width > 17 DO
+ Char(20X);
+ DEC(width)
+ END;
+ DEC(width, 8);
+ String(" 0.0");
+ WHILE width > 0 DO
+ Char("0");
+ DEC(width)
+ END;
+ String("E+00")
+ ELSE
+ _Real(x, width)
+ END
+END Real;
+
+
+PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
+VAR
+ n, k: INTEGER;
+ minus: BOOLEAN;
+
+BEGIN
+ minus := x < 0.0;
+ IF minus THEN
+ x := -x
+ END;
+
+ unpk10(x, n);
+
+ DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ IF minus THEN
+ Char("-")
+ ELSE
+ Char(20X)
+ END;
+
+ IF n < 0 THEN
+ INC(n);
+ Char("0");
+ Char(".");
+ WHILE (n < 0) & (p > 0) DO
+ Char("0");
+ INC(n);
+ DEC(p)
+ END
+ ELSE
+ WHILE n >= 0 DO
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ x := (x - FLT(k)) * 10.0;
+ DEC(n)
+ END;
+ Char(".")
+ END;
+
+ WHILE p > 0 DO
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ x := (x - FLT(k)) * 10.0;
+ DEC(p)
+ END
+
+END _FixReal;
+
+
+PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
+BEGIN
+ IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
+ Inf(x, width)
+ ELSIF x = 0.0 THEN
+ DEC(width, 3 + MAX(p, 0));
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+ String(" 0.");
+ WHILE p > 0 DO
+ Char("0");
+ DEC(p)
+ END
+ ELSE
+ _FixReal(x, width, p)
+ END
+END FixReal;
+
+
+PROCEDURE Open*;
+END Open;
+
+
+END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Lib/STM32CM3/RTL.ob07 b/programs/develop/oberon07/lib/RVMxI/32/RTL.ob07
similarity index 79%
rename from programs/develop/oberon07/Lib/STM32CM3/RTL.ob07
rename to programs/develop/oberon07/lib/RVMxI/32/RTL.ob07
index 255f81288..d23ad3735 100644
--- a/programs/develop/oberon07/Lib/STM32CM3/RTL.ob07
+++ b/programs/develop/oberon07/lib/RVMxI/32/RTL.ob07
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE RTL;
-IMPORT SYSTEM, F := FPU;
+IMPORT SYSTEM, F := FPU, Trap;
CONST
@@ -25,8 +25,10 @@ VAR
Heap, Types, TypesCount: INTEGER;
-PROCEDURE [code] sp (): INTEGER
- 4668H; (* mov r0, sp *)
+PROCEDURE _error* (modnum, _module, err, line: INTEGER);
+BEGIN
+ Trap.trap(modnum, _module, err, line)
+END _error;
PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
@@ -157,20 +159,14 @@ VAR
i: INTEGER;
BEGIN
- WHILE ((source MOD WORD # 0) OR (dest MOD WORD # 0)) & (bytes > 0) DO
- SYSTEM.GET(source, b);
- SYSTEM.PUT8(dest, b);
- INC(source);
- INC(dest);
- DEC(bytes)
- END;
-
- WHILE bytes >= WORD DO
- SYSTEM.GET(source, i);
- SYSTEM.PUT(dest, i);
- INC(source, WORD);
- INC(dest, WORD);
- DEC(bytes, WORD)
+ IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN
+ WHILE bytes >= WORD DO
+ SYSTEM.GET(source, i);
+ SYSTEM.PUT(dest, i);
+ INC(source, WORD);
+ INC(dest, WORD);
+ DEC(bytes, WORD)
+ END
END;
WHILE bytes > 0 DO
@@ -207,7 +203,7 @@ VAR
res: INTEGER;
BEGIN
- res := 0;
+ res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
@@ -216,6 +212,7 @@ BEGIN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
+ res := 0;
n := 0
END
END
@@ -225,13 +222,22 @@ END strncmp;
PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
- res: INTEGER;
+ res: INTEGER;
bRes: BOOLEAN;
+ c: CHAR;
BEGIN
res := strncmp(str1, str2, MIN(len1, len2));
- IF res = 0 THEN
- res := _length(len1, str1) - _length(len2, str2)
+ IF res = minint THEN
+ IF len1 > len2 THEN
+ SYSTEM.GET(str1 + len2, c);
+ res := ORD(c)
+ ELSIF len1 < len2 THEN
+ SYSTEM.GET(str2 + len1, c);
+ res := -ORD(c)
+ ELSE
+ res := 0
+ END
END;
CASE op OF
@@ -253,7 +259,7 @@ VAR
res: INTEGER;
BEGIN
- res := 0;
+ res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
@@ -261,7 +267,8 @@ BEGIN
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
- ELSIF A = WCHR(0) THEN
+ ELSIF A = 0X THEN
+ res := 0;
n := 0
END
END
@@ -271,13 +278,22 @@ END strncmpw;
PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
- res: INTEGER;
+ res: INTEGER;
bRes: BOOLEAN;
+ c: WCHAR;
BEGIN
res := strncmpw(str1, str2, MIN(len1, len2));
- IF res = 0 THEN
- res := _lengthw(len1, str1) - _lengthw(len2, str2)
+ IF res = minint THEN
+ IF len1 > len2 THEN
+ SYSTEM.GET(str1 + len2 * 2, c);
+ res := ORD(c)
+ ELSIF len1 < len2 THEN
+ SYSTEM.GET(str2 + len1 * 2, c);
+ res := -ORD(c)
+ ELSE
+ res := 0
+ END
END;
CASE op OF
@@ -316,15 +332,22 @@ END _strcpy;
PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
+VAR
+ ptr: INTEGER;
+
BEGIN
- IF Heap + size < sp() - 64 THEN
- p := Heap + WORD;
- REPEAT
- SYSTEM.PUT(Heap, t);
- INC(Heap, WORD);
- DEC(size, WORD);
- t := 0
- UNTIL size = 0
+ ptr := Heap;
+ IF ptr + size < Trap.sp() - 64 THEN
+ INC(Heap, size);
+ p := ptr + WORD;
+ SYSTEM.PUT(ptr, t);
+ INC(ptr, WORD);
+ DEC(size, WORD);
+ WHILE size > 0 DO
+ SYSTEM.PUT(ptr, 0);
+ INC(ptr, WORD);
+ DEC(size, WORD)
+ END
ELSE
p := 0
END
diff --git a/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07 b/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07
new file mode 100644
index 000000000..314860262
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07
@@ -0,0 +1,133 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE Trap;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+ SP = 4;
+
+
+PROCEDURE [code] sp* (): INTEGER
+ 22, 0, SP; (* MOV R0, SP *)
+
+
+PROCEDURE [code] syscall* (ptr: INTEGER)
+ 22, 0, SP, (* MOV R0, SP *)
+ 27, 0, 4, (* ADD R0, 4 *)
+ 9, 0, 0, (* LDW R0, R0 *)
+ 67, 0, 0; (* SYSCALL R0 *)
+
+
+PROCEDURE Char (c: CHAR);
+VAR
+ a: ARRAY 2 OF INTEGER;
+
+BEGIN
+ a[0] := 8;
+ a[1] := ORD(c);
+ syscall(SYSTEM.ADR(a[0]))
+END Char;
+
+
+PROCEDURE String (s: ARRAY OF CHAR);
+VAR
+ i: INTEGER;
+
+BEGIN
+ i := 0;
+ WHILE s[i] # 0X DO
+ Char(s[i]);
+ INC(i)
+ END
+END String;
+
+
+PROCEDURE PString (ptr: INTEGER);
+VAR
+ c: CHAR;
+
+BEGIN
+ SYSTEM.GET(ptr, c);
+ WHILE c # 0X DO
+ Char(c);
+ INC(ptr);
+ SYSTEM.GET(ptr, c)
+ END
+END PString;
+
+
+PROCEDURE Ln;
+BEGIN
+ String(0DX + 0AX)
+END Ln;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+ i, a: INTEGER;
+
+BEGIN
+ i := 0;
+ a := x;
+ REPEAT
+ INC(i);
+ a := a DIV 10
+ UNTIL a = 0;
+
+ str[i] := 0X;
+
+ REPEAT
+ DEC(i);
+ str[i] := CHR(x MOD 10 + ORD("0"));
+ x := x DIV 10
+ UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE Int (x: INTEGER);
+VAR
+ s: ARRAY 32 OF CHAR;
+
+BEGIN
+ IntToStr(x, s);
+ String(s)
+END Int;
+
+
+PROCEDURE trap* (modnum, _module, err, line: INTEGER);
+VAR
+ s: ARRAY 32 OF CHAR;
+
+BEGIN
+ CASE err OF
+ | 1: s := "assertion failure"
+ | 2: s := "NIL dereference"
+ | 3: s := "bad divisor"
+ | 4: s := "NIL procedure call"
+ | 5: s := "type guard error"
+ | 6: s := "index out of range"
+ | 7: s := "invalid CASE"
+ | 8: s := "array assignment error"
+ | 9: s := "CHR out of range"
+ |10: s := "WCHR out of range"
+ |11: s := "BYTE out of range"
+ END;
+
+ Ln;
+ String("error ("); Int(err); String("): "); String(s); Ln;
+ String("module: "); PString(_module); Ln;
+ String("line: "); Int(line); Ln;
+
+ SYSTEM.CODE(0, 0, 0) (* STOP *)
+END trap;
+
+
+END Trap.
\ No newline at end of file
diff --git a/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07 b/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07
new file mode 100644
index 000000000..ac5ba4f79
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07
@@ -0,0 +1,201 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+ $IF (host_linux)
+
+ slash* = "/";
+ eol* = 0AX;
+
+ $ELSE
+
+ slash* = "\";
+ eol* = 0DX + 0AX;
+
+ $END
+
+ bit_depth* = 64;
+ maxint* = ROR(-2, 1);
+ minint* = ROR(1, 1);
+
+
+VAR
+
+ maxreal*: REAL;
+
+
+PROCEDURE syscall0 (fn: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall0;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall3;
+
+
+PROCEDURE syscall4 (fn, p1, p2, p3, p4: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall4;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+ code := syscall1(0, code)
+END ExitProcess;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall2(1, LEN(path), SYSTEM.ADR(path[0]))
+END GetCurrentDirectory;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+BEGIN
+ n := syscall3(2, n, LEN(s), SYSTEM.ADR(s[0]))
+END GetArg;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+ RETURN syscall4(3, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+ RETURN syscall4(4, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+ RETURN syscall2(5, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+BEGIN
+ F := syscall1(6, F)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+ RETURN syscall2(7, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall2(12, LEN(FName), SYSTEM.ADR(FName[0]))
+END chmod;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+ a: INTEGER;
+BEGIN
+ a := syscall1(8, ORD(c))
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+ RETURN syscall0(9)
+END GetTickCount;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+ RETURN syscall2(11, LEN(path), SYSTEM.ADR(path[0])) # 0
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+ RETURN syscall0(10)
+END UnixTime;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+VAR
+ res: INTEGER;
+
+BEGIN
+ a := 0;
+ b := 0;
+ SYSTEM.GET32(SYSTEM.ADR(x), a);
+ SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
+ SYSTEM.GET(SYSTEM.ADR(x), res)
+ RETURN res
+END splitf;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+ h, l, s, e: INTEGER;
+
+BEGIN
+ e := splitf(x, l, h);
+
+ s := ASR(h, 31) MOD 2;
+ e := (h DIV 100000H) MOD 2048;
+ IF e <= 896 THEN
+ h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
+ REPEAT
+ h := h DIV 2;
+ INC(e)
+ UNTIL e = 897;
+ e := 896;
+ l := (h MOD 8) * 20000000H;
+ h := h DIV 8
+ ELSIF (1151 <= e) & (e < 2047) THEN
+ e := 1151;
+ h := 0;
+ l := 0
+ ELSIF e = 2047 THEN
+ e := 1151;
+ IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
+ h := 80000H;
+ l := 0
+ END
+ END;
+ DEC(e, 896)
+
+ RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
+END d2s;
+
+
+BEGIN
+ maxreal := 1.9;
+ PACK(maxreal, 1023)
+END HOST.
\ No newline at end of file
diff --git a/programs/develop/oberon07/lib/RVMxI/64/Out.ob07 b/programs/develop/oberon07/lib/RVMxI/64/Out.ob07
new file mode 100644
index 000000000..5fbf92cc2
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/64/Out.ob07
@@ -0,0 +1,288 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2016, 2018, 2020-2021 Anton Krotov
+ All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT HOST, SYSTEM;
+
+
+PROCEDURE Char* (c: CHAR);
+BEGIN
+ HOST.OutChar(c)
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+VAR
+ i, n: INTEGER;
+
+BEGIN
+ n := LENGTH(s) - 1;
+ FOR i := 0 TO n DO
+ Char(s[i])
+ END
+END String;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+VAR
+ i, a: INTEGER;
+ str: ARRAY 21 OF CHAR;
+
+BEGIN
+ IF x = ROR(1, 1) THEN
+ str := "-9223372036854775808";
+ DEC(width, 20)
+ ELSE
+ i := 0;
+ IF x < 0 THEN
+ x := -x;
+ i := 1;
+ str[0] := "-"
+ END;
+
+ a := x;
+ REPEAT
+ INC(i);
+ a := a DIV 10
+ UNTIL a = 0;
+
+ str[i] := 0X;
+ DEC(width, i);
+
+ REPEAT
+ DEC(i);
+ str[i] := CHR(x MOD 10 + ORD("0"));
+ x := x DIV 10
+ UNTIL x = 0
+ END;
+
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ String(str)
+END Int;
+
+
+PROCEDURE IsNan (x: REAL): BOOLEAN;
+CONST
+ INF = LSR(ASR(ROR(1, 1), 10), 1);
+ NINF = ASR(ASR(ROR(1, 1), 10), 1);
+
+VAR
+ a: INTEGER;
+
+BEGIN
+ SYSTEM.GET(SYSTEM.ADR(x), a)
+ RETURN (a > INF) OR (a < 0) & (a > NINF)
+END IsNan;
+
+
+PROCEDURE Inf (x: REAL; width: INTEGER);
+VAR
+ s: ARRAY 5 OF CHAR;
+
+BEGIN
+ DEC(width, 4);
+ IF IsNan(x) THEN
+ s := " Nan"
+ ELSIF x = SYSTEM.INF() THEN
+ s := "+Inf"
+ ELSIF x = -SYSTEM.INF() THEN
+ s := "-Inf"
+ END;
+
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ String(s)
+END Inf;
+
+
+PROCEDURE Ln*;
+BEGIN
+ Char(0DX);
+ Char(0AX)
+END Ln;
+
+
+PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
+VAR
+ a, b: REAL;
+
+BEGIN
+ ASSERT(x > 0.0);
+ n := 0;
+ WHILE x < 1.0 DO
+ x := x * 10.0;
+ DEC(n)
+ END;
+
+ a := 10.0;
+ b := 1.0;
+
+ WHILE a <= x DO
+ b := a;
+ a := a * 10.0;
+ INC(n)
+ END;
+ x := x / b
+END unpk10;
+
+
+PROCEDURE _Real (x: REAL; width: INTEGER);
+VAR
+ n, k, p: INTEGER;
+
+BEGIN
+ p := MIN(MAX(width - 8, 1), 15);
+
+ width := width - p - 8;
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ IF x < 0.0 THEN
+ Char("-");
+ x := -x
+ ELSE
+ Char(20X)
+ END;
+
+ unpk10(x, n);
+
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ Char(".");
+
+ WHILE p > 0 DO
+ x := (x - FLT(k)) * 10.0;
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ DEC(p)
+ END;
+
+ Char("E");
+ IF n >= 0 THEN
+ Char("+")
+ ELSE
+ Char("-")
+ END;
+ n := ABS(n);
+ Char(CHR(n DIV 100 + 30H)); n := n MOD 100;
+ Char(CHR(n DIV 10 + 30H));
+ Char(CHR(n MOD 10 + 30H))
+END _Real;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+ IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
+ Inf(x, width)
+ ELSIF x = 0.0 THEN
+ WHILE width > 23 DO
+ Char(20X);
+ DEC(width)
+ END;
+ DEC(width, 9);
+ String(" 0.0");
+ WHILE width > 0 DO
+ Char("0");
+ DEC(width)
+ END;
+ String("E+000")
+ ELSE
+ _Real(x, width)
+ END
+END Real;
+
+
+PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
+VAR
+ n, k: INTEGER;
+ minus: BOOLEAN;
+
+BEGIN
+ minus := x < 0.0;
+ IF minus THEN
+ x := -x
+ END;
+
+ unpk10(x, n);
+
+ DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+
+ IF minus THEN
+ Char("-")
+ ELSE
+ Char(20X)
+ END;
+
+ IF n < 0 THEN
+ INC(n);
+ Char("0");
+ Char(".");
+ WHILE (n < 0) & (p > 0) DO
+ Char("0");
+ INC(n);
+ DEC(p)
+ END
+ ELSE
+ WHILE n >= 0 DO
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ x := (x - FLT(k)) * 10.0;
+ DEC(n)
+ END;
+ Char(".")
+ END;
+
+ WHILE p > 0 DO
+ k := FLOOR(x);
+ Char(CHR(k + 30H));
+ x := (x - FLT(k)) * 10.0;
+ DEC(p)
+ END
+
+END _FixReal;
+
+
+PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
+BEGIN
+ IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
+ Inf(x, width)
+ ELSIF x = 0.0 THEN
+ DEC(width, 3 + MAX(p, 0));
+ WHILE width > 0 DO
+ Char(20X);
+ DEC(width)
+ END;
+ String(" 0.");
+ WHILE p > 0 DO
+ Char("0");
+ DEC(p)
+ END
+ ELSE
+ _FixReal(x, width, p)
+ END
+END FixReal;
+
+
+PROCEDURE Open*;
+END Open;
+
+
+END Out.
\ No newline at end of file
diff --git a/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07 b/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07
new file mode 100644
index 000000000..2c32d51ba
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07
@@ -0,0 +1,432 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2019-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+ bit_depth = 64;
+ maxint = ROR(-2, 1);
+ minint = ROR(1, 1);
+
+ WORD = bit_depth DIV 8;
+ MAX_SET = bit_depth - 1;
+
+
+VAR
+
+ Heap, Types, TypesCount: INTEGER;
+
+
+PROCEDURE _error* (modnum, _module, err, line: INTEGER);
+BEGIN
+ Trap.trap(modnum, _module, err, line)
+END _error;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+ Trap.syscall(SYSTEM.ADR(fn))
+ RETURN fn
+END syscall3;
+
+
+PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(100, b, a)
+END _fmul;
+
+
+PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(101, b, a)
+END _fdiv;
+
+
+PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(101, a, b)
+END _fdivi;
+
+
+PROCEDURE _fadd* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(102, b, a)
+END _fadd;
+
+
+PROCEDURE _fsub* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(103, b, a)
+END _fsub;
+
+
+PROCEDURE _fsubi* (b, a: INTEGER): INTEGER;
+ RETURN syscall2(103, a, b)
+END _fsubi;
+
+
+PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN;
+ RETURN syscall3(104, op, b, a) # 0
+END _fcmp;
+
+
+PROCEDURE _floor* (x: INTEGER): INTEGER;
+ RETURN syscall1(105, x)
+END _floor;
+
+
+PROCEDURE _flt* (x: INTEGER): INTEGER;
+ RETURN syscall1(106, x)
+END _flt;
+
+
+PROCEDURE _pack* (n: INTEGER; VAR x: SET);
+BEGIN
+ n := LSL((LSR(ORD(x), 52) MOD 2048 + n) MOD 2048, 52);
+ x := x - {52..62} + BITS(n)
+END _pack;
+
+
+PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET);
+BEGIN
+ n := LSR(ORD(x), 52) MOD 2048 - 1023;
+ x := x - {62} + {52..61}
+END _unpk;
+
+
+PROCEDURE _rot* (VAR A: ARRAY OF INTEGER);
+VAR
+ i, n, k: INTEGER;
+
+BEGIN
+ k := LEN(A) - 1;
+ n := A[0];
+ i := 0;
+ WHILE i < k DO
+ A[i] := A[i + 1];
+ INC(i)
+ END;
+ A[k] := n
+END _rot;
+
+
+PROCEDURE _set* (b, a: INTEGER): INTEGER;
+BEGIN
+ IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
+ IF b > MAX_SET THEN
+ b := MAX_SET
+ END;
+ IF a < 0 THEN
+ a := 0
+ END;
+ a := LSR(ASR(minint, b - a), MAX_SET - b)
+ ELSE
+ a := 0
+ END
+
+ RETURN a
+END _set;
+
+
+PROCEDURE _set1* (a: INTEGER): INTEGER;
+BEGIN
+ IF ASR(a, 6) = 0 THEN
+ a := LSL(1, a)
+ ELSE
+ a := 0
+ END
+ RETURN a
+END _set1;
+
+
+PROCEDURE _length* (len, str: INTEGER): INTEGER;
+VAR
+ c: CHAR;
+ res: INTEGER;
+
+BEGIN
+ res := 0;
+ REPEAT
+ SYSTEM.GET(str, c);
+ INC(str);
+ DEC(len);
+ INC(res)
+ UNTIL (len = 0) OR (c = 0X);
+
+ RETURN res - ORD(c = 0X)
+END _length;
+
+
+PROCEDURE _move* (bytes, dest, source: INTEGER);
+VAR
+ b: BYTE;
+ i: INTEGER;
+
+BEGIN
+ IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN
+ WHILE bytes >= WORD DO
+ SYSTEM.GET(source, i);
+ SYSTEM.PUT(dest, i);
+ INC(source, WORD);
+ INC(dest, WORD);
+ DEC(bytes, WORD)
+ END
+ END;
+
+ WHILE bytes > 0 DO
+ SYSTEM.GET(source, b);
+ SYSTEM.PUT8(dest, b);
+ INC(source);
+ INC(dest);
+ DEC(bytes)
+ END
+END _move;
+
+
+PROCEDURE _lengthw* (len, str: INTEGER): INTEGER;
+VAR
+ c: WCHAR;
+ res: INTEGER;
+
+BEGIN
+ res := 0;
+ REPEAT
+ SYSTEM.GET(str, c);
+ INC(str, 2);
+ DEC(len);
+ INC(res)
+ UNTIL (len = 0) OR (c = 0X);
+
+ RETURN res - ORD(c = 0X)
+END _lengthw;
+
+
+PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
+VAR
+ A, B: CHAR;
+ res: INTEGER;
+
+BEGIN
+ res := minint;
+ WHILE n > 0 DO
+ SYSTEM.GET(a, A); INC(a);
+ SYSTEM.GET(b, B); INC(b);
+ DEC(n);
+ IF A # B THEN
+ res := ORD(A) - ORD(B);
+ n := 0
+ ELSIF A = 0X THEN
+ res := 0;
+ n := 0
+ END
+ END
+ RETURN res
+END strncmp;
+
+
+PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
+VAR
+ res: INTEGER;
+ bRes: BOOLEAN;
+ c: CHAR;
+
+BEGIN
+ res := strncmp(str1, str2, MIN(len1, len2));
+ IF res = minint THEN
+ IF len1 > len2 THEN
+ SYSTEM.GET(str1 + len2, c);
+ res := ORD(c)
+ ELSIF len1 < len2 THEN
+ SYSTEM.GET(str2 + len1, c);
+ res := -ORD(c)
+ ELSE
+ res := 0
+ END
+ END;
+
+ CASE op OF
+ |0: bRes := res = 0
+ |1: bRes := res # 0
+ |2: bRes := res < 0
+ |3: bRes := res <= 0
+ |4: bRes := res > 0
+ |5: bRes := res >= 0
+ END
+
+ RETURN bRes
+END _strcmp;
+
+
+PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
+VAR
+ A, B: WCHAR;
+ res: INTEGER;
+
+BEGIN
+ res := minint;
+ WHILE n > 0 DO
+ SYSTEM.GET(a, A); INC(a, 2);
+ SYSTEM.GET(b, B); INC(b, 2);
+ DEC(n);
+ IF A # B THEN
+ res := ORD(A) - ORD(B);
+ n := 0
+ ELSIF A = 0X THEN
+ res := 0;
+ n := 0
+ END
+ END
+ RETURN res
+END strncmpw;
+
+
+PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
+VAR
+ res: INTEGER;
+ bRes: BOOLEAN;
+ c: WCHAR;
+
+BEGIN
+ res := strncmpw(str1, str2, MIN(len1, len2));
+ IF res = minint THEN
+ IF len1 > len2 THEN
+ SYSTEM.GET(str1 + len2 * 2, c);
+ res := ORD(c)
+ ELSIF len1 < len2 THEN
+ SYSTEM.GET(str2 + len1 * 2, c);
+ res := -ORD(c)
+ ELSE
+ res := 0
+ END
+ END;
+
+ CASE op OF
+ |0: bRes := res = 0
+ |1: bRes := res # 0
+ |2: bRes := res < 0
+ |3: bRes := res <= 0
+ |4: bRes := res > 0
+ |5: bRes := res >= 0
+ END
+
+ RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+ res: BOOLEAN;
+
+BEGIN
+ IF len_src > len_dst THEN
+ res := FALSE
+ ELSE
+ _move(len_src * base_size, dst, src);
+ res := TRUE
+ END
+
+ RETURN res
+END _arrcpy;
+
+
+PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+ _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
+VAR
+ ptr: INTEGER;
+
+BEGIN
+ ptr := Heap;
+ IF ptr + size < Trap.sp() - 128 THEN
+ INC(Heap, size);
+ p := ptr + WORD;
+ SYSTEM.PUT(ptr, t);
+ INC(ptr, WORD);
+ DEC(size, WORD);
+ WHILE size > 0 DO
+ SYSTEM.PUT(ptr, 0);
+ INC(ptr, WORD);
+ DEC(size, WORD)
+ END
+ ELSE
+ p := 0
+ END
+END _new;
+
+
+PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
+VAR
+ _type: INTEGER;
+
+BEGIN
+ SYSTEM.GET(p, p);
+ IF p # 0 THEN
+ SYSTEM.GET(p - WORD, _type);
+ WHILE (_type # t) & (_type # 0) DO
+ SYSTEM.GET(Types + _type * WORD, _type)
+ END
+ ELSE
+ _type := t
+ END
+
+ RETURN _type = t
+END _guard;
+
+
+PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
+VAR
+ _type: INTEGER;
+
+BEGIN
+ _type := 0;
+ IF p # 0 THEN
+ SYSTEM.GET(p - WORD, _type);
+ WHILE (_type # t) & (_type # 0) DO
+ SYSTEM.GET(Types + _type * WORD, _type)
+ END
+ END
+
+ RETURN _type = t
+END _is;
+
+
+PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+ WHILE (t1 # t0) & (t1 # 0) DO
+ SYSTEM.GET(Types + t1 * WORD, t1)
+ END
+
+ RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE _init* (tcount, heap, types: INTEGER);
+BEGIN
+ Heap := heap;
+ TypesCount := tcount;
+ Types := types
+END _init;
+
+
+END RTL.
\ No newline at end of file
diff --git a/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07 b/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07
new file mode 100644
index 000000000..a1c2fb080
--- /dev/null
+++ b/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07
@@ -0,0 +1,133 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE Trap;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+ SP = 4;
+
+
+PROCEDURE [code] sp* (): INTEGER
+ 22, 0, SP; (* MOV R0, SP *)
+
+
+PROCEDURE [code] syscall* (ptr: INTEGER)
+ 22, 0, SP, (* MOV R0, SP *)
+ 27, 0, 8, (* ADD R0, 8 *)
+ 16, 0, 0, (* LDD R0, R0 *)
+ 67, 0, 0; (* SYSCALL R0 *)
+
+
+PROCEDURE Char (c: CHAR);
+VAR
+ a: ARRAY 2 OF INTEGER;
+
+BEGIN
+ a[0] := 8;
+ a[1] := ORD(c);
+ syscall(SYSTEM.ADR(a[0]))
+END Char;
+
+
+PROCEDURE String (s: ARRAY OF CHAR);
+VAR
+ i: INTEGER;
+
+BEGIN
+ i := 0;
+ WHILE s[i] # 0X DO
+ Char(s[i]);
+ INC(i)
+ END
+END String;
+
+
+PROCEDURE PString (ptr: INTEGER);
+VAR
+ c: CHAR;
+
+BEGIN
+ SYSTEM.GET(ptr, c);
+ WHILE c # 0X DO
+ Char(c);
+ INC(ptr);
+ SYSTEM.GET(ptr, c)
+ END
+END PString;
+
+
+PROCEDURE Ln;
+BEGIN
+ String(0DX + 0AX)
+END Ln;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+ i, a: INTEGER;
+
+BEGIN
+ i := 0;
+ a := x;
+ REPEAT
+ INC(i);
+ a := a DIV 10
+ UNTIL a = 0;
+
+ str[i] := 0X;
+
+ REPEAT
+ DEC(i);
+ str[i] := CHR(x MOD 10 + ORD("0"));
+ x := x DIV 10
+ UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE Int (x: INTEGER);
+VAR
+ s: ARRAY 32 OF CHAR;
+
+BEGIN
+ IntToStr(x, s);
+ String(s)
+END Int;
+
+
+PROCEDURE trap* (modnum, _module, err, line: INTEGER);
+VAR
+ s: ARRAY 32 OF CHAR;
+
+BEGIN
+ CASE err OF
+ | 1: s := "assertion failure"
+ | 2: s := "NIL dereference"
+ | 3: s := "bad divisor"
+ | 4: s := "NIL procedure call"
+ | 5: s := "type guard error"
+ | 6: s := "index out of range"
+ | 7: s := "invalid CASE"
+ | 8: s := "array assignment error"
+ | 9: s := "CHR out of range"
+ |10: s := "WCHR out of range"
+ |11: s := "BYTE out of range"
+ END;
+
+ Ln;
+ String("error ("); Int(err); String("): "); String(s); Ln;
+ String("module: "); PString(_module); Ln;
+ String("line: "); Int(line); Ln;
+
+ SYSTEM.CODE(0, 0, 0) (* STOP *)
+END trap;
+
+
+END Trap.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Samples/KolibriOS/Dialogs.ob07 b/programs/develop/oberon07/samples/KolibriOS/Dialogs.ob07
similarity index 100%
rename from programs/develop/oberon07/Samples/KolibriOS/Dialogs.ob07
rename to programs/develop/oberon07/samples/KolibriOS/Dialogs.ob07
diff --git a/programs/develop/oberon07/Samples/KolibriOS/HW.ob07 b/programs/develop/oberon07/samples/KolibriOS/HW.ob07
similarity index 100%
rename from programs/develop/oberon07/Samples/KolibriOS/HW.ob07
rename to programs/develop/oberon07/samples/KolibriOS/HW.ob07
diff --git a/programs/develop/oberon07/Samples/KolibriOS/HW_con.ob07 b/programs/develop/oberon07/samples/KolibriOS/HW_con.ob07
similarity index 100%
rename from programs/develop/oberon07/Samples/KolibriOS/HW_con.ob07
rename to programs/develop/oberon07/samples/KolibriOS/HW_con.ob07
diff --git a/programs/develop/oberon07/Source/AMD64.ob07 b/programs/develop/oberon07/source/AMD64.ob07
similarity index 79%
rename from programs/develop/oberon07/Source/AMD64.ob07
rename to programs/develop/oberon07/source/AMD64.ob07
index 899b7e953..09d171f77 100644
--- a/programs/develop/oberon07/Source/AMD64.ob07
+++ b/programs/develop/oberon07/source/AMD64.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -272,11 +272,6 @@ PROCEDURE GetAnyReg (): INTEGER;
END GetAnyReg;
-PROCEDURE GetVarReg (offs: INTEGER): INTEGER;
- RETURN REG.GetVarReg(R, offs)
-END GetVarReg;
-
-
PROCEDURE callimp (label: INTEGER);
BEGIN
OutByte2(0FFH, 15H); (* call qword[rip + label + IMP] *)
@@ -301,14 +296,12 @@ VAR
label: INTEGER;
BEGIN
- REG.Store(R);
label := IL.codes.rtl[proc];
IF label < 0 THEN
callimp(-label)
ELSE
X86.call(label)
- END;
- REG.Restore(R)
+ END
END CallRTL;
@@ -567,142 +560,6 @@ BEGIN
END shiftrc;
-PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): IL.LOCALVAR;
-VAR
- cur: IL.LOCALVAR;
-
-BEGIN
- cur := variables.first(IL.LOCALVAR);
- WHILE (cur # NIL) & (cur.offset # offset) DO
- cur := cur.next(IL.LOCALVAR)
- END
-
- RETURN cur
-END getVar;
-
-
-PROCEDURE allocReg (cmd: COMMAND);
-VAR
- leave: BOOLEAN;
- leaf: BOOLEAN;
- cur: COMMAND;
- variables: LISTS.LIST;
- lvar, rvar: IL.LOCALVAR;
- reg: INTEGER;
- max: INTEGER;
- loop: INTEGER;
-
-BEGIN
- loop := 1;
- variables := cmd.variables;
- leave := FALSE;
- leaf := TRUE;
-
- cur := cmd.next(COMMAND);
- REPEAT
- CASE cur.opcode OF
- |IL.opLLOAD64,
- IL.opLLOAD8,
- IL.opLLOAD16,
- IL.opLLOAD32,
- IL.opLLOAD64_PARAM,
- IL.opLLOAD32_PARAM,
- IL.opLADR_SAVE,
- IL.opLADR_INC,
- IL.opLADR_DEC,
- IL.opLADR_INCB,
- IL.opLADR_DECB,
- IL.opLADR_INCL,
- IL.opLADR_EXCL,
- IL.opLADR_UNPK:
- lvar := getVar(variables, cur.param2);
- IF (lvar # NIL) & (lvar.count # -1) THEN
- INC(lvar.count, loop)
- END
-
- |IL.opLADR_SAVEC,
- IL.opLADR_INCC,
- IL.opLADR_INCCB,
- IL.opLADR_DECCB,
- IL.opLADR_INCLC,
- IL.opLADR_EXCLC:
- lvar := getVar(variables, cur.param1);
- IF (lvar # NIL) & (lvar.count # -1) THEN
- INC(lvar.count, loop)
- END
-
- |IL.opLADR:
- lvar := getVar(variables, cur.param2);
- IF (lvar # NIL) & (lvar.count # -1) THEN
- lvar.count := -1
- END
-
- |IL.opLOOP:
- INC(loop, 10)
-
- |IL.opENDLOOP:
- DEC(loop, 10)
-
- |IL.opLEAVE,
- IL.opLEAVER,
- IL.opLEAVEF:
- leave := TRUE
-
- |IL.opCALL, IL.opCALLP, IL.opCALLI,
- IL.opWIN64CALL, IL.opWIN64CALLP, IL.opWIN64CALLI,
- IL.opSYSVCALL, IL.opSYSVCALLP, IL.opSYSVCALLI,
-
- IL.opSAVES, IL.opRSET, IL.opRSETR,
- IL.opRSETL, IL.opRSET1,
- IL.opEQS .. IL.opGES,
- IL.opEQSW .. IL.opGESW,
- IL.opCOPY, IL.opMOVE, IL.opCOPYA,
- IL.opCOPYS, IL.opROT,
- IL.opNEW, IL.opDISP, IL.opISREC,
- IL.opIS, IL.opTYPEGR, IL.opTYPEGP,
- IL.opTYPEGD, IL.opCASET, IL.opDIV,
- IL.opDIVL, IL.opMOD,
- IL.opMODL, IL.opLENGTH, IL.opLENGTHW:
- leaf := FALSE
-
- |IL.opDIVR, IL.opMODR:
- leaf := UTILS.Log2(cur.param2) >= 0
-
- ELSE
-
- END;
- cur := cur.next(COMMAND)
- UNTIL leave OR ~leaf;
-
- IF leaf THEN
- REPEAT
- reg := -1;
- max := -1;
- rvar := NIL;
- lvar := variables.first(IL.LOCALVAR);
- WHILE lvar # NIL DO
- IF lvar.count > max THEN
- max := lvar.count;
- rvar := lvar
- END;
- lvar := lvar.next(IL.LOCALVAR)
- END;
-
- IF rvar # NIL THEN
- reg := REG.GetAnyVarReg(R);
- IF reg # -1 THEN
- REG.Lock(R, reg, rvar.offset, rvar.size);
- REG.Load(R, reg);
- rvar.count := -1
- END
- END
-
- UNTIL (rvar = NIL) OR (reg = -1)
- END
-
-END allocReg;
-
-
PROCEDURE GetRegA;
BEGIN
ASSERT(REG.GetReg(R, rax))
@@ -733,7 +590,7 @@ VAR
reg: BOOLEAN;
BEGIN
- ASSERT(r10 IN R.regs);
+ ASSERT(r11 IN R.regs);
n := params MOD 32;
params := params DIV 32;
s := 0;
@@ -772,8 +629,8 @@ BEGIN
END;
IF ~reg THEN
- movrm(r10, rsp, ofs);
- movmr(rsp, p, r10);
+ movrm(r11, rsp, ofs);
+ movmr(rsp, p, r11);
INC(p, 8)
END
END
@@ -828,8 +685,6 @@ VAR
float: REAL;
- regVar: BOOLEAN;
-
BEGIN
xmm := -1;
cmd := commands.first(COMMAND);
@@ -846,42 +701,34 @@ BEGIN
X86.jmp(param1)
|IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL:
- REG.Store(R);
CASE opcode OF
|IL.opCALL:
|IL.opWIN64CALL: Win64Passing(param2)
|IL.opSYSVCALL: SysVPassing(param2)
END;
- X86.call(param1);
- REG.Restore(R)
+ X86.call(param1)
|IL.opCALLP, IL.opWIN64CALLP, IL.opSYSVCALLP:
UnOp(reg1);
IF reg1 # rax THEN
- GetRegA;
- ASSERT(REG.Exchange(R, reg1, rax));
- drop
+ mov(rax, reg1)
END;
drop;
- REG.Store(R);
CASE opcode OF
|IL.opCALLP:
|IL.opWIN64CALLP: Win64Passing(param2)
|IL.opSYSVCALLP: SysVPassing(param2)
END;
OutByte2(0FFH, 0D0H); (* call rax *)
- REG.Restore(R);
ASSERT(R.top = -1)
|IL.opCALLI, IL.opWIN64CALLI, IL.opSYSVCALLI:
- REG.Store(R);
CASE opcode OF
|IL.opCALLI:
|IL.opWIN64CALLI: Win64Passing(param2)
|IL.opSYSVCALLI: SysVPassing(param2)
END;
- callimp(param1);
- REG.Restore(R)
+ callimp(param1)
|IL.opLABEL:
X86.SetLabel(param1)
@@ -978,9 +825,9 @@ BEGIN
param3 := -param3;
n := (param3 MOD 32) * 8;
param3 := param3 DIV 32;
- pop(r10);
+ pop(r11);
subrc(rsp, n);
- push(r10);
+ push(r11);
push(rbp);
mov(rbp, rsp);
@@ -996,8 +843,8 @@ BEGIN
movsdmr(rbp, i, b);
INC(b)
ELSE
- movrm(r10, rbp, n + c);
- movmr(rbp, i, r10);
+ movrm(r11, rbp, n + c);
+ movmr(rbp, i, r11);
INC(c, 8)
END
ELSE
@@ -1005,8 +852,8 @@ BEGIN
movmr(rbp, i, SystemVRegPar[a]);
INC(a)
ELSE
- movrm(r10, rbp, n + c);
- movmr(rbp, i, r10);
+ movrm(r11, rbp, n + c);
+ movmr(rbp, i, r11);
INC(c, 8)
END
END;
@@ -1028,19 +875,13 @@ BEGIN
pushc(0);
DEC(n)
END
- END;
-
- IF cmd.allocReg THEN
- allocReg(cmd)
END
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # rax THEN
- GetRegA;
- ASSERT(REG.Exchange(R, reg1, rax));
- drop
+ mov(rax, reg1)
END;
drop
END;
@@ -1059,11 +900,10 @@ BEGIN
pop(rbp);
IF param2 > 0 THEN
- OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2 *)
+ OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2*8 *)
ELSE
X86.ret
- END;
- REG.Reset(R)
+ END
|IL.opSAVES:
UnOp(reg1);
@@ -1097,31 +937,16 @@ BEGIN
|IL.opLLOAD64:
reg1 := GetAnyReg();
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- mov(reg1, reg2)
- ELSE
- movrm(reg1, rbp, param2 * 8)
- END
+ movrm(reg1, rbp, param2 * 8)
|IL.opLLOAD8,
IL.opLLOAD16:
reg1 := GetAnyReg();
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- mov(reg1, reg2)
- ELSE
- movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16)
- END
+ movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16)
|IL.opLLOAD32:
reg1 := GetAnyReg();
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- mov(reg1, reg2)
- ELSE
- movrm32(reg1, rbp, param2 * 8)
- END;
+ movrm32(reg1, rbp, param2 * 8);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32)
@@ -1490,8 +1315,8 @@ BEGIN
|IL.opNEW:
PushAll(1);
- n := param2 + 16;
- ASSERT(UTILS.Align(n, 64));
+ n := param2 + 8;
+ ASSERT(UTILS.Align(n, 8));
pushc(n);
pushc(param1);
CallRTL(IL._new)
@@ -1502,8 +1327,7 @@ BEGIN
|IL.opPUSHT:
UnOp(reg1);
- reg2 := GetAnyReg();
- movrm(reg2, reg1, -8)
+ movrm(GetAnyReg(), reg1, -8)
|IL.opISREC:
PushAll(2);
@@ -1540,11 +1364,11 @@ BEGIN
GetRegA
|IL.opCASET:
- push(r10);
- push(r10);
+ push(rcx);
+ push(rcx);
pushc(param2 * tcount);
CallRTL(IL._guardrec);
- pop(r10);
+ pop(rcx);
test(rax);
jcc(jne, param1)
@@ -1714,6 +1538,7 @@ BEGIN
END
END
ELSIF isLong(param2) THEN
+ UnOp(reg1);
addrc(reg1, param2)
END
@@ -1848,7 +1673,7 @@ BEGIN
IF param2 = 0 THEN
reg2 := rax
ELSE
- reg2 := r10
+ reg2 := rcx
END;
IF reg1 # reg2 THEN
ASSERT(REG.GetReg(R, reg2));
@@ -1874,28 +1699,44 @@ BEGIN
|IL.opCASELR:
GetRegA;
cmprc(rax, param1);
- jcc(jl, param2);
- jcc(jg, cmd.param3);
+ IF param2 = cmd.param3 THEN
+ jcc(jne, param2)
+ ELSE
+ jcc(jl, param2);
+ jcc(jg, cmd.param3)
+ END;
drop
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
+ UnOp(reg1);
+ IF reg1 # rcx THEN
+ ASSERT(REG.GetReg(R, rcx));
+ ASSERT(REG.Exchange(R, reg1, rcx));
+ drop
+ END;
+
BinOp(reg1, reg2);
- xchg(reg2, rcx);
+ ASSERT(reg2 = rcx);
Rex(reg1, 0);
OutByte(0D3H);
X86.shift(opcode, reg1 MOD 8); (* shift reg1, cl *)
- xchg(reg2, rcx);
drop
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1:
+ UnOp(reg1);
+ IF reg1 # rcx THEN
+ ASSERT(REG.GetReg(R, rcx));
+ ASSERT(REG.Exchange(R, reg1, rcx));
+ drop
+ END;
+
reg1 := GetAnyReg();
movrc(reg1, param2);
BinOp(reg1, reg2);
- xchg(reg1, rcx);
+ ASSERT(reg1 = rcx);
Rex(reg2, 0);
OutByte(0D3H);
X86.shift(opcode, reg2 MOD 8); (* shift reg2, cl *)
- xchg(reg1, rcx);
drop;
drop;
ASSERT(REG.GetReg(R, reg2))
@@ -2189,17 +2030,12 @@ BEGIN
IF opcode = IL.opLADR_UNPK THEN
n := param2 * 8;
UnOp(reg1);
- reg2 := GetVarReg(param2);
- regVar := reg2 # -1;
- IF ~regVar THEN
- reg2 := GetAnyReg();
- Rex(0, reg2);
- OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *)
- OutIntByte(n)
- END
+ reg2 := GetAnyReg();
+ Rex(0, reg2);
+ OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *)
+ OutIntByte(n)
ELSE
- BinOp(reg1, reg2);
- regVar := FALSE
+ BinOp(reg1, reg2)
END;
push(reg1);
@@ -2208,12 +2044,7 @@ BEGIN
shiftrc(shr, reg1, 53);
subrc(reg1, 1023);
- IF regVar THEN
- mov(reg2, reg1);
- reg2 := GetAnyReg()
- ELSE
- movmr(reg2, 0, reg1)
- END;
+ movmr(reg2, 0, reg1);
pop(reg2);
movrm(reg1, reg2, 0);
@@ -2243,12 +2074,7 @@ BEGIN
drop
|IL.opLLOAD64_PARAM:
- reg1 := GetVarReg(param2);
- IF reg1 # -1 THEN
- push(reg1)
- ELSE
- X86.pushm(rbp, param2 * 8)
- END
+ X86.pushm(rbp, param2 * 8)
|IL.opGLOAD64_PARAM:
OutByte2(0FFH, 35H); (* push qword[rip + param2 + BSS] *)
@@ -2272,12 +2098,7 @@ BEGIN
|IL.opLLOAD32_PARAM:
reg1 := GetAnyReg();
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- mov(reg1, reg2)
- ELSE
- movrm32(reg1, rbp, param2 * 8)
- END;
+ movrm32(reg1, rbp, param2 * 8);
shiftrc(shl, reg1, 32);
shiftrc(shr, reg1, 32);
push(reg1);
@@ -2285,20 +2106,15 @@ BEGIN
|IL.opLADR_SAVEC:
n := param1 * 8;
- reg1 := GetVarReg(param1);
- IF reg1 # -1 THEN
- movrc(reg1, param2)
+ IF isLong(param2) THEN
+ reg2 := GetAnyReg();
+ movrc(reg2, param2);
+ movmr(rbp, n, reg2);
+ drop
ELSE
- IF isLong(param2) THEN
- reg2 := GetAnyReg();
- movrc(reg2, param2);
- movmr(rbp, n, reg2);
- drop
- ELSE
- OutByte3(48H, 0C7H, 45H + long(n)); (* mov qword[rbp+n], param2 *)
- OutIntByte(n);
- OutInt(param2)
- END
+ OutByte3(48H, 0C7H, 45H + long(n)); (* mov qword[rbp+n], param2 *)
+ OutIntByte(n);
+ OutInt(param2)
END
|IL.opGADR_SAVEC:
@@ -2319,141 +2135,75 @@ BEGIN
|IL.opLADR_SAVE:
UnOp(reg1);
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- mov(reg2, reg1)
- ELSE
- movmr(rbp, param2 * 8, reg1)
- END;
+ movmr(rbp, param2 * 8, reg1);
drop
|IL.opLADR_INCC:
- reg1 := GetVarReg(param1);
IF isLong(param2) THEN
reg2 := GetAnyReg();
movrc(reg2, param2);
- IF reg1 # -1 THEN
- add(reg1, reg2)
- ELSE
- n := param1 * 8;
- Rex(0, reg2);
- OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8);
- OutIntByte(n) (* add qword[rbp+n], reg2 *)
- END;
+ n := param1 * 8;
+ Rex(0, reg2);
+ OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8);
+ OutIntByte(n); (* add qword[rbp+n], reg2 *)
drop
ELSIF ABS(param2) = 1 THEN
- IF reg1 # -1 THEN
- IF param2 = 1 THEN
- incr(reg1)
- ELSE
- decr(reg1)
- END
- ELSE
- n := param1 * 8;
- OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *)
- OutIntByte(n)
- END
+ n := param1 * 8;
+ OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *)
+ OutIntByte(n)
ELSE
- IF reg1 # -1 THEN
- addrc(reg1, param2)
- ELSE
- n := param1 * 8;
- OutByte3(48H, 81H + short(param2), 45H + long(n));
- OutIntByte(n);
- OutIntByte(param2) (* add qword[rbp+n], param2 *)
- END
+ n := param1 * 8;
+ OutByte3(48H, 81H + short(param2), 45H + long(n));
+ OutIntByte(n);
+ OutIntByte(param2) (* add qword[rbp+n], param2 *)
END
|IL.opLADR_INCCB, IL.opLADR_DECCB:
- reg1 := GetVarReg(param1);
param2 := param2 MOD 256;
- IF reg1 # -1 THEN
- IF opcode = IL.opLADR_DECCB THEN
- subrc(reg1, param2)
- ELSE
- addrc(reg1, param2)
- END;
- andrc(reg1, 255)
- ELSE
- n := param1 * 8;
- OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB));
- OutIntByte(n);
- OutByte(param2) (* add/sub byte[rbp+n], param2 *)
- END
+ n := param1 * 8;
+ OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB));
+ OutIntByte(n);
+ OutByte(param2) (* add/sub byte[rbp+n], param2 *)
|IL.opLADR_INC, IL.opLADR_DEC:
UnOp(reg1);
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- IF opcode = IL.opLADR_DEC THEN
- sub(reg2, reg1)
- ELSE
- add(reg2, reg1)
- END
- ELSE
- n := param2 * 8;
- Rex(0, reg1);
- OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
- OutIntByte(n) (* add/sub qword[rbp+n], reg1 *)
- END;
+ n := param2 * 8;
+ Rex(0, reg1);
+ OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8);
+ OutIntByte(n); (* add/sub qword[rbp+n], reg1 *)
drop
|IL.opLADR_INCB, IL.opLADR_DECB:
UnOp(reg1);
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- IF opcode = IL.opLADR_DECB THEN
- sub(reg2, reg1)
- ELSE
- add(reg2, reg1)
- END;
- andrc(reg2, 255)
- ELSE
- n := param2 * 8;
- IF reg1 >= 8 THEN
- OutByte(44H)
- END;
- OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
- OutIntByte(n) (* add/sub byte[rbp+n], reg1_8 *)
+ n := param2 * 8;
+ IF reg1 >= 8 THEN
+ OutByte(44H)
END;
+ OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8));
+ OutIntByte(n); (* add/sub byte[rbp+n], reg1_8 *)
drop
|IL.opLADR_INCL, IL.opLADR_EXCL:
UnOp(reg1);
cmprc(reg1, 64);
- reg2 := GetVarReg(param2);
- IF reg2 # -1 THEN
- OutByte2(73H, 4); (* jnb L *)
- oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *)
- ELSE
- n := param2 * 8;
- OutByte2(73H, 5 + 3 * ORD(~X86.isByte(n))); (* jnb L *)
- Rex(0, reg1);
- OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8));
- OutIntByte(n) (* bts/btr qword[rbp+n], reg1 *)
- END;
+ n := param2 * 8;
+ OutByte2(73H, 5 + 3 * ORD(~X86.isByte(n))); (* jnb L *)
+ Rex(0, reg1);
+ OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8));
+ OutIntByte(n); (* bts/btr qword[rbp+n], reg1 *)
(* L: *)
drop
|IL.opLADR_INCLC, IL.opLADR_EXCLC:
- reg1 := GetVarReg(param1);
- IF reg1 # -1 THEN
- Rex(reg1, 0);
- OutByte3(0FH, 0BAH, 0E8H); (* bts/btr reg1, param2 *)
- OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2)
- ELSE
- n := param1 * 8;
- OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *)
- OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC));
- OutIntByte(n);
- OutByte(param2)
- END
+ n := param1 * 8;
+ OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *)
+ OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC));
+ OutIntByte(n);
+ OutByte(param2)
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
- |IL.opLOOP, IL.opENDLOOP:
-
END;
cmd := cmd.next(COMMAND)
@@ -2600,30 +2350,6 @@ BEGIN
END epilog;
-PROCEDURE rload (reg, offs, size: INTEGER);
-BEGIN
- offs := offs * 8;
- CASE size OF
- |1: movzx(reg, rbp, offs, FALSE)
- |2: movzx(reg, rbp, offs, TRUE)
- |4: xor(reg, reg); movrm32(reg, rbp, offs)
- |8: movrm(reg, rbp, offs)
- END
-END rload;
-
-
-PROCEDURE rsave (reg, offs, size: INTEGER);
-BEGIN
- offs := offs * 8;
- CASE size OF
- |1: X86.movmr8(rbp, offs, reg)
- |2: X86.movmr16(rbp, offs, reg)
- |4: movmr32(rbp, offs, reg)
- |8: movmr(rbp, offs, reg)
- END
-END rsave;
-
-
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
path, modname, ext: PATHS.PATH;
@@ -2647,7 +2373,7 @@ BEGIN
PATHS.split(outname, path, modname, ext);
S.append(modname, ext);
- REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9});
+ REG.Init(R, push, pop, mov, xchg, {rax, rcx, rdx, r8, r9, r10, r11});
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 8)));
diff --git a/programs/develop/oberon07/Source/ARITH.ob07 b/programs/develop/oberon07/source/ARITH.ob07
similarity index 90%
rename from programs/develop/oberon07/Source/ARITH.ob07
rename to programs/develop/oberon07/source/ARITH.ob07
index 28b766863..d572d8b83 100644
--- a/programs/develop/oberon07/Source/ARITH.ob07
+++ b/programs/develop/oberon07/source/ARITH.ob07
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE ARITH;
-IMPORT AVLTREES, STRINGS, UTILS;
+IMPORT STRINGS, UTILS, LISTS;
CONST
@@ -31,7 +31,7 @@ TYPE
set: SET;
bool: BOOLEAN;
- string*: AVLTREES.DATA
+ string*: LISTS.ITEM
END;
@@ -158,7 +158,7 @@ BEGIN
n := -1;
i := 0;
- WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO
+ WHILE (s[i] # "H") & (s[i] # "X") & (s[i] # "h") & (s[i] # "x") & (error = 0) DO
d := digit[ORD(s[i])];
IF (n = -1) & (d # 0) THEN
@@ -176,13 +176,13 @@ BEGIN
value := UTILS.Long(value);
- IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
+ IF ((s[i] = "X") OR (s[i] = "x")) & (n # -1) & (i - n > 4) THEN
error := 3
END;
IF error = 0 THEN
v.int := value;
- IF s[i] = "X" THEN
+ IF (s[i] = "X") OR (s[i] = "x") THEN
v.typ := tCHAR;
IF ~check(v) THEN
v.typ := tWCHAR;
@@ -217,6 +217,7 @@ END opFloat2;
PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
VAR
value: REAL;
+ frac: REAL;
exp10: REAL;
i, n, d: INTEGER;
minus: BOOLEAN;
@@ -224,7 +225,8 @@ VAR
BEGIN
error := 0;
value := 0.0;
- exp10 := 10.0;
+ frac := 0.0;
+ exp10 := 1.0;
minus := FALSE;
n := 0;
@@ -240,14 +242,19 @@ BEGIN
INC(i);
WHILE (error = 0) & STRINGS.digit(s[i]) DO
- IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN
+ IF opFloat2(frac, 10.0, "*") & opFloat2(frac, FLT(digit[ORD(s[i])]), "+") THEN
+ exp10 := exp10 * 10.0;
INC(i)
ELSE
error := 4
END
END;
- IF s[i] = "E" THEN
+ IF ~opFloat2(value, frac / exp10, "+") THEN
+ error := 4
+ END;
+
+ IF (s[i] = "E") OR (s[i] = "e") THEN
INC(i)
END;
diff --git a/programs/develop/oberon07/Source/AVLTREES.ob07 b/programs/develop/oberon07/source/AVLTREES.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/AVLTREES.ob07
rename to programs/develop/oberon07/source/AVLTREES.ob07
diff --git a/programs/develop/oberon07/Source/BIN.ob07 b/programs/develop/oberon07/source/BIN.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/BIN.ob07
rename to programs/develop/oberon07/source/BIN.ob07
diff --git a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 b/programs/develop/oberon07/source/CHUNKLISTS.ob07
similarity index 70%
rename from programs/develop/oberon07/Source/CHUNKLISTS.ob07
rename to programs/develop/oberon07/source/CHUNKLISTS.ob07
index 548eaf165..4137b5a00 100644
--- a/programs/develop/oberon07/Source/CHUNKLISTS.ob07
+++ b/programs/develop/oberon07/source/CHUNKLISTS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -46,52 +46,36 @@ TYPE
PROCEDURE SetByte* (list: BYTELIST; idx: INTEGER; byte: BYTE);
VAR
- ChunkNum: INTEGER;
- chunk: BYTECHUNK;
+ chunk: BYTECHUNK;
+ item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
- ChunkNum := idx DIV LENOFBYTECHUNK;
- idx := idx MOD LENOFBYTECHUNK;
-
- chunk := list.first(BYTECHUNK);
-
- WHILE (chunk # NIL) & (ChunkNum > 0) DO
- chunk := chunk.next(BYTECHUNK);
- DEC(ChunkNum)
- END;
-
- ASSERT(chunk # NIL);
+ item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
+ ASSERT(item # NIL);
+ chunk := item(BYTECHUNK);
+ idx := idx MOD LENOFBYTECHUNK;
ASSERT(idx < chunk.count);
-
chunk.data[idx] := byte
END SetByte;
PROCEDURE GetByte* (list: BYTELIST; idx: INTEGER): BYTE;
VAR
- ChunkNum: INTEGER;
- chunk: BYTECHUNK;
+ chunk: BYTECHUNK;
+ item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
- ChunkNum := idx DIV LENOFBYTECHUNK;
- idx := idx MOD LENOFBYTECHUNK;
-
- chunk := list.first(BYTECHUNK);
-
- WHILE (chunk # NIL) & (ChunkNum > 0) DO
- chunk := chunk.next(BYTECHUNK);
- DEC(ChunkNum)
- END;
-
- ASSERT(chunk # NIL);
+ item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
+ ASSERT(item # NIL);
+ chunk := item(BYTECHUNK);
+ idx := idx MOD LENOFBYTECHUNK;
ASSERT(idx < chunk.count)
-
RETURN chunk.data[idx]
END GetByte;
@@ -187,52 +171,37 @@ END CreateByteList;
PROCEDURE SetInt* (list: INTLIST; idx: INTEGER; int: INTEGER);
VAR
- ChunkNum: INTEGER;
- chunk: INTCHUNK;
+ chunk: INTCHUNK;
+ item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
- ChunkNum := idx DIV LENOFINTCHUNK;
- idx := idx MOD LENOFINTCHUNK;
-
- chunk := list.first(INTCHUNK);
-
- WHILE (chunk # NIL) & (ChunkNum > 0) DO
- chunk := chunk.next(INTCHUNK);
- DEC(ChunkNum)
- END;
-
- ASSERT(chunk # NIL);
+ item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
+ ASSERT(item # NIL);
+ chunk := item(INTCHUNK);
+ idx := idx MOD LENOFINTCHUNK;
ASSERT(idx < chunk.count);
-
chunk.data[idx] := int
END SetInt;
PROCEDURE GetInt* (list: INTLIST; idx: INTEGER): INTEGER;
+
VAR
- ChunkNum: INTEGER;
- chunk: INTCHUNK;
+ chunk: INTCHUNK;
+ item: LISTS.ITEM;
BEGIN
ASSERT(idx >= 0);
ASSERT(list # NIL);
- ChunkNum := idx DIV LENOFINTCHUNK;
- idx := idx MOD LENOFINTCHUNK;
-
- chunk := list.first(INTCHUNK);
-
- WHILE (chunk # NIL) & (ChunkNum > 0) DO
- chunk := chunk.next(INTCHUNK);
- DEC(ChunkNum)
- END;
-
- ASSERT(chunk # NIL);
+ item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
+ ASSERT(item # NIL);
+ chunk := item(INTCHUNK);
+ idx := idx MOD LENOFINTCHUNK;
ASSERT(idx < chunk.count)
-
RETURN chunk.data[idx]
END GetInt;
diff --git a/programs/develop/oberon07/Source/COLLECTIONS.ob07 b/programs/develop/oberon07/source/COLLECTIONS.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/COLLECTIONS.ob07
rename to programs/develop/oberon07/source/COLLECTIONS.ob07
diff --git a/programs/develop/oberon07/Source/CONSOLE.ob07 b/programs/develop/oberon07/source/CONSOLE.ob07
similarity index 77%
rename from programs/develop/oberon07/Source/CONSOLE.ob07
rename to programs/develop/oberon07/source/CONSOLE.ob07
index b5916839c..f5091cca3 100644
--- a/programs/develop/oberon07/Source/CONSOLE.ob07
+++ b/programs/develop/oberon07/source/CONSOLE.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2019, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -33,16 +33,6 @@ BEGIN
END Int;
-PROCEDURE Hex* (x, n: INTEGER);
-VAR
- s: ARRAY 24 OF CHAR;
-
-BEGIN
- STRINGS.IntToHex(x, s, n);
- String(s)
-END Hex;
-
-
PROCEDURE Int2* (x: INTEGER);
BEGIN
IF x < 10 THEN
@@ -79,4 +69,10 @@ BEGIN
END Int2Ln;
+PROCEDURE Dashes*;
+BEGIN
+ StringLn("------------------------------------------------")
+END Dashes;
+
+
END CONSOLE.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/Compiler.ob07 b/programs/develop/oberon07/source/Compiler.ob07
similarity index 82%
rename from programs/develop/oberon07/Source/Compiler.ob07
rename to programs/develop/oberon07/source/Compiler.ob07
index 664c03f9a..0a30e6123 100644
--- a/programs/develop/oberon07/Source/Compiler.ob07
+++ b/programs/develop/oberon07/source/Compiler.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -11,6 +11,15 @@ IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE,
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN;
+CONST
+
+ DEF_WINDOWS = "WINDOWS";
+ DEF_LINUX = "LINUX";
+ DEF_KOLIBRIOS = "KOLIBRIOS";
+ DEF_CPU_X86 = "CPU_X86";
+ DEF_CPU_X8664 = "CPU_X8664";
+
+
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
VAR
param: PARS.PATH;
@@ -94,6 +103,8 @@ BEGIN
EXCL(checking, ST.chkCHR);
EXCL(checking, ST.chkWCHR);
EXCL(checking, ST.chkBYTE)
+ ELSIF param[j] = "s" THEN
+ EXCL(checking, ST.chkSTK)
ELSIF param[j] = "a" THEN
checking := {}
END;
@@ -177,14 +188,23 @@ BEGIN
options.checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path);
- lib_path := app_path;
+
+ UTILS.GetArg(0, temp);
+ PATHS.split(temp, path, modname, ext);
+ IF PATHS.isRelative(path) THEN
+ PATHS.RelPath(app_path, path, temp);
+ path := temp
+ END;
+ lib_path := path;
UTILS.GetArg(1, inname);
+ STRINGS.replace(inname, "\", UTILS.slash);
+ STRINGS.replace(inname, "/", UTILS.slash);
C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
- C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
- C.StringLn("Copyright (c) 2018-2020, Anton Krotov");
+ C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date);
+ C.StringLn("Copyright (c) 2018-2021, Anton Krotov");
IF inname = "" THEN
C.Ln;
@@ -220,7 +240,7 @@ BEGIN
UTILS.Exit(0)
END;
- C.StringLn("--------------------------------------------");
+ C.Dashes;
PATHS.split(inname, path, modname, ext);
IF ext # UTILS.FILE_EXT THEN
@@ -245,14 +265,14 @@ BEGIN
ERRORS.Error(206)
END;
- IF target = TARGETS.MSP430 THEN
+ IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
options.ram := MSP430.minRAM;
options.rom := MSP430.minROM
END;
- IF target = TARGETS.STM32CM3 THEN
- options.ram := THUMB.STM32_minRAM;
- options.rom := THUMB.STM32_minROM
+ IF (TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE) THEN
+ options.ram := THUMB.minRAM;
+ options.rom := THUMB.minROM
END;
IF UTILS.bit_depth < TARGETS.BitDepth THEN
@@ -278,10 +298,28 @@ BEGIN
PARS.init(options);
+ CASE TARGETS.OS OF
+ |TARGETS.osNONE:
+ |TARGETS.osWIN32,
+ TARGETS.osWIN64: SCAN.NewDef(DEF_WINDOWS)
+ |TARGETS.osLINUX32,
+ TARGETS.osLINUX64: SCAN.NewDef(DEF_LINUX)
+ |TARGETS.osKOS: SCAN.NewDef(DEF_KOLIBRIOS)
+ END;
+
+ CASE TARGETS.CPU OF
+ |TARGETS.cpuX86: SCAN.NewDef(DEF_CPU_X86)
+ |TARGETS.cpuAMD64: SCAN.NewDef(DEF_CPU_X8664)
+ |TARGETS.cpuMSP430:
+ |TARGETS.cpuTHUMB:
+ |TARGETS.cpuRVM32I:
+ |TARGETS.cpuRVM64I:
+ END;
+
ST.compile(path, lib_path, modname, outname, target, options);
time := UTILS.GetTickCount() - UTILS.time;
- C.StringLn("--------------------------------------------");
+ C.Dashes;
C.Int(PARS.lines); C.String(" lines, ");
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");
C.Int(WRITER.counter); C.StringLn(" bytes");
diff --git a/programs/develop/oberon07/Source/ELF.ob07 b/programs/develop/oberon07/source/ELF.ob07
similarity index 91%
rename from programs/develop/oberon07/Source/ELF.ob07
rename to programs/develop/oberon07/source/ELF.ob07
index 87c688ec6..b62c6d0a1 100644
--- a/programs/develop/oberon07/Source/ELF.ob07
+++ b/programs/develop/oberon07/source/ELF.ob07
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE ELF;
-IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS;
+IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS, STRINGS;
CONST
@@ -155,25 +155,6 @@ BEGIN
END NewSym;
-PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
-VAR
- i, h: INTEGER;
- g: SET;
-
-BEGIN
- h := 0;
- i := 0;
- WHILE name[i] # 0X DO
- h := h * 16 + ORD(name[i]);
- g := BITS(h) * {28..31};
- h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
- INC(i)
- END
-
- RETURN h
-END HashStr;
-
-
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
VAR
symi, hi, k: INTEGER;
@@ -329,18 +310,18 @@ BEGIN
hashtab := CHL.CreateIntList();
- CHL.PushInt(hashtab, HashStr(""));
+ CHL.PushInt(hashtab, STRINGS.HashStr(""));
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
- CHL.PushInt(hashtab, HashStr("dlopen"));
+ CHL.PushInt(hashtab, STRINGS.HashStr("dlopen"));
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
- CHL.PushInt(hashtab, HashStr("dlsym"));
+ CHL.PushInt(hashtab, STRINGS.HashStr("dlsym"));
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
IF so THEN
item := program.exp_list.first;
WHILE item # NIL DO
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
- CHL.PushInt(hashtab, HashStr(Name));
+ CHL.PushInt(hashtab, STRINGS.HashStr(Name));
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
item := item.next
END;
@@ -575,7 +556,7 @@ BEGIN
WR.Write32LE(00000201H)
END;
-
+
WR.Write32LE(symCount);
WR.Write32LE(symCount);
@@ -588,14 +569,14 @@ BEGIN
END;
CHL.WriteToFile(strtab);
-
+
IF amd64 THEN
WR.Write64LE(0);
WR.Write64LE(0)
ELSE
WR.Write32LE(0);
- WR.Write32LE(0)
- END;
+ WR.Write32LE(0)
+ END;
CHL.WriteToFile(program.code);
WHILE pad > 0 DO
diff --git a/programs/develop/oberon07/Source/ERRORS.ob07 b/programs/develop/oberon07/source/ERRORS.ob07
similarity index 95%
rename from programs/develop/oberon07/Source/ERRORS.ob07
rename to programs/develop/oberon07/source/ERRORS.ob07
index 872b2ef29..c9056bdb2 100644
--- a/programs/develop/oberon07/Source/ERRORS.ob07
+++ b/programs/develop/oberon07/source/ERRORS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -25,6 +25,7 @@ BEGIN
CASE warning OF
|0: C.StringLn("passing a string value as a fixed array")
|1: C.StringLn("endless FOR loop")
+ |2: C.StringLn("identifier too long")
END
END WarningMsg;
@@ -43,7 +44,7 @@ BEGIN
| 3: str := "unclosed string"
| 4: str := "illegal character"
| 5: str := "string too long"
- | 6: str := "identifier too long"
+
| 7: str := "number too long"
| 8..12: str := "number too large"
| 13: str := "real numbers not supported"
diff --git a/programs/develop/oberon07/Source/FILES.ob07 b/programs/develop/oberon07/source/FILES.ob07
similarity index 87%
rename from programs/develop/oberon07/Source/FILES.ob07
rename to programs/develop/oberon07/source/FILES.ob07
index 07c906bc0..d1bbde9cb 100644
--- a/programs/develop/oberon07/Source/FILES.ob07
+++ b/programs/develop/oberon07/source/FILES.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -154,27 +154,24 @@ END read;
PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
VAR
- free, n, k, res, idx: INTEGER;
+ free, n, idx: INTEGER;
BEGIN
idx := 0;
- res := 0;
IF (file # NIL) & (file.count >= 0) THEN
free := LEN(file.buffer) - file.count;
WHILE bytes > 0 DO
n := MIN(free, bytes);
copy(chunk, idx, file.buffer, file.count, n);
- INC(res, n);
DEC(free, n);
DEC(bytes, n);
INC(idx, n);
INC(file.count, n);
IF free = 0 THEN
- k := flush(file);
- IF k # LEN(file.buffer) THEN
+ IF flush(file) # LEN(file.buffer) THEN
bytes := 0;
- DEC(res, n)
+ DEC(idx, n)
ELSE
file.count := 0;
free := LEN(file.buffer)
@@ -184,7 +181,7 @@ BEGIN
END
- RETURN res
+ RETURN idx
END write;
diff --git a/programs/develop/oberon07/Source/HEX.ob07 b/programs/develop/oberon07/source/HEX.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/HEX.ob07
rename to programs/develop/oberon07/source/HEX.ob07
diff --git a/programs/develop/oberon07/Source/IL.ob07 b/programs/develop/oberon07/source/IL.ob07
similarity index 91%
rename from programs/develop/oberon07/Source/IL.ob07
rename to programs/develop/oberon07/source/IL.ob07
index cd1cd43bf..e7033b37b 100644
--- a/programs/develop/oberon07/Source/IL.ob07
+++ b/programs/develop/oberon07/source/IL.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -16,6 +16,8 @@ CONST
call_win64* = 1;
call_sysv* = 2;
+ begin_loop* = 1; end_loop* = 2;
+
opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5;
opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
@@ -44,7 +46,7 @@ CONST
opCASEL* = 83; opCASER* = 84; opCASELR* = 85;
opPOPSP* = 86;
- opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91;
+ opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opAND* = 90; opOR* = 91;
opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97;
opPUSHC* = 98; opSWITCH* = 99;
@@ -79,7 +81,6 @@ CONST
opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215;
opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219;
- opAND* = 220; opOR* = 221;
opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4;
@@ -132,21 +133,13 @@ CONST
TYPE
- LOCALVAR* = POINTER TO RECORD (LISTS.ITEM)
-
- offset*, size*, count*: INTEGER
-
- END;
-
COMMAND* = POINTER TO RECORD (LISTS.ITEM)
opcode*: INTEGER;
param1*: INTEGER;
param2*: INTEGER;
param3*: INTEGER;
- float*: REAL;
- variables*: LISTS.LIST;
- allocReg*: BOOLEAN
+ float*: REAL
END;
@@ -166,13 +159,13 @@ TYPE
EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM)
label*: INTEGER;
- name*: SCAN.LEXSTR
+ name*: SCAN.IDSTR
END;
IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM)
- name*: SCAN.LEXSTR;
+ name*: SCAN.TEXTSTR;
procs*: LISTS.LIST
END;
@@ -181,7 +174,7 @@ TYPE
label*: INTEGER;
lib*: IMPORT_LIB;
- name*: SCAN.LEXSTR;
+ name*: SCAN.TEXTSTR;
count: INTEGER
END;
@@ -215,7 +208,7 @@ VAR
codes*: CODES;
CPU: INTEGER;
- commands, variables: C.COLLECTION;
+ commands: C.COLLECTION;
PROCEDURE set_dmin* (value: INTEGER);
@@ -247,33 +240,12 @@ BEGIN
NEW(cmd)
ELSE
cmd := citem(COMMAND)
- END;
-
- cmd.allocReg := FALSE
+ END
RETURN cmd
END NewCmd;
-PROCEDURE NewVar* (): LOCALVAR;
-VAR
- lvar: LOCALVAR;
- citem: C.ITEM;
-
-BEGIN
- citem := C.pop(variables);
- IF citem = NIL THEN
- NEW(lvar)
- ELSE
- lvar := citem(LOCALVAR)
- END;
-
- lvar.count := 0
-
- RETURN lvar
-END NewVar;
-
-
PROCEDURE setlast* (cmd: COMMAND);
BEGIN
codes.last := cmd
@@ -493,14 +465,32 @@ BEGIN
set(cur, opGADR_SAVEC, param2)
ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
- cur.param2 := param2 * cur.param2
+ cur.param2 := cur.param2 * param2
ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
- cur.param2 := param2 + cur.param2
+ INC(cur.param2, param2)
ELSE
old_opcode := -1
END
+
+ ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
+
+ old_opcode := cur.opcode;
+ param2 := nov.param2;
+
+ IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN
+ cur.opcode := opLADR_SAVE
+ ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN
+ set(cur, opLADR_INCC, param2)
+ ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN
+ cur.param2 := cur.param2 * param2
+ ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN
+ INC(cur.param2, param2)
+ ELSE
+ old_opcode := -1
+ END
+
ELSE
old_opcode := -1
END;
@@ -583,23 +573,8 @@ BEGIN
END AddCmd0;
-PROCEDURE deleteVarList (list: LISTS.LIST);
-VAR
- last: LISTS.ITEM;
-
-BEGIN
- WHILE list.last # NIL DO
- last := LISTS.pop(list);
- C.push(variables, last)
- END
-END deleteVarList;
-
-
PROCEDURE delete (cmd: COMMAND);
BEGIN
- IF cmd.variables # NIL THEN
- deleteVarList(cmd.variables)
- END;
LISTS.delete(codes.commands, cmd);
C.push(commands, cmd)
END delete;
@@ -626,7 +601,7 @@ BEGIN
END delete2;
-PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER);
+PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER);
VAR
prev: COMMAND;
not: BOOLEAN;
@@ -649,7 +624,7 @@ BEGIN
IF not THEN
delete(prev)
END
-END AddJmpCmd;
+END Jmp;
PROCEDURE AndOrOpt* (VAR label: INTEGER);
@@ -706,16 +681,16 @@ BEGIN
END;
IF jz THEN
- AddJmpCmd(opJZ, label)
+ Jmp(opJZ, label)
ELSE
- AddJmpCmd(opJNZ, label)
+ Jmp(opJNZ, label)
END;
IF op = opOR THEN
SetLabel(l)
END
ELSE
- AddJmpCmd(opJZ, label)
+ Jmp(opJZ, label)
END;
setlast(codes.last)
@@ -734,7 +709,7 @@ VAR
BEGIN
AddCmd(op, t);
label := NewLabel();
- AddJmpCmd(opJNZ, label);
+ Jmp(opJNZ, label);
OnError(line, error);
SetLabel(label)
END TypeGuard;
@@ -789,7 +764,6 @@ BEGIN
cmd.opcode := opENTER;
cmd.param1 := label;
cmd.param3 := params;
- cmd.allocReg := TRUE;
insert(codes.last, cmd)
RETURN codes.last
@@ -829,9 +803,9 @@ END LeaveC;
PROCEDURE Call* (proc, callconv, fparams: INTEGER);
BEGIN
CASE callconv OF
- |call_stack: AddJmpCmd(opCALL, proc)
- |call_win64: AddJmpCmd(opWIN64CALL, proc)
- |call_sysv: AddJmpCmd(opSYSVCALL, proc)
+ |call_stack: Jmp(opCALL, proc)
+ |call_win64: Jmp(opWIN64CALL, proc)
+ |call_sysv: Jmp(opSYSVCALL, proc)
END;
codes.last(COMMAND).param2 := fparams
END Call;
@@ -840,9 +814,9 @@ END Call;
PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER);
BEGIN
CASE callconv OF
- |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label)
- |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label)
- |call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label)
+ |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label)
+ |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label)
+ |call_sysv: Jmp(opSYSVCALLI, proc(IMPORT_PROC).label)
END;
codes.last(COMMAND).param2 := fparams
END CallImp;
@@ -860,34 +834,34 @@ END CallP;
PROCEDURE AssignProc* (proc: INTEGER);
BEGIN
- AddJmpCmd(opSAVEP, proc)
+ Jmp(opSAVEP, proc)
END AssignProc;
PROCEDURE AssignImpProc* (proc: LISTS.ITEM);
BEGIN
- AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label)
+ Jmp(opSAVEIP, proc(IMPORT_PROC).label)
END AssignImpProc;
PROCEDURE PushProc* (proc: INTEGER);
BEGIN
- AddJmpCmd(opPUSHP, proc)
+ Jmp(opPUSHP, proc)
END PushProc;
PROCEDURE PushImpProc* (proc: LISTS.ITEM);
BEGIN
- AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label)
+ Jmp(opPUSHIP, proc(IMPORT_PROC).label)
END PushImpProc;
PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN);
BEGIN
IF eq THEN
- AddJmpCmd(opEQP, proc)
+ Jmp(opEQP, proc)
ELSE
- AddJmpCmd(opNEP, proc)
+ Jmp(opNEP, proc)
END
END ProcCmp;
@@ -895,9 +869,9 @@ END ProcCmp;
PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN);
BEGIN
IF eq THEN
- AddJmpCmd(opEQIP, proc(IMPORT_PROC).label)
+ Jmp(opEQIP, proc(IMPORT_PROC).label)
ELSE
- AddJmpCmd(opNEIP, proc(IMPORT_PROC).label)
+ Jmp(opNEIP, proc(IMPORT_PROC).label)
END
END ProcImpCmp;
@@ -1089,7 +1063,7 @@ BEGIN
END fname;
-PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR);
+PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR);
VAR
exp: EXPORT_PROC;
@@ -1101,7 +1075,7 @@ BEGIN
END AddExp;
-PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC;
+PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC;
VAR
lib: IMPORT_LIB;
p: IMPORT_PROC;
@@ -1162,7 +1136,6 @@ VAR
BEGIN
commands := C.create();
- variables := C.create();
CPU := pCPU;
diff --git a/programs/develop/oberon07/Source/KOS.ob07 b/programs/develop/oberon07/source/KOS.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/KOS.ob07
rename to programs/develop/oberon07/source/KOS.ob07
diff --git a/programs/develop/oberon07/Source/LISTS.ob07 b/programs/develop/oberon07/source/LISTS.ob07
similarity index 81%
rename from programs/develop/oberon07/Source/LISTS.ob07
rename to programs/develop/oberon07/source/LISTS.ob07
index 4cb60d21e..f57e3fd6f 100644
--- a/programs/develop/oberon07/Source/LISTS.ob07
+++ b/programs/develop/oberon07/source/LISTS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -126,20 +126,23 @@ BEGIN
prev := item.prev;
next := item.next;
- IF (next # NIL) & (prev # NIL) THEN
- prev.next := next;
- next.prev := prev
- ELSIF (next = NIL) & (prev = NIL) THEN
- list.first := NIL;
- list.last := NIL
- ELSIF (next = NIL) & (prev # NIL) THEN
- prev.next := NIL;
- list.last := prev
- ELSIF (next # NIL) & (prev = NIL) THEN
- next.prev := NIL;
- list.first := next
+ IF next # NIL THEN
+ IF prev # NIL THEN
+ prev.next := next;
+ next.prev := prev
+ ELSE
+ next.prev := NIL;
+ list.first := next
+ END
+ ELSE
+ IF prev # NIL THEN
+ prev.next := NIL;
+ list.last := prev
+ ELSE
+ list.first := NIL;
+ list.last := NIL
+ END
END
-
END delete;
diff --git a/programs/develop/oberon07/Source/MSCOFF.ob07 b/programs/develop/oberon07/source/MSCOFF.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/MSCOFF.ob07
rename to programs/develop/oberon07/source/MSCOFF.ob07
diff --git a/programs/develop/oberon07/Source/MSP430.ob07 b/programs/develop/oberon07/source/MSP430.ob07
similarity index 90%
rename from programs/develop/oberon07/Source/MSP430.ob07
rename to programs/develop/oberon07/source/MSP430.ob07
index 8a37320bf..9df92b619 100644
--- a/programs/develop/oberon07/Source/MSP430.ob07
+++ b/programs/develop/oberon07/source/MSP430.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
@@ -13,10 +13,12 @@ IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX,
CONST
+ chkSTK* = 6;
+
minRAM* = 128; maxRAM* = 2048;
minROM* = 2048; maxROM* = 24576;
- minStackSize = 64;
+ StkReserve = RTL.StkReserve;
IntVectorSize* = RTL.IntVectorSize;
@@ -24,7 +26,7 @@ CONST
R4 = 4; R5 = 5; R6 = 6; R7 = 7;
- HP = 14; IR = 15;
+ HP = RTL.HP;
ACC = R4;
@@ -108,7 +110,12 @@ VAR
IdxWords: RECORD src, dst: INTEGER END;
- StkCnt: INTEGER;
+ StkCnt, MaxStkCnt: INTEGER;
+
+
+PROCEDURE CheckProcDataSize* (VarSize, RamSize: INTEGER): BOOLEAN;
+ RETURN (VarSize + 1) * 2 + StkReserve + RTL.VarSize < RamSize
+END CheckProcDataSize;
PROCEDURE EmitLabel (L: INTEGER);
@@ -163,6 +170,13 @@ BEGIN
END EmitCall;
+PROCEDURE IncStk;
+BEGIN
+ INC(StkCnt);
+ MaxStkCnt := MAX(StkCnt, MaxStkCnt)
+END IncStk;
+
+
PROCEDURE bw (b: BOOLEAN): INTEGER;
RETURN BW * ORD(b)
END bw;
@@ -266,7 +280,7 @@ BEGIN
Op1(opPUSH, PC, sINCR);
EmitWord(imm)
END;
- INC(StkCnt)
+ IncStk
END PushImm;
@@ -389,7 +403,7 @@ END Fixup;
PROCEDURE Push (reg: INTEGER);
BEGIN
Op1(opPUSH, reg, sREG);
- INC(StkCnt)
+ IncStk
END Push;
@@ -440,6 +454,8 @@ END Reloc;
PROCEDURE CallRTL (proc, params: INTEGER);
BEGIN
+ IncStk;
+ DEC(StkCnt);
EmitCall(RTL.rtl[proc].label);
RTL.Used(proc);
IF params > 0 THEN
@@ -611,7 +627,7 @@ PROCEDURE LocalSrc (offset: INTEGER): INTEGER;
END LocalSrc;
-PROCEDURE translate;
+PROCEDURE translate (chk_stk: BOOLEAN);
VAR
cmd, next: COMMAND;
@@ -621,6 +637,8 @@ VAR
cc: INTEGER;
+ word: WORD;
+
BEGIN
cmd := IL.codes.commands.first(COMMAND);
@@ -636,9 +654,13 @@ BEGIN
EmitJmp(opJMP, param1)
|IL.opCALL:
+ IncStk;
+ DEC(StkCnt);
EmitCall(param1)
|IL.opCALLP:
+ IncStk;
+ DEC(StkCnt);
UnOp(reg1);
Op1(opCALL, reg1, sREG);
drop;
@@ -652,7 +674,7 @@ BEGIN
|IL.opSADR_PARAM:
Op1(opPUSH, PC, sINCR);
- INC(StkCnt);
+ IncStk;
EmitWord(param2);
Reloc(RDATA)
@@ -663,8 +685,10 @@ BEGIN
PushImm(param2)
|IL.opONERR:
- PushImm(param2);
DEC(StkCnt);
+ EmitWord(0C232H); (* BIC #8, SR; DINT *)
+ EmitWord(4303H); (* MOV R3, R3; NOP *)
+ PushImm(param2);
EmitJmp(opJMP, param1)
|IL.opLEAVEC:
@@ -672,8 +696,25 @@ BEGIN
|IL.opENTER:
ASSERT(R.top = -1);
- StkCnt := 0;
EmitLabel(param1);
+ n := param2 MOD 65536;
+ param2 := param2 DIV 65536;
+ StkCnt := 0;
+ IF chk_stk THEN
+ L := NewLabel();
+ Op2(opMOV, SP * 256, R4);
+ Op2(opSUB, HP * 256, R4);
+ Op2(opCMP, imm(StkReserve), R4);
+ word := CodeList.last(WORD);
+ jcc(jge, L);
+ DEC(StkCnt);
+ EmitWord(0C232H); (* BIC #8, SR; DINT *)
+ EmitWord(4303H); (* MOV R3, R3; NOP *)
+ PushImm(n);
+ EmitJmp(opJMP, cmd.param3);
+ EmitLabel(L)
+ END;
+
IF param2 > 8 THEN
Op2(opMOV, imm(param2), R4);
L := NewLabel();
@@ -681,26 +722,28 @@ BEGIN
Push(CG);
Op2(opSUB, imm(1), R4);
jcc(jne, L)
- ELSIF param2 > 0 THEN
- WHILE param2 > 0 DO
- Push(CG);
- DEC(param2)
+ ELSE
+ FOR n := 1 TO param2 DO
+ Push(CG)
END
- END
+ END;
+ StkCnt := param2;
+ MaxStkCnt := StkCnt
|IL.opLEAVE, IL.opLEAVER:
ASSERT(param2 = 0);
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # ACC THEN
- GetRegA;
- ASSERT(REG.Exchange(R, reg1, ACC));
- drop
+ mov(ACC, reg1)
END;
drop
END;
ASSERT(R.top = -1);
ASSERT(StkCnt = param1);
+ IF chk_stk THEN
+ INC(word.val, MaxStkCnt * 2)
+ END;
IF param1 > 0 THEN
Op2(opADD, imm(param1 * 2), SP)
END;
@@ -930,9 +973,6 @@ BEGIN
Test(reg1);
setcc(jne, reg1)
- |IL.opLOOP:
- |IL.opENDLOOP:
-
|IL.opGET:
BinOp(reg1, reg2);
drop;
@@ -1036,7 +1076,7 @@ BEGIN
UnOp(reg1);
PushAll(0);
Op1(opPUSH, reg1, sIDX);
- INC(StkCnt);
+ IncStk;
EmitWord(-2);
PushImm(param2);
CallRTL(RTL._guardrec, 2);
@@ -1144,8 +1184,12 @@ BEGIN
|IL.opCASELR:
Op2(opCMP, imm(param1), ACC);
- jcc(jl, param2);
- jcc(jg, cmd.param3)
+ IF param2 = cmd.param3 THEN
+ jcc(jne, param2)
+ ELSE
+ jcc(jl, param2);
+ jcc(jg, cmd.param3)
+ END
|IL.opSBOOL:
BinOp(reg2, reg1);
@@ -1351,7 +1395,7 @@ BEGIN
UnOp(reg1);
PushAll_1;
Op1(opPUSH, PC, sINCR);
- INC(StkCnt);
+ IncStk;
EmitWord(param2);
Reloc(RDATA);
Push(reg1);
@@ -1534,12 +1578,12 @@ BEGIN
END translate;
-PROCEDURE prolog (ramSize: INTEGER);
+PROCEDURE prolog;
VAR
i: INTEGER;
BEGIN
- RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize);
+ RTL.Init(EmitLabel, EmitWord, EmitCall);
FOR i := 0 TO LEN(RTL.rtl) - 1 DO
RTL.Set(i, NewLabel())
END;
@@ -1551,14 +1595,14 @@ BEGIN
Op2(opMOV, incr(PC), HP);
EmitWord(0);
Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *)
- Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR));
- Op2(opMOV, imm(0), dst_x(RTL.trap, SR))
+ Op2(opMOV, imm(RTL.empty_proc), dst_x(0, SP));
+ Op2(opMOV, imm(RTL.empty_proc), dst_x(2, SP));
END prolog;
PROCEDURE epilog;
VAR
- L1, i: INTEGER;
+ L1, i, n: INTEGER;
BEGIN
Op2(opBIS, imm(10H), SR); (* CPUOFF *)
@@ -1575,22 +1619,24 @@ BEGIN
EmitLabel(L1);
- MovRR(SP, IR);
-
+ n := 0;
FOR i := 0 TO 15 DO
- IF i IN R.regs + R.vregs THEN
- Push(i)
+ IF i IN R.regs THEN
+ Push(i);
+ INC(n)
END
END;
- Push(IR);
- Op1(opPUSH, IR, sINDIR);
- Op1(opCALL, SR, sIDX);
- EmitWord(RTL.int);
+ MovRR(SP, R4);
+ Op2(opADD, imm(n * 2), R4);
+
+ Push(R4);
+ Op1(opPUSH, R4, sINDIR);
+ Op1(opCALL, SR, sIDX); EmitWord(-RTL.VarSize); Reloc(RBSS); (* call int *)
Op2(opADD, imm(4), SP);
FOR i := 15 TO 0 BY -1 DO
- IF i IN R.regs + R.vregs THEN
+ IF i IN R.regs THEN
Pop(i)
END
END;
@@ -1606,7 +1652,7 @@ PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIO
VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER;
- Code, Data, Bss, Free: RECORD address, size: INTEGER END;
+ Code, Data, Bss: RECORD address, size: INTEGER END;
ram, rom: INTEGER;
@@ -1625,7 +1671,7 @@ BEGIN
ram := MIN(MAX(ram, minRAM), maxRAM);
rom := MIN(MAX(rom, minROM), maxROM);
- IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN
+ IF IL.codes.bss > ram - StkReserve - RTL.VarSize THEN
ERRORS.Error(204)
END;
@@ -1634,35 +1680,40 @@ BEGIN
CHL.PushInt(Labels, 0)
END;
- FOR i := 0 TO LEN(mem) - 1 DO
- mem[i] := 0
- END;
-
- TypesSize := CHL.Length(IL.codes.types) * 2;
CodeList := LISTS.create(NIL);
RelList := LISTS.create(NIL);
- REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {});
+ REG.Init(R, Push, Pop, mov, xchg, {R4, R5, R6, R7});
- prolog(ram);
- translate;
+ prolog;
+ translate(chkSTK IN options.checking);
epilog;
- Code.address := 10000H - rom;
- Code.size := Fixup(Code.address, IntVectorSize + TypesSize);
- Data.address := Code.address + Code.size;
+ TypesSize := CHL.Length(IL.codes.types) * 2;
Data.size := CHL.Length(IL.codes.data);
- Data.size := Data.size + Data.size MOD 2;
- TextSize := Code.size + Data.size;
+ IF ODD(Data.size) THEN
+ CHL.PushByte(IL.codes.data, 0);
+ INC(Data.size)
+ END;
+ Code.size := Fixup(0, IntVectorSize + TypesSize + Data.size);
+ Code.address := 10000H - (IntVectorSize + TypesSize + Data.size + Code.size);
+ IF Code.address < 10000H - rom THEN
+ ERRORS.Error(203)
+ END;
+ Code.size := Fixup(Code.address, IntVectorSize + TypesSize + Data.size);
+ Data.address := Code.address + Code.size;
+ TextSize := Code.size + Data.size;
- IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN
+ IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN
ERRORS.Error(203)
END;
- Bss.address := RTL.ram + RTL.VarSize;
- Bss.size := IL.codes.bss + IL.codes.bss MOD 2;
- heap := Bss.address + Bss.size;
stack := RTL.ram + ram;
- ASSERT(stack - heap >= minStackSize);
+ Bss.size := IL.codes.bss + IL.codes.bss MOD 2;
+ DEC(stack, Bss.size);
+ Bss.address := stack;
+ DEC(stack, RTL.VarSize);
+ heap := RTL.ram;
+ ASSERT(stack - heap >= StkReserve);
adr := Code.address + 2;
PutWord(stack, adr);
adr := Code.address + 6;
@@ -1675,20 +1726,18 @@ BEGIN
CASE reloc.section OF
|RCODE: PutWord(LabelOffs(val) * 2, adr)
|RDATA: PutWord(val + Data.address, adr)
- |RBSS: PutWord(val + Bss.address, adr)
+ |RBSS: PutWord((val + Bss.address) MOD 65536, adr)
END;
reloc := reloc.next(RELOC)
END;
adr := Data.address;
- FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO
+ FOR i := 0 TO Data.size - 1 DO
mem[adr] := CHL.GetByte(IL.codes.data, i);
INC(adr)
END;
- adr := 10000H - IntVectorSize - TypesSize;
-
FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO
PutWord(CHL.GetInt(IL.codes.types, i), adr)
END;
@@ -1705,11 +1754,6 @@ BEGIN
END
END;
- Free.address := Code.address + TextSize;
- Free.size := rom - (IntVectorSize + TypesSize + TextSize);
-
- PutWord(Free.address, adr);
- PutWord(Free.size, adr);
PutWord(4130H, adr); (* RET *)
PutWord(stack, adr);
PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *)
@@ -1718,26 +1762,18 @@ BEGIN
PutWord(LabelOffs(IV[i]) * 2, adr)
END;
+ INC(TextSize, IntVectorSize + TypesSize + Code.address MOD 16);
+ INC(Bss.size, StkReserve + RTL.VarSize);
+
WR.Create(outname);
-
- HEX.Data(mem, Code.address, TextSize);
- HEX.Data(mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize);
+ HEX.Data(mem, Code.address - Code.address MOD 16, TextSize);
HEX.End;
-
WR.Close;
- INC(TextSize, IntVectorSize + TypesSize);
- INC(Bss.size, minStackSize + RTL.VarSize);
-
- C.StringLn("--------------------------------------------");
- C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)");
- IF Free.size > 0 THEN
- C.String( " "); C.Int(Free.size); C.String(" bytes free (0");
- C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)")
- END;
+ C.Dashes;
+ C.String(" rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)");
C.Ln;
- C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)")
-
+ C.String(" ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)")
END CodeGen;
diff --git a/programs/develop/oberon07/Source/MSP430RTL.ob07 b/programs/develop/oberon07/source/MSP430RTL.ob07
similarity index 90%
rename from programs/develop/oberon07/Source/MSP430RTL.ob07
rename to programs/develop/oberon07/source/MSP430RTL.ob07
index e2c4f6c8c..66f0021d9 100644
--- a/programs/develop/oberon07/Source/MSP430RTL.ob07
+++ b/programs/develop/oberon07/source/MSP430RTL.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
@@ -34,7 +34,7 @@ CONST
_new* = 21;
- HP = 14;
+ HP* = 15;
LenIV* = 32;
@@ -42,9 +42,7 @@ CONST
bsl = iv - 2;
sp = bsl - 2;
empty_proc* = sp - 2;
- free_size = empty_proc - 2;
- free_adr = free_size - 2;
- bits = free_adr - 272;
+ bits = empty_proc - 272;
bits_offs = bits - 32;
DataSize* = iv - bits_offs;
types = bits_offs - 2;
@@ -53,6 +51,10 @@ CONST
VarSize* = 4;
+ StkReserve* = 40;
+
+ trap = 2;
+
TYPE
@@ -61,7 +63,7 @@ TYPE
VAR
- ram*, trap*, int*: INTEGER;
+ ram*: INTEGER;
rtl*: ARRAY 22 OF
RECORD
@@ -187,7 +189,7 @@ BEGIN
Word1(5405H); (* ADD R4, R5 *)
Word2(5035H, bits); (* ADD bits, R5 *)
Word1(4524H); (* MOV @R5, R4 *)
- Word1(4130H); (* MOV @SP+, PC *)
+ Word1(4130H); (* RET *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
@@ -202,7 +204,7 @@ BEGIN
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
- Word1(4130H); (* MOV @SP+, PC *)
+ Word1(4130H); (* RET *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
@@ -234,7 +236,7 @@ BEGIN
Word2(0F114H, 2); (* AND 2(SP), R4 *)
Word1(2400H + 3); (* JZ L1 *)
Word1(4314H); (* MOV #1, R4 *)
- Word1(4130H); (* MOV @SP+, PC *)
+ Word1(4130H); (* RET *)
(* L2: *)
Word1(4304H); (* MOV #0, R4 *)
(* L1: *)
@@ -374,51 +376,47 @@ BEGIN
(* _error (modNum, modName, err, line: INTEGER) *)
IF rtl[_error].used THEN
Label(rtl[_error].label);
- Word1(0C232H); (* BIC #8, SR; DINT *)
- Word1(4303H); (* MOV R3, R3; NOP *)
- Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- modNum *)
- Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- modName *)
- Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- err *)
- Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- line *)
- Word2(4211H, sp); (* MOV sp(SR), SP *)
- Word1(1207H); (* PUSH R7 *)
- Word1(1206H); (* PUSH R6 *)
- Word1(1205H); (* PUSH R5 *)
- Word1(1204H); (* PUSH R4 *)
- Word2(4214H, trap); (* MOV trap(SR), R4 *)
- Word1(9304H); (* TST R4 *)
- Word1(2400H + 1); (* JZ L *)
- Word1(1284H); (* CALL R4 *)
- (* L: *)
- Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
+ Word1(5321H); (* ADD #2, SP *)
+ Word1(4134H); (* POP R4; R4 <- modNum *)
+ Word1(4135H); (* POP R5; R5 <- modName *)
+ Word1(4136H); (* POP R6; R6 <- err *)
+ Word1(4137H); (* POP R7; R7 <- line *)
+ Word2(4211H, sp); (* MOV sp(SR), SP *)
+ Word1(1207H); (* PUSH R7 *)
+ Word1(1206H); (* PUSH R6 *)
+ Word1(1205H); (* PUSH R5 *)
+ Word1(1204H); (* PUSH R4 *)
+ Word2(4214H, sp); (* MOV sp(SR), R4 *)
+ Word2(1294H, trap); (* CALL trap(R4) *)
+ Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
END;
(* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
IF rtl[_new].used THEN
Label(rtl[_new].label);
- Word1(1202H); (* PUSH SR *)
- Word1(4302H); (* MOV #0, SR *)
- Word1(4303H); (* NOP *)
- Word1(4104H); (* MOV SP, R4 *)
- Word2(8034H, 16); (* SUB #16, R4 *)
- Word1(4005H + 100H * HP); (* MOV HP, R5 *)
- Word2(5115H, 6); (* ADD 6(SP), R5 *)
- Word1(9504H); (* CMP R5, R4 *)
- Word2(4114H, 8); (* MOV 8(SP), R4 *)
- Word1(3800H + 12); (* JL L1 *)
- Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *)
- Word1(5320H + HP); (* ADD #2, HP *)
- Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *)
- (* L3 *)
- Word2(4380H + HP, 0); (* MOV #0, 0(HP) *)
- Word1(5320H + HP); (* ADD #2, HP *)
- Word1(9500H + HP); (* CMP R5, HP *)
- Word1(3800H + 400H - 5); (* JL L3 *)
- Word1(3C00H + 2); (* JMP L2 *)
- (* L1 *)
- Word2(4384H, 0); (* MOV #0, 0(R4) *)
- (* L2 *)
- Word1(1300H) (* RETI *)
+ Word1(1202H); (* PUSH SR *)
+ Word1(4302H); (* MOV #0, SR *)
+ Word1(4303H); (* NOP *)
+ Word1(4104H); (* MOV SP, R4 *)
+ Word2(8034H, StkReserve); (* SUB #StkReserve, R4 *)
+ Word1(4005H + 100H * HP); (* MOV HP, R5 *)
+ Word2(5115H, 6); (* ADD 6(SP), R5 *)
+ Word1(9504H); (* CMP R5, R4 *)
+ Word2(4114H, 8); (* MOV 8(SP), R4 *)
+ Word1(3800H + 12); (* JL L1 *)
+ Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *)
+ Word1(5320H + HP); (* ADD #2, HP *)
+ Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *)
+ (* L3 *)
+ Word2(4380H + HP, 0); (* MOV #0, 0(HP) *)
+ Word1(5320H + HP); (* ADD #2, HP *)
+ Word1(9500H + HP); (* CMP R5, HP *)
+ Word1(3800H + 400H - 5); (* JL L3 *)
+ Word1(3C00H + 2); (* JMP L2 *)
+ (* L1 *)
+ Word2(4384H, 0); (* MOV #0, 0(R4) *)
+ (* L2 *)
+ Word1(1300H) (* RETI *)
END;
(* _guardrec (t0, t1: INTEGER): INTEGER *)
@@ -442,7 +440,7 @@ BEGIN
Word1(9405H); (* CMP R4, R5 *)
Word1(2400H + 2); (* JZ L2 *)
Word1(4304H); (* MOV #0, R4 *)
- Word1(4130H); (* MOV @SP+, PC *)
+ Word1(4130H); (* RET *)
(* L2: *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H) (* RET *)
@@ -661,14 +659,12 @@ BEGIN
END Used;
-PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER);
+PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC);
BEGIN
Label := pLabel;
Word := pWord;
Call := pCall;
ram := 200H;
- trap := ram;
- int := trap + 2
END Init;
diff --git a/programs/develop/oberon07/Source/PARS.ob07 b/programs/develop/oberon07/source/PARS.ob07
similarity index 83%
rename from programs/develop/oberon07/Source/PARS.ob07
rename to programs/develop/oberon07/source/PARS.ob07
index a3f2078d7..9cc5a8e7e 100644
--- a/programs/develop/oberon07/Source/PARS.ob07
+++ b/programs/develop/oberon07/source/PARS.ob07
@@ -1,14 +1,14 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS,
- C := COLLECTIONS, TARGETS, THUMB;
+ C := COLLECTIONS, TARGETS, THUMB, MSP430;
CONST
@@ -60,7 +60,7 @@ TYPE
constexp*: BOOLEAN;
main*: BOOLEAN;
- open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
+ open*: PROCEDURE (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
parse*: PROCEDURE (parser: PARSER);
StatSeq*: STATPROC;
expression*: EXPRPROC;
@@ -198,10 +198,11 @@ END ExpectSym;
PROCEDURE ImportList (parser: PARSER);
VAR
+ fname, path, ext, _name: PATH;
name: SCAN.IDENT;
parser2: PARSER;
pos: POSITION;
- alias: BOOLEAN;
+ alias, _in: BOOLEAN;
unit: PROG.UNIT;
ident: PROG.IDENT;
@@ -222,22 +223,69 @@ BEGIN
Next(parser);
+ path := parser.path;
+ fname := "";
+ ext := UTILS.FILE_EXT;
+ COPY(name.s, _name);
+ _in := FALSE;
+
+ IF parser.sym = SCAN.lxIN THEN
+ _in := TRUE;
+ Next(parser);
+ IF parser.sym = SCAN.lxSTRING THEN
+ STRINGS.trim(parser.lex.string.s, fname)
+ ELSIF parser.sym = SCAN.lxCHAR THEN
+ fname[0] := CHR(ARITH.Int(parser.lex.value));
+ fname[1] := 0X
+ ELSE
+ check1(FALSE, parser, 117)
+ END;
+ STRINGS.replace(fname, "/", UTILS.slash);
+ STRINGS.replace(fname, "\", UTILS.slash);
+ PATHS.DelSlashes(fname);
+ PATHS.split(fname, path, _name, ext);
+ IF PATHS.isRelative(path) THEN
+ PATHS.RelPath(parser.path, path, fname);
+ STRINGS.append(fname, _name);
+ STRINGS.append(fname, ext);
+ PATHS.split(fname, path, _name, ext)
+ END;
+ Next(parser)
+ END;
+
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE;
- unit := PROG.getUnit(name);
+ IF (fname = "") & ((_name = "SYSTEM") OR PROG.LowerCase & (_name = "system")) THEN
+ unit := PROG.program.sysunit
+ ELSE
+ IF fname # "" THEN
+ unit := PROG.getUnit(fname)
+ ELSE
+ fname := path;
+ STRINGS.append(fname, _name);
+ STRINGS.append(fname, UTILS.FILE_EXT);
+ unit := PROG.getUnit(fname);
+ IF unit = NIL THEN
+ fname := parser.lib_path;
+ STRINGS.append(fname, _name);
+ STRINGS.append(fname, UTILS.FILE_EXT);
+ unit := PROG.getUnit(fname)
+ END
+ END
+ END;
IF unit # NIL THEN
check(unit.closed, pos, 31)
ELSE
- parser2 := parser.create(parser.path, parser.lib_path,
+ parser2 := parser.create(path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
- IF ~parser2.open(parser2, name.s) THEN
- IF parser.path # parser.lib_path THEN
+ IF ~parser2.open(parser2, _name, ext) THEN
+ IF (path # parser.lib_path) & ~_in THEN
destroy(parser2);
parser2 := parser.create(parser.lib_path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
- check(parser2.open(parser2, name.s), pos, 29)
+ check(parser2.open(parser2, _name, ext), pos, 29)
ELSE
error(pos, 29)
END
@@ -245,6 +293,7 @@ BEGIN
parser2.parse(parser2);
unit := parser2.unit;
+ unit.fname := parser2.fname;
destroy(parser2)
END;
IF unit = PROG.program.sysunit THEN
@@ -294,8 +343,8 @@ END QIdent;
PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
VAR
- str: SCAN.LEXSTR;
- string1, string2: SCAN.IDENT;
+ str: SCAN.TEXTSTR;
+ string1, string2: SCAN.STRING;
bool: BOOLEAN;
BEGIN
@@ -303,20 +352,20 @@ BEGIN
IF v.typ = ARITH.tCHAR THEN
ASSERT(v2.typ = ARITH.tSTRING);
ARITH.charToStr(v, str);
- string1 := SCAN.enterid(str);
- string2 := v2.string(SCAN.IDENT)
+ string1 := SCAN.enterStr(str);
+ string2 := v2.string(SCAN.STRING)
END;
IF v2.typ = ARITH.tCHAR THEN
ASSERT(v.typ = ARITH.tSTRING);
ARITH.charToStr(v2, str);
- string2 := SCAN.enterid(str);
- string1 := v.string(SCAN.IDENT)
+ string2 := SCAN.enterStr(str);
+ string1 := v.string(SCAN.STRING)
END;
IF v.typ = v2.typ THEN
- string1 := v.string(SCAN.IDENT);
- string2 := v2.string(SCAN.IDENT)
+ string1 := v.string(SCAN.STRING);
+ string2 := v2.string(SCAN.STRING)
END;
CASE operator OF
@@ -482,27 +531,26 @@ VAR
res, sf: INTEGER;
BEGIN
- IF parser.lex.s = "stdcall" THEN
+ checklex(parser, SCAN.lxIDENT);
+ IF parser.lex.ident.s = "stdcall" THEN
sf := PROG.sf_stdcall
- ELSIF parser.lex.s = "stdcall64" THEN
- sf := PROG.sf_stdcall64
- ELSIF parser.lex.s = "ccall" THEN
+ ELSIF parser.lex.ident.s = "cdecl" THEN
+ sf := PROG.sf_cdecl
+ ELSIF parser.lex.ident.s = "ccall" THEN
sf := PROG.sf_ccall
- ELSIF parser.lex.s = "ccall16" THEN
- sf := PROG.sf_ccall16
- ELSIF parser.lex.s = "win64" THEN
+ ELSIF parser.lex.ident.s = "win64" THEN
sf := PROG.sf_win64
- ELSIF parser.lex.s = "systemv" THEN
+ ELSIF parser.lex.ident.s = "systemv" THEN
sf := PROG.sf_systemv
- ELSIF parser.lex.s = "windows" THEN
+ ELSIF parser.lex.ident.s = "windows" THEN
sf := PROG.sf_windows
- ELSIF parser.lex.s = "linux" THEN
+ ELSIF parser.lex.ident.s = "linux" THEN
sf := PROG.sf_linux
- ELSIF parser.lex.s = "code" THEN
+ ELSIF parser.lex.ident.s = "code" THEN
sf := PROG.sf_code
- ELSIF parser.lex.s = "oberon" THEN
+ ELSIF parser.lex.ident.s = "oberon" THEN
sf := PROG.sf_oberon
- ELSIF parser.lex.s = "noalign" THEN
+ ELSIF parser.lex.ident.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
check1(FALSE, parser, 124)
@@ -519,12 +567,16 @@ BEGIN
CASE sf OF
|PROG.sf_stdcall:
res := PROG.stdcall
- |PROG.sf_stdcall64:
- res := PROG.stdcall64
+ |PROG.sf_cdecl:
+ res := PROG.cdecl
|PROG.sf_ccall:
- res := PROG.ccall
- |PROG.sf_ccall16:
- res := PROG.ccall16
+ IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
+ res := PROG.ccall
+ ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
+ res := PROG.win64
+ ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
+ res := PROG.systemv
+ END
|PROG.sf_win64:
res := PROG.win64
|PROG.sf_systemv:
@@ -545,7 +597,7 @@ BEGIN
END
|PROG.sf_linux:
IF TARGETS.OS = TARGETS.osLINUX32 THEN
- res := PROG.ccall16
+ res := PROG.ccall
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
res := PROG.systemv
END
@@ -560,11 +612,11 @@ END sysflag;
PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR
call: INTEGER;
- dll, proc: SCAN.LEXSTR;
+ dll, proc: SCAN.TEXTSTR;
pos: POSITION;
- PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR);
+ PROCEDURE getStr (parser: PARSER; VAR name: SCAN.TEXTSTR);
VAR
pos: POSITION;
str: ARITH.VALUE;
@@ -573,7 +625,7 @@ VAR
getpos(parser, pos);
ConstExpression(parser, str);
IF str.typ = ARITH.tSTRING THEN
- name := str.string(SCAN.IDENT).s
+ name := str.string(SCAN.STRING).s
ELSIF str.typ = ARITH.tCHAR THEN
ARITH.charToStr(str, name)
ELSE
@@ -614,9 +666,13 @@ BEGIN
|32: IF TARGETS.CPU = TARGETS.cpuX86 THEN
call := PROG.default32
ELSE
- call := PROG.ccall
+ call := PROG.cdecl
+ END
+ |64: IF TARGETS.CPU = TARGETS.cpuAMD64 THEN
+ call := PROG.default64
+ ELSE
+ call := PROG.cdecl
END
- |64: call := PROG.default64
END
END;
@@ -920,12 +976,12 @@ VAR
_import: IL.IMPORT_PROC;
endmod, b: BOOLEAN;
fparams: SET;
- variables: LISTS.LIST;
int, flt: INTEGER;
comma: BOOLEAN;
code, iv: ARITH.VALUE;
codeProc,
handler: BOOLEAN;
+ line: INTEGER;
BEGIN
endmod := FALSE;
@@ -938,12 +994,13 @@ VAR
getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT);
+ line := pos.line;
IF _import # NIL THEN
proc := IdentDef(parser, PROG.idIMP, name);
proc._import := _import;
IF _import.name = "" THEN
- _import.name := name.s
+ COPY(name.s, _import.name)
END;
PROG.program.procs.last(PROG.PROC)._import := _import
ELSE
@@ -961,7 +1018,7 @@ VAR
IF parser.sym = SCAN.lxLSQUARE THEN
getpos(parser, pos2);
- check(TARGETS.target = TARGETS.STM32CM3, pos2, 24);
+ check((TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE), pos2, 24);
Next(parser);
getpos(parser, pos2);
ConstExpression(parser, iv);
@@ -1075,8 +1132,10 @@ VAR
proc.proc.leave := IL.LeaveC()
END;
- IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
- check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
+ IF (TARGETS.CPU = TARGETS.cpuMSP430) & ~codeProc THEN
+ check(MSP430.CheckProcDataSize(enter.param2 + proc._type.parSize, PROG.program.options.ram), pos1, 63);
+ enter.param2 := enter.param2 * 65536 + line;
+ enter.param3 := IL.codes.errlabels[10]
END
END;
@@ -1086,15 +1145,15 @@ VAR
getpos(parser, pos);
endname := parser.lex.ident;
IF ~codeProc & (_import = NIL) THEN
- check(endname = name, pos, 60);
+ check(PROG.IdEq(endname, name), pos, 60);
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
- IF endname = parser.unit.name THEN
+ IF PROG.IdEq(endname, parser.unit.name) THEN
ExpectSym(parser, SCAN.lxPOINT);
Next(parser);
endmod := TRUE
- ELSIF endname = name THEN
+ ELSIF PROG.IdEq(endname, name) THEN
ExpectSym(parser, SCAN.lxSEMI);
Next(parser)
ELSE
@@ -1108,17 +1167,7 @@ VAR
END
END;
- IF ~codeProc & (_import = NIL) THEN
- variables := LISTS.create(NIL);
- ELSE
- variables := NIL
- END;
-
- PROG.closeScope(unit, variables);
-
- IF ~codeProc & (_import = NIL) THEN
- enter.variables := variables
- END
+ PROG.closeScope(unit);
RETURN endmod
END ProcDeclaration;
@@ -1185,11 +1234,11 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT);
IF ~parser.main THEN
- check1(parser.lex.s = parser.modname, parser, 23)
+ check1(parser.lex.ident.s = parser.modname, parser, 23)
END;
unit := PROG.newUnit(parser.lex.ident);
-
+ unit.fname := parser.fname;
parser.unit := unit;
ExpectSym(parser, SCAN.lxSEMI);
@@ -1214,7 +1263,7 @@ BEGIN
END;
label := IL.NewLabel();
- IL.AddJmpCmd(IL.opJMP, label);
+ IL.Jmp(IL.opJMP, label);
name := IL.putstr(unit.name.s);
@@ -1228,7 +1277,7 @@ BEGIN
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
IL.SetErrLabel(errno);
IL.AddCmd(IL.opPUSHC, errno);
- IL.AddJmpCmd(IL.opJMP, errlabel)
+ IL.Jmp(IL.opJMP, errlabel)
END;
endmod := DeclarationSequence(parser);
@@ -1245,7 +1294,7 @@ BEGIN
checklex(parser, SCAN.lxEND);
ExpectSym(parser, SCAN.lxIDENT);
- check1(parser.lex.s = unit.name.s, parser, 25);
+ check1(parser.lex.ident.s = unit.name.s, parser, 25);
ExpectSym(parser, SCAN.lxPOINT)
END;
@@ -1254,12 +1303,12 @@ BEGIN
END parse;
-PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE open (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
BEGIN
ASSERT(parser # NIL);
STRINGS.append(parser.fname, modname);
- STRINGS.append(parser.fname, parser.ext);
+ STRINGS.append(parser.fname, FileExt);
STRINGS.append(parser.modname, modname);
parser.scanner := SCAN.open(parser.fname)
diff --git a/programs/develop/oberon07/Source/PATHS.ob07 b/programs/develop/oberon07/source/PATHS.ob07
similarity index 65%
rename from programs/develop/oberon07/Source/PATHS.ob07
rename to programs/develop/oberon07/source/PATHS.ob07
index 5532b6ca1..f75c64a00 100644
--- a/programs/develop/oberon07/Source/PATHS.ob07
+++ b/programs/develop/oberon07/source/PATHS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2019, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -29,7 +29,7 @@ VAR
BEGIN
len := LENGTH(fname);
pos1 := len - 1;
- pos2 := len - 1;
+ pos2 := pos1;
STRINGS.search(fname, pos1, slash, FALSE);
STRINGS.search(fname, pos2, ".", FALSE);
@@ -45,8 +45,7 @@ BEGIN
STRINGS.copy(fname, name, pos1, 0, pos2 - pos1);
name[pos2 - pos1] := 0X;
STRINGS.copy(fname, ext, pos2, 0, len - pos2);
- ext[len - pos2] := 0X;
-
+ ext[len - pos2] := 0X
END split;
@@ -67,6 +66,12 @@ BEGIN
error := FALSE;
j := 0;
+ WHILE (relative[j] = ".") & (relative[j + 1] = slash) DO
+ INC(j, 2)
+ ELSIF relative[j] = slash DO
+ INC(j)
+ END;
+
WHILE ~error & (relative[j] # 0X) DO
IF (relative[j] = ".") & (relative[j + 1] = ".") & (relative[j + 2] = slash) & (i > 0) & (res[i - 1] = slash) THEN
DEC(i, 2);
@@ -95,6 +100,43 @@ BEGIN
END RelPath;
+PROCEDURE DelSlashes* (VAR path: ARRAY OF CHAR);
+VAR
+ i, j, k: INTEGER;
+ c: CHAR;
+
+BEGIN
+ i := 0;
+ j := 0;
+ k := 0;
+ REPEAT
+ c := path[j];
+ INC(j);
+ IF c = slash THEN
+ INC(k)
+ ELSE
+ k := 0
+ END;
+ IF k <= 1 THEN
+ path[i] := c;
+ INC(i)
+ END
+ UNTIL c = 0X;
+
+ i := 0;
+ j := 0;
+ REPEAT
+ c := path[j];
+ INC(j);
+ path[i] := c;
+ INC(i);
+ IF (c = slash) & (path[j] = ".") & (path[j + 1] = slash) THEN
+ INC(j, 2)
+ END
+ UNTIL c = 0X
+END DelSlashes;
+
+
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN UTILS.isRelative(path)
END isRelative;
diff --git a/programs/develop/oberon07/Source/PE32.ob07 b/programs/develop/oberon07/source/PE32.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/PE32.ob07
rename to programs/develop/oberon07/source/PE32.ob07
diff --git a/programs/develop/oberon07/Source/PROG.ob07 b/programs/develop/oberon07/source/PROG.ob07
similarity index 80%
rename from programs/develop/oberon07/Source/PROG.ob07
rename to programs/develop/oberon07/source/PROG.ob07
index 87cde889f..f2e3b6c46 100644
--- a/programs/develop/oberon07/Source/PROG.ob07
+++ b/programs/develop/oberon07/source/PROG.ob07
@@ -1,13 +1,13 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE PROG;
-IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS;
+IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS, PATHS;
CONST
@@ -44,25 +44,24 @@ CONST
default32* = 2; _default32* = default32 + 1;
stdcall* = 4; _stdcall* = stdcall + 1;
- ccall* = 6; _ccall* = ccall + 1;
- ccall16* = 8; _ccall16* = ccall16 + 1;
+ cdecl* = 6; _cdecl* = cdecl + 1;
+ ccall* = 8; _ccall* = ccall + 1;
win64* = 10; _win64* = win64 + 1;
- stdcall64* = 12; _stdcall64* = stdcall64 + 1;
- default64* = 14; _default64* = default64 + 1;
- systemv* = 16; _systemv* = systemv + 1;
- default16* = 18;
- code* = 20; _code* = code + 1;
+ default64* = 12; _default64* = default64 + 1;
+ systemv* = 14; _systemv* = systemv + 1;
+ default16* = 16; _default16* = default16 + 1;
+ code* = 18; _code* = code + 1;
noalign* = 22;
- callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
+ callee_clean_up* = {default32, _default32, stdcall, _stdcall, default64, _default64};
- sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
- sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
- sf_code* = 8; sf_oberon* = 9;
- sf_noalign* = 10;
+ sf_stdcall* = 0; sf_oberon* = 1; sf_cdecl* = 2; sf_ccall* = 3;
+ sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
+ sf_code* = 8;
+ sf_noalign* = 9;
- proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
+ proc_flags* = {sf_stdcall, sf_cdecl, sf_ccall, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
rec_flags* = {sf_noalign};
STACK_FRAME = 2;
@@ -115,6 +114,7 @@ TYPE
rUNIT = RECORD (LISTS.ITEM)
+ fname*: PATHS.PATH;
name*: SCAN.IDENT;
idents*: LISTS.LIST;
frwPointers: LISTS.LIST;
@@ -214,7 +214,7 @@ TYPE
VAR
- LowerCase: BOOLEAN;
+ LowerCase*: BOOLEAN;
idents: C.COLLECTION;
program*: PROGRAM;
@@ -300,15 +300,18 @@ BEGIN
END closeUnit;
+PROCEDURE IdEq* (a, b: SCAN.IDENT): BOOLEAN;
+ RETURN (a.hash = b.hash) & (a.s = b.s)
+END IdEq;
+
+
PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN;
VAR
item: IDENT;
BEGIN
- ASSERT(ident # NIL);
-
item := unit.idents.last(IDENT);
- WHILE (item.typ # idGUARD) & (item.name # ident) DO
+ WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
@@ -324,7 +327,6 @@ VAR
BEGIN
ASSERT(unit # NIL);
- ASSERT(ident # NIL);
res := unique(unit, ident);
@@ -410,21 +412,19 @@ VAR
item: IDENT;
BEGIN
- ASSERT(ident # NIL);
-
item := unit.idents.last(IDENT);
IF item # NIL THEN
IF currentScope THEN
- WHILE (item.name # ident) & (item.typ # idGUARD) DO
+ WHILE (item.typ # idGUARD) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END;
- IF item.name # ident THEN
+ IF item.typ = idGUARD THEN
item := NIL
END
ELSE
- WHILE (item # NIL) & (item.name # ident) DO
+ WHILE (item # NIL) & ~IdEq(item.name, ident) DO
item := item.prev(IDENT)
END
END
@@ -452,7 +452,8 @@ BEGIN
NEW(item);
item := NewIdent();
- item.name := NIL;
+ item.name.s := "";
+ item.name.hash := 0;
item.typ := idGUARD;
LISTS.push(unit.idents, item)
@@ -462,11 +463,10 @@ BEGIN
END openScope;
-PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST);
+PROCEDURE closeScope* (unit: UNIT);
VAR
item: IDENT;
del: IDENT;
- lvar: IL.LOCALVAR;
BEGIN
item := unit.idents.last(IDENT);
@@ -477,17 +477,6 @@ BEGIN
IF (del.typ = idVAR) & (del.offset = -1) THEN
ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0)
END;
- IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN
- IF del._type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN
- lvar := IL.NewVar();
- lvar.offset := del.offset;
- lvar.size := del._type.size;
- IF del.typ = idVAR THEN
- lvar.offset := -lvar.offset
- END;
- LISTS.push(variables, lvar)
- END
- END;
LISTS.delete(unit.idents, del);
C.push(idents, del)
END;
@@ -508,7 +497,6 @@ VAR
BEGIN
ASSERT(unit # NIL);
ASSERT(_type # NIL);
- ASSERT(baseIdent # NIL);
NEW(newptr);
@@ -626,20 +614,18 @@ PROCEDURE arrcomp* (src, dst: _TYPE): BOOLEAN;
END arrcomp;
-PROCEDURE getUnit* (name: SCAN.IDENT): UNIT;
+PROCEDURE getUnit* (name: PATHS.PATH): UNIT;
VAR
item: UNIT;
BEGIN
- ASSERT(name # NIL);
-
item := program.units.first(UNIT);
- WHILE (item # NIL) & (item.name # name) DO
+ WHILE (item # NIL) & (item.fname # name) DO
item := item.next(UNIT)
END;
- IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN
+ IF (item = NIL) & ((name = "SYSTEM") OR LowerCase & (name = "system")) THEN
item := program.sysunit
END
@@ -650,19 +636,22 @@ END getUnit;
PROCEDURE enterStTypes (unit: UNIT);
- PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE);
+ PROCEDURE enter (unit: UNIT; nameStr: SCAN.IDSTR; _type: _TYPE);
VAR
ident: IDENT;
- upper: SCAN.LEXSTR;
+ upper: SCAN.IDSTR;
+ name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
- ident := addIdent(unit, SCAN.enterid(name), idTYPE);
+ SCAN.setIdent(name, nameStr);
+ ident := addIdent(unit, name, idTYPE);
ident._type := _type
END;
- upper := name;
+ upper := nameStr;
STRINGS.UpCase(upper);
- ident := addIdent(unit, SCAN.enterid(upper), idTYPE);
+ SCAN.setIdent(name, upper);
+ ident := addIdent(unit, name, idTYPE);
ident._type := _type
END enter;
@@ -687,80 +676,64 @@ END enterStTypes;
PROCEDURE enterStProcs (unit: UNIT);
- PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER);
+ PROCEDURE Enter (unit: UNIT; nameStr: SCAN.IDSTR; nfunc, tfunc: INTEGER);
VAR
ident: IDENT;
- upper: SCAN.LEXSTR;
+ upper: SCAN.IDSTR;
+ name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
- ident := addIdent(unit, SCAN.enterid(name), idSTPROC);
- ident.stproc := proc;
+ SCAN.setIdent(name, nameStr);
+ ident := addIdent(unit, name, tfunc);
+ ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
END;
- upper := name;
+ upper := nameStr;
STRINGS.UpCase(upper);
- ident := addIdent(unit, SCAN.enterid(upper), idSTPROC);
- ident.stproc := proc;
+ SCAN.setIdent(name, upper);
+ ident := addIdent(unit, name, tfunc);
+ ident.stproc := nfunc;
ident._type := program.stTypes.tNONE
- END EnterProc;
-
-
- PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER);
- VAR
- ident: IDENT;
- upper: SCAN.LEXSTR;
-
- BEGIN
- IF LowerCase THEN
- ident := addIdent(unit, SCAN.enterid(name), idSTFUNC);
- ident.stproc := func;
- ident._type := program.stTypes.tNONE
- END;
- upper := name;
- STRINGS.UpCase(upper);
- ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC);
- ident.stproc := func;
- ident._type := program.stTypes.tNONE
- END EnterFunc;
+ END Enter;
BEGIN
- EnterProc(unit, "assert", stASSERT);
- EnterProc(unit, "dec", stDEC);
- EnterProc(unit, "excl", stEXCL);
- EnterProc(unit, "inc", stINC);
- EnterProc(unit, "incl", stINCL);
- EnterProc(unit, "new", stNEW);
- EnterProc(unit, "copy", stCOPY);
+ Enter(unit, "assert", stASSERT, idSTPROC);
+ Enter(unit, "dec", stDEC, idSTPROC);
+ Enter(unit, "excl", stEXCL, idSTPROC);
+ Enter(unit, "inc", stINC, idSTPROC);
+ Enter(unit, "incl", stINCL, idSTPROC);
+ Enter(unit, "new", stNEW, idSTPROC);
+ Enter(unit, "copy", stCOPY, idSTPROC);
- EnterFunc(unit, "abs", stABS);
- EnterFunc(unit, "asr", stASR);
- EnterFunc(unit, "chr", stCHR);
- EnterFunc(unit, "len", stLEN);
- EnterFunc(unit, "lsl", stLSL);
- EnterFunc(unit, "odd", stODD);
- EnterFunc(unit, "ord", stORD);
- EnterFunc(unit, "ror", stROR);
- EnterFunc(unit, "bits", stBITS);
- EnterFunc(unit, "lsr", stLSR);
- EnterFunc(unit, "length", stLENGTH);
- EnterFunc(unit, "min", stMIN);
- EnterFunc(unit, "max", stMAX);
+ Enter(unit, "abs", stABS, idSTFUNC);
+ Enter(unit, "asr", stASR, idSTFUNC);
+ Enter(unit, "chr", stCHR, idSTFUNC);
+ Enter(unit, "len", stLEN, idSTFUNC);
+ Enter(unit, "lsl", stLSL, idSTFUNC);
+ Enter(unit, "odd", stODD, idSTFUNC);
+ Enter(unit, "ord", stORD, idSTFUNC);
+ Enter(unit, "ror", stROR, idSTFUNC);
+ Enter(unit, "bits", stBITS, idSTFUNC);
+ Enter(unit, "lsr", stLSR, idSTFUNC);
+ Enter(unit, "length", stLENGTH, idSTFUNC);
+ Enter(unit, "min", stMIN, idSTFUNC);
+ Enter(unit, "max", stMAX, idSTFUNC);
IF TARGETS.RealSize # 0 THEN
- EnterProc(unit, "pack", stPACK);
- EnterProc(unit, "unpk", stUNPK);
- EnterFunc(unit, "floor", stFLOOR);
- EnterFunc(unit, "flt", stFLT)
+ Enter(unit, "pack", stPACK, idSTPROC);
+ Enter(unit, "unpk", stUNPK, idSTPROC);
+ Enter(unit, "floor", stFLOOR, idSTFUNC);
+ Enter(unit, "flt", stFLT, idSTFUNC)
END;
IF TARGETS.BitDepth >= 32 THEN
- EnterFunc(unit, "wchr", stWCHR)
+ Enter(unit, "wchr", stWCHR, idSTFUNC)
END;
IF TARGETS.Dispose THEN
- EnterProc(unit, "dispose", stDISPOSE)
+ Enter(unit, "dispose", stDISPOSE, idSTPROC)
END
END enterStProcs;
@@ -771,8 +744,6 @@ VAR
unit: UNIT;
BEGIN
- ASSERT(name # NIL);
-
NEW(unit);
unit.name := name;
@@ -810,7 +781,6 @@ VAR
BEGIN
ASSERT(self # NIL);
- ASSERT(name # NIL);
ASSERT(unit # NIL);
field := NIL;
@@ -818,7 +788,7 @@ BEGIN
field := self.fields.first(FIELD);
- WHILE (field # NIL) & (field.name # name) DO
+ WHILE (field # NIL) & ~IdEq(field.name, name) DO
field := field.next(FIELD)
END;
@@ -842,8 +812,6 @@ VAR
res: BOOLEAN;
BEGIN
- ASSERT(name # NIL);
-
res := getField(self, name, self.unit) = NIL;
IF res THEN
@@ -901,11 +869,9 @@ VAR
item: PARAM;
BEGIN
- ASSERT(name # NIL);
-
item := self.params.first(PARAM);
- WHILE (item # NIL) & (item.name # name) DO
+ WHILE (item # NIL) & ~IdEq(item.name, name) DO
item := item.next(PARAM)
END
@@ -919,8 +885,6 @@ VAR
res: BOOLEAN;
BEGIN
- ASSERT(name # NIL);
-
res := getParam(self, name) = NIL;
IF res THEN
@@ -1101,23 +1065,27 @@ PROCEDURE createSysUnit;
VAR
ident: IDENT;
unit: UNIT;
+ name: SCAN.IDENT;
- PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER);
+ PROCEDURE EnterProc (sys: UNIT; nameStr: SCAN.IDSTR; idtyp, proc: INTEGER);
VAR
ident: IDENT;
- upper: SCAN.LEXSTR;
+ upper: SCAN.IDSTR;
+ name: SCAN.IDENT;
BEGIN
IF LowerCase THEN
- ident := addIdent(sys, SCAN.enterid(name), idtyp);
+ SCAN.setIdent(name, nameStr);
+ ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
END;
- upper := name;
+ upper := nameStr;
STRINGS.UpCase(upper);
- ident := addIdent(sys, SCAN.enterid(upper), idtyp);
+ SCAN.setIdent(name, upper);
+ ident := addIdent(sys, name, idtyp);
ident.stproc := proc;
ident._type := program.stTypes.tNONE;
ident.export := TRUE
@@ -1125,7 +1093,9 @@ VAR
BEGIN
- unit := newUnit(SCAN.enterid("$SYSTEM"));
+ SCAN.setIdent(name, "$SYSTEM");
+ unit := newUnit(name);
+ unit.fname := "SYSTEM";
EnterProc(unit, "adr", idSYSFUNC, sysADR);
EnterProc(unit, "size", idSYSFUNC, sysSIZE);
@@ -1161,11 +1131,13 @@ BEGIN
EnterProc(unit, "get32", idSYSPROC, sysGET32);
IF LowerCase THEN
- ident := addIdent(unit, SCAN.enterid("card32"), idTYPE);
+ SCAN.setIdent(name, "card32");
+ ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE
END;
- ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
+ SCAN.setIdent(name, "CARD32");
+ ident := addIdent(unit, name, idTYPE);
ident._type := program.stTypes.tCARD32;
ident.export := TRUE;
END;
@@ -1247,11 +1219,11 @@ BEGIN
program.options := options;
CASE TARGETS.OS OF
- |TARGETS.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
- |TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
- |TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
- |TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
- |TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
+ |TARGETS.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
+ |TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
+ |TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_cdecl, sf_ccall, sf_noalign}
+ |TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_win64, sf_systemv, sf_ccall, sf_noalign}
+ |TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_win64, sf_systemv, sf_ccall, sf_noalign}
|TARGETS.osNONE: program.sysflags := {sf_code}
END;
diff --git a/programs/develop/oberon07/Source/REG.ob07 b/programs/develop/oberon07/source/REG.ob07
similarity index 58%
rename from programs/develop/oberon07/Source/REG.ob07
rename to programs/develop/oberon07/source/REG.ob07
index 32dbbf60d..06aab4fe1 100644
--- a/programs/develop/oberon07/Source/REG.ob07
+++ b/programs/develop/oberon07/source/REG.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -17,14 +17,11 @@ CONST
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
- NVR = 32;
-
TYPE
OP1 = PROCEDURE (arg: INTEGER);
OP2 = PROCEDURE (arg1, arg2: INTEGER);
- OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
REGS* = RECORD
@@ -33,13 +30,8 @@ TYPE
top*: INTEGER;
pushed*: INTEGER;
- vregs*: SET;
- offs: ARRAY NVR OF INTEGER;
- size: ARRAY NVR OF INTEGER;
-
push, pop: OP1;
- mov, xch: OP2;
- load, save: OP3
+ mov, xch: OP2
END;
@@ -78,17 +70,12 @@ END pop;
PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER;
VAR
- i, n: INTEGER;
+ i: INTEGER;
BEGIN
- i := 0;
- n := R.top;
- WHILE (i <= n) & (R.stk[i] # reg) DO
- INC(i)
- END;
-
- IF i > n THEN
- i := -1
+ i := R.top;
+ WHILE (i >= 0) & (R.stk[i] # reg) DO
+ DEC(i)
END
RETURN i
@@ -206,7 +193,7 @@ VAR
res: BOOLEAN;
BEGIN
- res := FALSE;
+ res := TRUE;
IF reg1 # reg2 THEN
n1 := InStk(R, reg1);
@@ -215,23 +202,20 @@ BEGIN
IF (n1 # -1) & (n2 # -1) THEN
R.stk[n1] := reg2;
R.stk[n2] := reg1;
- R.xch(reg2, reg1);
- res := TRUE
+ R.xch(reg2, reg1)
ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
R.stk[n1] := reg2;
INCL(R.regs, reg1);
EXCL(R.regs, reg2);
- R.mov(reg2, reg1);
- res := TRUE
+ R.mov(reg2, reg1)
ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
R.stk[n2] := reg1;
EXCL(R.regs, reg1);
INCL(R.regs, reg2);
- R.mov(reg1, reg2);
- res := TRUE
+ R.mov(reg1, reg2)
+ ELSE
+ res := FALSE
END
- ELSE
- res := TRUE
END
RETURN res
@@ -252,8 +236,8 @@ BEGIN
reg2 := R.stk[R.top]
ELSIF R.top = 0 THEN
reg1 := PopAnyReg(R);
- reg2 := R.stk[R.top]
- ELSIF R.top < 0 THEN
+ reg2 := R.stk[1]
+ ELSE (* R.top = -1 *)
reg2 := PopAnyReg(R);
reg1 := PopAnyReg(R)
END
@@ -286,130 +270,7 @@ BEGIN
END PushAll_1;
-PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
-BEGIN
- ASSERT(reg IN R.vregs);
- ASSERT(offs # 0);
- ASSERT(size IN {1, 2, 4, 8});
- R.offs[reg] := offs;
- R.size[reg] := size
-END Lock;
-
-
-PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
-BEGIN
- ASSERT(reg IN R.vregs);
- R.offs[reg] := 0
-END Release;
-
-
-PROCEDURE Load* (R: REGS; reg: INTEGER);
-VAR
- offs: INTEGER;
-
-BEGIN
- ASSERT(reg IN R.vregs);
- offs := R.offs[reg];
- IF offs # 0 THEN
- R.load(reg, offs, R.size[reg])
- END
-END Load;
-
-
-PROCEDURE Save* (R: REGS; reg: INTEGER);
-VAR
- offs: INTEGER;
-
-BEGIN
- ASSERT(reg IN R.vregs);
- offs := R.offs[reg];
- IF offs # 0 THEN
- R.save(reg, offs, R.size[reg])
- END
-END Save;
-
-
-PROCEDURE Store* (R: REGS);
-VAR
- i: INTEGER;
-
-BEGIN
- FOR i := 0 TO NVR - 1 DO
- IF i IN R.vregs THEN
- Save(R, i)
- END
- END
-END Store;
-
-
-PROCEDURE Restore* (R: REGS);
-VAR
- i: INTEGER;
-
-BEGIN
- FOR i := 0 TO NVR - 1 DO
- IF i IN R.vregs THEN
- Load(R, i)
- END
- END
-END Restore;
-
-
-PROCEDURE Reset* (VAR R: REGS);
-VAR
- i: INTEGER;
-
-BEGIN
- FOR i := 0 TO NVR - 1 DO
- IF i IN R.vregs THEN
- R.offs[i] := 0
- END
- END
-END Reset;
-
-
-PROCEDURE GetVarReg* (R: REGS; offs: INTEGER): INTEGER;
-VAR
- i, res: INTEGER;
-
-BEGIN
- res := -1;
- i := 0;
- WHILE i < NVR DO
- IF (i IN R.vregs) & (R.offs[i] = offs) THEN
- res := i;
- i := NVR
- END;
- INC(i)
- END
-
- RETURN res
-END GetVarReg;
-
-
-PROCEDURE GetAnyVarReg* (R: REGS): INTEGER;
-VAR
- i, res: INTEGER;
-
-BEGIN
- res := -1;
- i := 0;
- WHILE i < NVR DO
- IF (i IN R.vregs) & (R.offs[i] = 0) THEN
- res := i;
- i := NVR
- END;
- INC(i)
- END
-
- RETURN res
-END GetAnyVarReg;
-
-
-PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
-VAR
- i: INTEGER;
-
+PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; regs: SET);
BEGIN
R.regs := regs;
R.pushed := 0;
@@ -419,16 +280,6 @@ BEGIN
R.pop := pop;
R.mov := mov;
R.xch := xch;
- R.load := load;
- R.save := save;
-
- R.vregs := vregs;
-
- FOR i := 0 TO NVR - 1 DO
- R.offs[i] := 0;
- R.size[i] := 0
- END
-
END Init;
diff --git a/programs/develop/oberon07/Source/RVM32I.ob07 b/programs/develop/oberon07/source/RVM32I.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/RVM32I.ob07
rename to programs/develop/oberon07/source/RVM32I.ob07
diff --git a/programs/develop/oberon07/source/RVMxI.ob07 b/programs/develop/oberon07/source/RVMxI.ob07
new file mode 100644
index 000000000..d9630221c
--- /dev/null
+++ b/programs/develop/oberon07/source/RVMxI.ob07
@@ -0,0 +1,1428 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+MODULE RVMxI;
+
+IMPORT
+
+ PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS;
+
+
+CONST
+
+ LTypes = 0;
+ LStrings = 1;
+ LGlobal = 2;
+ LHeap = 3;
+ LStack = 4;
+
+ numGPRs = 3;
+
+ R0 = 0; R1 = 1;
+ BP = 3; SP = 4;
+
+ ACC = R0;
+
+ GPRs = {0 .. 2} + {5 .. numGPRs + 1};
+
+ opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opNOP = 5;
+ opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11;
+ opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15;
+ opLDD = 16; (* 17, 18 *)
+ opJMP = 19; opCALL = 20; opCALLI = 21;
+
+ opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
+ opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *)
+ opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
+ opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64;
+
+ opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
+ opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *)
+ opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
+ opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65;
+
+ opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69;
+
+ opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75;
+ opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81;
+
+
+VAR
+
+ R: REG.REGS; count, szWord: INTEGER;
+
+ ldr, str: PROCEDURE (r1, r2: INTEGER);
+
+
+PROCEDURE OutByte (n: BYTE);
+BEGIN
+ WR.WriteByte(n);
+ INC(count)
+END OutByte;
+
+
+PROCEDURE OutInt (n: INTEGER);
+BEGIN
+ IF szWord = 8 THEN
+ WR.Write64LE(n);
+ INC(count, 8)
+ ELSE (* szWord = 4 *)
+ WR.Write32LE(n);
+ INC(count, 4)
+ END
+END OutInt;
+
+
+PROCEDURE Emit (op, par1, par2: INTEGER);
+BEGIN
+ OutInt(op);
+ OutInt(par1);
+ OutInt(par2)
+END Emit;
+
+
+PROCEDURE drop;
+BEGIN
+ REG.Drop(R)
+END drop;
+
+
+PROCEDURE GetAnyReg (): INTEGER;
+ RETURN REG.GetAnyReg(R)
+END GetAnyReg;
+
+
+PROCEDURE GetAcc;
+BEGIN
+ ASSERT(REG.GetReg(R, ACC))
+END GetAcc;
+
+
+PROCEDURE UnOp (VAR r: INTEGER);
+BEGIN
+ REG.UnOp(R, r)
+END UnOp;
+
+
+PROCEDURE BinOp (VAR r1, r2: INTEGER);
+BEGIN
+ REG.BinOp(R, r1, r2)
+END BinOp;
+
+
+PROCEDURE PushAll (NumberOfParameters: INTEGER);
+BEGIN
+ REG.PushAll(R);
+ DEC(R.pushed, NumberOfParameters)
+END PushAll;
+
+
+PROCEDURE push (r: INTEGER);
+BEGIN
+ Emit(opPUSH, r, 0)
+END push;
+
+
+PROCEDURE pop (r: INTEGER);
+BEGIN
+ Emit(opPOP, r, 0)
+END pop;
+
+
+PROCEDURE mov (r1, r2: INTEGER);
+BEGIN
+ Emit(opMOV, r1, r2)
+END mov;
+
+
+PROCEDURE xchg (r1, r2: INTEGER);
+BEGIN
+ Emit(opXCHG, r1, r2)
+END xchg;
+
+
+PROCEDURE addrc (r, c: INTEGER);
+BEGIN
+ Emit(opADDC, r, c)
+END addrc;
+
+
+PROCEDURE subrc (r, c: INTEGER);
+BEGIN
+ Emit(opSUBC, r, c)
+END subrc;
+
+
+PROCEDURE movrc (r, c: INTEGER);
+BEGIN
+ Emit(opMOVC, r, c)
+END movrc;
+
+
+PROCEDURE pushc (c: INTEGER);
+BEGIN
+ Emit(opPUSHC, c, 0)
+END pushc;
+
+
+PROCEDURE add (r1, r2: INTEGER);
+BEGIN
+ Emit(opADD, r1, r2)
+END add;
+
+
+PROCEDURE sub (r1, r2: INTEGER);
+BEGIN
+ Emit(opSUB, r1, r2)
+END sub;
+
+
+PROCEDURE ldr64 (r1, r2: INTEGER);
+BEGIN
+ Emit(opLDD, r2 * 256 + r1, 0)
+END ldr64;
+
+
+PROCEDURE ldr32 (r1, r2: INTEGER);
+BEGIN
+ Emit(opLDW, r2 * 256 + r1, 0)
+END ldr32;
+
+
+PROCEDURE ldr16 (r1, r2: INTEGER);
+BEGIN
+ Emit(opLDH, r2 * 256 + r1, 0)
+END ldr16;
+
+
+PROCEDURE ldr8 (r1, r2: INTEGER);
+BEGIN
+ Emit(opLDB, r2 * 256 + r1, 0)
+END ldr8;
+
+
+PROCEDURE str64 (r1, r2: INTEGER);
+BEGIN
+ Emit(opSTD, r1 * 256 + r2, 0)
+END str64;
+
+
+PROCEDURE str32 (r1, r2: INTEGER);
+BEGIN
+ Emit(opSTW, r1 * 256 + r2, 0)
+END str32;
+
+
+PROCEDURE str16 (r1, r2: INTEGER);
+BEGIN
+ Emit(opSTH, r1 * 256 + r2, 0)
+END str16;
+
+
+PROCEDURE str8 (r1, r2: INTEGER);
+BEGIN
+ Emit(opSTB, r1 * 256 + r2, 0)
+END str8;
+
+
+PROCEDURE GlobalAdr (r, offset: INTEGER);
+BEGIN
+ Emit(opLEA, r + 256 * LGlobal, offset)
+END GlobalAdr;
+
+
+PROCEDURE StrAdr (r, offset: INTEGER);
+BEGIN
+ Emit(opLEA, r + 256 * LStrings, offset)
+END StrAdr;
+
+
+PROCEDURE ProcAdr (r, label: INTEGER);
+BEGIN
+ Emit(opLLA, r, label)
+END ProcAdr;
+
+
+PROCEDURE jnz (r, label: INTEGER);
+BEGIN
+ Emit(opCMPC, r, 0);
+ Emit(opJNE, label, 0)
+END jnz;
+
+
+PROCEDURE CallRTL (proc, par: INTEGER);
+BEGIN
+ Emit(opCALL, IL.codes.rtl[proc], 0);
+ addrc(SP, par * szWord)
+END CallRTL;
+
+
+PROCEDURE jcc (cc: INTEGER): INTEGER;
+BEGIN
+ CASE cc OF
+ |IL.opEQ, IL.opEQC: cc := opJEQ
+ |IL.opNE, IL.opNEC: cc := opJNE
+ |IL.opLT, IL.opLTC: cc := opJLT
+ |IL.opLE, IL.opLEC: cc := opJLE
+ |IL.opGT, IL.opGTC: cc := opJGT
+ |IL.opGE, IL.opGEC: cc := opJGE
+ END
+ RETURN cc
+END jcc;
+
+
+PROCEDURE shift1 (op, param: INTEGER);
+VAR
+ r1, r2: INTEGER;
+
+BEGIN
+ r2 := GetAnyReg();
+ Emit(opMOVC, r2, param);
+ BinOp(r1, r2);
+ Emit(op, r2, r1);
+ mov(r1, r2);
+ drop
+END shift1;
+
+
+PROCEDURE shift (op: INTEGER);
+VAR
+ r1, r2: INTEGER;
+
+BEGIN
+ BinOp(r1, r2);
+ Emit(op, r1, r2);
+ drop
+END shift;
+
+
+PROCEDURE translate (szWord: INTEGER);
+VAR
+ cmd, next: IL.COMMAND;
+
+ opcode, param1, param2, r1, r2, r3,
+ a, b, label, opLD, opST, opSTC: INTEGER;
+
+BEGIN
+ IF szWord = 8 THEN
+ opLD := opLDD;
+ opST := opSTD;
+ opSTC := opSTDC
+ ELSE
+ opLD := opLDW;
+ opST := opSTW;
+ opSTC := opSTWC
+ END;
+
+ cmd := IL.codes.commands.first(IL.COMMAND);
+
+ WHILE cmd # NIL DO
+
+ param1 := cmd.param1;
+ param2 := cmd.param2;
+ opcode := cmd.opcode;
+
+ CASE opcode OF
+
+ |IL.opJMP:
+ Emit(opJMP, param1, 0)
+
+ |IL.opLABEL:
+ Emit(opLABEL, param1, 0)
+
+ |IL.opCALL:
+ Emit(opCALL, param1, 0)
+
+ |IL.opCALLP:
+ UnOp(r1);
+ Emit(opCALLI, r1, 0);
+ drop;
+ ASSERT(R.top = -1)
+
+ |IL.opPUSHC:
+ pushc(param2)
+
+ |IL.opCLEANUP:
+ IF param2 # 0 THEN
+ addrc(SP, param2 * szWord)
+ END
+
+ |IL.opNOP, IL.opAND, IL.opOR:
+
+ |IL.opSADR:
+ StrAdr(GetAnyReg(), param2)
+
+ |IL.opGADR:
+ GlobalAdr(GetAnyReg(), param2)
+
+ |IL.opLADR:
+ param2 := param2 * szWord;
+ next := cmd.next(IL.COMMAND);
+ IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN
+ UnOp(r1);
+ Emit(opSTD, BP * 256 + r1, param2);
+ drop;
+ cmd := next
+ ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN
+ UnOp(r1);
+ Emit(opSTW, BP * 256 + r1, param2);
+ drop;
+ cmd := next
+ ELSIF next.opcode = IL.opSAVE16 THEN
+ UnOp(r1);
+ Emit(opSTH, BP * 256 + r1, param2);
+ drop;
+ cmd := next
+ ELSIF next.opcode = IL.opSAVE8 THEN
+ UnOp(r1);
+ Emit(opSTB, BP * 256 + r1, param2);
+ drop;
+ cmd := next
+ ELSE
+ Emit(opADDRC, BP * 256 + GetAnyReg(), param2)
+ END
+
+ |IL.opPARAM:
+ IF param2 = 1 THEN
+ UnOp(r1);
+ push(r1);
+ drop
+ ELSE
+ ASSERT(R.top + 1 <= param2);
+ PushAll(param2)
+ END
+
+ |IL.opONERR:
+ pushc(param2);
+ Emit(opJMP, param1, 0)
+
+ |IL.opPRECALL:
+ PushAll(0)
+
+ |IL.opRES, IL.opRESF:
+ ASSERT(R.top = -1);
+ GetAcc
+
+ |IL.opENTER:
+ ASSERT(R.top = -1);
+ Emit(opLABEL, param1, 0);
+ Emit(opENTER, param2, 0)
+
+ |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
+ IF opcode # IL.opLEAVE THEN
+ UnOp(r1);
+ IF r1 # ACC THEN
+ mov(ACC, r1)
+ END;
+ drop
+ END;
+
+ ASSERT(R.top = -1);
+
+ IF param1 > 0 THEN
+ mov(SP, BP)
+ END;
+
+ pop(BP);
+
+ Emit(opRET, 0, 0)
+
+ |IL.opLEAVEC:
+ Emit(opRET, 0, 0)
+
+ |IL.opCONST:
+ next := cmd.next(IL.COMMAND);
+ IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN
+ pushc(param2);
+ cmd := next
+ ELSE
+ movrc(GetAnyReg(), param2)
+ END
+
+ |IL.opDROP:
+ UnOp(r1);
+ drop
+
+ |IL.opSAVEC:
+ UnOp(r1);
+ Emit(opSTC, r1, param2);
+ drop
+
+ |IL.opSAVE8C:
+ UnOp(r1);
+ Emit(opSTBC, r1, param2 MOD 256);
+ drop
+
+ |IL.opSAVE16C:
+ UnOp(r1);
+ Emit(opSTHC, r1, param2 MOD 65536);
+ drop
+
+ |IL.opSAVE, IL.opSAVEF:
+ BinOp(r2, r1);
+ str(r1, r2);
+ drop;
+ drop
+
+ |IL.opSAVE32:
+ BinOp(r2, r1);
+ str32(r1, r2);
+ drop;
+ drop
+
+ |IL.opSAVE64:
+ BinOp(r2, r1);
+ str64(r1, r2);
+ drop;
+ drop
+
+ |IL.opSAVEFI:
+ BinOp(r2, r1);
+ str(r2, r1);
+ drop;
+ drop
+
+ |IL.opSAVE8:
+ BinOp(r2, r1);
+ str8(r1, r2);
+ drop;
+ drop
+
+ |IL.opSAVE16:
+ BinOp(r2, r1);
+ str16(r1, r2);
+ drop;
+ drop
+
+ |IL.opGLOAD32:
+ r1 := GetAnyReg();
+ GlobalAdr(r1, param2);
+ ldr32(r1, r1)
+
+ |IL.opGLOAD64:
+ r1 := GetAnyReg();
+ GlobalAdr(r1, param2);
+ ldr64(r1, r1)
+
+ |IL.opVADR:
+ Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord)
+
+ |IL.opLLOAD32:
+ Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord)
+
+ |IL.opLLOAD64:
+ Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord)
+
+ |IL.opVLOAD32:
+ r1 := GetAnyReg();
+ Emit(opLD, BP * 256 + r1, param2 * szWord);
+ ldr32(r1, r1)
+
+ |IL.opVLOAD64:
+ r1 := GetAnyReg();
+ Emit(opLDD, BP * 256 + r1, param2 * szWord);
+ ldr64(r1, r1)
+
+ |IL.opGLOAD16:
+ r1 := GetAnyReg();
+ GlobalAdr(r1, param2);
+ ldr16(r1, r1)
+
+ |IL.opLLOAD16:
+ Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord)
+
+ |IL.opVLOAD16:
+ r1 := GetAnyReg();
+ Emit(opLD, BP * 256 + r1, param2 * szWord);
+ ldr16(r1, r1)
+
+ |IL.opGLOAD8:
+ r1 := GetAnyReg();
+ GlobalAdr(r1, param2);
+ ldr8(r1, r1)
+
+ |IL.opLLOAD8:
+ Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord)
+
+ |IL.opVLOAD8:
+ r1 := GetAnyReg();
+ Emit(opLD, BP * 256 + r1, param2 * szWord);
+ ldr8(r1, r1)
+
+ |IL.opLOAD8:
+ UnOp(r1);
+ ldr8(r1, r1)
+
+ |IL.opLOAD16:
+ UnOp(r1);
+ ldr16(r1, r1)
+
+ |IL.opLOAD32:
+ UnOp(r1);
+ ldr32(r1, r1)
+
+ |IL.opLOAD64:
+ UnOp(r1);
+ ldr64(r1, r1)
+
+ |IL.opLOADF:
+ UnOp(r1);
+ ldr(r1, r1)
+
+ |IL.opUMINUS:
+ UnOp(r1);
+ Emit(opNEG, r1, 0)
+
+ |IL.opADD:
+ BinOp(r1, r2);
+ add(r1, r2);
+ drop
+
+ |IL.opSUB:
+ BinOp(r1, r2);
+ sub(r1, r2);
+ drop
+
+ |IL.opADDC:
+ UnOp(r1);
+ next := cmd.next(IL.COMMAND);
+ CASE next.opcode OF
+ |IL.opLOADF:
+ Emit(opLD, r1 * 256 + r1, param2);
+ cmd := next
+ |IL.opLOAD64:
+ Emit(opLDD, r1 * 256 + r1, param2);
+ cmd := next
+ |IL.opLOAD32:
+ Emit(opLDW, r1 * 256 + r1, param2);
+ cmd := next
+ |IL.opLOAD16:
+ Emit(opLDH, r1 * 256 + r1, param2);
+ cmd := next
+ |IL.opLOAD8:
+ Emit(opLDB, r1 * 256 + r1, param2);
+ cmd := next
+ ELSE
+ addrc(r1, param2)
+ END
+
+ |IL.opSUBR:
+ UnOp(r1);
+ subrc(r1, param2)
+
+ |IL.opSUBL:
+ UnOp(r1);
+ subrc(r1, param2);
+ Emit(opNEG, r1, 0)
+
+ |IL.opMULC:
+ UnOp(r1);
+ Emit(opMULC, r1, param2)
+
+ |IL.opMUL:
+ BinOp(r1, r2);
+ Emit(opMUL, r1, r2);
+ drop
+
+ |IL.opDIV:
+ BinOp(r1, r2);
+ Emit(opDIV, r1, r2);
+ drop
+
+ |IL.opMOD:
+ BinOp(r1, r2);
+ Emit(opMOD, r1, r2);
+ drop
+
+ |IL.opDIVR:
+ UnOp(r1);
+ Emit(opDIVC, r1, param2)
+
+ |IL.opMODR:
+ UnOp(r1);
+ Emit(opMODC, r1, param2)
+
+ |IL.opDIVL:
+ UnOp(r1);
+ r2 := GetAnyReg();
+ movrc(r2, param2);
+ Emit(opDIV, r2, r1);
+ mov(r1, r2);
+ drop
+
+ |IL.opMODL:
+ UnOp(r1);
+ r2 := GetAnyReg();
+ movrc(r2, param2);
+ Emit(opMOD, r2, r1);
+ mov(r1, r2);
+ drop
+
+ |IL.opEQ .. IL.opGE, IL.opEQC .. IL.opGEC:
+ IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
+ BinOp(r1, r2);
+ Emit(opCMP, r1, r2);
+ drop
+ ELSE
+ UnOp(r1);
+ Emit(opCMPC, r1, param2)
+ END;
+ next := cmd.next(IL.COMMAND);
+ IF next.opcode = IL.opJZ THEN
+ Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0);
+ cmd := next;
+ drop
+ ELSIF next.opcode = IL.opJNZ THEN
+ Emit(jcc(opcode), next.param1, 0);
+ cmd := next;
+ drop
+ ELSE
+ Emit(jcc(opcode) + 6, r1, 0)
+ END
+
+ |IL.opJNZ1:
+ UnOp(r1);
+ jnz(r1, param1)
+
+ |IL.opJG:
+ UnOp(r1);
+ Emit(opCMPC, r1, 0);
+ Emit(opJGT, param1, 0)
+
+ |IL.opJNZ:
+ UnOp(r1);
+ jnz(r1, param1);
+ drop
+
+ |IL.opJZ:
+ UnOp(r1);
+ Emit(opCMPC, r1, 0);
+ Emit(opJEQ, param1, 0);
+ drop
+
+ |IL.opMULS:
+ BinOp(r1, r2);
+ Emit(opAND, r1, r2);
+ drop
+
+ |IL.opMULSC:
+ UnOp(r1);
+ Emit(opANDC, r1, param2)
+
+ |IL.opDIVS:
+ BinOp(r1, r2);
+ Emit(opXOR, r1, r2);
+ drop
+
+ |IL.opDIVSC:
+ UnOp(r1);
+ Emit(opXORC, r1, param2)
+
+ |IL.opADDS:
+ BinOp(r1, r2);
+ Emit(opOR, r1, r2);
+ drop
+
+ |IL.opSUBS:
+ BinOp(r1, r2);
+ Emit(opNOT, r2, 0);
+ Emit(opAND, r1, r2);
+ drop
+
+ |IL.opADDSC:
+ UnOp(r1);
+ Emit(opORC, r1, param2)
+
+ |IL.opSUBSL:
+ UnOp(r1);
+ Emit(opNOT, r1, 0);
+ Emit(opANDC, r1, param2)
+
+ |IL.opSUBSR:
+ UnOp(r1);
+ Emit(opANDC, r1, ORD(-BITS(param2)))
+
+ |IL.opUMINS:
+ UnOp(r1);
+ Emit(opNOT, r1, 0)
+
+ |IL.opASR:
+ shift(opASR)
+
+ |IL.opLSL:
+ shift(opLSL)
+
+ |IL.opROR:
+ shift(opROR)
+
+ |IL.opLSR:
+ shift(opLSR)
+
+ |IL.opASR1:
+ shift1(opASR, param2)
+
+ |IL.opLSL1:
+ shift1(opLSL, param2)
+
+ |IL.opROR1:
+ shift1(opROR, param2)
+
+ |IL.opLSR1:
+ shift1(opLSR, param2)
+
+ |IL.opASR2:
+ UnOp(r1);
+ Emit(opASRC, r1, param2 MOD (szWord * 8))
+
+ |IL.opLSL2:
+ UnOp(r1);
+ Emit(opLSLC, r1, param2 MOD (szWord * 8))
+
+ |IL.opROR2:
+ UnOp(r1);
+ Emit(opRORC, r1, param2 MOD (szWord * 8))
+
+ |IL.opLSR2:
+ UnOp(r1);
+ Emit(opLSRC, r1, param2 MOD (szWord * 8))
+
+ |IL.opCHR:
+ UnOp(r1);
+ Emit(opANDC, r1, 255)
+
+ |IL.opWCHR:
+ UnOp(r1);
+ Emit(opANDC, r1, 65535)
+
+ |IL.opABS:
+ UnOp(r1);
+ Emit(opCMPC, r1, 0);
+ label := IL.NewLabel();
+ Emit(opJGE, label, 0);
+ Emit(opNEG, r1, 0);
+ Emit(opLABEL, label, 0)
+
+ |IL.opLEN:
+ UnOp(r1);
+ drop;
+ EXCL(R.regs, r1);
+
+ WHILE param2 > 0 DO
+ UnOp(r2);
+ drop;
+ DEC(param2)
+ END;
+
+ INCL(R.regs, r1);
+ ASSERT(REG.GetReg(R, r1))
+
+ |IL.opSWITCH:
+ UnOp(r1);
+ IF param2 = 0 THEN
+ r2 := ACC
+ ELSE
+ r2 := R1
+ END;
+ IF r1 # r2 THEN
+ ASSERT(REG.GetReg(R, r2));
+ ASSERT(REG.Exchange(R, r1, r2));
+ drop
+ END;
+ drop
+
+ |IL.opENDSW:
+
+ |IL.opCASEL:
+ Emit(opCMPC, ACC, param1);
+ Emit(opJLT, param2, 0)
+
+ |IL.opCASER:
+ Emit(opCMPC, ACC, param1);
+ Emit(opJGT, param2, 0)
+
+ |IL.opCASELR:
+ Emit(opCMPC, ACC, param1);
+ IF param2 = cmd.param3 THEN
+ Emit(opJNE, param2, 0)
+ ELSE
+ Emit(opJLT, param2, 0);
+ Emit(opJGT, cmd.param3, 0)
+ END
+
+ |IL.opSBOOL:
+ BinOp(r2, r1);
+ Emit(opCMPC, r2, 0);
+ Emit(opSNE, r2, 0);
+ str8(r1, r2);
+ drop;
+ drop
+
+ |IL.opSBOOLC:
+ UnOp(r1);
+ Emit(opSTBC, r1, ORD(param2 # 0));
+ drop
+
+ |IL.opINCC:
+ UnOp(r1);
+ r2 := GetAnyReg();
+ ldr(r2, r1);
+ addrc(r2, param2);
+ str(r1, r2);
+ drop;
+ drop
+
+ |IL.opINCCB, IL.opDECCB:
+ IF opcode = IL.opDECCB THEN
+ param2 := -param2
+ END;
+ UnOp(r1);
+ r2 := GetAnyReg();
+ ldr8(r2, r1);
+ addrc(r2, param2);
+ str8(r1, r2);
+ drop;
+ drop
+
+ |IL.opINCB, IL.opDECB:
+ BinOp(r2, r1);
+ r3 := GetAnyReg();
+ ldr8(r3, r1);
+ IF opcode = IL.opINCB THEN
+ add(r3, r2)
+ ELSE
+ sub(r3, r2)
+ END;
+ str8(r1, r3);
+ drop;
+ drop;
+ drop
+
+ |IL.opINC, IL.opDEC:
+ BinOp(r2, r1);
+ r3 := GetAnyReg();
+ ldr(r3, r1);
+ IF opcode = IL.opINC THEN
+ add(r3, r2)
+ ELSE
+ sub(r3, r2)
+ END;
+ str(r1, r3);
+ drop;
+ drop;
+ drop
+
+ |IL.opINCL, IL.opEXCL:
+ BinOp(r2, r1);
+ Emit(opBIT, r2, r2);
+ r3 := GetAnyReg();
+ ldr(r3, r1);
+ IF opcode = IL.opINCL THEN
+ Emit(opOR, r3, r2)
+ ELSE
+ Emit(opNOT, r2, 0);
+ Emit(opAND, r3, r2)
+ END;
+ str(r1, r3);
+ drop;
+ drop;
+ drop
+
+ |IL.opINCLC, IL.opEXCLC:
+ UnOp(r1);
+ r2 := GetAnyReg();
+ ldr(r2, r1);
+ IF opcode = IL.opINCLC THEN
+ Emit(opORC, r2, ORD({param2}))
+ ELSE
+ Emit(opANDC, r2, ORD(-{param2}))
+ END;
+ str(r1, r2);
+ drop;
+ drop
+
+ |IL.opEQB, IL.opNEB:
+ BinOp(r1, r2);
+ Emit(opCMPC, r1, 0);
+ Emit(opSNE, r1, 0);
+ Emit(opCMPC, r2, 0);
+ Emit(opSNE, r2, 0);
+ Emit(opCMP, r1, r2);
+ IF opcode = IL.opEQB THEN
+ Emit(opSEQ, r1, 0)
+ ELSE
+ Emit(opSNE, r1, 0)
+ END;
+ drop
+
+ |IL.opCHKBYTE:
+ BinOp(r1, r2);
+ Emit(opCMPC, r1, 256);
+ Emit(opJBT, param1, 0)
+
+ |IL.opCHKIDX:
+ UnOp(r1);
+ Emit(opCMPC, r1, param2);
+ Emit(opJBT, param1, 0)
+
+ |IL.opCHKIDX2:
+ BinOp(r1, r2);
+ IF param2 # -1 THEN
+ Emit(opCMP, r2, r1);
+ Emit(opJBT, param1, 0)
+ END;
+ INCL(R.regs, r1);
+ DEC(R.top);
+ R.stk[R.top] := r2
+
+ |IL.opEQP, IL.opNEP:
+ ProcAdr(GetAnyReg(), param1);
+ BinOp(r1, r2);
+ Emit(opCMP, r1, r2);
+ IF opcode = IL.opEQP THEN
+ Emit(opSEQ, r1, 0)
+ ELSE
+ Emit(opSNE, r1, 0)
+ END;
+ drop
+
+ |IL.opSAVEP:
+ UnOp(r1);
+ r2 := GetAnyReg();
+ ProcAdr(r2, param2);
+ str(r1, r2);
+ drop;
+ drop
+
+ |IL.opPUSHP:
+ ProcAdr(GetAnyReg(), param2)
+
+ |IL.opPUSHT:
+ UnOp(r1);
+ Emit(opLD, r1 * 256 + GetAnyReg(), -szWord)
+
+ |IL.opGET, IL.opGETC:
+ IF opcode = IL.opGET THEN
+ BinOp(r1, r2)
+ ELSIF opcode = IL.opGETC THEN
+ UnOp(r2);
+ r1 := GetAnyReg();
+ movrc(r1, param1)
+ END;
+ drop;
+ drop;
+
+ CASE param2 OF
+ |1: ldr8(r1, r1); str8(r2, r1)
+ |2: ldr16(r1, r1); str16(r2, r1)
+ |4: ldr32(r1, r1); str32(r2, r1)
+ |8: ldr64(r1, r1); str64(r2, r1)
+ END
+
+ |IL.opNOT:
+ UnOp(r1);
+ Emit(opCMPC, r1, 0);
+ Emit(opSEQ, r1, 0)
+
+ |IL.opORD:
+ UnOp(r1);
+ Emit(opCMPC, r1, 0);
+ Emit(opSNE, r1, 0)
+
+ |IL.opMIN, IL.opMAX:
+ BinOp(r1, r2);
+ Emit(opCMP, r1, r2);
+ label := IL.NewLabel();
+ IF opcode = IL.opMIN THEN
+ Emit(opJLE, label, 0)
+ ELSE
+ Emit(opJGE, label, 0)
+ END;
+ Emit(opMOV, r1, r2);
+ Emit(opLABEL, label, 0);
+ drop
+
+ |IL.opMINC, IL.opMAXC:
+ UnOp(r1);
+ Emit(opCMPC, r1, param2);
+ label := IL.NewLabel();
+ IF opcode = IL.opMINC THEN
+ Emit(opJLE, label, 0)
+ ELSE
+ Emit(opJGE, label, 0)
+ END;
+ Emit(opMOVC, r1, param2);
+ Emit(opLABEL, label, 0)
+
+ |IL.opIN:
+ BinOp(r1, r2);
+ Emit(opBIT, r1, r1);
+ Emit(opAND, r1, r2);
+ Emit(opCMPC, r1, 0);
+ Emit(opSNE, r1, 0);
+ drop
+
+ |IL.opINL:
+ UnOp(r1);
+ Emit(opANDC, r1, ORD({param2}));
+ Emit(opCMPC, r1, 0);
+ Emit(opSNE, r1, 0)
+
+ |IL.opINR:
+ UnOp(r1);
+ Emit(opBIT, r1, r1);
+ Emit(opANDC, r1, param2);
+ Emit(opCMPC, r1, 0);
+ Emit(opSNE, r1, 0)
+
+ |IL.opERR:
+ CallRTL(IL._error, 4)
+
+ |IL.opEQS .. IL.opGES:
+ PushAll(4);
+ pushc(opcode - IL.opEQS);
+ CallRTL(IL._strcmp, 5);
+ GetAcc
+
+ |IL.opEQSW .. IL.opGESW:
+ PushAll(4);
+ pushc(opcode - IL.opEQSW);
+ CallRTL(IL._strcmpw, 5);
+ GetAcc
+
+ |IL.opCOPY:
+ PushAll(2);
+ pushc(param2);
+ CallRTL(IL._move, 3)
+
+ |IL.opMOVE:
+ PushAll(3);
+ CallRTL(IL._move, 3)
+
+ |IL.opCOPYA:
+ PushAll(4);
+ pushc(param2);
+ CallRTL(IL._arrcpy, 5);
+ GetAcc
+
+ |IL.opCOPYS:
+ PushAll(4);
+ pushc(param2);
+ CallRTL(IL._strcpy, 5)
+
+ |IL.opROT:
+ PushAll(0);
+ mov(ACC, SP);
+ push(ACC);
+ pushc(param2);
+ CallRTL(IL._rot, 2)
+
+ |IL.opLENGTH:
+ PushAll(2);
+ CallRTL(IL._length, 2);
+ GetAcc
+
+ |IL.opLENGTHW:
+ PushAll(2);
+ CallRTL(IL._lengthw, 2);
+ GetAcc
+
+ |IL.opSAVES:
+ UnOp(r2);
+ REG.PushAll_1(R);
+ r1 := GetAnyReg();
+ StrAdr(r1, param2);
+ push(r1);
+ drop;
+ push(r2);
+ drop;
+ pushc(param1);
+ CallRTL(IL._move, 3)
+
+ |IL.opRSET:
+ PushAll(2);
+ CallRTL(IL._set, 2);
+ GetAcc
+
+ |IL.opRSETR:
+ PushAll(1);
+ pushc(param2);
+ CallRTL(IL._set, 2);
+ GetAcc
+
+ |IL.opRSETL:
+ UnOp(r1);
+ REG.PushAll_1(R);
+ pushc(param2);
+ push(r1);
+ drop;
+ CallRTL(IL._set, 2);
+ GetAcc
+
+ |IL.opRSET1:
+ PushAll(1);
+ CallRTL(IL._set1, 1);
+ GetAcc
+
+ |IL.opNEW:
+ PushAll(1);
+ INC(param2, szWord);
+ ASSERT(UTILS.Align(param2, szWord));
+ pushc(param2);
+ pushc(param1);
+ CallRTL(IL._new, 3)
+
+ |IL.opTYPEGP:
+ UnOp(r1);
+ PushAll(0);
+ push(r1);
+ pushc(param2);
+ CallRTL(IL._guard, 2);
+ GetAcc
+
+ |IL.opIS:
+ PushAll(1);
+ pushc(param2);
+ CallRTL(IL._is, 2);
+ GetAcc
+
+ |IL.opISREC:
+ PushAll(2);
+ pushc(param2);
+ CallRTL(IL._guardrec, 3);
+ GetAcc
+
+ |IL.opTYPEGR:
+ PushAll(1);
+ pushc(param2);
+ CallRTL(IL._guardrec, 2);
+ GetAcc
+
+ |IL.opTYPEGD:
+ UnOp(r1);
+ PushAll(0);
+ subrc(r1, szWord);
+ ldr(r1, r1);
+ push(r1);
+ pushc(param2);
+ CallRTL(IL._guardrec, 2);
+ GetAcc
+
+ |IL.opCASET:
+ push(R1);
+ push(R1);
+ pushc(param2);
+ CallRTL(IL._guardrec, 2);
+ pop(R1);
+ jnz(ACC, param1)
+
+ |IL.opCONSTF:
+ IF szWord = 8 THEN
+ movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b))
+ ELSE (* szWord = 4 *)
+ movrc(GetAnyReg(), UTILS.d2s(cmd.float))
+ END
+
+ |IL.opMULF:
+ PushAll(2);
+ CallRTL(IL._fmul, 2);
+ GetAcc
+
+ |IL.opDIVF:
+ PushAll(2);
+ CallRTL(IL._fdiv, 2);
+ GetAcc
+
+ |IL.opDIVFI:
+ PushAll(2);
+ CallRTL(IL._fdivi, 2);
+ GetAcc
+
+ |IL.opADDF:
+ PushAll(2);
+ CallRTL(IL._fadd, 2);
+ GetAcc
+
+ |IL.opSUBFI:
+ PushAll(2);
+ CallRTL(IL._fsubi, 2);
+ GetAcc
+
+ |IL.opSUBF:
+ PushAll(2);
+ CallRTL(IL._fsub, 2);
+ GetAcc
+
+ |IL.opEQF..IL.opGEF:
+ PushAll(2);
+ pushc(opcode - IL.opEQF);
+ CallRTL(IL._fcmp, 3);
+ GetAcc
+
+ |IL.opFLOOR:
+ PushAll(1);
+ CallRTL(IL._floor, 1);
+ GetAcc
+
+ |IL.opFLT:
+ PushAll(1);
+ CallRTL(IL._flt, 1);
+ GetAcc
+
+ |IL.opUMINF:
+ UnOp(r1);
+ Emit(opRORC, r1, -1);
+ Emit(opXORC, r1, 1);
+ Emit(opRORC, r1, 1)
+
+ |IL.opFABS:
+ UnOp(r1);
+ Emit(opLSLC, r1, 1);
+ Emit(opLSRC, r1, 1)
+
+ |IL.opINF:
+ r1 := GetAnyReg();
+ Emit(opMOVC, r1, 1);
+ Emit(opRORC, r1, 1);
+ Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8));
+ Emit(opLSRC, r1, 1)
+
+ |IL.opPUSHF:
+ UnOp(r1);
+ push(r1);
+ drop
+
+ |IL.opPACK:
+ PushAll(2);
+ CallRTL(IL._pack, 2)
+
+ |IL.opPACKC:
+ PushAll(1);
+ pushc(param2);
+ CallRTL(IL._pack, 2)
+
+ |IL.opUNPK:
+ PushAll(2);
+ CallRTL(IL._unpk, 2)
+
+ |IL.opCODE:
+ OutInt(param2)
+
+ |IL.opLADR_SAVE:
+ UnOp(r1);
+ Emit(opST, BP * 256 + r1, param2 * szWord);
+ drop
+
+ |IL.opLADR_INCC:
+ r1 := GetAnyReg();
+ Emit(opLD, BP * 256 + r1, param1 * szWord);
+ Emit(opADDC, r1, param2);
+ Emit(opST, BP * 256 + r1, param1 * szWord);
+ drop
+
+ END;
+
+ cmd := cmd.next(IL.COMMAND)
+ END;
+
+ ASSERT(R.pushed = 0);
+ ASSERT(R.top = -1)
+END translate;
+
+
+PROCEDURE prolog;
+BEGIN
+ Emit(opLEA, SP + LStack * 256, 0);
+ Emit(opLEA, ACC + LTypes * 256, 0);
+ push(ACC);
+ Emit(opLEA, ACC + LHeap * 256, 0);
+ push(ACC);
+ pushc(CHL.Length(IL.codes.types));
+ CallRTL(IL._init, 3)
+END prolog;
+
+
+PROCEDURE epilog (ram, szWord: INTEGER);
+VAR
+ tcount, dcount, i, offTypes, offStrings,
+ szData, szGlobal, szHeapStack: INTEGER;
+
+BEGIN
+ Emit(opSTOP, 0, 0);
+
+ offTypes := count;
+
+ tcount := CHL.Length(IL.codes.types);
+ FOR i := 0 TO tcount - 1 DO
+ OutInt(CHL.GetInt(IL.codes.types, i))
+ END;
+
+ offStrings := count;
+ dcount := CHL.Length(IL.codes.data);
+ FOR i := 0 TO dcount - 1 DO
+ OutByte(CHL.GetByte(IL.codes.data, i))
+ END;
+
+ IF dcount MOD szWord # 0 THEN
+ i := szWord - dcount MOD szWord;
+ WHILE i > 0 DO
+ OutByte(0);
+ DEC(i)
+ END
+ END;
+
+ szData := count - offTypes;
+ szGlobal := (IL.codes.bss DIV szWord + 1) * szWord;
+ szHeapStack := ram - szData - szGlobal;
+
+ OutInt(offTypes);
+ OutInt(offStrings);
+ OutInt(szGlobal DIV szWord);
+ OutInt(szHeapStack DIV szWord);
+ FOR i := 1 TO 8 DO
+ OutInt(0)
+ END
+END epilog;
+
+
+PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
+CONST
+ minRAM = 32*1024;
+ maxRAM = 256*1024;
+
+VAR
+ szData, szRAM: INTEGER;
+
+BEGIN
+ szWord := TARGETS.WordSize;
+ IF szWord = 8 THEN
+ ldr := ldr64;
+ str := str64
+ ELSE
+ ldr := ldr32;
+ str := str32
+ END;
+ szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord;
+ szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
+
+ IF szRAM - szData < 1024*1024 THEN
+ ERRORS.Error(208)
+ END;
+
+ count := 0;
+ WR.Create(outname);
+
+ REG.Init(R, push, pop, mov, xchg, GPRs);
+
+ prolog;
+ translate(szWord);
+ epilog(szRAM, szWord);
+
+ WR.Close
+END CodeGen;
+
+
+END RVMxI.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/SCAN.ob07 b/programs/develop/oberon07/source/SCAN.ob07
similarity index 65%
rename from programs/develop/oberon07/Source/SCAN.ob07
rename to programs/develop/oberon07/source/SCAN.ob07
index c1c95571f..f32cf45f4 100644
--- a/programs/develop/oberon07/Source/SCAN.ob07
+++ b/programs/develop/oberon07/source/SCAN.ob07
@@ -1,18 +1,20 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
MODULE SCAN;
-IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
+IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
CONST
- LEXLEN = 1024;
+ NUMLEN = 256;
+ IDLEN = 256;
+ TEXTLEN = 512;
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
@@ -39,26 +41,33 @@ CONST
lxWHILE* = 83;
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
- lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
+ lxERROR05* = -5; (*lxERROR06* = -6;*) lxERROR07* = -7; lxERROR08* = -8;
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
lxERROR13* = -13;
TYPE
- LEXSTR* = ARRAY LEXLEN OF CHAR;
+ TEXTSTR* = ARRAY TEXTLEN OF CHAR;
+ IDSTR* = ARRAY IDLEN OF CHAR;
DEF = POINTER TO RECORD (LISTS.ITEM)
- ident: LEXSTR
+ ident: IDSTR
END;
- IDENT* = POINTER TO RECORD (AVL.DATA)
+ STRING* = POINTER TO RECORD (LISTS.ITEM)
- s*: LEXSTR;
- offset*, offsetW*: INTEGER;
- key: INTEGER
+ s*: TEXTSTR;
+ offset*, offsetW*, hash: INTEGER
+
+ END;
+
+ IDENT* = RECORD
+
+ s*: IDSTR;
+ hash*: INTEGER
END;
@@ -70,70 +79,89 @@ TYPE
LEX* = RECORD
- s*: LEXSTR;
- length*: INTEGER;
sym*: INTEGER;
pos*: POSITION;
ident*: IDENT;
- string*: IDENT;
+ string*: STRING;
value*: ARITH.VALUE;
- error*: INTEGER;
-
- over: BOOLEAN
+ error*: INTEGER
END;
SCANNER* = TXT.TEXT;
+ KEYWORD = ARRAY 10 OF CHAR;
+
VAR
- idents: AVL.NODE;
-
delimiters: ARRAY 256 OF BOOLEAN;
- NewIdent: IDENT;
-
upto, LowerCase, _if: BOOLEAN;
- def: LISTS.LIST;
+ strings, def: LISTS.LIST;
+
+ KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
-PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
- RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
-END nodecmp;
+PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
+BEGIN
+ KW[idx].lower := s;
+ KW[idx].upper := s;
+ S.UpCase(KW[idx].upper);
+ KW[idx].uhash := S.HashStr(KW[idx].upper);
+ KW[idx].lhash := S.HashStr(KW[idx].lower);
+END enterKW;
-PROCEDURE enterid* (s: LEXSTR): IDENT;
+PROCEDURE checkKW (ident: IDENT): INTEGER;
VAR
- newnode: BOOLEAN;
- node: AVL.NODE;
+ i, res: INTEGER;
BEGIN
- NewIdent.s := s;
- idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
-
- IF newnode THEN
- NEW(NewIdent);
- NewIdent.offset := -1;
- NewIdent.offsetW := -1;
- NewIdent.key := 0
+ res := lxIDENT;
+ i := 0;
+ WHILE i < LEN(KW) DO
+ IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
+ OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
+ res := i + lxKW;
+ i := LEN(KW)
+ END;
+ INC(i)
END
- RETURN node.data(IDENT)
-END enterid;
+ RETURN res
+END checkKW;
-PROCEDURE putchar (VAR lex: LEX; c: CHAR);
+PROCEDURE enterStr* (s: TEXTSTR): STRING;
+VAR
+ str, res: STRING;
+ hash: INTEGER;
+
BEGIN
- IF lex.length < LEXLEN - 1 THEN
- lex.s[lex.length] := c;
- INC(lex.length);
- lex.s[lex.length] := 0X
- ELSE
- lex.over := TRUE
+ hash := S.HashStr(s);
+ str := strings.first(STRING);
+ res := NIL;
+ WHILE str # NIL DO
+ IF (str.hash = hash) & (str.s = s) THEN
+ res := str;
+ str := NIL
+ ELSE
+ str := str.next(STRING)
+ END
+ END;
+ IF res = NIL THEN
+ NEW(res);
+ res.s := s;
+ res.offset := -1;
+ res.offsetW := -1;
+ res.hash := hash;
+ LISTS.push(strings, res)
END
-END putchar;
+
+ RETURN res
+END enterStr;
PROCEDURE nextc (text: TXT.TEXT): CHAR;
@@ -143,66 +171,92 @@ BEGIN
END nextc;
+PROCEDURE setIdent* (VAR ident: IDENT; s: IDSTR);
+BEGIN
+ ident.s := s;
+ ident.hash := S.HashStr(s)
+END setIdent;
+
+
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
VAR
c: CHAR;
+ i: INTEGER;
BEGIN
c := text.peak;
ASSERT(S.letter(c));
- WHILE S.letter(c) OR S.digit(c) DO
- putchar(lex, c);
+ i := 0;
+ WHILE (i < IDLEN - 1) & (S.letter(c) OR S.digit(c)) DO
+ lex.ident.s[i] := c;
+ INC(i);
c := nextc(text)
END;
- IF lex.over THEN
- lex.sym := lxERROR06
- ELSE
- lex.ident := enterid(lex.s);
- IF lex.ident.key # 0 THEN
- lex.sym := lex.ident.key
- ELSE
- lex.sym := lxIDENT
+ lex.ident.s[i] := 0X;
+ lex.ident.hash := S.HashStr(lex.ident.s);
+ lex.sym := checkKW(lex.ident);
+
+ IF S.letter(c) OR S.digit(c) THEN
+ ERRORS.WarningMsg(lex.pos.line, lex.pos.col, 2);
+ WHILE S.letter(c) OR S.digit(c) DO
+ c := nextc(text)
END
END
-
END ident;
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
+TYPE
+ NUMSTR = ARRAY NUMLEN OF CHAR;
+
VAR
c: CHAR;
hex: BOOLEAN;
- error, sym: INTEGER;
+ error, sym, i: INTEGER;
+ num: NUMSTR;
+
+
+ PROCEDURE push (VAR num: NUMSTR; VAR i: INTEGER; c: CHAR);
+ BEGIN
+ IF i < NUMLEN - 1 THEN
+ num[i] := c;
+ INC(i)
+ END
+ END push;
+
BEGIN
c := text.peak;
ASSERT(S.digit(c));
+ i := 0;
+
error := 0;
sym := lxINTEGER;
hex := FALSE;
WHILE S.digit(c) DO
- putchar(lex, c);
+ push(num, i, c);
c := nextc(text)
END;
- WHILE S.hexdigit(c) DO
- putchar(lex, c);
+ WHILE S.hexdigit(c) OR LowerCase & ("a" <= c) & (c <= "f") DO
+ S.cap(c);
+ push(num, i, c);
c := nextc(text);
hex := TRUE
END;
- IF c = "H" THEN
- putchar(lex, c);
+ IF (c = "H") OR LowerCase & (c = "h") THEN
+ push(num, i, c);
TXT.next(text);
sym := lxHEX
- ELSIF c = "X" THEN
- putchar(lex, c);
+ ELSIF (c = "X") OR LowerCase & (c = "x") THEN
+ push(num, i, c);
TXT.next(text);
sym := lxCHAR
@@ -215,7 +269,7 @@ BEGIN
c := nextc(text);
IF c # "." THEN
- putchar(lex, ".");
+ push(num, i, ".");
sym := lxFLOAT
ELSE
sym := lxINTEGER;
@@ -224,22 +278,22 @@ BEGIN
END;
WHILE S.digit(c) DO
- putchar(lex, c);
+ push(num, i, c);
c := nextc(text)
END;
- IF c = "E" THEN
+ IF (c = "E") OR LowerCase & (c = "e") THEN
- putchar(lex, c);
+ push(num, i, c);
c := nextc(text);
IF (c = "+") OR (c = "-") THEN
- putchar(lex, c);
+ push(num, i, c);
c := nextc(text)
END;
IF S.digit(c) THEN
WHILE S.digit(c) DO
- putchar(lex, c);
+ push(num, i, c);
c := nextc(text)
END
ELSE
@@ -255,16 +309,18 @@ BEGIN
END;
- IF lex.over & (sym >= 0) THEN
+ IF (i = NUMLEN - 1) & (sym >= 0) THEN
sym := lxERROR07
END;
+ num[i] := 0X;
+
IF sym = lxINTEGER THEN
- ARITH.iconv(lex.s, lex.value, error)
+ ARITH.iconv(num, lex.value, error)
ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
- ARITH.hconv(lex.s, lex.value, error)
+ ARITH.hconv(num, lex.value, error)
ELSIF sym = lxFLOAT THEN
- ARITH.fconv(lex.s, lex.value, error)
+ ARITH.fconv(num, lex.value, error)
END;
CASE error OF
@@ -283,36 +339,39 @@ END number;
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
VAR
c: CHAR;
- n: INTEGER;
+ i: INTEGER;
+ str: TEXTSTR;
BEGIN
c := nextc(text);
- n := 0;
- WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
- putchar(lex, c);
+ i := 0;
+ WHILE (i < LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
+ str[i] := c;
c := nextc(text);
- INC(n)
+ INC(i)
+ END;
+
+ str[i] := 0X;
+
+ IF (i = LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof THEN
+ lex.sym := lxERROR05
END;
IF c = quot THEN
TXT.next(text);
- IF lex.over THEN
- lex.sym := lxERROR05
+ IF i # 1 THEN
+ lex.sym := lxSTRING
ELSE
- IF n # 1 THEN
- lex.sym := lxSTRING
- ELSE
- lex.sym := lxCHAR;
- ARITH.setChar(lex.value, ORD(lex.s[0]))
- END
+ lex.sym := lxCHAR;
+ ARITH.setChar(lex.value, ORD(str[0]))
END
- ELSE
+ ELSIF lex.sym # lxERROR05 THEN
lex.sym := lxERROR03
END;
IF lex.sym = lxSTRING THEN
- lex.string := enterid(lex.s);
+ lex.string := enterStr(str);
lex.value.typ := ARITH.tSTRING;
lex.value.string := lex.string
END
@@ -357,15 +416,16 @@ BEGIN
END comment;
-PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
+PROCEDURE delimiter (text: TXT.TEXT; c: CHAR): INTEGER;
VAR
sym: INTEGER;
+ c0: CHAR;
BEGIN
- putchar(lex, c);
+ c0 := c;
c := nextc(text);
- CASE lex.s[0] OF
+ CASE c0 OF
|"+":
sym := lxPLUS
@@ -396,7 +456,6 @@ BEGIN
IF c = "." THEN
sym := lxRANGE;
- putchar(lex, c);
TXT.next(text)
END
@@ -438,7 +497,6 @@ BEGIN
IF c = "=" THEN
sym := lxLE;
- putchar(lex, c);
TXT.next(text)
END
@@ -447,7 +505,6 @@ BEGIN
IF c = "=" THEN
sym := lxGE;
- putchar(lex, c);
TXT.next(text)
END
@@ -456,7 +513,6 @@ BEGIN
IF c = "=" THEN
sym := lxASSIGN;
- putchar(lex, c);
TXT.next(text)
END
@@ -469,10 +525,9 @@ BEGIN
|"}":
sym := lxRCURLY
- END;
-
- lex.sym := sym
+ END
+ RETURN sym
END delimiter;
@@ -538,7 +593,7 @@ VAR
check(lex.sym = lxIDENT, text, lex, 22);
REPEAT
- IF IsDef(lex.s) THEN
+ IF IsDef(lex.ident.s) THEN
skip := FALSE
END;
@@ -590,12 +645,8 @@ BEGIN
c := nextc(text)
END;
- lex.s[0] := 0X;
- lex.length := 0;
lex.pos.line := text.line;
lex.pos.col := text.col;
- lex.ident := NIL;
- lex.over := FALSE;
IF S.letter(c) THEN
ident(text, lex)
@@ -604,7 +655,7 @@ BEGIN
ELSIF (c = '"') OR (c = "'") THEN
string(text, lex, c)
ELSIF delimiters[ORD(c)] THEN
- delimiter(text, lex, c)
+ lex.sym := delimiter(text, c)
ELSIF c = "$" THEN
IF S.letter(nextc(text)) THEN
ident(text, lex);
@@ -631,12 +682,9 @@ BEGIN
ELSIF (c = 7FX) & upto THEN
upto := FALSE;
lex.sym := lxRANGE;
- putchar(lex, ".");
- putchar(lex, ".");
DEC(lex.pos.col);
TXT.next(text)
ELSE
- putchar(lex, c);
TXT.next(text);
lex.sym := lxERROR04
END;
@@ -668,24 +716,6 @@ VAR
i: INTEGER;
delim: ARRAY 23 OF CHAR;
-
- PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
- VAR
- id: IDENT;
- upper: LEXSTR;
-
- BEGIN
- IF LowerCase THEN
- id := enterid(kw);
- id.key := key
- END;
- upper := kw;
- S.UpCase(upper);
- id := enterid(upper);
- id.key := key
- END enterkw;
-
-
BEGIN
upto := FALSE;
LowerCase := lower;
@@ -700,48 +730,39 @@ BEGIN
delimiters[ORD(delim[i])] := TRUE
END;
- NEW(NewIdent);
- NewIdent.s := "";
- NewIdent.offset := -1;
- NewIdent.offsetW := -1;
- NewIdent.key := 0;
-
- idents := NIL;
-
- enterkw(lxARRAY, "array");
- enterkw(lxBEGIN, "begin");
- enterkw(lxBY, "by");
- enterkw(lxCASE, "case");
- enterkw(lxCONST, "const");
- enterkw(lxDIV, "div");
- enterkw(lxDO, "do");
- enterkw(lxELSE, "else");
- enterkw(lxELSIF, "elsif");
- enterkw(lxEND, "end");
- enterkw(lxFALSE, "false");
- enterkw(lxFOR, "for");
- enterkw(lxIF, "if");
- enterkw(lxIMPORT, "import");
- enterkw(lxIN, "in");
- enterkw(lxIS, "is");
- enterkw(lxMOD, "mod");
- enterkw(lxMODULE, "module");
- enterkw(lxNIL, "nil");
- enterkw(lxOF, "of");
- enterkw(lxOR, "or");
- enterkw(lxPOINTER, "pointer");
- enterkw(lxPROCEDURE, "procedure");
- enterkw(lxRECORD, "record");
- enterkw(lxREPEAT, "repeat");
- enterkw(lxRETURN, "return");
- enterkw(lxTHEN, "then");
- enterkw(lxTO, "to");
- enterkw(lxTRUE, "true");
- enterkw(lxTYPE, "type");
- enterkw(lxUNTIL, "until");
- enterkw(lxVAR, "var");
- enterkw(lxWHILE, "while")
-
+ enterKW("array", 0);
+ enterKW("begin", 1);
+ enterKW("by", 2);
+ enterKW("case", 3);
+ enterKW("const", 4);
+ enterKW("div", 5);
+ enterKW("do", 6);
+ enterKW("else", 7);
+ enterKW("elsif", 8);
+ enterKW("end", 9);
+ enterKW("false", 10);
+ enterKW("for", 11);
+ enterKW("if", 12);
+ enterKW("import", 13);
+ enterKW("in", 14);
+ enterKW("is", 15);
+ enterKW("mod", 16);
+ enterKW("module", 17);
+ enterKW("nil", 18);
+ enterKW("of", 19);
+ enterKW("or", 20);
+ enterKW("pointer", 21);
+ enterKW("procedure", 22);
+ enterKW("record", 23);
+ enterKW("repeat", 24);
+ enterKW("return", 25);
+ enterKW("then", 26);
+ enterKW("to", 27);
+ enterKW("true", 28);
+ enterKW("type", 29);
+ enterKW("until", 30);
+ enterKW("var", 31);
+ enterKW("while", 32)
END init;
@@ -757,5 +778,6 @@ END NewDef;
BEGIN
- def := LISTS.create(NIL)
+ def := LISTS.create(NIL);
+ strings := LISTS.create(NIL)
END SCAN.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/STATEMENTS.ob07 b/programs/develop/oberon07/source/STATEMENTS.ob07
similarity index 93%
rename from programs/develop/oberon07/Source/STATEMENTS.ob07
rename to programs/develop/oberon07/source/STATEMENTS.ob07
index a873af1b4..cb6cfa4ff 100644
--- a/programs/develop/oberon07/Source/STATEMENTS.ob07
+++ b/programs/develop/oberon07/source/STATEMENTS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -9,7 +9,7 @@ MODULE STATEMENTS;
IMPORT
- PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVM32I,
+ PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVMxI,
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
@@ -26,8 +26,9 @@ CONST
errCHR = 9; errWCHR = 10; errBYTE = 11;
chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
+ chkSTK* = MSP430.chkSTK; (* 6 *)
- chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};
+ chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE, chkSTK};
TYPE
@@ -207,7 +208,7 @@ BEGIN
IF e._type = tCHAR THEN
res := 1
ELSE
- res := LENGTH(e.value.string(SCAN.IDENT).s)
+ res := LENGTH(e.value.string(SCAN.STRING).s)
END
RETURN res
END strlen;
@@ -240,7 +241,7 @@ BEGIN
IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
res := 1
ELSE
- res := _length(e.value.string(SCAN.IDENT).s)
+ res := _length(e.value.string(SCAN.STRING).s)
END
RETURN res
END utf8strlen;
@@ -301,11 +302,11 @@ END assigncomp;
PROCEDURE String (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
- string: SCAN.IDENT;
+ string: SCAN.STRING;
BEGIN
IF strlen(e) # 1 THEN
- string := e.value.string(SCAN.IDENT);
+ string := e.value.string(SCAN.STRING);
IF string.offset = -1 THEN
string.offset := IL.putstr(string.s);
END;
@@ -321,11 +322,11 @@ END String;
PROCEDURE StringW (e: PARS.EXPR): INTEGER;
VAR
offset: INTEGER;
- string: SCAN.IDENT;
+ string: SCAN.STRING;
BEGIN
IF utf8strlen(e) # 1 THEN
- string := e.value.string(SCAN.IDENT);
+ string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
@@ -334,7 +335,7 @@ BEGIN
IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
offset := IL.putstrW1(ARITH.Int(e.value))
ELSE (* e._type.typ = PROG.tSTRING *)
- string := e.value.string(SCAN.IDENT);
+ string := e.value.string(SCAN.STRING);
IF string.offsetW = -1 THEN
string.offsetW := IL.putstrW(string.s);
END;
@@ -383,7 +384,7 @@ BEGIN
END;
IL.AddCmd(IL.opCOPYA, VarType.base.size);
label := IL.NewLabel();
- IL.AddJmpCmd(IL.opJNZ, label);
+ IL.Jmp(IL.opJNZ, label);
IL.OnError(line, errCOPY);
IL.SetLabel(label)
@@ -436,7 +437,7 @@ BEGIN
ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
- IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
+ IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isCharW(e) & (VarType = tWCHAR) THEN
IF e.obj = eCONST THEN
IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
@@ -608,7 +609,7 @@ BEGIN
IL.Const(0);
IL.Param1
ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
- IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s));
+ IL.Const(StrToWChar(e.value.string(SCAN.STRING).s));
IL.Param1
ELSIF (e._type.typ = PROG.tSTRING) OR
(e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
@@ -709,12 +710,6 @@ BEGIN
getpos(parser, pos);
- IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
- IF parser.unit.scopeLvl > 0 THEN
- parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE
- END
- END;
-
IF e.obj IN {eSTPROC, eSYSPROC} THEN
CASE proc OF
@@ -1146,11 +1141,12 @@ BEGIN
END
|PROG.stORD:
+ IL.AddCmd(IL.opPRECALL, 0);
PExpression(parser, e);
PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
IF e.obj = eCONST THEN
IF isStringW1(e) THEN
- ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
+ ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
ELSE
ARITH.ord(e.value)
END
@@ -1382,7 +1378,7 @@ BEGIN
IF chkPTR IN Options.checking THEN
label := IL.NewLabel();
- IL.AddJmpCmd(IL.opJNZ1, label);
+ IL.Jmp(IL.opJNZ1, label);
IL.OnError(pos.line, error);
IL.SetLabel(label)
END
@@ -1551,7 +1547,9 @@ BEGIN
PARS.checklex(parser, SCAN.lxRSQUARE);
PARS.Next(parser);
- e.ident := NIL
+ IF ~(isArr(e) & (e._type.length = 0) & (parser.sym = SCAN.lxLSQUARE)) THEN
+ e.ident := NIL
+ END
ELSIF parser.sym = SCAN.lxCARET DO
getpos(parser, pos);
@@ -1628,7 +1626,7 @@ BEGIN
IL.setlast(begcall);
IL.AddCmd(IL.opPRECALL, ORD(isfloat));
- IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
+ IF cconv IN {PROG._ccall, PROG.ccall} THEN
IL.AddCmd(IL.opALIGN16, parSize)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
IL.AddCmd(IL.opWIN64ALIGN16, parSize)
@@ -1646,7 +1644,7 @@ BEGIN
IL.CallP(callconv, fparSize)
END;
- IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
+ IF cconv IN {PROG._ccall, PROG.ccall} THEN
IL.AddCmd(IL.opCLEANUP, parSize);
IL.AddCmd0(IL.opPOPSP)
ELSIF cconv IN {PROG._win64, PROG.win64} THEN
@@ -1655,7 +1653,7 @@ BEGIN
ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
IL.AddCmd0(IL.opPOPSP)
- ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN
+ ELSIF cconv IN {PROG._cdecl, PROG.cdecl, PROG.default16, PROG.code, PROG._code} THEN
IL.AddCmd(IL.opCLEANUP, parSize)
END;
@@ -1912,10 +1910,10 @@ VAR
label := IL.NewLabel()
END;
- IF e.obj = eCONST THEN
+ IF (e.obj = eCONST) & isBoolean(e) THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
- IL.AndOrOpt(label)
+ IL.Jmp(IL.opJZ, label)
END
END;
@@ -2011,7 +2009,7 @@ VAR
ELSE
IF e1.obj # eCONST THEN
label1 := IL.NewLabel();
- IL.AddJmpCmd(IL.opJG, label1)
+ IL.Jmp(IL.opJG, label1)
END;
IF e.obj = eCONST THEN
IL.OnError(pos.line, errDIV);
@@ -2030,7 +2028,7 @@ VAR
|SCAN.lxAND:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
+ IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
ARITH.opBoolean(e.value, e1.value, "&")
ELSE
e.obj := eEXPR;
@@ -2044,12 +2042,12 @@ VAR
IF label # -1 THEN
label1 := IL.NewLabel();
- IL.AddJmpCmd(IL.opJNZ, label1);
+ IL.Jmp(IL.opJNZ, label1);
IL.SetLabel(label);
IL.Const(0);
IL.drop;
label := IL.NewLabel();
- IL.AddJmpCmd(IL.opJMP, label);
+ IL.Jmp(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(1);
IL.SetLabel(label);
@@ -2063,7 +2061,7 @@ VAR
pos: PARS.POSITION;
op: INTEGER;
e1: PARS.EXPR;
- s, s1: SCAN.LEXSTR;
+ s, s1: SCAN.TEXTSTR;
plus, minus: BOOLEAN;
@@ -2117,11 +2115,10 @@ VAR
label := IL.NewLabel()
END;
- IF e.obj = eCONST THEN
+ IF (e.obj = eCONST) & isBoolean(e) THEN
IL.Const(ORD(ARITH.getBool(e.value)))
END;
- IL.not;
- IL.AndOrOpt(label)
+ IL.Jmp(IL.opJNZ, label)
END
END;
@@ -2155,15 +2152,15 @@ VAR
IF e.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e.value, s)
ELSE
- s := e.value.string(SCAN.IDENT).s
+ s := e.value.string(SCAN.STRING).s
END;
IF e1.value.typ = ARITH.tCHAR THEN
ARITH.charToStr(e1.value, s1)
ELSE
- s1 := e1.value.string(SCAN.IDENT).s
+ s1 := e1.value.string(SCAN.STRING).s
END;
PARS.check(ARITH.concat(s, s1), pos, 5);
- e.value.string := SCAN.enterid(s);
+ e.value.string := SCAN.enterStr(s);
e.value.typ := ARITH.tSTRING;
e._type := PROG.program.stTypes.tSTRING
END
@@ -2202,7 +2199,7 @@ VAR
|SCAN.lxOR:
PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
+ IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
ARITH.opBoolean(e.value, e1.value, "|")
ELSE
e.obj := eEXPR;
@@ -2216,12 +2213,12 @@ VAR
IF label # -1 THEN
label1 := IL.NewLabel();
- IL.AddJmpCmd(IL.opJZ, label1);
+ IL.Jmp(IL.opJZ, label1);
IL.SetLabel(label);
IL.Const(1);
IL.drop;
label := IL.NewLabel();
- IL.AddJmpCmd(IL.opJMP, label);
+ IL.Jmp(IL.opJMP, label);
IL.SetLabel(label1);
IL.Const(0);
IL.SetLabel(label);
@@ -2371,10 +2368,10 @@ BEGIN
END
ELSIF isStringW1(e) & isCharW(e1) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s))
+ IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
+ IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isBoolean(e) & isBoolean(e1) THEN
IF constant THEN
@@ -2488,10 +2485,10 @@ BEGIN
END
ELSIF isStringW1(e) & isCharW(e1) THEN
- IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s))
+ IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))
ELSIF isStringW1(e1) & isCharW(e) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s))
+ IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
ELSIF isReal(e) & isReal(e1) THEN
IF constant THEN
@@ -2641,7 +2638,7 @@ BEGIN
L := IL.NewLabel();
IF ~_if THEN
- IL.AddCmd0(IL.opLOOP);
+ IL.AddCmd(IL.opNOP, IL.begin_loop);
IL.SetLabel(L)
END;
@@ -2655,7 +2652,7 @@ BEGIN
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
- IL.AddJmpCmd(IL.opJMP, label)
+ IL.Jmp(IL.opJMP, label)
END
ELSE
IL.AndOrOpt(label)
@@ -2671,7 +2668,7 @@ BEGIN
parser.StatSeq(parser);
IF ~_if OR (parser.sym # SCAN.lxEND) THEN
- IL.AddJmpCmd(IL.opJMP, L)
+ IL.Jmp(IL.opJMP, L)
END;
IL.SetLabel(label)
@@ -2684,7 +2681,7 @@ BEGIN
END;
IL.SetLabel(L)
ELSE
- IL.AddCmd0(IL.opENDLOOP)
+ IL.AddCmd(IL.opNOP, IL.end_loop)
END;
PARS.checklex(parser, SCAN.lxEND);
@@ -2701,7 +2698,7 @@ VAR
L: IL.COMMAND;
BEGIN
- IL.AddCmd0(IL.opLOOP);
+ IL.AddCmd(IL.opNOP, IL.begin_loop);
label := IL.NewLabel();
IL.SetLabel(label);
@@ -2716,14 +2713,14 @@ BEGIN
IF e.obj = eCONST THEN
IF ~ARITH.getBool(e.value) THEN
- IL.AddJmpCmd(IL.opJMP, label)
+ IL.Jmp(IL.opJMP, label)
END
ELSE
IL.AndOrOpt(label);
L.param1 := label
END;
- IL.AddCmd0(IL.opENDLOOP)
+ IL.AddCmd(IL.opNOP, IL.end_loop)
END RepeatStatement;
@@ -2797,8 +2794,8 @@ VAR
a := ARITH.getInt(value)
ELSIF isCharW(caseExpr) THEN
PARS.ConstExpression(parser, value);
- IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
- ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
+ IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
+ ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
ELSE
PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
END;
@@ -2927,7 +2924,7 @@ VAR
END;
parser.StatSeq(parser);
- IL.AddJmpCmd(IL.opJMP, _end);
+ IL.Jmp(IL.opJMP, _end);
IF isRecPtr(caseExpr) THEN
caseExpr.ident._type := t
@@ -2976,7 +2973,7 @@ VAR
IL.SetLabel(node.data(CASE_LABEL).self);
IL._case(range.a, range.b, L, R);
IF v.processed THEN
- IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant)
+ IL.Jmp(IL.opJMP, node.data(CASE_LABEL).variant)
END;
v.processed := TRUE;
@@ -3010,7 +3007,7 @@ VAR
_else := IL.NewLabel();
table := IL.NewLabel();
IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
- IL.AddJmpCmd(IL.opJMP, table);
+ IL.Jmp(IL.opJMP, table);
tree := NIL;
@@ -3024,7 +3021,7 @@ VAR
IF parser.sym = SCAN.lxELSE THEN
PARS.Next(parser);
parser.StatSeq(parser);
- IL.AddJmpCmd(IL.opJMP, _end)
+ IL.Jmp(IL.opJMP, _end)
ELSE
IL.OnError(pos.line, errCASE)
END;
@@ -3035,7 +3032,7 @@ VAR
IF isRecPtr(e) THEN
IL.SetLabel(table);
TableT(tree);
- IL.AddJmpCmd(IL.opJMP, _else)
+ IL.Jmp(IL.opJMP, _else)
ELSE
tree.data(CASE_LABEL).self := table;
Table(tree, _else)
@@ -3094,7 +3091,7 @@ VAR
L1, L2: INTEGER;
BEGIN
- IL.AddCmd0(IL.opLOOP);
+ IL.AddCmd(IL.opNOP, IL.begin_loop);
L1 := IL.NewLabel();
L2 := IL.NewLabel();
@@ -3167,7 +3164,7 @@ BEGIN
END
END;
- IL.AddJmpCmd(IL.opJZ, L2);
+ IL.Jmp(IL.opJZ, L2);
PARS.checklex(parser, SCAN.lxDO);
PARS.Next(parser);
@@ -3181,15 +3178,14 @@ BEGIN
IL.AddCmd(IL.opINCC, st);
- IL.AddJmpCmd(IL.opJMP, L1);
+ IL.Jmp(IL.opJMP, L1);
PARS.checklex(parser, SCAN.lxEND);
PARS.Next(parser);
IL.SetLabel(L2);
- IL.AddCmd0(IL.opENDLOOP)
-
+ IL.AddCmd(IL.opNOP, IL.end_loop)
END ForStatement;
@@ -3260,12 +3256,14 @@ VAR
rtl: PROG.UNIT;
- PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER);
+ PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.IDSTR; idx: INTEGER);
VAR
id: PROG.IDENT;
+ ident: SCAN.IDENT;
BEGIN
- id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
+ SCAN.setIdent(ident, name);
+ id := PROG.getIdent(rtl, ident, FALSE);
IF (id # NIL) & (id._import # NIL) THEN
IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
@@ -3307,7 +3305,7 @@ BEGIN
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_dllentry", IL._dllentry);
getproc(rtl, "_sofinit", IL._sofinit)
- ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} THEN
+ ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
getproc(rtl, "_fmul", IL._fmul);
getproc(rtl, "_fdiv", IL._fdiv);
getproc(rtl, "_fdivi", IL._fdivi);
@@ -3319,7 +3317,7 @@ BEGIN
getproc(rtl, "_flt", IL._flt);
getproc(rtl, "_pack", IL._pack);
getproc(rtl, "_unpk", IL._unpk);
- IF CPU = TARGETS.cpuRVM32I THEN
+ IF CPU IN {TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
getproc(rtl, "_error", IL._error)
END
END
@@ -3355,13 +3353,13 @@ BEGIN
IF TARGETS.RTL THEN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
- IF parser.open(parser, UTILS.RTL_NAME) THEN
+ IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
PARS.destroy(parser);
parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
- IF parser.open(parser, UTILS.RTL_NAME) THEN
+ IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
parser.parse(parser);
PARS.destroy(parser)
ELSE
@@ -3373,7 +3371,7 @@ BEGIN
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
parser.main := TRUE;
- IF parser.open(parser, modname) THEN
+ IF parser.open(parser, modname, UTILS.FILE_EXT) THEN
parser.parse(parser)
ELSE
ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
@@ -3398,7 +3396,8 @@ BEGIN
|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
- |TARGETS.cpuRVM32I: RVM32I.CodeGen(outname, target, options)
+ |TARGETS.cpuRVM32I,
+ TARGETS.cpuRVM64I: RVMxI.CodeGen(outname, target, options)
END
END compile;
diff --git a/programs/develop/oberon07/Source/STRINGS.ob07 b/programs/develop/oberon07/source/STRINGS.ob07
similarity index 77%
rename from programs/develop/oberon07/Source/STRINGS.ob07
rename to programs/develop/oberon07/source/STRINGS.ob07
index 8dfcb66d0..410944769 100644
--- a/programs/develop/oberon07/Source/STRINGS.ob07
+++ b/programs/develop/oberon07/source/STRINGS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -73,17 +73,6 @@ BEGIN
END IntToStr;
-PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
-BEGIN
- str[n] := 0X;
- WHILE n > 0 DO
- str[n - 1] := CHR(UTILS.hexdgt(x MOD 16));
- x := x DIV 16;
- DEC(n)
- END
-END IntToHex;
-
-
PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
VAR
length: INTEGER;
@@ -110,6 +99,47 @@ BEGIN
END search;
+PROCEDURE replace* (VAR s: ARRAY OF CHAR; find, repl: CHAR);
+VAR
+ i, strlen: INTEGER;
+
+BEGIN
+ strlen := LENGTH(s) - 1;
+ FOR i := 0 TO strlen DO
+ IF s[i] = find THEN
+ s[i] := repl
+ END
+ END
+END replace;
+
+
+PROCEDURE trim* (source: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
+VAR
+ LenS, start, _end, i, j: INTEGER;
+
+BEGIN
+ LenS := LENGTH(source) - 1;
+ j := 0;
+ IF LenS >= 0 THEN
+ start := 0;
+ WHILE (start <= LenS) & (source[start] <= 20X) DO
+ INC(start)
+ END;
+
+ _end := LenS;
+ WHILE (_end >= 0) & (source[_end] <= 20X) DO
+ DEC(_end)
+ END;
+
+ FOR i := start TO _end DO
+ result[j] := source[i];
+ INC(j)
+ END
+ END;
+ result[j] := 0X
+END trim;
+
+
PROCEDURE letter* (c: CHAR): BOOLEAN;
RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") OR (c = "_")
END letter;
@@ -130,7 +160,7 @@ PROCEDURE space* (c: CHAR): BOOLEAN;
END space;
-PROCEDURE cap (VAR c: CHAR);
+PROCEDURE cap* (VAR c: CHAR);
BEGIN
IF ("a" <= c) & (c <= "z") THEN
c := CHR(ORD(c) - 32)
@@ -290,4 +320,23 @@ BEGIN
END Utf8To16;
+PROCEDURE HashStr* (name: ARRAY OF CHAR): INTEGER;
+VAR
+ i, h: INTEGER;
+ g: SET;
+
+BEGIN
+ h := 0;
+ i := 0;
+ WHILE name[i] # 0X DO
+ h := h * 16 + ORD(name[i]);
+ g := BITS(h) * {28..31};
+ h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
+ INC(i)
+ END
+
+ RETURN h
+END HashStr;
+
+
END STRINGS.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/TARGETS.ob07 b/programs/develop/oberon07/source/TARGETS.ob07
similarity index 81%
rename from programs/develop/oberon07/Source/TARGETS.ob07
rename to programs/develop/oberon07/source/TARGETS.ob07
index 58d7e0183..0b87e5838 100644
--- a/programs/develop/oberon07/Source/TARGETS.ob07
+++ b/programs/develop/oberon07/source/TARGETS.ob07
@@ -1,12 +1,14 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
MODULE TARGETS;
+IMPORT UTILS;
+
CONST
@@ -25,17 +27,21 @@ CONST
Linux64SO* = 12;
STM32CM3* = 13;
RVM32I* = 14;
+ RVM64I* = 15;
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
- cpuRVM32I* = 4;
+ cpuRVM32I* = 4; cpuRVM64I* = 5;
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
- noDISPOSE = {MSP430, STM32CM3, RVM32I};
+ noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I};
noRTL = {MSP430};
+ libRVM32I = "RVMxI" + UTILS.slash + "32";
+ libRVM64I = "RVMxI" + UTILS.slash + "64";
+
TYPE
@@ -51,9 +57,9 @@ TYPE
VAR
- Targets*: ARRAY 15 OF TARGET;
+ Targets*: ARRAY 16 OF TARGET;
- CPUs: ARRAY 5 OF
+ CPUs: ARRAY 6 OF
RECORD
BitDepth, InstrSize: INTEGER;
LittleEndian: BOOLEAN
@@ -126,20 +132,22 @@ BEGIN
EnterCPU(cpuMSP430, 16, 2, TRUE);
EnterCPU(cpuTHUMB, 32, 2, TRUE);
EnterCPU(cpuRVM32I, 32, 4, TRUE);
+ EnterCPU(cpuRVM64I, 64, 8, TRUE);
- Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex");
- Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows32", ".exe");
- Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows32", ".exe");
- Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows32", ".dll");
- Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", "");
- Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj");
- Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows64", ".exe");
- Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows64", ".exe");
- Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows64", ".dll");
- Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux32", "");
- Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux32", ".so");
- Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux64", "");
- Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux64", ".so");
- Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
- Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", "RVM32I", ".bin");
+ Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex");
+ Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows", ".exe");
+ Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows", ".exe");
+ Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows", ".dll");
+ Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", "");
+ Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj");
+ Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows", ".exe");
+ Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows", ".exe");
+ Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows", ".dll");
+ Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux", "");
+ Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux", ".so");
+ Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux", "");
+ Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux", ".so");
+ Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
+ Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", libRVM32I, ".bin");
+ Enter( RVM64I, cpuRVM64I, 8, osNONE, "rvm64i", libRVM64I, ".bin");
END TARGETS.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/TEXTDRV.ob07 b/programs/develop/oberon07/source/TEXTDRV.ob07
similarity index 100%
rename from programs/develop/oberon07/Source/TEXTDRV.ob07
rename to programs/develop/oberon07/source/TEXTDRV.ob07
diff --git a/programs/develop/oberon07/Source/THUMB.ob07 b/programs/develop/oberon07/source/THUMB.ob07
similarity index 88%
rename from programs/develop/oberon07/Source/THUMB.ob07
rename to programs/develop/oberon07/source/THUMB.ob07
index cfc3a52f6..f53cd57c8 100644
--- a/programs/develop/oberon07/Source/THUMB.ob07
+++ b/programs/develop/oberon07/source/THUMB.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2019-2020, Anton Krotov
+ Copyright (c) 2019-2021, Anton Krotov
All rights reserved.
*)
@@ -23,11 +23,18 @@ CONST
inf = 7F800000H;
- STM32_minROM* = 16; STM32_maxROM* = 65536;
- STM32_minRAM* = 4; STM32_maxRAM* = 65536;
+ minROM* = 16; maxROM* = 65536;
+ minRAM* = 4; maxRAM* = 65536;
maxIVT* = 1023;
+ _THUMB2 = 0; _IT = 1; _SDIV = 2; _CBXZ = 3;
+
+ CortexM0 = {};
+ CortexM1 = {};
+ CortexM3 = {_THUMB2, _IT, _SDIV, _CBXZ};
+ CortexM23 = {_SDIV, _CBXZ};
+
TYPE
@@ -103,7 +110,8 @@ VAR
IVTLen,
MinStack,
Reserved: INTEGER;
- InstrSet: RECORD thumb2, it, cbxz, sdiv: BOOLEAN END
+ InstrSet: SET;
+ isNXP: BOOLEAN
END;
IVT: ARRAY maxIVT + 1 OF INTEGER;
@@ -475,7 +483,7 @@ END Cmp;
PROCEDURE Tst (r: INTEGER);
BEGIN
- gen3(1, r, 0) (* cmp r, #0 *)
+ gen3(1, r, 0) (* cmp r, 0 *)
END Tst;
@@ -533,8 +541,6 @@ VAR
shorted: BOOLEAN;
jump: JUMP;
- first, second: INTEGER;
-
reloc, i, diff, len: INTEGER;
RelocCode: RELOCCODE;
@@ -555,14 +561,6 @@ VAR
END genjmp;
- PROCEDURE genlongjmp (offset: INTEGER; VAR first, second: INTEGER);
- BEGIN
- ASSERT(srange(offset, 22));
- first := 0F000H + ASR(offset, 11) MOD 2048;
- second := 0F800H + offset MOD 2048
- END genlongjmp;
-
-
PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE);
VAR
imm1, imm3, imm4, imm8: INTEGER;
@@ -576,17 +574,17 @@ VAR
PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE);
BEGIN
- IF Target.InstrSet.thumb2 THEN
+ IF _THUMB2 IN Target.InstrSet THEN
movwt(r, low(value), 0, code);
movwt(r, high(value), 1, code)
ELSE
- code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* mov r, #imm8 *)
- code[1] := 0200H + r * 9; (* lsl r, r, #8 *)
- code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* add r, #imm8 *)
- code[3] := code[1]; (* lsl r, r, #8 *)
- code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* add r, #imm8 *)
- code[5] := code[1]; (* lsl r, r, #8 *)
- code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* add r, #imm8 *)
+ code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* movs r, imm8 *)
+ code[1] := 0200H + r * 9; (* lsls r, 8 *)
+ code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* adds r, imm8 *)
+ code[3] := code[1]; (* lsls r, 8 *)
+ code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* adds r, imm8 *)
+ code[5] := code[1]; (* lsls r, 8 *)
+ code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* adds r, imm8 *)
END
END genmovimm32;
@@ -597,19 +595,22 @@ VAR
END PutCode;
- PROCEDURE genbc (code: JUMP);
- VAR
- first, second: INTEGER;
+ PROCEDURE genlongjmp (offset: INTEGER);
+ BEGIN
+ ASSERT(srange(offset, 22));
+ PutCode(0F000H + ASR(offset, 11) MOD 2048);
+ PutCode(0F800H + offset MOD 2048)
+ END genlongjmp;
+
+ PROCEDURE genbc (code: JUMP);
BEGIN
CASE code.len OF
|1: PutCode(genjcc(code.cond, code.diff))
|2: PutCode(genjcc(inv0(code.cond), 0));
PutCode(genjmp(code.diff))
|3: PutCode(genjcc(inv0(code.cond), 1));
- genlongjmp(code.diff, first, second);
- PutCode(first);
- PutCode(second)
+ genlongjmp(code.diff)
END
END genbc;
@@ -647,7 +648,7 @@ BEGIN
|CODE: INC(count)
|LABEL: BIN.SetLabel(program, code.label, count)
|JUMP: INC(count, code.len); code.offset := count + ORD(code.short)
- |RELOC: INC(count, 7 - ORD(Target.InstrSet.thumb2) * 3 + code.rel MOD 2)
+ |RELOC: INC(count, 7 - ORD(_THUMB2 IN Target.InstrSet) * 3 + code.rel MOD 2)
END;
code := code.next(ANYCODE)
@@ -714,27 +715,22 @@ BEGIN
IF code.len = 1 THEN
PutCode(genjmp(code.diff))
ELSE
- genlongjmp(code.diff, first, second);
- PutCode(first);
- PutCode(second)
+ genlongjmp(code.diff)
END
|JCC: genbc(code)
|CBXZ:
IF code.len > 1 THEN
- PutCode(2800H + code.reg * 256); (* cmp code.reg, #0 *)
+ PutCode(2800H + code.reg * 256); (* cmp code.reg, 0 *)
DEC(code.len);
genbc(code)
ELSE
(* cb(n)z code.reg, L *)
- PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * ORD(code.diff >= 32) + (code.diff MOD 32) * 8 + code.reg)
+ PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * (code.diff DIV 32) + (code.diff MOD 32) * 8 + code.reg)
END
- |CALL:
- genlongjmp(code.diff, first, second);
- PutCode(first);
- PutCode(second)
+ |CALL: genlongjmp(code.diff)
|RELOC:
CASE code.rel OF
@@ -743,14 +739,14 @@ BEGIN
|BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
- DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(Target.InstrSet.thumb2) + 9))
+ DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(_THUMB2 IN Target.InstrSet) + 9))
END;
genmovimm32(code.reg, reloc, RelocCode);
- FOR i := 0 TO 6 - 3 * ORD(Target.InstrSet.thumb2) DO
+ FOR i := 0 TO 6 - 3 * ORD(_THUMB2 IN Target.InstrSet) DO
PutCode(RelocCode[i])
END;
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN
- PutCode(4478H + code.reg) (* add code.reg, PC *)
+ PutCode(4478H + code.reg) (* add code.reg, pc *)
END
END;
@@ -858,7 +854,7 @@ BEGIN
MovImm8(r, 1);
LslImm(r, 31)
ELSE
- IF Target.InstrSet.thumb2 THEN
+ IF _THUMB2 IN Target.InstrSet THEN
movwt(r, low(c), 0);
IF (c < 0) OR (c > 65535) THEN
movwt(r, high(c), 1)
@@ -897,7 +893,7 @@ VAR
L1, L2: INTEGER;
BEGIN
- IF Target.InstrSet.it THEN
+ IF _IT IN Target.InstrSet THEN
Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *)
MovConst(r, 1);
MovConst(r, 0)
@@ -938,12 +934,8 @@ BEGIN
ELSE
SubImm8(r, -n)
END
- ELSIF Target.InstrSet.thumb2 & (-4095 <= n) & (n <= 4095) THEN
- IF n > 0 THEN
- AddSubImm12(r, n, FALSE)
- ELSE
- AddSubImm12(r, -n, TRUE)
- END
+ ELSIF (_THUMB2 IN Target.InstrSet) & (-4095 <= n) & (n <= 4095) THEN
+ AddSubImm12(r, ABS(n), n < 0)
ELSE
r2 := GetAnyReg();
ASSERT(r2 # r);
@@ -971,7 +963,7 @@ PROCEDURE AddSP (n: INTEGER);
BEGIN
IF n > 0 THEN
IF n < 127 THEN
- Code(0B000H + n) (* add sp, n*4 *)
+ Code(0B000H + n) (* add sp, n*4 *)
ELSE
ASSERT(R2 IN R.regs);
MovConst(R2, n * 4);
@@ -982,25 +974,26 @@ BEGIN
END AddSP;
-PROCEDURE cbz (r, label: INTEGER);
+PROCEDURE cbxz2 (c, r, label: INTEGER);
BEGIN
- IF Target.InstrSet.cbxz THEN
- cbxz(je, r, label)
+ IF _CBXZ IN Target.InstrSet THEN
+ cbxz(c, r, label)
ELSE
Tst(r);
- jcc(je, label)
+ jcc(c, label)
END
+END cbxz2;
+
+
+PROCEDURE cbz (r, label: INTEGER);
+BEGIN
+ cbxz2(je, r, label)
END cbz;
PROCEDURE cbnz (r, label: INTEGER);
BEGIN
- IF Target.InstrSet.cbxz THEN
- cbxz(jne, r, label)
- ELSE
- Tst(r);
- jcc(jne, label)
- END
+ cbxz2(jne, r, label)
END cbnz;
@@ -1053,6 +1046,18 @@ BEGIN
END divmod;
+PROCEDURE cpsid_i;
+BEGIN
+ Code(0B672H) (* cpsid i *)
+END cpsid_i;
+
+
+PROCEDURE cpsie_i;
+BEGIN
+ Code(0B662H) (* cpsie i *)
+END cpsie_i;
+
+
PROCEDURE translate (pic, stroffs: INTEGER);
VAR
cmd, next: COMMAND;
@@ -1103,7 +1108,7 @@ BEGIN
Label(param1);
- gen14(FALSE, TRUE, {}); (* push LR *)
+ gen14(FALSE, TRUE, {}); (* push {lr} *)
n := param2;
IF n >= 5 THEN
@@ -1128,9 +1133,7 @@ BEGIN
IF opcode # IL.opLEAVE THEN
UnOp(r1);
IF r1 # ACC THEN
- GetRegA;
- ASSERT(REG.Exchange(R, r1, ACC));
- drop
+ mov(ACC, r1)
END;
drop
END;
@@ -1139,10 +1142,10 @@ BEGIN
ASSERT(StkCount = param1);
AddSP(param1);
- gen14(TRUE, TRUE, {}) (* pop PC *)
+ gen14(TRUE, TRUE, {}) (* pop {pc} *)
|IL.opLEAVEC:
- gen5(3, FALSE, TRUE, 6, 0) (* bx LR *)
+ gen5(3, FALSE, TRUE, 6, 0) (* bx lr *)
|IL.opPRECALL:
PushAll(0)
@@ -1169,6 +1172,7 @@ BEGIN
PushConst(param2)
|IL.opONERR:
+ cpsid_i;
MovConst(R0, param2);
push(R0);
DEC(StkCount);
@@ -1203,6 +1207,38 @@ BEGIN
reloc(r1, BIN.RBSS + pic, param2);
Ldr8(r1, r1)
+ |IL.opLADR_SAVE:
+ UnOp(r1);
+ n := LocalOffset(param2);
+ IF n <= 255 THEN
+ gen11(FALSE, r1, n) (* str r1, [sp, n*4] *)
+ ELSE
+ LocAdr(param2);
+ BinOp(r1, r2);
+ Str32(r1, r2);
+ drop
+ END;
+ drop
+
+ |IL.opLADR_INCC:
+ n := LocalOffset(param1);
+ IF n <= 255 THEN
+ r1 := GetAnyReg();
+ LdrSp(r1, n);
+ AddConst(r1, param2);
+ gen11(FALSE, r1, n) (* str r1, [sp, n*4] *)
+ ELSE
+ LocAdr(param1);
+ r1 := GetAnyReg();
+ BinOp(r2, r1);
+ Ldr32(r1, r2);
+ AddConst(r1, param2);
+ BinOp(r2, r1);
+ Str32(r1, r2);
+ drop
+ END;
+ drop
+
|IL.opLLOAD32, IL.opVADR, IL.opVLOAD32:
r1 := GetAnyReg();
n := LocalOffset(param2);
@@ -1402,8 +1438,12 @@ BEGIN
|IL.opCASELR:
GetRegA;
CmpConst(ACC, param1);
- jcc(jl, param2);
- jcc(jg, cmd.param3);
+ IF param2 = cmd.param3 THEN
+ jcc(jne, param2)
+ ELSE
+ jcc(jl, param2);
+ jcc(jg, cmd.param3)
+ END;
drop
|IL.opCODE:
@@ -1549,11 +1589,11 @@ BEGIN
|IL.opCHR:
UnOp(r1);
- Code(0B2C0H + r1 * 9) (* uxtb r1 *)
+ Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *)
|IL.opWCHR:
UnOp(r1);
- Code(0B280H + r1 * 9) (* uxth r1 *)
+ Code(0B280H + r1 * 9) (* uxth r1, r1 *)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
BinOp(r1, r2);
@@ -1615,8 +1655,6 @@ BEGIN
INCL(R.regs, r1);
ASSERT(REG.GetReg(R, r1))
- |IL.opLOOP, IL.opENDLOOP:
-
|IL.opINF:
MovConst(GetAnyReg(), inf)
@@ -1720,46 +1758,46 @@ BEGIN
|IL.opMULS:
BinOp(r1, r2);
- gen4(0, r2, r1); (* and r1, r2 *)
+ gen4(0, r2, r1); (* ands r1, r2 *)
drop
|IL.opMULSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
- gen4(0, r2, r1); (* and r1, r2 *)
+ gen4(0, r2, r1); (* ands r1, r2 *)
drop
|IL.opDIVS:
BinOp(r1, r2);
- gen4(1, r2, r1); (* eor r1, r2 *)
+ gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opDIVSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
- gen4(1, r2, r1); (* eor r1, r2 *)
+ gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opADDS:
BinOp(r1, r2);
- gen4(12, r2, r1); (* orr r1, r2 *)
+ gen4(12, r2, r1); (* orrs r1, r2 *)
drop
|IL.opSUBS:
BinOp(r1, r2);
- gen4(14, r2, r1); (* bic r1, r2 *)
+ gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opADDSC:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
- gen4(12, r2, r1); (* orr r1, r2 *)
+ gen4(12, r2, r1); (* orrs r1, r2 *)
drop
|IL.opSUBSL:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
- gen4(14, r1, r2); (* bic r2, r1 *)
+ gen4(14, r1, r2); (* bics r2, r1 *)
INCL(R.regs, r1);
DEC(R.top);
R.stk[R.top] := r2
@@ -1767,12 +1805,12 @@ BEGIN
|IL.opSUBSR:
MovConst(GetAnyReg(), param2);
BinOp(r1, r2);
- gen4(14, r2, r1); (* bic r1, r2 *)
+ gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opUMINS:
UnOp(r1);
- gen4(15, r1, r1) (* mvn r1, r1 *)
+ gen4(15, r1, r1) (* mvns r1, r1 *)
|IL.opINCL, IL.opEXCL:
BinOp(r1, r2);
@@ -1781,12 +1819,12 @@ BEGIN
CmpConst(r1, 32);
L := NewLabel();
jcc(jnb, L);
- gen4(2, r1, r3); (* lsl r3, r1 *)
+ gen4(2, r1, r3); (* lsls r3, r1 *)
Ldr32(r1, r2);
IF opcode = IL.opINCL THEN
- gen4(12, r3, r1) (* orr r1, r3 *)
+ gen4(12, r3, r1) (* orrs r1, r3 *)
ELSE
- gen4(14, r3, r1) (* bic r1, r3 *)
+ gen4(14, r3, r1) (* bics r1, r3 *)
END;
Str32(r1, r2);
Label(L);
@@ -1802,9 +1840,9 @@ BEGIN
LslImm(r3, param2);
Ldr32(r1, r2);
IF opcode = IL.opINCLC THEN
- gen4(12, r3, r1) (* orr r1, r3 *)
+ gen4(12, r3, r1) (* orrs r1, r3 *)
ELSE
- gen4(14, r3, r1) (* bic r1, r3 *)
+ gen4(14, r3, r1) (* bics r1, r3 *)
END;
Str32(r1, r2);
drop;
@@ -1902,9 +1940,9 @@ BEGIN
IF n > 0 THEN
UnOp(r1);
IF n = 8 THEN
- Code(0B2C0H + r1 * 9) (* uxtb r1 *)
+ Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *)
ELSIF n = 16 THEN
- Code(0B280H + r1 * 9) (* uxth r1 *)
+ Code(0B280H + r1 * 9) (* uxth r1, r1 *)
ELSE
LslImm(r1, 32 - n);
LsrImm(r1, 32 - n)
@@ -1946,7 +1984,7 @@ BEGIN
Label(L);
MovConst(r3, 1);
Shift(IL.opLSL, r3, r1);
- gen4(0, r3, r2); (* and r2, r3 *)
+ gen4(0, r3, r2); (* ands r2, r3 *)
SetCC(jne, r1);
Label(L2);
drop;
@@ -1956,7 +1994,7 @@ BEGIN
UnOp(r1);
r2 := GetAnyReg();
MovConst(r2, LSL(1, param2));
- gen4(0, r2, r1); (* and r1, r2 *)
+ gen4(0, r2, r1); (* ands r1, r2 *)
SetCC(jne, r1);
drop
@@ -2039,7 +2077,7 @@ BEGIN
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
- gen4(1, r2, r1); (* eor r1, r2 *)
+ gen4(1, r2, r1); (* eors r1, r2 *)
drop
|IL.opFABS:
@@ -2047,16 +2085,18 @@ BEGIN
r2 := GetAnyReg();
MovConst(r2, 1);
LslImm(r2, 31);
- gen4(14, r2, r1); (* bic r1, r2 *)
+ gen4(14, r2, r1); (* bics r1, r2 *)
drop
|IL.opNEW:
+ cpsid_i;
PushAll(1);
- n := param2 + 8;
- ASSERT(UTILS.Align(n, 32));
+ n := param2 + 4;
+ ASSERT(UTILS.Align(n, 4));
PushConst(n);
PushConst(param1);
- CallRTL(IL._new, 3)
+ CallRTL(IL._new, 3);
+ cpsie_i
|IL.opTYPEGP:
UnOp(r1);
@@ -2132,7 +2172,7 @@ BEGIN
END translate;
-PROCEDURE prolog (GlobSize, tcount, pic, FlashAdr, sp, ivt_len: INTEGER);
+PROCEDURE prolog (GlobSize, tcount, pic, sp, ivt_len: INTEGER);
VAR
r1, r2, i, dcount: INTEGER;
@@ -2158,6 +2198,7 @@ BEGIN
END;
Label(entry);
+ cpsie_i;
r1 := GetAnyReg();
r2 := GetAnyReg();
@@ -2201,14 +2242,14 @@ VAR
L1, L2, L3, L4: INTEGER;
BEGIN
- Code(0BF30H); (* L2: wfi *)
- Code(0E7FDH); (* b L2 *)
+ (* L2: *)
+ Code(0E7FEH); (* b L2 *)
Label(genInt);
- Code(0F3EFH); Code(08105H); (* mrs r1, ipsr *)
- gen14(FALSE, TRUE, {R1}); (* push {LR, R1} *)
+ Code(0F3EFH); Code(08005H); (* mrs r0, ipsr *)
+ gen14(FALSE, TRUE, {R0}); (* push {lr, r0} *)
call(int0);
- gen14(TRUE, TRUE, {R1}); (* pop {PC, R1} *)
+ gen14(TRUE, TRUE, {R0}); (* pop {pc, r0} *)
Label(emptyProc);
Code(04770H); (* bx lr *)
@@ -2218,20 +2259,20 @@ BEGIN
call(entry);
Label(sdivProc);
- IF Target.InstrSet.sdiv THEN
- Code(09800H); (* ldr r0, [sp + #0] *)
- Code(09901H); (* ldr r1, [sp + #4] *)
- Code(0FB91H); (* sdiv r2, r1, r0 *)
+ IF _SDIV IN Target.InstrSet THEN
+ Code(09800H); (* ldr r0, [sp] *)
+ Code(09901H); (* ldr r1, [sp, 4] *)
+ Code(0FB91H); (* sdiv r2, r1, r0 *)
Code(0F2F0H);
- Code(00013H); (* mov r3, r2 *)
- Code(04343H); (* mul r3, r0 *)
- Code(01AC9H); (* sub r1, r3 *)
- Code(0DA01H); (* bge L *)
- Code(04401H); (* add r1, r0 *)
- Code(03A01H); (* sub r2, #1 *)
- (* L: *)
- Code(00010H); (* mov r0, r2 *)
- Code(04770H); (* bx lr *)
+ Code(00013H); (* movs r3, r2 *)
+ Code(04343H); (* muls r3, r0, r3 *)
+ Code(01AC9H); (* subs r1, r1, r3 *)
+ Code(0DA01H); (* bge L *)
+ Code(01809H); (* adds r1, r1, r0 *)
+ Code(03A01H); (* subs r2, 1 *)
+ (* L: *)
+ Code(00010H); (* movs r0, r2 *)
+ Code(04770H); (* bx lr *)
ELSE
(* a / b; a >= 0 *)
L1 := NewLabel();
@@ -2303,35 +2344,34 @@ BEGIN
END epilog;
-PROCEDURE CortexM3;
+PROCEDURE SetTarget (FlashStart, SRAMStart: INTEGER; InstrSet: SET; isNXP: BOOLEAN);
BEGIN
- Target.FlashAdr := 08000000H;
- Target.SRAMAdr := 20000000H;
- Target.IVTLen := 256;
+ Target.FlashAdr := FlashStart;
+ Target.SRAMAdr := SRAMStart;
+ Target.InstrSet := InstrSet;
+ Target.isNXP := isNXP;
+
+ Target.IVTLen := 256; (* >= 192 *)
Target.Reserved := 0;
Target.MinStack := 512;
- Target.InstrSet.thumb2 := TRUE;
- Target.InstrSet.it := TRUE;
- Target.InstrSet.sdiv := TRUE;
- Target.InstrSet.cbxz := TRUE
-END CortexM3;
+END SetTarget;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
opt: PROG.OPTIONS;
- ram, rom: INTEGER;
+ ram, rom, i, j: INTEGER;
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
BEGIN
- IF target = TARGETS.STM32CM3 THEN
- CortexM3
- END;
+ ram := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
+ rom := MIN(MAX(options.rom, minROM), maxROM) * 1024;
- ram := MIN(MAX(options.ram, STM32_minRAM), STM32_maxRAM) * 1024;
- rom := MIN(MAX(options.rom, STM32_minROM), STM32_maxROM) * 1024;
+ IF target = TARGETS.STM32CM3 THEN
+ SetTarget(08000000H, 20000000H, CortexM3, FALSE)
+ END;
tcount := CHL.Length(IL.codes.types);
@@ -2340,7 +2380,7 @@ BEGIN
program := BIN.create(IL.codes.lcount);
- REG.Init(R, push, pop, mov, xchg, NIL, NIL, {R0, R1, R2, R3}, {});
+ REG.Init(R, push, pop, mov, xchg, {R0, R1, R2, R3});
StkCount := 0;
@@ -2357,7 +2397,7 @@ BEGIN
BssSize := IL.codes.bss;
ASSERT(UTILS.Align(BssSize, 4));
- prolog(BssSize, tcount, ORD(opt.pic), Target.FlashAdr, Target.SRAMAdr + ram, Target.IVTLen);
+ prolog(BssSize, tcount, ORD(opt.pic), Target.SRAMAdr + ram, Target.IVTLen);
translate(ORD(opt.pic), tcount * 4);
epilog;
@@ -2374,6 +2414,16 @@ BEGIN
ERRORS.Error(204)
END;
+ IF Target.isNXP THEN
+ BIN.put32le(program.code, 2FCH, 0H); (* code read protection (CRP) *)
+ (* NXP checksum *)
+ j := 0;
+ FOR i := 0 TO 6 DO
+ INC(j, BIN.get32le(program.code, i * 4))
+ END;
+ BIN.put32le(program.code, 1CH, -j)
+ END;
+
WR.Create(outname);
HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr));
@@ -2381,11 +2431,10 @@ BEGIN
WR.Close;
- C.StringLn("--------------------------------------------");
+ C.Dashes;
C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)");
C.Ln;
- C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)")
-
+ C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)")
END CodeGen;
diff --git a/programs/develop/oberon07/Source/UTILS.ob07 b/programs/develop/oberon07/source/UTILS.ob07
similarity index 85%
rename from programs/develop/oberon07/Source/UTILS.ob07
rename to programs/develop/oberon07/source/UTILS.ob07
index 6b77353cb..d854e0639 100644
--- a/programs/develop/oberon07/Source/UTILS.ob07
+++ b/programs/develop/oberon07/source/UTILS.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -23,7 +23,8 @@ CONST
max32* = 2147483647;
vMajor* = 1;
- vMinor* = 43;
+ vMinor* = 52;
+ Date* = "07-may-2021";
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
@@ -162,20 +163,9 @@ END Byte;
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
-VAR
- res: BOOLEAN;
-
BEGIN
- IF bytes MOD align # 0 THEN
- res := maxint - bytes >= align - (bytes MOD align);
- IF res THEN
- bytes := bytes + align - (bytes MOD align)
- END
- ELSE
- res := TRUE
- END
-
- RETURN res
+ INC(bytes, (-bytes) MOD align)
+ RETURN bytes >= 0
END Align;
@@ -221,6 +211,6 @@ END hexdgt;
BEGIN
- time := GetTickCount();
+ time := HOST.GetTickCount();
maxreal := HOST.maxreal
END UTILS.
\ No newline at end of file
diff --git a/programs/develop/oberon07/Source/WRITER.ob07 b/programs/develop/oberon07/source/WRITER.ob07
similarity index 86%
rename from programs/develop/oberon07/Source/WRITER.ob07
rename to programs/develop/oberon07/source/WRITER.ob07
index bfb180676..14d7882ca 100644
--- a/programs/develop/oberon07/Source/WRITER.ob07
+++ b/programs/develop/oberon07/source/WRITER.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -18,10 +18,7 @@ VAR
PROCEDURE align* (n, _align: INTEGER): INTEGER;
BEGIN
- IF n MOD _align # 0 THEN
- INC(n, _align - (n MOD _align))
- END
-
+ ASSERT(UTILS.Align(n, _align))
RETURN n
END align;
diff --git a/programs/develop/oberon07/Source/X86.ob07 b/programs/develop/oberon07/source/X86.ob07
similarity index 95%
rename from programs/develop/oberon07/Source/X86.ob07
rename to programs/develop/oberon07/source/X86.ob07
index de1759228..770777163 100644
--- a/programs/develop/oberon07/Source/X86.ob07
+++ b/programs/develop/oberon07/source/X86.ob07
@@ -1,7 +1,7 @@
(*
BSD 2-Clause License
- Copyright (c) 2018-2020, Anton Krotov
+ Copyright (c) 2018-2021, Anton Krotov
All rights reserved.
*)
@@ -851,9 +851,7 @@ BEGIN
IF opcode = IL.opLEAVER THEN
UnOp(reg1);
IF reg1 # eax THEN
- GetRegA;
- ASSERT(REG.Exchange(R, reg1, eax));
- drop
+ mov(eax, reg1)
END;
drop
END;
@@ -872,10 +870,8 @@ BEGIN
pop(ebp);
- n := param2;
- IF n > 0 THEN
- n := n * 4;
- OutByte(0C2H); OutWord(n MOD 65536) (* ret n *)
+ IF param2 > 0 THEN
+ OutByte(0C2H); OutWord(param2 * 4 MOD 65536) (* ret param2*4 *)
ELSE
ret
END
@@ -1321,8 +1317,12 @@ BEGIN
|IL.opCASELR:
cmprc(eax, param1);
- jcc(jl, param2);
- jcc(jg, cmd.param3)
+ IF param2 = cmd.param3 THEN
+ jcc(jne, param2)
+ ELSE
+ jcc(jl, param2);
+ jcc(jg, cmd.param3)
+ END
|IL.opCODE:
OutByte(param2)
@@ -2176,8 +2176,6 @@ BEGIN
|IL.opFNAME:
fname := cmd(IL.FNAMECMD).fname
- |IL.opLOOP, IL.opENDLOOP:
-
END;
cmd := cmd.next(COMMAND)
@@ -2374,7 +2372,7 @@ BEGIN
opt.pic := TRUE
END;
- REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {});
+ REG.Init(R, push, pop, mov, xchg, {eax, ecx, edx});
prolog(opt.pic, target, opt.stack, dllinit, dllret);
translate(opt.pic, tcount * 4);
diff --git a/programs/develop/oberon07/tools/RVMxI.ob07 b/programs/develop/oberon07/tools/RVMxI.ob07
new file mode 100644
index 000000000..af40b4481
--- /dev/null
+++ b/programs/develop/oberon07/tools/RVMxI.ob07
@@ -0,0 +1,668 @@
+(*
+ BSD 2-Clause License
+
+ Copyright (c) 2020-2021, Anton Krotov
+ All rights reserved.
+*)
+
+(*
+ RVMxI executor and disassembler
+
+ Usage:
+ RVMxI.exe -run [program parameters]
+ RVMxI.exe -dis