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

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

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

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

@ -1,94 +1,94 @@
============================================================================== ==============================================================================
Áèáëèîòåêà (KolibriOS) Áèáëèîòåêà (KolibriOS)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Out - консольный вывод MODULE Out - консольный вывод
PROCEDURE Open PROCEDURE Open
ôîðìàëüíî îòêðûâàåò êîíñîëüíûé âûâîä ôîðìàëüíî îòêðûâàåò êîíñîëüíûé âûâîä
PROCEDURE Int(x, width: INTEGER) PROCEDURE Int(x, width: INTEGER)
âûâîä öåëîãî ÷èñëà x; âûâîä öåëîãî ÷èñëà x;
width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà
PROCEDURE Real(x: REAL; width: INTEGER) PROCEDURE Real(x: REAL; width: INTEGER)
âûâîä âåùåñòâåííîãî ÷èñëà x â ïëàâàþùåì ôîðìàòå; âûâîä âåùåñòâåííîãî ÷èñëà x â ïëàâàþùåì ôîðìàòå;
width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà
PROCEDURE Char(x: CHAR) PROCEDURE Char(x: CHAR)
âûâîä ñèìâîëà x âûâîä ñèìâîëà x
PROCEDURE FixReal(x: REAL; width, p: INTEGER) PROCEDURE FixReal(x: REAL; width, p: INTEGER)
âûâîä âåùåñòâåííîãî ÷èñëà x â ôèêñèðîâàííîì ôîðìàòå; âûâîä âåùåñòâåííîãî ÷èñëà x â ôèêñèðîâàííîì ôîðìàòå;
width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà; width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà;
p - êîëè÷åñòâî çíàêîâ ïîñëå äåñÿòè÷íîé òî÷êè p - êîëè÷åñòâî çíàêîâ ïîñëå äåñÿòè÷íîé òî÷êè
PROCEDURE Ln PROCEDURE Ln
ïåðåõîä íà ñëåäóþùóþ ñòðîêó ïåðåõîä íà ñëåäóþùóþ ñòðîêó
PROCEDURE String(s: ARRAY OF CHAR) PROCEDURE String(s: ARRAY OF CHAR)
âûâîä ñòðîêè s âûâîä ñòðîêè s
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE In - консольный ввод MODULE In - консольный ввод
VAR Done: BOOLEAN VAR Done: BOOLEAN
ïðèíèìàåò çíà÷åíèå TRUE â ñëó÷àå óñïåøíîãî âûïîëíåíèÿ ïðèíèìàåò çíà÷åíèå TRUE â ñëó÷àå óñïåøíîãî âûïîëíåíèÿ
îïåðàöèè ââîäà, èíà÷å FALSE îïåðàöèè ââîäà, èíà÷å FALSE
PROCEDURE Open PROCEDURE Open
ôîðìàëüíî îòêðûâàåò êîíñîëüíûé ââîä, ôîðìàëüíî îòêðûâàåò êîíñîëüíûé ââîä,
òàêæå ïðèñâàèâàåò ïåðåìåííîé Done çíà÷åíèå TRUE òàêæå ïðèñâàèâàåò ïåðåìåííîé Done çíà÷åíèå TRUE
PROCEDURE Int(VAR x: INTEGER) PROCEDURE Int(VAR x: INTEGER)
ââîä ÷èñëà òèïà INTEGER ââîä ÷èñëà òèïà INTEGER
PROCEDURE Char(VAR x: CHAR) PROCEDURE Char(VAR x: CHAR)
ââîä ñèìâîëà ââîä ñèìâîëà
PROCEDURE Real(VAR x: REAL) PROCEDURE Real(VAR x: REAL)
ââîä ÷èñëà òèïà REAL ââîä ÷èñëà òèïà REAL
PROCEDURE String(VAR s: ARRAY OF CHAR) PROCEDURE String(VAR s: ARRAY OF CHAR)
ââîä ñòðîêè ââîä ñòðîêè
PROCEDURE Ln PROCEDURE Ln
îæèäàíèå íàæàòèÿ ENTER îæèäàíèå íàæàòèÿ ENTER
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Console - дополнительные процедуры консольного вывода MODULE Console - дополнительные процедуры консольного вывода
CONST CONST
Ñëåäóþùèå êîíñòàíòû îïðåäåëÿþò öâåò êîíñîëüíîãî âûâîäà Ñëåäóþùèå êîíñòàíòû îïðåäåëÿþò öâåò êîíñîëüíîãî âûâîäà
Black = 0 Blue = 1 Green = 2 Black = 0 Blue = 1 Green = 2
Cyan = 3 Red = 4 Magenta = 5 Cyan = 3 Red = 4 Magenta = 5
Brown = 6 LightGray = 7 DarkGray = 8 Brown = 6 LightGray = 7 DarkGray = 8
LightBlue = 9 LightGreen = 10 LightCyan = 11 LightBlue = 9 LightGreen = 10 LightCyan = 11
LightRed = 12 LightMagenta = 13 Yellow = 14 LightRed = 12 LightMagenta = 13 Yellow = 14
White = 15 White = 15
PROCEDURE Cls PROCEDURE Cls
î÷èñòêà îêíà êîíñîëè î÷èñòêà îêíà êîíñîëè
PROCEDURE SetColor(FColor, BColor: INTEGER) PROCEDURE SetColor(FColor, BColor: INTEGER)
óñòàíîâêà öâåòà êîíñîëüíîãî âûâîäà: FColor - öâåò òåêñòà, óñòàíîâêà öâåòà êîíñîëüíîãî âûâîäà: FColor - öâåò òåêñòà,
BColor - öâåò ôîíà, âîçìîæíûå çíà÷åíèÿ - âûøåïåðå÷èñëåííûå BColor - öâåò ôîíà, âîçìîæíûå çíà÷åíèÿ - âûøåïåðå÷èñëåííûå
êîíñòàíòû êîíñòàíòû
PROCEDURE SetCursor(x, y: INTEGER) PROCEDURE SetCursor(x, y: INTEGER)
óñòàíîâêà êóðñîðà êîíñîëè â ïîçèöèþ (x, y) óñòàíîâêà êóðñîðà êîíñîëè â ïîçèöèþ (x, y)
PROCEDURE GetCursor(VAR x, y: INTEGER) PROCEDURE GetCursor(VAR x, y: INTEGER)
çàïèñûâàåò â ïàðàìåòðû òåêóùèå êîîðäèíàòû êóðñîðà êîíñîëè çàïèñûâàåò â ïàðàìåòðû òåêóùèå êîîðäèíàòû êóðñîðà êîíñîëè
PROCEDURE GetCursorX(): INTEGER PROCEDURE GetCursorX(): INTEGER
âîçâðàùàåò òåêóùóþ x-êîîðäèíàòó êóðñîðà êîíñîëè âîçâðàùàåò òåêóùóþ x-êîîðäèíàòó êóðñîðà êîíñîëè
PROCEDURE GetCursorY(): INTEGER PROCEDURE GetCursorY(): INTEGER
âîçâðàùàåò òåêóùóþ y-êîîðäèíàòó êóðñîðà êîíñîëè âîçâðàùàåò òåêóùóþ y-êîîðäèíàòó êóðñîðà êîíñîëè
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE ConsoleLib - обертка библиотеки console.obj MODULE ConsoleLib - обертка библиотеки console.obj
@ -96,469 +96,469 @@ MODULE ConsoleLib -
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Math - математические функции MODULE Math - математические функции
CONST CONST
pi = 3.141592653589793E+00 pi = 3.141592653589793E+00
e = 2.718281828459045E+00 e = 2.718281828459045E+00
PROCEDURE IsNan(x: REAL): BOOLEAN PROCEDURE IsNan(x: REAL): BOOLEAN
âîçâðàùàåò TRUE, åñëè x - íå ÷èñëî âîçâðàùàåò TRUE, åñëè x - íå ÷èñëî
PROCEDURE IsInf(x: REAL): BOOLEAN PROCEDURE IsInf(x: REAL): BOOLEAN
âîçâðàùàåò TRUE, åñëè x - áåñêîíå÷íîñòü âîçâðàùàåò TRUE, åñëè x - áåñêîíå÷íîñòü
PROCEDURE sqrt(x: REAL): REAL PROCEDURE sqrt(x: REAL): REAL
êâàäðàòíûé êîðåíü x êâàäðàòíûé êîðåíü x
PROCEDURE exp(x: REAL): REAL PROCEDURE exp(x: REAL): REAL
ýêñïîíåíòà x ýêñïîíåíòà x
PROCEDURE ln(x: REAL): REAL PROCEDURE ln(x: REAL): REAL
íàòóðàëüíûé ëîãàðèôì x íàòóðàëüíûé ëîãàðèôì x
PROCEDURE sin(x: REAL): REAL PROCEDURE sin(x: REAL): REAL
ñèíóñ x ñèíóñ x
PROCEDURE cos(x: REAL): REAL PROCEDURE cos(x: REAL): REAL
êîñèíóñ x êîñèíóñ x
PROCEDURE tan(x: REAL): REAL PROCEDURE tan(x: REAL): REAL
òàíãåíñ x òàíãåíñ x
PROCEDURE arcsin(x: REAL): REAL PROCEDURE arcsin(x: REAL): REAL
àðêñèíóñ x àðêñèíóñ x
PROCEDURE arccos(x: REAL): REAL PROCEDURE arccos(x: REAL): REAL
àðêêîñèíóñ x àðêêîñèíóñ x
PROCEDURE arctan(x: REAL): REAL PROCEDURE arctan(x: REAL): REAL
àðêòàíãåíñ x àðêòàíãåíñ x
PROCEDURE arctan2(y, x: REAL): REAL PROCEDURE arctan2(y, x: REAL): REAL
àðêòàíãåíñ y/x àðêòàíãåíñ y/x
PROCEDURE power(base, exponent: REAL): REAL PROCEDURE power(base, exponent: REAL): REAL
âîçâåäåíèå ÷èñëà base â ñòåïåíü exponent âîçâåäåíèå ÷èñëà base â ñòåïåíü exponent
PROCEDURE log(base, x: REAL): REAL PROCEDURE log(base, x: REAL): REAL
ëîãàðèôì x ïî îñíîâàíèþ base ëîãàðèôì x ïî îñíîâàíèþ base
PROCEDURE sinh(x: REAL): REAL PROCEDURE sinh(x: REAL): REAL
ãèïåðáîëè÷åñêèé ñèíóñ x ãèïåðáîëè÷åñêèé ñèíóñ x
PROCEDURE cosh(x: REAL): REAL PROCEDURE cosh(x: REAL): REAL
ãèïåðáîëè÷åñêèé êîñèíóñ x ãèïåðáîëè÷åñêèé êîñèíóñ x
PROCEDURE tanh(x: REAL): REAL PROCEDURE tanh(x: REAL): REAL
ãèïåðáîëè÷åñêèé òàíãåíñ x ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE arsinh(x: REAL): REAL PROCEDURE arsinh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x
PROCEDURE arcosh(x: REAL): REAL PROCEDURE arcosh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x
PROCEDURE artanh(x: REAL): REAL PROCEDURE artanh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE round(x: REAL): REAL PROCEDURE round(x: REAL): REAL
îêðóãëåíèå x äî áëèæàéøåãî öåëîãî îêðóãëåíèå x äî áëèæàéøåãî öåëîãî
PROCEDURE frac(x: REAL): REAL; PROCEDURE frac(x: REAL): REAL;
äðîáíàÿ ÷àñòü ÷èñëà x äðîáíàÿ ÷àñòü ÷èñëà x
PROCEDURE floor(x: REAL): REAL PROCEDURE floor(x: REAL): REAL
íàèáîëüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL), íàèáîëüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL),
íå áîëüøå x: floor(1.2) = 1.0 íå áîëüøå x: floor(1.2) = 1.0
PROCEDURE ceil(x: REAL): REAL PROCEDURE ceil(x: REAL): REAL
íàèìåíüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL), íàèìåíüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL),
íå ìåíüøå x: ceil(1.2) = 2.0 íå ìåíüøå x: ceil(1.2) = 2.0
PROCEDURE sgn(x: REAL): INTEGER PROCEDURE sgn(x: REAL): INTEGER
åñëè x > 0 âîçâðàùàåò 1 åñëè x > 0 âîçâðàùàåò 1
åñëè x < 0 âîçâðàùàåò -1 åñëè x < 0 âîçâðàùàåò -1
åñëè x = 0 âîçâðàùàåò 0 åñëè x = 0 âîçâðàùàåò 0
PROCEDURE fact(n: INTEGER): REAL PROCEDURE fact(n: INTEGER): REAL
ôàêòîðèàë n ôàêòîðèàë n
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Debug - вывод на доску отладки MODULE Debug - вывод на доску отладки
Èíòåðôåéñ êàê ìîäóëü Out Èíòåðôåéñ êàê ìîäóëü Out
PROCEDURE Open PROCEDURE Open
îòêðûâàåò äîñêó îòëàäêè îòêðûâàåò äîñêó îòëàäêè
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE File - работа с файловой системой MODULE File - работа с файловой системой
TYPE TYPE
FNAME = ARRAY 520 OF CHAR FNAME = ARRAY 520 OF CHAR
FS = POINTER TO rFS FS = POINTER TO rFS
rFS = RECORD (* èíôîðìàöèîííàÿ ñòðóêòóðà ôàéëà *) rFS = RECORD (* èíôîðìàöèîííàÿ ñòðóêòóðà ôàéëà *)
subfunc, pos, hpos, bytes, buffer: INTEGER; subfunc, pos, hpos, bytes, buffer: INTEGER;
name: FNAME name: FNAME
END END
FD = POINTER TO rFD FD = POINTER TO rFD
rFD = RECORD (* ñòðóêòóðà áëîêà äàííûõ âõîäà êàòàëîãà *) rFD = RECORD (* ñòðóêòóðà áëîêà äàííûõ âõîäà êàòàëîãà *)
attr: INTEGER; attr: INTEGER;
ntyp: CHAR; ntyp: CHAR;
reserved: ARRAY 3 OF CHAR; reserved: ARRAY 3 OF CHAR;
time_create, date_create, time_create, date_create,
time_access, date_access, time_access, date_access,
time_modif, date_modif, time_modif, date_modif,
size, hsize: INTEGER; size, hsize: INTEGER;
name: FNAME name: FNAME
END END
CONST CONST
SEEK_BEG = 0 SEEK_BEG = 0
SEEK_CUR = 1 SEEK_CUR = 1
SEEK_END = 2 SEEK_END = 2
PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
Çàãðóæàåò â ïàìÿòü ôàéë ñ èìåíåì FName, çàïèñûâàåò â ïàðàìåòð Çàãðóæàåò â ïàìÿòü ôàéë ñ èìåíåì FName, çàïèñûâàåò â ïàðàìåòð
size ðàçìåð ôàéëà, âîçâðàùàåò àäðåñ çàãðóæåííîãî ôàéëà size ðàçìåð ôàéëà, âîçâðàùàåò àäðåñ çàãðóæåííîãî ôàéëà
èëè 0 (îøèáêà). Ïðè íåîáõîäèìîñòè, ðàñïàêîâûâàåò èëè 0 (îøèáêà). Ïðè íåîáõîäèìîñòè, ðàñïàêîâûâàåò
ôàéë (kunpack). ôàéë (kunpack).
PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
Çàïèñûâàåò ñòðóêòóðó áëîêà äàííûõ âõîäà êàòàëîãà äëÿ ôàéëà Çàïèñûâàåò ñòðóêòóðó áëîêà äàííûõ âõîäà êàòàëîãà äëÿ ôàéëà
èëè ïàïêè ñ èìåíåì FName â ïàðàìåòð Info. èëè ïàïêè ñ èìåíåì FName â ïàðàìåòð Info.
Ïðè îøèáêå âîçâðàùàåò FALSE. Ïðè îøèáêå âîçâðàùàåò FALSE.
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
âîçâðàùàåò TRUE, åñëè ôàéë ñ èìåíåì FName ñóùåñòâóåò âîçâðàùàåò TRUE, åñëè ôàéë ñ èìåíåì FName ñóùåñòâóåò
PROCEDURE Close(VAR F: FS) PROCEDURE Close(VAR F: FS)
îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ èíôîðìàöèîííîé ñòðóêòóðû îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ èíôîðìàöèîííîé ñòðóêòóðû
ôàéëà F è ïðèñâàèâàåò F çíà÷åíèå NIL ôàéëà F è ïðèñâàèâàåò F çíà÷åíèå NIL
PROCEDURE Open(FName: ARRAY OF CHAR): FS PROCEDURE Open(FName: ARRAY OF CHAR): FS
âîçâðàùàåò óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà ñ âîçâðàùàåò óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà ñ
èìåíåì FName, ïðè îøèáêå âîçâðàùàåò NIL èìåíåì FName, ïðè îøèáêå âîçâðàùàåò NIL
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
óäàëÿåò ôàéë ñ èìåíåì FName, ïðè îøèáêå âîçâðàùàåò FALSE óäàëÿåò ôàéë ñ èìåíåì FName, ïðè îøèáêå âîçâðàùàåò FALSE
PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER
óñòàíàâëèâàåò ïîçèöèþ ÷òåíèÿ-çàïèñè ôàéëà F íà Offset, óñòàíàâëèâàåò ïîçèöèþ ÷òåíèÿ-çàïèñè ôàéëà F íà Offset,
îòíîñèòåëüíî Origin = (SEEK_BEG - íà÷àëî ôàéëà, îòíîñèòåëüíî Origin = (SEEK_BEG - íà÷àëî ôàéëà,
SEEK_CUR - òåêóùàÿ ïîçèöèÿ, SEEK_END - êîíåö ôàéëà), SEEK_CUR - òåêóùàÿ ïîçèöèÿ, SEEK_END - êîíåö ôàéëà),
âîçâðàùàåò ïîçèöèþ îòíîñèòåëüíî íà÷àëà ôàéëà, íàïðèìåð: âîçâðàùàåò ïîçèöèþ îòíîñèòåëüíî íà÷àëà ôàéëà, íàïðèìåð:
Seek(F, 0, SEEK_END) Seek(F, 0, SEEK_END)
óñòàíàâëèâàåò ïîçèöèþ íà êîíåö ôàéëà è âîçâðàùàåò äëèíó óñòàíàâëèâàåò ïîçèöèþ íà êîíåö ôàéëà è âîçâðàùàåò äëèíó
ôàéëà; ïðè îøèáêå âîçâðàùàåò -1 ôàéëà; ïðè îøèáêå âîçâðàùàåò -1
PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER
×èòàåò äàííûå èç ôàéëà â ïàìÿòü. F - óêàçàòåëü íà ×èòàåò äàííûå èç ôàéëà â ïàìÿòü. F - óêàçàòåëü íà
èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè
ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ ïðî÷èòàòü ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ ïðî÷èòàòü
èç ôàéëà; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî ïðî÷èòàíî èç ôàéëà; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî ïðî÷èòàíî
è ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â è ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â
èíôîðìàöèîííîé ñòðóêòóðå F. èíôîðìàöèîííîé ñòðóêòóðå F.
PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER
Çàïèñûâàåò äàííûå èç ïàìÿòè â ôàéë. F - óêàçàòåëü íà Çàïèñûâàåò äàííûå èç ïàìÿòè â ôàéë. F - óêàçàòåëü íà
èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè
ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ çàïèñàòü ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ çàïèñàòü
â ôàéë; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî çàïèñàíî è â ôàéë; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî çàïèñàíî è
ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â
èíôîðìàöèîííîé ñòðóêòóðå F. èíôîðìàöèîííîé ñòðóêòóðå F.
PROCEDURE Create(FName: ARRAY OF CHAR): FS PROCEDURE Create(FName: ARRAY OF CHAR): FS
ñîçäàåò íîâûé ôàéë ñ èìåíåì FName (ïîëíîå èìÿ), âîçâðàùàåò ñîçäàåò íîâûé ôàéë ñ èìåíåì FName (ïîëíîå èìÿ), âîçâðàùàåò
óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà,
ïðè îøèáêå âîçâðàùàåò NIL ïðè îøèáêå âîçâðàùàåò NIL
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
ñîçäàåò ïàïêó ñ èìåíåì DirName, âñå ïðîìåæóòî÷íûå ïàïêè ñîçäàåò ïàïêó ñ èìåíåì DirName, âñå ïðîìåæóòî÷íûå ïàïêè
äîëæíû ñóùåñòâîâàòü, ïðè îøèáêå âîçâðàùàåò FALSE äîëæíû ñóùåñòâîâàòü, ïðè îøèáêå âîçâðàùàåò FALSE
PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN
óäàëÿåò ïóñòóþ ïàïêó ñ èìåíåì DirName, óäàëÿåò ïóñòóþ ïàïêó ñ èìåíåì DirName,
ïðè îøèáêå âîçâðàùàåò FALSE ïðè îøèáêå âîçâðàùàåò FALSE
PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN
âîçâðàùàåò TRUE, åñëè ïàïêà ñ èìåíåì DirName ñóùåñòâóåò âîçâðàùàåò TRUE, åñëè ïàïêà ñ èìåíåì DirName ñóùåñòâóåò
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Read - чтение основных типов данных из файла F MODULE Read - чтение основных типов данных из файла F
Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè ÷òåíèÿ è Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè ÷òåíèÿ è
ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â
èíôîðìàöèîííîé ñòðóêòóðå F èíôîðìàöèîííîé ñòðóêòóðå F
PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN 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 MODULE Write - запись основных типов данных в файл F
Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè çàïèñè è Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè çàïèñè è
ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â
èíôîðìàöèîííîé ñòðóêòóðå F èíôîðìàöèîííîé ñòðóêòóðå F
PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN 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 - дата, время MODULE DateTime - дата, время
CONST ERR = -7.0E5 CONST ERR = -7.0E5
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
çàïèñûâàåò â ïàðàìåòðû êîìïîíåíòû òåêóùåé ñèñòåìíîé äàòû è çàïèñûâàåò â ïàðàìåòðû êîìïîíåíòû òåêóùåé ñèñòåìíîé äàòû è
âðåìåíè âðåìåíè
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ
Year, Month, Day, Hour, Min, Sec; Year, Month, Day, Hour, Min, Sec;
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5 ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec: INTEGER): BOOLEAN Hour, Min, Sec: INTEGER): BOOLEAN
èçâëåêàåò êîìïîíåíòû èçâëåêàåò êîìïîíåíòû
Year, Month, Day, Hour, Min, Sec èç äàòû Date; Year, Month, Day, Hour, Min, Sec èç äàòû Date;
ïðè îøèáêå âîçâðàùàåò FALSE ïðè îøèáêå âîçâðàùàåò FALSE
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Args - параметры программы MODULE Args - параметры программы
VAR argc: INTEGER VAR argc: INTEGER
êîëè÷åñòâî ïàðàìåòðîâ ïðîãðàììû, âêëþ÷àÿ èìÿ êîëè÷åñòâî ïàðàìåòðîâ ïðîãðàììû, âêëþ÷àÿ èìÿ
èñïîëíÿåìîãî ôàéëà èñïîëíÿåìîãî ôàéëà
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
çàïèñûâàåò â ñòðîêó s n-é ïàðàìåòð ïðîãðàììû, çàïèñûâàåò â ñòðîêó s n-é ïàðàìåòð ïðîãðàììû,
íóìåðàöèÿ ïàðàìåòðîâ îò 0 äî argc - 1, íóìåðàöèÿ ïàðàìåòðîâ îò 0 äî argc - 1,
íóëåâîé ïàðàìåòð -- èìÿ èñïîëíÿåìîãî ôàéëà íóëåâîé ïàðàìåòð -- èìÿ èñïîëíÿåìîãî ôàéëà
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE KOSAPI MODULE KOSAPI
PROCEDURE sysfunc1(arg1: INTEGER): INTEGER PROCEDURE sysfunc1(arg1: INTEGER): INTEGER
PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER
... ...
PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER
Îáåðòêè äëÿ ôóíêöèé API ÿäðà KolibriOS. Îáåðòêè äëÿ ôóíêöèé API ÿäðà KolibriOS.
arg1 .. arg7 ñîîòâåòñòâóþò ðåãèñòðàì arg1 .. arg7 ñîîòâåòñòâóþò ðåãèñòðàì
eax, ebx, ecx, edx, esi, edi, ebp; eax, ebx, ecx, edx, esi, edi, ebp;
âîçâðàùàþò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. âîçâðàùàþò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà.
PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
Îáåðòêà äëÿ ôóíêöèé API ÿäðà KolibriOS. Îáåðòêà äëÿ ôóíêöèé API ÿäðà KolibriOS.
arg1 - ðåãèñòð eax, arg2 - ðåãèñòð ebx, arg1 - ðåãèñòð eax, arg2 - ðåãèñòð ebx,
res2 - çíà÷åíèå ðåãèñòðà ebx ïîñëå ñèñòåìíîãî âûçîâà; res2 - çíà÷åíèå ðåãèñòðà ebx ïîñëå ñèñòåìíîãî âûçîâà;
âîçâðàùàåò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. âîçâðàùàåò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà.
PROCEDURE malloc(size: INTEGER): INTEGER PROCEDURE malloc(size: INTEGER): INTEGER
Âûäåëÿåò áëîê ïàìÿòè. Âûäåëÿåò áëîê ïàìÿòè.
size - ðàçìåð áëîêà â áàéòàõ, size - ðàçìåð áëîêà â áàéòàõ,
âîçâðàùàåò àäðåñ âûäåëåííîãî áëîêà âîçâðàùàåò àäðåñ âûäåëåííîãî áëîêà
PROCEDURE free(ptr: INTEGER): INTEGER PROCEDURE free(ptr: INTEGER): INTEGER
Îñâîáîæäàåò ðàíåå âûäåëåííûé áëîê ïàìÿòè ñ àäðåñîì ptr, Îñâîáîæäàåò ðàíåå âûäåëåííûé áëîê ïàìÿòè ñ àäðåñîì ptr,
âîçâðàùàåò 0 âîçâðàùàåò 0
PROCEDURE realloc(ptr, size: INTEGER): INTEGER PROCEDURE realloc(ptr, size: INTEGER): INTEGER
Ïåðåðàñïðåäåëÿåò áëîê ïàìÿòè, Ïåðåðàñïðåäåëÿåò áëîê ïàìÿòè,
ptr - àäðåñ ðàíåå âûäåëåííîãî áëîêà, ptr - àäðåñ ðàíåå âûäåëåííîãî áëîêà,
size - íîâûé ðàçìåð, size - íîâûé ðàçìåð,
âîçâðàùàåò óêàçàòåëü íà ïåðåðàñïðåäåëåííûé áëîê, âîçâðàùàåò óêàçàòåëü íà ïåðåðàñïðåäåëåííûé áëîê,
0 ïðè îøèáêå 0 ïðè îøèáêå
PROCEDURE GetCommandLine(): INTEGER PROCEDURE GetCommandLine(): INTEGER
Âîçâðàùàåò àäðåñ ñòðîêè ïàðàìåòðîâ Âîçâðàùàåò àäðåñ ñòðîêè ïàðàìåòðîâ
PROCEDURE GetName(): INTEGER PROCEDURE GetName(): INTEGER
Âîçâðàùàåò àäðåñ ñòðîêè ñ èìåíåì ïðîãðàììû Âîçâðàùàåò àäðåñ ñòðîêè ñ èìåíåì ïðîãðàììû
PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
Çàãðóæàåò DLL ñ ïîëíûì èìåíåì name. Âîçâðàùàåò àäðåñ òàáëèöû Çàãðóæàåò DLL ñ ïîëíûì èìåíåì name. Âîçâðàùàåò àäðåñ òàáëèöû
ýêñïîðòà. Ïðè îøèáêå âîçâðàùàåò 0. ýêñïîðòà. Ïðè îøèáêå âîçâðàùàåò 0.
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
name - èìÿ ïðîöåäóðû name - èìÿ ïðîöåäóðû
lib - àäðåñ òàáëèöû ýêñïîðòà DLL lib - àäðåñ òàáëèöû ýêñïîðòà DLL
Âîçâðàùàåò àäðåñ ïðîöåäóðû. Ïðè îøèáêå âîçâðàùàåò 0. Âîçâðàùàåò àäðåñ ïðîöåäóðû. Ïðè îøèáêå âîçâðàùàåò 0.
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE ColorDlg - работа с диалогом "Color Dialog" MODULE ColorDlg - работа с диалогом "Color Dialog"
TYPE TYPE
Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *)
status: INTEGER (* ñîñòîÿíèå äèàëîãà: status: INTEGER (* ñîñòîÿíèå äèàëîãà:
0 - ïîëüçîâàòåëü íàæàë Cancel 0 - ïîëüçîâàòåëü íàæàë Cancel
1 - ïîëüçîâàòåëü íàæàë OK 1 - ïîëüçîâàòåëü íàæàë OK
2 - äèàëîã îòêðûò *) 2 - äèàëîã îòêðûò *)
color: INTEGER (* âûáðàííûé öâåò *) color: INTEGER (* âûáðàííûé öâåò *)
END END
PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
ñîçäàòü äèàëîã ñîçäàòü äèàëîã
draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà
(TYPE DRAW_WINDOW = PROCEDURE); (TYPE DRAW_WINDOW = PROCEDURE);
ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà
PROCEDURE Show(cd: Dialog) PROCEDURE Show(cd: Dialog)
ïîêàçàòü äèàëîã ïîêàçàòü äèàëîã
cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå
ïðîöåäóðîé Create ïðîöåäóðîé Create
PROCEDURE Destroy(VAR cd: Dialog) PROCEDURE Destroy(VAR cd: Dialog)
óíè÷òîæèòü äèàëîã óíè÷òîæèòü äèàëîã
cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE OpenDlg - работа с диалогом "Open Dialog" MODULE OpenDlg - работа с диалогом "Open Dialog"
TYPE TYPE
Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *)
status: INTEGER (* ñîñòîÿíèå äèàëîãà: status: INTEGER (* ñîñòîÿíèå äèàëîãà:
0 - ïîëüçîâàòåëü íàæàë Cancel 0 - ïîëüçîâàòåëü íàæàë Cancel
1 - ïîëüçîâàòåëü íàæàë OK 1 - ïîëüçîâàòåëü íàæàë OK
2 - äèàëîã îòêðûò *) 2 - äèàëîã îòêðûò *)
FileName: ARRAY 4096 OF CHAR (* èìÿ âûáðàííîãî ôàéëà *) FileName: ARRAY 4096 OF CHAR (* èìÿ âûáðàííîãî ôàéëà *)
FilePath: ARRAY 4096 OF CHAR (* ïîëíîå èìÿ âûáðàííîãî FilePath: ARRAY 4096 OF CHAR (* ïîëíîå èìÿ âûáðàííîãî
ôàéëà *) ôàéëà *)
END END
PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path,
filter: ARRAY OF CHAR): Dialog filter: ARRAY OF CHAR): Dialog
ñîçäàòü äèàëîã ñîçäàòü äèàëîã
draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà
(TYPE DRAW_WINDOW = PROCEDURE) (TYPE DRAW_WINDOW = PROCEDURE)
type - òèï äèàëîãà type - òèï äèàëîãà
0 - îòêðûòü 0 - îòêðûòü
1 - ñîõðàíèòü 1 - ñîõðàíèòü
2 - âûáðàòü ïàïêó 2 - âûáðàòü ïàïêó
def_path - ïóòü ïî óìîë÷àíèþ, ïàïêà def_path áóäåò îòêðûòà def_path - ïóòü ïî óìîë÷àíèþ, ïàïêà def_path áóäåò îòêðûòà
ïðè ïåðâîì çàïóñêå äèàëîãà ïðè ïåðâîì çàïóñêå äèàëîãà
filter - â ñòðîêå çàïèñàíî ïåðå÷èñëåíèå ðàñøèðåíèé ôàéëîâ, filter - â ñòðîêå çàïèñàíî ïåðå÷èñëåíèå ðàñøèðåíèé ôàéëîâ,
êîòîðûå áóäóò ïîêàçàíû â äèàëîãîâîì îêíå, ðàñøèðåíèÿ êîòîðûå áóäóò ïîêàçàíû â äèàëîãîâîì îêíå, ðàñøèðåíèÿ
ðàçäåëÿþòñÿ ñèìâîëîì "|", íàïðèìåð: "ASM|TXT|INI" ðàçäåëÿþòñÿ ñèìâîëîì "|", íàïðèìåð: "ASM|TXT|INI"
ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà
PROCEDURE Show(od: Dialog; Width, Height: INTEGER) PROCEDURE Show(od: Dialog; Width, Height: INTEGER)
ïîêàçàòü äèàëîã ïîêàçàòü äèàëîã
od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå
ïðîöåäóðîé Create ïðîöåäóðîé Create
Width è Height - øèðèíà è âûñîòà äèàëîãîâîãî îêíà Width è Height - øèðèíà è âûñîòà äèàëîãîâîãî îêíà
PROCEDURE Destroy(VAR od: Dialog) PROCEDURE Destroy(VAR od: Dialog)
óíè÷òîæèòü äèàëîã óíè÷òîæèòü äèàëîã
od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE kfonts - работа с kf-шрифтами MODULE kfonts - работа с kf-шрифтами
CONST CONST
bold = 1 bold = 1
italic = 2 italic = 2
underline = 4 underline = 4
strike_through = 8 strike_through = 8
smoothing = 16 smoothing = 16
bpp32 = 32 bpp32 = 32
TYPE TYPE
TFont = POINTER TO TFont_desc (* óêàçàòåëü íà øðèôò *) TFont = POINTER TO TFont_desc (* óêàçàòåëü íà øðèôò *)
PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont
çàãðóçèòü øðèôò èç ôàéëà çàãðóçèòü øðèôò èç ôàéëà
file_name èìÿ kf-ôàéëà file_name èìÿ kf-ôàéëà
ðåç-ò: óêàçàòåëü íà øðèôò/NIL (îøèáêà) ðåç-ò: óêàçàòåëü íà øðèôò/NIL (îøèáêà)
PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN
óñòàíîâèòü ðàçìåð øðèôòà óñòàíîâèòü ðàçìåð øðèôòà
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
font_size ðàçìåð øðèôòà font_size ðàçìåð øðèôòà
ðåç-ò: TRUE/FALSE (îøèáêà) ðåç-ò: TRUE/FALSE (îøèáêà)
PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
ïðîâåðèòü, åñòü ëè øðèôò, çàäàííîãî ðàçìåðà ïðîâåðèòü, åñòü ëè øðèôò, çàäàííîãî ðàçìåðà
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
font_size ðàçìåð øðèôòà font_size ðàçìåð øðèôòà
ðåç-ò: TRUE/FALSE (øðèôòà íåò) ðåç-ò: TRUE/FALSE (øðèôòà íåò)
PROCEDURE Destroy(VAR Font: TFont) PROCEDURE Destroy(VAR Font: TFont)
âûãðóçèòü øðèôò, îñâîáîäèòü äèíàìè÷åñêóþ ïàìÿòü âûãðóçèòü øðèôò, îñâîáîäèòü äèíàìè÷åñêóþ ïàìÿòü
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
Ïðèñâàèâàåò ïåðåìåííîé Font çíà÷åíèå NIL Ïðèñâàèâàåò ïåðåìåííîé Font çíà÷åíèå NIL
PROCEDURE TextHeight(Font: TFont): INTEGER PROCEDURE TextHeight(Font: TFont): INTEGER
ïîëó÷èòü âûñîòó ñòðîêè òåêñòà ïîëó÷èòü âûñîòó ñòðîêè òåêñòà
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
ðåç-ò: âûñîòà ñòðîêè òåêñòà â ïèêñåëÿõ ðåç-ò: âûñîòà ñòðîêè òåêñòà â ïèêñåëÿõ
PROCEDURE TextWidth(Font: TFont; PROCEDURE TextWidth(Font: TFont;
str, length, params: INTEGER): INTEGER str, length, params: INTEGER): INTEGER
ïîëó÷èòü øèðèíó ñòðîêè òåêñòà ïîëó÷èòü øèðèíó ñòðîêè òåêñòà
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251
length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà
çàâåðøàåòñÿ íóëåì çàâåðøàåòñÿ íóëåì
params ïàðàìåòðû-ôëàãè ñì. íèæå params ïàðàìåòðû-ôëàãè ñì. íèæå
ðåç-ò: øèðèíà ñòðîêè òåêñòà â ïèêñåëÿõ ðåç-ò: øèðèíà ñòðîêè òåêñòà â ïèêñåëÿõ
PROCEDURE TextOut(Font: TFont; PROCEDURE TextOut(Font: TFont;
canvas, x, y, str, length, color, params: INTEGER) canvas, x, y, str, length, color, params: INTEGER)
âûâåñòè òåêñò â áóôåð âûâåñòè òåêñò â áóôåð
äëÿ âûâîäà áóôåðà â îêíî, èñïîëüçîâàòü ô.65 èëè äëÿ âûâîäà áóôåðà â îêíî, èñïîëüçîâàòü ô.65 èëè
ô.7 (åñëè áóôåð 24-áèòíûé) ô.7 (åñëè áóôåð 24-áèòíûé)
Font óêàçàòåëü íà øðèôò Font óêàçàòåëü íà øðèôò
canvas àäðåñ ãðàôè÷åñêîãî áóôåðà canvas àäðåñ ãðàôè÷åñêîãî áóôåðà
ñòðóêòóðà áóôåðà: ñòðóêòóðà áóôåðà:
Xsize dd Xsize dd
Ysize dd Ysize dd
picture rb Xsize * Ysize * 4 (32 áèòà) picture rb Xsize * Ysize * 4 (32 áèòà)
èëè Xsize * Ysize * 3 (24 áèòà) èëè Xsize * Ysize * 3 (24 áèòà)
x, y êîîðäèíàòû òåêñòà îòíîñèòåëüíî ëåâîãî âåðõíåãî x, y êîîðäèíàòû òåêñòà îòíîñèòåëüíî ëåâîãî âåðõíåãî
óãëà áóôåðà óãëà áóôåðà
str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251
length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà
çàâåðøàåòñÿ íóëåì çàâåðøàåòñÿ íóëåì
color öâåò òåêñòà 0x00RRGGBB color öâåò òåêñòà 0x00RRGGBB
params ïàðàìåòðû-ôëàãè: params ïàðàìåòðû-ôëàãè:
1 æèðíûé 1 æèðíûé
2 êóðñèâ 2 êóðñèâ
4 ïîä÷åðêíóòûé 4 ïîä÷åðêíóòûé
8 ïåðå÷åðêíóòûé 8 ïåðå÷åðêíóòûé
16 ïðèìåíèòü ñãëàæèâàíèå 16 ïðèìåíèòü ñãëàæèâàíèå
32 âûâîä â 32-áèòíûé áóôåð 32 âûâîä â 32-áèòíûé áóôåð
âîçìîæíî èñïîëüçîâàíèå ôëàãîâ â ëþáûõ ñî÷åòàíèÿõ âîçìîæíî èñïîëüçîâàíèå ôëàãîâ â ëþáûõ ñî÷åòàíèÿõ
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE RasterWorks - обертка библиотеки Rasterworks.obj MODULE RasterWorks - обертка библиотеки Rasterworks.obj
------------------------------------------------------------------------------ ------------------------------------------------------------------------------

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

@ -1,94 +1,94 @@
============================================================================== ==============================================================================
<EFBFBD>¨¡«¨®â¥ª  (KolibriOS) <EFBFBD>¨¡«¨®â¥ª  (KolibriOS)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Out - ª®­á®«ì­ë© ¢ë¢®¤ MODULE Out - ª®­á®«ì­ë© ¢ë¢®¤
PROCEDURE Open PROCEDURE Open
ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢ë¢®¤ ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢ë¢®¤
PROCEDURE Int(x, width: INTEGER) PROCEDURE Int(x, width: INTEGER)
¢ë¢®¤ 楫®£® ç¨á«  x; ¢ë¢®¤ 楫®£® ç¨á«  x;
width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤  width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ 
PROCEDURE Real(x: REAL; width: INTEGER) PROCEDURE Real(x: REAL; width: INTEGER)
¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ ¯« ¢ î饬 ä®à¬ â¥; ¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ ¯« ¢ î饬 ä®à¬ â¥;
width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤  width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ 
PROCEDURE Char(x: CHAR) PROCEDURE Char(x: CHAR)
¢ë¢®¤ ᨬ¢®«  x ¢ë¢®¤ ᨬ¢®«  x
PROCEDURE FixReal(x: REAL; width, p: INTEGER) PROCEDURE FixReal(x: REAL; width, p: INTEGER)
¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ 䨪á¨à®¢ ­­®¬ ä®à¬ â¥; ¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ 䨪á¨à®¢ ­­®¬ ä®à¬ â¥;
width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ ; width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ ;
p - ª®«¨ç¥á⢮ §­ ª®¢ ¯®á«¥ ¤¥áïâ¨ç­®© â®çª¨ p - ª®«¨ç¥á⢮ §­ ª®¢ ¯®á«¥ ¤¥áïâ¨ç­®© â®çª¨
PROCEDURE Ln PROCEDURE Ln
¯¥à¥å®¤ ­  á«¥¤ãîéãî áâப㠯¥à¥å®¤ ­  á«¥¤ãîéãî áâபã
PROCEDURE String(s: ARRAY OF CHAR) PROCEDURE String(s: ARRAY OF CHAR)
¢ë¢®¤ áâப¨ s ¢ë¢®¤ áâப¨ s
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE In - ª®­á®«ì­ë© ¢¢®¤ MODULE In - ª®­á®«ì­ë© ¢¢®¤
VAR Done: BOOLEAN VAR Done: BOOLEAN
¯à¨­¨¬ ¥â §­ ç¥­¨¥ TRUE ¢ á«ãç ¥ ãᯥ譮£® ¢ë¯®«­¥­¨ï ¯à¨­¨¬ ¥â §­ ç¥­¨¥ TRUE ¢ á«ãç ¥ ãᯥ譮£® ¢ë¯®«­¥­¨ï
®¯¥à æ¨¨ ¢¢®¤ , ¨­ ç¥ FALSE ®¯¥à æ¨¨ ¢¢®¤ , ¨­ ç¥ FALSE
PROCEDURE Open PROCEDURE Open
ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢¢®¤, ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢¢®¤,
â ª¦¥ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Done §­ ç¥­¨¥ TRUE â ª¦¥ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Done §­ ç¥­¨¥ TRUE
PROCEDURE Int(VAR x: INTEGER) PROCEDURE Int(VAR x: INTEGER)
¢¢®¤ ç¨á«  ⨯  INTEGER ¢¢®¤ ç¨á«  ⨯  INTEGER
PROCEDURE Char(VAR x: CHAR) PROCEDURE Char(VAR x: CHAR)
¢¢®¤ ᨬ¢®«  ¢¢®¤ ᨬ¢®« 
PROCEDURE Real(VAR x: REAL) PROCEDURE Real(VAR x: REAL)
¢¢®¤ ç¨á«  ⨯  REAL ¢¢®¤ ç¨á«  ⨯  REAL
PROCEDURE String(VAR s: ARRAY OF CHAR) PROCEDURE String(VAR s: ARRAY OF CHAR)
¢¢®¤ áâப¨ ¢¢®¤ áâப¨
PROCEDURE Ln PROCEDURE Ln
®¦¨¤ ­¨¥ ­ ¦ â¨ï ENTER ®¦¨¤ ­¨¥ ­ ¦ â¨ï ENTER
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Console - ¤®¯®«­¨â¥«ì­ë¥ ¯à®æ¥¤ãàë ª®­á®«ì­®£® ¢ë¢®¤  MODULE Console - ¤®¯®«­¨â¥«ì­ë¥ ¯à®æ¥¤ãàë ª®­á®«ì­®£® ¢ë¢®¤ 
CONST CONST
‘«¥¤ãî騥 ª®­áâ ­âë ®¯à¥¤¥«ïîâ 梥⠪®­á®«ì­®£® ¢ë¢®¤  ‘«¥¤ãî騥 ª®­áâ ­âë ®¯à¥¤¥«ïîâ 梥⠪®­á®«ì­®£® ¢ë¢®¤ 
Black = 0 Blue = 1 Green = 2 Black = 0 Blue = 1 Green = 2
Cyan = 3 Red = 4 Magenta = 5 Cyan = 3 Red = 4 Magenta = 5
Brown = 6 LightGray = 7 DarkGray = 8 Brown = 6 LightGray = 7 DarkGray = 8
LightBlue = 9 LightGreen = 10 LightCyan = 11 LightBlue = 9 LightGreen = 10 LightCyan = 11
LightRed = 12 LightMagenta = 13 Yellow = 14 LightRed = 12 LightMagenta = 13 Yellow = 14
White = 15 White = 15
PROCEDURE Cls PROCEDURE Cls
®ç¨á⪠ ®ª­  ª®­á®«¨ ®ç¨á⪠ ®ª­  ª®­á®«¨
PROCEDURE SetColor(FColor, BColor: INTEGER) PROCEDURE SetColor(FColor, BColor: INTEGER)
ãáâ ­®¢ª  æ¢¥â  ª®­á®«ì­®£® ¢ë¢®¤ : FColor - 梥â ⥪áâ , ãáâ ­®¢ª  æ¢¥â  ª®­á®«ì­®£® ¢ë¢®¤ : FColor - 梥â ⥪áâ ,
BColor - 梥â ä®­ , ¢®§¬®¦­ë¥ §­ ç¥­¨ï - ¢ë襯¥à¥ç¨á«¥­­ë¥ BColor - 梥â ä®­ , ¢®§¬®¦­ë¥ §­ ç¥­¨ï - ¢ë襯¥à¥ç¨á«¥­­ë¥
ª®­áâ ­âë ª®­áâ ­âë
PROCEDURE SetCursor(x, y: INTEGER) PROCEDURE SetCursor(x, y: INTEGER)
ãáâ ­®¢ª  ªãàá®à  ª®­á®«¨ ¢ ¯®§¨æ¨î (x, y) ãáâ ­®¢ª  ªãàá®à  ª®­á®«¨ ¢ ¯®§¨æ¨î (x, y)
PROCEDURE GetCursor(VAR x, y: INTEGER) PROCEDURE GetCursor(VAR x, y: INTEGER)
§ ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ⥪ã騥 ª®®à¤¨­ âë ªãàá®à  ª®­á®«¨ § ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ⥪ã騥 ª®®à¤¨­ âë ªãàá®à  ª®­á®«¨
PROCEDURE GetCursorX(): INTEGER PROCEDURE GetCursorX(): INTEGER
¢®§¢à é ¥â ⥪ãéãî x-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨ ¢®§¢à é ¥â ⥪ãéãî x-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨
PROCEDURE GetCursorY(): INTEGER PROCEDURE GetCursorY(): INTEGER
¢®§¢à é ¥â ⥪ãéãî y-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨ ¢®§¢à é ¥â ⥪ãéãî y-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE ConsoleLib - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ console.obj MODULE ConsoleLib - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ console.obj
@ -96,469 +96,469 @@ MODULE ConsoleLib -
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Math - ¬ â¥¬ â¨ç¥áª¨¥ ä㭪樨 MODULE Math - ¬ â¥¬ â¨ç¥áª¨¥ ä㭪樨
CONST CONST
pi = 3.141592653589793E+00 pi = 3.141592653589793E+00
e = 2.718281828459045E+00 e = 2.718281828459045E+00
PROCEDURE IsNan(x: REAL): BOOLEAN PROCEDURE IsNan(x: REAL): BOOLEAN
¢®§¢à é ¥â TRUE, ¥á«¨ x - ­¥ ç¨á«® ¢®§¢à é ¥â TRUE, ¥á«¨ x - ­¥ ç¨á«®
PROCEDURE IsInf(x: REAL): BOOLEAN PROCEDURE IsInf(x: REAL): BOOLEAN
¢®§¢à é ¥â TRUE, ¥á«¨ x - ¡¥áª®­¥ç­®áâì ¢®§¢à é ¥â TRUE, ¥á«¨ x - ¡¥áª®­¥ç­®áâì
PROCEDURE sqrt(x: REAL): REAL PROCEDURE sqrt(x: REAL): REAL
ª¢ ¤à â­ë© ª®à¥­ì x ª¢ ¤à â­ë© ª®à¥­ì x
PROCEDURE exp(x: REAL): REAL PROCEDURE exp(x: REAL): REAL
íªá¯®­¥­â  x íªá¯®­¥­â  x
PROCEDURE ln(x: REAL): REAL PROCEDURE ln(x: REAL): REAL
­ âãà «ì­ë© «®£ à¨ä¬ x ­ âãà «ì­ë© «®£ à¨ä¬ x
PROCEDURE sin(x: REAL): REAL PROCEDURE sin(x: REAL): REAL
ᨭãá x ᨭãá x
PROCEDURE cos(x: REAL): REAL PROCEDURE cos(x: REAL): REAL
ª®á¨­ãá x ª®á¨­ãá x
PROCEDURE tan(x: REAL): REAL PROCEDURE tan(x: REAL): REAL
â ­£¥­á x â ­£¥­á x
PROCEDURE arcsin(x: REAL): REAL PROCEDURE arcsin(x: REAL): REAL
 àªá¨­ãá x  àªá¨­ãá x
PROCEDURE arccos(x: REAL): REAL PROCEDURE arccos(x: REAL): REAL
 àªª®á¨­ãá x  àªª®á¨­ãá x
PROCEDURE arctan(x: REAL): REAL PROCEDURE arctan(x: REAL): REAL
 àªâ ­£¥­á x  àªâ ­£¥­á x
PROCEDURE arctan2(y, x: REAL): REAL PROCEDURE arctan2(y, x: REAL): REAL
 àªâ ­£¥­á y/x  àªâ ­£¥­á y/x
PROCEDURE power(base, exponent: REAL): REAL PROCEDURE power(base, exponent: REAL): REAL
¢®§¢¥¤¥­¨¥ ç¨á«  base ¢ á⥯¥­ì exponent ¢®§¢¥¤¥­¨¥ ç¨á«  base ¢ á⥯¥­ì exponent
PROCEDURE log(base, x: REAL): REAL PROCEDURE log(base, x: REAL): REAL
«®£ à¨ä¬ x ¯® ®á­®¢ ­¨î base «®£ à¨ä¬ x ¯® ®á­®¢ ­¨î base
PROCEDURE sinh(x: REAL): REAL PROCEDURE sinh(x: REAL): REAL
£¨¯¥à¡®«¨ç¥áª¨© ᨭãá x £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x
PROCEDURE cosh(x: REAL): REAL PROCEDURE cosh(x: REAL): REAL
£¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x
PROCEDURE tanh(x: REAL): REAL PROCEDURE tanh(x: REAL): REAL
£¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
PROCEDURE arsinh(x: REAL): REAL PROCEDURE arsinh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x
PROCEDURE arcosh(x: REAL): REAL PROCEDURE arcosh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x
PROCEDURE artanh(x: REAL): REAL PROCEDURE artanh(x: REAL): REAL
®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x
PROCEDURE round(x: REAL): REAL PROCEDURE round(x: REAL): REAL
®ªà㣫¥­¨¥ x ¤® ¡«¨¦ ©è¥£® 楫®£® ®ªà㣫¥­¨¥ x ¤® ¡«¨¦ ©è¥£® 楫®£®
PROCEDURE frac(x: REAL): REAL; PROCEDURE frac(x: REAL): REAL;
¤à®¡­ ï ç áâì ç¨á«  x ¤à®¡­ ï ç áâì ç¨á«  x
PROCEDURE floor(x: REAL): REAL PROCEDURE floor(x: REAL): REAL
­ ¨¡®«ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª REAL), ­ ¨¡®«ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª REAL),
­¥ ¡®«ìè¥ x: floor(1.2) = 1.0 ­¥ ¡®«ìè¥ x: floor(1.2) = 1.0
PROCEDURE ceil(x: REAL): REAL PROCEDURE ceil(x: REAL): REAL
­ ¨¬¥­ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª REAL), ­ ¨¬¥­ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª REAL),
­¥ ¬¥­ìè¥ x: ceil(1.2) = 2.0 ­¥ ¬¥­ìè¥ x: ceil(1.2) = 2.0
PROCEDURE sgn(x: REAL): INTEGER PROCEDURE sgn(x: REAL): INTEGER
¥á«¨ x > 0 ¢®§¢à é ¥â 1 ¥á«¨ x > 0 ¢®§¢à é ¥â 1
¥á«¨ x < 0 ¢®§¢à é ¥â -1 ¥á«¨ x < 0 ¢®§¢à é ¥â -1
¥á«¨ x = 0 ¢®§¢à é ¥â 0 ¥á«¨ x = 0 ¢®§¢à é ¥â 0
PROCEDURE fact(n: INTEGER): REAL PROCEDURE fact(n: INTEGER): REAL
ä ªâ®à¨ « n ä ªâ®à¨ « n
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Debug - ¢ë¢®¤ ­  ¤®áªã ®â« ¤ª¨ MODULE Debug - ¢ë¢®¤ ­  ¤®áªã ®â« ¤ª¨
ˆ­â¥àä¥©á ª ª ¬®¤ã«ì Out ˆ­â¥àä¥©á ª ª ¬®¤ã«ì Out
PROCEDURE Open PROCEDURE Open
®âªà뢠¥â ¤®áªã ®â« ¤ª¨ ®âªà뢠¥â ¤®áªã ®â« ¤ª¨
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE File - à ¡®â  á ä ©«®¢®© á¨á⥬®© MODULE File - à ¡®â  á ä ©«®¢®© á¨á⥬®©
TYPE TYPE
FNAME = ARRAY 520 OF CHAR FNAME = ARRAY 520 OF CHAR
FS = POINTER TO rFS FS = POINTER TO rFS
rFS = RECORD (* ¨­ä®à¬ æ¨®­­ ï áâàãªâãà  ä ©«  *) rFS = RECORD (* ¨­ä®à¬ æ¨®­­ ï áâàãªâãà  ä ©«  *)
subfunc, pos, hpos, bytes, buffer: INTEGER; subfunc, pos, hpos, bytes, buffer: INTEGER;
name: FNAME name: FNAME
END END
FD = POINTER TO rFD FD = POINTER TO rFD
rFD = RECORD (* áâàãªâãà  ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  *) rFD = RECORD (* áâàãªâãà  ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  *)
attr: INTEGER; attr: INTEGER;
ntyp: CHAR; ntyp: CHAR;
reserved: ARRAY 3 OF CHAR; reserved: ARRAY 3 OF CHAR;
time_create, date_create, time_create, date_create,
time_access, date_access, time_access, date_access,
time_modif, date_modif, time_modif, date_modif,
size, hsize: INTEGER; size, hsize: INTEGER;
name: FNAME name: FNAME
END END
CONST CONST
SEEK_BEG = 0 SEEK_BEG = 0
SEEK_CUR = 1 SEEK_CUR = 1
SEEK_END = 2 SEEK_END = 2
PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
‡ £à㦠¥â ¢ ¯ ¬ïâì ä ©« á ¨¬¥­¥¬ FName, § ¯¨á뢠¥â ¢ ¯ à ¬¥âà ‡ £à㦠¥â ¢ ¯ ¬ïâì ä ©« á ¨¬¥­¥¬ FName, § ¯¨á뢠¥â ¢ ¯ à ¬¥âà
size à §¬¥à ä ©« , ¢®§¢à é ¥â  ¤à¥á § £à㦥­­®£® ä ©«  size à §¬¥à ä ©« , ¢®§¢à é ¥â  ¤à¥á § £à㦥­­®£® ä ©« 
¨«¨ 0 (®è¨¡ª ). <20>ਠ­¥®¡å®¤¨¬®áâ¨, à á¯ ª®¢ë¢ ¥â ¨«¨ 0 (®è¨¡ª ). <20>ਠ­¥®¡å®¤¨¬®áâ¨, à á¯ ª®¢ë¢ ¥â
ä ©« (kunpack). ä ©« (kunpack).
PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
‡ ¯¨á뢠¥â áâàãªâãàã ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  ¤«ï ä ©«  ‡ ¯¨á뢠¥â áâàãªâãàã ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  ¤«ï ä ©« 
¨«¨ ¯ ¯ª¨ á ¨¬¥­¥¬ FName ¢ ¯ à ¬¥âà Info. ¨«¨ ¯ ¯ª¨ á ¨¬¥­¥¬ FName ¢ ¯ à ¬¥âà Info.
<EFBFBD>ਠ®è¨¡ª¥ ¢®§¢à é ¥â FALSE. <EFBFBD>ਠ®è¨¡ª¥ ¢®§¢à é ¥â FALSE.
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
¢®§¢à é ¥â TRUE, ¥á«¨ ä ©« á ¨¬¥­¥¬ FName áãé¥áâ¢ã¥â ¢®§¢à é ¥â TRUE, ¥á«¨ ä ©« á ¨¬¥­¥¬ FName áãé¥áâ¢ã¥â
PROCEDURE Close(VAR F: FS) PROCEDURE Close(VAR F: FS)
®á¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥­­ãî ¤«ï ¨­ä®à¬ æ¨®­­®© áâàãªâãàë ®á¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥­­ãî ¤«ï ¨­ä®à¬ æ¨®­­®© áâàãªâãàë
ä ©«  F ¨ ¯à¨á¢ ¨¢ ¥â F §­ ç¥­¨¥ NIL ä ©«  F ¨ ¯à¨á¢ ¨¢ ¥â F §­ ç¥­¨¥ NIL
PROCEDURE Open(FName: ARRAY OF CHAR): FS PROCEDURE Open(FName: ARRAY OF CHAR): FS
¢®§¢à é ¥â 㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©«  á ¢®§¢à é ¥â 㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©«  á
¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL ¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
㤠«ï¥â ä ©« á ¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE 㤠«ï¥â ä ©« á ¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER
ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ç⥭¨ï-§ ¯¨á¨ ä ©«  F ­  Offset, ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ç⥭¨ï-§ ¯¨á¨ ä ©«  F ­  Offset,
®â­®á¨â¥«ì­® Origin = (SEEK_BEG - ­ ç «® ä ©« , ®â­®á¨â¥«ì­® Origin = (SEEK_BEG - ­ ç «® ä ©« ,
SEEK_CUR - ⥪ãé ï ¯®§¨æ¨ï, SEEK_END - ª®­¥æ ä ©« ), SEEK_CUR - ⥪ãé ï ¯®§¨æ¨ï, SEEK_END - ª®­¥æ ä ©« ),
¢®§¢à é ¥â ¯®§¨æ¨î ®â­®á¨â¥«ì­® ­ ç «  ä ©« , ­ ¯à¨¬¥à: ¢®§¢à é ¥â ¯®§¨æ¨î ®â­®á¨â¥«ì­® ­ ç «  ä ©« , ­ ¯à¨¬¥à:
Seek(F, 0, SEEK_END) Seek(F, 0, SEEK_END)
ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ­  ª®­¥æ ä ©«  ¨ ¢®§¢à é ¥â ¤«¨­ã ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ­  ª®­¥æ ä ©«  ¨ ¢®§¢à é ¥â ¤«¨­ã
ä ©« ; ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â -1 ä ©« ; ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â -1
PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER
—¨â ¥â ¤ ­­ë¥ ¨§ ä ©«  ¢ ¯ ¬ïâì. F - 㪠§ â¥«ì ­  —¨â ¥â ¤ ­­ë¥ ¨§ ä ©«  ¢ ¯ ¬ïâì. F - 㪠§ â¥«ì ­ 
¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« á⨠¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« áâ¨
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï ¯à®ç¨â âì ¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï ¯à®ç¨â âì
¨§ ä ©« ; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® ¯à®ç¨â ­® ¨§ ä ©« ; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® ¯à®ç¨â ­®
¨ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ ¨ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢
¨­ä®à¬ æ¨®­­®© áâàãªâãॠF. ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF.
PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER
‡ ¯¨á뢠¥â ¤ ­­ë¥ ¨§ ¯ ¬ï⨠¢ ä ©«. F - 㪠§ â¥«ì ­  ‡ ¯¨á뢠¥â ¤ ­­ë¥ ¨§ ¯ ¬ï⨠¢ ä ©«. F - 㪠§ â¥«ì ­ 
¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« á⨠¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« áâ¨
¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï § ¯¨á âì ¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï § ¯¨á âì
¢ ä ©«; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® § ¯¨á ­® ¨ ¢ ä ©«; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® § ¯¨á ­® ¨
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢
¨­ä®à¬ æ¨®­­®© áâàãªâãॠF. ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF.
PROCEDURE Create(FName: ARRAY OF CHAR): FS PROCEDURE Create(FName: ARRAY OF CHAR): FS
ᮧ¤ ¥â ­®¢ë© ä ©« á ¨¬¥­¥¬ FName (¯®«­®¥ ¨¬ï), ¢®§¢à é ¥â ᮧ¤ ¥â ­®¢ë© ä ©« á ¨¬¥­¥¬ FName (¯®«­®¥ ¨¬ï), ¢®§¢à é ¥â
㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , 㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« ,
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
ᮧ¤ ¥â ¯ ¯ªã á ¨¬¥­¥¬ DirName, ¢á¥ ¯à®¬¥¦ãâ®ç­ë¥ ¯ ¯ª¨ ᮧ¤ ¥â ¯ ¯ªã á ¨¬¥­¥¬ DirName, ¢á¥ ¯à®¬¥¦ãâ®ç­ë¥ ¯ ¯ª¨
¤®«¦­ë áãé¥á⢮¢ âì, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE ¤®«¦­ë áãé¥á⢮¢ âì, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN
㤠«ï¥â ¯ãáâãî ¯ ¯ªã á ¨¬¥­¥¬ DirName, 㤠«ï¥â ¯ãáâãî ¯ ¯ªã á ¨¬¥­¥¬ DirName,
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN
¢®§¢à é ¥â TRUE, ¥á«¨ ¯ ¯ª  á ¨¬¥­¥¬ DirName áãé¥áâ¢ã¥â ¢®§¢à é ¥â TRUE, ¥á«¨ ¯ ¯ª  á ¨¬¥­¥¬ DirName áãé¥áâ¢ã¥â
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Read - ç⥭¨¥ ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¨§ ä ©«  F MODULE Read - ç⥭¨¥ ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¨§ ä ©«  F
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ ç⥭¨ï ¨ <EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ ç⥭¨ï ¨
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢
¨­ä®à¬ æ¨®­­®© áâàãªâãॠF ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF
PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN 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 MODULE Write - § ¯¨áì ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¢ ä ©« F
<EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ § ¯¨á¨ ¨ <EFBFBD>à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ § ¯¨á¨ ¨
ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢
¨­ä®à¬ æ¨®­­®© áâàãªâãॠF ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF
PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN 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 - ¤ â , ¢à¥¬ï MODULE DateTime - ¤ â , ¢à¥¬ï
CONST ERR = -7.0E5 CONST ERR = -7.0E5
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
§ ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ª®¬¯®­¥­âë ⥪ã饩 á¨á⥬­®© ¤ âë ¨ § ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ª®¬¯®­¥­âë ⥪ã饩 á¨á⥬­®© ¤ âë ¨
¢à¥¬¥­¨ ¢à¥¬¥­¨
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
¢®§¢à é ¥â ¤ âã, ¯®«ã祭­ãî ¨§ ª®¬¯®­¥­â®¢ ¢®§¢à é ¥â ¤ âã, ¯®«ã祭­ãî ¨§ ª®¬¯®­¥­â®¢
Year, Month, Day, Hour, Min, Sec; Year, Month, Day, Hour, Min, Sec;
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0E5 ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0E5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec: INTEGER): BOOLEAN Hour, Min, Sec: INTEGER): BOOLEAN
¨§¢«¥ª ¥â ª®¬¯®­¥­âë ¨§¢«¥ª ¥â ª®¬¯®­¥­âë
Year, Month, Day, Hour, Min, Sec ¨§ ¤ âë Date; Year, Month, Day, Hour, Min, Sec ¨§ ¤ âë Date;
¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Args - ¯ à ¬¥âàë ¯à®£à ¬¬ë MODULE Args - ¯ à ¬¥âàë ¯à®£à ¬¬ë
VAR argc: INTEGER VAR argc: INTEGER
ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ¯à®£à ¬¬ë, ¢ª«îç ï ¨¬ï ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ¯à®£à ¬¬ë, ¢ª«îç ï ¨¬ï
¨á¯®«­ï¥¬®£® ä ©«  ¨á¯®«­ï¥¬®£® ä ©« 
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
§ ¯¨á뢠¥â ¢ áâபã s n-© ¯ à ¬¥âà ¯à®£à ¬¬ë, § ¯¨á뢠¥â ¢ áâபã s n-© ¯ à ¬¥âà ¯à®£à ¬¬ë,
­ã¬¥à æ¨ï ¯ à ¬¥â஢ ®â 0 ¤® argc - 1, ­ã¬¥à æ¨ï ¯ à ¬¥â஢ ®â 0 ¤® argc - 1,
­ã«¥¢®© ¯ à ¬¥âà -- ¨¬ï ¨á¯®«­ï¥¬®£® ä ©«  ­ã«¥¢®© ¯ à ¬¥âà -- ¨¬ï ¨á¯®«­ï¥¬®£® ä ©« 
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE KOSAPI MODULE KOSAPI
PROCEDURE sysfunc1(arg1: INTEGER): INTEGER PROCEDURE sysfunc1(arg1: INTEGER): INTEGER
PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER
... ...
PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER
Ž¡¥à⪨ ¤«ï ä㭪権 API ï¤à  KolibriOS. Ž¡¥à⪨ ¤«ï ä㭪権 API ï¤à  KolibriOS.
arg1 .. arg7 ᮮ⢥âáâ¢ãîâ ॣ¨áâà ¬ arg1 .. arg7 ᮮ⢥âáâ¢ãîâ ॣ¨áâà ¬
eax, ebx, ecx, edx, esi, edi, ebp; eax, ebx, ecx, edx, esi, edi, ebp;
¢®§¢à é îâ §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ . ¢®§¢à é îâ §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ .
PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
Ž¡¥à⪠ ¤«ï ä㭪権 API ï¤à  KolibriOS. Ž¡¥à⪠ ¤«ï ä㭪権 API ï¤à  KolibriOS.
arg1 - ॣ¨áâà eax, arg2 - ॣ¨áâà ebx, arg1 - ॣ¨áâà eax, arg2 - ॣ¨áâà ebx,
res2 - §­ ç¥­¨¥ ॣ¨áâà  ebx ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ ; res2 - §­ ç¥­¨¥ ॣ¨áâà  ebx ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ ;
¢®§¢à é ¥â §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ . ¢®§¢à é ¥â §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ .
PROCEDURE malloc(size: INTEGER): INTEGER PROCEDURE malloc(size: INTEGER): INTEGER
‚뤥«ï¥â ¡«®ª ¯ ¬ïâ¨. ‚뤥«ï¥â ¡«®ª ¯ ¬ïâ¨.
size - à §¬¥à ¡«®ª  ¢ ¡ ©â å, size - à §¬¥à ¡«®ª  ¢ ¡ ©â å,
¢®§¢à é ¥â  ¤à¥á ¢ë¤¥«¥­­®£® ¡«®ª  ¢®§¢à é ¥â  ¤à¥á ¢ë¤¥«¥­­®£® ¡«®ª 
PROCEDURE free(ptr: INTEGER): INTEGER PROCEDURE free(ptr: INTEGER): INTEGER
Žá¢®¡®¦¤ ¥â à ­¥¥ ¢ë¤¥«¥­­ë© ¡«®ª ¯ ¬ïâ¨ á  ¤à¥á®¬ ptr, Žá¢®¡®¦¤ ¥â à ­¥¥ ¢ë¤¥«¥­­ë© ¡«®ª ¯ ¬ïâ¨ á  ¤à¥á®¬ ptr,
¢®§¢à é ¥â 0 ¢®§¢à é ¥â 0
PROCEDURE realloc(ptr, size: INTEGER): INTEGER PROCEDURE realloc(ptr, size: INTEGER): INTEGER
<EFBFBD>¥à¥à á¯à¥¤¥«ï¥â ¡«®ª ¯ ¬ïâ¨, <EFBFBD>¥à¥à á¯à¥¤¥«ï¥â ¡«®ª ¯ ¬ïâ¨,
ptr -  ¤à¥á à ­¥¥ ¢ë¤¥«¥­­®£® ¡«®ª , ptr -  ¤à¥á à ­¥¥ ¢ë¤¥«¥­­®£® ¡«®ª ,
size - ­®¢ë© à §¬¥à, size - ­®¢ë© à §¬¥à,
¢®§¢à é ¥â 㪠§ â¥«ì ­  ¯¥à¥à á¯à¥¤¥«¥­­ë© ¡«®ª, ¢®§¢à é ¥â 㪠§ â¥«ì ­  ¯¥à¥à á¯à¥¤¥«¥­­ë© ¡«®ª,
0 ¯à¨ ®è¨¡ª¥ 0 ¯à¨ ®è¨¡ª¥
PROCEDURE GetCommandLine(): INTEGER PROCEDURE GetCommandLine(): INTEGER
‚®§¢à é ¥â  ¤à¥á áâப¨ ¯ à ¬¥â஢ ‚®§¢à é ¥â  ¤à¥á áâப¨ ¯ à ¬¥â஢
PROCEDURE GetName(): INTEGER PROCEDURE GetName(): INTEGER
‚®§¢à é ¥â  ¤à¥á áâப¨ á ¨¬¥­¥¬ ¯à®£à ¬¬ë ‚®§¢à é ¥â  ¤à¥á áâப¨ á ¨¬¥­¥¬ ¯à®£à ¬¬ë
PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
‡ £à㦠¥â DLL á ¯®«­ë¬ ¨¬¥­¥¬ name. ‚®§¢à é ¥â  ¤à¥á â ¡«¨æë ‡ £à㦠¥â DLL á ¯®«­ë¬ ¨¬¥­¥¬ name. ‚®§¢à é ¥â  ¤à¥á â ¡«¨æë
íªá¯®àâ . <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0. íªá¯®àâ . <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
name - ¨¬ï ¯à®æ¥¤ãàë name - ¨¬ï ¯à®æ¥¤ãàë
lib -  ¤à¥á â ¡«¨æë íªá¯®àâ  DLL lib -  ¤à¥á â ¡«¨æë íªá¯®àâ  DLL
‚®§¢à é ¥â  ¤à¥á ¯à®æ¥¤ãàë. <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0. ‚®§¢à é ¥â  ¤à¥á ¯à®æ¥¤ãàë. <20>ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0.
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE ColorDlg - à ¡®â  á ¤¨ «®£®¬ "Color Dialog" MODULE ColorDlg - à ¡®â  á ¤¨ «®£®¬ "Color Dialog"
TYPE TYPE
Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *) Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *)
status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ : status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ :
0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel 0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel
1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK 1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK
2 - ¤¨ «®£ ®âªàëâ *) 2 - ¤¨ «®£ ®âªàëâ *)
color: INTEGER (* ¢ë¡à ­­ë© 梥â *) color: INTEGER (* ¢ë¡à ­­ë© 梥â *)
END END
PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
ᮧ¤ âì ¤¨ «®£ ᮧ¤ âì ¤¨ «®£
draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­  draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­ 
(TYPE DRAW_WINDOW = PROCEDURE); (TYPE DRAW_WINDOW = PROCEDURE);
¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  ¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ 
PROCEDURE Show(cd: Dialog) PROCEDURE Show(cd: Dialog)
¯®ª § âì ¤¨ «®£ ¯®ª § âì ¤¨ «®£
cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥ cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥
¯à®æ¥¤ãன Create ¯à®æ¥¤ãன Create
PROCEDURE Destroy(VAR cd: Dialog) PROCEDURE Destroy(VAR cd: Dialog)
ã­¨ç⮦¨âì ¤¨ «®£ ã­¨ç⮦¨âì ¤¨ «®£
cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ 
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE OpenDlg - à ¡®â  á ¤¨ «®£®¬ "Open Dialog" MODULE OpenDlg - à ¡®â  á ¤¨ «®£®¬ "Open Dialog"
TYPE TYPE
Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *) Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *)
status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ : status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ :
0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel 0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel
1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK 1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK
2 - ¤¨ «®£ ®âªàëâ *) 2 - ¤¨ «®£ ®âªàëâ *)
FileName: ARRAY 4096 OF CHAR (* ¨¬ï ¢ë¡à ­­®£® ä ©«  *) FileName: ARRAY 4096 OF CHAR (* ¨¬ï ¢ë¡à ­­®£® ä ©«  *)
FilePath: ARRAY 4096 OF CHAR (* ¯®«­®¥ ¨¬ï ¢ë¡à ­­®£® FilePath: ARRAY 4096 OF CHAR (* ¯®«­®¥ ¨¬ï ¢ë¡à ­­®£®
ä ©«  *) ä ©«  *)
END END
PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path,
filter: ARRAY OF CHAR): Dialog filter: ARRAY OF CHAR): Dialog
ᮧ¤ âì ¤¨ «®£ ᮧ¤ âì ¤¨ «®£
draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­  draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­ 
(TYPE DRAW_WINDOW = PROCEDURE) (TYPE DRAW_WINDOW = PROCEDURE)
type - ⨯ ¤¨ «®£  type - ⨯ ¤¨ «®£ 
0 - ®âªàëâì 0 - ®âªàëâì
1 - á®åà ­¨âì 1 - á®åà ­¨âì
2 - ¢ë¡à âì ¯ ¯ªã 2 - ¢ë¡à âì ¯ ¯ªã
def_path - ¯ãâì ¯® 㬮«ç ­¨î, ¯ ¯ª  def_path ¡ã¤¥â ®âªàëâ  def_path - ¯ãâì ¯® 㬮«ç ­¨î, ¯ ¯ª  def_path ¡ã¤¥â ®âªàëâ 
¯à¨ ¯¥à¢®¬ § ¯ã᪥ ¤¨ «®£  ¯à¨ ¯¥à¢®¬ § ¯ã᪥ ¤¨ «®£ 
filter - ¢ áâப¥ § ¯¨á ­® ¯¥à¥ç¨á«¥­¨¥ à áè¨à¥­¨© ä ©«®¢, filter - ¢ áâப¥ § ¯¨á ­® ¯¥à¥ç¨á«¥­¨¥ à áè¨à¥­¨© ä ©«®¢,
ª®â®àë¥ ¡ã¤ãâ ¯®ª § ­ë ¢ ¤¨ «®£®¢®¬ ®ª­¥, à áè¨à¥­¨ï ª®â®àë¥ ¡ã¤ãâ ¯®ª § ­ë ¢ ¤¨ «®£®¢®¬ ®ª­¥, à áè¨à¥­¨ï
à §¤¥«ïîâáï ᨬ¢®«®¬ "|", ­ ¯à¨¬¥à: "ASM|TXT|INI" à §¤¥«ïîâáï ᨬ¢®«®¬ "|", ­ ¯à¨¬¥à: "ASM|TXT|INI"
¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  ¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ 
PROCEDURE Show(od: Dialog; Width, Height: INTEGER) PROCEDURE Show(od: Dialog; Width, Height: INTEGER)
¯®ª § âì ¤¨ «®£ ¯®ª § âì ¤¨ «®£
od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥ od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥
¯à®æ¥¤ãன Create ¯à®æ¥¤ãன Create
Width ¨ Height - è¨à¨­  ¨ ¢ëá®â  ¤¨ «®£®¢®£® ®ª­  Width ¨ Height - è¨à¨­  ¨ ¢ëá®â  ¤¨ «®£®¢®£® ®ª­ 
PROCEDURE Destroy(VAR od: Dialog) PROCEDURE Destroy(VAR od: Dialog)
ã­¨ç⮦¨âì ¤¨ «®£ ã­¨ç⮦¨âì ¤¨ «®£
od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ 
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE kfonts - à ¡®â  á kf-èà¨äâ ¬¨ MODULE kfonts - à ¡®â  á kf-èà¨äâ ¬¨
CONST CONST
bold = 1 bold = 1
italic = 2 italic = 2
underline = 4 underline = 4
strike_through = 8 strike_through = 8
smoothing = 16 smoothing = 16
bpp32 = 32 bpp32 = 32
TYPE TYPE
TFont = POINTER TO TFont_desc (* 㪠§ â¥«ì ­  èà¨äâ *) TFont = POINTER TO TFont_desc (* 㪠§ â¥«ì ­  èà¨äâ *)
PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont
§ £à㧨âì èà¨äâ ¨§ ä ©«  § £à㧨âì èà¨äâ ¨§ ä ©« 
file_name ¨¬ï kf-ä ©«  file_name ¨¬ï kf-ä ©« 
१-â: 㪠§ â¥«ì ­  èà¨äâ/NIL (®è¨¡ª ) १-â: 㪠§ â¥«ì ­  èà¨äâ/NIL (®è¨¡ª )
PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN
ãáâ ­®¢¨âì à §¬¥à èà¨äâ  ãáâ ­®¢¨âì à §¬¥à èà¨äâ 
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
font_size à §¬¥à èà¨äâ  font_size à §¬¥à èà¨äâ 
१-â: TRUE/FALSE (®è¨¡ª ) १-â: TRUE/FALSE (®è¨¡ª )
PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
¯à®¢¥à¨âì, ¥áâì «¨ èà¨äâ, § ¤ ­­®£® à §¬¥à  ¯à®¢¥à¨âì, ¥áâì «¨ èà¨äâ, § ¤ ­­®£® à §¬¥à 
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
font_size à §¬¥à èà¨äâ  font_size à §¬¥à èà¨äâ 
१-â: TRUE/FALSE (èà¨äâ  ­¥â) १-â: TRUE/FALSE (èà¨äâ  ­¥â)
PROCEDURE Destroy(VAR Font: TFont) PROCEDURE Destroy(VAR Font: TFont)
¢ë£à㧨âì èà¨äâ, ®á¢®¡®¤¨âì ¤¨­ ¬¨ç¥áªãî ¯ ¬ïâì ¢ë£à㧨âì èà¨äâ, ®á¢®¡®¤¨âì ¤¨­ ¬¨ç¥áªãî ¯ ¬ïâì
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
<EFBFBD>à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Font §­ ç¥­¨¥ NIL <EFBFBD>à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Font §­ ç¥­¨¥ NIL
PROCEDURE TextHeight(Font: TFont): INTEGER PROCEDURE TextHeight(Font: TFont): INTEGER
¯®«ãç¨âì ¢ëá®âã áâப¨ ⥪áâ  ¯®«ãç¨âì ¢ëá®âã áâப¨ ⥪áâ 
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
१-â: ¢ëá®â  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå १-â: ¢ëá®â  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå
PROCEDURE TextWidth(Font: TFont; PROCEDURE TextWidth(Font: TFont;
str, length, params: INTEGER): INTEGER str, length, params: INTEGER): INTEGER
¯®«ãç¨âì è¨à¨­ã áâப¨ ⥪áâ  ¯®«ãç¨âì è¨à¨­ã áâப¨ ⥪áâ 
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251 str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப  length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப 
§ ¢¥àè ¥âáï ­ã«¥¬ § ¢¥àè ¥âáï ­ã«¥¬
params ¯ à ¬¥âàë-ä« £¨ á¬. ­¨¦¥ params ¯ à ¬¥âàë-ä« £¨ á¬. ­¨¦¥
१-â: è¨à¨­  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå १-â: è¨à¨­  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå
PROCEDURE TextOut(Font: TFont; PROCEDURE TextOut(Font: TFont;
canvas, x, y, str, length, color, params: INTEGER) canvas, x, y, str, length, color, params: INTEGER)
¢ë¢¥á⨠⥪áâ ¢ ¡ãä¥à ¢ë¢¥á⨠⥪áâ ¢ ¡ãä¥à
¤«ï ¢ë¢®¤  ¡ãä¥à  ¢ ®ª­®, ¨á¯®«ì§®¢ âì ä.65 ¨«¨ ¤«ï ¢ë¢®¤  ¡ãä¥à  ¢ ®ª­®, ¨á¯®«ì§®¢ âì ä.65 ¨«¨
ä.7 (¥á«¨ ¡ãä¥à 24-¡¨â­ë©) ä.7 (¥á«¨ ¡ãä¥à 24-¡¨â­ë©)
Font 㪠§ â¥«ì ­  èà¨äâ Font 㪠§ â¥«ì ­  èà¨äâ
canvas  ¤à¥á £à ä¨ç¥áª®£® ¡ãä¥à  canvas  ¤à¥á £à ä¨ç¥áª®£® ¡ãä¥à 
áâàãªâãà  ¡ãä¥à : áâàãªâãà  ¡ãä¥à :
Xsize dd Xsize dd
Ysize dd Ysize dd
picture rb Xsize * Ysize * 4 (32 ¡¨â ) picture rb Xsize * Ysize * 4 (32 ¡¨â )
¨«¨ Xsize * Ysize * 3 (24 ¡¨â ) ¨«¨ Xsize * Ysize * 3 (24 ¡¨â )
x, y ª®®à¤¨­ âë ⥪áâ  ®â­®á¨â¥«ì­® «¥¢®£® ¢¥àå­¥£® x, y ª®®à¤¨­ âë ⥪áâ  ®â­®á¨â¥«ì­® «¥¢®£® ¢¥àå­¥£®
㣫  ¡ãä¥à  㣫  ¡ãä¥à 
str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251 str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251
length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப  length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப 
§ ¢¥àè ¥âáï ­ã«¥¬ § ¢¥àè ¥âáï ­ã«¥¬
color 梥â ⥪áâ  0x00RRGGBB color 梥â ⥪áâ  0x00RRGGBB
params ¯ à ¬¥âàë-ä« £¨: params ¯ à ¬¥âàë-ä« £¨:
1 ¦¨à­ë© 1 ¦¨à­ë©
2 ªãàᨢ 2 ªãàᨢ
4 ¯®¤ç¥àª­ãâë© 4 ¯®¤ç¥àª­ãâë©
8 ¯¥à¥ç¥àª­ãâë© 8 ¯¥à¥ç¥àª­ãâë©
16 ¯à¨¬¥­¨âì ᣫ ¦¨¢ ­¨¥ 16 ¯à¨¬¥­¨âì ᣫ ¦¨¢ ­¨¥
32 ¢ë¢®¤ ¢ 32-¡¨â­ë© ¡ãä¥à 32 ¢ë¢®¤ ¢ 32-¡¨â­ë© ¡ãä¥à
¢®§¬®¦­® ¨á¯®«ì§®¢ ­¨¥ ä« £®¢ ¢ «î¡ëå á®ç¥â ­¨ïå ¢®§¬®¦­® ¨á¯®«ì§®¢ ­¨¥ ä« £®¢ ¢ «î¡ëå á®ç¥â ­¨ïå
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE RasterWorks - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ Rasterworks.obj MODULE RasterWorks - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ Rasterworks.obj
------------------------------------------------------------------------------ ------------------------------------------------------------------------------

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

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

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -97,4 +97,4 @@ END GetArg;
BEGIN BEGIN
ParamParse ParamParse
END Args. END Args.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -102,4 +102,4 @@ END Load;
BEGIN BEGIN
Load Load
END ColorDlg. END ColorDlg.

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

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

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -100,4 +100,4 @@ END main;
BEGIN BEGIN
main main
END ConsoleLib. END ConsoleLib.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -138,4 +138,4 @@ BEGIN
Msec := 0 Msec := 0
END Now; END Now;
END DateTime. END DateTime.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -289,4 +289,4 @@ BEGIN
res := KOSAPI.sysfunc2(70, sys.ADR(info)) res := KOSAPI.sysfunc2(70, sys.ADR(info))
END Open; END Open;
END Debug. END Debug.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -313,4 +313,4 @@ BEGIN
END DeleteDir; END DeleteDir;
END File. END File.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -205,7 +205,7 @@ BEGIN
END Create; 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 VAR
n: INTEGER; n: INTEGER;
fs: FS; fs: FS;
@ -468,4 +468,4 @@ BEGIN
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
END; END;
ParamParse ParamParse
END HOST. END HOST.

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -427,4 +427,4 @@ BEGIN
END _init; END _init;
END KOSAPI. END KOSAPI.

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

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

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

@ -1,4 +1,4 @@
(* (*
Copyright 2017 Anton Krotov Copyright 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -104,4 +104,4 @@ PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
END LinkStatus; END LinkStatus;
END NetDevices. END NetDevices.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -150,4 +150,4 @@ END Load;
BEGIN BEGIN
Load Load
END OpenDlg. END OpenDlg.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -264,4 +264,4 @@ END FixReal;
PROCEDURE Open*; PROCEDURE Open*;
END Open; END Open;
END Out. END Out.

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

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

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 KolibriOS team Copyright 2016, 2018 KolibriOS team
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -121,4 +121,4 @@ END main;
BEGIN BEGIN
main main
END RasterWorks. END RasterWorks.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify 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) RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
END Set; END Set;
PROCEDURE Card16*(F: File.FS; VAR x: sys.CARD16): BOOLEAN; PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN;
RETURN File.Read(F, sys.ADR(x), sys.SIZE(sys.CARD16)) = sys.SIZE(sys.CARD16) RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
END Card16; END WChar;
END Read. 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 BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE UNIXTIME; MODULE UnixTime;
VAR VAR
@ -61,4 +61,4 @@ END time;
BEGIN BEGIN
init init
END UNIXTIME. END UnixTime.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016 Anton Krotov Copyright 2016 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -118,4 +118,4 @@ BEGIN
END destroy; END destroy;
END Vector. END Vector.

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

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

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 Anton Krotov Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -489,4 +489,4 @@ BEGIN
RETURN Font RETURN Font
END LoadFont; END LoadFont;
END kfonts. END kfonts.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2018 KolibriOS team Copyright 2016, 2018 KolibriOS team
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -432,4 +432,4 @@ END main;
BEGIN BEGIN
main main
END libimg. END libimg.

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

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

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

@ -1,4 +1,4 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019, Anton Krotov Copyright (c) 2019, Anton Krotov
@ -68,22 +68,12 @@ BEGIN
END GetCurrentDirectory; END GetCurrentDirectory;
PROCEDURE ReadFile (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; 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;
VAR VAR
res: INTEGER; res: INTEGER;
BEGIN BEGIN
res := ReadFile(F, Buffer, bytes); res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN IF res <= 0 THEN
res := -1 res := -1
END END
@ -97,7 +87,7 @@ VAR
res: INTEGER; res: INTEGER;
BEGIN BEGIN
res := WriteFile(F, Buffer, bytes); res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN IF res <= 0 THEN
res := -1 res := -1
END END
@ -175,4 +165,4 @@ END splitf;
BEGIN BEGIN
eol := 0AX; eol := 0AX;
SYSTEM.GET(API.MainParam, argc) SYSTEM.GET(API.MainParam, argc)
END HOST. END HOST.

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

@ -1,4 +1,4 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019, Anton Krotov Copyright (c) 2019, Anton Krotov
@ -74,12 +74,18 @@ VAR
ptr: INTEGER; ptr: INTEGER;
BEGIN BEGIN
envc := -1;
SYSTEM.GET(API.MainParam, argc); IF API.MainParam # 0 THEN
REPEAT envc := -1;
SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr); SYSTEM.GET(API.MainParam, argc);
INC(envc) REPEAT
UNTIL ptr = 0; SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
INC(envc)
UNTIL ptr = 0
ELSE
envc := 0;
argc := 0
END;
libc := API.libc; libc := API.libc;
@ -128,4 +134,4 @@ END syscall;
BEGIN BEGIN
init init
END LINAPI. END LINAPI.

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

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

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -42,9 +42,9 @@ TYPE
cBytes: CHAR; cBytes: CHAR;
fFixedDisk: CHAR; fFixedDisk: CHAR;
nErrCode: SYSTEM.CARD16; nErrCode: WCHAR;
Reserved1: SYSTEM.CARD16; Reserved1: WCHAR;
Reserved2: SYSTEM.CARD16; Reserved2: WCHAR;
szPathName: ARRAY OFS_MAXPATHNAME OF CHAR szPathName: ARRAY OFS_MAXPATHNAME OF CHAR
END; END;
@ -211,7 +211,7 @@ BEGIN
END GetArg; 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 VAR
res, n: INTEGER; res, n: INTEGER;
@ -328,4 +328,4 @@ BEGIN
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
hConsoleOutput := _GetStdHandle(-11); hConsoleOutput := _GetStdHandle(-11);
ParamParse ParamParse
END HOST. END HOST.

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

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

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

@ -107,4 +107,4 @@ END main;
BEGIN BEGIN
main main
END Dialogs. END Dialogs.

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

@ -47,4 +47,4 @@ END Main;
BEGIN BEGIN
Main("HW", "Hello, world!") Main("HW", "Hello, world!")
END HW. END HW.

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

@ -1,4 +1,4 @@
MODULE HW_con; MODULE HW_con;
IMPORT Out, In, Console, DateTime; IMPORT Out, In, Console, DateTime;
@ -10,14 +10,14 @@ BEGIN
Out.Char("0") Out.Char("0")
END; END;
Out.Int(n, 0) Out.Int(n, 0)
END OutInt2; END OutInt2;
PROCEDURE OutMonth(n: INTEGER); PROCEDURE OutMonth(n: INTEGER);
VAR VAR
str: ARRAY 4 OF CHAR; str: ARRAY 4 OF CHAR;
BEGIN BEGIN
CASE n OF CASE n OF
| 1: str := "jan" | 1: str := "jan"
@ -32,10 +32,10 @@ BEGIN
|10: str := "oct" |10: str := "oct"
|11: str := "nov" |11: str := "nov"
|12: str := "dec" |12: str := "dec"
END; END;
Out.String(str) Out.String(str)
END OutMonth; END OutMonth;
PROCEDURE main; PROCEDURE main;
@ -52,7 +52,7 @@ BEGIN
OutInt2(Hour); Out.Char(":"); OutInt2(Hour); Out.Char(":");
OutInt2(Min); Out.Char(":"); OutInt2(Min); Out.Char(":");
OutInt2(Sec) OutInt2(Sec)
END main; END main;
BEGIN BEGIN
@ -60,4 +60,4 @@ BEGIN
main; main;
In.Ln; In.Ln;
Console.exit(TRUE) Console.exit(TRUE)
END HW_con. END HW_con.

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

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

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -194,4 +194,4 @@ END destroy;
BEGIN BEGIN
nodes := C.create() nodes := C.create()
END AVLTREES. END AVLTREES.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -380,4 +380,4 @@ BEGIN
END InitArray; END InitArray;
END BIN. END BIN.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -283,4 +283,4 @@ PROCEDURE Length* (list: ANYLIST): INTEGER;
END Length; END Length;
END CHUNKLISTS. END CHUNKLISTS.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -56,4 +56,4 @@ BEGIN
END create; END create;
END COLLECTIONS. END COLLECTIONS.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -79,4 +79,4 @@ BEGIN
END Int2Ln; END Int2Ln;
END CONSOLE. END CONSOLE.

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

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

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

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

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

@ -1,4 +1,4 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019, Anton Krotov Copyright (c) 2019, Anton Krotov
@ -648,4 +648,4 @@ BEGIN
END write; END write;
END ELF. END ELF.

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -134,7 +134,7 @@ BEGIN
END close; 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 VAR
res: INTEGER; res: INTEGER;
@ -216,4 +216,4 @@ END WriteByte;
BEGIN BEGIN
files := C.create() files := C.create()
END FILES. END FILES.

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -215,4 +215,4 @@ BEGIN
END write; END write;
END KOS. END KOS.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -199,4 +199,4 @@ BEGIN
END create; END create;
END LISTS. END LISTS.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -313,4 +313,4 @@ BEGIN
END write; END write;
END MSCOFF. END MSCOFF.

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

@ -1,4 +1,4 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019, Anton Krotov Copyright (c) 2019, Anton Krotov
@ -582,7 +582,7 @@ BEGIN
END Neg; END Neg;
PROCEDURE translate (code: IL.CODES); PROCEDURE translate;
VAR VAR
cmd, next: COMMAND; cmd, next: COMMAND;
@ -593,7 +593,7 @@ VAR
cc: INTEGER; cc: INTEGER;
BEGIN BEGIN
cmd := code.commands.first(COMMAND); cmd := IL.codes.commands.first(COMMAND);
WHILE cmd # NIL DO WHILE cmd # NIL DO
@ -1643,7 +1643,7 @@ BEGIN
END WriteHex; 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 VAR
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER;
@ -1668,12 +1668,12 @@ BEGIN
ram := MIN(MAX(ram, minRAM), maxRAM); ram := MIN(MAX(ram, minRAM), maxRAM);
rom := MIN(MAX(rom, minROM), maxROM); 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) ERRORS.Error(204)
END; END;
Labels := CHL.CreateIntList(); Labels := CHL.CreateIntList();
FOR i := 1 TO code.lcount DO FOR i := 1 TO IL.codes.lcount DO
CHL.PushInt(Labels, 0) CHL.PushInt(Labels, 0)
END; END;
@ -1681,28 +1681,28 @@ BEGIN
mem[i] := 0 mem[i] := 0
END; END;
TypesSize := CHL.Length(code.types) * 2; TypesSize := CHL.Length(IL.codes.types) * 2;
CodeList := LISTS.create(NIL); CodeList := LISTS.create(NIL);
RelList := LISTS.create(NIL); RelList := LISTS.create(NIL);
REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {});
prolog(ram); prolog(ram);
translate(code); translate;
epilog; epilog;
Code.address := 10000H - rom; Code.address := 10000H - rom;
Code.size := Fixup(Code.address, IntVectorSize + TypesSize); Code.size := Fixup(Code.address, IntVectorSize + TypesSize);
Data.address := Code.address + Code.size; 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)); Data.size := Data.size + ORD(ODD(Data.size));
TextSize := Code.size + 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) ERRORS.Error(203)
END; END;
Bss.address := RTL.ram + RTL.VarSize; 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; heap := Bss.address + Bss.size;
stack := RTL.ram + ram; stack := RTL.ram + ram;
ASSERT(stack - heap >= minStackSize); ASSERT(stack - heap >= minStackSize);
@ -1724,15 +1724,15 @@ BEGIN
adr := Data.address; adr := Data.address;
FOR i := 0 TO CHL.Length(code.data) - 1 DO FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO
mem[adr] := CHL.GetByte(code.data, i); mem[adr] := CHL.GetByte(IL.codes.data, i);
INC(adr) INC(adr)
END; END;
adr := 10000H - IntVectorSize - TypesSize; adr := 10000H - IntVectorSize - TypesSize;
FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO 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; END;
FOR i := 0 TO 15 DO FOR i := 0 TO 15 DO
@ -1790,4 +1790,4 @@ BEGIN
END CodeGen; END CodeGen;
END MSP430. END MSP430.

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

@ -1,4 +1,4 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019, Anton Krotov Copyright (c) 2019, Anton Krotov
@ -674,4 +674,4 @@ BEGIN
END Init; END Init;
END MSP430RTL. END MSP430RTL.

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -106,4 +106,4 @@ BEGIN
END GetCurrentDirectory; END GetCurrentDirectory;
END PATHS. END PATHS.

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

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

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -293,10 +293,8 @@ PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
BEGIN BEGIN
ASSERT(reg IN R.vregs); ASSERT(reg IN R.vregs);
ASSERT(offs # 0); ASSERT(offs # 0);
ASSERT(size IN {1, 2, 4, 8});
R.offs[reg] := offs; R.offs[reg] := offs;
IF size = 0 THEN
size := 8
END;
R.size[reg] := size R.size[reg] := size
END Lock; END Lock;
@ -437,4 +435,4 @@ BEGIN
END Init; END Init;
END REG. END REG.

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

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

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

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

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -311,4 +311,4 @@ BEGIN
END Utf8To16; END Utf8To16;
END STRINGS. END STRINGS.

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

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

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

@ -1,13 +1,13 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE UTILS; MODULE UTILS;
IMPORT HOST, UNIXTIME; IMPORT HOST;
CONST CONST
@ -24,6 +24,11 @@ CONST
max32* = 2147483647; max32* = 2147483647;
TYPE
DAYS = ARRAY 12, 31, 2 OF INTEGER;
VAR VAR
time*: INTEGER; time*: INTEGER;
@ -48,8 +53,10 @@ VAR
bit_diff*: INTEGER; 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) RETURN HOST.FileRead(F, Buffer, bytes)
END FileRead; END FileRead;
@ -114,6 +121,11 @@ BEGIN
END GetCurrentDirectory; 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; PROCEDURE UnixTime* (): INTEGER;
VAR VAR
year, month, day, hour, min, sec: INTEGER; year, month, day, hour, min, sec: INTEGER;
@ -124,7 +136,7 @@ BEGIN
res := HOST.UnixTime() res := HOST.UnixTime()
ELSE ELSE
HOST.now(year, month, day, hour, min, sec); 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 END
RETURN res RETURN res
@ -201,9 +213,52 @@ BEGIN
END Log2; 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 BEGIN
time := GetTickCount(); time := GetTickCount();
COPY(HOST.eol, eol); COPY(HOST.eol, eol);
maxreal := 1.9; maxreal := 1.9;
PACK(maxreal, 1023) PACK(maxreal, 1023);
END UTILS. init(days)
END UTILS.

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov Copyright (c) 2018-2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -108,4 +108,4 @@ BEGIN
END Close; END Close;
END WRITER. END WRITER.

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

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