Egor00f/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

update

Browse Source 
git-svn-id: svn://kolibrios.org@7693 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2019-09-26 20:23:06 +00:00
parent 885116b9fb
commit c4dee82cbc
44 changed files with 8006 additions and 3960 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.

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

@ -17,6 +17,7 @@ UTF-8
"kos" - KolibriOS "kos" - KolibriOS
"obj" - KolibriOS DLL "obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC "elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) необязательные параметры-ключи 4) необязательные параметры-ключи
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб) -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб)
-base <address> адрес загрузки исполняемого файла в килобайтах -base <address> адрес загрузки исполняемого файла в килобайтах
@ -144,10 +145,10 @@ UTF-8
до 32 бит, для записи байтов использовать SYSTEM.PUT8, до 32 бит, для записи байтов использовать SYSTEM.PUT8,
для WCHAR -- SYSTEM.PUT16 для WCHAR -- SYSTEM.PUT16
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
Память[a] := младшие 8 бит (x) Память[a] := младшие 8 бит (x)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
Память[a] := младшие 16 бит (x) Память[a] := младшие 16 бит (x)
PROCEDURE MOVE(Source, Dest, n: INTEGER) PROCEDURE MOVE(Source, Dest, n: INTEGER)
@ -358,8 +359,8 @@ Oberon-
Все программы неявно используют модуль RTL. Компилятор транслирует Все программы неявно используют модуль RTL. Компилятор транслирует
некоторые операции (проверка и охрана типа, сравнение строк, сообщения об некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
следует явно вызывать эти процедуры, за исключением процедуры SetDll, следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini
если приложение компилируется как Windows DLL: если приложение компилируется как Windows DLL или Linux SO, соответственно:
PROCEDURE SetDll PROCEDURE SetDll
(process_detach, thread_detach, thread_attach: DLL_ENTRY); (process_detach, thread_detach, thread_attach: DLL_ENTRY);
@ -372,8 +373,15 @@ SetDll
- создании нового потока (thread_attach) - создании нового потока (thread_attach)
- уничтожении потока (thread_detach) - уничтожении потока (thread_detach)
Для прочих типов приложений, вызов процедуры SetDll не влияет на
PROCEDURE SetFini (ProcFini: PROC);
где TYPE PROC = PROCEDURE (* без параметров *)
SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки.
Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на
поведение программы. поведение программы.
Сообщения об ошибках времени выполнения выводятся в диалоговых окнах Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
(Windows), в терминал (Linux), на доску отладки (KolibriOS). (Windows), в терминал (Linux), на доску отладки (KolibriOS).
@ -395,6 +403,4 @@ SetDll
PROCEDURE [stdcall] lib_init (): INTEGER PROCEDURE [stdcall] lib_init (): INTEGER
Эта процедура должна быть вызвана перед использованием DLL. Эта процедура должна быть вызвана перед использованием DLL.
Процедура всегда возвращает 1. Процедура всегда возвращает 1.
Для Linux, генерация динамических библиотек не реализована.

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

@ -17,6 +17,7 @@ UTF-8
"kos" - KolibriOS "kos" - KolibriOS
"obj" - KolibriOS DLL "obj" - KolibriOS DLL
"elfexe" - Linux ELF-EXEC "elfexe" - Linux ELF-EXEC
"elfso" - Linux ELF-SO
4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨ 4) ­¥®¡ï§ â¥«ì­ë¥ ¯ à ¬¥âàë-ª«îç¨
-stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡) -stk <size> à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å (¯® 㬮«ç ­¨î 2 Œ¡)
-base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å -base <address>  ¤à¥á § £à㧪¨ ¨á¯®«­ï¥¬®£® ä ©«  ¢ ª¨«®¡ ©â å
@ -144,10 +145,10 @@ UTF-8
¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8, ¤® 32 ¡¨â, ¤«ï § ¯¨á¨ ¡ ©â®¢ ¨á¯®«ì§®¢ âì SYSTEM.PUT8,
¤«ï WCHAR -- SYSTEM.PUT16 ¤«ï WCHAR -- SYSTEM.PUT16
PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
<20> ¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x) <20> ¬ïâì[a] := ¬« ¤è¨¥ 8 ¡¨â (x)
PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR)
<20> ¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x) <20> ¬ïâì[a] := ¬« ¤è¨¥ 16 ¡¨â (x)
PROCEDURE MOVE(Source, Dest, n: INTEGER) PROCEDURE MOVE(Source, Dest, n: INTEGER)
@ -358,8 +359,8 @@ Oberon-ॠ
‚ᥠ¯à®£à ¬¬ë ­¥ï¢­® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à â࠭᫨àã¥â ‚ᥠ¯à®£à ¬¬ë ­¥ï¢­® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à â࠭᫨àã¥â
­¥ª®â®àë¥ ®¯¥à æ¨¨ (¯à®¢¥àª  ¨ ®åà ­  ⨯ , áà ¢­¥­¨¥ áâப, á®®¡é¥­¨ï ®¡ ­¥ª®â®àë¥ ®¯¥à æ¨¨ (¯à®¢¥àª  ¨ ®åà ­  ⨯ , áà ¢­¥­¨¥ áâப, á®®¡é¥­¨ï ®¡
®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. <20>¥ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. <20>¥
á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãàë SetDll, á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãà SetDll ¨ SetFini
¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL: ¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL ¨«¨ Linux SO, ᮮ⢥âá⢥­­®:
PROCEDURE SetDll PROCEDURE SetDll
(process_detach, thread_detach, thread_attach: DLL_ENTRY); (process_detach, thread_detach, thread_attach: DLL_ENTRY);
@ -372,8 +373,15 @@ SetDll
- ᮧ¤ ­¨¨ ­®¢®£® ¯®â®ª  (thread_attach) - ᮧ¤ ­¨¨ ­®¢®£® ¯®â®ª  (thread_attach)
- ã­¨ç⮦¥­¨¨ ¯®â®ª  (thread_detach) - ã­¨ç⮦¥­¨¨ ¯®â®ª  (thread_detach)
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãàë SetDll ­¥ ¢«¨ï¥â ­ 
PROCEDURE SetFini (ProcFini: PROC);
£¤¥ TYPE PROC = PROCEDURE (* ¡¥§ ¯ à ¬¥â஢ *)
SetFini ­ §­ ç ¥â ¯à®æ¥¤ãàã ProcFini ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ so-¡¨¡«¨®â¥ª¨.
„«ï ¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨©, ¢ë§®¢ ¯à®æ¥¤ãà SetDll ¨ SetFini ­¥ ¢«¨ï¥â ­ 
¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë. ¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë.
‘®®¡é¥­¨ï ®¡ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª­ å ‘®®¡é¥­¨ï ®¡ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª­ å
(Windows), ¢ â¥à¬¨­ « (Linux), ­  ¤®áªã ®â« ¤ª¨ (KolibriOS). (Windows), ¢ â¥à¬¨­ « (Linux), ­  ¤®áªã ®â« ¤ª¨ (KolibriOS).
@ -395,6 +403,4 @@ SetDll
PROCEDURE [stdcall] lib_init (): INTEGER PROCEDURE [stdcall] lib_init (): INTEGER
<EFBFBD>â  ¯à®æ¥¤ãà  ¤®«¦­  ¡ëâì ¢ë§¢ ­  ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ DLL. <EFBFBD>â  ¯à®æ¥¤ãà  ¤®«¦­  ¡ëâì ¢ë§¢ ­  ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ DLL.
<EFBFBD>à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1. <EFBFBD>à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1.
„«ï Linux, £¥­¥à æ¨ï ¤¨­ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª ­¥ ॠ«¨§®¢ ­ .

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

@ -98,8 +98,8 @@ MODULE Math -
CONST CONST
pi = 3.141592653589793D+00 pi = 3.141592653589793E+00
e = 2.718281828459045D+00 e = 2.718281828459045E+00
PROCEDURE IsNan(x: REAL): BOOLEAN PROCEDURE IsNan(x: REAL): BOOLEAN
@ -153,13 +153,13 @@ MODULE Math -
PROCEDURE tanh(x: REAL): REAL PROCEDURE tanh(x: REAL): REAL
ãèïåðáîëè÷åñêèé òàíãåíñ x ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE arcsinh(x: REAL): REAL PROCEDURE arsinh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x
PROCEDURE arccosh(x: REAL): REAL PROCEDURE arcosh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x
PROCEDURE arctanh(x: REAL): REAL PROCEDURE artanh(x: REAL): REAL
îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x
PROCEDURE round(x: REAL): REAL PROCEDURE round(x: REAL): REAL
@ -181,6 +181,9 @@ MODULE Math -
åñëè x < 0 âîçâðàùàåò -1 åñëè x < 0 âîçâðàùàåò -1
åñëè x = 0 âîçâðàùàåò 0 åñëè x = 0 âîçâðàùàåò 0
PROCEDURE fact(n: INTEGER): REAL
ôàêòîðèàë n
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
MODULE Debug - âûâîä íà äîñêó îòëàäêè MODULE Debug - âûâîä íà äîñêó îòëàäêè
Èíòåðôåéñ êàê ìîäóëü Out Èíòåðôåéñ êàê ìîäóëü Out
@ -337,7 +340,7 @@ MODULE DateTime -
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ
Year, Month, Day, Hour, Min, Sec; Year, Month, Day, Hour, Min, Sec;
ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5 ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0E5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec: INTEGER): BOOLEAN Hour, Min, Sec: INTEGER): BOOLEAN

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

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

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

@ -17,7 +17,7 @@
MODULE File; MODULE File;
IMPORT sys := SYSTEM, KOSAPI; IMPORT sys := SYSTEM, KOSAPI;
CONST CONST
@ -47,7 +47,7 @@ TYPE
time_modif*, date_modif*, time_modif*, date_modif*,
size*, hsize*: INTEGER; size*, hsize*: INTEGER;
name*: FNAME name*: FNAME
END; END;
PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER; PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
@ -67,7 +67,7 @@ BEGIN
0C2H, 008H, 000H (* ret 8 *) 0C2H, 008H, 000H (* ret 8 *)
) )
RETURN 0 RETURN 0
END f_68_27; END f_68_27;
PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
@ -77,7 +77,7 @@ END Load;
PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
VAR VAR
res2: INTEGER; fs: rFS; res2: INTEGER; fs: rFS;
BEGIN BEGIN
fs.subfunc := 5; fs.subfunc := 5;
@ -88,7 +88,7 @@ BEGIN
COPY(FName, fs.name) COPY(FName, fs.name)
RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0 RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
END GetFileInfo; END GetFileInfo;
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN; PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
@ -97,7 +97,7 @@ VAR
BEGIN BEGIN
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists; END Exists;
PROCEDURE Close* (VAR F: FS); PROCEDURE Close* (VAR F: FS);
BEGIN BEGIN
@ -109,9 +109,9 @@ END Close;
PROCEDURE Open* (FName: ARRAY OF CHAR): FS; PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
VAR VAR
F: FS; F: FS;
BEGIN BEGIN
IF Exists(FName) THEN IF Exists(FName) THEN
NEW(F); NEW(F);
@ -128,7 +128,7 @@ BEGIN
END END
RETURN F RETURN F
END Open; END Open;
PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
@ -158,7 +158,7 @@ BEGIN
RETURN res = 0 RETURN res = 0
END Delete; END Delete;
PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER; PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
VAR VAR
@ -202,7 +202,7 @@ BEGIN
END END
RETURN res2 RETURN res2
END Read; END Read;
PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER; PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
@ -225,7 +225,7 @@ BEGIN
RETURN res2 RETURN res2
END Write; END Write;
PROCEDURE Create* (FName: ARRAY OF CHAR): FS; PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
VAR VAR
@ -249,14 +249,14 @@ BEGIN
RETURN F RETURN F
END Create; END Create;
PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN; PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN;
VAR VAR
fd: rFD; fd: rFD;
BEGIN BEGIN
RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr)) RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
END DirExists; END DirExists;
PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
@ -282,7 +282,7 @@ BEGIN
RETURN res = 0 RETURN res = 0
END CreateDir; END CreateDir;
PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN; PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
VAR VAR

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

@ -1,5 +1,5 @@
(* (*
Copyright 2013, 2014, 2018 Anton Krotov Copyright 2013, 2014, 2018, 2019 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by it under the terms of the GNU Lesser General Public License as published by
@ -167,10 +167,10 @@ END ln;
PROCEDURE [stdcall] log* (base, x: REAL): REAL; PROCEDURE [stdcall] log* (base, x: REAL): REAL;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
0D9H, 0E8H, (* fld1 *) 0D9H, 0E8H, (* fld1 *)
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
0D9H, 0F1H, (* fyl2x *) 0D9H, 0F1H, (* fyl2x *)
0D9H, 0E8H, (* fld1 *) 0D9H, 0E8H, (* fld1 *)
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
@ -251,58 +251,45 @@ END arctan;
PROCEDURE sinh* (x: REAL): REAL; PROCEDURE sinh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN BEGIN
IF IsZero(x) THEN x := exp(x)
res := 0.0 RETURN (x - 1.0 / x) * 0.5
ELSE
res := (exp(x) - exp(-x)) / 2.0
END
RETURN res
END sinh; END sinh;
PROCEDURE cosh* (x: REAL): REAL; PROCEDURE cosh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN BEGIN
IF IsZero(x) THEN x := exp(x)
res := 1.0 RETURN (x + 1.0 / x) * 0.5
ELSE
res := (exp(x) + exp(-x)) / 2.0
END
RETURN res
END cosh; END cosh;
PROCEDURE tanh* (x: REAL): REAL; PROCEDURE tanh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN BEGIN
IF IsZero(x) THEN IF x > 15.0 THEN
res := 0.0 x := 1.0
ELSIF x < -15.0 THEN
x := -1.0
ELSE ELSE
res := sinh(x) / cosh(x) x := exp(2.0 * x);
x := (x - 1.0) / (x + 1.0)
END END
RETURN res
RETURN x
END tanh; END tanh;
PROCEDURE arcsinh* (x: REAL): REAL; PROCEDURE arsinh* (x: REAL): REAL;
RETURN ln(x + sqrt((x * x) + 1.0)) RETURN ln(x + sqrt(x * x + 1.0))
END arcsinh; END arsinh;
PROCEDURE arccosh* (x: REAL): REAL; PROCEDURE arcosh* (x: REAL): REAL;
RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0)) RETURN ln(x + sqrt(x * x - 1.0))
END arccosh; END arcosh;
PROCEDURE arctanh* (x: REAL): REAL; PROCEDURE artanh* (x: REAL): REAL;
VAR VAR
res: REAL; res: REAL;
@ -315,7 +302,7 @@ BEGIN
res := 0.5 * ln((1.0 + x) / (1.0 - x)) res := 0.5 * ln((1.0 + x) / (1.0 - x))
END END
RETURN res RETURN res
END arctanh; END artanh;
PROCEDURE floor* (x: REAL): REAL; PROCEDURE floor* (x: REAL): REAL;
@ -374,8 +361,24 @@ BEGIN
ELSE ELSE
res := 0 res := 0
END END
RETURN res RETURN res
END sgn; END sgn;
PROCEDURE fact* (n: INTEGER): REAL;
VAR
res: REAL;
BEGIN
res := 1.0;
WHILE n > 1 DO
res := res * FLT(n);
DEC(n)
END
RETURN res
END fact;
END Math. END Math.

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

@ -1,4 +1,4 @@
(* (*
Copyright 2017 Anton Krotov Copyright 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -24,18 +24,18 @@ CONST
//net devices types //net devices types
LOOPBACK* = 0; LOOPBACK* = 0;
ETH* = 1; ETH* = 1;
SLIP* = 2; SLIP* = 2;
//Link status //Link status
LINK_DOWN* = 0; LINK_DOWN* = 0;
LINK_UNKNOWN* = 1; LINK_UNKNOWN* = 1;
LINK_FD* = 2; //full duplex flag LINK_FD* = 2; //full duplex flag
LINK_10M* = 4; LINK_10M* = 4;
LINK_100M* = 8; LINK_100M* = 8;
LINK_1G* = 12; LINK_1G* = 12;
TYPE TYPE

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

@ -10,7 +10,7 @@ MODULE RTL;
IMPORT SYSTEM, API; IMPORT SYSTEM, API;
CONST CONST
bit_depth* = 32; bit_depth* = 32;
maxint* = 7FFFFFFFH; maxint* = 7FFFFFFFH;
@ -22,11 +22,13 @@ CONST
DLL_PROCESS_DETACH = 0; DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4; SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR VAR
@ -40,6 +42,8 @@ VAR
thread_attach: DLL_ENTRY thread_attach: DLL_ENTRY
END; END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN BEGIN
@ -107,18 +111,12 @@ BEGIN
END _arrcpy; END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst) _move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy; END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR VAR
i, n, k: INTEGER; i, n, k: INTEGER;
@ -137,32 +135,29 @@ BEGIN
END _rot; END _rot;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN BEGIN
IF (a <= b) & (a <= 31) & (b >= 0) THEN IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > 31 THEN IF b > MAX_SET THEN
b := 31 b := MAX_SET
END; END;
IF a < 0 THEN IF a < 0 THEN
a := 0 a := 0
END; END;
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
ELSE ELSE
res := 0 a := 0
END END
RETURN res RETURN a
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set; END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -185,7 +180,7 @@ BEGIN
END divmod; END divmod;
PROCEDURE div_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -196,10 +191,10 @@ BEGIN
END END
RETURN div RETURN div
END div_; END _div2;
PROCEDURE mod_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -210,29 +205,19 @@ BEGIN
END END
RETURN mod RETURN mod
END mod_; END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN div_(a, b) RETURN _div2(a, b)
END _div; END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN mod_(a, b) RETURN _mod2(a, b)
END _mod; END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN BEGIN
ptr := API._NEW(size); ptr := API._NEW(size);
@ -251,50 +236,6 @@ BEGIN
END _dispose; END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -345,16 +286,71 @@ BEGIN
END _lengthw; END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: CHAR;
BEGIN BEGIN
res := strncmp(str1, str2, MIN(len1, len2)); res := strncmp(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _length(len1, str1) - _length(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -370,21 +366,25 @@ BEGIN
END _strcmp; END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: WCHAR;
BEGIN BEGIN
res := strncmpw(str1, str2, MIN(len1, len2)); res := strncmpw(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -400,11 +400,6 @@ BEGIN
END _strcmpw; END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR VAR
c: CHAR; c: CHAR;
@ -470,14 +465,14 @@ BEGIN
END append; END append;
PROCEDURE [stdcall] _error* (module, err: INTEGER); PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
VAR VAR
s, temp: ARRAY 1024 OF CHAR; s, temp: ARRAY 1024 OF CHAR;
BEGIN BEGIN
s := ""; s := "";
CASE err MOD 16 OF CASE err OF
| 1: append(s, "assertion failure") | 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference") | 2: append(s, "NIL dereference")
| 3: append(s, "division by zero") | 3: append(s, "division by zero")
@ -493,8 +488,8 @@ BEGIN
append(s, API.eol); append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); append(s, "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name); API.DebugMsg(SYSTEM.ADR(s[0]), name);
@ -502,69 +497,42 @@ BEGIN
END _error; END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN BEGIN
(* r IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec; END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END END
RETURN t1 = t0 RETURN p MOD 2
END _is; END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN BEGIN
(* r:t1 IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec; END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p); SYSTEM.GET(p, p);
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE ELSE
t1 := t0 p := 1
END END
RETURN t1 = t0 RETURN p MOD 2
END _guard; END _guard;
@ -613,18 +581,50 @@ BEGIN
END _exit; END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
BEGIN BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code); API.init(param, code);
types := _types; types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
name := modname; name := modname;
dll.process_detach := NIL; dll.process_detach := NIL;
dll.thread_detach := NIL; dll.thread_detach := NIL;
dll.thread_attach := NIL; dll.thread_attach := NIL;
fini := NIL
END _init; END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL. END RTL.

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

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

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

@ -38,16 +38,6 @@ VAR
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER;
RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1)
END dlopen;
PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER;
RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0]))
END dlsym;
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
VAR VAR
i, len, ptr: INTEGER; i, len, ptr: INTEGER;

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

@ -10,7 +10,7 @@ MODULE RTL;
IMPORT SYSTEM, API; IMPORT SYSTEM, API;
CONST CONST
bit_depth* = 32; bit_depth* = 32;
maxint* = 7FFFFFFFH; maxint* = 7FFFFFFFH;
@ -22,11 +22,13 @@ CONST
DLL_PROCESS_DETACH = 0; DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4; SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR VAR
@ -40,6 +42,8 @@ VAR
thread_attach: DLL_ENTRY thread_attach: DLL_ENTRY
END; END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN BEGIN
@ -107,18 +111,12 @@ BEGIN
END _arrcpy; END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst) _move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy; END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR VAR
i, n, k: INTEGER; i, n, k: INTEGER;
@ -137,32 +135,29 @@ BEGIN
END _rot; END _rot;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN BEGIN
IF (a <= b) & (a <= 31) & (b >= 0) THEN IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > 31 THEN IF b > MAX_SET THEN
b := 31 b := MAX_SET
END; END;
IF a < 0 THEN IF a < 0 THEN
a := 0 a := 0
END; END;
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
ELSE ELSE
res := 0 a := 0
END END
RETURN res RETURN a
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set; END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -185,7 +180,7 @@ BEGIN
END divmod; END divmod;
PROCEDURE div_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -196,10 +191,10 @@ BEGIN
END END
RETURN div RETURN div
END div_; END _div2;
PROCEDURE mod_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -210,29 +205,19 @@ BEGIN
END END
RETURN mod RETURN mod
END mod_; END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN div_(a, b) RETURN _div2(a, b)
END _div; END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN mod_(a, b) RETURN _mod2(a, b)
END _mod; END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN BEGIN
ptr := API._NEW(size); ptr := API._NEW(size);
@ -251,50 +236,6 @@ BEGIN
END _dispose; END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -345,16 +286,71 @@ BEGIN
END _lengthw; END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: CHAR;
BEGIN BEGIN
res := strncmp(str1, str2, MIN(len1, len2)); res := strncmp(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _length(len1, str1) - _length(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -370,21 +366,25 @@ BEGIN
END _strcmp; END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: WCHAR;
BEGIN BEGIN
res := strncmpw(str1, str2, MIN(len1, len2)); res := strncmpw(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -400,11 +400,6 @@ BEGIN
END _strcmpw; END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR VAR
c: CHAR; c: CHAR;
@ -470,14 +465,14 @@ BEGIN
END append; END append;
PROCEDURE [stdcall] _error* (module, err: INTEGER); PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
VAR VAR
s, temp: ARRAY 1024 OF CHAR; s, temp: ARRAY 1024 OF CHAR;
BEGIN BEGIN
s := ""; s := "";
CASE err MOD 16 OF CASE err OF
| 1: append(s, "assertion failure") | 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference") | 2: append(s, "NIL dereference")
| 3: append(s, "division by zero") | 3: append(s, "division by zero")
@ -493,8 +488,8 @@ BEGIN
append(s, API.eol); append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); append(s, "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name); API.DebugMsg(SYSTEM.ADR(s[0]), name);
@ -502,69 +497,42 @@ BEGIN
END _error; END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN BEGIN
(* r IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec; END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END END
RETURN t1 = t0 RETURN p MOD 2
END _is; END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN BEGIN
(* r:t1 IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec; END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p); SYSTEM.GET(p, p);
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE ELSE
t1 := t0 p := 1
END END
RETURN t1 = t0 RETURN p MOD 2
END _guard; END _guard;
@ -613,18 +581,50 @@ BEGIN
END _exit; END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
BEGIN BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code); API.init(param, code);
types := _types; types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
name := modname; name := modname;
dll.process_detach := NIL; dll.process_detach := NIL;
dll.thread_detach := NIL; dll.thread_detach := NIL;
dll.thread_attach := NIL; dll.thread_attach := NIL;
fini := NIL
END _init; END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL. END RTL.

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

@ -13,14 +13,16 @@ VAR
eol*: ARRAY 3 OF CHAR; eol*: ARRAY 3 OF CHAR;
base*: INTEGER; base*: INTEGER;
heap: INTEGER;
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER; PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER; PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
@ -30,19 +32,22 @@ END DebugMsg;
PROCEDURE _NEW* (size: INTEGER): INTEGER; PROCEDURE _NEW* (size: INTEGER): INTEGER;
RETURN Alloc(64, size) RETURN HeapAlloc(heap, 8, size)
END _NEW; END _NEW;
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
RETURN Free(p) BEGIN
HeapFree(heap, 0, p)
RETURN 0
END _DISPOSE; END _DISPOSE;
PROCEDURE init* (reserved, code: INTEGER); PROCEDURE init* (reserved, code: INTEGER);
BEGIN BEGIN
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
base := code - 4096 base := code - 4096;
heap := GetProcessHeap()
END init; END init;

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

@ -10,7 +10,7 @@ MODULE RTL;
IMPORT SYSTEM, API; IMPORT SYSTEM, API;
CONST CONST
bit_depth* = 32; bit_depth* = 32;
maxint* = 7FFFFFFFH; maxint* = 7FFFFFFFH;
@ -22,11 +22,13 @@ CONST
DLL_PROCESS_DETACH = 0; DLL_PROCESS_DETACH = 0;
SIZE_OF_DWORD = 4; SIZE_OF_DWORD = 4;
MAX_SET = 31;
TYPE TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
VAR VAR
@ -40,6 +42,8 @@ VAR
thread_attach: DLL_ENTRY thread_attach: DLL_ENTRY
END; END;
fini: PROC;
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
BEGIN BEGIN
@ -107,18 +111,12 @@ BEGIN
END _arrcpy; END _arrcpy;
PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst) _move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy; END _strcpy;
PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
_move(MIN(len_dst, len_src) * chr_size, src, dst)
END _strcpy2;
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR VAR
i, n, k: INTEGER; i, n, k: INTEGER;
@ -137,32 +135,29 @@ BEGIN
END _rot; END _rot;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
VAR
res: INTEGER;
BEGIN BEGIN
IF (a <= b) & (a <= 31) & (b >= 0) THEN IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
IF b > 31 THEN IF b > MAX_SET THEN
b := 31 b := MAX_SET
END; END;
IF a < 0 THEN IF a < 0 THEN
a := 0 a := 0
END; END;
res := LSR(ASR(ROR(1, 1), b - a), 31 - b) a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
ELSE ELSE
res := 0 a := 0
END END
RETURN res RETURN a
END _set2;
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
RETURN _set2(a, b)
END _set; END _set;
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
RETURN _set(b, a)
END _set2;
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -185,7 +180,7 @@ BEGIN
END divmod; END divmod;
PROCEDURE div_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -196,10 +191,10 @@ BEGIN
END END
RETURN div RETURN div
END div_; END _div2;
PROCEDURE mod_ (x, y: INTEGER): INTEGER; PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
VAR VAR
div, mod: INTEGER; div, mod: INTEGER;
@ -210,29 +205,19 @@ BEGIN
END END
RETURN mod RETURN mod
END mod_; END _mod2;
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
RETURN div_(a, b) RETURN _div2(a, b)
END _div; END _div;
PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
RETURN div_(a, b)
END _div2;
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
RETURN mod_(a, b) RETURN _mod2(a, b)
END _mod; END _mod;
PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER;
RETURN mod_(a, b)
END _mod2;
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN BEGIN
ptr := API._NEW(size); ptr := API._NEW(size);
@ -251,50 +236,6 @@ BEGIN
END _dispose; END _dispose;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := 0;
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
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
BEGIN BEGIN
SYSTEM.CODE( SYSTEM.CODE(
@ -345,16 +286,71 @@ BEGIN
END _lengthw; END _lengthw;
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a);
SYSTEM.GET(b, B); INC(b);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmp;
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
VAR
A, B: WCHAR;
res: INTEGER;
BEGIN
res := minint;
WHILE n > 0 DO
SYSTEM.GET(a, A); INC(a, 2);
SYSTEM.GET(b, B); INC(b, 2);
DEC(n);
IF A # B THEN
res := ORD(A) - ORD(B);
n := 0
ELSIF A = 0X THEN
res := 0;
n := 0
END
END
RETURN res
END strncmpw;
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: CHAR;
BEGIN BEGIN
res := strncmp(str1, str2, MIN(len1, len2)); res := strncmp(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _length(len1, str1) - _length(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -370,21 +366,25 @@ BEGIN
END _strcmp; END _strcmp;
PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmp(op, len2, str2, len1, str1)
END _strcmp2;
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR VAR
res: INTEGER; res: INTEGER;
bRes: BOOLEAN; bRes: BOOLEAN;
c: WCHAR;
BEGIN BEGIN
res := strncmpw(str1, str2, MIN(len1, len2)); res := strncmpw(str1, str2, MIN(len1, len2));
IF res = 0 THEN IF res = minint THEN
res := _lengthw(len1, str1) - _lengthw(len2, str2) IF len1 > len2 THEN
SYSTEM.GET(str1 + len2 * 2, c);
res := ORD(c)
ELSIF len1 < len2 THEN
SYSTEM.GET(str2 + len1 * 2, c);
res := -ORD(c)
ELSE
res := 0
END
END; END;
CASE op OF CASE op OF
@ -400,11 +400,6 @@ BEGIN
END _strcmpw; END _strcmpw;
PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
RETURN _strcmpw(op, len2, str2, len1, str1)
END _strcmpw2;
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR VAR
c: CHAR; c: CHAR;
@ -470,14 +465,14 @@ BEGIN
END append; END append;
PROCEDURE [stdcall] _error* (module, err: INTEGER); PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
VAR VAR
s, temp: ARRAY 1024 OF CHAR; s, temp: ARRAY 1024 OF CHAR;
BEGIN BEGIN
s := ""; s := "";
CASE err MOD 16 OF CASE err OF
| 1: append(s, "assertion failure") | 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference") | 2: append(s, "NIL dereference")
| 3: append(s, "division by zero") | 3: append(s, "division by zero")
@ -493,8 +488,8 @@ BEGIN
append(s, API.eol); append(s, API.eol);
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); append(s, "line: "); IntToStr(line, temp); append(s, temp);
API.DebugMsg(SYSTEM.ADR(s[0]), name); API.DebugMsg(SYSTEM.ADR(s[0]), name);
@ -502,69 +497,42 @@ BEGIN
END _error; END _error;
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN BEGIN
(* r IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _isrec; END _isrec;
PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE
t1 := -1
END END
RETURN t1 = t0 RETURN p MOD 2
END _is; END _is;
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN BEGIN
(* r:t1 IS t0 *) SYSTEM.GET(t0 + t1 + types, t0)
RETURN t0 MOD 2
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
RETURN t1 = t0
END _guardrec; END _guardrec;
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
VAR
t1: INTEGER;
BEGIN BEGIN
(* p IS t0 *)
SYSTEM.GET(p, p); SYSTEM.GET(p, p);
IF p # 0 THEN IF p # 0 THEN
DEC(p, SIZE_OF_DWORD); SYSTEM.GET(p - SIZE_OF_DWORD, p);
SYSTEM.GET(p, t1); SYSTEM.GET(t0 + p + types, p)
WHILE (t1 # t0) & (t1 # 0) DO
SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
END
ELSE ELSE
t1 := t0 p := 1
END END
RETURN t1 = t0 RETURN p MOD 2
END _guard; END _guard;
@ -613,18 +581,50 @@ BEGIN
END _exit; END _exit;
PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
t0, t1, i, j: INTEGER;
BEGIN BEGIN
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
API.init(param, code); API.init(param, code);
types := _types; types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
ASSERT(types # 0);
FOR i := 0 TO tcount - 1 DO
FOR j := 0 TO tcount - 1 DO
t0 := i; t1 := j;
WHILE (t1 # 0) & (t1 # t0) DO
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
END;
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
END
END;
name := modname; name := modname;
dll.process_detach := NIL; dll.process_detach := NIL;
dll.thread_detach := NIL; dll.thread_detach := NIL;
dll.thread_attach := NIL; dll.thread_attach := NIL;
fini := NIL
END _init; END _init;
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
END RTL. END RTL.

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

File diff suppressed because it is too large Load Diff

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

@ -7,7 +7,7 @@
MODULE ARITH; MODULE ARITH;
IMPORT AVLTREES, STRINGS, MACHINE, UTILS; IMPORT AVLTREES, STRINGS, UTILS;
CONST CONST
@ -53,10 +53,7 @@ BEGIN
ELSIF v.typ = tWCHAR THEN ELSIF v.typ = tWCHAR THEN
res := v.int res := v.int
ELSIF v.typ = tSET THEN ELSIF v.typ = tSET THEN
res := ORD(v.set); res := UTILS.Long(ORD(v.set))
IF MACHINE._64to32 THEN
res := MACHINE.Int32To64(res)
END
ELSIF v.typ = tBOOLEAN THEN ELSIF v.typ = tBOOLEAN THEN
res := ORD(v.bool) res := ORD(v.bool)
END END
@ -88,13 +85,13 @@ VAR
BEGIN BEGIN
error := FALSE; error := FALSE;
IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN
error := TRUE error := TRUE
ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN
error := TRUE error := TRUE
ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN
error := TRUE error := TRUE
ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN
error := TRUE error := TRUE
END END
@ -172,7 +169,7 @@ BEGIN
n := i n := i
END; END;
IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
error := 2 error := 2
ELSE ELSE
value := value * 16 + d; value := value * 16 + d;
@ -181,9 +178,7 @@ BEGIN
END; END;
IF MACHINE._64to32 THEN value := UTILS.Long(value);
value := MACHINE.Int32To64(value);
END;
IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
error := 3 error := 3
@ -471,58 +466,53 @@ END mulInt;
PROCEDURE _ASR (x, n: INTEGER): INTEGER; PROCEDURE _ASR (x, n: INTEGER): INTEGER;
BEGIN RETURN ASR(UTILS.Long(x), n)
IF MACHINE._64to32 THEN
x := MACHINE.Int32To64(x)
END
RETURN ASR(x, n)
END _ASR; END _ASR;
PROCEDURE _LSR (x, n: INTEGER): INTEGER; PROCEDURE _LSR (x, n: INTEGER): INTEGER;
BEGIN RETURN UTILS.Long(LSR(UTILS.Short(x), n))
IF MACHINE._64to32 THEN
x := MACHINE.Int64To32(x);
x := LSR(x, n);
x := MACHINE.Int32To64(x)
ELSE
x := LSR(x, n)
END
RETURN x
END _LSR; END _LSR;
PROCEDURE _LSL (x, n: INTEGER): INTEGER; PROCEDURE _LSL (x, n: INTEGER): INTEGER;
BEGIN RETURN UTILS.Long(LSL(x, n))
x := LSL(x, n);
IF MACHINE._64to32 THEN
x := MACHINE.Int32To64(x)
END
RETURN x
END _LSL; END _LSL;
PROCEDURE _ROR1_32 (x: INTEGER): INTEGER; PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
BEGIN BEGIN
x := MACHINE.Int64To32(x); x := UTILS.Short(x);
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31))) x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
RETURN MACHINE.Int32To64(x) RETURN UTILS.Long(x)
END _ROR1_32; END _ROR1_32;
PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
BEGIN
x := x MOD 65536;
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
RETURN UTILS.Long(x)
END _ROR1_16;
PROCEDURE _ROR (x, n: INTEGER): INTEGER; PROCEDURE _ROR (x, n: INTEGER): INTEGER;
BEGIN BEGIN
IF MACHINE._64to32 THEN
CASE UTILS.bit_diff OF
|0: x := ROR(x, n)
|16, 48:
n := n MOD 16;
WHILE n > 0 DO
x := _ROR1_16(x);
DEC(n)
END
|32:
n := n MOD 32; n := n MOD 32;
WHILE n > 0 DO WHILE n > 0 DO
x := _ROR1_32(x); x := _ROR1_32(x);
DEC(n) DEC(n)
END END
ELSE
x := ROR(x, n)
END END
RETURN x RETURN x
@ -587,11 +577,7 @@ BEGIN
CASE v.typ OF CASE v.typ OF
|tCHAR, tWCHAR: |tCHAR, tWCHAR:
|tBOOLEAN: v.int := ORD(v.bool) |tBOOLEAN: v.int := ORD(v.bool)
|tSET: |tSET: v.int := UTILS.Long(ORD(v.set))
v.int := ORD(v.set);
IF MACHINE._64to32 THEN
v.int := MACHINE.Int32To64(v.int)
END
END; END;
v.typ := tINTEGER v.typ := tINTEGER
END ord; END ord;
@ -616,7 +602,7 @@ VAR
res: BOOLEAN; res: BOOLEAN;
BEGIN BEGIN
res := FALSE; res := FALSE;
CASE v.typ OF CASE v.typ OF
|tREAL: |tREAL:
@ -627,8 +613,8 @@ BEGIN
v.int := ABS(v.int); v.int := ABS(v.int);
res := TRUE res := TRUE
END END
END END
RETURN res RETURN res
END abs; END abs;
@ -787,7 +773,7 @@ BEGIN
|"I": |"I":
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
IF range(v, 0, MACHINE.target.maxSet) THEN IF range(v, 0, UTILS.target.maxSet) THEN
res := v.int IN v2.set res := v.int IN v2.set
ELSE ELSE
error := 2 error := 2

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

@ -1,11 +1,11 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE AVLTREES; MODULE AVLTREES;
IMPORT C := COLLECTIONS; IMPORT C := COLLECTIONS;
@ -39,7 +39,7 @@ VAR
node: NODE; node: NODE;
citem: C.ITEM; citem: C.ITEM;
BEGIN BEGIN
citem := C.pop(nodes); citem := C.pop(nodes);
IF citem = NIL THEN IF citem = NIL THEN
NEW(node) NEW(node)
@ -181,8 +181,8 @@ BEGIN
IF destructor # NIL THEN IF destructor # NIL THEN
destructor(node.data) destructor(node.data)
END; END;
C.push(nodes, node); C.push(nodes, node);
node := NIL; node := NIL;

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

@ -7,7 +7,7 @@
MODULE BIN; MODULE BIN;
IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS; IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
CONST CONST
@ -138,7 +138,10 @@ BEGIN
END; END;
IF UTILS.bit_depth = 64 THEN IF UTILS.bit_depth = 64 THEN
x := MACHINE.Int32To64(x) x := LSL(x, 16);
x := LSL(x, 16);
x := ASR(x, 16);
x := ASR(x, 16)
END END
RETURN x RETURN x
@ -151,7 +154,7 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 3 DO FOR i := 0 TO 3 DO
CHL.SetByte(array, idx + i, MACHINE.Byte(x, i)) CHL.SetByte(array, idx + i, UTILS.Byte(x, i))
END END
END put32le; END put32le;
@ -162,7 +165,7 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 3 DO FOR i := 0 TO 3 DO
CHL.PushByte(program.data, MACHINE.Byte(x, i)) CHL.PushByte(program.data, UTILS.Byte(x, i))
END END
END PutData32LE; END PutData32LE;
@ -173,7 +176,7 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 7 DO FOR i := 0 TO 7 DO
CHL.PushByte(program.data, MACHINE.Byte(x, i)) CHL.PushByte(program.data, UTILS.Byte(x, i))
END END
END PutData64LE; END PutData64LE;
@ -203,7 +206,7 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 3 DO FOR i := 0 TO 3 DO
CHL.PushByte(program.code, MACHINE.Byte(x, i)) CHL.PushByte(program.code, UTILS.Byte(x, i))
END END
END PutCode32LE; END PutCode32LE;
@ -217,7 +220,6 @@ END SetLabel;
PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
VAR VAR
imp: IMPRT; imp: IMPRT;
i: INTEGER;
BEGIN BEGIN
CHL.PushByte(program.import, 0); CHL.PushByte(program.import, 0);
@ -228,16 +230,9 @@ BEGIN
END; END;
NEW(imp); NEW(imp);
imp.nameoffs := CHL.Length(program.import); imp.nameoffs := CHL.PushStr(program.import, name);
imp.label := label; imp.label := label;
LISTS.push(program.imp_list, imp); LISTS.push(program.imp_list, imp)
i := 0;
WHILE name[i] # 0X DO
CHL.PushByte(program.import, ORD(name[i]));
INC(i)
END;
CHL.PushByte(program.import, 0)
END Import; END Import;
@ -262,19 +257,11 @@ END less;
PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
VAR VAR
exp, cur: EXPRT; exp, cur: EXPRT;
i: INTEGER;
BEGIN BEGIN
NEW(exp); NEW(exp);
exp.nameoffs := CHL.Length(program.export);
exp.label := CHL.GetInt(program.labels, label); exp.label := CHL.GetInt(program.labels, label);
exp.nameoffs := CHL.PushStr(program.export, name);
i := 0;
WHILE name[i] # 0X DO
CHL.PushByte(program.export, ORD(name[i]));
INC(i)
END;
CHL.PushByte(program.export, 0);
cur := program.exp_list.first(EXPRT); cur := program.exp_list.first(EXPRT);
WHILE (cur # NIL) & less(program.export, cur, exp) DO WHILE (cur # NIL) & less(program.export, cur, exp) DO
@ -389,7 +376,7 @@ BEGIN
array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
END; END;
idx := idx + k INC(idx, k)
END InitArray; END InitArray;

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -118,11 +118,46 @@ BEGIN
END PushByte; END PushByte;
PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
VAR
i, res: INTEGER;
BEGIN
res := list.length;
i := 0;
REPEAT
PushByte(list, ORD(str[i]));
INC(i)
UNTIL str[i - 1] = 0X
RETURN res
END PushStr;
PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
VAR
i: INTEGER;
res: BOOLEAN;
BEGIN
res := FALSE;
i := 0;
WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
str[i] := CHR(GetByte(list, pos));
res := str[i] = 0X;
INC(pos);
INC(i)
END
RETURN res
END GetStr;
PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST); PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST);
VAR VAR
chunk: BYTECHUNK; chunk: BYTECHUNK;
BEGIN BEGIN
chunk := list.first(BYTECHUNK); chunk := list.first(BYTECHUNK);
WHILE chunk # NIL DO WHILE chunk # NIL DO
WR.Write(file, chunk.data, chunk.count); WR.Write(file, chunk.data, chunk.count);

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

@ -1,12 +1,12 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE COLLECTIONS; MODULE COLLECTIONS;
TYPE TYPE

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -23,29 +23,39 @@ BEGIN
END String; END String;
PROCEDURE Int* (n: INTEGER); PROCEDURE Int* (x: INTEGER);
VAR VAR
s: ARRAY 32 OF CHAR; s: ARRAY 24 OF CHAR;
BEGIN BEGIN
STRINGS.IntToStr(n, s); STRINGS.IntToStr(x, s);
String(s) String(s)
END Int; END Int;
PROCEDURE Int2* (n: INTEGER); PROCEDURE Hex* (x, n: INTEGER);
VAR
s: ARRAY 24 OF CHAR;
BEGIN BEGIN
IF n < 10 THEN STRINGS.IntToHex(x, s, n);
String(s)
END Hex;
PROCEDURE Int2* (x: INTEGER);
BEGIN
IF x < 10 THEN
String("0") String("0")
END; END;
Int(n) Int(x)
END Int2; END Int2;
PROCEDURE Ln*; PROCEDURE Ln*;
BEGIN BEGIN
String(UTILS.eol) String(UTILS.eol)
END Ln; END Ln;
PROCEDURE StringLn* (s: ARRAY OF CHAR); PROCEDURE StringLn* (s: ARRAY OF CHAR);
@ -55,16 +65,16 @@ BEGIN
END StringLn; END StringLn;
PROCEDURE IntLn* (n: INTEGER); PROCEDURE IntLn* (x: INTEGER);
BEGIN BEGIN
Int(n); Int(x);
Ln Ln
END IntLn; END IntLn;
PROCEDURE Int2Ln* (n: INTEGER); PROCEDURE Int2Ln* (x: INTEGER);
BEGIN BEGIN
Int2(n); Int2(x);
Ln Ln
END Int2Ln; END Int2Ln;

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

@ -9,8 +9,8 @@ MODULE CONSTANTS;
CONST CONST
vMajor* = 0; vMajor* = 1;
vMinor* = 98; vMinor* = 0;
FILE_EXT* = ".ob07"; FILE_EXT* = ".ob07";
RTL_NAME* = "RTL"; RTL_NAME* = "RTL";
@ -26,7 +26,10 @@ CONST
Target_iGUI64* = 7; Target_iGUI64* = 7;
Target_iDLL64* = 8; Target_iDLL64* = 8;
Target_iELF32* = 9; Target_iELF32* = 9;
Target_iELF64* = 10; Target_iELFSO32* = 10;
Target_iELF64* = 11;
Target_iELFSO64* = 12;
Target_iMSP430* = 13;
Target_sConsole* = "console"; Target_sConsole* = "console";
Target_sGUI* = "gui"; Target_sGUI* = "gui";
@ -37,7 +40,10 @@ CONST
Target_sGUI64* = "gui64"; Target_sGUI64* = "gui64";
Target_sDLL64* = "dll64"; Target_sDLL64* = "dll64";
Target_sELF32* = "elfexe"; Target_sELF32* = "elfexe";
Target_sELFSO32* = "elfso";
Target_sELF64* = "elfexe64"; Target_sELF64* = "elfexe64";
Target_sELFSO64* = "elfso64";
Target_sMSP430* = "msp430";
END CONSTANTS. END CONSTANTS.

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

@ -7,7 +7,7 @@
MODULE Compiler; MODULE Compiler;
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER; IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430;
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; PROCEDURE Target (s: ARRAY OF CHAR): INTEGER;
@ -33,8 +33,14 @@ BEGIN
res := mConst.Target_iDLL64 res := mConst.Target_iDLL64
ELSIF s = mConst.Target_sELF32 THEN ELSIF s = mConst.Target_sELF32 THEN
res := mConst.Target_iELF32 res := mConst.Target_iELF32
ELSIF s = mConst.Target_sELFSO32 THEN
res := mConst.Target_iELFSO32
ELSIF s = mConst.Target_sELF64 THEN ELSIF s = mConst.Target_sELF64 THEN
res := mConst.Target_iELF64 res := mConst.Target_iELF64
ELSIF s = mConst.Target_sELFSO64 THEN
res := mConst.Target_iELFSO64
ELSIF s = mConst.Target_sMSP430 THEN
res := mConst.Target_iMSP430
ELSE ELSE
res := 0 res := 0
END END
@ -43,7 +49,7 @@ BEGIN
END Target; END Target;
PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET); PROCEDURE keys (VAR options: PROG.OPTIONS);
VAR VAR
param: PARS.PATH; param: PARS.PATH;
i, j: INTEGER; i, j: INTEGER;
@ -51,8 +57,10 @@ VAR
value: INTEGER; value: INTEGER;
minor, minor,
major: INTEGER; major: INTEGER;
checking: SET;
BEGIN BEGIN
checking := options.checking;
end := FALSE; end := FALSE;
i := 4; i := 4;
REPEAT REPEAT
@ -62,7 +70,7 @@ BEGIN
INC(i); INC(i);
UTILS.GetArg(i, param); UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
StackSize := value options.stack := value
END; END;
IF param[0] = "-" THEN IF param[0] = "-" THEN
DEC(i) DEC(i)
@ -72,7 +80,27 @@ BEGIN
INC(i); INC(i);
UTILS.GetArg(i, param); UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN IF STRINGS.StrToInt(param, value) THEN
BaseAddress := ((value DIV 64) * 64) * 1024 options.base := ((value DIV 64) * 64) * 1024
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-ram" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.ram := value
END;
IF param[0] = "-" THEN
DEC(i)
END
ELSIF param = "-rom" THEN
INC(i);
UTILS.GetArg(i, param);
IF STRINGS.StrToInt(param, value) THEN
options.rom := value
END; END;
IF param[0] = "-" THEN IF param[0] = "-" THEN
DEC(i) DEC(i)
@ -109,32 +137,34 @@ BEGIN
END; END;
INC(j) INC(j)
END END;
END END
ELSIF param = "-ver" THEN ELSIF param = "-ver" THEN
INC(i); INC(i);
UTILS.GetArg(i, param); UTILS.GetArg(i, param);
IF STRINGS.StrToVer(param, major, minor) THEN IF STRINGS.StrToVer(param, major, minor) THEN
Version := major * 65536 + minor options.version := major * 65536 + minor
END; END;
IF param[0] = "-" THEN IF param[0] = "-" THEN
DEC(i) DEC(i)
END END
ELSIF param = "-pic" THEN ELSIF param = "-pic" THEN
pic := TRUE options.pic := TRUE
ELSIF param = "" THEN ELSIF param = "" THEN
end := TRUE end := TRUE
ELSE ELSE
ERRORS.error3("bad parameter: ", param, "") ERRORS.BadParam(param)
END; END;
INC(i) INC(i)
UNTIL end UNTIL end;
options.checking := checking
END keys; END keys;
@ -149,38 +179,34 @@ VAR
outname: PARS.PATH; outname: PARS.PATH;
param: PARS.PATH; param: PARS.PATH;
temp: PARS.PATH; temp: PARS.PATH;
target: INTEGER; target: INTEGER;
bit_depth: INTEGER;
time: INTEGER; time: INTEGER;
options: PROG.OPTIONS;
StackSize,
Version,
BaseAdr: INTEGER;
pic: BOOLEAN;
checking: SET;
bits64: BOOLEAN;
BEGIN BEGIN
StackSize := 2; options.stack := 2;
Version := 65536; options.version := 65536;
pic := FALSE; options.pic := FALSE;
checking := ST.chkALL; options.checking := ST.chkALL;
PATHS.GetCurrentDirectory(app_path); PATHS.GetCurrentDirectory(app_path);
lib_path := app_path; lib_path := app_path;
UTILS.GetArg(1, inname); UTILS.GetArg(1, inname);
C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)");
C.StringLn("Copyright (c) 2018-2019, Anton Krotov");
IF inname = "" THEN IF inname = "" THEN
C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); C.Ln;
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln;
C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln; C.StringLn("Usage: Compiler <main module> <output> <target> [optional settings]"); C.Ln;
IF UTILS.bit_depth = 64 THEN IF UTILS.bit_depth = 64 THEN
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln; C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln;
ELSIF UTILS.bit_depth = 32 THEN ELSIF UTILS.bit_depth = 32 THEN
C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln; C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln;
END; END;
C.StringLn("optional settings:"); C.Ln; C.StringLn("optional settings:"); C.Ln;
C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln; C.StringLn(" -stk <size> set size of stack in megabytes"); C.Ln;
@ -188,14 +214,17 @@ BEGIN
C.StringLn(' -ver <major.minor> set version of program'); C.Ln; C.StringLn(' -ver <major.minor> set version of program'); C.Ln;
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,');
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; C.StringLn(' BYTE, CHR, WCHR)'); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430)"); C.Ln;
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430)"); C.Ln;
UTILS.Exit(0) UTILS.Exit(0)
END; END;
PATHS.split(inname, path, modname, ext); PATHS.split(inname, path, modname, ext);
IF ext # mConst.FILE_EXT THEN IF ext # mConst.FILE_EXT THEN
ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"') ERRORS.Error(207)
END; END;
IF PATHS.isRelative(path) THEN IF PATHS.isRelative(path) THEN
PATHS.RelPath(app_path, path, temp); PATHS.RelPath(app_path, path, temp);
path := temp path := temp
@ -203,7 +232,7 @@ BEGIN
UTILS.GetArg(2, outname); UTILS.GetArg(2, outname);
IF outname = "" THEN IF outname = "" THEN
ERRORS.error1("not enough parameters") ERRORS.Error(205)
END; END;
IF PATHS.isRelative(outname) THEN IF PATHS.isRelative(outname) THEN
PATHS.RelPath(app_path, outname, temp); PATHS.RelPath(app_path, outname, temp);
@ -212,59 +241,70 @@ BEGIN
UTILS.GetArg(3, param); UTILS.GetArg(3, param);
IF param = "" THEN IF param = "" THEN
ERRORS.error1("not enough parameters") ERRORS.Error(205)
END; END;
target := Target(param); target := Target(param);
IF target = 0 THEN IF target = 0 THEN
ERRORS.error1("bad parameter <target>") ERRORS.Error(206)
END; END;
bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; CASE target OF
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64:
IF bits64 THEN bit_depth := 64
IF UTILS.bit_depth = 32 THEN |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL,
ERRORS.error1("bad parameter <target>") mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32:
END; bit_depth := 32
PARS.init(64, target) |mConst.Target_iMSP430:
ELSE bit_depth := 16;
PARS.init(32, target) options.ram := MSP430.minRAM;
options.rom := MSP430.minROM
END; END;
PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64}; IF UTILS.bit_depth < bit_depth THEN
PARS.program.obj := target = mConst.Target_iObject; ERRORS.Error(206)
END;
STRINGS.append(lib_path, "lib"); STRINGS.append(lib_path, "lib");
STRINGS.append(lib_path, UTILS.slash); STRINGS.append(lib_path, UTILS.slash);
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN CASE target OF
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL:
IF target = mConst.Target_iDLL THEN IF target = mConst.Target_iDLL THEN
BaseAdr := 10000000H options.base := 10000000H
ELSE ELSE
BaseAdr := 400000H options.base := 400000H
END; END;
STRINGS.append(lib_path, "Windows32") STRINGS.append(lib_path, "Windows32")
ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN |mConst.Target_iKolibri, mConst.Target_iObject:
STRINGS.append(lib_path, "KolibriOS") STRINGS.append(lib_path, "KolibriOS")
ELSIF target = mConst.Target_iELF32 THEN |mConst.Target_iELF32, mConst.Target_iELFSO32:
STRINGS.append(lib_path, "Linux32") STRINGS.append(lib_path, "Linux32")
ELSIF target = mConst.Target_iELF64 THEN |mConst.Target_iELF64, mConst.Target_iELFSO64:
STRINGS.append(lib_path, "Linux64") STRINGS.append(lib_path, "Linux64")
ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64:
STRINGS.append(lib_path, "Windows64") STRINGS.append(lib_path, "Windows64")
|mConst.Target_iMSP430:
STRINGS.append(lib_path, "MSP430")
END; END;
STRINGS.append(lib_path, UTILS.slash); STRINGS.append(lib_path, UTILS.slash);
keys(StackSize, BaseAdr, Version, pic, checking); keys(options);
ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking); PARS.init(bit_depth, target, options);
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject};
PARS.program.obj := target = mConst.Target_iObject;
ST.compile(path, lib_path, modname, outname, target, options);
time := UTILS.GetTickCount() - UTILS.time; time := UTILS.GetTickCount() - UTILS.time;

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

@ -7,7 +7,7 @@
MODULE ELF; MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS; IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
CONST CONST
@ -68,9 +68,35 @@ TYPE
END; END;
Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
d_tag, d_val: INTEGER
END;
Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
name, value, size: INTEGER;
info, other: CHAR;
shndx: WCHAR
END;
FILE = WR.FILE; FILE = WR.FILE;
VAR
dynamic: LISTS.LIST;
strtab: CHL.BYTELIST;
symtab: LISTS.LIST;
hashtab, bucket, chain: CHL.INTLIST;
PROCEDURE align (n, _align: INTEGER): INTEGER; PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN BEGIN
IF n MOD _align # 0 THEN IF n MOD _align # 0 THEN
@ -136,7 +162,75 @@ BEGIN
END fixup; END fixup;
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN); PROCEDURE NewDyn (tag, val: INTEGER);
VAR
dyn: Elf32_Dyn;
BEGIN
NEW(dyn);
dyn.d_tag := tag;
dyn.d_val := val;
LISTS.push(dynamic, dyn)
END NewDyn;
PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
VAR
sym: Elf32_Sym;
BEGIN
NEW(sym);
sym.name := name;
sym.value := value;
sym.size := size;
sym.info := info;
sym.other := other;
sym.shndx := shndx;
LISTS.push(symtab, sym)
END NewSym;
PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER;
VAR
i, h: INTEGER;
g: SET;
BEGIN
h := 0;
i := 0;
WHILE name[i] # 0X DO
h := h * 16 + ORD(name[i]);
g := BITS(h) * {28..31};
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
INC(i)
END
RETURN h
END HashStr;
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
VAR
symi, hi, k: INTEGER;
BEGIN
FOR symi := 0 TO symCount - 1 DO
CHL.SetInt(chain, symi, 0);
hi := CHL.GetInt(hashtab, symi) MOD symCount;
IF CHL.GetInt(bucket, hi) # 0 THEN
k := symi;
WHILE CHL.GetInt(chain, k) # 0 DO
k := CHL.GetInt(chain, k)
END;
CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
END;
CHL.SetInt(bucket, hi, symi)
END
END MakeHash;
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
CONST CONST
interp = 0; interp = 0;
dyn = 1; dyn = 1;
@ -145,33 +239,67 @@ CONST
data = 4; data = 4;
bss = 5; bss = 5;
linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
linuxInterpreter32 = "/lib/ld-linux.so.2";
exeBaseAddress32 = 8048000H;
exeBaseAddress64 = 400000H;
dllBaseAddress = 0;
DT_NULL = 0;
DT_NEEDED = 1;
DT_HASH = 4;
DT_STRTAB = 5;
DT_SYMTAB = 6;
DT_RELA = 7;
DT_RELASZ = 8;
DT_RELAENT = 9;
DT_STRSZ = 10;
DT_SYMENT = 11;
DT_INIT = 12;
DT_FINI = 13;
DT_SONAME = 14;
DT_REL = 17;
DT_RELSZ = 18;
DT_RELENT = 19;
VAR VAR
ehdr: Elf32_Ehdr; ehdr: Elf32_Ehdr;
phdr: ARRAY 16 OF Elf32_Phdr; phdr: ARRAY 16 OF Elf32_Phdr;
i, LoadAdr, offset, pad, VA: INTEGER; i, BaseAdr, offset, pad, VA, symCount: INTEGER;
SizeOf: RECORD header, code, data, bss: INTEGER END; SizeOf: RECORD header, code, data, bss: INTEGER END;
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
File: FILE; File: FILE;
str: ARRAY 40 OF CHAR; lstr: INTEGER; Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
Dyn: ARRAY 350 OF BYTE;
item: LISTS.ITEM;
Name: ARRAY 2048 OF CHAR;
BEGIN BEGIN
IF amd64 THEN dynamic := LISTS.create(NIL);
str := "/lib64/ld-linux-x86-64.so.2" symtab := LISTS.create(NIL);
ELSE strtab := CHL.CreateByteList();
str := "/lib/ld-linux.so.2"
END;
lstr := LENGTH(str);
IF amd64 THEN IF amd64 THEN
LoadAdr := 400000H BaseAdr := exeBaseAddress64;
Interpreter := linuxInterpreter64
ELSE ELSE
LoadAdr := 08048000H BaseAdr := exeBaseAddress32;
Interpreter := linuxInterpreter32
END; END;
IF so THEN
BaseAdr := dllBaseAddress
END;
lenInterpreter := LENGTH(Interpreter) + 1;
SizeOf.code := CHL.Length(program.code); SizeOf.code := CHL.Length(program.code);
SizeOf.data := CHL.Length(program.data); SizeOf.data := CHL.Length(program.data);
SizeOf.bss := program.bss; SizeOf.bss := program.bss;
@ -192,7 +320,12 @@ BEGIN
ehdr.e_ident[i] := 0 ehdr.e_ident[i] := 0
END; END;
ehdr.e_type := WCHR(ET_EXEC); IF so THEN
ehdr.e_type := WCHR(ET_DYN)
ELSE
ehdr.e_type := WCHR(ET_EXEC)
END;
ehdr.e_version := 1; ehdr.e_version := 1;
ehdr.e_shoff := 0; ehdr.e_shoff := 0;
ehdr.e_flags := 0; ehdr.e_flags := 0;
@ -218,24 +351,92 @@ BEGIN
phdr[interp].p_type := 3; phdr[interp].p_type := 3;
phdr[interp].p_offset := SizeOf.header; phdr[interp].p_offset := SizeOf.header;
phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset; phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset; phdr[interp].p_paddr := phdr[interp].p_vaddr;
phdr[interp].p_filesz := lstr + 1; phdr[interp].p_filesz := lenInterpreter;
phdr[interp].p_memsz := lstr + 1; phdr[interp].p_memsz := lenInterpreter;
phdr[interp].p_flags := PF_R; phdr[interp].p_flags := PF_R;
phdr[interp].p_align := 1; phdr[interp].p_align := 1;
phdr[dyn].p_type := 2; phdr[dyn].p_type := 2;
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz; phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset; phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset; phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
IF amd64 THEN
phdr[dyn].p_filesz := 0A0H; hashtab := CHL.CreateIntList();
phdr[dyn].p_memsz := 0A0H
ELSE CHL.PushInt(hashtab, HashStr(""));
phdr[dyn].p_filesz := 50H; NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
phdr[dyn].p_memsz := 50H CHL.PushInt(hashtab, HashStr("dlopen"));
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
CHL.PushInt(hashtab, HashStr("dlsym"));
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
IF so THEN
item := program.exp_list.first;
WHILE item # NIL DO
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
CHL.PushInt(hashtab, HashStr(Name));
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
item := item.next
END;
ASSERT(CHL.GetStr(program.data, program.modname, Name))
END; END;
symCount := LISTS.count(symtab);
bucket := CHL.CreateIntList();
chain := CHL.CreateIntList();
FOR i := 1 TO symCount DO
CHL.PushInt(bucket, 0);
CHL.PushInt(chain, 0)
END;
MakeHash(bucket, chain, symCount);
NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
NewDyn(DT_STRTAB, 0);
NewDyn(DT_STRSZ, CHL.Length(strtab));
NewDyn(DT_SYMTAB, 0);
IF amd64 THEN
NewDyn(DT_SYMENT, 24);
NewDyn(DT_RELA, 0);
NewDyn(DT_RELASZ, 48);
NewDyn(DT_RELAENT, 24)
ELSE
NewDyn(DT_SYMENT, 16);
NewDyn(DT_REL, 0);
NewDyn(DT_RELSZ, 16);
NewDyn(DT_RELENT, 8)
END;
NewDyn(DT_HASH, 0);
IF so THEN
NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
NewDyn(DT_INIT, 0);
NewDyn(DT_FINI, 0)
END;
NewDyn(DT_NULL, 0);
Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
Offset.dyn := phdr[dyn].p_offset;
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr;
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr;
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
phdr[dyn].p_memsz := phdr[dyn].p_filesz;
phdr[dyn].p_flags := PF_R; phdr[dyn].p_flags := PF_R;
phdr[dyn].p_align := 1; phdr[dyn].p_align := 1;
@ -243,20 +444,15 @@ BEGIN
phdr[header].p_type := 1; phdr[header].p_type := 1;
phdr[header].p_offset := offset; phdr[header].p_offset := offset;
phdr[header].p_vaddr := LoadAdr; phdr[header].p_vaddr := BaseAdr;
phdr[header].p_paddr := LoadAdr; phdr[header].p_paddr := BaseAdr;
IF amd64 THEN phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
phdr[header].p_filesz := 305H; phdr[header].p_memsz := phdr[header].p_filesz;
phdr[header].p_memsz := 305H
ELSE
phdr[header].p_filesz := 1D0H;
phdr[header].p_memsz := 1D0H
END;
phdr[header].p_flags := PF_R + PF_W; phdr[header].p_flags := PF_R + PF_W;
phdr[header].p_align := 1000H; phdr[header].p_align := 1000H;
offset := offset + phdr[header].p_filesz; offset := offset + phdr[header].p_filesz;
VA := LoadAdr + offset + 1000H; VA := BaseAdr + offset + 1000H;
phdr[text].p_type := 1; phdr[text].p_type := 1;
phdr[text].p_offset := offset; phdr[text].p_offset := offset;
@ -268,9 +464,9 @@ BEGIN
phdr[text].p_align := 1000H; phdr[text].p_align := 1000H;
ehdr.e_entry := phdr[text].p_vaddr; ehdr.e_entry := phdr[text].p_vaddr;
offset := offset + phdr[text].p_filesz; offset := offset + phdr[text].p_filesz;
VA := LoadAdr + offset + 2000H; VA := BaseAdr + offset + 2000H;
pad := (16 - VA MOD 16) MOD 16; pad := (16 - VA MOD 16) MOD 16;
phdr[data].p_type := 1; phdr[data].p_type := 1;
@ -281,9 +477,9 @@ BEGIN
phdr[data].p_memsz := SizeOf.data + pad; phdr[data].p_memsz := SizeOf.data + pad;
phdr[data].p_flags := PF_R + PF_W; phdr[data].p_flags := PF_R + PF_W;
phdr[data].p_align := 1000H; phdr[data].p_align := 1000H;
offset := offset + phdr[data].p_filesz; offset := offset + phdr[data].p_filesz;
VA := LoadAdr + offset + 3000H; VA := BaseAdr + offset + 3000H;
phdr[bss].p_type := 1; phdr[bss].p_type := 1;
phdr[bss].p_offset := offset; phdr[bss].p_offset := offset;
@ -294,7 +490,20 @@ BEGIN
phdr[bss].p_flags := PF_R + PF_W; phdr[bss].p_flags := PF_R + PF_W;
phdr[bss].p_align := 1000H; phdr[bss].p_align := 1000H;
fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64);
item := symtab.first;
WHILE item # NIL DO
IF item(Elf32_Sym).value # 0 THEN
INC(item(Elf32_Sym).value, ehdr.e_entry)
END;
item := item.next
END;
IF so THEN
item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
END;
File := WR.Create(FileName); File := WR.Create(FileName);
@ -340,34 +549,94 @@ BEGIN
WritePH(File, phdr[bss]) WritePH(File, phdr[bss])
END; END;
FOR i := 0 TO lstr DO FOR i := 0 TO lenInterpreter - 1 DO
WR.WriteByte(File, ORD(str[i])) WR.WriteByte(File, ORD(Interpreter[i]))
END; END;
i := 0; i := 0;
IF amd64 THEN IF amd64 THEN
BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000"); item := dynamic.first;
BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000"); WHILE item # NIL DO
BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000"); WR.Write64LE(File, item(Elf32_Dyn).d_tag);
BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000"); WR.Write64LE(File, item(Elf32_Dyn).d_val);
BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000"); item := item.next
BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000"); END;
BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000");
BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000");
BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000");
BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69");
BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000")
ELSE
BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408");
BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000");
BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000");
BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000");
BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000");
BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32");
BIN.InitArray(Dyn, i, "000000000000000000")
END;
WR.Write(File, Dyn, i); item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
WR.Write64LE(File, item(Elf32_Sym).value);
WR.Write64LE(File, item(Elf32_Sym).size);
item := item.next
END;
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16);
WR.Write32LE(File, 1);
WR.Write32LE(File, 1);
WR.Write64LE(File, 0);
WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 1);
WR.Write32LE(File, 2);
WR.Write64LE(File, 0);
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write64LE(File, 0);
WR.Write64LE(File, 0)
ELSE
item := dynamic.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Dyn).d_tag);
WR.Write32LE(File, item(Elf32_Dyn).d_val);
item := item.next
END;
item := symtab.first;
WHILE item # NIL DO
WR.Write32LE(File, item(Elf32_Sym).name);
WR.Write32LE(File, item(Elf32_Sym).value);
WR.Write32LE(File, item(Elf32_Sym).size);
WR.WriteByte(File, ORD(item(Elf32_Sym).info));
WR.WriteByte(File, ORD(item(Elf32_Sym).other));
Write16(File, item(Elf32_Sym).shndx);
item := item.next
END;
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8);
WR.Write32LE(File, 00000101H);
WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4);
WR.Write32LE(File, 00000201H);
WR.Write32LE(File, symCount);
WR.Write32LE(File, symCount);
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(bucket, i))
END;
FOR i := 0 TO symCount - 1 DO
WR.Write32LE(File, CHL.GetInt(chain, i))
END;
CHL.WriteToFile(File, strtab);
WR.Write32LE(File, 0);
WR.Write32LE(File, 0)
END;
CHL.WriteToFile(File, program.code); CHL.WriteToFile(File, program.code);
WHILE pad > 0 DO WHILE pad > 0 DO

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

@ -7,25 +7,35 @@
MODULE ERRORS; MODULE ERRORS;
IMPORT C := CONSOLE, UTILS; IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS;
PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
BEGIN BEGIN
IF hint = 0 THEN IF hint = 0 THEN
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")"); C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
C.String(" variable '"); C.String(name); C.StringLn("' never used") C.String("variable '"); C.String(name); C.StringLn("' never used")
END END
END hintmsg; END HintMsg;
PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); PROCEDURE WarningMsg* (line, col, warning: INTEGER);
BEGIN
C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
CASE warning OF
|0: C.StringLn("passing a string value as a fixed array")
|1: C.StringLn("endless FOR loop")
END
END WarningMsg;
PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
VAR VAR
str: ARRAY 80 OF CHAR; str: ARRAY 80 OF CHAR;
BEGIN BEGIN
C.Ln; C.Ln;
C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
CASE errno OF CASE errno OF
| 1: str := "missing 'H' or 'X'" | 1: str := "missing 'H' or 'X'"
@ -36,6 +46,7 @@ BEGIN
| 6: str := "identifier too long" | 6: str := "identifier too long"
| 7: str := "number too long" | 7: str := "number too long"
| 8..12: str := "number too large" | 8..12: str := "number too large"
| 13: str := "real numbers not supported"
| 21: str := "'MODULE' expected" | 21: str := "'MODULE' expected"
| 22: str := "identifier expected" | 22: str := "identifier expected"
@ -79,7 +90,7 @@ BEGIN
| 60: str := "identifier does not match procedure name" | 60: str := "identifier does not match procedure name"
| 61: str := "illegally marked identifier" | 61: str := "illegally marked identifier"
| 62: str := "expression should be constant" | 62: str := "expression should be constant"
| 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected" | 63: str := "not enough RAM"
| 64: str := "'(' expected" | 64: str := "'(' expected"
| 65: str := "',' expected" | 65: str := "',' expected"
| 66: str := "incompatible parameter" | 66: str := "incompatible parameter"
@ -126,46 +137,81 @@ BEGIN
|107: str := "too large parameter of CHR" |107: str := "too large parameter of CHR"
|108: str := "a variable or a procedure expected" |108: str := "a variable or a procedure expected"
|109: str := "expression should be constant" |109: str := "expression should be constant"
|110: str := "'noalign' expected"
|111: str := "record [noalign] cannot have a base type" |111: str := "record [noalign] cannot have a base type"
|112: str := "record [noalign] cannot be a base type" |112: str := "record [noalign] cannot be a base type"
|113: str := "result type of procedure should not be REAL" |113: str := "result type of procedure should not be REAL"
|114: str := "identifiers 'lib_init' and 'version' are reserved" |114: str := "identifiers 'lib_init' and 'version' are reserved"
|115: str := "recursive constant definition" |115: str := "recursive constant definition"
|116: str := "procedure too deep nested" |116: str := "procedure too deep nested"
|117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected"
|118: str := "this flag for Windows only"
|119: str := "this flag for Linux only"
|120: str := "too many formal parameters" |120: str := "too many formal parameters"
|122: str := "negative divisor"
|123: str := "illegal flag"
|124: str := "unknown flag"
|125: str := "flag not supported"
END; END;
C.StringLn(str); C.StringLn(str);
C.String(" file: "); C.StringLn(fname); C.String(" file: "); C.StringLn(fname);
UTILS.Exit(1) UTILS.Exit(1)
END errormsg; END ErrorMsg;
PROCEDURE error1* (s1: ARRAY OF CHAR); PROCEDURE Error1 (s1: ARRAY OF CHAR);
BEGIN BEGIN
C.Ln; C.Ln;
C.StringLn(s1); C.StringLn(s1);
UTILS.Exit(1) UTILS.Exit(1)
END error1; END Error1;
PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR); PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
BEGIN BEGIN
C.Ln; C.Ln;
C.String(s1); C.String(s2); C.StringLn(s3); C.String(s1); C.String(s2); C.StringLn(s3);
UTILS.Exit(1) UTILS.Exit(1)
END error3; END Error3;
PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR); PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
BEGIN BEGIN
C.Ln; C.Ln;
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5); C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
UTILS.Exit(1) UTILS.Exit(1)
END error5; END Error5;
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
BEGIN
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found")
END WrongRTL;
PROCEDURE BadParam* (param: ARRAY OF CHAR);
BEGIN
Error3("bad parameter: ", param, "")
END BadParam;
PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
BEGIN
Error5("file ", Path, Name, Ext, " not found")
END FileNotFound;
PROCEDURE Error* (n: INTEGER);
BEGIN
CASE n OF
|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")
|205: Error1("not enough parameters")
|206: Error1("bad parameter <target>")
|207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"')
END
END Error;
END ERRORS. END ERRORS.

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

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

1182
programs/develop/oberon07/Source/IL.ob07 Normal file
View File

File diff suppressed because it is too large Load Diff

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -197,7 +197,7 @@ BEGIN
WR.Write32LE(File, header.sp); WR.Write32LE(File, header.sp);
WR.Write32LE(File, header.param); WR.Write32LE(File, header.param);
WR.Write32LE(File, header.path); WR.Write32LE(File, header.path);
CHL.WriteToFile(File, program.code); CHL.WriteToFile(File, program.code);
WR.Padding(File, FileAlignment); WR.Padding(File, FileAlignment);
@ -206,8 +206,8 @@ BEGIN
FOR i := 0 TO ILen - 1 DO FOR i := 0 TO ILen - 1 DO
WR.Write32LE(File, CHL.GetInt(ImportTable, i)) WR.Write32LE(File, CHL.GetInt(ImportTable, i))
END; END;
CHL.WriteToFile(File, program.import); CHL.WriteToFile(File, program.import);
WR.Close(File) WR.Close(File)

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -168,14 +168,32 @@ BEGIN
END count; END count;
PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
VAR
item: ITEM;
BEGIN
ASSERT(list # NIL);
ASSERT(idx >= 0);
item := list.first;
WHILE (item # NIL) & (idx > 0) DO
item := item.next;
DEC(idx)
END
RETURN item
END getidx;
PROCEDURE create* (list: LIST): LIST; PROCEDURE create* (list: LIST): LIST;
BEGIN BEGIN
IF list = NIL THEN IF list = NIL THEN
NEW(list) NEW(list)
END; END;
list.first := NIL; list.first := NIL;
list.last := NIL list.last := NIL
RETURN list RETURN list
END create; END create;

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -136,7 +136,7 @@ VAR
PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER); PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
BEGIN BEGIN
IF NumberOfRelocations >= 65536 THEN IF NumberOfRelocations >= 65536 THEN
ERRORS.error1("too many relocations") ERRORS.Error(202)
END; END;
section.NumberOfRelocations := WCHR(NumberOfRelocations) section.NumberOfRelocations := WCHR(NumberOfRelocations)
END SetNumberOfRelocations; END SetNumberOfRelocations;

1793
programs/develop/oberon07/Source/MSP430.ob07 Normal file
View File

File diff suppressed because it is too large Load Diff

677
programs/develop/oberon07/Source/MSP430RTL.ob07 Normal file
View File

@ -0,0 +1,677 @@
(*
BSD 2-Clause License
Copyright (c) 2019, Anton Krotov
All rights reserved.
*)
MODULE MSP430RTL;
CONST
_mul* = 0;
_divmod* = 1;
_lsl* = 2;
_asr* = 3;
_ror* = 4;
_lsr* = 5;
_in* = 6;
_in2* = 7;
_set1* = 8;
_incl* = 9;
_excl* = 10;
_move* = 11;
_set* = 12;
_arrcpy* = 13;
_rot* = 14;
_strcmp* = 15;
_error* = 16;
_is* = 17;
_guard* = 18;
_guardrec* = 19;
_length* = 20;
_new* = 21;
HP = 14;
LenIV* = 32;
iv = 10000H - LenIV * 2;
sp = iv - 2;
empty_proc* = sp - 2;
free_size = empty_proc - 2;
free_adr = free_size - 2;
bits = free_adr - 272;
bits_offs = bits - 32;
DataSize* = iv - bits_offs;
types = bits_offs - 2;
IntVectorSize* = LenIV * 2 + DataSize;
VarSize* = 4;
TYPE
EMITPROC = PROCEDURE (n: INTEGER);
VAR
ram*, trap*, int*: INTEGER;
rtl*: ARRAY 22 OF
RECORD
label*: INTEGER;
used: BOOLEAN
END;
Label, Word, Call: EMITPROC;
PROCEDURE Gen*;
PROCEDURE Word1 (word: INTEGER);
BEGIN
Word(word)
END Word1;
PROCEDURE Word2 (word1, word2: INTEGER);
BEGIN
Word1(word1);
Word1(word2)
END Word2;
PROCEDURE Word3 (word1, word2, word3: INTEGER);
BEGIN
Word1(word1);
Word1(word2);
Word1(word3)
END Word3;
BEGIN
(* _lsl (n, x: INTEGER): INTEGER *)
IF rtl[_lsl].used THEN
Label(rtl[_lsl].label);
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
Word2(0F035H, 15); (* AND #15, R5 *)
Word1(2400H + 3); (* JZ L1 *)
(* L2: *)
Word1(5404H); (* ADD R4, R4 *)
Word1(8315H); (* SUB #1, R5 *)
Word1(2000H + 400H - 3); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _asr (n, x: INTEGER): INTEGER *)
IF rtl[_asr].used THEN
Label(rtl[_asr].label);
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
Word2(0F035H, 15); (* AND #15, R5 *)
Word1(2400H + 3); (* JZ L1 *)
(* L2: *)
Word1(1104H); (* RRA R4 *)
Word1(8315H); (* SUB #1, R5 *)
Word1(2000H + 400H - 3); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _ror (n, x: INTEGER): INTEGER *)
IF rtl[_ror].used THEN
Label(rtl[_ror].label);
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
Word2(0F035H, 15); (* AND #15, R5 *)
Word1(2400H + 5); (* JZ L1 *)
Word1(4406H); (* MOV R4, R6 *)
(* L2: *)
Word1(1006H); (* RRC R6 *)
Word1(1004H); (* RRC R4 *)
Word1(8315H); (* SUB #1, R5 *)
Word1(2000H + 400H - 4); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _lsr (n, x: INTEGER): INTEGER *)
IF rtl[_lsr].used THEN
Label(rtl[_lsr].label);
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
Word2(0F035H, 15); (* AND #15, R5 *)
Word1(2400H + 4); (* JZ L1 *)
(* L2: *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1004H); (* RRC R4 *)
Word1(8315H); (* SUB #1, R5 *)
Word1(2000H + 400H - 4); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _set (b, a: INTEGER): SET *)
IF rtl[_set].used THEN
Label(rtl[_set].label);
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
Word1(9504H); (* CMP R5, R4 *)
Word1(3800H + 24); (* JL L1 *)
Word2(9035H, 16); (* CMP #16, R5 *)
Word1(3400H + 21); (* JGE L1 *)
Word1(9304H); (* CMP #0, R4 *)
Word1(3800H + 19); (* JL L1 *)
Word2(9034H, 16); (* CMP #16, R4 *)
Word1(3800H + 2); (* JL L2 *)
Word2(4034H, 15); (* MOV #15, R4 *)
(* L2: *)
Word1(9305H); (* CMP #0, R5 *)
Word1(3400H + 1); (* JGE L3 *)
Word1(4305H); (* MOV #0, R5 *)
(* L3: *)
Word1(8504H); (* SUB R5, R4 *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits_offs); (* ADD bits_offs, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word1(5505H); (* ADD R5, R5 *)
Word1(5405H); (* ADD R4, R5 *)
Word2(5035H, bits); (* ADD bits, R5 *)
Word1(4524H); (* MOV @R5, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
END;
(* _set1 (a: INTEGER): SET *)
IF rtl[_set1].used THEN
Label(rtl[_set1].label);
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *)
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
Word1(2000H + 5); (* JNZ L1 *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
(* L1: *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
END;
(* _in2 (i, s: INTEGER): BOOLEAN *)
IF rtl[_in2].used THEN
Label(rtl[_in2].label);
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word2(0F114H, 4); (* AND 4(SP), R4 *)
Word1(2400H + 1); (* JZ L1 *)
Word1(4314H); (* MOV #1, R4 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _in (s, i: INTEGER): BOOLEAN *)
IF rtl[_in].used THEN
Label(rtl[_in].label);
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
Word1(2000H + 9); (* JNZ L2 *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word2(0F114H, 2); (* AND 2(SP), R4 *)
Word1(2400H + 3); (* JZ L1 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
(* L2: *)
Word1(4304H); (* MOV #0, R4 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _incl (VAR s: SET; i: INTEGER) *)
IF rtl[_incl].used THEN
Label(rtl[_incl].label);
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
Word1(2000H + 8); (* JNZ L1 *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
Word2(0D485H, 0); (* BIS R4, 0(R5) *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _excl (VAR s: SET; i: INTEGER) *)
IF rtl[_excl].used THEN
Label(rtl[_excl].label);
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
Word1(2000H + 8); (* JNZ L1 *)
Word1(5404H); (* ADD R4, R4 *)
Word2(5034H, bits); (* ADD bits, R4 *)
Word1(4424H); (* MOV @R4, R4 *)
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
Word2(0C485H, 0); (* BIC R4, 0(R5) *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _rot (len, adr: INTEGER) *)
IF rtl[_rot].used THEN
Label(rtl[_rot].label);
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *)
Word1(8314H); (* SUB #1, R4 *)
Word1(5404H); (* ADD R4, R4 *)
Word1(1225H); (* PUSH @R5 *)
Word1(4406H); (* MOV R4, R6 *)
(* L1: *)
Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *)
Word1(5325H); (* ADD #2, R5 *)
Word1(8326H); (* SUB #2, R6 *)
Word1(2000H + 400H - 6); (* JNZ L1 *)
Word2(41B5H, 0); (* MOV @SP+, 0(R5) *)
Word1(4130H) (* RET *)
END;
(* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *)
IF rtl[_divmod].used THEN
Label(rtl[_divmod].label);
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
Word1(4304H); (* MOV #0, R4 *)
(* L1: *)
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
Word1(9605H); (* CMP R6, R5 *)
Word1(3800H + 17); (* JL L3 *)
Word1(4327H); (* MOV #2, R7 *)
Word1(5606H); (* ADD R6, R6 *)
(* L4: *)
Word1(9306H); (* CMP #0, R6 *)
Word1(2400H + 6); (* JZ L2 *)
Word1(3800H + 5); (* JL L2 *)
Word1(9605H); (* CMP R6, R5 *)
Word1(3800H + 3); (* JL L2 *)
Word1(5606H); (* ADD R6, R6 *)
Word1(5707H); (* ADD R7, R7 *)
Word1(3C00H + 400H - 8); (* JMP L4 *)
(* L2: *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1006H); (* RRC R6 *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1007H); (* RRC R7 *)
Word1(8605H); (* SUB R6, R5 *)
Word1(5704H); (* ADD R7, R4 *)
Word1(3C00H + 400H - 21); (* JMP L1 *)
(* L3: *)
(*----------- (a < 0) --------------*)
(* L1: *)
Word1(9305H); (* CMP #0, R5 *)
Word1(3400H + 23); (* JGE L3 *)
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
Word1(4327H); (* MOV #2, R7 *)
Word1(5606H); (* ADD R6, R6 *)
Word1(0E335H); (* XOR #-1, R5 *)
Word1(5315H); (* ADD #1, R5 *)
(* L4: *)
Word1(9306H); (* CMP #0, R6 *)
Word1(2400H + 6); (* JZ L2 *)
Word1(3800H + 5); (* JL L2 *)
Word1(9605H); (* CMP R6, R5 *)
Word1(3800H + 3); (* JL L2 *)
Word1(5606H); (* ADD R6, R6 *)
Word1(5707H); (* ADD R7, R7 *)
Word1(3C00H + 400H - 8); (* JMP L4 *)
(* L2: *)
Word1(0E335H); (* XOR #-1, R5 *)
Word1(5315H); (* ADD #1, R5 *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1006H); (* RRC R6 *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1007H); (* RRC R7 *)
Word1(5605H); (* ADD R6, R5 *)
Word1(8704H); (* SUB R7, R4 *)
Word1(3C00H + 400H - 25); (* JMP L1 *)
(* L3: *)
Word1(4130H) (* RET *)
END;
(* _mul (a, b: INTEGER): INTEGER *)
IF rtl[_mul].used THEN
Label(rtl[_mul].label);
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *)
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *)
Word1(4304H); (* MOV #0, R4; res := 0 *)
Word1(9306H); (* CMP #0, R6 *)
Word1(2400H + 7); (* JZ L1 *)
(* L2: *)
Word1(0B316H); (* BIT #1, R6 *)
Word1(2400H + 1); (* JZ L3 *)
Word1(5504H); (* ADD R5, R4 *)
(* L3: *)
Word1(5505H); (* ADD R5, R5 *)
Word1(0C312H); (* BIC #1, SR *)
Word1(1006H); (* RRC R6 *)
Word1(2000H + 400H - 7); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _error (module, err, line: INTEGER) *)
IF rtl[_error].used THEN
Label(rtl[_error].label);
Word1(0C232H); (* BIC #8, SR; DINT *)
Word1(4303H); (* MOV R3, R3; NOP *)
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *)
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *)
Word2(4211H, sp); (* MOV sp(SR), SP *)
Word1(1206H); (* PUSH R6 *)
Word1(1204H); (* PUSH R4 *)
Word1(1205H); (* PUSH R5 *)
Word2(4214H, trap); (* MOV trap(SR), R4 *)
Word1(9304H); (* TST R4 *)
Word1(2400H + 1); (* JZ L *)
Word1(1284H); (* CALL R4 *)
(* L: *)
Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
END;
(* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
IF rtl[_new].used THEN
Label(rtl[_new].label);
Word1(1202H); (* PUSH SR *)
Word1(4302H); (* MOV #0, SR *)
Word1(4303H); (* NOP *)
Word1(4104H); (* MOV SP, R4 *)
Word2(8034H, 16); (* SUB #16, R4 *)
Word1(4005H + 100H * HP); (* MOV HP, R5 *)
Word2(5115H, 6); (* ADD 6(SP), R5 *)
Word1(9504H); (* CMP R5, R4 *)
Word2(4114H, 8); (* MOV 8(SP), R4 *)
Word1(3800H + 12); (* JL L1 *)
Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *)
Word1(5320H + HP); (* ADD #2, HP *)
Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *)
(* L3 *)
Word2(4380H + HP, 0); (* MOV #0, 0(HP) *)
Word1(5320H + HP); (* ADD #2, HP *)
Word1(9500H + HP); (* CMP R5, HP *)
Word1(3800H + 400H - 5); (* JL L3 *)
Word1(3C00H + 2); (* JMP L2 *)
(* L1 *)
Word2(4384H, 0); (* MOV #0, 0(R4) *)
(* L2 *)
Word1(1300H) (* RETI *)
END;
(* _guardrec (t0, t1: INTEGER): INTEGER *)
IF rtl[_guardrec].used THEN
Label(rtl[_guardrec].label);
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *)
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *)
Word2(4036H, types); (* MOV #types, R6 *)
(* L3: *)
Word1(9305H); (* CMP #0, R5 *)
Word1(2400H + 8); (* JZ L1 *)
Word1(9405H); (* CMP R4, R5 *)
Word1(2400H + 10); (* JZ L2 *)
Word1(5505H); (* ADD R5, R5 *)
Word1(0E335H); (* XOR #-1, R5 *)
Word1(5315H); (* ADD #1, R5 *)
Word1(5605H); (* ADD R6, R5 *)
Word1(4525H); (* MOV @R5, R5 *)
Word1(3C00H + 400H - 10); (* JMP L3 *)
(* L1: *)
Word1(9405H); (* CMP R4, R5 *)
Word1(2400H + 2); (* JZ L2 *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H); (* MOV @SP+, PC *)
(* L2: *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H) (* RET *)
END;
(* _is (t, p: INTEGER): INTEGER *)
IF rtl[_is].used THEN
Label(rtl[_is].label);
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *)
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *)
Word1(9304H); (* TST R4 *)
Word1(2400H + 2); (* JZ L *)
Word2(4414H, -2); (* MOV -2(R4), R4 *)
(* L: *)
Word1(1204H); (* PUSH R4 *)
Word1(1205H); (* PUSH R5 *)
Call(rtl[_guardrec].label); (* CALL _guardrec *)
Word1(5221H); (* ADD #4, SP *)
Word1(4130H) (* RET *)
END;
(* _guard (t, p: INTEGER): INTEGER *)
IF rtl[_guard].used THEN
Label(rtl[_guard].label);
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4525H); (* MOV @R5, R5 *)
Word1(9305H); (* TST R5 *)
Word1(2400H + 9); (* JZ L *)
Word2(4515H, -2); (* MOV -2(R5), R5 *)
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *)
Word1(1205H); (* PUSH R5 *)
Word1(1204H); (* PUSH R4 *)
Call(rtl[_guardrec].label); (* CALL _guardrec *)
Word1(5221H); (* ADD #4, SP *)
(* L: *)
Word1(4130H) (* RET *)
END;
(* _move (bytes, dest, source: INTEGER) *)
IF rtl[_move].used THEN
Label(rtl[_move].label);
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *)
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *)
Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *)
Word1(9306H); (* CMP #0, R6 *)
Word1(3800H + 6); (* JL L1 *)
Word1(2400H + 5); (* JZ L1 *)
(* L2: *)
Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *)
Word1(5317H); (* ADD #1, R7 *)
Word1(8316H); (* SUB #1, R6 *)
Word1(2000H + 400H - 5); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *)
IF rtl[_arrcpy].used THEN
Label(rtl[_arrcpy].label);
Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *)
Word1(3800H + 18); (* JL L1 *)
Word2(1211H, 12); (* PUSH 12(SP) *)
Word2(1211H, 10); (* PUSH 10(SP) *)
Word2(1211H, 14); (* PUSH 14(SP) *)
Word2(1211H, 10); (* PUSH 10(SP) *)
Call(rtl[_mul].label); (* CALL _mul *)
Word1(5221H); (* ADD #4, SP *)
Word1(1204H); (* PUSH R4 *)
Call(rtl[_move].label); (* CALL _move *)
Word2(5031H, 6); (* ADD #6, SP *)
Word1(4314H); (* MOV #1, R4 *)
Word1(4130H); (* RET *)
(* L1 *)
Word1(4304H); (* MOV #0, R4 *)
Word1(4130H) (* RET *)
END;
(* _length (len, str: INTEGER): INTEGER *)
IF rtl[_length].used THEN
Label(rtl[_length].label);
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *)
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *)
Word1(4304H); (* MOV #0, R4; res := 0 *)
(* L2: *)
Word1(4775H); (* MOV.B @R7+, R5 *)
Word1(9305H); (* CMP #0, R5 *)
Word1(2400H + 3); (* JZ L1 *)
Word1(5314H); (* ADD #1, R4 *)
Word1(8316H); (* SUB #1, R6 *)
Word1(2000H + 400H - 6); (* JNZ L2 *)
(* L1: *)
Word1(4130H) (* RET *)
END;
(* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *)
IF rtl[_strcmp].used THEN
Label(rtl[_strcmp].label);
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
Word1(9607H); (* CMP R6, R7 *)
Word1(3400H + 1); (* JGE L5 *)
Word1(4706H); (* MOV R7, R6 *)
(* L5: *)
Word1(1206H); (* PUSH R6 *)
Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *)
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *)
(* L3: *)
Word2(9381H, 0); (* CMP #0, 0(SP) *)
Word1(2400H + 11); (* JZ L1 *)
Word1(4674H); (* MOV.B @R6+, R4 *)
Word1(4775H); (* MOV.B @R7+, R5 *)
Word2(8391H, 0); (* SUB #1, 0(SP) *)
Word1(9405H); (* CMP R4, R5 *)
Word1(2400H + 2); (* JZ L2 *)
Word1(8504H); (* SUB R5, R4 *)
Word1(3C00H + 5); (* JMP L4 *)
(* L2: *)
Word1(9304H); (* CMP #0, R4 *)
Word1(2000H + 400H - 13); (* JNZ L3 *)
Word1(3C00H + 2); (* JMP L4 *)
(* L1: *)
Word2(4034H, 8000H); (* MOV #8000H, R4 *)
(* L4: *)
Word1(5321H); (* ADD #2, SP *)
Word2(9034H, 8000H); (* CMP #8000H, R4 *)
Word1(2000H + 18); (* JNZ L6 *)
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
Word1(9607H); (* CMP R6, R7 *)
Word1(2400H + 11); (* JZ L7 *)
Word1(3800H + 4); (* JL L8 *)
Word2(5116H, 10); (* ADD 10(SP), R6 *)
Word1(4664H); (* MOV.B @R6, R4 *)
Word1(3C00H + 7); (* JMP L6 *)
(* L8: *)
Word2(5117H, 6); (* ADD 6(SP), R7 *)
Word1(4764H); (* MOV.B @R7, R4 *)
Word1(0E334H); (* XOR #-1, R4 *)
Word1(5314H); (* ADD #1, R4 *)
Word1(3C00H + 1); (* JMP L6 *)
(* L7: *)
Word1(4304H); (* MOV #0, R4 *)
(* L6: *)
Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(2400H + 1); (* JZ L *)
Word1(4304H); (* MOV #0, R4 *)
(* L *)
Word1(4130H); (* RET *)
Word1(4303H); (* NOP *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(2000H + 1); (* JNZ L *)
Word1(4304H); (* MOV #0, R4 *)
(* L *)
Word1(4130H); (* RET *)
Word1(4303H); (* NOP *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(3800H + 1); (* JL L *)
Word1(4304H); (* MOV #0, R4 *)
(* L *)
Word1(4130H); (* RET *)
Word1(4303H); (* NOP *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(3800H + 2); (* JL L *)
Word1(2400H + 1); (* JZ L *)
Word1(4304H); (* MOV #0, R4 *)
(* L *)
Word1(4130H); (* RET *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4304H); (* MOV #0, R4 *)
Word1(3800H + 2); (* JL L *)
Word1(2400H + 1); (* JZ L *)
Word1(4314H); (* MOV #1, R4 *)
(* L *)
Word1(4130H); (* RET *)
Word1(9304H); (* CMP #0, R4 *)
Word1(4314H); (* MOV #1, R4 *)
Word1(3400H + 1); (* JGE L *)
Word1(4304H); (* MOV #0, R4 *)
(* L *)
Word1(4130H) (* RET *)
END
END Gen;
PROCEDURE Set* (idx, label: INTEGER);
BEGIN
rtl[idx].label := label;
rtl[idx].used := FALSE
END Set;
PROCEDURE Used* (idx: INTEGER);
BEGIN
rtl[idx].used := TRUE;
IF (idx = _guard) OR (idx = _is) THEN
rtl[_guardrec].used := TRUE
ELSIF idx = _arrcpy THEN
rtl[_move].used := TRUE;
rtl[_mul].used := TRUE
END
END Used;
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER);
BEGIN
Label := pLabel;
Word := pWord;
Call := pCall;
IF ramSize > 2048 THEN
ram := 1100H
ELSE
ram := 200H
END;
trap := ram;
int := trap + 2
END Init;
END MSP430RTL.

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

@ -7,7 +7,7 @@
MODULE PARS; MODULE PARS;
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS; IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
CONST CONST
@ -24,6 +24,12 @@ TYPE
PARSER* = POINTER TO rPARSER; PARSER* = POINTER TO rPARSER;
POSITION* = RECORD (SCAN.POSITION)
parser*: PARSER
END;
EXPR* = RECORD EXPR* = RECORD
obj*: INTEGER; obj*: INTEGER;
@ -37,7 +43,7 @@ TYPE
STATPROC = PROCEDURE (parser: PARSER); STATPROC = PROCEDURE (parser: PARSER);
EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR); EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
rPARSER = RECORD (C.ITEM) rPARSER = RECORD (C.ITEM)
@ -67,7 +73,7 @@ TYPE
VAR VAR
program*: PROG.PROGRAM; program*: PROG.PROGRAM;
parsers: C.COLLECTION; parsers: C.COLLECTION;
@ -83,34 +89,40 @@ BEGIN
END destroy; END destroy;
PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
BEGIN BEGIN
ERRORS.errormsg(parser.fname, pos.line, pos.col, errno) pos.line := parser.lex.pos.line;
pos.col := parser.lex.pos.col;
pos.parser := parser
END getpos;
PROCEDURE error* (pos: POSITION; errno: INTEGER);
BEGIN
ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
END error; END error;
PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
BEGIN BEGIN
IF ~condition THEN IF ~condition THEN
error(parser, pos, errno) error(pos, errno)
END END
END check; END check;
PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER); PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
VAR
pos: POSITION;
BEGIN BEGIN
IF ~condition THEN IF ~condition THEN
error(parser, parser.lex.pos, errno) getpos(parser, pos);
error(pos, errno)
END END
END check1; END check1;
PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
BEGIN
pos := parser.lex.pos
END getpos;
PROCEDURE Next* (parser: PARSER); PROCEDURE Next* (parser: PARSER);
VAR VAR
errno: INTEGER; errno: INTEGER;
@ -118,6 +130,14 @@ VAR
BEGIN BEGIN
SCAN.Next(parser.scanner, parser.lex); SCAN.Next(parser.scanner, parser.lex);
errno := parser.lex.error; errno := parser.lex.error;
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
IF parser.lex.sym = SCAN.lxFLOAT THEN
errno := -SCAN.lxERROR13
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
errno := -SCAN.lxERROR10
END
END;
IF errno # 0 THEN IF errno # 0 THEN
check1(FALSE, parser, errno) check1(FALSE, parser, errno)
END; END;
@ -125,10 +145,10 @@ BEGIN
END Next; END Next;
PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION); PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
BEGIN BEGIN
Next(parser); Next(parser);
pos := parser.lex.pos getpos(parser, pos)
END NextPos; END NextPos;
@ -178,17 +198,14 @@ END ExpectSym;
PROCEDURE ImportList (parser: PARSER); PROCEDURE ImportList (parser: PARSER);
VAR VAR
name: SCAN.IDENT; name: SCAN.IDENT;
parser2: PARSER; parser2: PARSER;
pos: SCAN.POSITION; pos: POSITION;
alias: BOOLEAN; alias: BOOLEAN;
unit: PROG.UNIT; unit: PROG.UNIT;
ident: PROG.IDENT; ident: PROG.IDENT;
units: PROG.UNITS;
BEGIN BEGIN
units := program.units;
alias := FALSE; alias := FALSE;
REPEAT REPEAT
@ -199,18 +216,18 @@ BEGIN
getpos(parser, pos); getpos(parser, pos);
IF ~alias THEN IF ~alias THEN
ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE); ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
check(ident # NIL, parser, pos, 30) check(ident # NIL, pos, 30)
END; END;
Next(parser); Next(parser);
IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
alias := FALSE; alias := FALSE;
unit := units.get(units, name); unit := PROG.getUnit(program, name);
IF unit # NIL THEN IF unit # NIL THEN
check(unit.closed, parser, pos, 31) check(unit.closed, pos, 31)
ELSE ELSE
parser2 := parser.create(parser.path, parser.lib_path, parser2 := parser.create(parser.path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
@ -220,9 +237,9 @@ BEGIN
destroy(parser2); destroy(parser2);
parser2 := parser.create(parser.lib_path, parser.lib_path, parser2 := parser.create(parser.lib_path, parser.lib_path,
parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
check(parser2.open(parser2, name.s), parser, pos, 29) check(parser2.open(parser2, name.s), pos, 29)
ELSE ELSE
check(FALSE, parser, pos, 29) error(pos, 29)
END END
END; END;
@ -257,7 +274,7 @@ VAR
BEGIN BEGIN
ASSERT(parser.sym = SCAN.lxIDENT); ASSERT(parser.sym = SCAN.lxIDENT);
ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
IF ~forward THEN IF ~forward THEN
check1(ident # NIL, parser, 48) check1(ident # NIL, parser, 48)
@ -267,7 +284,7 @@ BEGIN
unit := ident.unit; unit := ident.unit;
ExpectSym(parser, SCAN.lxPOINT); ExpectSym(parser, SCAN.lxPOINT);
ExpectSym(parser, SCAN.lxIDENT); ExpectSym(parser, SCAN.lxIDENT);
ident := unit.idents.get(unit, parser.lex.ident, FALSE); ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
check1((ident # NIL) & ident.export, parser, 48) check1((ident # NIL) & ident.export, parser, 48)
END END
@ -312,30 +329,29 @@ BEGIN
END; END;
ARITH.setbool(v, bool) ARITH.setbool(v, bool)
END strcmp; END strcmp;
PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE); PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
VAR VAR
e: EXPR; e: EXPR;
pos: SCAN.POSITION; pos: POSITION;
BEGIN BEGIN
getpos(parser, pos); getpos(parser, pos);
parser.constexp := TRUE; parser.constexp := TRUE;
parser.expression(parser, e); parser.expression(parser, e);
parser.constexp := FALSE; parser.constexp := FALSE;
check(e.obj = eCONST, parser, pos, 62); check(e.obj = eCONST, pos, 62);
v := e.value v := e.value
END ConstExpression; END ConstExpression;
PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_); PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
VAR VAR
name: SCAN.IDENT; name: SCAN.IDENT;
export: BOOLEAN; export: BOOLEAN;
pos: SCAN.POSITION; pos: POSITION;
BEGIN BEGIN
ASSERT(parser.sym = SCAN.lxIDENT); ASSERT(parser.sym = SCAN.lxIDENT);
@ -355,7 +371,7 @@ BEGIN
Next(parser) Next(parser)
END; END;
check(rec.fields.add(rec, name, export), parser, pos, 30); check(PROG.addField(rec, name, export), pos, 30);
IF parser.sym = SCAN.lxCOMMA THEN IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT) ExpectSym(parser, SCAN.lxIDENT)
@ -391,7 +407,7 @@ VAR
exit := FALSE; exit := FALSE;
WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
check1(type.params.add(type, parser.lex.ident, vPar), parser, 30); check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
Next(parser); Next(parser);
IF parser.sym = SCAN.lxCOMMA THEN IF parser.sym = SCAN.lxCOMMA THEN
ExpectSym(parser, SCAN.lxIDENT) ExpectSym(parser, SCAN.lxIDENT)
@ -412,13 +428,13 @@ VAR
t1 := t0; t1 := t0;
WHILE dim > 0 DO WHILE dim > 0 DO
t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit); t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
t1.base := t0; t1.base := t0;
t0 := t1; t0 := t1;
DEC(dim) DEC(dim)
END; END;
type.params.set(type, t1); PROG.setParams(type, t1);
Next(parser); Next(parser);
exit := TRUE exit := TRUE
ELSE ELSE
@ -449,7 +465,7 @@ BEGIN
ExpectSym(parser, SCAN.lxIDENT); ExpectSym(parser, SCAN.lxIDENT);
ident := QIdent(parser, FALSE); ident := QIdent(parser, FALSE);
check1(ident.typ = PROG.idTYPE, parser, 68); check1(ident.typ = PROG.idTYPE, parser, 68);
check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69); check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113); check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
type.base := ident.type; type.base := ident.type;
Next(parser) Next(parser)
@ -461,54 +477,83 @@ BEGIN
END FormalParameters; END FormalParameters;
PROCEDURE sysflag (parser: PARSER): INTEGER; PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
VAR VAR
res: INTEGER; res, sf: INTEGER;
BEGIN BEGIN
IF parser.lex.s = "stdcall" THEN IF parser.lex.s = "stdcall" THEN
res := PROG.stdcall sf := PROG.sf_stdcall
ELSIF parser.lex.s = "stdcall64" THEN ELSIF parser.lex.s = "stdcall64" THEN
res := PROG.stdcall64 sf := PROG.sf_stdcall64
ELSIF parser.lex.s = "ccall" THEN ELSIF parser.lex.s = "ccall" THEN
res := PROG.ccall sf := PROG.sf_ccall
ELSIF parser.lex.s = "ccall16" THEN ELSIF parser.lex.s = "ccall16" THEN
res := PROG.ccall16 sf := PROG.sf_ccall16
ELSIF parser.lex.s = "win64" THEN ELSIF parser.lex.s = "win64" THEN
res := PROG.win64 sf := PROG.sf_win64
ELSIF parser.lex.s = "systemv" THEN ELSIF parser.lex.s = "systemv" THEN
res := PROG.systemv sf := PROG.sf_systemv
ELSIF parser.lex.s = "windows" THEN ELSIF parser.lex.s = "windows" THEN
sf := PROG.sf_windows
ELSIF parser.lex.s = "linux" THEN
sf := PROG.sf_linux
ELSIF parser.lex.s = "code" THEN
sf := PROG.sf_code
ELSIF parser.lex.s = "noalign" THEN
sf := PROG.sf_noalign
ELSE
check1(FALSE, parser, 124)
END;
check1(sf IN program.target.sysflags, parser, 125);
IF proc THEN
check1(sf IN PROG.proc_flags, parser, 123)
ELSE
check1(sf IN PROG.rec_flags, parser, 123)
END;
CASE sf OF
|PROG.sf_stdcall:
res := PROG.stdcall
|PROG.sf_stdcall64:
res := PROG.stdcall64
|PROG.sf_ccall:
res := PROG.ccall
|PROG.sf_ccall16:
res := PROG.ccall16
|PROG.sf_win64:
res := PROG.win64
|PROG.sf_systemv:
res := PROG.systemv
|PROG.sf_code:
res := PROG.code
|PROG.sf_windows:
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
res := PROG.stdcall res := PROG.stdcall
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
res := PROG.win64 res := PROG.win64
ELSE
check1(FALSE, parser, 118)
END END
ELSIF parser.lex.s = "linux" THEN |PROG.sf_linux:
IF program.target.sys = mConst.Target_iELF32 THEN IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
res := PROG.ccall16 res := PROG.ccall16
ELSIF program.target.sys = mConst.Target_iELF64 THEN ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
res := PROG.systemv res := PROG.systemv
ELSE
check1(FALSE, parser, 119)
END END
ELSIF parser.lex.s = "noalign" THEN |PROG.sf_noalign:
res := PROG.noalign res := PROG.noalign
ELSE
res := 0
END END
RETURN res RETURN res
END sysflag; END sysflag;
PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER; PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
VAR VAR
call: INTEGER; call: INTEGER;
dll, proc: SCAN.LEXSTR; dll, proc: SCAN.LEXSTR;
pos: SCAN.POSITION; pos: POSITION;
BEGIN BEGIN
@ -518,12 +563,7 @@ BEGIN
getpos(parser, pos); getpos(parser, pos);
check1(parser.unit.sysimport, parser, 54); check1(parser.unit.sysimport, parser, 54);
Next(parser); Next(parser);
call := sysflag(parser); call := sysflag(parser, TRUE);
IF program.target.bit_depth = 64 THEN
check1(call IN PROG.callconv64, parser, 117)
ELSIF program.target.bit_depth = 32 THEN
check1(call IN PROG.callconv32, parser, 63)
END;
Next(parser); Next(parser);
IF parser.sym = SCAN.lxMINUS THEN IF parser.sym = SCAN.lxMINUS THEN
Next(parser); Next(parser);
@ -539,20 +579,21 @@ BEGIN
ExpectSym(parser, SCAN.lxSTRING); ExpectSym(parser, SCAN.lxSTRING);
proc := parser.lex.s; proc := parser.lex.s;
Next(parser); Next(parser);
import := CODE.AddImp(dll, proc) import := IL.AddImp(dll, proc)
END; END;
checklex(parser, SCAN.lxRSQUARE); checklex(parser, SCAN.lxRSQUARE);
Next(parser) Next(parser)
ELSE ELSE
IF program.target.bit_depth = 32 THEN CASE program.target.bit_depth OF
call := PROG.default |16: call := PROG.default16
ELSIF program.target.bit_depth = 64 THEN |32: call := PROG.default32
call := PROG.default64 |64: call := PROG.default64
END END
END; END;
IF import # NIL THEN IF import # NIL THEN
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70) check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
END END
RETURN call RETURN call
@ -570,12 +611,12 @@ VAR
typeSize: ARITH.VALUE; typeSize: ARITH.VALUE;
ident: PROG.IDENT; ident: PROG.IDENT;
unit: PROG.UNIT; unit: PROG.UNIT;
pos, pos2: SCAN.POSITION; pos, pos2: POSITION;
fieldType: PROG.TYPE_; fieldType: PROG.TYPE_;
baseIdent: SCAN.IDENT; baseIdent: SCAN.IDENT;
a, b: INTEGER; a, b: INTEGER;
RecFlag: INTEGER; RecFlag: INTEGER;
import: CODE.IMPORT_PROC; import: IL.IMPORT_PROC;
BEGIN BEGIN
unit := parser.unit; unit := parser.unit;
@ -604,11 +645,11 @@ BEGIN
ConstExpression(parser, arrLen); ConstExpression(parser, arrLen);
check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43); check(arrLen.typ = ARITH.tINTEGER, pos, 43);
check(ARITH.check(arrLen), parser, pos, 39); check(ARITH.check(arrLen), pos, 39);
check(ARITH.getInt(arrLen) > 0, parser, pos, 51); check(ARITH.getInt(arrLen) > 0, pos, 51);
t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
IF parser.sym = SCAN.lxCOMMA THEN IF parser.sym = SCAN.lxCOMMA THEN
type(parser, t.base, {comma, closed}) type(parser, t.base, {comma, closed})
@ -623,8 +664,8 @@ BEGIN
a := t.length; a := t.length;
b := t.base.size; b := t.base.size;
check(ARITH.mulInt(a, b), parser, pos2, 104); check(ARITH.mulInt(a, b), pos2, 104);
check(ARITH.setInt(typeSize, a), parser, pos2, 104); check(ARITH.setInt(typeSize, a), pos2, 104);
t.size := a; t.size := a;
t.closed := TRUE t.closed := TRUE
@ -633,19 +674,14 @@ BEGIN
getpos(parser, pos2); getpos(parser, pos2);
Next(parser); Next(parser);
t := program.enterType(program, PROG.tRECORD, 0, 0, unit); t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit);
t.align := 1; t.align := 1;
IF parser.sym = SCAN.lxLSQUARE THEN IF parser.sym = SCAN.lxLSQUARE THEN
check1(parser.unit.sysimport, parser, 54); check1(parser.unit.sysimport, parser, 54);
Next(parser); Next(parser);
RecFlag := sysflag(parser); RecFlag := sysflag(parser, FALSE);
IF RecFlag = PROG.noalign THEN t.noalign := RecFlag = PROG.noalign;
t.noalign := TRUE
ELSE
check1(FALSE, parser, 110)
END;
ExpectSym(parser, SCAN.lxRSQUARE); ExpectSym(parser, SCAN.lxRSQUARE);
Next(parser) Next(parser)
END; END;
@ -657,14 +693,14 @@ BEGIN
type(parser, t.base, {closed}); type(parser, t.base, {closed});
check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52); check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);
IF t.base.typ = PROG.tPOINTER THEN IF t.base.typ = PROG.tPOINTER THEN
t.base := t.base.base; t.base := t.base.base;
check(t.base # NIL, parser, pos, 55) check(t.base # NIL, pos, 55)
END; END;
check(~t.base.noalign, parser, pos, 112); check(~t.base.noalign, pos, 112);
checklex(parser, SCAN.lxRROUND); checklex(parser, SCAN.lxRROUND);
Next(parser); Next(parser);
@ -684,7 +720,7 @@ BEGIN
Next(parser); Next(parser);
type(parser, fieldType, {closed}); type(parser, fieldType, {closed});
check(t.fields.set(t, fieldType), parser, pos2, 104); check(PROG.setFields(t, fieldType), pos2, 104);
IF (fieldType.align > t.align) & ~t.noalign THEN IF (fieldType.align > t.align) & ~t.noalign THEN
t.align := fieldType.align t.align := fieldType.align
@ -699,21 +735,21 @@ BEGIN
t.closed := TRUE; t.closed := TRUE;
CODE.AddRec(t.base.num); IL.AddRec(t.base.num);
IF ~t.noalign THEN IF ~t.noalign THEN
check(MACHINE.Align(t.size, t.align), parser, pos2, 104); check(UTILS.Align(t.size, t.align), pos2, 104);
check(ARITH.setInt(typeSize, t.size), parser, pos2, 104) check(ARITH.setInt(typeSize, t.size), pos2, 104)
END; END;
checklex(parser, SCAN.lxEND); checklex(parser, SCAN.lxEND);
Next(parser) Next(parser)
ELSIF parser.sym = SCAN.lxPOINTER THEN ELSIF parser.sym = SCAN.lxPOINTER THEN
ExpectSym(parser, SCAN.lxTO); ExpectSym(parser, SCAN.lxTO);
Next(parser); Next(parser);
t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit);
t.align := program.target.adr; t.align := program.target.adr;
getpos(parser, pos); getpos(parser, pos);
@ -725,14 +761,14 @@ BEGIN
type(parser, t.base, {forward}); type(parser, t.base, {forward});
IF t.base # NIL THEN IF t.base # NIL THEN
check(t.base.typ = PROG.tRECORD, parser, pos, 58) check(t.base.typ = PROG.tRECORD, pos, 58)
ELSE ELSE
unit.pointers.add(unit, t, baseIdent, pos) PROG.frwPtr(unit, t, baseIdent, pos)
END END
ELSIF parser.sym = SCAN.lxPROCEDURE THEN ELSIF parser.sym = SCAN.lxPROCEDURE THEN
NextPos(parser, pos); NextPos(parser, pos);
t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t.align := program.target.adr; t.align := program.target.adr;
t.call := procflag(parser, import, FALSE); t.call := procflag(parser, import, FALSE);
FormalParameters(parser, t) FormalParameters(parser, t)
@ -746,15 +782,15 @@ END type;
PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT; PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
VAR VAR
ident: PROG.IDENT; ident: PROG.IDENT;
pos: SCAN.POSITION; pos: POSITION;
BEGIN BEGIN
ASSERT(parser.sym = SCAN.lxIDENT); ASSERT(parser.sym = SCAN.lxIDENT);
name := parser.lex.ident; name := parser.lex.ident;
getpos(parser, pos); getpos(parser, pos);
ident := parser.unit.idents.add(parser.unit, name, typ); ident := PROG.addIdent(parser.unit, name, typ);
check(ident # NIL, parser, pos, 30); check(ident # NIL, pos, 30);
ident.pos := pos; ident.pos := pos;
Next(parser); Next(parser);
@ -770,9 +806,9 @@ END IdentDef;
PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN); PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
VAR VAR
ident: PROG.IDENT; ident: PROG.IDENT;
name: SCAN.IDENT; name: SCAN.IDENT;
pos: SCAN.POSITION; pos: POSITION;
BEGIN BEGIN
IF const THEN IF const THEN
@ -787,12 +823,12 @@ BEGIN
IF const THEN IF const THEN
ConstExpression(parser, ident.value); ConstExpression(parser, ident.value);
IF ident.value.typ = ARITH.tINTEGER THEN IF ident.value.typ = ARITH.tINTEGER THEN
check(ARITH.check(ident.value), parser, pos, 39) check(ARITH.check(ident.value), pos, 39)
ELSIF ident.value.typ = ARITH.tREAL THEN ELSIF ident.value.typ = ARITH.tREAL THEN
check(ARITH.check(ident.value), parser, pos, 40) check(ARITH.check(ident.value), pos, 40)
END; END;
ident.typ := PROG.idCONST; ident.typ := PROG.idCONST;
ident.type := program.getType(program, ident.value.typ) ident.type := PROG.getType(program, ident.value.typ)
ELSE ELSE
type(parser, ident.type, {}) type(parser, ident.type, {})
END; END;
@ -805,9 +841,9 @@ END ConstTypeDeclaration;
PROCEDURE VarDeclaration (parser: PARSER); PROCEDURE VarDeclaration (parser: PARSER);
VAR VAR
ident: PROG.IDENT; ident: PROG.IDENT;
name: SCAN.IDENT; name: SCAN.IDENT;
t: PROG.TYPE_; t: PROG.TYPE_;
BEGIN BEGIN
@ -819,7 +855,7 @@ BEGIN
ELSIF parser.sym = SCAN.lxCOLON THEN ELSIF parser.sym = SCAN.lxCOLON THEN
Next(parser); Next(parser);
type(parser, t, {}); type(parser, t, {});
parser.unit.setvars(parser.unit, t); PROG.setVarsType(parser.unit, t);
checklex(parser, SCAN.lxSEMI); checklex(parser, SCAN.lxSEMI);
Next(parser) Next(parser)
ELSE ELSE
@ -835,6 +871,7 @@ PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
VAR VAR
ptr: PROG.FRWPTR; ptr: PROG.FRWPTR;
endmod: BOOLEAN; endmod: BOOLEAN;
pos: POSITION;
PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN; PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
@ -842,20 +879,24 @@ VAR
proc: PROG.IDENT; proc: PROG.IDENT;
endname, endname,
name: SCAN.IDENT; name: SCAN.IDENT;
param: LISTS.ITEM; param: PROG.PARAM;
unit: PROG.UNIT; unit: PROG.UNIT;
ident: PROG.IDENT; ident: PROG.IDENT;
e: EXPR; e: EXPR;
pos: SCAN.POSITION; pos, pos1,
pos2: POSITION;
label: INTEGER; label: INTEGER;
enter: CODE.COMMAND; enter: IL.COMMAND;
call: INTEGER; call: INTEGER;
t: PROG.TYPE_; t: PROG.TYPE_;
import: CODE.IMPORT_PROC; import: IL.IMPORT_PROC;
endmod, b: BOOLEAN; endmod, b: BOOLEAN;
fparams: SET; fparams: SET;
variables: LISTS.LIST; variables: LISTS.LIST;
int, flt: INTEGER; int, flt: INTEGER;
comma: BOOLEAN;
code: ARITH.VALUE;
codeProc: BOOLEAN;
BEGIN BEGIN
endmod := FALSE; endmod := FALSE;
@ -865,6 +906,7 @@ VAR
call := procflag(parser, import, TRUE); call := procflag(parser, import, TRUE);
getpos(parser, pos); getpos(parser, pos);
pos1 := pos;
checklex(parser, SCAN.lxIDENT); checklex(parser, SCAN.lxIDENT);
IF import # NIL THEN IF import # NIL THEN
@ -875,29 +917,56 @@ VAR
proc := IdentDef(parser, PROG.idPROC, name) proc := IdentDef(parser, PROG.idPROC, name)
END; END;
check(unit.scope.open(unit, proc.proc), parser, pos, 116); check(PROG.openScope(unit, proc.proc), pos, 116);
proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
t := proc.type; t := proc.type;
t.align := program.target.adr; t.align := program.target.adr;
t.call := call; t.call := call;
FormalParameters(parser, t); FormalParameters(parser, t);
codeProc := call IN {PROG.code, PROG._code};
IF call IN {PROG.systemv, PROG._systemv} THEN IF call IN {PROG.systemv, PROG._systemv} THEN
check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120) check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
END; END;
param := t.params.first; param := t.params.first(PROG.PARAM);
WHILE param # NIL DO WHILE param # NIL DO
ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM); ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
ASSERT(ident # NIL); ASSERT(ident # NIL);
ident.type := param(PROG.PARAM).type; ident.type := param.type;
ident.offset := param(PROG.PARAM).offset; ident.offset := param.offset;
IF param(PROG.PARAM).vPar THEN IF param.vPar THEN
ident.typ := PROG.idVPAR ident.typ := PROG.idVPAR
END; END;
param := param.next param := param.next(PROG.PARAM)
END;
IF import = NIL THEN
label := IL.NewLabel();
proc.proc.label := label
END;
IF codeProc THEN
enter := IL.EnterC(label);
comma := FALSE;
WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
getpos(parser, pos2);
ConstExpression(parser, code);
check(code.typ = ARITH.tINTEGER, pos2, 43);
IF program.target.sys # mConst.Target_iMSP430 THEN
check(ARITH.range(code, 0, 255), pos2, 42)
END;
IL.AddCmd(IL.opCODE, ARITH.getInt(code));
comma := parser.sym = SCAN.lxCOMMA;
IF comma THEN
Next(parser)
ELSE
checklex(parser, SCAN.lxSEMI)
END
END
END; END;
checklex(parser, SCAN.lxSEMI); checklex(parser, SCAN.lxSEMI);
@ -905,55 +974,64 @@ VAR
IF import = NIL THEN IF import = NIL THEN
label := CODE.NewLabel();
proc.proc.label := label;
IF parser.main & proc.export & program.dll THEN IF parser.main & proc.export & program.dll THEN
IF program.obj THEN IF program.obj THEN
check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114) check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
END; END;
CODE.AddExp(label, proc.name.s); IL.AddExp(label, proc.name.s);
proc.proc.used := TRUE proc.proc.used := TRUE
END; END;
b := DeclarationSequence(parser); IF ~codeProc THEN
b := DeclarationSequence(parser)
END;
program.locsize := 0; program.locsize := 0;
IF call IN {PROG._win64, PROG.win64} THEN IF call IN {PROG._win64, PROG.win64} THEN
fparams := proc.type.params.getfparams(proc.type, 3, int, flt); fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4)) enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
ELSIF call IN {PROG._systemv, PROG.systemv} THEN ELSIF call IN {PROG._systemv, PROG.systemv} THEN
fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size)) enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
ELSIF codeProc THEN
ELSE ELSE
enter := CODE.Enter(label, 0) enter := IL.Enter(label, 0)
END; END;
proc.proc.enter := enter; proc.proc.enter := enter;
IF parser.sym = SCAN.lxBEGIN THEN IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
Next(parser); Next(parser);
parser.StatSeq(parser) parser.StatSeq(parser)
END; END;
IF t.base # NIL THEN IF ~codeProc & (t.base # NIL) THEN
checklex(parser, SCAN.lxRETURN); checklex(parser, SCAN.lxRETURN);
NextPos(parser, pos); NextPos(parser, pos);
parser.expression(parser, e); parser.expression(parser, e);
check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87) check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
END; END;
proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), IF ~codeProc THEN
t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
enter.param2 := program.locsize; t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
checklex(parser, SCAN.lxEND) enter.param2 := program.locsize;
checklex(parser, SCAN.lxEND)
ELSE
proc.proc.leave := IL.LeaveC()
END;
IF program.target.sys = mConst.Target_iMSP430 THEN
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
END
END; END;
IF parser.sym = SCAN.lxEND THEN IF parser.sym = SCAN.lxEND THEN
ExpectSym(parser, SCAN.lxIDENT); ExpectSym(parser, SCAN.lxIDENT);
getpos(parser, pos); getpos(parser, pos);
endname := parser.lex.ident; endname := parser.lex.ident;
IF import = NIL THEN IF ~codeProc & (import = NIL) THEN
check(endname = name, parser, pos, 60); check(endname = name, pos, 60);
ExpectSym(parser, SCAN.lxSEMI); ExpectSym(parser, SCAN.lxSEMI);
Next(parser) Next(parser)
ELSE ELSE
@ -965,20 +1043,20 @@ VAR
ExpectSym(parser, SCAN.lxSEMI); ExpectSym(parser, SCAN.lxSEMI);
Next(parser) Next(parser)
ELSE ELSE
check(FALSE, parser, pos, 60) error(pos, 60)
END END
END END
END; END;
IF import = NIL THEN IF ~codeProc & (import = NIL) THEN
variables := LISTS.create(NIL); variables := LISTS.create(NIL);
ELSE ELSE
variables := NIL variables := NIL
END; END;
unit.scope.close(unit, variables); PROG.closeScope(unit, variables);
IF import = NIL THEN IF ~codeProc & (import = NIL) THEN
enter.variables := variables enter.variables := variables
END END
@ -1001,12 +1079,15 @@ BEGIN
END END
END; END;
ptr := parser.unit.pointers.link(parser.unit); ptr := PROG.linkPtr(parser.unit);
IF ptr # NIL THEN IF ptr # NIL THEN
pos.line := ptr.pos.line;
pos.col := ptr.pos.col;
pos.parser := parser;
IF ptr.notRecord THEN IF ptr.notRecord THEN
error(parser, ptr.pos, 58) error(pos, 58)
ELSE ELSE
error(parser, ptr.pos, 48) error(pos, 48)
END END
END; END;
@ -1029,10 +1110,12 @@ END DeclarationSequence;
PROCEDURE parse (parser: PARSER); PROCEDURE parse (parser: PARSER);
VAR VAR
unit: PROG.UNIT; unit: PROG.UNIT;
label: INTEGER; label: INTEGER;
name: INTEGER; name: INTEGER;
endmod: BOOLEAN; endmod: BOOLEAN;
errlabel: INTEGER;
errno: INTEGER;
BEGIN BEGIN
ASSERT(parser # NIL); ASSERT(parser # NIL);
@ -1045,7 +1128,7 @@ BEGIN
check1(parser.lex.s = parser.modname, parser, 23) check1(parser.lex.s = parser.modname, parser, 23)
END; END;
unit := program.units.create(program.units, parser.lex.ident); unit := PROG.newUnit(program, parser.lex.ident);
parser.unit := unit; parser.unit := unit;
@ -1062,19 +1145,26 @@ BEGIN
END; END;
CONSOLE.Ln; CONSOLE.Ln;
label := CODE.NewLabel(); label := IL.NewLabel();
CODE.AddJmpCmd(CODE.opJMP, label); IL.AddJmpCmd(IL.opJMP, label);
name := CODE.putstr(unit.name.s); name := IL.putstr(unit.name.s);
CODE.SetErrLabel; errlabel := IL.NewLabel();
CODE.AddCmd(CODE.opSADR, name); IL.SetLabel(errlabel);
CODE.AddCmd(CODE.opPARAM, 1); IL.StrAdr(name);
CODE.AddCmd0(CODE.opERR); IL.Param1;
IL.AddCmd0(IL.opERR);
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
IL.SetErrLabel(errno);
IL.AddCmd(IL.opPUSHC, errno);
IL.AddJmpCmd(IL.opJMP, errlabel)
END;
endmod := DeclarationSequence(parser); endmod := DeclarationSequence(parser);
CODE.SetLabel(label); IL.SetLabel(label);
IF ~endmod THEN IF ~endmod THEN
@ -1091,8 +1181,7 @@ BEGIN
END; END;
unit.close(unit) PROG.closeUnit(unit)
END parse; END parse;
@ -1156,9 +1245,9 @@ BEGIN
END create; END create;
PROCEDURE init* (bit_depth, sys: INTEGER); PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
BEGIN BEGIN
program := PROG.create(bit_depth, sys); program := PROG.create(bit_depth, target, options);
parsers := C.create() parsers := C.create()
END init; END init;

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -12,11 +12,11 @@ IMPORT STRINGS, UTILS;
CONST CONST
slash = UTILS.slash; slash = UTILS.slash;
PATHLEN = 2048; PATHLEN = 2048;
TYPE TYPE
PATH* = ARRAY PATHLEN OF CHAR; PATH* = ARRAY PATHLEN OF CHAR;
@ -92,12 +92,12 @@ BEGIN
res[i] := 0X res[i] := 0X
END END
END RelPath; END RelPath;
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN UTILS.isRelative(path) RETURN UTILS.isRelative(path)
END isRelative; END isRelative;
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);

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

File diff suppressed because it is too large Load Diff

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

@ -12,8 +12,10 @@ CONST
N = 16; N = 16;
R0* = 0; R1* = 1; R2* = 2; R0* = 0; R1* = 1; R2* = 2; R3* = 3;
R8* = 8; R9* = 9; R10* = 10; R11* = 11; R4* = 4; R5* = 5; R6* = 6; R7* = 7;
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
NVR = 32; NVR = 32;
@ -24,7 +26,7 @@ TYPE
OP2 = PROCEDURE (arg1, arg2: INTEGER); OP2 = PROCEDURE (arg1, arg2: INTEGER);
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER); OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
REGS* = POINTER TO RECORD REGS* = RECORD
regs*: SET; regs*: SET;
stk*: ARRAY N OF INTEGER; stk*: ARRAY N OF INTEGER;
@ -42,7 +44,7 @@ TYPE
END; END;
PROCEDURE push (R: REGS); PROCEDURE push (VAR R: REGS);
VAR VAR
i, reg: INTEGER; i, reg: INTEGER;
@ -58,7 +60,7 @@ BEGIN
END push; END push;
PROCEDURE pop (R: REGS; reg: INTEGER); PROCEDURE pop (VAR R: REGS; reg: INTEGER);
VAR VAR
i: INTEGER; i: INTEGER;
@ -111,7 +113,7 @@ BEGIN
END GetFreeReg; END GetFreeReg;
PROCEDURE Put (R: REGS; reg: INTEGER); PROCEDURE Put (VAR R: REGS; reg: INTEGER);
BEGIN BEGIN
EXCL(R.regs, reg); EXCL(R.regs, reg);
INC(R.top); INC(R.top);
@ -119,7 +121,7 @@ BEGIN
END Put; END Put;
PROCEDURE PopAnyReg (R: REGS): INTEGER; PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
VAR VAR
reg: INTEGER; reg: INTEGER;
@ -134,7 +136,7 @@ BEGIN
END PopAnyReg; END PopAnyReg;
PROCEDURE GetAnyReg* (R: REGS): INTEGER; PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
VAR VAR
reg: INTEGER; reg: INTEGER;
@ -152,13 +154,13 @@ BEGIN
END GetAnyReg; END GetAnyReg;
PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN; PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
VAR VAR
free, n: INTEGER; free, n: INTEGER;
res: BOOLEAN; res: BOOLEAN;
PROCEDURE exch (R: REGS; reg1, reg2: INTEGER); PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
VAR VAR
n1, n2: INTEGER; n1, n2: INTEGER;
@ -201,7 +203,7 @@ BEGIN
END GetReg; END GetReg;
PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN; PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
VAR VAR
n1, n2: INTEGER; n1, n2: INTEGER;
res: BOOLEAN; res: BOOLEAN;
@ -239,14 +241,14 @@ BEGIN
END Exchange; END Exchange;
PROCEDURE Drop* (R: REGS); PROCEDURE Drop* (VAR R: REGS);
BEGIN BEGIN
INCL(R.regs, R.stk[R.top]); INCL(R.regs, R.stk[R.top]);
DEC(R.top) DEC(R.top)
END Drop; END Drop;
PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER); PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
BEGIN BEGIN
IF R.top > 0 THEN IF R.top > 0 THEN
reg1 := R.stk[R.top - 1]; reg1 := R.stk[R.top - 1];
@ -261,7 +263,7 @@ BEGIN
END BinOp; END BinOp;
PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER); PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
BEGIN BEGIN
IF R.top >= 0 THEN IF R.top >= 0 THEN
reg := R.stk[R.top] reg := R.stk[R.top]
@ -271,7 +273,7 @@ BEGIN
END UnOp; END UnOp;
PROCEDURE PushAll* (R: REGS); PROCEDURE PushAll* (VAR R: REGS);
BEGIN BEGIN
WHILE R.top >= 0 DO WHILE R.top >= 0 DO
push(R) push(R)
@ -279,7 +281,15 @@ BEGIN
END PushAll; END PushAll;
PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER); PROCEDURE PushAll_1* (VAR R: REGS);
BEGIN
WHILE R.top >= 1 DO
push(R)
END
END PushAll_1;
PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER);
BEGIN BEGIN
ASSERT(reg IN R.vregs); ASSERT(reg IN R.vregs);
ASSERT(offs # 0); ASSERT(offs # 0);
@ -291,7 +301,7 @@ BEGIN
END Lock; END Lock;
PROCEDURE Release* (R: REGS; reg: INTEGER); PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
BEGIN BEGIN
ASSERT(reg IN R.vregs); ASSERT(reg IN R.vregs);
R.offs[reg] := 0 R.offs[reg] := 0
@ -350,7 +360,7 @@ BEGIN
END Restore; END Restore;
PROCEDURE Reset* (R: REGS); PROCEDURE Reset* (VAR R: REGS);
VAR VAR
i: INTEGER; i: INTEGER;
@ -401,14 +411,11 @@ BEGIN
END GetAnyVarReg; END GetAnyVarReg;
PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS; PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
VAR VAR
R: REGS;
i: INTEGER; i: INTEGER;
BEGIN BEGIN
NEW(R);
R.regs := regs; R.regs := regs;
R.pushed := 0; R.pushed := 0;
R.top := -1; R.top := -1;
@ -427,8 +434,7 @@ BEGIN
R.size[i] := 0 R.size[i] := 0
END END
RETURN R END Init;
END Create;
END REG. END REG.

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

@ -1,46 +1,47 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE SCAN; MODULE SCAN;
IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS; IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
CONST CONST
LEXLEN = 1024; LEXLEN = 1024;
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3; lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7; lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
lxEOF* = 8; lxEOF* = 8;
lxKW = 101; lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;
lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;
lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;
lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;
lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;
lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;
lxASSIGN* = 45; lxRANGE* = 46;
lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104; lxKW = 51;
lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108;
lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112;
lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116;
lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120;
lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124;
lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128;
lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132;
lxWHILE* = 133;
lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204; lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;
lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208; lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;
lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212; lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;
lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216; lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;
lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220; lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;
lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224; lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;
lxASSIGN* = 225; lxRANGE* = 226; lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;
lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;
lxWHILE* = 83;
lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4; lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8; lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8;
lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12; lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
lxERROR13* = -13;
TYPE TYPE
@ -62,25 +63,20 @@ TYPE
LEX* = RECORD LEX* = RECORD
s*: LEXSTR; s*: LEXSTR;
length*: INTEGER; length*: INTEGER;
sym*: INTEGER; sym*: INTEGER;
pos*: POSITION; pos*: POSITION;
ident*: IDENT; ident*: IDENT;
string*: IDENT; string*: IDENT;
value*: ARITH.VALUE; value*: ARITH.VALUE;
error*: INTEGER; error*: INTEGER;
over: BOOLEAN over: BOOLEAN
END; END;
SCANNER* = POINTER TO RECORD (C.ITEM) SCANNER* = TXT.TEXT;
text: TEXTDRV.TEXT;
range: BOOLEAN
END;
KEYWORD = ARRAY 10 OF CHAR; KEYWORD = ARRAY 10 OF CHAR;
@ -89,16 +85,14 @@ VAR
vocabulary: RECORD vocabulary: RECORD
KW: ARRAY 33 OF KEYWORD; KW: ARRAY 33 OF KEYWORD;
delimiters: ARRAY 256 OF BOOLEAN;
delimiters: ARRAY 256 OF BOOLEAN; idents: AVL.NODE;
ident: IDENT
idents: AVL.NODE;
ident: IDENT
END; END;
scanners: C.COLLECTION; upto: BOOLEAN;
PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
@ -109,36 +103,27 @@ END nodecmp;
PROCEDURE key (VAR lex: LEX); PROCEDURE key (VAR lex: LEX);
VAR VAR
L, R, M: INTEGER; L, R, M: INTEGER;
found: BOOLEAN;
BEGIN BEGIN
L := 0; L := 0;
R := LEN(vocabulary.KW) - 1; R := LEN(vocabulary.KW) - 1;
M := (L + R) DIV 2; found := FALSE;
WHILE L # M DO REPEAT
IF lex.s > vocabulary.KW[M] THEN M := (L + R) DIV 2;
L := M;
M := (L + R) DIV 2 IF lex.s # vocabulary.KW[M] THEN
ELSIF lex.s < vocabulary.KW[M] THEN IF lex.s > vocabulary.KW[M] THEN
R := M; L := M + 1
M := (L + R) DIV 2 ELSE
R := M - 1
END
ELSE ELSE
lex.sym := lxKW + M; found := TRUE;
L := M; lex.sym := lxKW + M
R := M
END END
END; UNTIL found OR (L > R)
IF L # R THEN
IF lex.s = vocabulary.KW[L] THEN
lex.sym := lxKW + L
END;
IF lex.s = vocabulary.KW[R] THEN
lex.sym := lxKW + R
END
END
END key; END key;
@ -173,18 +158,24 @@ BEGIN
END putchar; END putchar;
PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX); PROCEDURE nextc (text: TXT.TEXT): CHAR;
BEGIN
TXT.next(text)
RETURN text.peak
END nextc;
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
VAR VAR
c: CHAR; c: CHAR;
BEGIN BEGIN
c := text.peak(text); c := text.peak;
ASSERT(S.letter(c)); ASSERT(S.letter(c));
WHILE S.letter(c) OR S.digit(c) DO WHILE S.letter(c) OR S.digit(c) DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text)
c := text.peak(text)
END; END;
IF lex.over THEN IF lex.over THEN
@ -201,44 +192,40 @@ BEGIN
END ident; END ident;
PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
VAR VAR
c: CHAR; c: CHAR;
hex: BOOLEAN; hex: BOOLEAN;
error: INTEGER; error: INTEGER;
BEGIN BEGIN
c := text.peak(text); c := text.peak;
ASSERT(S.digit(c)); ASSERT(S.digit(c));
error := 0; error := 0;
range := FALSE;
lex.sym := lxINTEGER; lex.sym := lxINTEGER;
hex := FALSE; hex := FALSE;
WHILE S.digit(c) DO WHILE S.digit(c) DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text)
c := text.peak(text)
END; END;
WHILE S.hexdigit(c) DO WHILE S.hexdigit(c) DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text);
c := text.peak(text);
hex := TRUE hex := TRUE
END; END;
IF c = "H" THEN IF c = "H" THEN
putchar(lex, c); putchar(lex, c);
text.nextc(text); TXT.next(text);
lex.sym := lxHEX lex.sym := lxHEX
ELSIF c = "X" THEN ELSIF c = "X" THEN
putchar(lex, c); putchar(lex, c);
text.nextc(text); TXT.next(text);
lex.sym := lxCHAR lex.sym := lxCHAR
ELSIF c = "." THEN ELSIF c = "." THEN
@ -247,39 +234,35 @@ BEGIN
lex.sym := lxERROR01 lex.sym := lxERROR01
ELSE ELSE
text.nextc(text); c := nextc(text);
c := text.peak(text);
IF c # "." THEN IF c # "." THEN
putchar(lex, "."); putchar(lex, ".");
lex.sym := lxFLOAT lex.sym := lxFLOAT
ELSE ELSE
lex.sym := lxINTEGER; lex.sym := lxINTEGER;
range := TRUE text.peak := 7FX;
upto := TRUE
END; END;
WHILE S.digit(c) DO WHILE S.digit(c) DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text)
c := text.peak(text)
END; END;
IF c = "E" THEN IF c = "E" THEN
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text);
c := text.peak(text);
IF (c = "+") OR (c = "-") THEN IF (c = "+") OR (c = "-") THEN
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text)
c := text.peak(text)
END; END;
IF S.digit(c) THEN IF S.digit(c) THEN
WHILE S.digit(c) DO WHILE S.digit(c) DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text)
c := text.peak(text)
END END
ELSE ELSE
lex.sym := lxERROR02 lex.sym := lxERROR02
@ -289,11 +272,8 @@ BEGIN
END END
ELSE ELSIF hex THEN
lex.sym := lxERROR01
IF hex THEN
lex.sym := lxERROR01
END
END; END;
@ -321,31 +301,23 @@ BEGIN
END number; END number;
PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX); PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
VAR VAR
c, c1: CHAR; c: CHAR;
n: INTEGER; n: INTEGER;
quot: CHAR;
BEGIN BEGIN
quot := text.peak(text); c := nextc(text);
n := 0;
ASSERT((quot = '"') OR (quot = "'"));
text.nextc(text);
c := text.peak(text);
c1 := c;
n := 0;
WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text);
c := text.peak(text);
INC(n) INC(n)
END; END;
IF c = quot THEN IF c = quot THEN
text.nextc(text); TXT.next(text);
IF lex.over THEN IF lex.over THEN
lex.sym := lxERROR05 lex.sym := lxERROR05
ELSE ELSE
@ -353,7 +325,7 @@ BEGIN
lex.sym := lxSTRING lex.sym := lxSTRING
ELSE ELSE
lex.sym := lxCHAR; lex.sym := lxCHAR;
ARITH.setChar(lex.value, ORD(c1)) ARITH.setChar(lex.value, ORD(lex.s[0]))
END END
END END
ELSE ELSE
@ -369,19 +341,19 @@ BEGIN
END string; END string;
PROCEDURE comment (text: TEXTDRV.TEXT); PROCEDURE comment (text: TXT.TEXT);
VAR VAR
c: CHAR; c: CHAR;
cond, depth: INTEGER; cond, depth: INTEGER;
BEGIN BEGIN
cond := 0; cond := 0;
depth := 1; depth := 1;
REPEAT REPEAT
c := text.peak(text); c := text.peak;
text.nextc(text); TXT.next(text);
IF c = "*" THEN IF c = "*" THEN
IF cond = 1 THEN IF cond = 1 THEN
@ -406,21 +378,12 @@ BEGIN
END comment; END comment;
PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
VAR
c: CHAR;
BEGIN BEGIN
c := text.peak(text);
IF range THEN
ASSERT(c = ".")
END;
putchar(lex, c); putchar(lex, c);
text.nextc(text); c := nextc(text);
CASE c OF CASE lex.s[0] OF
|"+": |"+":
lex.sym := lxPLUS lex.sym := lxPLUS
@ -433,10 +396,10 @@ BEGIN
|"/": |"/":
lex.sym := lxSLASH; lex.sym := lxSLASH;
IF text.peak(text) = "/" THEN IF c = "/" THEN
lex.sym := lxCOMMENT; lex.sym := lxCOMMENT;
REPEAT REPEAT
text.nextc(text) TXT.next(text)
UNTIL text.eol OR text.eof UNTIL text.eol OR text.eof
END END
@ -447,24 +410,12 @@ BEGIN
lex.sym := lxAND lex.sym := lxAND
|".": |".":
IF range THEN lex.sym := lxPOINT;
putchar(lex, "."); IF c = "." THEN
lex.sym := lxRANGE; lex.sym := lxRANGE;
range := FALSE; putchar(lex, c);
DEC(lex.pos.col) TXT.next(text)
ELSE
lex.sym := lxPOINT;
c := text.peak(text);
IF c = "." THEN
lex.sym := lxRANGE;
putchar(lex, c);
text.nextc(text)
END
END END
|",": |",":
@ -478,12 +429,10 @@ BEGIN
|"(": |"(":
lex.sym := lxLROUND; lex.sym := lxLROUND;
c := text.peak(text);
IF c = "*" THEN IF c = "*" THEN
lex.sym := lxCOMMENT; lex.sym := lxCOMMENT;
putchar(lex, c); TXT.next(text);
text.nextc(text);
comment(text) comment(text)
END END
@ -504,32 +453,29 @@ BEGIN
|"<": |"<":
lex.sym := lxLT; lex.sym := lxLT;
c := text.peak(text);
IF c = "=" THEN IF c = "=" THEN
lex.sym := lxLE; lex.sym := lxLE;
putchar(lex, c); putchar(lex, c);
text.nextc(text) TXT.next(text)
END END
|">": |">":
lex.sym := lxGT; lex.sym := lxGT;
c := text.peak(text);
IF c = "=" THEN IF c = "=" THEN
lex.sym := lxGE; lex.sym := lxGE;
putchar(lex, c); putchar(lex, c);
text.nextc(text) TXT.next(text)
END END
|":": |":":
lex.sym := lxCOLON; lex.sym := lxCOLON;
c := text.peak(text);
IF c = "=" THEN IF c = "=" THEN
lex.sym := lxASSIGN; lex.sym := lxASSIGN;
putchar(lex, c); putchar(lex, c);
text.nextc(text) TXT.next(text)
END END
|")": |")":
@ -546,26 +492,21 @@ BEGIN
END delimiter; END delimiter;
PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX); PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
VAR VAR
c: CHAR; c: CHAR;
text: TEXTDRV.TEXT;
BEGIN BEGIN
text := scanner.text;
REPEAT REPEAT
c := text.peak;
c := text.peak(text);
WHILE S.space(c) DO WHILE S.space(c) DO
text.nextc(text); c := nextc(text)
c := text.peak(text)
END; END;
lex.s[0] := 0X; lex.s[0] := 0X;
lex.length := 0; lex.length := 0;
lex.sym := lxUNDEF;
lex.pos.line := text.line; lex.pos.line := text.line;
lex.pos.col := text.col; lex.pos.col := text.col;
lex.ident := NIL; lex.ident := NIL;
@ -574,19 +515,26 @@ BEGIN
IF S.letter(c) THEN IF S.letter(c) THEN
ident(text, lex) ident(text, lex)
ELSIF S.digit(c) THEN ELSIF S.digit(c) THEN
number(text, lex, scanner.range) number(text, lex)
ELSIF (c = '"') OR (c = "'") THEN ELSIF (c = '"') OR (c = "'") THEN
string(text, lex) string(text, lex, c)
ELSIF vocabulary.delimiters[ORD(c)] THEN ELSIF vocabulary.delimiters[ORD(c)] THEN
delimiter(text, lex, scanner.range) delimiter(text, lex, c)
ELSIF c = 0X THEN ELSIF c = 0X THEN
lex.sym := lxEOF; lex.sym := lxEOF;
IF text.eof THEN IF text.eof THEN
INC(lex.pos.col) INC(lex.pos.col)
END END
ELSIF (c = 7FX) & upto THEN
upto := FALSE;
lex.sym := lxRANGE;
putchar(lex, ".");
putchar(lex, ".");
DEC(lex.pos.col);
TXT.next(text)
ELSE ELSE
putchar(lex, c); putchar(lex, c);
text.nextc(text); TXT.next(text);
lex.sym := lxERROR04 lex.sym := lxERROR04
END; END;
@ -601,53 +549,14 @@ BEGIN
END Next; END Next;
PROCEDURE NewScanner (): SCANNER;
VAR
scan: SCANNER;
citem: C.ITEM;
BEGIN
citem := C.pop(scanners);
IF citem = NIL THEN
NEW(scan)
ELSE
scan := citem(SCANNER)
END
RETURN scan
END NewScanner;
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER; PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
VAR RETURN TXT.open(name)
scanner: SCANNER;
text: TEXTDRV.TEXT;
BEGIN
text := TEXTDRV.create();
IF text.open(text, name) THEN
scanner := NewScanner();
scanner.text := text;
scanner.range := FALSE
ELSE
scanner := NIL;
TEXTDRV.destroy(text)
END
RETURN scanner
END open; END open;
PROCEDURE close* (VAR scanner: SCANNER); PROCEDURE close* (VAR scanner: SCANNER);
BEGIN BEGIN
IF scanner # NIL THEN TXT.close(scanner)
IF scanner.text # NIL THEN
TEXTDRV.destroy(scanner.text)
END;
C.push(scanners, scanner);
scanner := NIL
END
END close; END close;
@ -656,14 +565,16 @@ VAR
i: INTEGER; i: INTEGER;
delim: ARRAY 23 OF CHAR; delim: ARRAY 23 OF CHAR;
PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD); PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD);
BEGIN BEGIN
vocabulary.KW[i] := kw; vocabulary.KW[i] := kw;
INC(i) INC(i)
END enterkw; END enterkw;
BEGIN BEGIN
scanners := C.create(); upto := FALSE;
FOR i := 0 TO 255 DO FOR i := 0 TO 255 DO
vocabulary.delimiters[i] := FALSE vocabulary.delimiters[i] := FALSE
@ -714,7 +625,7 @@ BEGIN
vocabulary.ident.s := ""; vocabulary.ident.s := "";
vocabulary.ident.offset := -1; vocabulary.ident.offset := -1;
vocabulary.ident.offsetW := -1; vocabulary.ident.offsetW := -1;
vocabulary.idents := NIL vocabulary.idents := NIL
END init; END init;

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

File diff suppressed because it is too large Load Diff

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

@ -92,6 +92,29 @@ BEGIN
END IntToStr; END IntToStr;
PROCEDURE hexdgt (n: BYTE): BYTE;
BEGIN
IF n < 10 THEN
n := n + ORD("0")
ELSE
n := n - 10 + ORD("A")
END
RETURN n
END hexdgt;
PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER);
BEGIN
str[n] := 0X;
WHILE n > 0 DO
str[n - 1] := CHR(hexdgt(x MOD 16));
x := x DIV 16;
DEC(n)
END
END IntToHex;
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
BEGIN BEGIN
WHILE count > 0 DO WHILE count > 0 DO
@ -261,12 +284,12 @@ BEGIN
|0E1X..0EFX: |0E1X..0EFX:
u := LSL(ORD(c) - 0E0H, 12); u := LSL(ORD(c) - 0E0H, 12);
IF i + 1 < srclen THEN IF i + 1 < srclen THEN
INC(i); INC(i);
INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64) INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64)
END; END;
IF i + 1 < srclen THEN IF i + 1 < srclen THEN
INC(i); INC(i);
INC(u, ORD(BITS(ORD(src[i])) * {0..5})) INC(u, ORD(BITS(ORD(src[i])) * {0..5}))
END END
(* (*

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

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -30,10 +30,7 @@ TYPE
line*, col*: INTEGER; line*, col*: INTEGER;
eof*: BOOLEAN; eof*: BOOLEAN;
eol*: BOOLEAN; eol*: BOOLEAN;
peak*: CHAR
open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN;
peak*: PROCEDURE (text: TEXT): CHAR;
nextc*: PROCEDURE (text: TEXT)
END; END;
@ -43,26 +40,6 @@ VAR
texts: C.COLLECTION; texts: C.COLLECTION;
PROCEDURE reset (text: TEXT);
BEGIN
text.chunk[0] := 0;
text.pos := 0;
text.size := 0;
text.file := NIL;
text.utf8 := FALSE;
text.CR := FALSE;
text.line := 1;
text.col := 1;
text.eof := FALSE;
text.eol := FALSE
END reset;
PROCEDURE peak (text: TEXT): CHAR;
RETURN CHR(text.chunk[text.pos])
END peak;
PROCEDURE load (text: TEXT); PROCEDURE load (text: TEXT);
BEGIN BEGIN
IF ~text.eof THEN IF ~text.eof THEN
@ -71,37 +48,40 @@ BEGIN
IF text.size = 0 THEN IF text.size = 0 THEN
text.eof := TRUE; text.eof := TRUE;
text.chunk[0] := 0 text.chunk[0] := 0
END END;
text.peak := CHR(text.chunk[0])
END END
END load; END load;
PROCEDURE next (text: TEXT); PROCEDURE next* (text: TEXT);
VAR VAR
c: CHAR; c: CHAR;
BEGIN BEGIN
IF text.pos < text.size - 1 THEN IF text.pos < text.size - 1 THEN
INC(text.pos) INC(text.pos);
text.peak := CHR(text.chunk[text.pos])
ELSE ELSE
load(text) load(text)
END; END;
IF ~text.eof THEN IF ~text.eof THEN
c := peak(text); c := text.peak;
IF c = CR THEN IF c = CR THEN
INC(text.line); INC(text.line);
text.col := 0; text.col := 0;
text.eol := TRUE; text.eol := TRUE;
text.CR := TRUE text.CR := TRUE
ELSIF c = LF THEN ELSIF c = LF THEN
IF ~text.CR THEN IF ~text.CR THEN
INC(text.line); INC(text.line);
text.col := 0; text.col := 0;
text.eol := TRUE text.eol := TRUE
ELSE ELSE
text.eol := FALSE text.eol := FALSE
END; END;
text.CR := FALSE text.CR := FALSE
ELSE ELSE
@ -123,7 +103,6 @@ END next;
PROCEDURE init (text: TEXT); PROCEDURE init (text: TEXT);
BEGIN BEGIN
IF (text.pos = 0) & (text.size >= 3) THEN IF (text.pos = 0) & (text.size >= 3) THEN
IF (text.chunk[0] = 0EFH) & IF (text.chunk[0] = 0EFH) &
(text.chunk[1] = 0BBH) & (text.chunk[1] = 0BBH) &
@ -140,58 +119,13 @@ BEGIN
END; END;
text.line := 1; text.line := 1;
text.col := 1 text.col := 1;
text.peak := CHR(text.chunk[text.pos])
END init; END init;
PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; PROCEDURE close* (VAR text: TEXT);
BEGIN
ASSERT(text # NIL);
reset(text);
text.file := FILES.open(name);
IF text.file # NIL THEN
load(text);
init(text)
END
RETURN text.file # NIL
END open;
PROCEDURE NewText (): TEXT;
VAR
text: TEXT;
citem: C.ITEM;
BEGIN
citem := C.pop(texts);
IF citem = NIL THEN
NEW(text)
ELSE
text := citem(TEXT)
END
RETURN text
END NewText;
PROCEDURE create* (): TEXT;
VAR
text: TEXT;
BEGIN
text := NewText();
reset(text);
text.open := open;
text.peak := peak;
text.nextc := next
RETURN text
END create;
PROCEDURE destroy* (VAR text: TEXT);
BEGIN BEGIN
IF text # NIL THEN IF text # NIL THEN
IF text.file # NIL THEN IF text.file # NIL THEN
@ -201,7 +135,44 @@ BEGIN
C.push(texts, text); C.push(texts, text);
text := NIL text := NIL
END END
END destroy; END close;
PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
VAR
text: TEXT;
citem: C.ITEM;
BEGIN
citem := C.pop(texts);
IF citem = NIL THEN
NEW(text)
ELSE
text := citem(TEXT)
END;
IF text # NIL THEN
text.chunk[0] := 0;
text.pos := 0;
text.size := 0;
text.utf8 := FALSE;
text.CR := FALSE;
text.line := 1;
text.col := 1;
text.eof := FALSE;
text.eol := FALSE;
text.peak := 0X;
text.file := FILES.open(name);
IF text.file # NIL THEN
load(text);
init(text)
ELSE
close(text)
END
END
RETURN text
END open;
BEGIN BEGIN

9
programs/develop/oberon07/Source/UNIXTIME.ob07
View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -55,12 +55,7 @@ END init;
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
VAR RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
d, s: INTEGER;
BEGIN
d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4;
s := d * 86400 + hour * 3600 + min * 60 + sec
RETURN s
END time; END time;

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

@ -17,9 +17,12 @@ CONST
bit_depth* = HOST.bit_depth; bit_depth* = HOST.bit_depth;
maxint* = HOST.maxint; maxint* = HOST.maxint;
minint* = HOST.minint; minint* = HOST.minint;
OS = HOST.OS; OS = HOST.OS;
min32* = -2147483647-1;
max32* = 2147483647;
VAR VAR
@ -29,6 +32,22 @@ VAR
maxreal*: REAL; maxreal*: REAL;
target*:
RECORD
bit_depth*,
maxInt*,
minInt*,
maxSet*,
maxHex*: INTEGER;
maxReal*: REAL
END;
bit_diff*: INTEGER;
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
RETURN HOST.FileRead(F, Buffer, bytes) RETURN HOST.FileRead(F, Buffer, bytes)
@ -112,6 +131,76 @@ BEGIN
END UnixTime; END UnixTime;
PROCEDURE SetBitDepth* (BitDepth: INTEGER);
BEGIN
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
bit_diff := bit_depth - BitDepth;
ASSERT(bit_diff >= 0);
target.bit_depth := BitDepth;
target.maxSet := BitDepth - 1;
target.maxHex := BitDepth DIV 4;
target.minInt := ASR(minint, bit_diff);
target.maxInt := ASR(maxint, bit_diff);
target.maxReal := 1.9;
PACK(target.maxReal, 1023);
END SetBitDepth;
PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
RETURN ASR(n, 8 * idx) MOD 256
END Byte;
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
VAR
res: BOOLEAN;
BEGIN
IF bytes MOD align # 0 THEN
res := maxint - bytes >= align - (bytes MOD align);
IF res THEN
bytes := bytes + align - (bytes MOD align)
END
ELSE
res := TRUE
END
RETURN res
END Align;
PROCEDURE Long* (value: INTEGER): INTEGER;
RETURN ASR(LSL(value, bit_diff), bit_diff)
END Long;
PROCEDURE Short* (value: INTEGER): INTEGER;
RETURN LSR(LSL(value, bit_diff), bit_diff)
END Short;
PROCEDURE Log2* (x: INTEGER): INTEGER;
VAR
n: INTEGER;
BEGIN
ASSERT(x > 0);
n := 0;
WHILE ~ODD(x) DO
x := x DIV 2;
INC(n)
END;
IF x # 1 THEN
n := -1
END
RETURN n
END Log2;
BEGIN BEGIN
time := GetTickCount(); time := GetTickCount();
COPY(HOST.eol, eol); COPY(HOST.eol, eol);

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

@ -1,13 +1,13 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018, Anton Krotov Copyright (c) 2018, 2019, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE WRITER; MODULE WRITER;
IMPORT FILES, ERRORS, MACHINE; IMPORT FILES, ERRORS, UTILS;
TYPE TYPE
@ -35,7 +35,7 @@ BEGIN
IF FILES.WriteByte(file, n) THEN IF FILES.WriteByte(file, n) THEN
INC(counter) INC(counter)
ELSE ELSE
ERRORS.error1("writing file error") ERRORS.Error(201)
END END
END WriteByte; END WriteByte;
@ -47,7 +47,7 @@ VAR
BEGIN BEGIN
n := FILES.write(file, chunk, bytes); n := FILES.write(file, chunk, bytes);
IF n # bytes THEN IF n # bytes THEN
ERRORS.error1("writing file error") ERRORS.Error(201)
END; END;
INC(counter, n) INC(counter, n)
END Write; END Write;
@ -59,7 +59,7 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 7 DO FOR i := 0 TO 7 DO
WriteByte(file, MACHINE.Byte(n, i)) WriteByte(file, UTILS.Byte(n, i))
END END
END Write64LE; END Write64LE;
@ -70,15 +70,15 @@ VAR
BEGIN BEGIN
FOR i := 0 TO 3 DO FOR i := 0 TO 3 DO
WriteByte(file, MACHINE.Byte(n, i)) WriteByte(file, UTILS.Byte(n, i))
END END
END Write32LE; END Write32LE;
PROCEDURE Write16LE* (file: FILE; n: INTEGER); PROCEDURE Write16LE* (file: FILE; n: INTEGER);
BEGIN BEGIN
WriteByte(file, MACHINE.Byte(n, 0)); WriteByte(file, UTILS.Byte(n, 0));
WriteByte(file, MACHINE.Byte(n, 1)) WriteByte(file, UTILS.Byte(n, 1))
END Write16LE; END Write16LE;

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

File diff suppressed because it is too large Load Diff