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

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

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

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

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

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

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

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

@ -17,7 +17,7 @@
MODULE File;
IMPORT sys := SYSTEM, KOSAPI;
IMPORT sys := SYSTEM, KOSAPI;
CONST
@ -47,7 +47,7 @@ TYPE
time_modif*, date_modif*,
size*, hsize*: INTEGER;
name*: FNAME
END;
END;
PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
@ -67,7 +67,7 @@ BEGIN
0C2H, 008H, 000H (* ret 8 *)
)
RETURN 0
END f_68_27;
END f_68_27;
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;
VAR
res2: INTEGER; fs: rFS;
res2: INTEGER; fs: rFS;
BEGIN
fs.subfunc := 5;
@ -88,7 +88,7 @@ BEGIN
COPY(FName, fs.name)
RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
END GetFileInfo;
END GetFileInfo;
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
@ -97,7 +97,7 @@ VAR
BEGIN
RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists;
PROCEDURE Close* (VAR F: FS);
BEGIN
@ -109,9 +109,9 @@ END Close;
PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
VAR
F: FS;
F: FS;
BEGIN
BEGIN
IF Exists(FName) THEN
NEW(F);
@ -128,7 +128,7 @@ BEGIN
END
RETURN F
END Open;
END Open;
PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
@ -158,7 +158,7 @@ BEGIN
RETURN res = 0
END Delete;
PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
VAR
@ -202,7 +202,7 @@ BEGIN
END
RETURN res2
END Read;
END Read;
PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
@ -225,7 +225,7 @@ BEGIN
RETURN res2
END Write;
PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
VAR
@ -249,14 +249,14 @@ BEGIN
RETURN F
END Create;
PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN;
VAR
fd: rFD;
BEGIN
RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr))
END DirExists;
END DirExists;
PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
@ -282,7 +282,7 @@ BEGIN
RETURN res = 0
END CreateDir;
PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
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
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;
BEGIN
BEGIN
SYSTEM.CODE(
0D9H, 0E8H, (* fld1 *)
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
0DDH, 045H, 010H, (* fld qword [ebp + 10h] *)
0D9H, 0F1H, (* fyl2x *)
0D9H, 0E8H, (* fld1 *)
0DDH, 045H, 008H, (* fld qword [ebp + 08h] *)
@ -251,58 +251,45 @@ END arctan;
PROCEDURE sinh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
IF IsZero(x) THEN
res := 0.0
ELSE
res := (exp(x) - exp(-x)) / 2.0
END
RETURN res
x := exp(x)
RETURN (x - 1.0 / x) * 0.5
END sinh;
PROCEDURE cosh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
IF IsZero(x) THEN
res := 1.0
ELSE
res := (exp(x) + exp(-x)) / 2.0
END
RETURN res
x := exp(x)
RETURN (x + 1.0 / x) * 0.5
END cosh;
PROCEDURE tanh* (x: REAL): REAL;
VAR
res: REAL;
BEGIN
IF IsZero(x) THEN
res := 0.0
IF x > 15.0 THEN
x := 1.0
ELSIF x < -15.0 THEN
x := -1.0
ELSE
res := sinh(x) / cosh(x)
x := exp(2.0 * x);
x := (x - 1.0) / (x + 1.0)
END
RETURN res
RETURN x
END tanh;
PROCEDURE arcsinh* (x: REAL): REAL;
RETURN ln(x + sqrt((x * x) + 1.0))
END arcsinh;
PROCEDURE arsinh* (x: REAL): REAL;
RETURN ln(x + sqrt(x * x + 1.0))
END arsinh;
PROCEDURE arccosh* (x: REAL): REAL;
RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
END arccosh;
PROCEDURE arcosh* (x: REAL): REAL;
RETURN ln(x + sqrt(x * x - 1.0))
END arcosh;
PROCEDURE arctanh* (x: REAL): REAL;
PROCEDURE artanh* (x: REAL): REAL;
VAR
res: REAL;
@ -315,7 +302,7 @@ BEGIN
res := 0.5 * ln((1.0 + x) / (1.0 - x))
END
RETURN res
END arctanh;
END artanh;
PROCEDURE floor* (x: REAL): REAL;
@ -374,8 +361,24 @@ BEGIN
ELSE
res := 0
END
RETURN res
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.

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

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

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

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

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

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

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;
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);
VAR
i, len, ptr: INTEGER;

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

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

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

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

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

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

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

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

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

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

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

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

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
Copyright (c) 2018, 2019, Anton Krotov
All rights reserved.
*)
@ -118,11 +118,46 @@ BEGIN
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);
VAR
chunk: BYTECHUNK;
BEGIN
BEGIN
chunk := list.first(BYTECHUNK);
WHILE chunk # NIL DO
WR.Write(file, chunk.data, chunk.count);

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

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

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

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

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

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

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

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

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

@ -7,7 +7,7 @@
MODULE ELF;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS;
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS;
CONST
@ -68,9 +68,35 @@ TYPE
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;
VAR
dynamic: LISTS.LIST;
strtab: CHL.BYTELIST;
symtab: LISTS.LIST;
hashtab, bucket, chain: CHL.INTLIST;
PROCEDURE align (n, _align: INTEGER): INTEGER;
BEGIN
IF n MOD _align # 0 THEN
@ -136,7 +162,75 @@ BEGIN
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
interp = 0;
dyn = 1;
@ -145,33 +239,67 @@ CONST
data = 4;
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
ehdr: Elf32_Ehdr;
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;
Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END;
File: FILE;
str: ARRAY 40 OF CHAR; lstr: INTEGER;
Dyn: ARRAY 350 OF BYTE;
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
item: LISTS.ITEM;
Name: ARRAY 2048 OF CHAR;
BEGIN
IF amd64 THEN
str := "/lib64/ld-linux-x86-64.so.2"
ELSE
str := "/lib/ld-linux.so.2"
END;
lstr := LENGTH(str);
dynamic := LISTS.create(NIL);
symtab := LISTS.create(NIL);
strtab := CHL.CreateByteList();
IF amd64 THEN
LoadAdr := 400000H
BaseAdr := exeBaseAddress64;
Interpreter := linuxInterpreter64
ELSE
LoadAdr := 08048000H
BaseAdr := exeBaseAddress32;
Interpreter := linuxInterpreter32
END;
IF so THEN
BaseAdr := dllBaseAddress
END;
lenInterpreter := LENGTH(Interpreter) + 1;
SizeOf.code := CHL.Length(program.code);
SizeOf.data := CHL.Length(program.data);
SizeOf.bss := program.bss;
@ -192,7 +320,12 @@ BEGIN
ehdr.e_ident[i] := 0
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_shoff := 0;
ehdr.e_flags := 0;
@ -218,24 +351,92 @@ BEGIN
phdr[interp].p_type := 3;
phdr[interp].p_offset := SizeOf.header;
phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset;
phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset;
phdr[interp].p_filesz := lstr + 1;
phdr[interp].p_memsz := lstr + 1;
phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
phdr[interp].p_paddr := phdr[interp].p_vaddr;
phdr[interp].p_filesz := lenInterpreter;
phdr[interp].p_memsz := lenInterpreter;
phdr[interp].p_flags := PF_R;
phdr[interp].p_align := 1;
phdr[dyn].p_type := 2;
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset;
phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset;
IF amd64 THEN
phdr[dyn].p_filesz := 0A0H;
phdr[dyn].p_memsz := 0A0H
ELSE
phdr[dyn].p_filesz := 50H;
phdr[dyn].p_memsz := 50H
phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
hashtab := CHL.CreateIntList();
CHL.PushInt(hashtab, HashStr(""));
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
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;
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_align := 1;
@ -243,20 +444,15 @@ BEGIN
phdr[header].p_type := 1;
phdr[header].p_offset := offset;
phdr[header].p_vaddr := LoadAdr;
phdr[header].p_paddr := LoadAdr;
IF amd64 THEN
phdr[header].p_filesz := 305H;
phdr[header].p_memsz := 305H
ELSE
phdr[header].p_filesz := 1D0H;
phdr[header].p_memsz := 1D0H
END;
phdr[header].p_vaddr := BaseAdr;
phdr[header].p_paddr := BaseAdr;
phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz;
phdr[header].p_memsz := phdr[header].p_filesz;
phdr[header].p_flags := PF_R + PF_W;
phdr[header].p_align := 1000H;
offset := offset + phdr[header].p_filesz;
VA := LoadAdr + offset + 1000H;
VA := BaseAdr + offset + 1000H;
phdr[text].p_type := 1;
phdr[text].p_offset := offset;
@ -268,9 +464,9 @@ BEGIN
phdr[text].p_align := 1000H;
ehdr.e_entry := phdr[text].p_vaddr;
offset := offset + phdr[text].p_filesz;
VA := LoadAdr + offset + 2000H;
VA := BaseAdr + offset + 2000H;
pad := (16 - VA MOD 16) MOD 16;
phdr[data].p_type := 1;
@ -281,9 +477,9 @@ BEGIN
phdr[data].p_memsz := SizeOf.data + pad;
phdr[data].p_flags := PF_R + PF_W;
phdr[data].p_align := 1000H;
offset := offset + phdr[data].p_filesz;
VA := LoadAdr + offset + 3000H;
VA := BaseAdr + offset + 3000H;
phdr[bss].p_type := 1;
phdr[bss].p_offset := offset;
@ -294,7 +490,20 @@ BEGIN
phdr[bss].p_flags := PF_R + PF_W;
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);
@ -340,34 +549,94 @@ BEGIN
WritePH(File, phdr[bss])
END;
FOR i := 0 TO lstr DO
WR.WriteByte(File, ORD(str[i]))
FOR i := 0 TO lenInterpreter - 1 DO
WR.WriteByte(File, ORD(Interpreter[i]))
END;
i := 0;
IF amd64 THEN
BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000");
BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000");
BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000");
BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000");
BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000");
BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000");
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;
item := dynamic.first;
WHILE item # NIL DO
WR.Write64LE(File, item(Elf32_Dyn).d_tag);
WR.Write64LE(File, item(Elf32_Dyn).d_val);
item := item.next
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);
WHILE pad > 0 DO

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

@ -7,25 +7,35 @@
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
IF hint = 0 THEN
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(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
C.String("variable '"); C.String(name); C.StringLn("' never used")
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
str: ARRAY 80 OF CHAR;
BEGIN
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
| 1: str := "missing 'H' or 'X'"
@ -36,6 +46,7 @@ BEGIN
| 6: str := "identifier too long"
| 7: str := "number too long"
| 8..12: str := "number too large"
| 13: str := "real numbers not supported"
| 21: str := "'MODULE' expected"
| 22: str := "identifier expected"
@ -79,7 +90,7 @@ BEGIN
| 60: str := "identifier does not match procedure name"
| 61: str := "illegally marked identifier"
| 62: str := "expression should be constant"
| 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected"
| 63: str := "not enough RAM"
| 64: str := "'(' expected"
| 65: str := "',' expected"
| 66: str := "incompatible parameter"
@ -126,46 +137,81 @@ BEGIN
|107: str := "too large parameter of CHR"
|108: str := "a variable or a procedure expected"
|109: str := "expression should be constant"
|110: str := "'noalign' expected"
|111: str := "record [noalign] cannot have a base type"
|112: str := "record [noalign] cannot be a base type"
|113: str := "result type of procedure should not be REAL"
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|115: str := "recursive constant definition"
|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"
|122: str := "negative divisor"
|123: str := "illegal flag"
|124: str := "unknown flag"
|125: str := "flag not supported"
END;
C.StringLn(str);
C.String(" file: "); C.StringLn(fname);
UTILS.Exit(1)
END errormsg;
END ErrorMsg;
PROCEDURE error1* (s1: ARRAY OF CHAR);
PROCEDURE Error1 (s1: ARRAY OF CHAR);
BEGIN
C.Ln;
C.StringLn(s1);
UTILS.Exit(1)
END error1;
END Error1;
PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR);
PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
BEGIN
C.Ln;
C.String(s1); C.String(s2); C.StringLn(s3);
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
C.Ln;
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
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.

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

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

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

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
Copyright (c) 2018, 2019, Anton Krotov
All rights reserved.
*)
@ -168,14 +168,32 @@ BEGIN
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;
BEGIN
IF list = NIL THEN
NEW(list)
END;
list.first := NIL;
list.last := NIL
list.first := NIL;
list.last := NIL
RETURN list
END create;

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

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

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

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018, Anton Krotov
Copyright (c) 2018, 2019, Anton Krotov
All rights reserved.
*)
@ -12,11 +12,11 @@ IMPORT STRINGS, UTILS;
CONST
slash = UTILS.slash;
slash = UTILS.slash;
PATHLEN = 2048;
TYPE
PATH* = ARRAY PATHLEN OF CHAR;
@ -92,12 +92,12 @@ BEGIN
res[i] := 0X
END
END RelPath;
END RelPath;
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
RETURN UTILS.isRelative(path)
END isRelative;
END isRelative;
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;
R0* = 0; R1* = 1; R2* = 2;
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
R0* = 0; R1* = 1; R2* = 2; R3* = 3;
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;
@ -24,7 +26,7 @@ TYPE
OP2 = PROCEDURE (arg1, arg2: INTEGER);
OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER);
REGS* = POINTER TO RECORD
REGS* = RECORD
regs*: SET;
stk*: ARRAY N OF INTEGER;
@ -42,7 +44,7 @@ TYPE
END;
PROCEDURE push (R: REGS);
PROCEDURE push (VAR R: REGS);
VAR
i, reg: INTEGER;
@ -58,7 +60,7 @@ BEGIN
END push;
PROCEDURE pop (R: REGS; reg: INTEGER);
PROCEDURE pop (VAR R: REGS; reg: INTEGER);
VAR
i: INTEGER;
@ -111,7 +113,7 @@ BEGIN
END GetFreeReg;
PROCEDURE Put (R: REGS; reg: INTEGER);
PROCEDURE Put (VAR R: REGS; reg: INTEGER);
BEGIN
EXCL(R.regs, reg);
INC(R.top);
@ -119,7 +121,7 @@ BEGIN
END Put;
PROCEDURE PopAnyReg (R: REGS): INTEGER;
PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
VAR
reg: INTEGER;
@ -134,7 +136,7 @@ BEGIN
END PopAnyReg;
PROCEDURE GetAnyReg* (R: REGS): INTEGER;
PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
VAR
reg: INTEGER;
@ -152,13 +154,13 @@ BEGIN
END GetAnyReg;
PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN;
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
VAR
free, n: INTEGER;
res: BOOLEAN;
PROCEDURE exch (R: REGS; reg1, reg2: INTEGER);
PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
VAR
n1, n2: INTEGER;
@ -201,7 +203,7 @@ BEGIN
END GetReg;
PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN;
PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
VAR
n1, n2: INTEGER;
res: BOOLEAN;
@ -239,14 +241,14 @@ BEGIN
END Exchange;
PROCEDURE Drop* (R: REGS);
PROCEDURE Drop* (VAR R: REGS);
BEGIN
INCL(R.regs, R.stk[R.top]);
DEC(R.top)
END Drop;
PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER);
PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
BEGIN
IF R.top > 0 THEN
reg1 := R.stk[R.top - 1];
@ -261,7 +263,7 @@ BEGIN
END BinOp;
PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER);
PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
BEGIN
IF R.top >= 0 THEN
reg := R.stk[R.top]
@ -271,7 +273,7 @@ BEGIN
END UnOp;
PROCEDURE PushAll* (R: REGS);
PROCEDURE PushAll* (VAR R: REGS);
BEGIN
WHILE R.top >= 0 DO
push(R)
@ -279,7 +281,15 @@ BEGIN
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
ASSERT(reg IN R.vregs);
ASSERT(offs # 0);
@ -291,7 +301,7 @@ BEGIN
END Lock;
PROCEDURE Release* (R: REGS; reg: INTEGER);
PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
BEGIN
ASSERT(reg IN R.vregs);
R.offs[reg] := 0
@ -350,7 +360,7 @@ BEGIN
END Restore;
PROCEDURE Reset* (R: REGS);
PROCEDURE Reset* (VAR R: REGS);
VAR
i: INTEGER;
@ -401,14 +411,11 @@ BEGIN
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
R: REGS;
i: INTEGER;
BEGIN
NEW(R);
R.regs := regs;
R.pushed := 0;
R.top := -1;
@ -427,8 +434,7 @@ BEGIN
R.size[i] := 0
END
RETURN R
END Create;
END Init;
END REG.

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

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

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

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

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

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

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

@ -17,9 +17,12 @@ CONST
bit_depth* = HOST.bit_depth;
maxint* = HOST.maxint;
minint* = HOST.minint;
OS = HOST.OS;
min32* = -2147483647-1;
max32* = 2147483647;
VAR
@ -29,6 +32,22 @@ VAR
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;
RETURN HOST.FileRead(F, Buffer, bytes)
@ -112,6 +131,76 @@ BEGIN
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
time := GetTickCount();
COPY(HOST.eol, eol);

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

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

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

File diff suppressed because it is too large Load Diff