Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 7695 → Rev 7696

/programs/develop/oberon07/Compiler.kex
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/programs/develop/oberon07/Docs/About1251.txt
9,8 → 9,7
Âûõîä - èñïîíÿåìûé ôàéë ôîðìàòà PE32, ELF èëè MENUET01/MSCOFF.
Ïàðàìåòðû:
1) èìÿ ãëàâíîãî ìîäóëÿ
2) èìÿ ðåçóëüòèðóþùåãî ôàéëà
3) òèï ïðèëîæåíèÿ è ïëàòôîðìà
2) òèï ïðèëîæåíèÿ
"console" - Windows console
"gui" - Windows GUI
"dll" - Windows DLL
18,11 → 17,14
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá)
-base <address> àäðåñ çàãðóçêè èñïîëíÿåìîãî ôàéëà â êèëîáàéòàõ
3) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è
-out <file_name> èìÿ ðåçóëüòèðóþùåãî ôàéëà; ïî óìîë÷àíèþ,
ñîâïàäàåò ñ èìåíåì ãëàâíîãî ìîäóëÿ, íî ñ äðóãèì ðàñøèðåíèåì
(ñîîòâåòñòâóåò òèïó èñïîëíÿåìîãî ôàéëà)
-stk <size> ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá,
äîïóñòèìî îò 1 äî 32 Ìá)
-nochk <"ptibcwra"> îòêëþ÷èòü ïðîâåðêè ïðè âûïîëíåíèè (ñì. íèæå)
-ver <major.minor> âåðñèÿ ïðîãðàììû (òîëüêî äëÿ obj)
-nochk <"ptibcwra"> îòêëþ÷èòü ïðîâåðêè ïðè âûïîëíåíèè (ñì. íèæå)
 
ïàðàìåòð -nochk çàäàåòñÿ â âèäå ñòðîêè èç ñèìâîëîâ:
"p" - óêàçàòåëè
42,13 → 44,13
 
Íàïðèìåð:
 
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,25 → 168,7
íàïðèìåð:
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 íåëüçÿ èñïîëüçîâàòü â êîíñòàíòíûõ âûðàæåíèÿõ.
 
------------------------------------------------------------------------------
/programs/develop/oberon07/Docs/About866.txt
9,8 → 9,7
‚ë室 - ¨á¯®­ï¥¬ë© ä ©« ä®à¬ â  PE32, ELF ¨«¨ MENUET01/MSCOFF.
 à ¬¥âàë:
1) ¨¬ï £« ¢­®£® ¬®¤ã«ï
2) ¨¬ï १ã«ìâ¨àãî饣® ä ©« 
3) ⨯ ¯à¨«®¦¥­¨ï ¨ ¯« âä®à¬ 
2) ⨯ ¯à¨«®¦¥­¨ï
"console" - Windows console
"gui" - Windows GUI
"dll" - Windows DLL
18,11 → 17,14
"obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡)
-base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å
3) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-out <file_name> ¨¬ï १ã«ìâ¨àãî饣® ä ©« ; ¯® 㬮«ç ­¨î,
ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ £« ¢­®£® ¬®¤ã«ï, ­® á ¤à㣨¬ à áè¨à¥­¨¥¬
(ᮮ⢥âáâ¢ã¥â ⨯㠨ᯮ«­ï¥¬®£® ä ©« )
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡,
¤®¯ãá⨬® ®â 1 ¤® 32 Œ¡)
-nochk <"ptibcwra"> ®âª«îç¨âì ¯à®¢¥àª¨ ¯à¨ ¢ë¯®«­¥­¨¨ (á¬. ­¨¦¥)
-ver <major.minor> ¢¥àá¨ï ¯à®£à ¬¬ë (⮫쪮 ¤«ï obj)
-nochk <"ptibcwra"> ®âª«îç¨âì ¯à®¢¥àª¨ ¯à¨ ¢ë¯®«­¥­¨¨ (á¬. ­¨¦¥)
 
¯ à ¬¥âà -nochk § ¤ ¥âáï ¢ ¢¨¤¥ áâப¨ ¨§ ᨬ¢®«®¢:
"p" - 㪠§ â¥«¨
42,13 → 44,13
 
 ¯à¨¬¥à:
 
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,25 → 168,7
­ ¯à¨¬¥à:
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 ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ª®­áâ ­â­ëå ¢ëà ¦¥­¨ïå.
 
------------------------------------------------------------------------------
/programs/develop/oberon07/Docs/KOSLib1251.txt
307,7 → 307,7
 
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
 
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 - äàòà, âðåìÿ
/programs/develop/oberon07/Docs/KOSLib866.txt
307,7 → 307,7
 
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
 
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 - ¤ â , ¢à¥¬ï
/programs/develop/oberon07/Lib/KolibriOS/API.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, Anton Krotov
18,7 → 18,9
_new = 1;
_dispose = 2;
 
SizeOfHeader = 36;
 
 
TYPE
 
CRITICAL_SECTION = ARRAY 2 OF INTEGER;
294,7 → 296,7
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;
/programs/develop/oberon07/Lib/KolibriOS/Args.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/Console.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/File.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
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
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;
/programs/develop/oberon07/Lib/KolibriOS/In.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Lib/KolibriOS/Math.ob07
1,4 → 1,4
(*
(*
Copyright 2013, 2014, 2018, 2019 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07
1,4 → 1,4
(*
(*
Copyright 2017 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/Out.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
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
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
 
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
 
dll: RECORD
process_detach,
45,10 → 46,9
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 *)
55,31 → 55,6
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 *)
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 *)
92,7 → 67,7
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
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
 
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
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,77 → 128,50
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 *)
)
END _divmod;
 
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;
 
 
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
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
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
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
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
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
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
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,7 → 564,7
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))
603,6 → 571,12
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
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
/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 KolibriOS team
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/Read.ob07
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
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.
END Read.
/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07
0,0 → 1,64
(*
BSD 2-Clause License
 
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
MODULE UnixTime;
 
 
VAR
 
days: ARRAY 12, 31, 2 OF INTEGER;
 
 
PROCEDURE init;
VAR
i, j, k, 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 k := 0 TO 1 DO
days[ 1, 29, k] := -1;
days[ 1, 30, k] := -1;
days[ 3, 30, k] := -1;
days[ 5, 30, k] := -1;
days[ 8, 30, k] := -1;
days[10, 30, k] := -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;
 
 
PROCEDURE time* (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 time;
 
 
BEGIN
init
END UnixTime.
/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07
1,4 → 1,4
(*
(*
Copyright 2016 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/Write.ob07
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
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.
END Write.
/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 Anton Krotov
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07
1,4 → 1,4
(*
(*
Copyright 2016, 2018 KolibriOS team
 
This program is free software: you can redistribute it and/or modify
/programs/develop/oberon07/Lib/Linux32/API.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
12,7 → 12,7
 
CONST
 
BASE_ADR = 08048000H;
RTLD_LAZY* = 1;
 
 
TYPE
23,7 → 23,7
VAR
 
eol*: ARRAY 2 OF CHAR;
base*, MainParam*: INTEGER;
MainParam*: INTEGER;
 
libc*, librt*: INTEGER;
 
93,6 → 93,7
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
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
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;
 
/programs/develop/oberon07/Lib/Linux32/HOST.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
68,22 → 68,12
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
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
/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
74,12 → 74,18
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;
 
/programs/develop/oberon07/Lib/Linux32/RTL.ob07
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
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
 
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
 
dll: RECORD
process_detach,
45,10 → 46,9
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 *)
55,31 → 55,6
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 *)
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 *)
92,7 → 67,7
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
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
 
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
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,77 → 128,50
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 *)
)
END _divmod;
 
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;
 
 
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
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
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
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
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
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
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
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,7 → 564,7
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))
603,6 → 571,12
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
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
/programs/develop/oberon07/Lib/Windows32/API.ob07
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
 
IMPORT SYSTEM;
 
 
CONST
 
SectionAlignment = 1000H;
 
 
VAR
 
eol*: ARRAY 3 OF CHAR;
46,7 → 52,7
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;
 
/programs/develop/oberon07/Lib/Windows32/HOST.ob07
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
 
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
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;
 
/programs/develop/oberon07/Lib/Windows32/RTL.ob07
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
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
 
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
 
dll: RECORD
process_detach,
45,10 → 46,9
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 *)
55,31 → 55,6
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 *)
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 *)
92,7 → 67,7
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
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
 
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
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,77 → 128,50
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 *)
)
END _divmod;
 
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;
 
 
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
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
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
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
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
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
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
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,7 → 564,7
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))
603,6 → 571,12
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
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
/programs/develop/oberon07/Samples/HW_con.ob07
1,4 → 1,4
MODULE HW_con;
MODULE HW_con;
 
IMPORT Out, In, Console, DateTime;
 
/programs/develop/oberon07/Source/UNIXTIME.ob07
File deleted
\ No newline at end of file
/programs/develop/oberon07/Source/AMD64.ob07
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
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
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
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
|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
 
|IL.opDIV:
PushAll(2);
CallRTL(IL._div);
CallRTL(IL._divmod);
GetRegA
 
|IL.opDIVR:
1854,20 → 1858,24
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
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
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
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
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
 
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
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
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
 
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
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
/programs/develop/oberon07/Source/ARITH.ob07
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
 
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,22 → 77,17
 
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;
 
 
102,13 → 94,11
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
CASE v.typ OF
|tINTEGER: res := v.int = 0
|tREAL: res := v.float = 0.0
END
 
RETURN res
/programs/develop/oberon07/Source/AVLTREES.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/BIN.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/CHUNKLISTS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/COLLECTIONS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/CONSOLE.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/CONSTANTS.ob07
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
CONST
 
vMajor* = 1;
vMinor* = 0;
vMinor* = 13;
 
FILE_EXT* = ".ob07";
RTL_NAME* = "RTL";
/programs/develop/oberon07/Source/Compiler.ob07
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
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
checking: SET;
 
BEGIN
out := "";
checking := options.checking;
end := FALSE;
i := 4;
i := 3;
REPEAT
UTILS.GetArg(i, param);
 
76,14 → 77,13
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,7 → 202,7
 
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
209,13 → 209,13
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
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
 
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,8 → 283,35
 
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);
 
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
308,6 → 321,7
 
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");
 
/programs/develop/oberon07/Source/ELF.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
/programs/develop/oberon07/Source/ERRORS.ob07
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
|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, '"')
/programs/develop/oberon07/Source/FILES.ob07
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
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;
 
/programs/develop/oberon07/Source/IL.ob07
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
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
_isrec *= 19;
_guard *= 20;
_guardrec *= 21;
_length *= 22;
_init *= 23;
_dllentry *= 24;
_sofinit *= 25;
 
 
TYPE
175,7 → 171,7
END;
 
 
CODES* = POINTER TO RECORD
CODES = RECORD
 
last: COMMAND;
begcall: CMDSTACK;
188,7 → 184,7
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
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
END getlast;
 
 
PROCEDURE PutByte (codes: CODES; b: BYTE);
PROCEDURE PutByte (b: BYTE);
BEGIN
CHL.PushByte(codes.data, b)
END PutByte;
272,11 → 286,11
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
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
res := CHL.Length(codes.data);
 
IF ODD(res) THEN
PutByte(codes, 0);
PutByte(0);
INC(res)
END;
 
317,17 → 331,17
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
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
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
numRegsFloat := pNumRegsFloat;
endianness := pEndianness;
 
NEW(codes);
NEW(codes.begcall);
codes.begcall.top := -1;
NEW(codes.endcall);
/programs/develop/oberon07/Source/KOS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/LISTS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/MSCOFF.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/MSP430.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
582,7 → 582,7
END Neg;
 
 
PROCEDURE translate (code: IL.CODES);
PROCEDURE translate;
VAR
cmd, next: COMMAND;
 
593,7 → 593,7
cc: INTEGER;
 
BEGIN
cmd := code.commands.first(COMMAND);
cmd := IL.codes.commands.first(COMMAND);
 
WHILE cmd # NIL DO
 
1643,7 → 1643,7
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
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
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,8 → 1724,8
 
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;
 
1732,7 → 1732,7
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
/programs/develop/oberon07/Source/MSP430RTL.ob07
1,4 → 1,4
(*
(*
BSD 2-Clause License
 
Copyright (c) 2019, Anton Krotov
/programs/develop/oberon07/Source/PARS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
77,7 → 77,9
 
parsers: C.COLLECTION;
 
lines*: INTEGER;
 
 
PROCEDURE destroy* (VAR parser: PARSER);
BEGIN
IF parser.scanner # NIL THEN
1178,9 → 1180,9
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,8 → 1250,9
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;
 
 
END PARS.
END PARS.
/programs/develop/oberon07/Source/PATHS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/PE32.ob07
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
(* 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
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
 
END;
 
BaseAddress: INTEGER;
 
Address: VIRTUAL_ADDR;
 
File: FILE;
504,6 → 506,12
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
 
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;
 
/programs/develop/oberon07/Source/PROG.ob07
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
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
 
OPTIONS* = RECORD
 
version*, stack*, base*, ram*, rom*: INTEGER;
version*, stack*, ram*, rom*: INTEGER;
pic*: BOOLEAN;
checking*: SET
 
205,7 → 205,7
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
 
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
END;
 
DEC(unit.scopeLvl)
 
END closeScope;
 
 
631,6 → 634,13
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,26 → 1069,16
 
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;
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
 
ASSERT(res # NIL)
 
RETURN res
END getType;
 
1126,10 → 1126,6
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
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
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;
 
/programs/develop/oberon07/Source/REG.ob07
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
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;
 
/programs/develop/oberon07/Source/SCAN.ob07
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
IDENT* = POINTER TO RECORD (AVL.DATA)
 
s*: LEXSTR;
offset*, offsetW*: INTEGER
offset*, offsetW*: INTEGER;
key: INTEGER
 
END;
 
78,19 → 79,14
 
SCANNER* = TXT.TEXT;
 
KEYWORD = ARRAY 10 OF CHAR;
 
 
VAR
 
vocabulary: RECORD
idents: AVL.NODE;
 
KW: ARRAY 33 OF KEYWORD;
delimiters: ARRAY 256 OF BOOLEAN;
idents: AVL.NODE;
ident: IDENT
 
END;
NewIdent: IDENT;
 
upto: BOOLEAN;
 
100,33 → 96,6
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;
133,13 → 102,14
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,13 → 151,13
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
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
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,58 → 550,60
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;
 
NEW(vocabulary.ident);
vocabulary.ident.s := "";
vocabulary.ident.offset := -1;
vocabulary.ident.offsetW := -1;
vocabulary.idents := NIL
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")
 
END init;
 
 
BEGIN
init
END SCAN.
END SCAN.
/programs/develop/oberon07/Source/STATEMENTS.ob07
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
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,30 → 278,17
ELSE
res := TRUE
END
ELSIF isSet(e) & (t = tSET) 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
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
res := TRUE
ELSE
res := FALSE
END
315,6 → 295,7
ELSE
res := FALSE
END
 
RETURN res
END assigncomp;
 
384,18 → 365,10
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
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
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
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
IF e.obj = eCONST THEN
ARITH.odd(e.value)
ELSE
IL.odd
IL.AddCmd0(IL.opODD)
END
 
|PROG.stORD:
1156,7 → 1127,7
END
ELSE
IF isBoolean(e) THEN
IL.ord
IL.AddCmd0(IL.opORD)
END
END;
e.type := tINTEGER
3257,10 → 3228,10
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
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
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,15 → 3349,15
 
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;
 
 
END STATEMENTS.
END STATEMENTS.
/programs/develop/oberon07/Source/STRINGS.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/TEXTDRV.ob07
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
 
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
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
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
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,9 → 104,9
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
113,7 → 113,7
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
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
END;
 
IF text # NIL THEN
text.chunk[0] := 0;
text.chunk[0] := 0X;
text.pos := 0;
text.size := 0;
text.utf8 := FALSE;
/programs/develop/oberon07/Source/UTILS.ob07
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
max32* = 2147483647;
 
 
TYPE
 
DAYS = ARRAY 12, 31, 2 OF INTEGER;
 
 
VAR
 
time*: INTEGER;
48,8 → 53,10
 
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
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
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
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)
END UTILS.
PACK(maxreal, 1023);
init(days)
END UTILS.
/programs/develop/oberon07/Source/WRITER.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
 
/programs/develop/oberon07/Source/X86.ob07
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
END GetRegA;
 
 
PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER);
PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER);
VAR
cmd: COMMAND;
 
586,7 → 586,7
float: REAL;
 
BEGIN
cmd := code.commands.first(COMMAND);
cmd := IL.codes.commands.first(COMMAND);
 
WHILE cmd # NIL DO
 
1186,8 → 1186,8
 
|8:
PushAll(0);
push(reg1);
push(reg2);
push(reg1);
pushc(8);
CallRTL(pic, IL._move)
 
1194,19 → 1194,21
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
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
 
|IL.opDIV:
PushAll(2);
CallRTL(pic, IL._div);
CallRTL(pic, IL._divmod);
GetRegA
 
|IL.opDIVR:
1540,20 → 1543,24
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
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
|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
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
Reloc(BIN.RDATA, 0)
END;
 
dcount := CHL.Length(code.data);
dcount := CHL.Length(IL.codes.data);
 
pushc(tcount);
 
2145,11 → 2157,26
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
 
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
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
 
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