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

oberon07: update (v1.13) 

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

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

Binary file not shown.

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

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

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
@ -18,6 +18,8 @@ CONST
_new = 1;
_dispose = 2;
SizeOfHeader = 36;
TYPE
@ -294,7 +296,7 @@ PROCEDURE init* (_import, code: INTEGER);
BEGIN
multi := FALSE;
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
base := code - 36;
base := code - SizeOfHeader;
K.sysfunc2(68, 11);
InitializeCriticalSection(CriticalSection);
K._init;
@ -316,4 +318,4 @@ PROCEDURE GetTickCount* (): INTEGER;
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
This program is free software: you can redistribute it and/or modify
@ -97,4 +97,4 @@ END GetArg;
BEGIN
ParamParse
END Args.
END Args.

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -138,4 +138,4 @@ BEGIN
Msec := 0
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
This program is free software: you can redistribute it and/or modify
@ -289,4 +289,4 @@ BEGIN
res := KOSAPI.sysfunc2(70, sys.ADR(info))
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
This program is free software: you can redistribute it and/or modify
@ -313,4 +313,4 @@ BEGIN
END DeleteDir;
END File.
END File.

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

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -205,7 +205,7 @@ BEGIN
END Create;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
n: INTEGER;
fs: FS;
@ -468,4 +468,4 @@ BEGIN
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
END;
ParamParse
END HOST.
END HOST.

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

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

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

@ -1,7 +1,7 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -427,4 +427,4 @@ BEGIN
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
This program is free software: you can redistribute it and/or modify
@ -381,4 +381,4 @@ BEGIN
END fact;
END Math.
END Math.

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

@ -1,4 +1,4 @@
(*
(*
Copyright 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -104,4 +104,4 @@ PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
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
This program is free software: you can redistribute it and/or modify
@ -150,4 +150,4 @@ END Load;
BEGIN
Load
END OpenDlg.
END OpenDlg.

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

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -264,4 +264,4 @@ END FixReal;
PROCEDURE 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
Copyright (c) 2018, 2019, Anton Krotov
Copyright (c) 2018-2019, Anton Krotov
All rights reserved.
*)
@ -16,13 +16,13 @@ CONST
maxint* = 7FFFFFFFH;
minint* = 80000000H;
DLL_PROCESS_ATTACH = 1;
DLL_THREAD_ATTACH = 2;
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
DLL_PROCESS_ATTACH = 1;
DLL_THREAD_ATTACH = 2;
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4;
MAX_SET = 31;
WORD = bit_depth DIV 8;
MAX_SET = bit_depth - 1;
TYPE
@ -35,6 +35,7 @@ VAR
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
dll: RECORD
process_detach,
@ -45,35 +46,9 @@ VAR
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
0FCH, (* cld *)
057H, (* push edi *)
056H, (* push esi *)
08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *)
08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *)
089H, 0C1H, (* mov ecx, eax *)
0C1H, 0E9H, 002H, (* shr ecx, 2 *)
0F3H, 0A5H, (* rep movsd *)
089H, 0C1H, (* mov ecx, eax *)
083H, 0E1H, 003H, (* and ecx, 3 *)
0F3H, 0A4H, (* rep movsb *)
05EH, (* pop esi *)
05FH (* pop edi *)
(* L: *)
)
END _move;
PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
085H, 0C0H, (* test eax, eax *)
07EH, 019H, (* jle L *)
@ -92,7 +67,7 @@ BEGIN
05FH (* pop edi *)
(* L: *)
)
END _move2;
END _move;
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
@ -103,7 +78,7 @@ BEGIN
IF len_src > len_dst THEN
res := FALSE
ELSE
_move(len_src * base_size, src, dst);
_move(len_src * base_size, dst, src);
res := TRUE
END
@ -113,7 +88,7 @@ END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
_move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
@ -144,7 +119,7 @@ BEGIN
IF a < 0 THEN
a := 0
END;
a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
a := LSR(ASR(minint, b - a), MAX_SET - b)
ELSE
a := 0
END
@ -153,69 +128,42 @@ BEGIN
END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
BEGIN
IF ASR(a, 5) = 0 THEN
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
ELSE
a := 0
END
RETURN a
END _set1;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
SYSTEM.CODE(
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
053H, (* push ebx *)
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
031H, 0D2H, (* xor edx, edx *)
085H, 0C0H, (* test eax, eax *)
07DH, 002H, (* jge L1 *)
074H, 018H, (* je L2 *)
07FH, 002H, (* jg L1 *)
0F7H, 0D2H, (* not edx *)
(* L1: *)
089H, 0C3H, (* mov ebx, eax *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
0F7H, 0F9H, (* idiv ecx *)
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
089H, 011H, (* mov dword [ecx], edx *)
0C9H, (* leave *)
0C2H, 00CH, 000H (* ret 12 *)
085H, 0D2H, (* test edx, edx *)
074H, 009H, (* je L2 *)
031H, 0CBH, (* xor ebx, ecx *)
085H, 0DBH, (* test ebx, ebx *)
07DH, 003H, (* jge L2 *)
048H, (* dec eax *)
001H, 0CAH, (* add edx, ecx *)
(* L2: *)
05BH (* pop ebx *)
)
RETURN 0
END divmod;
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
DEC(div)
END
RETURN div
END _div2;
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR
div, mod: INTEGER;
BEGIN
div := divmod(x, y, mod);
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
INC(mod, y)
END
RETURN mod
END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN _div2(a, b)
END _div;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN _mod2(a, b)
END _mod;
END _divmod;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
@ -223,7 +171,7 @@ BEGIN
ptr := API._NEW(size);
IF ptr # 0 THEN
SYSTEM.PUT(ptr, t);
INC(ptr, SIZE_OF_DWORD)
INC(ptr, WORD)
END
END _new;
@ -231,15 +179,14 @@ END _new;
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
IF ptr # 0 THEN
ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
ptr := API._DISPOSE(ptr - WORD)
END
END _dispose;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
PROCEDURE [stdcall] _length* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
@ -250,19 +197,14 @@ BEGIN
0E2H, 0F8H, (* loop L1 *)
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
)
RETURN 0
END _length;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER;
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
BEGIN
SYSTEM.CODE(
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
048H, (* dec eax *)
@ -277,58 +219,92 @@ BEGIN
040H, (* inc eax *)
(* L2: *)
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
0D1H, 0E8H, (* shr eax, 1 *)
0C9H, (* leave *)
0C2H, 008H, 000H (* ret 08h *)
0D1H, 0E8H (* shr eax, 1 *)
)
RETURN 0
END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 017H, (* jle L3 *)
08AH, 00EH, (* mov cl, byte[esi] *)
08AH, 017H, (* mov dl, byte[edi] *)
046H, (* inc esi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E7H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
SYSTEM.CODE(
056H, (* push esi *)
057H, (* push edi *)
053H, (* push ebx *)
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
031H, 0C9H, (* xor ecx, ecx *)
031H, 0D2H, (* xor edx, edx *)
0B8H,
000H, 000H, 000H, 080H, (* mov eax, minint *)
(* L1: *)
085H, 0DBH, (* test ebx, ebx *)
07EH, 01BH, (* jle L3 *)
066H, 08BH, 00EH, (* mov cx, word[esi] *)
066H, 08BH, 017H, (* mov dx, word[edi] *)
046H, (* inc esi *)
046H, (* inc esi *)
047H, (* inc edi *)
047H, (* inc edi *)
04BH, (* dec ebx *)
039H, 0D1H, (* cmp ecx, edx *)
074H, 006H, (* je L2 *)
089H, 0C8H, (* mov eax, ecx *)
029H, 0D0H, (* sub eax, edx *)
0EBH, 006H, (* jmp L3 *)
(* L2: *)
085H, 0C9H, (* test ecx, ecx *)
075H, 0E3H, (* jne L1 *)
031H, 0C0H, (* xor eax, eax *)
(* L3: *)
05BH, (* pop ebx *)
05FH, (* pop edi *)
05EH, (* pop esi *)
05DH, (* pop ebp *)
0C2H, 00CH, 000H (* ret 12 *)
)
RETURN 0
END strncmpw;
@ -507,7 +483,7 @@ END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
END
@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
SYSTEM.GET(p, p);
IF p # 0 THEN
SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p - WORD, p);
SYSTEM.GET(t0 + p + types, p)
ELSE
p := 1
@ -567,14 +543,6 @@ BEGIN
END _dllentry;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
@ -596,14 +564,20 @@ BEGIN
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
SYSTEM.GET(_types + t1 * WORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
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.thread_detach := NIL;
@ -621,10 +595,18 @@ BEGIN
END _sofinit;
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
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
This program is free software: you can redistribute it and/or modify
@ -121,4 +121,4 @@ END main;
BEGIN
main
END RasterWorks.
END RasterWorks.

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

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

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

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

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

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

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

@ -1,4 +1,4 @@
(*
(*
Copyright 2016, 2018 Anton Krotov
This program is free software: you can redistribute it and/or modify
@ -489,4 +489,4 @@ BEGIN
RETURN Font
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
This program is free software: you can redistribute it and/or modify
@ -432,4 +432,4 @@ END main;
BEGIN
main
END libimg.
END libimg.

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

@ -1,4 +1,4 @@
(*
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
@ -12,7 +12,7 @@ IMPORT SYSTEM;
CONST
BASE_ADR = 08048000H;
RTLD_LAZY* = 1;
TYPE
@ -22,8 +22,8 @@ TYPE
VAR
eol*: ARRAY 2 OF CHAR;
base*, MainParam*: INTEGER;
eol*: ARRAY 2 OF CHAR;
MainParam*: INTEGER;
libc*, librt*: INTEGER;
@ -93,6 +93,7 @@ END _DISPOSE;
PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
VAR
sym: INTEGER;
BEGIN
sym := dlsym(lib, SYSTEM.ADR(name[0]));
ASSERT(sym # 0);
@ -105,10 +106,9 @@ BEGIN
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
MainParam := sp;
base := BASE_ADR;
eol := 0AX;
libc := dlopen(SYSTEM.SADR("libc.so.6"), 1);
libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc));
GetProcAdr(libc, "free", SYSTEM.ADR(free));
GetProcAdr(libc, "exit", SYSTEM.ADR(_exit));
@ -125,7 +125,7 @@ BEGIN
GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose));
GetProcAdr(libc, "time", SYSTEM.ADR(time));
librt := dlopen(SYSTEM.SADR("librt.so.1"), 1);
librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
END init;
@ -142,4 +142,4 @@ BEGIN
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
Copyright (c) 2019, Anton Krotov
@ -68,22 +68,12 @@ BEGIN
END GetCurrentDirectory;
PROCEDURE ReadFile (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F)
END ReadFile;
PROCEDURE WriteFile (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F)
END WriteFile;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN
res := ReadFile(F, Buffer, bytes);
res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN
res := -1
END
@ -97,7 +87,7 @@ VAR
res: INTEGER;
BEGIN
res := WriteFile(F, Buffer, bytes);
res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
IF res <= 0 THEN
res := -1
END
@ -175,4 +165,4 @@ END splitf;
BEGIN
eol := 0AX;
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
Copyright (c) 2019, Anton Krotov
@ -74,12 +74,18 @@ VAR
ptr: INTEGER;
BEGIN
envc := -1;
SYSTEM.GET(API.MainParam, argc);
REPEAT
SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
INC(envc)
UNTIL ptr = 0;
IF API.MainParam # 0 THEN
envc := -1;
SYSTEM.GET(API.MainParam, argc);
REPEAT
SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
INC(envc)
UNTIL ptr = 0
ELSE
envc := 0;
argc := 0
END;
libc := API.libc;
@ -128,4 +134,4 @@ END syscall;
BEGIN
init
END LINAPI.
END LINAPI.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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