Aren
/
kolibrios
mirror of https://github.com/KolibriOS/kolibrios.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

oberon07: update (v1.13) 

git-svn-id: svn://kolibrios.org@7696 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2019-10-06 17:55:12 +00:00
parent d364a86956
commit 4f802a86ba
68 changed files with 1872 additions and 1909 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
programs/develop/oberon07/Compiler.kex
View File

Binary file not shown.

46
programs/develop/oberon07/Docs/About1251.txt
View File

@ -9,8 +9,7 @@ UTF-8
Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF.
Параметры:
1) имя главного модуля
2) èìÿ ðåçóëüòèðóþùåãî ôàéëà
3) òèï ïðèëîæåíèÿ è ïëàòôîðìà
2) òèï ïðèëîæåíèÿ
"console" - Windows console
"gui" - Windows GUI
"dll" - Windows DLL
@ -18,11 +17,14 @@ UTF-8
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá)
-base <address> àäðåñ çàãðóçêè èñïîëíÿåìîãî ôàéëà â êèëîáàéòàõ
-ver <major.minor> âåðñèÿ ïðîãðàììû (òîëüêî äëÿ obj)
3) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è
-out <file_name> èìÿ ðåçóëüòèðóþùåãî ôàéëà; ïî óìîë÷àíèþ,
ñîâïàäàåò ñ èìåíåì ãëàâíîãî ìîäóëÿ, íî ñ äðóãèì ðàñøèðåíèåì
(ñîîòâåòñòâóåò òèïó èñïîëíÿåìîãî ôàéëà)
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá,
äîïóñòèìî îò 1 äî 32 Ìá)
-nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
-ver <major.minor> âåðñèÿ ïðîãðàììû (òîëüêî äëÿ obj)
параметр -nochk задается в виде строки из символов:
"p" - указатели
@ -42,13 +44,13 @@ UTF-8
Например:
Compiler.exe "C:\example.ob07" "C:\example.exe" console -stk 1
Compiler.exe "C:\example.ob07" "C:\example.dll" dll
Compiler.exe "C:\example.ob07" "C:\example.exe" gui -stk 4
Compiler.exe "C:\example.ob07" "C:\example.exe" console -nochk pti
Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.kex" kos -stk 2
Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.obj" obj -ver 2.7
Compiler.exe "C:\example.ob07" "C:\example" elfexe
Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1
Compiler.exe "C:\example.ob07" dll -out "C:\example.dll"
Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4
Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti
Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4
Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7
Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a
В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
При работе компилятора в KolibriOS, код завершения не передается.
@ -166,24 +168,6 @@ UTF-8
например:
SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *)
Òàêæå â ìîäóëå SYSTEM îïðåäåëåí òèï CARD16 (2 áàéòà). Äëÿ òèïà CARD16 íå
äîïóñêàþòñÿ íèêàêèå ÿâíûå îïåðàöèè, çà èñêëþ÷åíèåì ïðèñâàèâàíèÿ.
Ïðåîáðàçîâàíèÿ CARD16 -> INTEGER è INTEGER -> CARD16 ìîãóò áûòü ðåàëèçîâàíû
òàê:
PROCEDURE Card16ToInt (w: SYSTEM.CARD16): INTEGER;
VAR i: INTEGER;
BEGIN
SYSTEM.PUT(SYSTEM.ADR(i), w)
RETURN i
END Card16ToInt;
PROCEDURE IntToCard16 (i: INTEGER): SYSTEM.CARD16;
VAR w: SYSTEM.CARD16;
BEGIN
SYSTEM.GET(SYSTEM.ADR(i), w)
RETURN w
END IntToCard16;
Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.

46
programs/develop/oberon07/Docs/About866.txt
View File

@ -9,8 +9,7 @@ UTF-8
‚ë室 - ¨á¯®­ï¥¬ë© ä ©« ä®à¬ â  PE32, ELF ¨«¨ MENUET01/MSCOFF.
<20> à ¬¥âàë:
1) ¨¬ï £« ¢­®£® ¬®¤ã«ï
2) ¨¬ï १ã«ìâ¨àãî饣® ä ©« 
3) ⨯ ¯à¨«®¦¥­¨ï ¨ ¯« âä®à¬ 
2) ⨯ ¯à¨«®¦¥­¨ï
"console" - Windows console
"gui" - Windows GUI
"dll" - Windows DLL
@ -18,11 +17,14 @@ UTF-8
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡)
-base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å
-ver <major.minor> ¢¥àá¨ï ¯à®£à ¬¬ë (⮫쪮 ¤«ï obj)
3) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-out <file_name> ¨¬ï १ã«ìâ¨àãî饣® ä ©« ; ¯® 㬮«ç ­¨î,
ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ £« ¢­®£® ¬®¤ã«ï, ­® á ¤à㣨¬ à áè¨à¥­¨¥¬
(ᮮ⢥âáâ¢ã¥â ⨯㠨ᯮ«­ï¥¬®£® ä ©« )
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡,
¤®¯ãá⨬® ®â 1 ¤® 32 Œ¡)
-nochk <"ptibcwra"> ®âª«îç¨âì ¯à®¢¥àª¨ ¯à¨ ¢ë¯®«­¥­¨¨ (á¬. ­¨¦¥)
-ver <major.minor> ¢¥àá¨ï ¯à®£à ¬¬ë (⮫쪮 ¤«ï obj)
¯ à ¬¥âà -nochk § ¤ ¥âáï ¢ ¢¨¤¥ áâப¨ ¨§ ᨬ¢®«®¢:
"p" - 㪠§ â¥«¨
@ -42,13 +44,13 @@ UTF-8
<20> ¯à¨¬¥à:
Compiler.exe "C:\example.ob07" "C:\example.exe" console -stk 1
Compiler.exe "C:\example.ob07" "C:\example.dll" dll
Compiler.exe "C:\example.ob07" "C:\example.exe" gui -stk 4
Compiler.exe "C:\example.ob07" "C:\example.exe" console -nochk pti
Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.kex" kos -stk 2
Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.obj" obj -ver 2.7
Compiler.exe "C:\example.ob07" "C:\example" elfexe
Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1
Compiler.exe "C:\example.ob07" dll -out "C:\example.dll"
Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4
Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti
Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4
Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7
Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a
‚ á«ãç ¥ ãᯥ譮© ª®¬¯¨«ï樨, ª®¬¯¨«ïâ®à ¯¥à¥¤ ¥â ª®¤ § ¢¥à襭¨ï 0, ¨­ ç¥ 1.
<EFBFBD>ਠࠡ®â¥ ª®¬¯¨«ïâ®à  ¢ KolibriOS, ª®¤ § ¢¥à襭¨ï ­¥ ¯¥à¥¤ ¥âáï.
@ -166,24 +168,6 @@ UTF-8
­ ¯à¨¬¥à:
SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *)
’ ª¦¥ ¢ ¬®¤ã«¥ SYSTEM ®¯à¥¤¥«¥­ ⨯ CARD16 (2 ¡ ©â ). „«ï ⨯  CARD16 ­¥
¤®¯ã᪠îâáï ­¨ª ª¨¥ ï¢­ë¥ ®¯¥à æ¨¨, §  ¨áª«î祭¨¥¬ ¯à¨á¢ ¨¢ ­¨ï.
<EFBFBD>८¡à §®¢ ­¨ï CARD16 -> INTEGER ¨ INTEGER -> CARD16 ¬®£ãâ ¡ëâì ॠ«¨§®¢ ­ë
â ª:
PROCEDURE Card16ToInt (w: SYSTEM.CARD16): INTEGER;
VAR i: INTEGER;
BEGIN
SYSTEM.PUT(SYSTEM.ADR(i), w)
RETURN i
END Card16ToInt;
PROCEDURE IntToCard16 (i: INTEGER): SYSTEM.CARD16;
VAR w: SYSTEM.CARD16;
BEGIN
SYSTEM.GET(SYSTEM.ADR(i), w)
RETURN w
END IntToCard16;
”㭪樨 ¯á¥¢¤®¬®¤ã«ï SYSTEM ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ª®­áâ ­â­ëå ¢ëà ¦¥­¨ïå.

4
programs/develop/oberon07/Docs/KOSLib1251.txt
View File

@ -307,7 +307,7 @@ MODULE Read -
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN
PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN
------------------------------------------------------------------------------
MODULE Write - çàïèñü îñíîâíûõ òèïîâ äàííûõ â ôàéë F
@ -326,7 +326,7 @@ MODULE Write -
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN
PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN
------------------------------------------------------------------------------
MODULE DateTime - äàòà, âðåìÿ

4
programs/develop/oberon07/Docs/KOSLib866.txt
View File

@ -307,7 +307,7 @@ MODULE Read -
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN
PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN
------------------------------------------------------------------------------
MODULE Write - § ¯¨áì ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¢ ä ©« F
@ -326,7 +326,7 @@ MODULE Write -
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN
PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN
------------------------------------------------------------------------------
MODULE DateTime - ¤ â , ¢à¥¬ï

6
programs/develop/oberon07/Lib/KolibriOS/API.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
@ -18,6 +18,8 @@ CONST
_new = 1;
_dispose = 2;
SizeOfHeader = 36;
TYPE
@ -294,7 +296,7 @@ PROCEDURE init* (_import, code: INTEGER);
BEGIN
multi := FALSE;
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
base := code - 36;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init;

2
programs/develop/oberon07/Lib/KolibriOS/Args.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/Console.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/Debug.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/File.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

6
programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -205,7 +205,7 @@ BEGIN
END Create;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
n: INTEGER;
fs: FS;

2
programs/develop/oberon07/Lib/KolibriOS/In.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

4
programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

2
programs/develop/oberon07/Lib/KolibriOS/Math.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2013, 2014, 2018, 2019 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/Out.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

288
programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -21,8 +21,8 @@ CONST
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
WORD = bit_depth DIV 8;
MAX_SET = bit_depth - 1;
TYPE
@ -35,6 +35,7 @@ VAR
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
dll: RECORD
process_detach,
@ -45,35 +46,9 @@ VAR
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: 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, 00CH, (* mov esi, dword [ebp + 12] *)
08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *)
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] _move2* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
@ -92,7 +67,7 @@ BEGIN
05FH (* pop edi *)
(* L: *)
)
END _move2;
END _move;
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
@ -103,7 +78,7 @@ BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, src, dst);
_move(len_src * base_size, dst, src);
res := TRUE
END
@ -113,7 +88,7 @@ END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
@ -144,7 +119,7 @@ BEGIN
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
a := LSR(ASR(minint, b - a), MAX_SET - b)
ELSE
a := 0
END
@ -153,69 +128,42 @@ BEGIN
END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
BEGIN
IF ASR(a, 5) = 0 THEN
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
ELSE
a := 0
END
RETURN a
END _set1;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L1 *)
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 *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
089H, 011H, (* mov dword [ecx], edx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
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 *)
)
RETURN 0
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
DEC(div)
END
RETURN div
END _div2;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
INC(mod, y)
END
RETURN mod
END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
END _div;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
END _mod;
END _divmod;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
@ -223,7 +171,7 @@ BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, SIZE_OF_DWORD)
INC(ptr, WORD)
END
END _new;
@ -231,15 +179,14 @@ END _new;
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
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 *)
@ -250,19 +197,14 @@ BEGIN
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
RETURN 0
END _length;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER;
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 *)
@ -277,58 +219,92 @@ BEGIN
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H, (* shr eax, 1 *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
0D1H, 0E8H (* shr eax, 1 *)
)
RETURN 0
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): 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
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 strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): 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
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;
@ -507,7 +483,7 @@ END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
@ -567,14 +543,6 @@ BEGIN
END _dllentry;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
@ -596,13 +564,19 @@ BEGIN
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
SYSTEM.GET(_types + t1 * WORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
j := 1;
FOR i := 0 TO MAX_SET DO
bits[i] := j;
j := LSL(j, 1)
END;
name := modname;
dll.process_detach := NIL;
@ -621,6 +595,14 @@ BEGIN
END _sofinit;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini

2
programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 KolibriOS team
This program is free software: you can redistribute it and/or modify

8
programs/develop/oberon07/Lib/KolibriOS/Read.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -39,8 +39,8 @@ PROCEDURE Set*(F: File.FS; VAR x: SET): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
END Set;
PROCEDURE Card16*(F: File.FS; VAR x: sys.CARD16): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(sys.CARD16)) = sys.SIZE(sys.CARD16)
END Card16;
PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
END WChar;
END Read.

8
programs/develop/oberon07/Source/UNIXTIME.ob07 → programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07
View File

@ -1,11 +1,11 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
MODULE UNIXTIME;
MODULE UnixTime;
VAR
@ -61,4 +61,4 @@ END time;
BEGIN
init
END UNIXTIME.
END UnixTime.

2
programs/develop/oberon07/Lib/KolibriOS/Vector.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify

8
programs/develop/oberon07/Lib/KolibriOS/Write.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -39,8 +39,8 @@ PROCEDURE Set*(F: File.FS; x: SET): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
END Set;
PROCEDURE Card16*(F: File.FS; x: sys.CARD16): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(sys.CARD16)) = sys.SIZE(sys.CARD16)
END Card16;
PROCEDURE WChar*(F: File.FS; x: WCHAR): BOOLEAN;
RETURN File.Write(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
END WChar;
END Write.

2
programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify

2
programs/develop/oberon07/Lib/KolibriOS/libimg.ob07
View File

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 KolibriOS team
This program is free software: you can redistribute it and/or modify

12
programs/develop/oberon07/Lib/Linux32/API.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
@ -12,7 +12,7 @@ IMPORT SYSTEM;
CONST
BASE_ADR = 08048000H;
RTLD_LAZY* = 1;
TYPE
@ -23,7 +23,7 @@ TYPE
VAR
eol*: ARRAY 2 OF CHAR;
base*, MainParam*: INTEGER;
MainParam*: INTEGER;
libc*, librt*: INTEGER;
@ -93,6 +93,7 @@ END _DISPOSE;
PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
VAR
sym: INTEGER;
BEGIN
sym := dlsym(lib, SYSTEM.ADR(name[0]));
ASSERT(sym # 0);
@ -105,10 +106,9 @@ BEGIN
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
MainParam := sp;
base := BASE_ADR;
eol := 0AX;
libc := dlopen(SYSTEM.SADR("libc.so.6"), 1);
libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc));
GetProcAdr(libc, "free", SYSTEM.ADR(free));
GetProcAdr(libc, "exit", SYSTEM.ADR(_exit));
@ -125,7 +125,7 @@ BEGIN
GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose));
GetProcAdr(libc, "time", SYSTEM.ADR(time));
librt := dlopen(SYSTEM.SADR("librt.so.1"), 1);
librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
END init;

18
programs/develop/oberon07/Lib/Linux32/HOST.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
@ -68,22 +68,12 @@ BEGIN
END GetCurrentDirectory;
PROCEDURE ReadFile (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F)
END ReadFile;
PROCEDURE WriteFile (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F)
END WriteFile;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := ReadFile(F, Buffer, bytes);
res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN
res := -1
END
@ -97,7 +87,7 @@ VAR
res: INTEGER;
BEGIN
res := WriteFile(F, Buffer, bytes);
res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN
res := -1
END

10
programs/develop/oberon07/Lib/Linux32/LINAPI.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
@ -74,12 +74,18 @@ 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;
UNTIL ptr = 0
ELSE
envc := 0;
argc := 0
END;
libc := API.libc;

288
programs/develop/oberon07/Lib/Linux32/RTL.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -21,8 +21,8 @@ CONST
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
WORD = bit_depth DIV 8;
MAX_SET = bit_depth - 1;
TYPE
@ -35,6 +35,7 @@ VAR
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
dll: RECORD
process_detach,
@ -45,35 +46,9 @@ VAR
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: 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, 00CH, (* mov esi, dword [ebp + 12] *)
08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *)
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] _move2* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
@ -92,7 +67,7 @@ BEGIN
05FH (* pop edi *)
(* L: *)
)
END _move2;
END _move;
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
@ -103,7 +78,7 @@ BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, src, dst);
_move(len_src * base_size, dst, src);
res := TRUE
END
@ -113,7 +88,7 @@ END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
@ -144,7 +119,7 @@ BEGIN
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
a := LSR(ASR(minint, b - a), MAX_SET - b)
ELSE
a := 0
END
@ -153,69 +128,42 @@ BEGIN
END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
BEGIN
IF ASR(a, 5) = 0 THEN
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
ELSE
a := 0
END
RETURN a
END _set1;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L1 *)
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 *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
089H, 011H, (* mov dword [ecx], edx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
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 *)
)
RETURN 0
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
DEC(div)
END
RETURN div
END _div2;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
INC(mod, y)
END
RETURN mod
END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
END _div;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
END _mod;
END _divmod;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
@ -223,7 +171,7 @@ BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, SIZE_OF_DWORD)
INC(ptr, WORD)
END
END _new;
@ -231,15 +179,14 @@ END _new;
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
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 *)
@ -250,19 +197,14 @@ BEGIN
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
RETURN 0
END _length;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER;
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 *)
@ -277,58 +219,92 @@ BEGIN
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H, (* shr eax, 1 *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
0D1H, 0E8H (* shr eax, 1 *)
)
RETURN 0
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): 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
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 strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): 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
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;
@ -507,7 +483,7 @@ END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
@ -567,14 +543,6 @@ BEGIN
END _dllentry;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
@ -596,13 +564,19 @@ BEGIN
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
SYSTEM.GET(_types + t1 * WORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
j := 1;
FOR i := 0 TO MAX_SET DO
bits[i] := j;
j := LSL(j, 1)
END;
name := modname;
dll.process_detach := NIL;
@ -621,6 +595,14 @@ BEGIN
END _sofinit;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini

12
programs/develop/oberon07/Lib/Windows32/API.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -9,6 +9,12 @@ MODULE API;
IMPORT SYSTEM;
CONST
SectionAlignment = 1000H;
VAR
eol*: ARRAY 3 OF CHAR;
@ -46,7 +52,7 @@ END _DISPOSE;
PROCEDURE init* (reserved, code: INTEGER);
BEGIN
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
base := code - 4096;
base := code - SectionAlignment;
heap := GetProcessHeap()
END init;

12
programs/develop/oberon07/Lib/Windows32/HOST.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -42,9 +42,9 @@ TYPE
cBytes: CHAR;
fFixedDisk: CHAR;
nErrCode: SYSTEM.CARD16;
Reserved1: SYSTEM.CARD16;
Reserved2: SYSTEM.CARD16;
nErrCode: WCHAR;
Reserved1: WCHAR;
Reserved2: WCHAR;
szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
END;
@ -211,7 +211,7 @@ BEGIN
END GetArg;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
res, n: INTEGER;

288
programs/develop/oberon07/Lib/Windows32/RTL.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -21,8 +21,8 @@ CONST
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
WORD = bit_depth DIV 8;
MAX_SET = bit_depth - 1;
TYPE
@ -35,6 +35,7 @@ VAR
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
dll: RECORD
process_detach,
@ -45,35 +46,9 @@ VAR
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: 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, 00CH, (* mov esi, dword [ebp + 12] *)
08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *)
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] _move2* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
@ -92,7 +67,7 @@ BEGIN
05FH (* pop edi *)
(* L: *)
)
END _move2;
END _move;
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
@ -103,7 +78,7 @@ BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, src, dst);
_move(len_src * base_size, dst, src);
res := TRUE
END
@ -113,7 +88,7 @@ END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
@ -144,7 +119,7 @@ BEGIN
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
a := LSR(ASR(minint, b - a), MAX_SET - b)
ELSE
a := 0
END
@ -153,69 +128,42 @@ BEGIN
END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
BEGIN
IF ASR(a, 5) = 0 THEN
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
ELSE
a := 0
END
RETURN a
END _set1;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L1 *)
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 *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
089H, 011H, (* mov dword [ecx], edx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
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 *)
)
RETURN 0
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
DEC(div)
END
RETURN div
END _div2;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
INC(mod, y)
END
RETURN mod
END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
END _div;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
END _mod;
END _divmod;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
@ -223,7 +171,7 @@ BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, SIZE_OF_DWORD)
INC(ptr, WORD)
END
END _new;
@ -231,15 +179,14 @@ END _new;
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
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 *)
@ -250,19 +197,14 @@ BEGIN
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
RETURN 0
END _length;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER;
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 *)
@ -277,58 +219,92 @@ BEGIN
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H, (* shr eax, 1 *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
0D1H, 0E8H (* shr eax, 1 *)
)
RETURN 0
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): 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
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 strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): 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
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;
@ -507,7 +483,7 @@ END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
@ -567,14 +543,6 @@ BEGIN
END _dllentry;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
@ -596,13 +564,19 @@ BEGIN
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
SYSTEM.GET(_types + t1 * WORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
j := 1;
FOR i := 0 TO MAX_SET DO
bits[i] := j;
j := LSL(j, 1)
END;
name := modname;
dll.process_detach := NIL;
@ -621,6 +595,14 @@ BEGIN
END _sofinit;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini

2
programs/develop/oberon07/Samples/HW_con.ob07
View File

@ -1,4 +1,4 @@
MODULE HW_con;
MODULE HW_con;
IMPORT Out, In, Console, DateTime;

87
programs/develop/oberon07/Source/AMD64.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -750,7 +750,7 @@ BEGIN
IL.opCOPYS, IL.opROT,
IL.opNEW, IL.opDISP, IL.opISREC,
IL.opIS, IL.opTYPEGR, IL.opTYPEGP,
IL.opCASET, IL.opDIV,
IL.opTYPEGD, IL.opCASET, IL.opDIV,
IL.opDIVL, IL.opMOD,
IL.opMODL, IL.opLENGTH, IL.opLENGTHW:
leaf := FALSE
@ -1163,8 +1163,11 @@ BEGIN
REG.Reset(R)
|IL.opSAVES:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushDA(stroffs + param2);
push(reg1);
drop;
pushc(param1);
CallRTL(IL._move)
@ -1327,16 +1330,17 @@ BEGIN
GetRegA
|IL.opRSETL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(IL._set2);
push(reg1);
drop;
CallRTL(IL._set);
GetRegA
|IL.opRSET1:
UnOp(reg1);
PushAll(1);
push(reg1);
CallRTL(IL._set);
CallRTL(IL._set1);
GetRegA
|IL.opINCL, IL.opEXCL:
@ -1573,11 +1577,11 @@ BEGIN
|IL.opCOPY:
PushAll(2);
pushc(param2);
CallRTL(IL._move2)
CallRTL(IL._move)
|IL.opMOVE:
PushAll(3);
CallRTL(IL._move2)
CallRTL(IL._move)
|IL.opCOPYA:
PushAll(4);
@ -1819,7 +1823,7 @@ BEGIN
|IL.opDIV:
PushAll(2);
CallRTL(IL._div);
CallRTL(IL._divmod);
GetRegA
|IL.opDIVR:
@ -1854,20 +1858,24 @@ BEGIN
ELSE
PushAll(1);
pushc(param2);
CallRTL(IL._div);
CallRTL(IL._divmod);
GetRegA
END
END
|IL.opDIVL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(IL._div2);
push(reg1);
drop;
CallRTL(IL._divmod);
GetRegA
|IL.opMOD:
PushAll(2);
CallRTL(IL._mod);
CallRTL(IL._divmod);
mov(rax, rdx);
GetRegA
|IL.opMODR:
@ -1899,15 +1907,20 @@ BEGIN
ELSE
PushAll(1);
pushc(param2);
CallRTL(IL._mod);
CallRTL(IL._divmod);
mov(rax, rdx);
GetRegA
END
END
|IL.opMODL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(IL._mod2);
push(reg1);
drop;
CallRTL(IL._divmod);
mov(rax, rdx);
GetRegA
|IL.opMUL:
@ -2561,12 +2574,12 @@ BEGIN
END translate;
PROCEDURE prolog (code: IL.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER);
PROCEDURE prolog (modname: ARRAY OF CHAR; target, stack_size: INTEGER);
VAR
ModName_Offs, entry, L: INTEGER;
BEGIN
ModName_Offs := tcount * 8 + CHL.Length(code.data);
ModName_Offs := tcount * 8 + CHL.Length(IL.codes.data);
Numbers_Offs := ModName_Offs + LENGTH(modname) + 1;
ASSERT(UTILS.Align(Numbers_Offs, 16));
@ -2596,7 +2609,7 @@ BEGIN
pushDA(ModName_Offs); //MODNAME
CallRTL(IL._init);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64} THEN
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iELF64} THEN
L := NewLabel();
pushc(0);
push(rsp);
@ -2613,7 +2626,7 @@ BEGIN
END prolog;
PROCEDURE epilog (code: IL.CODES; modname: ARRAY OF CHAR; target: INTEGER);
PROCEDURE epilog (modname: ARRAY OF CHAR; target: INTEGER);
VAR
i, n: INTEGER;
number: Number;
@ -2660,13 +2673,13 @@ BEGIN
i := 0;
WHILE i < tcount DO
BIN.PutData64LE(prog, CHL.GetInt(code.types, i));
BIN.PutData64LE(prog, CHL.GetInt(IL.codes.types, i));
INC(i)
END;
i := 0;
WHILE i < CHL.Length(code.data) DO
BIN.PutData(prog, CHL.GetByte(code.data, i));
WHILE i < CHL.Length(IL.codes.data) DO
BIN.PutData(prog, CHL.GetByte(IL.codes.data, i));
INC(i)
END;
@ -2685,13 +2698,13 @@ BEGIN
number := number.next(Number)
END;
exp := code.export.first(IL.EXPORT_PROC);
exp := IL.codes.export.first(IL.EXPORT_PROC);
WHILE exp # NIL DO
BIN.Export(prog, exp.name, exp.label);
exp := exp.next(IL.EXPORT_PROC)
END;
import(code.import)
import(IL.codes.import)
END epilog;
@ -2719,12 +2732,12 @@ BEGIN
END rsave;
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
path, modname, ext: PATHS.PATH;
BEGIN
tcount := CHL.Length(code.types);
tcount := CHL.Length(IL.codes.types);
Win64RegPar[0] := rcx;
Win64RegPar[1] := rdx;
@ -2743,7 +2756,7 @@ BEGIN
REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9});
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 8));
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 8)));
Numbers := LISTS.create(NIL);
Numbers_Count := 0;
@ -2755,18 +2768,18 @@ BEGIN
NewNumber(ORD(-BITS(LSR(ASR(ROR(1, 1), 10), 1)))); (* {0..51, 63} *)
NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *)
prog := BIN.create(code.lcount);
BIN.SetParams(prog, code.bss, 1, WCHR(1), WCHR(0));
prog := BIN.create(IL.codes.lcount);
BIN.SetParams(prog, IL.codes.bss, 1, WCHR(1), WCHR(0));
X86.SetProgram(prog);
prolog(code, modname, target, options.stack);
translate(code.commands, tcount * 8);
epilog(code, modname, target);
prolog(modname, target, options.stack);
translate(IL.codes.commands, tcount * 8);
epilog(modname, target);
BIN.fixup(prog);
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
PE32.write(prog, outname, options.base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE)
PE32.write(prog, outname, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE)
ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE)
END

44
programs/develop/oberon07/Source/ARITH.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -46,15 +46,12 @@ VAR
BEGIN
IF v.typ = tINTEGER THEN
CASE v.typ OF
|tINTEGER, tCHAR, tWCHAR:
res := v.int
ELSIF v.typ = tCHAR THEN
res := v.int
ELSIF v.typ = tWCHAR THEN
res := v.int
ELSIF v.typ = tSET THEN
|tSET:
res := UTILS.Long(ORD(v.set))
ELSIF v.typ = tBOOLEAN THEN
|tBOOLEAN:
res := ORD(v.bool)
END
@ -80,35 +77,28 @@ END Float;
PROCEDURE check* (v: VALUE): BOOLEAN;
VAR
error: BOOLEAN;
res: BOOLEAN;
BEGIN
error := FALSE;
IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN
error := TRUE
ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN
error := TRUE
ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN
error := TRUE
ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN
error := TRUE
CASE v.typ OF
|tINTEGER: res := (UTILS.target.minInt <= v.int) & (v.int <= UTILS.target.maxInt)
|tCHAR: res := (0 <= v.int) & (v.int <= 255)
|tWCHAR: res := (0 <= v.int) & (v.int <= 65535)
|tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
END
RETURN ~error
RETURN res
END check;
PROCEDURE isZero* (v: VALUE): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
ASSERT(v.typ IN {tINTEGER, tREAL});
IF v.typ = tINTEGER THEN
res := v.int = 0
ELSIF v.typ = tREAL THEN
res := v.float = 0.0
BEGIN
CASE v.typ OF
|tINTEGER: res := v.int = 0
|tREAL: res := v.float = 0.0
END
RETURN res

4
programs/develop/oberon07/Source/AVLTREES.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/BIN.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/CHUNKLISTS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/COLLECTIONS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/CONSOLE.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

6
programs/develop/oberon07/Source/CONSTANTS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -10,7 +10,7 @@ MODULE CONSTANTS;
CONST
vMajor* = 1;
vMinor* = 0;
vMinor* = 13;
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";

72
programs/develop/oberon07/Source/Compiler.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -49,7 +49,7 @@ BEGIN
END Target;
PROCEDURE keys (VAR options: PROG.OPTIONS);
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
VAR
param: PARS.PATH;
i, j: INTEGER;
@ -60,9 +60,10 @@ VAR
checking: SET;
BEGIN
out := "";
checking := options.checking;
end := FALSE;
i := 4;
i := 3;
REPEAT
UTILS.GetArg(i, param);
@ -76,14 +77,13 @@ BEGIN
DEC(i)
END
ELSIF param = "-base" THEN
ELSIF param = "-out" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.base := ((value DIV 64) * 64) * 1024
END;
IF param[0] = "-" THEN
DEC(i)
ELSE
out := param
END
ELSIF param = "-ram" THEN
@ -202,20 +202,20 @@ BEGIN
IF inname = "" THEN
C.Ln;
C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln;
C.StringLn("Usage: Compiler <main module> <target> [optional settings]"); C.Ln;
IF UTILS.bit_depth = 64 THEN
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
ELSIF UTILS.bit_depth = 32 THEN
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
END;
C.StringLn("optional settings:"); C.Ln;
C.StringLn(" -out <file name> output"); C.Ln;
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln;
C.StringLn(" -base <address> set base address of image in kilobytes"); C.Ln;
C.StringLn(' -ver <major.minor> set version of program'); C.Ln;
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430)"); C.Ln;
C.StringLn(" -ver <major.minor> set version of program ('obj' target)"); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes ('msp430' target)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes ('msp430' target)"); C.Ln;
UTILS.Exit(0)
END;
@ -230,16 +230,7 @@ BEGIN
path := temp
END;
UTILS.GetArg(2, outname);
IF outname = "" THEN
ERRORS.Error(205)
END;
IF PATHS.isRelative(outname) THEN
PATHS.RelPath(app_path, outname, temp);
outname := temp
END;
UTILS.GetArg(3, param);
UTILS.GetArg(2, param);
IF param = "" THEN
ERRORS.Error(205)
END;
@ -271,11 +262,6 @@ BEGIN
CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
IF target = mConst.Target_iDLL THEN
options.base := 10000000H
ELSE
options.base := 400000H
END;
STRINGS.append(lib_path, "Windows32")
|mConst.Target_iKolibri, mConst.Target_iObject:
@ -297,7 +283,34 @@ BEGIN
STRINGS.append(lib_path, UTILS.slash);
keys(options);
keys(options, outname);
IF outname = "" THEN
outname := path;
STRINGS.append(outname, modname);
CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iConsole64, mConst.Target_iGUI64:
STRINGS.append(outname, ".exe")
|mConst.Target_iObject:
STRINGS.append(outname, ".obj")
|mConst.Target_iKolibri, mConst.Target_iELF32, mConst.Target_iELF64:
|mConst.Target_iELFSO32, mConst.Target_iELFSO64:
STRINGS.append(outname, ".so")
|mConst.Target_iDLL, mConst.Target_iDLL64:
STRINGS.append(outname, ".dll")
|mConst.Target_iMSP430:
STRINGS.append(outname, ".hex")
END
ELSE
IF PATHS.isRelative(outname) THEN
PATHS.RelPath(app_path, outname, temp);
outname := temp
END
END;
PARS.init(bit_depth, target, options);
@ -308,6 +321,7 @@ BEGIN
time := UTILS.GetTickCount() - UTILS.time;
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");

2
programs/develop/oberon07/Source/ELF.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov

6
programs/develop/oberon07/Source/ERRORS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -206,7 +206,7 @@ BEGIN
|201: Error1("writing file error")
|202: Error1("too many relocations")
|203: Error1("size of program is too large")
|204: Error1("size of global variables is too large")
|204: Error1("size of variables is too large")
|205: Error1("not enough parameters")
|206: Error1("bad parameter <target>")
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')

6
programs/develop/oberon07/Source/FILES.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -134,7 +134,7 @@ BEGIN
END close;
PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
res: INTEGER;

95
programs/develop/oberon07/Source/IL.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -96,18 +96,18 @@ CONST
opLADR_UNPK* = -24;
_move *= 0;
_move2 *= 1;
_init *= 0;
_move *= 1;
_strcmpw *= 2;
_exit *= 3;
_set *= 4;
_set2 *= 5;
_set1 *= 5;
_lengthw *= 6;
_strcpy *= 7;
_div *= 8;
_mod *= 9;
_div2 *= 10;
_mod2 *= 11;
_length *= 8;
_divmod *= 9;
_dllentry *= 10;
_sofinit *= 11;
_arrcpy *= 12;
_rot *= 13;
_new *= 14;
@ -118,10 +118,6 @@ CONST
_isrec *= 19;
_guard *= 20;
_guardrec *= 21;
_length *= 22;
_init *= 23;
_dllentry *= 24;
_sofinit *= 25;
TYPE
@ -175,7 +171,7 @@ TYPE
END;
CODES* = POINTER TO RECORD
CODES = RECORD
last: COMMAND;
begcall: CMDSTACK;
@ -188,7 +184,7 @@ TYPE
dmin*: INTEGER;
lcount*: INTEGER;
bss*: INTEGER;
rtl*: ARRAY 26 OF INTEGER;
rtl*: ARRAY 22 OF INTEGER;
errlabels*: ARRAY 12 OF INTEGER;
charoffs: ARRAY 256 OF INTEGER;
@ -208,6 +204,24 @@ VAR
commands, variables: C.COLLECTION;
PROCEDURE set_dmin* (value: INTEGER);
BEGIN
codes.dmin := value
END set_dmin;
PROCEDURE set_bss* (value: INTEGER);
BEGIN
codes.bss := value
END set_bss;
PROCEDURE set_rtl* (idx, label: INTEGER);
BEGIN
codes.rtl[idx] := label
END set_rtl;
PROCEDURE NewCmd (): COMMAND;
VAR
cmd: COMMAND;
@ -257,7 +271,7 @@ PROCEDURE getlast* (): COMMAND;
END getlast;
PROCEDURE PutByte (codes: CODES; b: BYTE);
PROCEDURE PutByte (b: BYTE);
BEGIN
CHL.PushByte(codes.data, b)
END PutByte;
@ -272,11 +286,11 @@ BEGIN
i := 0;
n := LENGTH(s);
WHILE i < n DO
PutByte(codes, ORD(s[i]));
PutByte(ORD(s[i]));
INC(i)
END;
PutByte(codes, 0)
PutByte(0)
RETURN res
END putstr;
@ -289,8 +303,8 @@ VAR
BEGIN
IF codes.charoffs[c] = -1 THEN
res := CHL.Length(codes.data);
PutByte(codes, c);
PutByte(codes, 0);
PutByte(c);
PutByte(0);
codes.charoffs[c] := res
ELSE
res := codes.charoffs[c]
@ -308,7 +322,7 @@ BEGIN
res := CHL.Length(codes.data);
IF ODD(res) THEN
PutByte(codes, 0);
PutByte(0);
INC(res)
END;
@ -317,17 +331,17 @@ BEGIN
i := 0;
WHILE i < n DO
IF endianness = little_endian THEN
PutByte(codes, ORD(codes.wstr[i]) MOD 256);
PutByte(codes, ORD(codes.wstr[i]) DIV 256)
PutByte(ORD(codes.wstr[i]) MOD 256);
PutByte(ORD(codes.wstr[i]) DIV 256)
ELSIF endianness = big_endian THEN
PutByte(codes, ORD(codes.wstr[i]) DIV 256);
PutByte(codes, ORD(codes.wstr[i]) MOD 256)
PutByte(ORD(codes.wstr[i]) DIV 256);
PutByte(ORD(codes.wstr[i]) MOD 256)
END;
INC(i)
END;
PutByte(codes, 0);
PutByte(codes, 0)
PutByte(0);
PutByte(0)
RETURN res
END putstrW;
@ -342,20 +356,20 @@ BEGIN
res := CHL.Length(codes.data);
IF ODD(res) THEN
PutByte(codes, 0);
PutByte(0);
INC(res)
END;
IF endianness = little_endian THEN
PutByte(codes, c MOD 256);
PutByte(codes, c DIV 256)
PutByte(c MOD 256);
PutByte(c DIV 256)
ELSIF endianness = big_endian THEN
PutByte(codes, c DIV 256);
PutByte(codes, c MOD 256)
PutByte(c DIV 256);
PutByte(c MOD 256)
END;
PutByte(codes, 0);
PutByte(codes, 0);
PutByte(0);
PutByte(0);
codes.wcharoffs[c] := res
ELSE
@ -935,18 +949,6 @@ BEGIN
END flt;
PROCEDURE odd*;
BEGIN
AddCmd0(opODD)
END odd;
PROCEDURE ord*;
BEGIN
AddCmd0(opORD)
END ord;
PROCEDURE shift_minmax* (op: CHAR);
BEGIN
CASE op OF
@ -1147,7 +1149,6 @@ BEGIN
numRegsFloat := pNumRegsFloat;
endianness := pEndianness;
NEW(codes);
NEW(codes.begcall);
codes.begcall.top := -1;
NEW(codes.endcall);

4
programs/develop/oberon07/Source/KOS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/LISTS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

4
programs/develop/oberon07/Source/MSCOFF.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

28
programs/develop/oberon07/Source/MSP430.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
@ -582,7 +582,7 @@ BEGIN
END Neg;
PROCEDURE translate (code: IL.CODES);
PROCEDURE translate;
VAR
cmd, next: COMMAND;
@ -593,7 +593,7 @@ VAR
cc: INTEGER;
BEGIN
cmd := code.commands.first(COMMAND);
cmd := IL.codes.commands.first(COMMAND);
WHILE cmd # NIL DO
@ -1643,7 +1643,7 @@ BEGIN
END WriteHex;
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER;
@ -1668,12 +1668,12 @@ BEGIN
ram := MIN(MAX(ram, minRAM), maxRAM);
rom := MIN(MAX(rom, minROM), maxROM);
IF code.bss > ram - minStackSize - RTL.VarSize THEN
IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN
ERRORS.Error(204)
END;
Labels := CHL.CreateIntList();
FOR i := 1 TO code.lcount DO
FOR i := 1 TO IL.codes.lcount DO
CHL.PushInt(Labels, 0)
END;
@ -1681,28 +1681,28 @@ BEGIN
mem[i] := 0
END;
TypesSize := CHL.Length(code.types) * 2;
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}, {});
prolog(ram);
translate(code);
translate;
epilog;
Code.address := 10000H - rom;
Code.size := Fixup(Code.address, IntVectorSize + TypesSize);
Data.address := Code.address + Code.size;
Data.size := CHL.Length(code.data);
Data.size := CHL.Length(IL.codes.data);
Data.size := Data.size + ORD(ODD(Data.size));
TextSize := Code.size + Data.size;
IF Code.address + TextSize + MAX(code.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 := code.bss + ORD(ODD(code.bss));
Bss.size := IL.codes.bss + ORD(ODD(IL.codes.bss));
heap := Bss.address + Bss.size;
stack := RTL.ram + ram;
ASSERT(stack - heap >= minStackSize);
@ -1724,15 +1724,15 @@ BEGIN
adr := Data.address;
FOR i := 0 TO CHL.Length(code.data) - 1 DO
mem[adr] := CHL.GetByte(code.data, i);
FOR i := 0 TO CHL.Length(IL.codes.data) - 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(code.types, i), adr)
PutWord(CHL.GetInt(IL.codes.types, i), adr)
END;
FOR i := 0 TO 15 DO

2
programs/develop/oberon07/Source/MSP430RTL.ob07
View File

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov

11
programs/develop/oberon07/Source/PARS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -77,6 +77,8 @@ VAR
parsers: C.COLLECTION;
lines*: INTEGER;
PROCEDURE destroy* (VAR parser: PARSER);
BEGIN
@ -1178,9 +1180,9 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT);
check1(parser.lex.s = unit.name.s, parser, 25);
ExpectSym(parser, SCAN.lxPOINT)
END;
INC(lines, parser.lex.pos.line);
PROG.closeUnit(unit)
END parse;
@ -1248,7 +1250,8 @@ END create;
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
BEGIN
program := PROG.create(bit_depth, target, options);
parsers := C.create()
parsers := C.create();
lines := 0
END init;

4
programs/develop/oberon07/Source/PATHS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

20
programs/develop/oberon07/Source/PE32.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -28,8 +28,8 @@ CONST
(* SectionHeader.Characteristics *)
SHC_text = 060000020H;
SHC_data = 0C0000040H;
SHC_bss = 0C00000C0H;
SHC_data = 040000040H;
SHC_bss = 0C0000080H;
SectionAlignment = 1000H;
FileAlignment = 200H;
@ -372,7 +372,7 @@ BEGIN
END WriteFileHeader;
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; BaseAddress: INTEGER; console, dll, amd64: BOOLEAN);
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN);
VAR
i, n: INTEGER;
@ -382,6 +382,8 @@ VAR
END;
BaseAddress: INTEGER;
Address: VIRTUAL_ADDR;
File: FILE;
@ -504,6 +506,12 @@ BEGIN
Size.Bss := program.bss;
Size.Stack := program.stack;
IF dll THEN
BaseAddress := 10000000H
ELSE
BaseAddress := 400000H
END;
PEHeader.Signature[0] := 50H;
PEHeader.Signature[1] := 45H;
PEHeader.Signature[2] := 0;
@ -556,7 +564,7 @@ BEGIN
InitSection(SectionHeaders[0], ".text", SHC_text);
SectionHeaders[0].VirtualSize := Size.Code;
SectionHeaders[0].VirtualAddress := 1000H;
SectionHeaders[0].VirtualAddress := SectionAlignment;
SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment);
SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders;

66
programs/develop/oberon07/Source/PROG.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -24,9 +24,9 @@ CONST
tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4;
tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8;
tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12;
tCARD16* = 13; tCARD32* = 14; tANYREC* = 15; tWCHAR* = 16;
tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15;
BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD16, tCARD32, tWCHAR};
BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR};
stABS* = 1; stASR* = 2; stCHR* = 3; stFLOOR* = 4;
stFLT* = 5; stLEN* = 6; stLSL* = 7; stODD* = 8;
@ -72,7 +72,7 @@ TYPE
OPTIONS* = RECORD
version*, stack*, base*, ram*, rom*: INTEGER;
version*, stack*, ram*, rom*: INTEGER;
pic*: BOOLEAN;
checking*: SET
@ -205,7 +205,7 @@ TYPE
stTypes*: RECORD
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*,
tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_
tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_
END;
@ -254,23 +254,27 @@ VAR
BEGIN
IF varIdent.offset = -1 THEN
size := varIdent.type.size;
IF varIdent.global THEN
IF UTILS.Align(program.bss, varIdent.type.align) THEN
IF UTILS.maxint - program.bss >= varIdent.type.size THEN
IF UTILS.maxint - program.bss >= size THEN
varIdent.offset := program.bss;
INC(program.bss, varIdent.type.size)
INC(program.bss, size)
END
END
ELSE
word := program.target.word;
size := varIdent.type.size;
IF UTILS.Align(size, word) THEN
size := size DIV word;
IF UTILS.maxint - program.locsize >= size THEN
INC(program.locsize, size);
varIdent.offset := program.locsize;
varIdent.offset := program.locsize
END
END
END;
IF varIdent.offset = -1 THEN
ERRORS.Error(204)
END
END
@ -509,7 +513,6 @@ BEGIN
END;
DEC(unit.scopeLvl)
END closeScope;
@ -631,6 +634,13 @@ PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN;
END isOpenArray;
PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN;
RETURN (dst.typ = tARRAY) & isOpenArray(src) &
~isOpenArray(src.base) & ~isOpenArray(dst.base) &
isTypeEq(src.base, dst.base)
END arrcomp;
PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT;
VAR
item: UNIT;
@ -1059,25 +1069,15 @@ VAR
BEGIN
IF typ = ARITH.tINTEGER THEN
res := program.stTypes.tINTEGER
ELSIF typ = ARITH.tREAL THEN
res := program.stTypes.tREAL
ELSIF typ = ARITH.tSET THEN
res := program.stTypes.tSET
ELSIF typ = ARITH.tBOOLEAN THEN
res := program.stTypes.tBOOLEAN
ELSIF typ = ARITH.tCHAR THEN
res := program.stTypes.tCHAR
ELSIF typ = ARITH.tWCHAR THEN
res := program.stTypes.tWCHAR
ELSIF typ = ARITH.tSTRING THEN
res := program.stTypes.tSTRING
ELSE
res := NIL
END;
ASSERT(res # NIL)
CASE typ OF
|ARITH.tINTEGER: res := program.stTypes.tINTEGER
|ARITH.tREAL: res := program.stTypes.tREAL
|ARITH.tSET: res := program.stTypes.tSET
|ARITH.tBOOLEAN: res := program.stTypes.tBOOLEAN
|ARITH.tCHAR: res := program.stTypes.tCHAR
|ARITH.tWCHAR: res := program.stTypes.tWCHAR
|ARITH.tSTRING: res := program.stTypes.tSTRING
END
RETURN res
END getType;
@ -1126,10 +1126,6 @@ BEGIN
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16);
EnterProc(unit, "COPY", idSYSPROC, sysCOPY);
ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE);
ident.type := program.stTypes.tCARD16;
ident.export := TRUE;
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE);
ident.type := program.stTypes.tCARD32;
ident.export := TRUE
@ -1248,7 +1244,6 @@ BEGIN
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL);
program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL);
program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL);
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL)
END;
@ -1267,7 +1262,6 @@ BEGIN
IF target # mConst.Target_iMSP430 THEN
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size;
program.stTypes.tREAL.align := program.stTypes.tREAL.size;
program.stTypes.tCARD16.align := program.stTypes.tCARD16.size;
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size
END;

8
programs/develop/oberon07/Source/REG.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -293,10 +293,8 @@ 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;
IF size = 0 THEN
size := 8
END;
R.size[reg] := size
END Lock;

163
programs/develop/oberon07/Source/SCAN.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -51,7 +51,8 @@ TYPE
IDENT* = POINTER TO RECORD (AVL.DATA)
s*: LEXSTR;
offset*, offsetW*: INTEGER
offset*, offsetW*: INTEGER;
key: INTEGER
END;
@ -78,19 +79,14 @@ TYPE
SCANNER* = TXT.TEXT;
KEYWORD = ARRAY 10 OF CHAR;
VAR
vocabulary: RECORD
KW: ARRAY 33 OF KEYWORD;
delimiters: ARRAY 256 OF BOOLEAN;
idents: AVL.NODE;
ident: IDENT
END;
delimiters: ARRAY 256 OF BOOLEAN;
NewIdent: IDENT;
upto: BOOLEAN;
@ -100,46 +96,20 @@ PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
END nodecmp;
PROCEDURE key (VAR lex: LEX);
VAR
L, R, M: INTEGER;
found: BOOLEAN;
BEGIN
L := 0;
R := LEN(vocabulary.KW) - 1;
found := FALSE;
REPEAT
M := (L + R) DIV 2;
IF lex.s # vocabulary.KW[M] THEN
IF lex.s > vocabulary.KW[M] THEN
L := M + 1
ELSE
R := M - 1
END
ELSE
found := TRUE;
lex.sym := lxKW + M
END
UNTIL found OR (L > R)
END key;
PROCEDURE enterid* (s: LEXSTR): IDENT;
VAR
newnode: BOOLEAN;
node: AVL.NODE;
BEGIN
vocabulary.ident.s := s;
vocabulary.idents := AVL.insert(vocabulary.idents, vocabulary.ident, nodecmp, newnode, node);
NewIdent.s := s;
idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
IF newnode THEN
NEW(vocabulary.ident);
vocabulary.ident.offset := -1;
vocabulary.ident.offsetW := -1
NEW(NewIdent);
NewIdent.offset := -1;
NewIdent.offsetW := -1;
NewIdent.key := 0
END
RETURN node.data(IDENT)
@ -181,12 +151,12 @@ BEGIN
IF lex.over THEN
lex.sym := lxERROR06
ELSE
lex.sym := lxIDENT;
key(lex)
END;
IF lex.sym = lxIDENT THEN
lex.ident := enterid(lex.s)
lex.ident := enterid(lex.s);
IF lex.ident.key # 0 THEN
lex.sym := lex.ident.key
ELSE
lex.sym := lxIDENT
END
END
END ident;
@ -518,7 +488,7 @@ BEGIN
number(text, lex)
ELSIF (c = '"') OR (c = "'") THEN
string(text, lex, c)
ELSIF vocabulary.delimiters[ORD(c)] THEN
ELSIF delimiters[ORD(c)] THEN
delimiter(text, lex, c)
ELSIF c = 0X THEN
lex.sym := lxEOF;
@ -566,10 +536,13 @@ VAR
delim: ARRAY 23 OF CHAR;
PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
VAR
id: IDENT;
BEGIN
vocabulary.KW[i] := kw;
INC(i)
id := enterid(kw);
id.key := key
END enterkw;
@ -577,55 +550,57 @@ BEGIN
upto := FALSE;
FOR i := 0 TO 255 DO
vocabulary.delimiters[i] := FALSE
delimiters[i] := FALSE
END;
delim := "+-*/~&.,;|([{^=#<>:)]}";
FOR i := 0 TO LEN(delim) - 2 DO
vocabulary.delimiters[ORD(delim[i])] := TRUE
delimiters[ORD(delim[i])] := TRUE
END;
i := 0;
enterkw(i, "ARRAY");
enterkw(i, "BEGIN");
enterkw(i, "BY");
enterkw(i, "CASE");
enterkw(i, "CONST");
enterkw(i, "DIV");
enterkw(i, "DO");
enterkw(i, "ELSE");
enterkw(i, "ELSIF");
enterkw(i, "END");
enterkw(i, "FALSE");
enterkw(i, "FOR");
enterkw(i, "IF");
enterkw(i, "IMPORT");
enterkw(i, "IN");
enterkw(i, "IS");
enterkw(i, "MOD");
enterkw(i, "MODULE");
enterkw(i, "NIL");
enterkw(i, "OF");
enterkw(i, "OR");
enterkw(i, "POINTER");
enterkw(i, "PROCEDURE");
enterkw(i, "RECORD");
enterkw(i, "REPEAT");
enterkw(i, "RETURN");
enterkw(i, "THEN");
enterkw(i, "TO");
enterkw(i, "TRUE");
enterkw(i, "TYPE");
enterkw(i, "UNTIL");
enterkw(i, "VAR");
enterkw(i, "WHILE");
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")
NEW(vocabulary.ident);
vocabulary.ident.s := "";
vocabulary.ident.offset := -1;
vocabulary.ident.offsetW := -1;
vocabulary.idents := NIL
END init;

91
programs/develop/oberon07/Source/STATEMENTS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -267,17 +267,10 @@ PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN;
VAR
res: BOOLEAN;
PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
PROG.isTypeEq(src.base, dst.base)
END arrcomp;
BEGIN
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
IF arrcomp(e.type, t) THEN
IF t = e.type THEN
res := TRUE
ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
IF (e.obj = eCONST) & (t = tBYTE) THEN
@ -285,29 +278,16 @@ BEGIN
ELSE
res := TRUE
END
ELSIF isSet(e) & (t = tSET) THEN
res := TRUE
ELSIF isBoolean(e) & (t = tBOOLEAN) THEN
res := TRUE
ELSIF isReal(e) & (t = tREAL) THEN
res := TRUE
ELSIF isChar(e) & (t = tCHAR) THEN
res := TRUE
ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) THEN
res := TRUE
ELSIF isStringW1(e) & (t = tWCHAR) THEN
res := TRUE
ELSIF isCharW(e) & (t = tWCHAR) THEN
res := TRUE
ELSIF PROG.isBaseOf(t, e.type) THEN
res := TRUE
ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN
res := TRUE
ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
res := TRUE
ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))) THEN
res := TRUE
ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))) THEN
ELSIF
(e.obj = eCONST) & isChar(e) & (t = tWCHAR)
OR isStringW1(e) & (t = tWCHAR)
OR PROG.isBaseOf(t, e.type)
OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type)
OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
OR PROG.arrcomp(e.type, t)
OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
THEN
res := TRUE
ELSE
res := FALSE
@ -315,6 +295,7 @@ BEGIN
ELSE
res := FALSE
END
RETURN res
END assigncomp;
@ -384,18 +365,10 @@ VAR
res: BOOLEAN;
label: INTEGER;
PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
PROG.isTypeEq(src.base, dst.base)
END arrcomp;
BEGIN
IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
res := TRUE;
IF arrcomp(e.type, VarType) THEN
IF PROG.arrcomp(e.type, VarType) THEN
IF ~PROG.isOpenArray(VarType) THEN
IL.Const(VarType.length)
@ -470,8 +443,6 @@ BEGIN
END
ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
IL.AddCmd0(IL.opSAVE32)
ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN
IL.AddCmd0(IL.opSAVE16)
ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
IF e.obj = ePROC THEN
IL.AssignProc(e.ident.proc.label)
@ -642,7 +613,7 @@ BEGIN
stroffs := StringW(e);
IL.StrAdr(stroffs)
END;
IL.codes.dmin := stroffs + p.type.size;
IL.set_dmin(stroffs + p.type.size);
IL.Param1
ELSE
LoadConst(e);
@ -934,7 +905,7 @@ BEGIN
END
ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, pos, 66);
PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
IF e2.obj = eCONST THEN
LoadConst(e2)
END;
@ -1142,7 +1113,7 @@ BEGIN
IF e.obj = eCONST THEN
ARITH.odd(e.value)
ELSE
IL.odd
IL.AddCmd0(IL.opODD)
END
|PROG.stORD:
@ -1156,7 +1127,7 @@ BEGIN
END
ELSE
IF isBoolean(e) THEN
IL.ord
IL.AddCmd0(IL.opORD)
END
END;
e.type := tINTEGER
@ -3257,10 +3228,10 @@ VAR
id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);
IF (id # NIL) & (id.import # NIL) THEN
IL.codes.rtl[idx] := -id.import(IL.IMPORT_PROC).label;
IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label);
id.proc.used := TRUE
ELSIF (id # NIL) & (id.proc # NIL) THEN
IL.codes.rtl[idx] := id.proc.label;
IL.set_rtl(idx, id.proc.label);
id.proc.used := TRUE
ELSE
ERRORS.WrongRTL(name)
@ -3276,7 +3247,6 @@ BEGIN
getproc(rtl, "_strcmp", IL._strcmp);
getproc(rtl, "_length", IL._length);
getproc(rtl, "_arrcpy", IL._arrcpy);
getproc(rtl, "_move", IL._move);
getproc(rtl, "_is", IL._is);
getproc(rtl, "_guard", IL._guard);
getproc(rtl, "_guardrec", IL._guardrec);
@ -3284,13 +3254,10 @@ BEGIN
getproc(rtl, "_new", IL._new);
getproc(rtl, "_rot", IL._rot);
getproc(rtl, "_strcpy", IL._strcpy);
getproc(rtl, "_move2", IL._move2);
getproc(rtl, "_div2", IL._div2);
getproc(rtl, "_mod2", IL._mod2);
getproc(rtl, "_div", IL._div);
getproc(rtl, "_mod", IL._mod);
getproc(rtl, "_move", IL._move);
getproc(rtl, "_divmod", IL._divmod);
getproc(rtl, "_set", IL._set);
getproc(rtl, "_set2", IL._set2);
getproc(rtl, "_set1", IL._set1);
getproc(rtl, "_isrec", IL._isrec);
getproc(rtl, "_lengthw", IL._lengthw);
getproc(rtl, "_strcmpw", IL._strcmpw);
@ -3382,12 +3349,12 @@ BEGIN
PROG.DelUnused(PARS.program, IL.DelImport);
IL.codes.bss := PARS.program.bss;
IL.set_bss(PARS.program.bss);
CASE CPU OF
| cpuAMD64: AMD64.CodeGen(IL.codes, outname, target, options)
| cpuX86: X86.CodeGen(IL.codes, outname, target, options)
|cpuMSP430: MSP430.CodeGen(IL.codes, outname, target, options)
| cpuAMD64: AMD64.CodeGen(outname, target, options)
| cpuX86: X86.CodeGen(outname, target, options)
|cpuMSP430: MSP430.CodeGen(outname, target, options)
END
END compile;

4
programs/develop/oberon07/Source/STRINGS.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

26
programs/develop/oberon07/Source/TEXTDRV.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -21,7 +21,7 @@ TYPE
TEXT* = POINTER TO RECORD (C.ITEM)
chunk: ARRAY CHUNK OF BYTE;
chunk: ARRAY CHUNK OF CHAR;
pos, size: INTEGER;
file: FILES.FILE;
utf8: BOOLEAN;
@ -47,9 +47,9 @@ BEGIN
text.pos := 0;
IF text.size = 0 THEN
text.eof := TRUE;
text.chunk[0] := 0
text.chunk[0] := 0X
END;
text.peak := CHR(text.chunk[0])
text.peak := text.chunk[0]
END
END load;
@ -61,7 +61,7 @@ VAR
BEGIN
IF text.pos < text.size - 1 THEN
INC(text.pos);
text.peak := CHR(text.chunk[text.pos])
text.peak := text.chunk[text.pos]
ELSE
load(text)
END;
@ -87,7 +87,7 @@ BEGIN
ELSE
text.eol := FALSE;
IF text.utf8 THEN
IF (c < 80X) OR (c > 0BFX) THEN
IF ORD(c) DIV 64 # 2 THEN
INC(text.col)
END
ELSE
@ -104,16 +104,16 @@ END next;
PROCEDURE init (text: TEXT);
BEGIN
IF (text.pos = 0) & (text.size >= 3) THEN
IF (text.chunk[0] = 0EFH) &
(text.chunk[1] = 0BBH) &
(text.chunk[2] = 0BFH) THEN
IF (text.chunk[0] = 0EFX) &
(text.chunk[1] = 0BBX) &
(text.chunk[2] = 0BFX) THEN
text.pos := 3;
text.utf8 := TRUE
END
END;
IF text.size = 0 THEN
text.chunk[0] := 0;
text.chunk[0] := 0X;
text.size := 1;
text.eof := FALSE
END;
@ -121,7 +121,7 @@ BEGIN
text.line := 1;
text.col := 1;
text.peak := CHR(text.chunk[text.pos])
text.peak := text.chunk[text.pos]
END init;
@ -152,7 +152,7 @@ BEGIN
END;
IF text # NIL THEN
text.chunk[0] := 0;
text.chunk[0] := 0X;
text.pos := 0;
text.size := 0;
text.utf8 := FALSE;

67
programs/develop/oberon07/Source/UTILS.ob07
View File

@ -1,13 +1,13 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
MODULE UTILS;
IMPORT HOST, UNIXTIME;
IMPORT HOST;
CONST
@ -24,6 +24,11 @@ CONST
max32* = 2147483647;
TYPE
DAYS = ARRAY 12, 31, 2 OF INTEGER;
VAR
time*: INTEGER;
@ -48,8 +53,10 @@ VAR
bit_diff*: INTEGER;
days: DAYS;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
RETURN HOST.FileRead(F, Buffer, bytes)
END FileRead;
@ -114,6 +121,11 @@ BEGIN
END GetCurrentDirectory;
PROCEDURE GetUnixTime* (year, month, day, hour, min, sec: INTEGER): INTEGER;
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
END GetUnixTime;
PROCEDURE UnixTime* (): INTEGER;
VAR
year, month, day, hour, min, sec: INTEGER;
@ -124,7 +136,7 @@ BEGIN
res := HOST.UnixTime()
ELSE
HOST.now(year, month, day, hour, min, sec);
res := UNIXTIME.time(year, month, day, hour, min, sec)
res := GetUnixTime(year, month, day, hour, min, sec)
END
RETURN res
@ -201,9 +213,52 @@ BEGIN
END Log2;
PROCEDURE init (VAR days: DAYS);
VAR
i, j, n0, n1: INTEGER;
BEGIN
FOR i := 0 TO 11 DO
FOR j := 0 TO 30 DO
days[i, j, 0] := 0;
days[i, j, 1] := 0;
END
END;
days[ 1, 28, 0] := -1;
FOR i := 0 TO 1 DO
days[ 1, 29, i] := -1;
days[ 1, 30, i] := -1;
days[ 3, 30, i] := -1;
days[ 5, 30, i] := -1;
days[ 8, 30, i] := -1;
days[10, 30, i] := -1;
END;
n0 := 0;
n1 := 0;
FOR i := 0 TO 11 DO
FOR j := 0 TO 30 DO
IF days[i, j, 0] = 0 THEN
days[i, j, 0] := n0;
INC(n0)
END;
IF days[i, j, 1] = 0 THEN
days[i, j, 1] := n1;
INC(n1)
END
END
END
END init;
BEGIN
time := GetTickCount();
COPY(HOST.eol, eol);
maxreal := 1.9;
PACK(maxreal, 1023)
PACK(maxreal, 1023);
init(days)
END UTILS.

4
programs/develop/oberon07/Source/WRITER.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)

115
programs/develop/oberon07/Source/X86.ob07
View File

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -573,7 +573,7 @@ BEGIN
END GetRegA;
PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER);
PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER);
VAR
cmd: COMMAND;
@ -586,7 +586,7 @@ VAR
float: REAL;
BEGIN
cmd := code.commands.first(COMMAND);
cmd := IL.codes.commands.first(COMMAND);
WHILE cmd # NIL DO
@ -1186,27 +1186,29 @@ BEGIN
|8:
PushAll(0);
push(reg2);
push(reg1);
push(reg2);
pushc(8);
CallRTL(pic, IL._move)
END
|IL.opSAVES:
UnOp(reg1);
drop;
PushAll(0);
push(reg1);
UnOp(reg2);
REG.PushAll_1(R);
IF pic THEN
reg1 := GetAnyReg();
Pic(reg1, BIN.PICDATA, stroffs + param2);
push(reg1)
push(reg1);
drop
ELSE
OutByte(068H); // push _data + stroffs + param2
Reloc(BIN.RDATA, stroffs + param2);
END;
push(reg2);
drop;
pushc(param1);
CallRTL(pic, IL._move)
@ -1458,16 +1460,17 @@ BEGIN
GetRegA
|IL.opRSETL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(pic, IL._set2);
push(reg1);
drop;
CallRTL(pic, IL._set);
GetRegA
|IL.opRSET1:
UnOp(reg1);
PushAll(1);
push(reg1);
CallRTL(pic, IL._set);
CallRTL(pic, IL._set1);
GetRegA
|IL.opINCL, IL.opEXCL:
@ -1497,7 +1500,7 @@ BEGIN
|IL.opDIV:
PushAll(2);
CallRTL(pic, IL._div);
CallRTL(pic, IL._divmod);
GetRegA
|IL.opDIVR:
@ -1540,20 +1543,24 @@ BEGIN
ELSE
PushAll(1);
pushc(param2);
CallRTL(pic, IL._div);
CallRTL(pic, IL._divmod);
GetRegA
END
END
|IL.opDIVL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(pic, IL._div2);
push(reg1);
drop;
CallRTL(pic, IL._divmod);
GetRegA
|IL.opMOD:
PushAll(2);
CallRTL(pic, IL._mod);
CallRTL(pic, IL._divmod);
mov(eax, edx);
GetRegA
|IL.opMODR:
@ -1589,15 +1596,20 @@ BEGIN
ELSE
PushAll(1);
pushc(param2);
CallRTL(pic, IL._mod);
CallRTL(pic, IL._divmod);
mov(eax, edx);
GetRegA
END
END
|IL.opMODL:
PushAll(1);
UnOp(reg1);
REG.PushAll_1(R);
pushc(param2);
CallRTL(pic, IL._mod2);
push(reg1);
drop;
CallRTL(pic, IL._divmod);
mov(eax, edx);
GetRegA
|IL.opERR:
@ -1613,11 +1625,11 @@ BEGIN
|IL.opCOPY:
PushAll(2);
pushc(param2);
CallRTL(pic, IL._move2)
CallRTL(pic, IL._move)
|IL.opMOVE:
PushAll(3);
CallRTL(pic, IL._move2)
CallRTL(pic, IL._move)
|IL.opCOPYA:
PushAll(4);
@ -2075,9 +2087,9 @@ BEGIN
END translate;
PROCEDURE prolog (code: IL.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER);
PROCEDURE prolog (pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER);
VAR
reg1, entry, dcount: INTEGER;
reg1, entry, L, dcount: INTEGER;
BEGIN
@ -2131,7 +2143,7 @@ BEGIN
Reloc(BIN.RDATA, 0)
END;
dcount := CHL.Length(code.data);
dcount := CHL.Length(IL.codes.data);
pushc(tcount);
@ -2145,11 +2157,26 @@ BEGIN
Reloc(BIN.RDATA, tcount * 4 + dcount)
END;
CallRTL(pic, IL._init)
CallRTL(pic, IL._init);
IF target = mConst.Target_iELF32 THEN
L := NewLabel();
pushc(0);
push(esp);
pushc(1024 * 1024 * stack);
pushc(0);
CallRTL(pic, IL._new);
pop(eax);
test(eax);
jcc(je, L);
addrc(eax, 1024 * 1024 * stack - 4);
mov(esp, eax);
SetLabel(L)
END
END prolog;
PROCEDURE epilog (code: IL.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER);
PROCEDURE epilog (pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER);
VAR
exp: IL.EXPORT_PROC;
path, name, ext: PATHS.PATH;
@ -2200,14 +2227,14 @@ BEGIN
fixup;
dcount := CHL.Length(code.data);
dcount := CHL.Length(IL.codes.data);
FOR i := 0 TO tcount - 1 DO
BIN.PutData32LE(program, CHL.GetInt(code.types, i))
BIN.PutData32LE(program, CHL.GetInt(IL.codes.types, i))
END;
FOR i := 0 TO dcount - 1 DO
BIN.PutData(program, CHL.GetByte(code.data, i))
BIN.PutData(program, CHL.GetByte(IL.codes.data, i))
END;
program.modname := CHL.Length(program.data);
@ -2221,33 +2248,33 @@ BEGIN
BIN.Export(program, "lib_init", dllinit);
END;
exp := code.export.first(IL.EXPORT_PROC);
exp := IL.codes.export.first(IL.EXPORT_PROC);
WHILE exp # NIL DO
BIN.Export(program, exp.name, exp.label);
exp := exp.next(IL.EXPORT_PROC)
END;
import(code.import);
import(IL.codes.import);
code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 4));
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4)));
BIN.SetParams(program, code.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536));
BIN.SetParams(program, IL.codes.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536));
END epilog;
PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR
dllret, dllinit, sofinit: INTEGER;
opt: PROG.OPTIONS;
BEGIN
tcount := CHL.Length(code.types);
tcount := CHL.Length(IL.codes.types);
opt := options;
CodeList := LISTS.create(NIL);
program := BIN.create(code.lcount);
program := BIN.create(IL.codes.lcount);
dllinit := NewLabel();
dllret := NewLabel();
@ -2263,14 +2290,14 @@ BEGIN
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {});
prolog(code, opt.pic, target, opt.stack, dllinit, dllret);
translate(code, opt.pic, tcount * 4);
epilog(code, opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);
prolog(opt.pic, target, opt.stack, dllinit, dllret);
translate(opt.pic, tcount * 4);
epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);
BIN.fixup(program);
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
PE32.write(program, outname, opt.base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE)
PE32.write(program, outname, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE)
ELSIF target = mConst.Target_iKolibri THEN
KOS.write(program, outname)
ELSIF target = mConst.Target_iObject THEN