Explorar el Código

SVI Добавление кода

SVI hace 2 años
padre
commit
4a93a81c08
Se han modificado 100 ficheros con 22466 adiciones y 0 borrados
  1. BIN
      Compiler.exe
  2. BIN
      Compiler.kex
  3. 16 0
      Makefile
  4. 2 0
      SamplesMSP430.cmd
  5. 2 0
      SamplesSTM32.cmd
  6. 2 0
      SamplesWin32.cmd
  7. 2 0
      SamplesWin64.cmd
  8. 2 0
      SelfKolibriOS.cmd
  9. 2 0
      SelfLinux32.cmd
  10. 2 0
      SelfLinux64.cmd
  11. 2 0
      SelfWin32.cmd
  12. 2 0
      SelfWin64.cmd
  13. 0 0
      bin/.gitkeep
  14. BIN
      compiler
  15. 61 0
      doc/CC.txt
  16. 566 0
      doc/KOSLib.txt
  17. 548 0
      doc/MSP430.txt
  18. BIN
      doc/Oberon07.Report_2016_05_03.pdf
  19. 454 0
      doc/STM32.txt
  20. 312 0
      doc/WinLib.txt
  21. 425 0
      doc/x86.txt
  22. 406 0
      doc/x86_64.txt
  23. 123 0
      lib/KOSDRV/API.ob07
  24. 292 0
      lib/KOSDRV/Debug.ob07
  25. 548 0
      lib/KOSDRV/RTL.ob07
  26. 131 0
      lib/KOSKER/API.ob07
  27. 292 0
      lib/KOSKER/Debug.ob07
  28. 548 0
      lib/KOSKER/RTL.ob07
  29. 290 0
      lib/KolibriOS/API.ob07
  30. 100 0
      lib/KolibriOS/Args.ob07
  31. 105 0
      lib/KolibriOS/ColorDlg.ob07
  32. 94 0
      lib/KolibriOS/Console.ob07
  33. 103 0
      lib/KolibriOS/ConsoleLib.ob07
  34. 141 0
      lib/KolibriOS/DateTime.ob07
  35. 292 0
      lib/KolibriOS/Debug.ob07
  36. 330 0
      lib/KolibriOS/File.ob07
  37. 553 0
      lib/KolibriOS/HOST.ob07
  38. 282 0
      lib/KolibriOS/In.ob07
  39. 436 0
      lib/KolibriOS/KOSAPI.ob07
  40. 449 0
      lib/KolibriOS/Math.ob07
  41. 107 0
      lib/KolibriOS/NetDevices.ob07
  42. 158 0
      lib/KolibriOS/OpenDlg.ob07
  43. 267 0
      lib/KolibriOS/Out.ob07
  44. 543 0
      lib/KolibriOS/RTL.ob07
  45. 124 0
      lib/KolibriOS/RasterWorks.ob07
  46. 46 0
      lib/KolibriOS/Read.ob07
  47. 64 0
      lib/KolibriOS/UnixTime.ob07
  48. 121 0
      lib/KolibriOS/Vector.ob07
  49. 46 0
      lib/KolibriOS/Write.ob07
  50. 492 0
      lib/KolibriOS/kfonts.ob07
  51. 435 0
      lib/KolibriOS/libimg.ob07
  52. 124 0
      lib/Linux/API.ob07
  53. 70 0
      lib/Linux/Args.ob07
  54. 130 0
      lib/Linux/File.ob07
  55. 255 0
      lib/Linux/HOST.ob07
  56. 81 0
      lib/Linux/In.ob07
  57. 127 0
      lib/Linux/LINAPI.ob07
  58. 65 0
      lib/Linux/Libdl.ob07
  59. 493 0
      lib/Linux/Math.ob07
  60. 451 0
      lib/Linux/Math_x86.ob07
  61. 97 0
      lib/Linux/Out.ob07
  62. 1072 0
      lib/Linux/RTL.ob07
  63. 130 0
      lib/MSP430/MSP430.ob07
  64. 462 0
      lib/Math/CMath.ob07
  65. 33 0
      lib/Math/MathBits.ob07
  66. 99 0
      lib/Math/MathRound.ob07
  67. 238 0
      lib/Math/MathStat.ob07
  68. 81 0
      lib/Math/Rand.ob07
  69. 298 0
      lib/Math/RandExt.ob07
  70. 460 0
      lib/RVMxI/32/FPU.ob07
  71. 186 0
      lib/RVMxI/32/HOST.ob07
  72. 273 0
      lib/RVMxI/32/Out.ob07
  73. 411 0
      lib/RVMxI/32/RTL.ob07
  74. 133 0
      lib/RVMxI/32/Trap.ob07
  75. 202 0
      lib/RVMxI/64/HOST.ob07
  76. 288 0
      lib/RVMxI/64/Out.ob07
  77. 432 0
      lib/RVMxI/64/RTL.ob07
  78. 133 0
      lib/RVMxI/64/Trap.ob07
  79. 684 0
      lib/STM32CM3/FPU.ob07
  80. 478 0
      lib/STM32CM3/RTL.ob07
  81. 134 0
      lib/Windows/API.ob07
  82. 101 0
      lib/Windows/Args.ob07
  83. 100 0
      lib/Windows/Console.ob07
  84. 197 0
      lib/Windows/DateTime.ob07
  85. 149 0
      lib/Windows/File.ob07
  86. 340 0
      lib/Windows/HOST.ob07
  87. 88 0
      lib/Windows/In.ob07
  88. 493 0
      lib/Windows/Math.ob07
  89. 451 0
      lib/Windows/Math_x86.ob07
  90. 104 0
      lib/Windows/Out.ob07
  91. 1072 0
      lib/Windows/RTL.ob07
  92. 224 0
      lib/Windows/WINAPI.ob07
  93. 5 0
      samples/KolibriOS/BUILD_ALL.SH
  94. 159 0
      samples/KolibriOS/Dialogs.ob07
  95. 78 0
      samples/KolibriOS/HW.ob07
  96. 59 0
      samples/KolibriOS/HW_con.ob07
  97. 43 0
      samples/MSP430/Blink.ob07
  98. 103 0
      samples/MSP430/Button.ob07
  99. 156 0
      samples/MSP430/Flash.ob07
  100. 106 0
      samples/MSP430/Restart.ob07

BIN
Compiler.exe


BIN
Compiler.kex


+ 16 - 0
Makefile

@@ -0,0 +1,16 @@
+lin64:
+	./compiler ./source/Compiler.ob07 linux64exe -out ./bin/compiler -stk 2
+lin32:
+	./compiler ./source/Compiler.ob07 linux32exe -out ./bin/compiler32 -stk 2
+lin64sample1:
+	./compiler ./samples/linux/hello.ob07 linux64exe -out ./bin/hello -stk 2
+	./bin/hello
+lin64sample2:
+	./compiler ./samples/linux/x11/animation.ob07 linux64exe -out ./bin/animation -stk 2
+	./bin/animation
+win64:
+	./compiler ./source/Compiler.ob07 win64con -out ./bin/Compiler.exe -stk 2
+win32:
+	./compiler ./source/Compiler.ob07 win32con -out ./bin/Compiler32.exe -stk 2
+kos:
+	./compiler ./source/Compiler.ob07 kosexe -out ./bin/Compiler.kex -stk 2

+ 2 - 0
SamplesMSP430.cmd

@@ -0,0 +1,2 @@
+for %%f in (samples\MSP430\*.ob07) do Compiler.exe %%f msp430 -rom 2048 -ram 128
+@pause

+ 2 - 0
SamplesSTM32.cmd

@@ -0,0 +1,2 @@
+for %%f in (samples\STM32CM3\*.ob07) do Compiler.exe %%f stm32cm3
+@pause

+ 2 - 0
SamplesWin32.cmd

@@ -0,0 +1,2 @@
+for %%f in (samples\Windows\Console\*.ob07) do Compiler.exe %%f win32con
+@pause

+ 2 - 0
SamplesWin64.cmd

@@ -0,0 +1,2 @@
+for %%f in (samples\Windows\Console\*.ob07) do Compiler.exe %%f win64con
+@pause

+ 2 - 0
SelfKolibriOS.cmd

@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 kosexe -out bin\Compiler.kex -stk 2
+@pause

+ 2 - 0
SelfLinux32.cmd

@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 linux32exe -out bin\compiler32 -stk 2
+@pause

+ 2 - 0
SelfLinux64.cmd

@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 linux64exe -out bin\compiler -stk 2
+@pause

+ 2 - 0
SelfWin32.cmd

@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 win32con -out bin\Compiler32.exe -stk 2 -fa 512
+@pause

+ 2 - 0
SelfWin64.cmd

@@ -0,0 +1,2 @@
+Compiler.exe source\Compiler.ob07 win64con -out bin\Compiler.exe -stk 2 -fa 512
+@pause

+ 0 - 0
bin/.gitkeep


BIN
compiler


+ 61 - 0
doc/CC.txt

@@ -0,0 +1,61 @@
+Условная компиляция
+
+синтаксис:
+
+    $IF "(" ident {"|" ident} ")"
+        <...>
+    {$ELSIF "(" ident {"|" ident} ")"}
+        <...>
+    [$ELSE]
+        <...>
+    $END
+
+    где ident:
+    - одно из возможных значений параметра <target> в командной строке
+    - пользовательский идентификатор, переданный с ключом -def при компиляции
+    - один из возможных предопределенных идентификаторов:
+
+        WINDOWS   - приложение Windows
+        LINUX     - приложение Linux
+        KOLIBRIOS - приложение KolibriOS
+        CPU_X86   - приложение для процессора x86 (32-бит)
+        CPU_X8664 - приложение для процессора x86_64
+
+
+примеры:
+
+    $IF (win64con | win64gui | win64dll)
+        OS := "WIN64";
+    $ELSIF (win32con | win32gui | win32dll)
+        OS := "WIN32";
+    $ELSIF (linux64exe | linux64so)
+        OS := "LINUX64";
+    $ELSIF (linux32exe | linux32so)
+        OS := "LINUX32";
+    $ELSE
+        OS := "UNKNOWN";
+    $END
+
+
+    $IF (debug) (* -def debug *)
+        print("debug");
+    $END
+
+
+    $IF (WINDOWS)
+        $IF (CPU_X86)
+        (*windows 32*)
+
+        $ELSIF (CPU_X8664)
+        (*windows 64*)
+
+        $END
+    $ELSIF (LINUX)
+        $IF (CPU_X86)
+        (*linux 32*)
+
+        $ELSIF (CPU_X8664)
+        (*linux 64*)
+
+        $END
+    $END

+ 566 - 0
doc/KOSLib.txt

@@ -0,0 +1,566 @@
+==============================================================================
+
+        Библиотека (KolibriOS)
+
+------------------------------------------------------------------------------
+MODULE Out - консольный вывод
+
+        PROCEDURE Open
+                формально открывает консольный вывод
+
+        PROCEDURE Int(x, width: INTEGER)
+                вывод целого числа x;
+                width - количество знакомест, используемых для вывода
+
+        PROCEDURE Real(x: REAL; width: INTEGER)
+                вывод вещественного числа x в плавающем формате;
+                width - количество знакомест, используемых для вывода
+
+        PROCEDURE Char(x: CHAR)
+                вывод символа x
+
+        PROCEDURE FixReal(x: REAL; width, p: INTEGER)
+                вывод вещественного числа x в фиксированном формате;
+                width - количество знакомест, используемых для вывода;
+                p - количество знаков после десятичной точки
+
+        PROCEDURE Ln
+                переход на следующую строку
+
+        PROCEDURE String(s: ARRAY OF CHAR)
+                вывод строки s
+
+------------------------------------------------------------------------------
+MODULE In - консольный ввод
+
+        VAR Done: BOOLEAN
+                принимает значение TRUE в случае успешного выполнения
+                операции ввода, иначе FALSE
+
+        PROCEDURE Open
+                формально открывает консольный ввод,
+                также присваивает переменной Done значение TRUE
+
+        PROCEDURE Int(VAR x: INTEGER)
+                ввод числа типа INTEGER
+
+        PROCEDURE Char(VAR x: CHAR)
+                ввод символа
+
+        PROCEDURE Real(VAR x: REAL)
+                ввод числа типа REAL
+
+        PROCEDURE String(VAR s: ARRAY OF CHAR)
+                ввод строки
+
+        PROCEDURE Ln
+                ожидание нажатия ENTER
+
+------------------------------------------------------------------------------
+MODULE Console - дополнительные процедуры консольного вывода
+
+        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
+
+        PROCEDURE Cls
+                очистка окна консоли
+
+        PROCEDURE SetColor(FColor, BColor: INTEGER)
+                установка цвета консольного вывода: FColor - цвет текста,
+                BColor - цвет фона, возможные значения - вышеперечисленные
+                константы
+
+        PROCEDURE SetCursor(x, y: INTEGER)
+                установка курсора консоли в позицию (x, y)
+
+        PROCEDURE GetCursor(VAR x, y: INTEGER)
+                записывает в параметры текущие координаты курсора консоли
+
+        PROCEDURE GetCursorX(): INTEGER
+                возвращает текущую x-координату курсора консоли
+
+        PROCEDURE GetCursorY(): INTEGER
+                возвращает текущую y-координату курсора консоли
+
+------------------------------------------------------------------------------
+MODULE ConsoleLib - обертка библиотеки console.obj
+
+------------------------------------------------------------------------------
+MODULE Math - математические функции
+
+        CONST
+
+                pi = 3.141592653589793E+00
+                e  = 2.718281828459045E+00
+
+
+        PROCEDURE IsNan(x: REAL): BOOLEAN
+                возвращает TRUE, если x - не число
+
+        PROCEDURE IsInf(x: REAL): BOOLEAN
+                возвращает TRUE, если x - бесконечность
+
+        PROCEDURE sqrt(x: REAL): REAL
+                квадратный корень x
+
+        PROCEDURE exp(x: REAL): REAL
+                экспонента x
+
+        PROCEDURE ln(x: REAL): REAL
+                натуральный логарифм x
+
+        PROCEDURE sin(x: REAL): REAL
+                синус x
+
+        PROCEDURE cos(x: REAL): REAL
+                косинус x
+
+        PROCEDURE tan(x: REAL): REAL
+                тангенс x
+
+        PROCEDURE arcsin(x: REAL): REAL
+                арксинус x
+
+        PROCEDURE arccos(x: REAL): REAL
+                арккосинус x
+
+        PROCEDURE arctan(x: REAL): REAL
+                арктангенс x
+
+        PROCEDURE arctan2(y, x: REAL): REAL
+                арктангенс y/x
+
+        PROCEDURE power(base, exponent: REAL): REAL
+                возведение числа base в степень exponent
+
+        PROCEDURE log(base, x: REAL): REAL
+                логарифм x по основанию base
+
+        PROCEDURE sinh(x: REAL): REAL
+                гиперболический синус x
+
+        PROCEDURE cosh(x: REAL): REAL
+                гиперболический косинус x
+
+        PROCEDURE tanh(x: REAL): REAL
+                гиперболический тангенс x
+
+        PROCEDURE arsinh(x: REAL): REAL
+                обратный гиперболический синус x
+
+        PROCEDURE arcosh(x: REAL): REAL
+                обратный гиперболический косинус x
+
+        PROCEDURE artanh(x: REAL): REAL
+                обратный гиперболический тангенс x
+
+        PROCEDURE round(x: REAL): REAL
+                округление x до ближайшего целого
+
+        PROCEDURE frac(x: REAL): REAL;
+                дробная часть числа x
+
+        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 sgn(x: REAL): INTEGER
+                если x > 0 возвращает 1
+                если x < 0 возвращает -1
+                если x = 0 возвращает 0
+
+        PROCEDURE fact(n: INTEGER): REAL
+                факториал n
+
+------------------------------------------------------------------------------
+MODULE Debug - вывод на доску отладки
+        Интерфейс как модуль Out
+
+        PROCEDURE Open
+                открывает доску отладки
+
+------------------------------------------------------------------------------
+MODULE File - работа с файловой системой
+
+        TYPE
+
+                FNAME = ARRAY 520 OF CHAR
+
+                FS = POINTER TO rFS
+
+                rFS = RECORD (* информационная структура файла *)
+                        subfunc, pos, hpos, bytes, buffer: INTEGER;
+                        name: FNAME
+                END
+
+                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
+
+        CONST
+
+                SEEK_BEG = 0
+                SEEK_CUR = 1
+                SEEK_END = 2
+
+        PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
+                Загружает в память файл с именем FName, записывает в параметр
+                size размер файла, возвращает адрес загруженного файла
+                или 0 (ошибка). При необходимости, распаковывает
+                файл (kunpack).
+
+        PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN
+                Записывает структуру блока данных входа каталога для файла
+                или папки с именем FName в параметр Info.
+                При ошибке возвращает FALSE.
+
+        PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
+                возвращает TRUE, если файл с именем FName существует
+
+        PROCEDURE Close(VAR F: FS)
+                освобождает память, выделенную для информационной структуры
+                файла F и присваивает F значение NIL
+
+        PROCEDURE Open(FName: ARRAY OF CHAR): FS
+                возвращает указатель на информационную структуру файла с
+                именем FName, при ошибке возвращает NIL
+
+        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 Read(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 CreateDir(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 существует
+
+------------------------------------------------------------------------------
+MODULE Read - чтение основных типов данных из файла F
+
+        Процедуры возвращают TRUE в случае успешной операции чтения и
+        соответствующим образом изменяют позицию чтения/записи в
+        информационной структуре F
+
+        PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN
+
+        PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN
+
+        PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN
+
+        PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN
+
+        PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN
+
+        PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN
+
+------------------------------------------------------------------------------
+MODULE Write - запись основных типов данных в файл F
+
+        Процедуры возвращают TRUE в случае успешной операции записи и
+        соответствующим образом изменяют позицию чтения/записи в
+        информационной структуре F
+
+        PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN
+
+        PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN
+
+        PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN
+
+        PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN
+
+        PROCEDURE Set(F: File.FS; x: SET): BOOLEAN
+
+        PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN
+
+------------------------------------------------------------------------------
+MODULE DateTime - дата, время
+
+        CONST ERR = -7.0E5
+
+        PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER)
+                записывает в параметры компоненты текущей системной даты и
+                времени
+
+        PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL
+                возвращает дату, полученную из компонентов
+                Year, Month, Day, Hour, Min, Sec;
+                при ошибке возвращает константу ERR = -7.0E5
+
+        PROCEDURE 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
+                количество параметров программы, включая имя
+                исполняемого файла
+
+        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 sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER
+                Обертка для функций API ядра KolibriOS.
+                arg1 - регистр eax, arg2 - регистр ebx,
+                res2 - значение регистра ebx после системного вызова;
+                возвращает значение регистра eax после системного вызова.
+
+        PROCEDURE malloc(size: INTEGER): INTEGER
+                Выделяет блок памяти.
+                size - размер блока в байтах,
+                возвращает адрес выделенного блока
+
+        PROCEDURE free(ptr: INTEGER): INTEGER
+                Освобождает ранее выделенный блок памяти с адресом ptr,
+                возвращает 0
+
+        PROCEDURE realloc(ptr, size: INTEGER): INTEGER
+                Перераспределяет блок памяти,
+                ptr - адрес ранее выделенного блока,
+                size - новый размер,
+                возвращает указатель на перераспределенный блок,
+                0 при ошибке
+
+        PROCEDURE GetCommandLine(): INTEGER
+                Возвращает адрес строки параметров
+
+        PROCEDURE GetName(): INTEGER
+                Возвращает адрес строки с именем программы
+
+        PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER
+                Загружает DLL с полным именем name. Возвращает адрес таблицы
+                экспорта. При ошибке возвращает 0.
+
+        PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER
+                name - имя процедуры
+                lib - адрес таблицы экспорта DLL
+                Возвращает адрес процедуры. При ошибке возвращает 0.
+
+------------------------------------------------------------------------------
+MODULE ColorDlg - работа с диалогом "Color Dialog"
+
+        TYPE
+
+                Dialog = POINTER TO RECORD (* структура диалога *)
+                    status: INTEGER   (* состояние диалога:
+                                         0 - пользователь нажал Cancel
+                                         1 - пользователь нажал OK
+                                         2 - диалог открыт       *)
+
+                    color:  INTEGER   (* выбранный цвет *)
+                END
+
+        PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog
+                создать диалог
+                draw_window - процедура перерисовки основного окна
+                (TYPE DRAW_WINDOW = PROCEDURE);
+                процедура возвращает указатель на структуру диалога
+
+        PROCEDURE Show(cd: Dialog)
+                показать диалог
+                cd - указатель на структуру диалога, который был создан ранее
+                процедурой Create
+
+        PROCEDURE Destroy(VAR cd: Dialog)
+                уничтожить диалог
+                cd - указатель на структуру диалога
+
+------------------------------------------------------------------------------
+MODULE OpenDlg - работа с диалогом "Open Dialog"
+
+        TYPE
+
+                Dialog = POINTER TO RECORD (* структура диалога *)
+                    status:   INTEGER  (* состояние диалога:
+                                          0 - пользователь нажал Cancel
+                                          1 - пользователь нажал OK
+                                          2 - диалог открыт       *)
+
+                    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 Show(od: Dialog; Width, Height: INTEGER)
+                показать диалог
+                od - указатель на структуру диалога, который был создан ранее
+                     процедурой Create
+                Width и Height - ширина и высота диалогового окна
+
+        PROCEDURE Destroy(VAR od: Dialog)
+                уничтожить диалог
+                od - указатель на структуру диалога
+
+------------------------------------------------------------------------------
+MODULE kfonts - работа с kf-шрифтами
+
+        CONST
+
+                bold            =   1
+                italic          =   2
+                underline       =   4
+                strike_through  =   8
+                smoothing       =  16
+                bpp32           =  32
+
+        TYPE
+
+                TFont = POINTER TO TFont_desc (* указатель на шрифт *)
+
+        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 Enabled(Font: TFont; font_size: INTEGER): BOOLEAN
+                проверить, есть ли шрифт, заданного размера
+                Font        указатель на шрифт
+                font_size   размер шрифта
+                рез-т:          TRUE/FALSE (шрифта нет)
+
+        PROCEDURE Destroy(VAR Font: TFont)
+                выгрузить шрифт, освободить динамическую память
+                Font        указатель на шрифт
+                Присваивает переменной Font значение NIL
+
+        PROCEDURE TextHeight(Font: TFont): INTEGER
+                получить высоту строки текста
+                Font        указатель на шрифт
+                рез-т:          высота строки текста в пикселях
+
+        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-битный буфер
+                            возможно использование флагов в любых сочетаниях
+------------------------------------------------------------------------------
+MODULE RasterWorks - обертка библиотеки Rasterworks.obj
+------------------------------------------------------------------------------
+MODULE libimg - обертка библиотеки libimg.obj
+------------------------------------------------------------------------------

+ 548 - 0
doc/MSP430.txt

@@ -0,0 +1,548 @@
+        Компилятор языка программирования Oberon-07/16 для
+            микроконтроллеров MSP430x{1,2}xx.
+------------------------------------------------------------------------------
+
+        Параметры командной строки
+
+  Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
+UTF-8 с BOM-сигнатурой.
+  Выход - hex-файл прошивки.
+  Параметры:
+  1) имя главного модуля
+  2) "msp430"
+  3) необязательные параметры-ключи
+      -out <file_name> имя результирующего файла; по умолчанию,
+          совпадает с именем главного модуля, но с расширением ".hex"
+      -ram <size> размер ОЗУ в байтах (128 - 2048) по умолчанию 128
+      -rom <size> размер ПЗУ в байтах (2048 - 24576) по умолчанию 2048
+      -tab <width> размер табуляции (используется для вычисления координат в
+          исходном коде), по умолчанию - 4
+      -nochk <"ptibcwra"> отключить проверки при выполнении
+      -lower разрешить ключевые слова и встроенные идентификаторы в
+          нижнем регистре (по умолчанию)
+      -upper только верхний регистр для ключевых слов и встроенных
+          идентификаторов
+      -def <имя> задать символ условной компиляции
+      -uses вывести список импортированных модулей
+
+      параметр -nochk задается в виде строки из символов:
+      "p" - указатели
+      "t" - типы
+      "i" - индексы
+      "b" - неявное приведение INTEGER к BYTE
+      "c" - диапазон аргумента функции CHR
+      "s" - переполнение стэка
+      "a" - все проверки
+
+      Порядок символов может быть любым. Наличие в строке того или иного
+      символа отключает соответствующую проверку.
+
+      Например: -nochk it - отключить проверку индексов и охрану типа.
+      -nochk a - отключить все отключаемые проверки.
+
+  Например:
+
+  Compiler.exe "C:\example.ob07" msp430 -ram 128 -rom 4096 -nochk pti
+  Compiler.exe "C:\example.ob07" msp430 -out "C:\Ex1.hex" -ram 512 -rom 16384
+
+  В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
+
+------------------------------------------------------------------------------
+        Отличия от оригинала
+
+ 1.     Расширен псевдомодуль SYSTEM
+ 2.     В идентификаторах допускается символ "_"
+ 3.     Усовершенствован оператор CASE (добавлены константные выражения в
+        метках вариантов и необязательная ветка ELSE)
+ 4.     Расширен набор стандартных процедур
+ 5.     Семантика охраны/проверки типа уточнена для нулевого указателя
+ 6.     Добавлены однострочные комментарии (начинаются с пары символов "//")
+ 7.     Разрешено наследование от типа-указателя
+ 8.     "Строки" можно заключать также в одиночные кавычки: 'строка'
+ 9.     Добавлена операция конкатенации строковых и символьных констант
+10.     Добавлены кодовые процедуры
+11.     Не реализована вещественная арифметика
+12.     Возможен импорт модулей с указанием пути и имени файла
+13.     Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+14.     Имя процедуры в конце объявления (после END) необязательно
+15.     Разрешено использовать нижний регистр для ключевых слов
+
+------------------------------------------------------------------------------
+        Особенности реализации
+
+1.      Основные типы
+
+          Тип              Диапазон значений               Размер, байт
+
+        INTEGER       -32768 .. 32767                           2
+        CHAR          символ ASCII (0X .. 0FFX)                 1
+        BOOLEAN       FALSE, TRUE                               1
+        SET           множество из целых чисел {0 .. 15}        2
+        BYTE          0 .. 255                                  1
+
+2.      Максимальная длина идентификаторов - 255 символов
+3.      Максимальная длина строковых констант - 511 символов (UTF-8)
+4.      Максимальная размерность открытых массивов - 5
+5.      Процедура NEW заполняет нулями выделенный блок памяти
+6.      Локальные переменные инициализируются нулями
+7.      В отличие от многих Oberon-реализаций, сборщик мусора и динамическая
+        модульность отсутствуют
+8.      Тип BYTE в выражениях всегда приводится к INTEGER
+9.      Контроль переполнения значений выражений не производится
+
+------------------------------------------------------------------------------
+        Псевдомодуль SYSTEM
+
+  Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры,
+ошибки при использовании процедур псевдомодуля SYSTEM могут привести к
+повреждению данных времени выполнения и аварийному завершению программы.
+
+        PROCEDURE ADR(v: любой тип): INTEGER
+                v - переменная или процедура;
+                возвращает адрес v
+
+        PROCEDURE SADR(x: строковая константа): INTEGER
+                возвращает адрес x
+
+        PROCEDURE VAL(v: любой тип; T): T
+                v - переменная;
+                интерпретирует v, как переменную типа T
+
+        PROCEDURE SIZE(T): INTEGER
+                возвращает размер типа T
+
+        PROCEDURE TYPEID(T): INTEGER
+                T - тип-запись или тип-указатель,
+                возвращает номер типа в таблице типов-записей
+
+        PROCEDURE MOVE(Source, Dest, n: INTEGER)
+                Копирует n байт памяти из Source в Dest,
+                области Source и Dest не могут перекрываться
+
+        PROCEDURE GET(a: INTEGER;
+                VAR v: любой основной тип, PROCEDURE, POINTER)
+                v := Память[a]
+
+        PROCEDURE GET8(a: INTEGER; VAR x: INTEGER, SET, BYTE, CHAR)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+        PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
+                Память[a] := x;
+                Если x: BYTE, то значение x будет расширено до 16 бит,
+                для записи байтов использовать SYSTEM.PUT8
+
+        PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR)
+                Память[a] := младшие 8 бит (x)
+
+        PROCEDURE CODE(word1, word2,... : INTEGER)
+                Вставка машинного кода,
+                word1, word2 ... - целочисленные константы (константные
+                выражения) - машинные слова, например:
+                SYSTEM.CODE(0D032H, 0010H) (* BIS #16, SR; CPUOFF *)
+
+
+  Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
+
+------------------------------------------------------------------------------
+        Оператор CASE
+
+  Синтаксис оператора CASE:
+
+        CaseStatement =
+                CASE Expression OF Case {"|" Case}
+                        [ELSE StatementSequence] END.
+        Case = [CaseLabelList ":" StatementSequence].
+        CaseLabelList = CaseLabels {"," CaseLabels}.
+        CaseLabels = ConstExpression [".." ConstExpression].
+
+  Например:
+
+        CASE x OF
+        |-1:    DoSomething1
+        | 1:    DoSomething2
+        | 0:    DoSomething3
+        ELSE
+                DoSomething4
+        END
+
+  В метках вариантов можно использовать константные выражения, ветка ELSE
+необязательна. Если значение x не соответствует ни одному варианту и ELSE
+отсутствует, то программа прерывается с ошибкой времени выполнения.
+
+------------------------------------------------------------------------------
+        Конкатенация строковых и символьных констант
+
+  Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+  str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+  newline = 0DX + 0AX;
+
+------------------------------------------------------------------------------
+        Проверка и охрана типа нулевого указателя
+
+  Оригинальное сообщение о языке не определяет поведение программы при
+выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих
+Oberon-реализациях выполнение такой операции приводит к ошибке времени
+выполнения. В данной реализации охрана типа нулевого указателя не приводит к
+ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет
+значительно сократить частоту применения охраны типа.
+
+------------------------------------------------------------------------------
+        Дополнительные стандартные процедуры
+
+
+        COPY (x: ARRAY OF CHAR; VAR v: ARRAY OF CHAR);
+                v := x;
+                Если LEN(v) < LEN(x), то строка x будет скопирована
+                не полностью.
+
+        LSR (x, n: INTEGER): INTEGER
+                Логический сдвиг x на n бит вправо.
+
+        MIN (a, b: INTEGER): INTEGER
+                Минимум из двух значений.
+
+        MAX (a, b: INTEGER): INTEGER
+                Максимум из двух значений.
+
+        BITS (x: INTEGER): SET
+                Интерпретирует x как значение типа SET.
+                Выполняется на этапе компиляции.
+
+        LENGTH (s: ARRAY OF CHAR): INTEGER
+                Длина 0X-завершенной строки s, без учета символа 0X.
+                Если символ 0X отсутствует, функция возвращает длину
+                массива s. s не может быть константой.
+
+------------------------------------------------------------------------------
+        Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+    IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+    IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
+------------------------------------------------------------------------------
+        Использование регистров общего назначения R4 - R15
+
+    R4 - R7:   регистровый стэк (промежуточные значения выражений),
+               волатильные регистры (не требуют сохранения)
+
+    R8 - R11:  не используются компилятором, могут использоваться в кодовых
+               процедурах, неволатильные (требуется сохранять перед
+               использованием и восстанавливать после)
+
+    R12 - R14: зарезервированы для возможного специального назначения в
+               будущем
+
+    R15:       указатель кучи, используется в стандартной процедуре NEW, а
+               также для контроля переполнения стэка
+
+------------------------------------------------------------------------------
+        Вызов процедур и кадр стэка
+
+  Правила вызова похожи на соглашение cdecl (x86):
+  - параметры передаются через стэк справа налево
+  - результат, если есть, передается через регистр R4
+  - вызывающая процедура очищает стэк
+
+  Состояние стэка при выполнении процедуры:
+
+  меньшие адреса <- |var3|var2|var1|PC|arg1|arg2|arg3| -> бОльшие адреса
+
+  PC   - значение регистра PC перед вызовом (адрес возврата)
+  argX - параметры в порядке объявления (слева направо)
+  varX - локальные переменные в порядке использования в процедуре
+
+  Размер каждого элемента в стэке (кроме локальных переменных структурных
+  типов) - 1 машинное слово (2 байта). Структурные переменные (массивы и
+  записи) занимают место в стэке в соответствии с их размером (с учетом
+  выравнивания).
+
+  Размещение локальных переменных зависит от их размеров и порядка
+  использования, и в общем случае неопределенно. Если переменная не
+  используется явно, то компилятор не выделяет для нее место в стэке.
+
+------------------------------------------------------------------------------
+        Скрытые параметры процедур
+
+  Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке
+формальных параметров, но учитываются компилятором при трансляции вызовов.
+Это возможно в следующих случаях:
+
+1.      Процедура имеет формальный параметр открытый массив:
+                PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL);
+        Вызов транслируется так:
+                Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x))
+2.      Процедура имеет формальный параметр-переменную типа RECORD:
+                PROCEDURE Proc (VAR x: Rec);
+        Вызов транслируется так:
+                Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+
+------------------------------------------------------------------------------
+        Кодовые процедуры
+
+  Компилятор поддерживает процедуры, написаные в машинных кодах.
+  Синтаксис:
+
+  PROCEDURE "[code]" имя [ (параметры): ТипРезультата ]
+      МашСлово, МашСлово,... МашСлово;
+
+  ";" после заголовка и END "имя" в конце процедуры не ставятся.
+  МашСлово - целочисленная константа (в том числе и константное выражение).
+  Например:
+
+  PROCEDURE [code] asr (n, x: INTEGER): INTEGER  (* ASR(x, n) -> R4 *)
+      4115H, 2,              (*  MOV  2(SP), R5; R5 <- n  *)
+      4114H, 4,              (*  MOV  4(SP), R4; R4 <- x  *)
+      0F035H, 15,            (*  AND  #15, R5             *)
+      2400H + 3,             (*  JZ   L1                  *)
+                             (*  L2:                      *)
+      1104H,                 (*  RRA  R4                  *)
+      8315H,                 (*  SUB  #1, R5              *)
+      2000H + 400H - 3;      (*  JNZ  L2                  *)
+                             (*  L1:                      *)
+
+  Компилятор автоматически добавляет к такой процедуре команду RET.
+  Способ передачи параметров и результата не изменяется.
+
+  Кодовые процедуры можно использовать также и для добавления в программу
+константных данных:
+
+  PROCEDURE [code] sqr
+      0, 1, 4, 9, 16, 25, 36, 49, 64, 81;
+
+  Получить адрес такой "процедуры": SYSTEM.ADR(sqr).
+  Получить адрес n-го машинного слова: SYSTEM.ADR(sqr) + n * 2.
+
+  Чтобы использовать кодовые процедуры, необходимо импортировать псевдомодуль
+SYSTEM.
+
+------------------------------------------------------------------------------
+        Обработка прерываний
+
+  При появлении запроса на прерывание, процессор:
+  - помещает в стэк значение регистра PC
+  - помещает в стэк значение регистра SR
+  - очищает регистр SR
+  - выполняет переход по адресу IV[priority], где
+    IV - таблица векторов прерываний,
+    priority - приоритет прерывания (номер элемента в таблице IV) (0..30)
+
+  Компилятор генерирует код обработки прерываний:
+
+                   ; IV[0] = адрес следующей команды
+  PUSH  #0         ; поместить в стэк приоритет прерывания
+  JMP   Label      ; перейти к обработчику
+
+                   ; IV[1] = адрес следующей команды
+  PUSH  #1         ; поместить в стэк приоритет прерывания
+  JMP   Label      ; перейти к обработчику
+
+  ...
+                   ; IV[priority] = адрес следующей команды
+  PUSH  #priority  ; поместить в стэк приоритет прерывания
+  JMP   Label      ; перейти к обработчику
+
+  ...
+                   ; IV[30] = адрес следующей команды
+  PUSH  #30        ; поместить в стэк приоритет прерывания
+
+  Label:
+  PUSH  R4         ; сохранить рабочие регистры (R4 - R7)
+  ...
+  PUSH  R7
+  MOV   SP, R4     ; настроить R4 на структуру данных прерывания (см. далее)
+  ADD   #8, R4
+  PUSH  R4         ; передать параметр interrupt в обработчик (см. далее)
+  PUSH  @R4        ; передать параметр priority в обработчик (см. далее)
+  CALL  int        ; вызвать обработчик (см. далее)
+  ADD   #4, SP     ; удалить из стэка параметры обработчика
+  POP   R7         ; восстановить рабочие регистры (R7 - R4)
+  ...
+  POP   R4
+  ADD   #2, SP     ; удалить из стэка значение priority
+  RETI             ; возврат из прерывания (восстановить SR и PC)
+
+------------------------------------------------------------------------------
+        Обработка ошибок
+
+  В случае возникновения ошибки при выполнении программы, будет вызван общий
+обработчик ошибок, который:
+
+  - запрещает прерывания
+  - сбрасывает стэк (во избежание переполнения в процессе обработки ошибки)
+  - передает параметры в пользовательский обработчик (см. далее)
+  - вызывает пользовательский обработчик (если он назначен)
+  - повторно запрещает прерывания
+  - выключает CPU и все тактовые сигналы
+
+  Если выключать CPU не требуется, то пользовательский обработчик может,
+например, перезапустить программу.
+
+Коды ошибок:
+
+ 1       ASSERT(x), при x = FALSE
+ 2       разыменование нулевого указателя
+ 3       целочисленное деление на неположительное число
+ 4       вызов процедуры через процедурную переменную с нулевым значением
+ 5       ошибка охраны типа
+ 6       нарушение границ массива
+ 7       непредусмотренное значение выражения в операторе CASE
+ 8       ошибка копирования массивов v := x, если LEN(v) < LEN(x)
+ 9       CHR(x), если (x < 0) OR (x > 255)
+10       переполнение стэка
+11       неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255)
+
+------------------------------------------------------------------------------
+        Инициализация и финализация программы
+
+  В начало программы компилятор вставляет код, который:
+  - инициализирует регистры SP и R15
+  - выключает сторожевой таймер
+  - назначает пустой обработчик прерываний и пустой обработчик ошибок
+
+  В конец программы добавляет команду
+  BIS #16, SR; выключить CPU
+
+------------------------------------------------------------------------------
+        Структура ОЗУ (RAM)
+
+  начало -> | куча/стэк | спец. переменные | глобальные переменные | <- конец
+
+  Компилятор поддерживает размер ОЗУ 128..2048 байт. В верхних адресах
+располагаются пользовательские глобальные переменные и скрытые специальные
+переменные. Оставшаяся часть памяти отводится для кучи и стэка (не менее 40
+байт, минимально необходимо для обработки прерываний и ошибок). При старте
+программы, в регистр R15 записывается адрес начала области кучи/стэка, а
+регистр SP настраивается на конец этой области (адрес спец. переменных). При
+выделении памяти процедурой NEW, значение регистра R15 увеличивается (если
+есть свободная память). Таким образом, стэк и куча растут навстречу друг
+другу.
+
+Проверка переполнения стэка производится только при входе в процедуру, если
+эта проверка не отключена при компиляции (-nochk s).
+Проверка стэка не производится:
+  - в процессе выполнения процедуры
+  - при входе в кодовую процедуру
+  - при выполнении тела модуля
+
+------------------------------------------------------------------------------
+        Структура ПЗУ (ROM)
+
+  начало -> | свободная область | код | данные | векторы прерываний | <- конец
+
+  Компилятор поддерживает размер ПЗУ 2048..24576 байт. В верхних адресах
+располагается таблица векторов прерываний (64 байта), адреса 0FFC0H..0FFFFH.
+Непосредственно перед ней размещаются данные (таблица типов, строки,
+множества) и перед данными - программный код. Адрес начала кода совпадает с
+точкой входа в программу (вектор сброса). Если размер ПЗУ больше, чем размер
+программы, то перед кодом останется свободная область.
+
+==============================================================================
+MODULE MSP430
+
+CONST
+
+    биты регистра SR:
+
+    GIE     = {3}
+    CPUOFF  = {4}
+    OSCOFF  = {5}
+    SCG0    = {6}
+    SCG1    = {7}
+
+
+TYPE
+
+    TInterrupt = RECORD priority: INTEGER; sr: SET; pc: INTEGER END
+        структура данных прерывания
+
+        priority - приоритет прерывания:
+
+        адрес    приоритет
+        0FFFEH     31
+        0FFFCH     30
+        0FFFAH     29
+        ...
+        0FFC0H      0
+
+        sr - сохраненное значение регистра SR
+        pc - сохраненное значение регистра PC
+
+
+    TTrapProc = PROCEDURE (modNum, modName, err, line: INTEGER);
+        Процедура-обработчик ошибок.
+
+        modNum  - номер модуля (в отчете о компиляции:
+                  compiling (modNum) "modName" )
+        modName - адрес имени модуля
+        err     - номер ошибки
+        line    - номер строки
+
+
+    TIntProc = PROCEDURE (priority: INTEGER; interrupt: TInterrupt)
+        Процедура-обработчик прерываний.
+
+        priority  - приоритет прерывания
+        interrupt - структура данных прерывания
+
+
+    PROCEDURE SetTrapProc (TrapProc: TTrapProc)
+        Назначить обработчик ошибок.
+
+
+    PROCEDURE SetIntProc (IntProc: TIntProc)
+        Назначить обработчик прерываний.
+
+
+    PROCEDURE Restart
+        Перезапустить программу.
+        При этом: очищается регистр SR, повторно выполняется код инициализации
+        программы (см. выше). Всё прочее состояние ОЗУ и регистров устройств
+        сохраняется.
+
+
+    PROCEDURE SetIntPC (interrupt: TInterrupt; NewPC: INTEGER)
+        interrupt.pc := NewPC
+        После возврата из прерывания, регистр PC получит значение NewPC.
+
+
+    PROCEDURE SetIntSR (interrupt: TInterrupt; NewSR: SET)
+        interrupt.sr := NewSR
+        После возврата из прерывания, регистр SR получит значение NewSR.
+
+
+    PROCEDURE DInt
+        Запретить прерывания.
+
+
+    PROCEDURE EInt
+        Разрешить прерывания.
+
+
+    PROCEDURE CpuOff
+        Выключить CPU (установить бит CPUOFF регистра SR).
+
+
+    PROCEDURE Halt
+        Запретить прерывания, выключить CPU и все тактовые сигналы.
+
+
+    PROCEDURE SetSR (bits: SET)
+        Установить биты bits регистра SR.
+
+
+    PROCEDURE ClrSR (bits: SET)
+        Сбросить биты bits регистра SR.
+
+
+    PROCEDURE Delay (n: INTEGER)
+        Задержка выполнения программы на 1000*n тактов,
+        но не менее чем на 2000 тактов.
+
+
+==============================================================================

BIN
doc/Oberon07.Report_2016_05_03.pdf


+ 454 - 0
doc/STM32.txt

@@ -0,0 +1,454 @@
+        Компилятор языка программирования Oberon-07/16 для
+            микроконтроллеров STM32 Cortex-M3.
+
+------------------------------------------------------------------------------
+        Параметры командной строки
+
+  Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
+UTF-8 с BOM-сигнатурой.
+  Выход - hex-файл прошивки.
+  Параметры:
+  1) имя главного модуля
+  2) "stm32cm3"
+  3) необязательные параметры-ключи
+      -out <file_name> имя результирующего файла; по умолчанию,
+          совпадает с именем главного модуля, но с расширением ".hex"
+      -ram <size> размер ОЗУ в килобайтах (4 - 65536) по умолчанию 4
+      -rom <size> размер ПЗУ в килобайтах (16 - 65536) по умолчанию 16
+      -tab <width> размер табуляции (используется для вычисления координат в
+          исходном коде), по умолчанию - 4
+      -nochk <"ptibcwra"> отключить проверки при выполнении
+      -lower разрешить ключевые слова и встроенные идентификаторы в
+          нижнем регистре (по умолчанию)
+      -upper только верхний регистр для ключевых слов и встроенных
+          идентификаторов
+      -def <имя> задать символ условной компиляции
+      -uses вывести список импортированных модулей
+
+      параметр -nochk задается в виде строки из символов:
+      "p" - указатели
+      "t" - типы
+      "i" - индексы
+      "b" - неявное приведение INTEGER к BYTE
+      "c" - диапазон аргумента функции CHR
+      "w" - диапазон аргумента функции WCHR
+      "r" - эквивалентно "bcw"
+      "a" - все проверки
+
+      Порядок символов может быть любым. Наличие в строке того или иного
+      символа отключает соответствующую проверку.
+
+      Например: -nochk it - отключить проверку индексов и охрану типа.
+      -nochk a - отключить все отключаемые проверки.
+
+  Например:
+
+  Compiler.exe "C:\example.ob07" stm32cm3 -ram 32 -rom 256 -nochk pti
+  Compiler.exe "C:\example.ob07" stm32cm3 -out "C:\Ex1.hex" -ram 8 -rom 32
+
+  В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
+
+------------------------------------------------------------------------------
+        Отличия от оригинала
+
+ 1.     Расширен псевдомодуль SYSTEM
+ 2.     В идентификаторах допускается символ "_"
+ 3.     Усовершенствован оператор CASE (добавлены константные выражения в
+        метках вариантов и необязательная ветка ELSE)
+ 4.     Расширен набор стандартных процедур
+ 5.     Семантика охраны/проверки типа уточнена для нулевого указателя
+ 6.     Добавлены однострочные комментарии (начинаются с пары символов "//")
+ 7.     Разрешено наследование от типа-указателя
+ 8.     "Строки" можно заключать также в одиночные кавычки: 'строка'
+ 9.     Добавлен тип WCHAR
+10.     Добавлена операция конкатенации строковых и символьных констант
+11.     Добавлены кодовые процедуры
+12.     Возможен импорт модулей с указанием пути и имени файла
+13.     Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+14.     Имя процедуры в конце объявления (после END) необязательно
+15.     Разрешено использовать нижний регистр для ключевых слов
+
+------------------------------------------------------------------------------
+        Особенности реализации
+
+1.      Основные типы
+
+          Тип              Диапазон значений               Размер, байт
+
+        INTEGER       -2147483648 .. 2147483647                 4
+        REAL          1.17E-38 .. 3.40E+38                      4
+        CHAR          символ ASCII (0X .. 0FFX)                 1
+        BOOLEAN       FALSE, TRUE                               1
+        SET           множество из целых чисел {0 .. 31}        4
+        BYTE          0 .. 255                                  1
+        WCHAR         символ юникода (0X .. 0FFFFX)             2
+
+2.      Максимальная длина идентификаторов - 255 символов
+3.      Максимальная длина строковых констант - 511 символов (UTF-8)
+4.      Максимальная размерность открытых массивов - 5
+5.      Процедура NEW заполняет нулями выделенный блок памяти
+6.      Локальные переменные инициализируются нулями
+7.      В отличие от многих Oberon-реализаций, сборщик мусора и динамическая
+        модульность отсутствуют
+8.      Тип BYTE в выражениях всегда приводится к INTEGER
+9.      Контроль переполнения значений выражений не производится
+
+------------------------------------------------------------------------------
+        Псевдомодуль SYSTEM
+
+  Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры,
+ошибки при использовании процедур псевдомодуля SYSTEM могут привести к
+повреждению данных времени выполнения и аварийному завершению программы.
+
+        PROCEDURE ADR(v: любой тип): INTEGER
+                v - переменная или процедура;
+                возвращает адрес v
+
+        PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE VAL(v: любой тип; T): T
+                v - переменная;
+                интерпретирует v, как переменную типа T
+
+        PROCEDURE SIZE(T): INTEGER
+                возвращает размер типа T
+
+        PROCEDURE TYPEID(T): INTEGER
+                T - тип-запись или тип-указатель,
+                возвращает номер типа в таблице типов-записей
+
+        PROCEDURE INF(): REAL
+                возвращает специальное вещественное значение "бесконечность"
+
+        PROCEDURE MOVE(Source, Dest, n: INTEGER)
+                Копирует n байт памяти из Source в Dest,
+                области Source и Dest не могут перекрываться
+
+        PROCEDURE GET(a: INTEGER;
+                VAR v: любой основной тип, PROCEDURE, POINTER)
+                v := Память[a]
+
+        PROCEDURE GET8(a: INTEGER;
+                       VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+        PROCEDURE GET16(a: INTEGER;
+                        VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
+
+        PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
+
+        PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
+                Память[a] := x;
+                Если x: BYTE или x: WCHAR, то значение x будет расширено
+                до 32 бит, для записи байтов использовать SYSTEM.PUT8,
+                для WCHAR -- SYSTEM.PUT16
+
+        PROCEDURE PUT8(a: INTEGER;
+                       x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 8 бит (x)
+
+        PROCEDURE PUT16(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 16 бит (x)
+
+        PROCEDURE PUT32(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 32 бит (x)
+
+        PROCEDURE CODE(hword1, hword2,... : INTEGER)
+                Вставка машинного кода,
+                hword1, hword2 ... - константы в диапазоне 0..65535,
+                например:
+                SYSTEM.CODE(0BF30H) (* wfi *)
+
+  Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не
+допускаются никакие явные операции, за исключением присваивания.
+
+  Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
+
+------------------------------------------------------------------------------
+        Оператор CASE
+
+  Синтаксис оператора CASE:
+
+        CaseStatement =
+                CASE Expression OF Case {"|" Case}
+                        [ELSE StatementSequence] END.
+        Case = [CaseLabelList ":" StatementSequence].
+        CaseLabelList = CaseLabels {"," CaseLabels}.
+        CaseLabels = ConstExpression [".." ConstExpression].
+
+  Например:
+
+        CASE x OF
+        |-1:    DoSomething1
+        | 1:    DoSomething2
+        | 0:    DoSomething3
+        ELSE
+                DoSomething4
+        END
+
+  В метках вариантов можно использовать константные выражения, ветка ELSE
+необязательна. Если значение x не соответствует ни одному варианту и ELSE
+отсутствует, то программа прерывается с ошибкой времени выполнения.
+
+------------------------------------------------------------------------------
+        Тип WCHAR
+
+  Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и
+ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и
+ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
+только тип CHAR. Для получения значения типа WCHAR, следует использовать
+процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
+исходный код в кодировке UTF-8 с BOM.
+
+------------------------------------------------------------------------------
+        Конкатенация строковых и символьных констант
+
+  Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+  str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+  newline = 0DX + 0AX;
+
+------------------------------------------------------------------------------
+        Проверка и охрана типа нулевого указателя
+
+  Оригинальное сообщение о языке не определяет поведение программы при
+выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих
+Oberon-реализациях выполнение такой операции приводит к ошибке времени
+выполнения. В данной реализации охрана типа нулевого указателя не приводит к
+ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет
+значительно сократить частоту применения охраны типа.
+
+------------------------------------------------------------------------------
+        Дополнительные стандартные процедуры
+
+
+        COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR);
+                v := x;
+                Если LEN(v) < LEN(x), то строка x будет скопирована
+                не полностью
+
+        LSR (x, n: INTEGER): INTEGER
+                Логический сдвиг x на n бит вправо.
+
+        MIN (a, b: INTEGER): INTEGER
+                Минимум из двух значений.
+
+        MAX (a, b: INTEGER): INTEGER
+                Максимум из двух значений.
+
+        BITS (x: INTEGER): SET
+                Интерпретирует x как значение типа SET.
+                Выполняется на этапе компиляции.
+
+        LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER
+                Длина 0X-завершенной строки s, без учета символа 0X.
+                Если символ 0X отсутствует, функция возвращает длину
+                массива s. s не может быть константой.
+
+        WCHR (n: INTEGER): WCHAR
+                Преобразование типа, аналогично CHR(n: INTEGER): CHAR
+
+------------------------------------------------------------------------------
+        Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+    IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+    IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
+------------------------------------------------------------------------------
+        Плавающая точка
+
+  Компилятор предназначен для устройств на ядре Cortex-M3 и, возможно, после
+небольшой доработки, также для Cortex-M0. В таких микроконтроллерах нет
+встроенной поддержки плавающей точки, поэтому операции с вещественными числами
+одинарной точности эмулируются (модуль lib/STM32CM3/FPU.ob07). Компилятор
+подставляет вызовы процедур в месте операций с вещественными числами.
+
+  Сохраняется возможность доработки компилятора в будущем для устройств со
+встроенной поддержкой вещественных чисел.
+
+------------------------------------------------------------------------------
+        Использование регистров общего назначения R0 - R12
+
+        R0 - R3:  регистровый стэк (промежуточные значения выражений),
+                  волатильные регистры (не требуют сохранения)
+
+        R4 - R7:  не используются компилятором, могут использоваться в кодовых
+                  процедурах, неволатильные (требуется сохранять перед
+                  использованием и восстанавливать после)
+
+        R8 - R12: зарезервированы для возможного специального назначения в
+                  будущем
+
+------------------------------------------------------------------------------
+        Вызов процедур и кадр стэка
+
+  Правила вызова похожи на соглашение cdecl (x86):
+  - параметры передаются через стэк справа налево
+  - результат, если есть, передается через регистр R0
+  - вызывающая процедура очищает стэк
+
+  Состояние стэка при выполнении процедуры:
+
+  меньшие адреса <- |var3|var2|var1|LR|arg1|arg2|arg3| -> бОльшие адреса
+
+  LR   - сохраненный регистр LR (адрес возврата)
+  argX - параметры в порядке объявления (слева направо)
+  varX - локальные переменные в порядке использования в процедуре
+
+  Размер каждого элемента в стэке (кроме локальных переменных структурных
+  типов) - 1 машинное слово (4 байта). Структурные переменные (массивы и
+  записи) занимают место в стэке в соответствии с их размером (с учетом
+  выравнивания).
+
+  Размещение локальных переменных зависит от их размеров и порядка
+  использования, и в общем случае неопределенно. Если переменная не
+  используется явно, то компилятор не выделяет для нее место в стэке.
+
+------------------------------------------------------------------------------
+        Скрытые параметры процедур
+
+  Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке
+формальных параметров, но учитываются компилятором при трансляции вызовов.
+Это возможно в следующих случаях:
+
+1.      Процедура имеет формальный параметр открытый массив:
+                PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL);
+        Вызов транслируется так:
+                Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x))
+2.      Процедура имеет формальный параметр-переменную типа RECORD:
+                PROCEDURE Proc (VAR x: Rec);
+        Вызов транслируется так:
+                Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+
+------------------------------------------------------------------------------
+        Кодовые процедуры
+
+  Компилятор поддерживает процедуры, написаные в машинных кодах.
+  Синтаксис:
+
+  PROCEDURE "[code]" имя [ (параметры): ТипРезультата ]
+      МашКом, МашКом,... МашКом;
+
+  ";" после заголовка и END "имя" в конце процедуры не ставятся.
+  МашКом - целочисленная константа [0..65535] (в том числе и константное
+  выражение).
+
+  Примеры:
+
+  PROCEDURE [code] WFI
+      0BF30H; (* wfi *)
+
+  (* сумма квадратов (a*a + b*b) -> r0 *)
+  PROCEDURE [code] SqrSum (a, b: INTEGER): INTEGER
+      0B430H, (* push {r4, r5}    *) (* сохранить все используемые регистры,
+                                        кроме r0, r1, r2, r3 *)
+      09C02H, (* ldr r4, [sp, 8]  *) (* r4 <- a *)
+      09D03H, (* ldr r5, [sp, 12] *) (* r5 <- b *)
+      04364H, (* muls r4, r4      *) (* r4 := r4 * r4 *)
+      0436DH, (* muls r5, r5      *) (* r5 := r5 * r5 *)
+      01960H, (* adds r0, r4, r5  *) (* r0 := r4 + r5; результат в r0 *)
+      0BC30H; (* pop {r4, r5}     *) (* восстановить регистры *)
+
+  Компилятор автоматически добавляет к такой процедуре команду возврата
+(bx LR). Способ передачи параметров и результата не изменяется. Регистр LR,
+при входе в процедуру не сохраняется.
+
+  Чтобы использовать кодовые процедуры, необходимо импортировать псевдомодуль
+SYSTEM.
+
+------------------------------------------------------------------------------
+        Обработка прерываний
+
+  При возникновении прерывания, будет вызван обработчик (если он объявлен).
+Объявление обработчика:
+
+    PROCEDURE handler_name [iv]; (* процедура без параметров *)
+
+iv - целочисленная константа (константное выражение), номер вектора прерывания
+в таблице векторов, iv >= 2:
+
+     0       начальное значение SP
+     1       сброс
+    ...
+    15       SysTick
+    ...
+    59       TIM6
+    60       TIM7
+    ...
+
+например:
+
+    (* обработчик прерываний от TIM6 *)
+    PROCEDURE tim6 [59];
+    BEGIN
+        (* код обработки *)
+    END tim6;
+
+  Также, можно объявить общий обработчик (iv = 0), который будет вызван, если
+не назначен индивидуальный. Общий обработчик получает параметр - номер вектора
+прерывания. По значению этого параметра, обработчик должен определить источник
+прерывания и выполнить соответствующие действия:
+
+    PROCEDURE handler (iv: INTEGER) [0];
+    BEGIN
+        IF iv = 59 THEN
+            (* TIM6 *)
+        ELSIF iv = 60 THEN
+            (* TIM7 *)
+        ELSIF ....
+        ....
+        END
+    END handler;
+
+------------------------------------------------------------------------------
+        Обработка ошибок
+
+  В случае возникновения ошибки при выполнении программы, будет вызван
+пользовательский обработчик (если он объявлен). Перед вызовом обработчика,
+будут запрещены прерывания.
+
+Объявление обработчика ошибок:
+
+    PROCEDURE trap (modNum, modName, err, line: INTEGER) [1];
+    BEGIN
+    END trap;
+
+    где,
+        modNum  - номер модуля (в отчете о компиляции:
+                  compiling (modNum) "modName" )
+        modName - адрес имени модуля
+        err     - код ошибки
+        line    - номер строки
+
+Коды ошибок:
+
+ 1       ASSERT(x), при x = FALSE
+ 2       разыменование нулевого указателя
+ 3       целочисленное деление на неположительное число
+ 4       вызов процедуры через процедурную переменную с нулевым значением
+ 5       ошибка охраны типа
+ 6       нарушение границ массива
+ 7       непредусмотренное значение выражения в операторе CASE
+ 8       ошибка копирования массивов v := x, если LEN(v) < LEN(x)
+ 9       CHR(x), если (x < 0) OR (x > 255)
+10       WCHR(x), если (x < 0) OR (x > 65535)
+11       неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255)
+
+После возврата из обработчика, программа будет перезапущена.
+
+------------------------------------------------------------------------------

+ 312 - 0
doc/WinLib.txt

@@ -0,0 +1,312 @@
+==============================================================================
+
+        Библиотека (Windows)
+
+------------------------------------------------------------------------------
+MODULE Out - консольный вывод
+
+        PROCEDURE Open
+                открывает консольный вывод
+
+        PROCEDURE Int(x, width: INTEGER)
+                вывод целого числа x;
+                width - количество знакомест, используемых для вывода
+
+        PROCEDURE Real(x: REAL; width: INTEGER)
+                вывод вещественного числа x в плавающем формате;
+                width - количество знакомест, используемых для вывода
+
+        PROCEDURE Char(x: CHAR)
+                вывод символа x
+
+        PROCEDURE FixReal(x: REAL; width, p: INTEGER)
+                вывод вещественного числа x в фиксированном формате;
+                width - количество знакомест, используемых для вывода;
+                p - количество знаков после десятичной точки
+
+        PROCEDURE Ln
+                переход на следующую строку
+
+        PROCEDURE String(s: ARRAY OF CHAR)
+                вывод строки s (ASCII)
+
+        PROCEDURE StringW(s: ARRAY OF WCHAR)
+                вывод строки s (UTF-16)
+
+------------------------------------------------------------------------------
+MODULE In - консольный ввод
+
+        VAR Done: BOOLEAN
+                принимает значение TRUE в случае успешного выполнения
+                операции ввода и FALSE в противном случае
+
+        PROCEDURE Open
+                открывает консольный ввод,
+                также присваивает переменной Done значение TRUE
+
+        PROCEDURE Int(VAR x: INTEGER)
+                ввод числа типа INTEGER
+
+        PROCEDURE Char(VAR x: CHAR)
+                ввод символа
+
+        PROCEDURE Real(VAR x: REAL)
+                ввод числа типа REAL
+
+        PROCEDURE String(VAR s: ARRAY OF CHAR)
+                ввод строки
+
+        PROCEDURE Ln
+                ожидание нажатия ENTER
+
+------------------------------------------------------------------------------
+MODULE Console - дополнительные процедуры консольного вывода
+
+        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
+
+        PROCEDURE Cls
+                очистка окна консоли
+
+        PROCEDURE SetColor(FColor, BColor: INTEGER)
+                установка цвета консольного вывода: FColor - цвет текста,
+                BColor - цвет фона, возможные значения - вышеперечисленные
+                константы
+
+        PROCEDURE SetCursor(x, y: INTEGER)
+                установка курсора консоли в позицию (x, y)
+
+        PROCEDURE GetCursor(VAR x, y: INTEGER)
+                записывает в параметры текущие координаты курсора консоли
+
+        PROCEDURE GetCursorX(): INTEGER
+                возвращает текущую x-координату курсора консоли
+
+        PROCEDURE GetCursorY(): INTEGER
+                возвращает текущую y-координату курсора консоли
+
+------------------------------------------------------------------------------
+MODULE Math - математические функции
+
+        CONST
+
+                pi = 3.141592653589793E+00
+                e  = 2.718281828459045E+00
+
+        PROCEDURE IsNan(x: REAL): BOOLEAN
+                возвращает TRUE, если x - не число
+
+        PROCEDURE IsInf(x: REAL): BOOLEAN
+                возвращает TRUE, если x - бесконечность
+
+        PROCEDURE sqrt(x: REAL): REAL
+                квадратный корень x
+
+        PROCEDURE exp(x: REAL): REAL
+                экспонента x
+
+        PROCEDURE ln(x: REAL): REAL
+                натуральный логарифм x
+
+        PROCEDURE sin(x: REAL): REAL
+                синус x
+
+        PROCEDURE cos(x: REAL): REAL
+                косинус x
+
+        PROCEDURE tan(x: REAL): REAL
+                тангенс x
+
+        PROCEDURE arcsin(x: REAL): REAL
+                арксинус x
+
+        PROCEDURE arccos(x: REAL): REAL
+                арккосинус x
+
+        PROCEDURE arctan(x: REAL): REAL
+                арктангенс x
+
+        PROCEDURE arctan2(y, x: REAL): REAL
+                арктангенс y/x
+
+        PROCEDURE power(base, exponent: REAL): REAL
+                возведение числа base в степень exponent
+
+        PROCEDURE log(base, x: REAL): REAL
+                логарифм x по основанию base
+
+        PROCEDURE sinh(x: REAL): REAL
+                гиперболический синус x
+
+        PROCEDURE cosh(x: REAL): REAL
+                гиперболический косинус x
+
+        PROCEDURE tanh(x: REAL): REAL
+                гиперболический тангенс x
+
+        PROCEDURE arsinh(x: REAL): REAL
+                обратный гиперболический синус x
+
+        PROCEDURE arcosh(x: REAL): REAL
+                обратный гиперболический косинус x
+
+        PROCEDURE artanh(x: REAL): REAL
+                обратный гиперболический тангенс x
+
+        PROCEDURE round(x: REAL): REAL
+                округление x до ближайшего целого
+
+        PROCEDURE frac(x: REAL): REAL;
+                дробная часть числа x
+
+        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 sgn(x: REAL): INTEGER
+                если x > 0 возвращает 1
+                если x < 0 возвращает -1
+                если x = 0 возвращает 0
+
+        PROCEDURE fact(n: INTEGER): REAL
+                факториал n
+
+------------------------------------------------------------------------------
+MODULE File - работа с файловой системой
+
+        CONST
+
+                OPEN_R = 0
+                OPEN_W = 1
+                OPEN_RW = 2
+
+                SEEK_BEG = 0
+                SEEK_CUR = 1
+                SEEK_END = 2
+
+        PROCEDURE Create(FName: ARRAY OF CHAR): INTEGER
+                создает новый файл с именем FName (полное имя с путем),
+                открывет файл для записи и возвращает идентификатор файла
+                (целое число), в случае ошибки, возвращает -1
+
+        PROCEDURE Open(FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER
+                открывает существующий файл с именем FName (полное имя с
+                путем) в режиме Mode = (OPEN_R (только чтение), OPEN_W
+                (только запись), OPEN_RW (чтение и запись)), возвращает
+                идентификатор файла (целое число), в случае ошибки,
+                возвращает -1
+
+        PROCEDURE Read(F, Buffer, Count: INTEGER): INTEGER
+                Читает данные из файла в память. F - числовой идентификатор
+                файла, Buffer - адрес области памяти, Count - количество байт,
+                которое требуется прочитать из файла; возвращает количество
+                байт, которое было прочитано из файла
+
+        PROCEDURE Write(F, Buffer, Count: INTEGER): INTEGER
+                Записывает данные из памяти в файл. F - числовой идентификатор
+                файла, Buffer - адрес области памяти, Count - количество байт,
+                которое требуется записать в файл; возвращает количество байт,
+                которое было записано в файл
+
+        PROCEDURE Seek(F, Offset, Origin: INTEGER): INTEGER
+                устанавливает позицию чтения-записи файла с идентификатором F
+                на Offset, относительно Origin = (SEEK_BEG - начало файла,
+                SEEK_CUR - текущая позиция, SEEK_END - конец файла),
+                возвращает позицию относительно начала файла, например:
+                Seek(F, 0, 2) - устанавливает позицию на конец файла и
+                возвращает длину файла; при ошибке возвращает -1
+
+        PROCEDURE Close(F: INTEGER)
+                закрывает ранее открытый файл с идентификатором F
+
+        PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
+                удаляет файл с именем FName (полное имя с путем),
+                возвращает TRUE, если файл успешно удален
+
+        PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
+                возвращает TRUE, если файл с именем FName (полное имя)
+                существует
+
+        PROCEDURE Load(FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER
+                загружает в память существующий файл с именем FName (полное имя с
+                путем), возвращает адрес памяти, куда был загружен файл,
+                записывает размер файла в параметр Size;
+                при ошибке возвращает 0
+
+        PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
+                создает папку с именем DirName, все промежуточные папки
+                должны существовать. В случае ошибки, возвращает FALSE
+
+        PROCEDURE RemoveDir(DirName: ARRAY OF CHAR): BOOLEAN
+                удаляет пустую папку с именем DirName. В случае ошибки,
+                возвращает FALSE
+
+        PROCEDURE ExistsDir(DirName: ARRAY OF CHAR): BOOLEAN
+                возвращает TRUE, если папка с именем DirName существует
+
+------------------------------------------------------------------------------
+MODULE DateTime - дата, время
+
+        CONST ERR = -7.0E5
+
+        PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER)
+                возвращает в параметрах компоненты текущей системной даты и
+                времени
+
+        PROCEDURE NowEncode(): REAL;
+                возвращает текущую системную дату и
+                время (представление REAL)
+
+        PROCEDURE Encode(Year, Month, Day,
+            Hour, Min, Sec, MSec: INTEGER): REAL
+                возвращает дату, полученную из компонентов
+                Year, Month, Day, Hour, Min, Sec, MSec;
+                при ошибке возвращает константу ERR = -7.0E5
+
+        PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
+                Hour, Min, Sec, MSec: INTEGER): BOOLEAN
+                извлекает компоненты
+                Year, Month, Day, Hour, Min, Sec, MSec из даты Date;
+                при ошибке возвращает FALSE
+
+------------------------------------------------------------------------------
+MODULE Args - параметры программы
+
+        VAR argc: INTEGER
+                количество параметров программы, включая имя
+                исполняемого файла
+
+        PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
+                записывает в строку s n-й параметр программы,
+                нумерация параметров от 0 до argc - 1,
+                нулевой параметр -- имя исполняемого файла
+
+------------------------------------------------------------------------------
+MODULE Utils - разное
+
+        PROCEDURE Utf8To16(source: ARRAY OF CHAR;
+            VAR dest: ARRAY OF CHAR): INTEGER;
+                преобразует символы строки source из кодировки UTF-8 в
+                кодировку UTF-16, результат записывает в строку dest,
+                возвращает количество 16-битных символов, записанных в dest
+
+        PROCEDURE PutSeed(seed: INTEGER)
+                Инициализация генератора случайных чисел целым числом seed
+
+        PROCEDURE Rnd(range: INTEGER): INTEGER
+                Целые случайные числа в диапазоне 0 <= x < range
+
+------------------------------------------------------------------------------
+MODULE WINAPI - привязки к некоторым API-функциям Windows

+ 425 - 0
doc/x86.txt

@@ -0,0 +1,425 @@
+        Компилятор языка программирования Oberon-07/16 для i486
+                Windows/Linux/KolibriOS.
+------------------------------------------------------------------------------
+
+        Параметры командной строки
+
+  Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
+UTF-8 с BOM-сигнатурой.
+  Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF.
+  Параметры:
+  1) имя главного модуля
+  2) тип приложения
+      "win32con" - Windows console
+      "win32gui" - Windows GUI
+      "win32dll" - Windows DLL
+      "linux32exe" - Linux ELF-EXEC
+      "linux32so"  - Linux ELF-SO
+      "kosexe" - KolibriOS
+      "kosdll" - KolibriOS DLL
+
+  3) необязательные параметры-ключи
+      -out <file_name> имя результирующего файла; по умолчанию,
+          совпадает с именем главного модуля, но с другим расширением
+          (соответствует типу исполняемого файла)
+      -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
+          допустимо от 1 до 32 Мб)
+      -tab <width> размер табуляции (используется для вычисления координат в
+          исходном коде), по умолчанию - 4
+      -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
+      -lower разрешить ключевые слова и встроенные идентификаторы в
+          нижнем регистре (по умолчанию)
+      -upper только верхний регистр для ключевых слов и встроенных
+          идентификаторов
+      -def <имя> задать символ условной компиляции
+      -ver <major.minor> версия программы (только для kosdll)
+      -uses вывести список импортированных модулей
+      -fa <size> выравнивание секций файла PE32 в байтах, возможные значения:
+          512, 1024, 2048, 4096. По умолчанию - 512
+
+      параметр -nochk задается в виде строки из символов:
+      "p" - указатели
+      "t" - типы
+      "i" - индексы
+      "b" - неявное приведение INTEGER к BYTE
+      "c" - диапазон аргумента функции CHR
+      "w" - диапазон аргумента функции WCHR
+      "r" - эквивалентно "bcw"
+      "a" - все проверки
+
+      Порядок символов может быть любым. Наличие в строке того или иного
+      символа отключает соответствующую проверку.
+
+      Например: -nochk it - отключить проверку индексов и охрану типа.
+      -nochk a - отключить все отключаемые проверки.
+
+  Например:
+
+  Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1
+  Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll"
+  Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4
+  Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti
+  Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4
+  Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7
+  Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a
+
+  В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
+При работе компилятора в KolibriOS, код завершения не передается.
+
+------------------------------------------------------------------------------
+        Отличия от оригинала
+
+1.      Расширен псевдомодуль SYSTEM
+2.      В идентификаторах допускается символ "_"
+3.      Добавлены системные флаги
+4.      Усовершенствован оператор CASE (добавлены константные выражения в
+        метках вариантов и необязательная ветка ELSE)
+5.      Расширен набор стандартных процедур
+6.      Семантика охраны/проверки типа уточнена для нулевого указателя
+7.      Добавлены однострочные комментарии (начинаются с пары символов "//")
+8.      Разрешено наследование от типа-указателя
+9.      Добавлен синтаксис для импорта процедур из внешних библиотек
+10.     "Строки" можно заключать также в одиночные кавычки: 'строка'
+11.     Добавлен тип WCHAR
+12.     Добавлена операция конкатенации строковых и символьных констант
+13.     Возможен импорт модулей с указанием пути и имени файла
+14.     Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+15.     Имя процедуры в конце объявления (после END) необязательно
+16.     Разрешено использовать нижний регистр для ключевых слов
+
+------------------------------------------------------------------------------
+        Особенности реализации
+
+1.      Основные типы
+
+          Тип              Диапазон значений               Размер, байт
+
+        INTEGER       -2147483648 .. 2147483647                 4
+        REAL          4.94E-324 .. 1.70E+308                    8
+        CHAR          символ ASCII (0X .. 0FFX)                 1
+        BOOLEAN       FALSE, TRUE                               1
+        SET           множество из целых чисел {0 .. 31}        4
+        BYTE          0 .. 255                                  1
+        WCHAR         символ юникода (0X .. 0FFFFX)             2
+
+2.      Максимальная длина идентификаторов - 255 символов
+3.      Максимальная длина строковых констант - 511 символов (UTF-8)
+4.      Максимальная размерность открытых массивов - 5
+5.      Процедура NEW заполняет нулями выделенный блок памяти
+6.      Глобальные и локальные переменные инициализируются нулями
+7.      В отличие от многих Oberon-реализаций, сборщик мусора и динамическая
+        модульность отсутствуют
+8.      Тип BYTE в выражениях всегда приводится к INTEGER
+9.      Контроль переполнения значений выражений не производится
+10.     Ошибки времени выполнения:
+
+ 1      ASSERT(x), при x = FALSE
+ 2      разыменование нулевого указателя
+ 3      целочисленное деление на неположительное число
+ 4      вызов процедуры через процедурную переменную с нулевым значением
+ 5      ошибка охраны типа
+ 6      нарушение границ массива
+ 7      непредусмотренное значение выражения в операторе CASE
+ 8      ошибка копирования массивов v := x, если LEN(v) < LEN(x)
+ 9      CHR(x), если (x < 0) OR (x > 255)
+10      WCHR(x), если (x < 0) OR (x > 65535)
+11      неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255)
+
+------------------------------------------------------------------------------
+        Псевдомодуль SYSTEM
+
+  Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры,
+ошибки при использовании процедур псевдомодуля SYSTEM могут привести к
+повреждению данных времени выполнения и аварийному завершению программы.
+
+        PROCEDURE ADR(v: любой тип): INTEGER
+                v - переменная или процедура;
+                возвращает адрес v
+
+        PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE VAL(v: любой тип; T): T
+                v - переменная;
+                интерпретирует v, как переменную типа T
+
+        PROCEDURE SIZE(T): INTEGER
+                возвращает размер типа T
+
+        PROCEDURE TYPEID(T): INTEGER
+                T - тип-запись или тип-указатель,
+                возвращает номер типа в таблице типов-записей
+
+        PROCEDURE INF(): REAL
+                возвращает специальное вещественное значение "бесконечность"
+
+        PROCEDURE MOVE(Source, Dest, n: INTEGER)
+                Копирует n байт памяти из Source в Dest,
+                области Source и Dest не могут перекрываться
+
+        PROCEDURE GET(a: INTEGER;
+                VAR v: любой основной тип, PROCEDURE, POINTER)
+                v := Память[a]
+
+        PROCEDURE GET8(a: INTEGER;
+                       VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+        PROCEDURE GET16(a: INTEGER;
+                        VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
+
+        PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
+
+        PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
+                Память[a] := x;
+                Если x: BYTE или x: WCHAR, то значение x будет расширено
+                до 32 бит, для записи байтов использовать SYSTEM.PUT8,
+                для WCHAR -- SYSTEM.PUT16
+
+        PROCEDURE PUT8(a: INTEGER;
+                       x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 8 бит (x)
+
+        PROCEDURE PUT16(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 16 бит (x)
+
+        PROCEDURE PUT32(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 32 бит (x)
+
+        PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER)
+                Копирует n байт памяти из Source в Dest.
+                Эквивалентно
+                SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
+
+        PROCEDURE CODE(byte1, byte2,... : INTEGER)
+                Вставка машинного кода,
+                byte1, byte2 ... - константы в диапазоне 0..255,
+                например:
+                SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *)
+
+  Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не
+допускаются никакие явные операции, за исключением присваивания.
+
+  Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
+
+------------------------------------------------------------------------------
+        Системные флаги
+
+  При объявлении процедурных типов и глобальных процедур, после ключевого
+слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall],
+[cdecl], [fastcall], [ccall], [windows], [linux], [oberon]. Например:
+
+        PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER;
+
+  Если указан флаг [ccall], то принимается соглашение cdecl, но перед
+вызовом указатель стэка будет выравнен по границе 16 байт.
+  Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall].
+  Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что
+результат процедуры можно игнорировать (не допускается для типа REAL).
+  Если флаг не указан или указан флаг [oberon], то принимается внутреннее
+соглашение о вызове.
+
+  При объявлении типов-записей, после ключевого слова RECORD может быть
+указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
+записи. Записи с системным флагом не могут иметь базовый тип и не могут быть
+базовыми типами для других записей.
+  Для использования системных флагов, требуется импортировать SYSTEM.
+
+------------------------------------------------------------------------------
+        Оператор CASE
+
+  Синтаксис оператора CASE:
+
+        CaseStatement =
+                CASE Expression OF Case {"|" Case}
+                        [ELSE StatementSequence] END.
+        Case = [CaseLabelList ":" StatementSequence].
+        CaseLabelList = CaseLabels {"," CaseLabels}.
+        CaseLabels = ConstExpression [".." ConstExpression].
+
+  Например:
+
+        CASE x OF
+        |-1:    DoSomething1
+        | 1:    DoSomething2
+        | 0:    DoSomething3
+        ELSE
+                DoSomething4
+        END
+
+  В метках вариантов можно использовать константные выражения, ветка ELSE
+необязательна. Если значение x не соответствует ни одному варианту и ELSE
+отсутствует, то программа прерывается с ошибкой времени выполнения.
+
+------------------------------------------------------------------------------
+        Тип WCHAR
+
+  Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и
+ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и
+ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
+только тип CHAR. Для получения значения типа WCHAR, следует использовать
+процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
+исходный код в кодировке UTF-8 с BOM.
+
+------------------------------------------------------------------------------
+        Конкатенация строковых и символьных констант
+
+  Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+  str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+  newline = 0DX + 0AX;
+
+------------------------------------------------------------------------------
+        Проверка и охрана типа нулевого указателя
+
+  Оригинальное сообщение о языке не определяет поведение программы при
+выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих
+Oberon-реализациях выполнение такой операции приводит к ошибке времени
+выполнения. В данной реализации охрана типа нулевого указателя не приводит к
+ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет
+значительно сократить частоту применения охраны типа.
+
+------------------------------------------------------------------------------
+        Дополнительные стандартные процедуры
+
+        DISPOSE (VAR v: любой_указатель)
+                Освобождает память, выделенную процедурой NEW для
+                динамической переменной v^, и присваивает переменной v
+                значение NIL.
+
+        COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR);
+                v := x;
+                Если LEN(v) < LEN(x), то строка x будет скопирована
+                не полностью
+
+        LSR (x, n: INTEGER): INTEGER
+                Логический сдвиг x на n бит вправо.
+
+        MIN (a, b: INTEGER): INTEGER
+                Минимум из двух значений.
+
+        MAX (a, b: INTEGER): INTEGER
+                Максимум из двух значений.
+
+        BITS (x: INTEGER): SET
+                Интерпретирует x как значение типа SET.
+                Выполняется на этапе компиляции.
+
+        LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER
+                Длина 0X-завершенной строки s, без учета символа 0X.
+                Если символ 0X отсутствует, функция возвращает длину
+                массива s. s не может быть константой.
+
+        WCHR (n: INTEGER): WCHAR
+                Преобразование типа, аналогично CHR(n: INTEGER): CHAR
+
+------------------------------------------------------------------------------
+        Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+    IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+    IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
+------------------------------------------------------------------------------
+        Импортированные процедуры
+
+  Синтаксис импорта:
+
+  PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
+
+  - callconv -- соглашение о вызове
+  - library -- имя файла динамической библиотеки (строковая константа)
+  - function -- имя импортируемой процедуры (строковая константа), если
+  указана пустая строка, то имя процедуры = proc_name
+
+  например:
+
+  PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER);
+
+  PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN);
+
+  В конце объявления может быть добавлено (необязательно) "END proc_name;"
+
+  Объявления импортированных процедур должны располагаться в глобальной
+  области видимости модуля после объявления переменных, вместе с объявлением
+  "обычных" процедур, от которых импортированные отличаются только отсутствием
+  тела процедуры. В остальном, к таким процедурам применимы те же правила:
+  их можно вызвать, присвоить процедурной переменной или получить адрес.
+
+  Так как импортированная процедура всегда имеет явное указание соглашения о
+  вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием
+  соглашения о вызове:
+
+  VAR
+      ExitProcess: PROCEDURE [windows] (code: INTEGER);
+      con_exit:    PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
+
+  В KolibriOS импортировать процедуры можно только из библиотек, размещенных
+  в /sys/lib. Импортировать и вызывать функции инициализации библиотек
+  (lib_init, START) при этом не нужно.
+
+  Для Linux, импортированные процедуры не реализованы.
+
+------------------------------------------------------------------------------
+        Скрытые параметры процедур
+
+  Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке
+формальных параметров, но учитываются компилятором при трансляции вызовов.
+Это возможно в следующих случаях:
+
+1.      Процедура имеет формальный параметр открытый массив:
+                PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL);
+        Вызов транслируется так:
+                Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x))
+2.      Процедура имеет формальный параметр-переменную типа RECORD:
+                PROCEDURE Proc (VAR x: Rec);
+        Вызов транслируется так:
+                Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+
+  Скрытые параметры необходимо учитывать при связи с внешними приложениями.
+
+------------------------------------------------------------------------------
+        Модуль RTL
+
+  Все программы неявно используют модуль RTL. Компилятор транслирует
+некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
+ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
+следует вызывать эти процедуры явно.
+  Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
+(Windows), в терминал (Linux), на доску отладки (KolibriOS).
+
+------------------------------------------------------------------------------
+        Модуль API
+
+  Существуют несколько реализаций модуля API (для различных ОС).
+  Как и модуль RTL, модуль API не предназначен для прямого использования.
+Он обеспечивает связь RTL с ОС.
+
+------------------------------------------------------------------------------
+        Генерация исполняемых файлов DLL
+
+  Разрешается экспортировать только процедуры. Для этого, процедура должна
+находиться в главном модуле программы, и ее имя должно быть отмечено символом
+экспорта ("*"). Нельзя экспортировать процедуры, которые импортированы из
+других dll-библиотек.
+
+  KolibriOS DLL всегда экспортируют идентификаторы "version" (версия
+программы) и "lib_init" - адрес процедуры инициализации DLL:
+
+        PROCEDURE [stdcall] lib_init (): INTEGER
+
+Эта процедура должна быть вызвана перед использованием DLL.
+Процедура всегда возвращает 1.

+ 406 - 0
doc/x86_64.txt

@@ -0,0 +1,406 @@
+        Компилятор языка программирования Oberon-07/16 для x86_64
+                Windows/Linux
+------------------------------------------------------------------------------
+
+        Параметры командной строки
+
+  Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
+UTF-8 с BOM-сигнатурой.
+  Выход - испоняемый файл формата PE32+ или ELF64.
+  Параметры:
+  1) имя главного модуля
+  2) тип приложения
+      "win64con" - Windows64 console
+      "win64gui" - Windows64 GUI
+      "win64dll" - Windows64 DLL
+      "linux64exe" - Linux ELF64-EXEC
+      "linux64so" - Linux ELF64-SO
+
+  3) необязательные параметры-ключи
+      -out <file_name> имя результирующего файла; по умолчанию,
+          совпадает с именем главного модуля, но с другим расширением
+          (соответствует типу исполняемого файла)
+      -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
+          допустимо от 1 до 32 Мб)
+      -tab <width> размер табуляции (используется для вычисления координат в
+          исходном коде), по умолчанию - 4
+      -nochk <"ptibcwra"> отключить проверки при выполнении
+      -lower разрешить ключевые слова и встроенные идентификаторы в
+          нижнем регистре (по умолчанию)
+      -upper только верхний регистр для ключевых слов и встроенных
+          идентификаторов
+      -def <имя> задать символ условной компиляции
+      -uses вывести список импортированных модулей
+      -fa <size> выравнивание секций файла PE32 в байтах, возможные значения:
+          512, 1024, 2048, 4096. По умолчанию - 512
+
+      параметр -nochk задается в виде строки из символов:
+      "p" - указатели
+      "t" - типы
+      "i" - индексы
+      "b" - неявное приведение INTEGER к BYTE
+      "c" - диапазон аргумента функции CHR
+      "w" - диапазон аргумента функции WCHR
+      "r" - эквивалентно "bcw"
+      "a" - все проверки
+
+      Порядок символов может быть любым. Наличие в строке того или иного
+      символа отключает соответствующую проверку.
+
+      Например: -nochk it - отключить проверку индексов и охрану типа.
+      -nochk a - отключить все отключаемые проверки.
+
+  Например:
+
+  Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1
+  Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti
+  Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a
+
+  В случае успешной компиляции, компилятор передает код завершения 0, иначе 1.
+
+------------------------------------------------------------------------------
+        Отличия от оригинала
+
+1.      Расширен псевдомодуль SYSTEM
+2.      В идентификаторах допускается символ "_"
+3.      Добавлены системные флаги
+4.      Усовершенствован оператор CASE (добавлены константные выражения в
+        метках вариантов и необязательная ветка ELSE)
+5.      Расширен набор стандартных процедур
+6.      Семантика охраны/проверки типа уточнена для нулевого указателя
+7.      Добавлены однострочные комментарии (начинаются с пары символов "//")
+8.      Разрешено наследование от типа-указателя
+9.      Добавлен синтаксис для импорта процедур из внешних библиотек
+10.     "Строки" можно заключать также в одиночные кавычки: 'строка'
+11.     Добавлен тип WCHAR
+12.     Добавлена операция конкатенации строковых и символьных констант
+13.     Возможен импорт модулей с указанием пути и имени файла
+14.     Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
+15.     Имя процедуры в конце объявления (после END) необязательно
+16.     Разрешено использовать нижний регистр для ключевых слов
+
+------------------------------------------------------------------------------
+        Особенности реализации
+
+1.      Основные типы
+
+          Тип              Диапазон значений                      Размер, байт
+
+        INTEGER       -9223372036854775808 .. 9223372036854775807       8
+        REAL          4.94E-324 .. 1.70E+308                            8
+        CHAR          символ ASCII (0X .. 0FFX)                         1
+        BOOLEAN       FALSE, TRUE                                       1
+        SET           множество из целых чисел {0 .. 63}                8
+        BYTE          0 .. 255                                          1
+        WCHAR         символ юникода (0X .. 0FFFFX)                     2
+
+2.      Максимальная длина идентификаторов - 255 символов
+3.      Максимальная длина строковых констант - 511 символов (UTF-8)
+4.      Максимальная размерность открытых массивов - 5
+5.      Процедура NEW заполняет нулями выделенный блок памяти
+6.      Глобальные и локальные переменные инициализируются нулями
+7.      В отличие от многих Oberon-реализаций, сборщик мусора и динамическая
+        модульность отсутствуют
+8.      Тип BYTE в выражениях всегда приводится к INTEGER
+9.      Контроль переполнения значений выражений не производится
+10.     Ошибки времени выполнения:
+
+ 1       ASSERT(x), при x = FALSE
+ 2       разыменование нулевого указателя
+ 3       целочисленное деление на неположительное число
+ 4       вызов процедуры через процедурную переменную с нулевым значением
+ 5       ошибка охраны типа
+ 6       нарушение границ массива
+ 7       непредусмотренное значение выражения в операторе CASE
+ 8       ошибка копирования массивов v := x, если LEN(v) < LEN(x)
+ 9       CHR(x), если (x < 0) OR (x > 255)
+10       WCHR(x), если (x < 0) OR (x > 65535)
+11       неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255)
+
+------------------------------------------------------------------------------
+        Псевдомодуль SYSTEM
+
+  Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры,
+ошибки при использовании процедур псевдомодуля SYSTEM могут привести к
+повреждению данных времени выполнения и аварийному завершению программы.
+
+        PROCEDURE ADR(v: любой тип): INTEGER
+                v - переменная или процедура;
+                возвращает адрес v
+
+        PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER
+                возвращает адрес x
+
+        PROCEDURE VAL(v: любой тип; T): T
+                v - переменная;
+                интерпретирует v, как переменную типа T
+
+        PROCEDURE SIZE(T): INTEGER
+                возвращает размер типа T
+
+        PROCEDURE TYPEID(T): INTEGER
+                T - тип-запись или тип-указатель,
+                возвращает номер типа в таблице типов-записей
+
+        PROCEDURE INF(): REAL
+                возвращает специальное вещественное значение "бесконечность"
+
+        PROCEDURE MOVE(Source, Dest, n: INTEGER)
+                Копирует n байт памяти из Source в Dest,
+                области Source и Dest не могут перекрываться
+
+        PROCEDURE GET(a: INTEGER;
+                VAR v: любой основной тип, PROCEDURE, POINTER)
+                v := Память[a]
+
+        PROCEDURE GET8(a: INTEGER;
+                       VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 1)
+
+        PROCEDURE GET16(a: INTEGER;
+                        VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 2)
+
+        PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32)
+                Эквивалентно
+                SYSTEM.MOVE(a, SYSTEM.ADR(x), 4)
+
+        PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER)
+                Память[a] := x;
+                Если x: BYTE или x: WCHAR, то значение x будет расширено
+                до 64 бит, для записи байтов использовать SYSTEM.PUT8,
+                для WCHAR -- SYSTEM.PUT16
+
+        PROCEDURE PUT8(a: INTEGER;
+                       x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 8 бит (x)
+
+        PROCEDURE PUT16(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 16 бит (x)
+
+        PROCEDURE PUT32(a: INTEGER;
+                        x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32)
+                Память[a] := младшие 32 бит (x)
+
+        PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER)
+                Копирует n байт памяти из Source в Dest.
+                Эквивалентно
+                SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n)
+
+        PROCEDURE CODE(byte1, byte2,... : BYTE)
+                Вставка машинного кода,
+                byte1, byte2 ... - константы в диапазоне 0..255,
+                например:
+
+                SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *)
+
+  Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не
+допускаются никакие явные операции, за исключением присваивания.
+
+  Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях.
+
+------------------------------------------------------------------------------
+        Системные флаги
+
+  При объявлении процедурных типов и глобальных процедур, после ключевого
+слова PROCEDURE может быть указан флаг соглашения о вызове:
+[win64], [systemv], [windows], [linux], [oberon], [ccall].
+Например:
+
+        PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER;
+
+  Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv].
+  Флаг [ccall] - синоним для [win64] или [systemv] (зависит от целевой ОС).
+  Знак "-" после имени флага ([win64-], [linux-], ...) означает, что
+результат процедуры можно игнорировать (не допускается для типа REAL).
+  Если флаг не указан или указан флаг [oberon], то принимается внутреннее
+соглашение о вызове. [win64] и [systemv] используются для связи с
+операционной системой и внешними приложениями.
+
+  При объявлении типов-записей, после ключевого слова RECORD может быть
+указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
+записи. Записи с системным флагом не могут иметь базовый тип и не могут быть
+базовыми типами для других записей.
+  Для использования системных флагов, требуется импортировать SYSTEM.
+
+------------------------------------------------------------------------------
+        Оператор CASE
+
+  Синтаксис оператора CASE:
+
+        CaseStatement =
+                CASE Expression OF Case {"|" Case}
+                        [ELSE StatementSequence] END.
+        Case = [CaseLabelList ":" StatementSequence].
+        CaseLabelList = CaseLabels {"," CaseLabels}.
+        CaseLabels = ConstExpression [".." ConstExpression].
+
+  Например:
+
+        CASE x OF
+        |-1:    DoSomething1
+        | 1:    DoSomething2
+        | 0:    DoSomething3
+        ELSE
+                DoSomething4
+        END
+
+  В метках вариантов можно использовать константные выражения, ветка ELSE
+необязательна. Если значение x не соответствует ни одному варианту и ELSE
+отсутствует, то программа прерывается с ошибкой времени выполнения.
+
+------------------------------------------------------------------------------
+        Тип WCHAR
+
+  Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и
+ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и
+ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает
+только тип CHAR. Для получения значения типа WCHAR, следует использовать
+процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
+исходный код в кодировке UTF-8 с BOM.
+
+------------------------------------------------------------------------------
+        Конкатенация строковых и символьных констант
+
+  Допускается конкатенация ("+") константных строк и символов типа CHAR:
+
+  str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
+
+  newline = 0DX + 0AX;
+
+------------------------------------------------------------------------------
+        Проверка и охрана типа нулевого указателя
+
+  Оригинальное сообщение о языке не определяет поведение программы при
+выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих
+Oberon-реализациях выполнение такой операции приводит к ошибке времени
+выполнения. В данной реализации охрана типа нулевого указателя не приводит к
+ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет
+значительно сократить частоту применения охраны типа.
+
+------------------------------------------------------------------------------
+        Дополнительные стандартные процедуры
+
+        DISPOSE (VAR v: любой_указатель)
+                Освобождает память, выделенную процедурой NEW для
+                динамической переменной v^, и присваивает переменной v
+                значение NIL.
+
+        COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR);
+                v := x;
+                Если LEN(v) < LEN(x), то строка x будет скопирована
+                не полностью
+
+        LSR (x, n: INTEGER): INTEGER
+                Логический сдвиг x на n бит вправо.
+
+        MIN (a, b: INTEGER): INTEGER
+                Минимум из двух значений.
+
+        MAX (a, b: INTEGER): INTEGER
+                Максимум из двух значений.
+
+        BITS (x: INTEGER): SET
+                Интерпретирует x как значение типа SET.
+                Выполняется на этапе компиляции.
+
+        LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER
+                Длина 0X-завершенной строки s, без учета символа 0X.
+                Если символ 0X отсутствует, функция возвращает длину
+                массива s. s не может быть константой.
+
+        WCHR (n: INTEGER): WCHAR
+                Преобразование типа, аналогично CHR(n: INTEGER): CHAR
+
+------------------------------------------------------------------------------
+        Импорт модулей с указанием пути и имени файла
+
+Примеры:
+
+    IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *)
+
+    IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *)
+
+------------------------------------------------------------------------------
+        Импортированные процедуры
+
+  Синтаксис импорта:
+
+  PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
+
+  - callconv -- соглашение о вызове
+  - library -- имя файла динамической библиотеки (строковая константа)
+  - function -- имя импортируемой процедуры (строковая константа), если
+  указана пустая строка, то имя процедуры = proc_name
+
+  например:
+
+  PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
+
+  PROCEDURE [windows, "kernel32.dll", ""] GetTickCount (): INTEGER;
+
+  В конце объявления может быть добавлено (необязательно) "END proc_name;"
+
+  Объявления импортированных процедур должны располагаться в глобальной
+  области видимости модуля после объявления переменных, вместе с объявлением
+  "обычных" процедур, от которых импортированные отличаются только отсутствием
+  тела процедуры. В остальном, к таким процедурам применимы те же правила:
+  их можно вызвать, присвоить процедурной переменной или получить адрес.
+
+  Так как импортированная процедура всегда имеет явное указание соглашения о
+  вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием
+  соглашения о вызове:
+
+  VAR
+      ExitProcess: PROCEDURE [windows] (code: INTEGER);
+
+  Для Linux, импортированные процедуры не реализованы.
+
+------------------------------------------------------------------------------
+        Скрытые параметры процедур
+
+  Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке
+формальных параметров, но учитываются компилятором при трансляции вызовов.
+Это возможно в следующих случаях:
+
+1.      Процедура имеет формальный параметр открытый массив:
+                PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL);
+        Вызов транслируется так:
+                Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x))
+2.      Процедура имеет формальный параметр-переменную типа RECORD:
+                PROCEDURE Proc (VAR x: Rec);
+        Вызов транслируется так:
+                Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x))
+
+  Скрытые параметры необходимо учитывать при связи с внешними приложениями.
+
+------------------------------------------------------------------------------
+        Модуль RTL
+
+  Все программы неявно используют модуль RTL. Компилятор транслирует
+некоторые операции (проверка и охрана типа, сравнение строк, сообщения об
+ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не
+следует вызывать эти процедуры явно.
+  Сообщения об ошибках времени выполнения выводятся в диалоговых окнах
+(Windows), в терминал (Linux).
+
+------------------------------------------------------------------------------
+        Модуль API
+
+  Существуют несколько реализаций модуля API (для различных ОС).
+  Как и модуль RTL, модуль API не предназначен для прямого использования.
+Он обеспечивает связь RTL с ОС.
+
+------------------------------------------------------------------------------
+        Генерация исполняемых файлов DLL
+
+  Разрешается экспортировать только процедуры. Для этого, процедура должна
+находиться в главном модуле программы, ее имя должно быть отмечено символом
+экспорта ("*") и должно быть указано соглашение о вызове. Нельзя
+экспортировать процедуры, которые импортированы из других dll-библиотек.

+ 123 - 0
lib/KOSDRV/API.ob07

@@ -0,0 +1,123 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE API;
+
+IMPORT SYSTEM;
+
+CONST
+	eol* = 0DX + 0AX;
+	BIT_DEPTH* = 32;
+
+VAR
+	action*, cmdline*, org*: INTEGER;
+
+
+PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
+BEGIN
+	SYSTEM.CODE(
+	053H,               (*  push    ebx                    *)
+	08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+	08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+	08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+	0CDH, 040H,         (*  int     64                     *)
+	05BH,               (*  pop     ebx                    *)
+	0C9H,               (*  leave                          *)
+	0C2H, 00CH, 000H    (*  ret     12                     *)
+	)
+	RETURN 0
+END sysfunc3;
+
+
+PROCEDURE OutChar* (c: CHAR);
+BEGIN
+	sysfunc3(63, 1, ORD(c))
+END OutChar;
+
+
+PROCEDURE OutLn*;
+BEGIN
+	OutChar(0DX);
+	OutChar(0AX)
+END OutLn;
+
+
+PROCEDURE OutStr (pchar: INTEGER);
+VAR
+	c: CHAR;
+BEGIN
+	IF pchar # 0 THEN
+		REPEAT
+			SYSTEM.GET(pchar, c);
+			IF c # 0X THEN
+				OutChar(c)
+			END;
+			INC(pchar)
+		UNTIL c = 0X
+	END
+END OutStr;
+
+
+PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
+BEGIN
+	IF lpCaption # 0 THEN
+		OutLn;
+		OutStr(lpCaption);
+		OutChar(":");
+		OutLn
+	END;
+	OutStr(lpText);
+	IF lpCaption # 0 THEN
+		OutLn
+	END
+END DebugMsg;
+
+
+PROCEDURE _NEW* (size: INTEGER): INTEGER;
+	RETURN sysfunc3(68, 12, size)
+END _NEW;
+
+
+PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
+BEGIN
+	sysfunc3(68, 13, ptr)
+	RETURN 0
+END _DISPOSE;
+
+
+PROCEDURE init* (reserved, _org: INTEGER);
+BEGIN
+	org := _org - 4096;
+	sysfunc3(68, 11, 0)
+END init;
+
+
+PROCEDURE exit* (code: INTEGER);
+BEGIN
+	sysfunc3(-1, 0, 0)
+END exit;
+
+
+PROCEDURE exit_thread* (code: INTEGER);
+BEGIN
+	sysfunc3(-1, 0, 0)
+END exit_thread;
+
+
+PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+BEGIN
+	action := hinstDLL;
+	cmdline := fdwReason
+	RETURN hinstDLL
+END dllentry;
+
+
+PROCEDURE sofinit*;
+END sofinit;
+
+
+END API.

+ 292 - 0
lib/KOSDRV/Debug.ob07

@@ -0,0 +1,292 @@
+(*
+    Copyright 2016, 2018, 2022, 2023 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Debug;
+
+IMPORT API, sys := SYSTEM;
+
+CONST
+
+  d = 1.0 - 5.0E-12;
+
+VAR
+
+  Realp: PROCEDURE (x: REAL; width: INTEGER);
+
+PROCEDURE Char*(c: CHAR);
+VAR res: INTEGER;
+BEGIN
+  res := API.sysfunc3(63, 1, ORD(c))
+END Char;
+
+PROCEDURE String*(s: ARRAY OF CHAR);
+VAR n, i: INTEGER;
+BEGIN
+  n := LENGTH(s);
+  FOR i := 0 TO n - 1 DO
+    Char(s[i])
+  END
+END String;
+
+PROCEDURE WriteInt(x, n: INTEGER);
+VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
+BEGIN
+  i := 0;
+  IF n < 1 THEN
+    n := 1
+  END;
+  IF x < 0 THEN
+    x := -x;
+    DEC(n);
+    neg := TRUE
+  END;
+  REPEAT
+    a[i] := CHR(x MOD 10 + ORD("0"));
+    x := x DIV 10;
+    INC(i)
+  UNTIL x = 0;
+  WHILE n > i DO
+    Char(" ");
+    DEC(n)
+  END;
+  IF neg THEN
+    Char("-")
+  END;
+  REPEAT
+    DEC(i);
+    Char(a[i])
+  UNTIL i = 0
+END WriteInt;
+
+PROCEDURE IsNan(AValue: REAL): BOOLEAN;
+VAR h, l: SET;
+BEGIN
+  sys.GET(sys.ADR(AValue), l);
+  sys.GET(sys.ADR(AValue) + 4, h)
+  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+PROCEDURE IsInf(x: REAL): BOOLEAN;
+  RETURN ABS(x) = sys.INF()
+END IsInf;
+
+PROCEDURE Int*(x, width: INTEGER);
+VAR i: INTEGER;
+BEGIN
+  IF x # 80000000H THEN
+    WriteInt(x, width)
+  ELSE
+    FOR i := 12 TO width DO
+      Char(20X)
+    END;
+    String("-2147483648")
+  END
+END Int;
+
+PROCEDURE OutInf(x: REAL; width: INTEGER);
+VAR s: ARRAY 5 OF CHAR; i: INTEGER;
+BEGIN
+  IF IsNan(x) THEN
+    s := "Nan";
+    INC(width)
+  ELSIF IsInf(x) & (x > 0.0) THEN
+    s := "+Inf"
+  ELSIF IsInf(x) & (x < 0.0) THEN
+    s := "-Inf"
+  END;
+  FOR i := 1 TO width - 4 DO
+    Char(" ")
+  END;
+  String(s)
+END OutInf;
+
+PROCEDURE Ln*;
+BEGIN
+  Char(0DX);
+  Char(0AX)
+END Ln;
+
+PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
+VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSIF p < 0 THEN
+    Realp(x, width)
+  ELSE
+    len := 0;
+    minus := FALSE;
+    IF x < 0.0 THEN
+      minus := TRUE;
+      INC(len);
+      x := ABS(x)
+    END;
+    e := 0;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    IF e >= 0 THEN
+      len := len + e + p + 1;
+      IF x > 9.0 + d THEN
+        INC(len)
+      END;
+      IF p > 0 THEN
+        INC(len)
+      END
+    ELSE
+      len := len + p + 2
+    END;
+    FOR i := 1 TO width - len DO
+      Char(" ")
+    END;
+    IF minus THEN
+      Char("-")
+    END;
+    y := x;
+    WHILE (y < 1.0) & (y # 0.0) DO
+      y := y * 10.0;
+      DEC(e)
+    END;
+    IF e < 0 THEN
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char("1");
+        x := 0.0
+      ELSE
+        Char("0");
+        x := x * 10.0
+      END
+    ELSE
+      WHILE e >= 0 DO
+        IF x - FLT(FLOOR(x)) > d THEN
+          IF x > 9.0 THEN
+            String("10")
+          ELSE
+            Char(CHR(FLOOR(x) + ORD("0") + 1))
+          END;
+          x := 0.0
+        ELSE
+          Char(CHR(FLOOR(x) + ORD("0")));
+          x := (x - FLT(FLOOR(x))) * 10.0
+        END;
+        DEC(e)
+      END
+    END;
+    IF p > 0 THEN
+      Char(".")
+    END;
+    WHILE p > 0 DO
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char(CHR(FLOOR(x) + ORD("0") + 1));
+        x := 0.0
+      ELSE
+        Char(CHR(FLOOR(x) + ORD("0")));
+        x := (x - FLT(FLOOR(x))) * 10.0
+      END;
+      DEC(p)
+    END
+  END
+END _FixReal;
+
+PROCEDURE Real*(x: REAL; width: INTEGER);
+VAR e, n, i: INTEGER; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSE
+    e := 0;
+    n := 0;
+    IF width > 23 THEN
+      n := width - 23;
+      width := 23
+    ELSIF width < 9 THEN
+      width := 9
+    END;
+    width := width - 5;
+    IF x < 0.0 THEN
+      x := -x;
+      minus := TRUE
+    ELSE
+      minus := FALSE
+    END;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    WHILE (x < 1.0) & (x # 0.0) DO
+      x := x * 10.0;
+      DEC(e)
+    END;
+    IF x > 9.0 + d THEN
+      x := 1.0;
+      INC(e)
+    END;
+    FOR i := 1 TO n DO
+      Char(" ")
+    END;
+    IF minus THEN
+      x := -x
+    END;
+    Realp := Real;
+    _FixReal(x, width, width - 3);
+    Char("E");
+    IF e >= 0 THEN
+      Char("+")
+    ELSE
+      Char("-");
+      e := ABS(e)
+    END;
+    IF e < 100 THEN
+      Char("0")
+    END;
+    IF e < 10 THEN
+      Char("0")
+    END;
+    Int(e, 0)
+  END
+END Real;
+
+PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
+BEGIN
+  Realp := Real;
+  _FixReal(x, width, p)
+END FixReal;
+
+PROCEDURE Open*;
+TYPE
+
+  info_struct = RECORD
+    subfunc: INTEGER;
+    flags:   INTEGER;
+    param:   INTEGER;
+    rsrvd1:  INTEGER;
+    rsrvd2:  INTEGER;
+    fname:   ARRAY 1024 OF CHAR
+  END;
+
+VAR info: info_struct; res: INTEGER;
+BEGIN
+  info.subfunc := 7;
+  info.flags := 0;
+  info.param := sys.SADR(" ");
+  info.rsrvd1 := 0;
+  info.rsrvd2 := 0;
+  info.fname := "/sys/develop/board";
+  res := API.sysfunc3(70, sys.ADR(info), 0)
+END Open;
+
+END Debug.

+ 548 - 0
lib/KOSDRV/RTL.ob07

@@ -0,0 +1,548 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name, types, tcount: INTEGER;
+
+
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
+    085H, 0C0H,          (*  test eax, eax              *)
+    07EH, 019H,          (*  jle L                      *)
+    0FCH,                (*  cld                        *)
+    057H,                (*  push edi                   *)
+    056H,                (*  push esi                   *)
+    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
+    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
+    0F3H, 0A5H,          (*  rep movsd                  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
+    0F3H, 0A4H,          (*  rep movsb                  *)
+    05EH,                (*  pop esi                    *)
+    05FH                 (*  pop edi                    *)
+                         (*  L:                         *)
+                )
+END _move;
+
+
+PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
+    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
+    049H,               (*  dec   ecx                    *)
+    053H,               (*  push  ebx                    *)
+    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
+                        (*  L:                           *)
+    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
+    089H, 010H,         (*  mov   dword [eax], edx       *)
+    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
+    049H,               (*  dec   ecx                    *)
+    075H, 0F5H,         (*  jnz   L                      *)
+    089H, 018H,         (*  mov   dword [eax], ebx       *)
+    05BH,               (*  pop   ebx                    *)
+    05DH,               (*  pop   ebp                    *)
+    0C2H, 008H, 000H    (*  ret   8                      *)
+    )
+END _rot;
+
+
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
+    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
+    039H, 0C8H,                    (*  cmp   eax, ecx               *)
+    07FH, 033H,                    (*  jg    L1                     *)
+    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
+    07FH, 02EH,                    (*  jg    L1                     *)
+    085H, 0C9H,                    (*  test  ecx, ecx               *)
+    07CH, 02AH,                    (*  jl    L1                     *)
+    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
+    07EH, 005H,                    (*  jle   L3                     *)
+    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
+                                   (*  L3:                          *)
+    085H, 0C0H,                    (*  test  eax, eax               *)
+    07DH, 002H,                    (*  jge   L2                     *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+                                   (*  L2:                          *)
+    089H, 0CAH,                    (*  mov   edx, ecx               *)
+    029H, 0C2H,                    (*  sub   edx, eax               *)
+    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    0D3H, 0F8H,                    (*  sar   eax, cl                *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
+    0F7H, 0D9H,                    (*  neg   ecx                    *)
+    0D3H, 0E8H,                    (*  shr   eax, cl                *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H,              (*  ret   8                      *)
+                                   (*  L1:                          *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H               (*  ret   8                      *)
+    )
+END _set;
+
+
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    031H, 0C0H,         (*  xor  eax, eax              *)
+    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
+    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
+    077H, 003H,         (*  ja   L                     *)
+    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
+                        (*  L:                         *)
+    )
+END _set1;
+
+
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
+BEGIN
+    SYSTEM.CODE(
+    053H,                (*  push    ebx                    *)
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
+    031H, 0D2H,          (*  xor     edx, edx               *)
+    085H, 0C0H,          (*  test    eax, eax               *)
+    074H, 018H,          (*  je      L2                     *)
+    07FH, 002H,          (*  jg      L1                     *)
+    0F7H, 0D2H,          (*  not     edx                    *)
+                         (*  L1:                            *)
+    089H, 0C3H,          (*  mov     ebx, eax               *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
+    0F7H, 0F9H,          (*  idiv    ecx                    *)
+    085H, 0D2H,          (*  test    edx, edx               *)
+    074H, 009H,          (*  je      L2                     *)
+    031H, 0CBH,          (*  xor     ebx, ecx               *)
+    085H, 0DBH,          (*  test    ebx, ebx               *)
+    07DH, 003H,          (*  jge     L2                     *)
+    048H,                (*  dec     eax                    *)
+    001H, 0CAH,          (*  add     edx, ecx               *)
+                         (*  L2:                            *)
+    05BH                 (*  pop     ebx                    *)
+               )
+END _divmod;
+
+
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD)
+    END
+END _new;
+
+
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - WORD)
+    END
+END _dispose;
+
+
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                (*  dec     eax                     *)
+                         (*  L1:                             *)
+    040H,                (*  inc     eax                     *)
+    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
+    074H, 003H,          (*  jz      L2                      *)
+    0E2H, 0F8H,          (*  loop    L1                      *)
+    040H,                (*  inc     eax                     *)
+                         (*  L2:                             *)
+    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
+               )
+END _length;
+
+
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                     (*  dec     eax                     *)
+    048H,                     (*  dec     eax                     *)
+                              (*  L1:                             *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
+    074H, 004H,               (*  jz      L2                      *)
+    0E2H, 0F6H,               (*  loop    L1                      *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+                              (*  L2:                             *)
+    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
+    0D1H, 0E8H                (*  shr     eax, 1                  *)
+               )
+END _lengthw;
+
+
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 017H,              (*  jle     L3                             *)
+    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
+    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E7H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 01BH,              (*  jle     L3                             *)
+    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
+    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E3H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
+BEGIN
+    (* r IS t0 *)
+    WHILE (t1 # 0) & (t1 # t0) DO
+        SYSTEM.GET(types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _isrec;
+
+
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+VAR
+    t1: INTEGER;
+
+BEGIN
+    (* p IS t0 *)
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, t1);
+        WHILE (t1 # 0) & (t1 # t0) DO
+            SYSTEM.GET(types + t1 * WORD, t1)
+        END
+    ELSE
+        t1 := -1
+    END
+
+    RETURN t1 = t0
+END _is;
+
+
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+    (* r:t1 IS t0 *)
+    WHILE (t1 # 0) & (t1 # t0) DO
+        SYSTEM.GET(types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+VAR
+    t1:  INTEGER;
+
+BEGIN
+    (* p IS t0 *)
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, t1);
+        WHILE (t1 # t0) & (t1 # 0) DO
+            SYSTEM.GET(types + t1 * WORD, t1)
+        END
+    ELSE
+        t1 := t0
+    END
+
+    RETURN t1 = t0
+END _guard;
+
+
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [stdcall] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+PROCEDURE [stdcall] _init* (modname: INTEGER; _tcount, _types: INTEGER; code, param: INTEGER);
+BEGIN
+    SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
+    API.init(param, code);
+    tcount := _tcount;
+    types := _types;
+    name := modname
+END _init;
+
+
+END RTL.

+ 131 - 0
lib/KOSKER/API.ob07

@@ -0,0 +1,131 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE API;
+
+IMPORT SYSTEM;
+
+CONST
+	eol* = 0DX + 0AX;
+	BIT_DEPTH* = 32;
+
+	HEAP_SIZE = 3*1024;
+
+VAR
+	org*: INTEGER;
+
+	mem: ARRAY HEAP_SIZE OF BYTE;
+	heap: INTEGER;
+
+
+PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
+BEGIN
+	SYSTEM.CODE(
+	053H,               (*  push    ebx                    *)
+	08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+	08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+	08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+	0CDH, 040H,         (*  int     64                     *)
+	05BH,               (*  pop     ebx                    *)
+	0C9H,               (*  leave                          *)
+	0C2H, 00CH, 000H    (*  ret     12                     *)
+	)
+	RETURN 0
+END sysfunc3;
+
+
+PROCEDURE OutChar* (c: CHAR);
+BEGIN
+	sysfunc3(63, 1, ORD(c))
+END OutChar;
+
+
+PROCEDURE OutLn*;
+BEGIN
+	OutChar(0DX);
+	OutChar(0AX)
+END OutLn;
+
+
+PROCEDURE OutStr* (pchar: INTEGER);
+VAR
+	c: CHAR;
+BEGIN
+	IF pchar # 0 THEN
+		REPEAT
+			SYSTEM.GET(pchar, c);
+			IF c # 0X THEN
+				OutChar(c)
+			END;
+			INC(pchar)
+		UNTIL c = 0X
+	END
+END OutStr;
+
+
+PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
+BEGIN
+	IF lpCaption # 0 THEN
+		OutLn;
+		OutStr(lpCaption);
+		OutChar(":");
+		OutLn
+	END;
+	OutStr(lpText);
+	IF lpCaption # 0 THEN
+		OutLn
+	END
+END DebugMsg;
+
+
+PROCEDURE _NEW* (size: INTEGER): INTEGER;
+VAR
+	res: INTEGER;
+BEGIN
+	IF heap + size <= SYSTEM.ADR(mem[0]) + HEAP_SIZE THEN
+		res := heap;
+		INC(heap, size)
+	ELSE
+		res := 0
+	END
+	RETURN res
+END _NEW;
+
+
+PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
+	RETURN 0
+END _DISPOSE;
+
+
+PROCEDURE init* (reserved, _org: INTEGER);
+BEGIN
+	org := _org;
+	heap := SYSTEM.ADR(mem[0])
+END init;
+
+
+PROCEDURE exit* (code: INTEGER);
+BEGIN
+	sysfunc3(-1, 0, 0)
+END exit;
+
+
+PROCEDURE exit_thread* (code: INTEGER);
+BEGIN
+	sysfunc3(-1, 0, 0)
+END exit_thread;
+
+
+PROCEDURE dllentry* (param1, param2, param3: INTEGER): INTEGER;
+	RETURN 0
+END dllentry;
+
+
+PROCEDURE sofinit*;
+END sofinit;
+
+END API.

+ 292 - 0
lib/KOSKER/Debug.ob07

@@ -0,0 +1,292 @@
+(*
+    Copyright 2016, 2018, 2022, 2023 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Debug;
+
+IMPORT API, sys := SYSTEM;
+
+CONST
+
+  d = 1.0 - 5.0E-12;
+
+VAR
+
+  Realp: PROCEDURE (x: REAL; width: INTEGER);
+
+PROCEDURE Char*(c: CHAR);
+VAR res: INTEGER;
+BEGIN
+  res := API.sysfunc3(63, 1, ORD(c))
+END Char;
+
+PROCEDURE String*(s: ARRAY OF CHAR);
+VAR n, i: INTEGER;
+BEGIN
+  n := LENGTH(s);
+  FOR i := 0 TO n - 1 DO
+    Char(s[i])
+  END
+END String;
+
+PROCEDURE WriteInt(x, n: INTEGER);
+VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
+BEGIN
+  i := 0;
+  IF n < 1 THEN
+    n := 1
+  END;
+  IF x < 0 THEN
+    x := -x;
+    DEC(n);
+    neg := TRUE
+  END;
+  REPEAT
+    a[i] := CHR(x MOD 10 + ORD("0"));
+    x := x DIV 10;
+    INC(i)
+  UNTIL x = 0;
+  WHILE n > i DO
+    Char(" ");
+    DEC(n)
+  END;
+  IF neg THEN
+    Char("-")
+  END;
+  REPEAT
+    DEC(i);
+    Char(a[i])
+  UNTIL i = 0
+END WriteInt;
+
+PROCEDURE IsNan(AValue: REAL): BOOLEAN;
+VAR h, l: SET;
+BEGIN
+  sys.GET(sys.ADR(AValue), l);
+  sys.GET(sys.ADR(AValue) + 4, h)
+  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+PROCEDURE IsInf(x: REAL): BOOLEAN;
+  RETURN ABS(x) = sys.INF()
+END IsInf;
+
+PROCEDURE Int*(x, width: INTEGER);
+VAR i: INTEGER;
+BEGIN
+  IF x # 80000000H THEN
+    WriteInt(x, width)
+  ELSE
+    FOR i := 12 TO width DO
+      Char(20X)
+    END;
+    String("-2147483648")
+  END
+END Int;
+
+PROCEDURE OutInf(x: REAL; width: INTEGER);
+VAR s: ARRAY 5 OF CHAR; i: INTEGER;
+BEGIN
+  IF IsNan(x) THEN
+    s := "Nan";
+    INC(width)
+  ELSIF IsInf(x) & (x > 0.0) THEN
+    s := "+Inf"
+  ELSIF IsInf(x) & (x < 0.0) THEN
+    s := "-Inf"
+  END;
+  FOR i := 1 TO width - 4 DO
+    Char(" ")
+  END;
+  String(s)
+END OutInf;
+
+PROCEDURE Ln*;
+BEGIN
+  Char(0DX);
+  Char(0AX)
+END Ln;
+
+PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
+VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSIF p < 0 THEN
+    Realp(x, width)
+  ELSE
+    len := 0;
+    minus := FALSE;
+    IF x < 0.0 THEN
+      minus := TRUE;
+      INC(len);
+      x := ABS(x)
+    END;
+    e := 0;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    IF e >= 0 THEN
+      len := len + e + p + 1;
+      IF x > 9.0 + d THEN
+        INC(len)
+      END;
+      IF p > 0 THEN
+        INC(len)
+      END
+    ELSE
+      len := len + p + 2
+    END;
+    FOR i := 1 TO width - len DO
+      Char(" ")
+    END;
+    IF minus THEN
+      Char("-")
+    END;
+    y := x;
+    WHILE (y < 1.0) & (y # 0.0) DO
+      y := y * 10.0;
+      DEC(e)
+    END;
+    IF e < 0 THEN
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char("1");
+        x := 0.0
+      ELSE
+        Char("0");
+        x := x * 10.0
+      END
+    ELSE
+      WHILE e >= 0 DO
+        IF x - FLT(FLOOR(x)) > d THEN
+          IF x > 9.0 THEN
+            String("10")
+          ELSE
+            Char(CHR(FLOOR(x) + ORD("0") + 1))
+          END;
+          x := 0.0
+        ELSE
+          Char(CHR(FLOOR(x) + ORD("0")));
+          x := (x - FLT(FLOOR(x))) * 10.0
+        END;
+        DEC(e)
+      END
+    END;
+    IF p > 0 THEN
+      Char(".")
+    END;
+    WHILE p > 0 DO
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char(CHR(FLOOR(x) + ORD("0") + 1));
+        x := 0.0
+      ELSE
+        Char(CHR(FLOOR(x) + ORD("0")));
+        x := (x - FLT(FLOOR(x))) * 10.0
+      END;
+      DEC(p)
+    END
+  END
+END _FixReal;
+
+PROCEDURE Real*(x: REAL; width: INTEGER);
+VAR e, n, i: INTEGER; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSE
+    e := 0;
+    n := 0;
+    IF width > 23 THEN
+      n := width - 23;
+      width := 23
+    ELSIF width < 9 THEN
+      width := 9
+    END;
+    width := width - 5;
+    IF x < 0.0 THEN
+      x := -x;
+      minus := TRUE
+    ELSE
+      minus := FALSE
+    END;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    WHILE (x < 1.0) & (x # 0.0) DO
+      x := x * 10.0;
+      DEC(e)
+    END;
+    IF x > 9.0 + d THEN
+      x := 1.0;
+      INC(e)
+    END;
+    FOR i := 1 TO n DO
+      Char(" ")
+    END;
+    IF minus THEN
+      x := -x
+    END;
+    Realp := Real;
+    _FixReal(x, width, width - 3);
+    Char("E");
+    IF e >= 0 THEN
+      Char("+")
+    ELSE
+      Char("-");
+      e := ABS(e)
+    END;
+    IF e < 100 THEN
+      Char("0")
+    END;
+    IF e < 10 THEN
+      Char("0")
+    END;
+    Int(e, 0)
+  END
+END Real;
+
+PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
+BEGIN
+  Realp := Real;
+  _FixReal(x, width, p)
+END FixReal;
+
+PROCEDURE Open*;
+TYPE
+
+  info_struct = RECORD
+    subfunc: INTEGER;
+    flags:   INTEGER;
+    param:   INTEGER;
+    rsrvd1:  INTEGER;
+    rsrvd2:  INTEGER;
+    fname:   ARRAY 1024 OF CHAR
+  END;
+
+VAR info: info_struct; res: INTEGER;
+BEGIN
+  info.subfunc := 7;
+  info.flags := 0;
+  info.param := sys.SADR(" ");
+  info.rsrvd1 := 0;
+  info.rsrvd2 := 0;
+  info.fname := "/sys/develop/board";
+  res := API.sysfunc3(70, sys.ADR(info), 0)
+END Open;
+
+END Debug.

+ 548 - 0
lib/KOSKER/RTL.ob07

@@ -0,0 +1,548 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name, types, tcount: INTEGER;
+
+
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
+    085H, 0C0H,          (*  test eax, eax              *)
+    07EH, 019H,          (*  jle L                      *)
+    0FCH,                (*  cld                        *)
+    057H,                (*  push edi                   *)
+    056H,                (*  push esi                   *)
+    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
+    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
+    0F3H, 0A5H,          (*  rep movsd                  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
+    0F3H, 0A4H,          (*  rep movsb                  *)
+    05EH,                (*  pop esi                    *)
+    05FH                 (*  pop edi                    *)
+                         (*  L:                         *)
+                )
+END _move;
+
+
+PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
+    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
+    049H,               (*  dec   ecx                    *)
+    053H,               (*  push  ebx                    *)
+    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
+                        (*  L:                           *)
+    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
+    089H, 010H,         (*  mov   dword [eax], edx       *)
+    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
+    049H,               (*  dec   ecx                    *)
+    075H, 0F5H,         (*  jnz   L                      *)
+    089H, 018H,         (*  mov   dword [eax], ebx       *)
+    05BH,               (*  pop   ebx                    *)
+    05DH,               (*  pop   ebp                    *)
+    0C2H, 008H, 000H    (*  ret   8                      *)
+    )
+END _rot;
+
+
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
+    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
+    039H, 0C8H,                    (*  cmp   eax, ecx               *)
+    07FH, 033H,                    (*  jg    L1                     *)
+    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
+    07FH, 02EH,                    (*  jg    L1                     *)
+    085H, 0C9H,                    (*  test  ecx, ecx               *)
+    07CH, 02AH,                    (*  jl    L1                     *)
+    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
+    07EH, 005H,                    (*  jle   L3                     *)
+    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
+                                   (*  L3:                          *)
+    085H, 0C0H,                    (*  test  eax, eax               *)
+    07DH, 002H,                    (*  jge   L2                     *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+                                   (*  L2:                          *)
+    089H, 0CAH,                    (*  mov   edx, ecx               *)
+    029H, 0C2H,                    (*  sub   edx, eax               *)
+    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    0D3H, 0F8H,                    (*  sar   eax, cl                *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
+    0F7H, 0D9H,                    (*  neg   ecx                    *)
+    0D3H, 0E8H,                    (*  shr   eax, cl                *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H,              (*  ret   8                      *)
+                                   (*  L1:                          *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H               (*  ret   8                      *)
+    )
+END _set;
+
+
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    031H, 0C0H,         (*  xor  eax, eax              *)
+    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
+    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
+    077H, 003H,         (*  ja   L                     *)
+    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
+                        (*  L:                         *)
+    )
+END _set1;
+
+
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
+BEGIN
+    SYSTEM.CODE(
+    053H,                (*  push    ebx                    *)
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
+    031H, 0D2H,          (*  xor     edx, edx               *)
+    085H, 0C0H,          (*  test    eax, eax               *)
+    074H, 018H,          (*  je      L2                     *)
+    07FH, 002H,          (*  jg      L1                     *)
+    0F7H, 0D2H,          (*  not     edx                    *)
+                         (*  L1:                            *)
+    089H, 0C3H,          (*  mov     ebx, eax               *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
+    0F7H, 0F9H,          (*  idiv    ecx                    *)
+    085H, 0D2H,          (*  test    edx, edx               *)
+    074H, 009H,          (*  je      L2                     *)
+    031H, 0CBH,          (*  xor     ebx, ecx               *)
+    085H, 0DBH,          (*  test    ebx, ebx               *)
+    07DH, 003H,          (*  jge     L2                     *)
+    048H,                (*  dec     eax                    *)
+    001H, 0CAH,          (*  add     edx, ecx               *)
+                         (*  L2:                            *)
+    05BH                 (*  pop     ebx                    *)
+               )
+END _divmod;
+
+
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD)
+    END
+END _new;
+
+
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - WORD)
+    END
+END _dispose;
+
+
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                (*  dec     eax                     *)
+                         (*  L1:                             *)
+    040H,                (*  inc     eax                     *)
+    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
+    074H, 003H,          (*  jz      L2                      *)
+    0E2H, 0F8H,          (*  loop    L1                      *)
+    040H,                (*  inc     eax                     *)
+                         (*  L2:                             *)
+    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
+               )
+END _length;
+
+
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                     (*  dec     eax                     *)
+    048H,                     (*  dec     eax                     *)
+                              (*  L1:                             *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
+    074H, 004H,               (*  jz      L2                      *)
+    0E2H, 0F6H,               (*  loop    L1                      *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+                              (*  L2:                             *)
+    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
+    0D1H, 0E8H                (*  shr     eax, 1                  *)
+               )
+END _lengthw;
+
+
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 017H,              (*  jle     L3                             *)
+    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
+    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E7H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 01BH,              (*  jle     L3                             *)
+    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
+    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E3H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
+BEGIN
+    (* r IS t0 *)
+    WHILE (t1 # 0) & (t1 # t0) DO
+        SYSTEM.GET(types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _isrec;
+
+
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+VAR
+    t1: INTEGER;
+
+BEGIN
+    (* p IS t0 *)
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, t1);
+        WHILE (t1 # 0) & (t1 # t0) DO
+            SYSTEM.GET(types + t1 * WORD, t1)
+        END
+    ELSE
+        t1 := -1
+    END
+
+    RETURN t1 = t0
+END _is;
+
+
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+    (* r:t1 IS t0 *)
+    WHILE (t1 # 0) & (t1 # t0) DO
+        SYSTEM.GET(types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+VAR
+    t1:  INTEGER;
+
+BEGIN
+    (* p IS t0 *)
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, t1);
+        WHILE (t1 # t0) & (t1 # 0) DO
+            SYSTEM.GET(types + t1 * WORD, t1)
+        END
+    ELSE
+        t1 := t0
+    END
+
+    RETURN t1 = t0
+END _guard;
+
+
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [stdcall] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+PROCEDURE [stdcall] _init* (modname: INTEGER; _tcount, _types: INTEGER; code, param: INTEGER);
+BEGIN
+    SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
+    API.init(param, code);
+    tcount := _tcount;
+    types := _types;
+    name := modname
+END _init;
+
+
+END RTL.

+ 290 - 0
lib/KolibriOS/API.ob07

@@ -0,0 +1,290 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018, 2020-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE API;
+
+IMPORT SYSTEM, K := KOSAPI;
+
+
+CONST
+
+    eol* = 0DX + 0AX;
+    BIT_DEPTH* = 32;
+
+    MAX_SIZE  = 16 * 400H;
+    HEAP_SIZE =  1 * 100000H;
+
+    _new = 1;
+    _dispose = 2;
+
+    SizeOfHeader = 36;
+
+
+TYPE
+
+    CRITICAL_SECTION = ARRAY 2 OF INTEGER;
+
+
+VAR
+
+    heap, endheap: INTEGER;
+    pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
+
+    CriticalSection: CRITICAL_SECTION;
+
+    multi: BOOLEAN;
+
+    base*: INTEGER;
+
+
+PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    0FCH,               (*  cld                            *)
+    031H, 0C0H,         (*  xor     eax, eax               *)
+    057H,               (*  push    edi                    *)
+    08BH, 07DH, 00CH,   (*  mov     edi, dword [ebp + 12]  *)
+    08BH, 04DH, 008H,   (*  mov     ecx, dword [ebp +  8]  *)
+    0F3H, 0ABH,         (*  rep     stosd                  *)
+    05FH                (*  pop     edi                    *)
+    )
+END zeromem;
+
+
+PROCEDURE mem_commit* (adr, size: INTEGER);
+VAR
+    tmp: INTEGER;
+BEGIN
+    FOR tmp := adr TO adr + size - 1 BY 4096 DO
+        SYSTEM.PUT(tmp, 0)
+    END
+END mem_commit;
+
+
+PROCEDURE switch_task;
+BEGIN
+    K.sysfunc2(68, 1)
+END switch_task;
+
+
+PROCEDURE futex_create (ptr: INTEGER): INTEGER;
+    RETURN K.sysfunc3(77, 0, ptr)
+END futex_create;
+
+
+PROCEDURE futex_wait (futex, value, timeout: INTEGER);
+BEGIN
+    K.sysfunc5(77, 2, futex, value, timeout)
+END futex_wait;
+
+
+PROCEDURE futex_wake (futex, number: INTEGER);
+BEGIN
+    K.sysfunc4(77, 3, futex, number)
+END futex_wake;
+
+
+PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
+BEGIN
+    switch_task;
+    futex_wait(CriticalSection[0], 1, 10000);
+    CriticalSection[1] := 1
+END EnterCriticalSection;
+
+
+PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
+BEGIN
+    CriticalSection[1] := 0;
+    futex_wake(CriticalSection[0], 1)
+END LeaveCriticalSection;
+
+
+PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
+BEGIN
+    CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1]));
+    CriticalSection[1] := 0
+END InitializeCriticalSection;
+
+
+PROCEDURE __NEW (size: INTEGER): INTEGER;
+VAR
+    res, idx, temp: INTEGER;
+BEGIN
+    IF size <= MAX_SIZE THEN
+        idx := ASR(size, 5);
+        res := pockets[idx];
+        IF res # 0 THEN
+            SYSTEM.GET(res, pockets[idx]);
+            SYSTEM.PUT(res, size);
+            INC(res, 4)
+        ELSE
+            temp := 0;
+            IF heap + size >= endheap THEN
+                IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
+                    temp := K.sysfunc3(68, 12, HEAP_SIZE)
+                ELSE
+                    temp := 0
+                END;
+                IF temp # 0 THEN
+                    mem_commit(temp, HEAP_SIZE);
+                    heap := temp;
+                    endheap := heap + HEAP_SIZE
+                ELSE
+                    temp := -1
+                END
+            END;
+            IF (heap # 0) & (temp # -1) THEN
+                SYSTEM.PUT(heap, size);
+                res := heap + 4;
+                heap := heap + size
+            ELSE
+                res := 0
+            END
+        END
+    ELSE
+        IF K.sysfunc2(18, 16) > ASR(size, 10) THEN
+            res := K.sysfunc3(68, 12, size);
+            IF res # 0 THEN
+                mem_commit(res, size);
+                SYSTEM.PUT(res, size);
+                INC(res, 4)
+            END
+        ELSE
+            res := 0
+        END
+    END;
+    IF (res # 0) & (size <= MAX_SIZE) THEN
+        zeromem(ASR(size, 2) - 1, res)
+    END
+    RETURN res
+END __NEW;
+
+
+PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER;
+VAR
+    size, idx: INTEGER;
+BEGIN
+    DEC(ptr, 4);
+    SYSTEM.GET(ptr, size);
+    IF size <= MAX_SIZE THEN
+        idx := ASR(size, 5);
+        SYSTEM.PUT(ptr, pockets[idx]);
+        pockets[idx] := ptr
+    ELSE
+        size := K.sysfunc3(68, 13, ptr)
+    END
+    RETURN 0
+END __DISPOSE;
+
+
+PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF multi THEN
+        EnterCriticalSection(CriticalSection)
+    END;
+
+    IF func = _new THEN
+        res := __NEW(arg)
+    ELSIF func = _dispose THEN
+        res := __DISPOSE(arg)
+    END;
+
+    IF multi THEN
+        LeaveCriticalSection(CriticalSection)
+    END
+
+    RETURN res
+END NEW_DISPOSE;
+
+
+PROCEDURE _NEW* (size: INTEGER): INTEGER;
+    RETURN NEW_DISPOSE(_new, size)
+END _NEW;
+
+
+PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
+    RETURN NEW_DISPOSE(_dispose, ptr)
+END _DISPOSE;
+
+
+PROCEDURE exit* (p1: INTEGER);
+BEGIN
+    K.sysfunc1(-1)
+END exit;
+
+
+PROCEDURE exit_thread* (p1: INTEGER);
+BEGIN
+    K.sysfunc1(-1)
+END exit_thread;
+
+
+PROCEDURE OutStr (pchar: INTEGER);
+VAR
+    c: CHAR;
+BEGIN
+    IF pchar # 0 THEN
+        REPEAT
+            SYSTEM.GET(pchar, c);
+            IF c # 0X THEN
+                K.OutChar(c)
+            END;
+            INC(pchar)
+        UNTIL c = 0X
+    END
+END OutStr;
+
+
+PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
+BEGIN
+    IF lpCaption # 0 THEN
+        K.OutLn;
+        OutStr(lpCaption);
+        K.OutChar(":");
+        K.OutLn
+    END;
+    OutStr(lpText);
+    IF lpCaption # 0 THEN
+        K.OutLn
+    END
+END DebugMsg;
+
+
+PROCEDURE init* (import_, code: INTEGER);
+BEGIN
+    multi := FALSE;
+    base := code - SizeOfHeader;
+    K.sysfunc2(68, 11);
+    InitializeCriticalSection(CriticalSection);
+    K._init(import_)
+END init;
+
+
+PROCEDURE SetMultiThr* (value: BOOLEAN);
+BEGIN
+    multi := value
+END SetMultiThr;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+    RETURN K.sysfunc2(26, 9) * 10
+END GetTickCount;
+
+
+PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN 0
+END dllentry;
+
+
+PROCEDURE sofinit*;
+END sofinit;
+
+
+END API.

+ 100 - 0
lib/KolibriOS/Args.ob07

@@ -0,0 +1,100 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Args;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+CONST
+
+  MAX_PARAM = 1024;
+
+VAR
+
+  Params: ARRAY MAX_PARAM, 2 OF INTEGER;
+  argc*: INTEGER;
+
+PROCEDURE GetChar(adr: INTEGER): CHAR;
+VAR res: CHAR;
+BEGIN
+  sys.GET(adr, res)
+  RETURN res
+END GetChar;
+
+PROCEDURE ParamParse;
+VAR p, count, name: INTEGER; c: CHAR; cond: INTEGER;
+
+  PROCEDURE ChangeCond(A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
+  BEGIN
+    IF (c <= 20X) & (c # 0X) THEN
+      cond := A
+    ELSIF c = 22X THEN
+      cond := B
+    ELSIF c = 0X THEN
+      cond := 6
+    ELSE
+      cond := C
+    END
+  END ChangeCond;
+
+BEGIN
+  p := KOSAPI.GetCommandLine();
+  name := KOSAPI.GetName();
+  Params[0, 0] := name;
+  WHILE GetChar(name) # 0X DO
+    INC(name)
+  END;
+  Params[0, 1] := name - 1;
+  cond := 0;
+  count := 1;
+  WHILE (argc < MAX_PARAM) & (cond # 6) DO
+    c := GetChar(p);
+    CASE cond OF
+    |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
+    |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
+    |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+    |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
+    |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+    ELSE
+    END;
+    INC(p)
+  END;
+  argc := count
+END ParamParse;
+
+PROCEDURE GetArg*(n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR i, j, len: INTEGER; c: CHAR;
+BEGIN
+  j := 0;
+  IF n < argc THEN
+    len := LEN(s) - 1;
+    i := Params[n, 0];
+    WHILE (j < len) & (i <= Params[n, 1]) DO
+      c := GetChar(i);
+      IF c # 22X THEN
+        s[j] := c;
+        INC(j)
+      END;
+      INC(i);
+    END;
+  END;
+  s[j] := 0X
+END GetArg;
+
+BEGIN
+  ParamParse
+END Args.

+ 105 - 0
lib/KolibriOS/ColorDlg.ob07

@@ -0,0 +1,105 @@
+(*
+    Copyright 2016, 2018, 2020, 2022 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE ColorDlg;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+TYPE
+
+  DRAW_WINDOW = PROCEDURE;
+
+  TDialog = RECORD
+    _type,
+    procinfo,
+    com_area_name,
+    com_area,
+    start_path: INTEGER;
+    draw_window: DRAW_WINDOW;
+    status*,
+    X, Y,
+    color_type,
+    color*: INTEGER;
+
+    procinf: ARRAY 1024 OF CHAR;
+    s_com_area_name: ARRAY 32 OF CHAR
+  END;
+
+  Dialog* = POINTER TO TDialog;
+
+VAR
+
+  Dialog_start, Dialog_init: PROCEDURE [stdcall] (cd: Dialog);
+
+PROCEDURE Show*(cd: Dialog);
+BEGIN
+  IF cd # NIL THEN
+    cd.X := 0;
+    cd.Y := 0;
+    Dialog_start(cd)
+  END
+END Show;
+
+PROCEDURE Create*(draw_window: DRAW_WINDOW): Dialog;
+VAR res: Dialog;
+BEGIN
+  NEW(res);
+  IF res # NIL THEN
+    res.s_com_area_name := "FFFFFFFF_color_dlg";
+    res.com_area := 0;
+    res._type := 0;
+    res.color_type := 0;
+    res.procinfo := sys.ADR(res.procinf[0]);
+    res.com_area_name := sys.ADR(res.s_com_area_name[0]);
+    res.start_path := sys.SADR("/sys/colrdial");
+    res.draw_window := draw_window;
+    res.status := 0;
+    res.X := 0;
+    res.Y := 0;
+    res.color := 0;
+    Dialog_init(res)
+  END
+  RETURN res
+END Create;
+
+PROCEDURE Destroy*(VAR cd: Dialog);
+BEGIN
+  IF cd # NIL THEN
+    DISPOSE(cd)
+  END
+END Destroy;
+
+PROCEDURE Load;
+VAR Lib: INTEGER;
+
+  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
+  VAR a: INTEGER;
+  BEGIN
+    a := KOSAPI.GetProcAdr(name, Lib);
+    ASSERT(a # 0);
+    sys.PUT(v, a)
+  END GetProc;
+
+BEGIN
+  Lib := KOSAPI.LoadLib("/sys/Lib/Proc_lib.obj");
+  GetProc(Lib, sys.ADR(Dialog_init), "ColorDialog_init");
+  GetProc(Lib, sys.ADR(Dialog_start), "ColorDialog_start");
+END Load;
+
+BEGIN
+  Load
+END ColorDlg.

+ 94 - 0
lib/KolibriOS/Console.ob07

@@ -0,0 +1,94 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Console;
+
+IMPORT ConsoleLib, In, Out;
+
+
+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;
+
+
+PROCEDURE SetCursor* (X, Y: INTEGER);
+BEGIN
+    ConsoleLib.set_cursor_pos(X, Y)
+END SetCursor;
+
+
+PROCEDURE GetCursor* (VAR X, Y: INTEGER);
+BEGIN
+    ConsoleLib.get_cursor_pos(X, Y)
+END GetCursor;
+
+
+PROCEDURE Cls*;
+BEGIN
+    ConsoleLib.cls
+END Cls;
+
+
+PROCEDURE SetColor* (FColor, BColor: INTEGER);
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN
+        res := ConsoleLib.set_flags(LSL(BColor, 4) + FColor)
+    END
+END SetColor;
+
+
+PROCEDURE GetCursorX* (): INTEGER;
+VAR
+    x, y: INTEGER;
+
+BEGIN
+    ConsoleLib.get_cursor_pos(x, y)
+    RETURN x
+END GetCursorX;
+
+
+PROCEDURE GetCursorY* (): INTEGER;
+VAR
+    x, y: INTEGER;
+
+BEGIN
+    ConsoleLib.get_cursor_pos(x, y)
+    RETURN y
+END GetCursorY;
+
+
+PROCEDURE open*;
+BEGIN
+    ConsoleLib.open(-1, -1, -1, -1, "");
+    In.Open;
+    Out.Open
+END open;
+
+
+PROCEDURE exit* (bCloseWindow: BOOLEAN);
+BEGIN
+    ConsoleLib.exit(bCloseWindow)
+END exit;
+
+
+END Console.

+ 103 - 0
lib/KolibriOS/ConsoleLib.ob07

@@ -0,0 +1,103 @@
+(*
+    Copyright 2016, 2018, 2022 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE ConsoleLib;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+CONST
+
+    COLOR_BLUE*      = 001H;
+    COLOR_GREEN*     = 002H;
+    COLOR_RED*       = 004H;
+    COLOR_BRIGHT*    = 008H;
+    BGR_BLUE*        = 010H;
+    BGR_GREEN*       = 020H;
+    BGR_RED*         = 040H;
+    BGR_BRIGHT*      = 080H;
+    IGNORE_SPECIALS* = 100H;
+    WINDOW_CLOSED*   = 200H;
+
+TYPE
+
+    gets2_callback* = PROCEDURE [stdcall] (keycode: INTEGER; pstr: INTEGER; VAR n, pos: INTEGER);
+
+VAR
+
+    version*           : INTEGER;
+    init*              : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
+    exit*              : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
+    write_asciiz*      : PROCEDURE [stdcall] (string: INTEGER);
+    write_string*      : PROCEDURE [stdcall] (string, length: INTEGER);
+    get_flags*         : PROCEDURE [stdcall] (): INTEGER;
+    set_flags*         : PROCEDURE [stdcall] (new_flags: INTEGER): INTEGER;
+    get_font_height*   : PROCEDURE [stdcall] (): INTEGER;
+    get_cursor_height* : PROCEDURE [stdcall] (): INTEGER;
+    set_cursor_height* : PROCEDURE [stdcall] (new_height: INTEGER): INTEGER;
+    getch*             : PROCEDURE [stdcall] (): INTEGER;
+    getch2*            : PROCEDURE [stdcall] (): INTEGER;
+    kbhit*             : PROCEDURE [stdcall] (): INTEGER;
+    gets*              : PROCEDURE [stdcall] (str, n: INTEGER): INTEGER;
+    gets2*             : PROCEDURE [stdcall] (callback: gets2_callback; str, n: INTEGER): INTEGER;
+    cls*               : PROCEDURE [stdcall] ();
+    get_cursor_pos*    : PROCEDURE [stdcall] (VAR x, y: INTEGER);
+    set_cursor_pos*    : PROCEDURE [stdcall] (x, y: INTEGER);
+    set_title*         : PROCEDURE [stdcall] (title: INTEGER);
+
+PROCEDURE open*(wnd_width, wnd_height, scr_width, scr_height: INTEGER; title: ARRAY OF CHAR);
+BEGIN
+  init(wnd_width, wnd_height, scr_width, scr_height, sys.ADR(title[0]))
+END open;
+
+PROCEDURE main;
+VAR Lib: INTEGER;
+
+  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
+  VAR a: INTEGER;
+  BEGIN
+    a := KOSAPI.GetProcAdr(name, Lib);
+    ASSERT(a # 0);
+    sys.PUT(v, a)
+  END GetProc;
+
+BEGIN
+  Lib := KOSAPI.LoadLib("/sys/lib/Console.obj");
+  ASSERT(Lib # 0);
+  GetProc(Lib, sys.ADR(version),           "version");
+  GetProc(Lib, sys.ADR(init),              "con_init");
+  GetProc(Lib, sys.ADR(exit),              "con_exit");
+  GetProc(Lib, sys.ADR(write_asciiz),      "con_write_asciiz");
+  GetProc(Lib, sys.ADR(write_string),      "con_write_string");
+  GetProc(Lib, sys.ADR(get_flags),         "con_get_flags");
+  GetProc(Lib, sys.ADR(set_flags),         "con_set_flags");
+  GetProc(Lib, sys.ADR(get_font_height),   "con_get_font_height");
+  GetProc(Lib, sys.ADR(get_cursor_height), "con_get_cursor_height");
+  GetProc(Lib, sys.ADR(set_cursor_height), "con_set_cursor_height");
+  GetProc(Lib, sys.ADR(getch),             "con_getch");
+  GetProc(Lib, sys.ADR(getch2),            "con_getch2");
+  GetProc(Lib, sys.ADR(kbhit),             "con_kbhit");
+  GetProc(Lib, sys.ADR(gets),              "con_gets");
+  GetProc(Lib, sys.ADR(gets2),             "con_gets2");
+  GetProc(Lib, sys.ADR(cls),               "con_cls");
+  GetProc(Lib, sys.ADR(get_cursor_pos),    "con_get_cursor_pos");
+  GetProc(Lib, sys.ADR(set_cursor_pos),    "con_set_cursor_pos");
+  GetProc(Lib, sys.ADR(set_title),         "con_set_title");
+END main;
+
+BEGIN
+  main
+END ConsoleLib.

+ 141 - 0
lib/KolibriOS/DateTime.ob07

@@ -0,0 +1,141 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE DateTime;
+
+IMPORT KOSAPI;
+
+CONST ERR* = -7.0E5;
+
+PROCEDURE Encode*(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL;
+VAR d, i: INTEGER; M: ARRAY 14 OF CHAR; Res: REAL;
+BEGIN
+  Res := ERR;
+  IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
+    (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
+    (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) THEN
+    M := "_303232332323";
+    IF (Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0) THEN
+      M[2] := "1"
+    END;
+    IF Day <= ORD(M[Month]) - ORD("0") + 28 THEN
+      DEC(Year);
+      d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + Day - 693594;
+      FOR i := 1 TO Month - 1 DO
+        d := d + ORD(M[i]) - ORD("0") + 28
+      END;
+      Res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000) / 86400000.0
+    END
+  END
+  RETURN Res
+END Encode;
+
+PROCEDURE Decode*(Date: REAL; VAR Year, Month, Day, Hour, Min, Sec: INTEGER): BOOLEAN;
+VAR Res, flag: BOOLEAN; d, t, i: INTEGER; M: ARRAY 14 OF CHAR;
+
+  PROCEDURE MonthDay(n: INTEGER; VAR d, Month: INTEGER; M: ARRAY OF CHAR): BOOLEAN;
+  VAR Res: BOOLEAN;
+  BEGIN
+    Res := FALSE;
+    IF d > ORD(M[n]) - ORD("0") + 28 THEN
+      d := d - ORD(M[n]) + ORD("0") - 28;
+      INC(Month);
+      Res := TRUE
+    END
+    RETURN Res
+  END MonthDay;
+
+BEGIN
+  IF (Date >= -693593.0) & (Date < 2958466.0) THEN
+    d := FLOOR(Date);
+    t := FLOOR((Date - FLT(d)) * 86400000.0);
+    d := d + 693593;
+    Year := 1;
+    Month := 1;
+    WHILE d > 0 DO
+      d := d - 365 - ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
+      INC(Year)
+    END;
+    IF d < 0 THEN
+      DEC(Year);
+      d := d + 365 + ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0))
+    END;
+    INC(d);
+    M := "_303232332323";
+    IF (Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0) THEN
+      M[2] := "1"
+    END;
+    i := 1;
+    flag := TRUE;
+    WHILE flag & (i <= 12) DO
+      flag := MonthDay(i, d, Month, M);
+      INC(i)
+    END;
+    Day := d;
+    Hour := t DIV 3600000;
+    t := t MOD 3600000;
+    Min := t DIV 60000;
+    t := t MOD 60000;
+    Sec := t DIV 1000;
+    Res := TRUE
+  ELSE
+    Res := FALSE
+  END
+  RETURN Res
+END Decode;
+
+PROCEDURE Now*(VAR Year, Month, Day, Hour, Min, Sec, Msec: INTEGER);
+VAR date, time: INTEGER;
+BEGIN
+  date  := KOSAPI.sysfunc1(29);
+  time  := KOSAPI.sysfunc1(3);
+
+  Year  := date MOD 16;
+  date  := date DIV 16;
+  Year  := (date MOD 16) * 10 + Year;
+  date  := date DIV 16;
+
+  Month := date MOD 16;
+  date  := date DIV 16;
+  Month := (date MOD 16) * 10 + Month;
+  date  := date DIV 16;
+
+  Day := date MOD 16;
+  date  := date DIV 16;
+  Day := (date MOD 16) * 10 + Day;
+  date  := date DIV 16;
+
+  Hour  := time MOD 16;
+  time  := time DIV 16;
+  Hour  := (time MOD 16) * 10 + Hour;
+  time  := time DIV 16;
+
+  Min := time MOD 16;
+  time  := time DIV 16;
+  Min := (time MOD 16) * 10 + Min;
+  time  := time DIV 16;
+
+  Sec := time MOD 16;
+  time  := time DIV 16;
+  Sec := (time MOD 16) * 10 + Sec;
+  time  := time DIV 16;
+
+  Year := Year + 2000;
+  Msec := 0
+END Now;
+
+END DateTime.

+ 292 - 0
lib/KolibriOS/Debug.ob07

@@ -0,0 +1,292 @@
+(*
+    Copyright 2016, 2018, 2022 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Debug;
+
+IMPORT KOSAPI, sys := SYSTEM;
+
+CONST
+
+  d = 1.0 - 5.0E-12;
+
+VAR
+
+  Realp: PROCEDURE (x: REAL; width: INTEGER);
+
+PROCEDURE Char*(c: CHAR);
+VAR res: INTEGER;
+BEGIN
+  res := KOSAPI.sysfunc3(63, 1, ORD(c))
+END Char;
+
+PROCEDURE String*(s: ARRAY OF CHAR);
+VAR n, i: INTEGER;
+BEGIN
+  n := LENGTH(s);
+  FOR i := 0 TO n - 1 DO
+    Char(s[i])
+  END
+END String;
+
+PROCEDURE WriteInt(x, n: INTEGER);
+VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
+BEGIN
+  i := 0;
+  IF n < 1 THEN
+    n := 1
+  END;
+  IF x < 0 THEN
+    x := -x;
+    DEC(n);
+    neg := TRUE
+  END;
+  REPEAT
+    a[i] := CHR(x MOD 10 + ORD("0"));
+    x := x DIV 10;
+    INC(i)
+  UNTIL x = 0;
+  WHILE n > i DO
+    Char(" ");
+    DEC(n)
+  END;
+  IF neg THEN
+    Char("-")
+  END;
+  REPEAT
+    DEC(i);
+    Char(a[i])
+  UNTIL i = 0
+END WriteInt;
+
+PROCEDURE IsNan(AValue: REAL): BOOLEAN;
+VAR h, l: SET;
+BEGIN
+  sys.GET(sys.ADR(AValue), l);
+  sys.GET(sys.ADR(AValue) + 4, h)
+  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+PROCEDURE IsInf(x: REAL): BOOLEAN;
+  RETURN ABS(x) = sys.INF()
+END IsInf;
+
+PROCEDURE Int*(x, width: INTEGER);
+VAR i: INTEGER;
+BEGIN
+  IF x # 80000000H THEN
+    WriteInt(x, width)
+  ELSE
+    FOR i := 12 TO width DO
+      Char(20X)
+    END;
+    String("-2147483648")
+  END
+END Int;
+
+PROCEDURE OutInf(x: REAL; width: INTEGER);
+VAR s: ARRAY 5 OF CHAR; i: INTEGER;
+BEGIN
+  IF IsNan(x) THEN
+    s := "Nan";
+    INC(width)
+  ELSIF IsInf(x) & (x > 0.0) THEN
+    s := "+Inf"
+  ELSIF IsInf(x) & (x < 0.0) THEN
+    s := "-Inf"
+  END;
+  FOR i := 1 TO width - 4 DO
+    Char(" ")
+  END;
+  String(s)
+END OutInf;
+
+PROCEDURE Ln*;
+BEGIN
+  Char(0DX);
+  Char(0AX)
+END Ln;
+
+PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
+VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSIF p < 0 THEN
+    Realp(x, width)
+  ELSE
+    len := 0;
+    minus := FALSE;
+    IF x < 0.0 THEN
+      minus := TRUE;
+      INC(len);
+      x := ABS(x)
+    END;
+    e := 0;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    IF e >= 0 THEN
+      len := len + e + p + 1;
+      IF x > 9.0 + d THEN
+        INC(len)
+      END;
+      IF p > 0 THEN
+        INC(len)
+      END
+    ELSE
+      len := len + p + 2
+    END;
+    FOR i := 1 TO width - len DO
+      Char(" ")
+    END;
+    IF minus THEN
+      Char("-")
+    END;
+    y := x;
+    WHILE (y < 1.0) & (y # 0.0) DO
+      y := y * 10.0;
+      DEC(e)
+    END;
+    IF e < 0 THEN
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char("1");
+        x := 0.0
+      ELSE
+        Char("0");
+        x := x * 10.0
+      END
+    ELSE
+      WHILE e >= 0 DO
+        IF x - FLT(FLOOR(x)) > d THEN
+          IF x > 9.0 THEN
+            String("10")
+          ELSE
+            Char(CHR(FLOOR(x) + ORD("0") + 1))
+          END;
+          x := 0.0
+        ELSE
+          Char(CHR(FLOOR(x) + ORD("0")));
+          x := (x - FLT(FLOOR(x))) * 10.0
+        END;
+        DEC(e)
+      END
+    END;
+    IF p > 0 THEN
+      Char(".")
+    END;
+    WHILE p > 0 DO
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char(CHR(FLOOR(x) + ORD("0") + 1));
+        x := 0.0
+      ELSE
+        Char(CHR(FLOOR(x) + ORD("0")));
+        x := (x - FLT(FLOOR(x))) * 10.0
+      END;
+      DEC(p)
+    END
+  END
+END _FixReal;
+
+PROCEDURE Real*(x: REAL; width: INTEGER);
+VAR e, n, i: INTEGER; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSE
+    e := 0;
+    n := 0;
+    IF width > 23 THEN
+      n := width - 23;
+      width := 23
+    ELSIF width < 9 THEN
+      width := 9
+    END;
+    width := width - 5;
+    IF x < 0.0 THEN
+      x := -x;
+      minus := TRUE
+    ELSE
+      minus := FALSE
+    END;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    WHILE (x < 1.0) & (x # 0.0) DO
+      x := x * 10.0;
+      DEC(e)
+    END;
+    IF x > 9.0 + d THEN
+      x := 1.0;
+      INC(e)
+    END;
+    FOR i := 1 TO n DO
+      Char(" ")
+    END;
+    IF minus THEN
+      x := -x
+    END;
+    Realp := Real;
+    _FixReal(x, width, width - 3);
+    Char("E");
+    IF e >= 0 THEN
+      Char("+")
+    ELSE
+      Char("-");
+      e := ABS(e)
+    END;
+    IF e < 100 THEN
+      Char("0")
+    END;
+    IF e < 10 THEN
+      Char("0")
+    END;
+    Int(e, 0)
+  END
+END Real;
+
+PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
+BEGIN
+  Realp := Real;
+  _FixReal(x, width, p)
+END FixReal;
+
+PROCEDURE Open*;
+TYPE
+
+  info_struct = RECORD
+    subfunc: INTEGER;
+    flags:   INTEGER;
+    param:   INTEGER;
+    rsrvd1:  INTEGER;
+    rsrvd2:  INTEGER;
+    fname:   ARRAY 1024 OF CHAR
+  END;
+
+VAR info: info_struct; res: INTEGER;
+BEGIN
+  info.subfunc := 7;
+  info.flags := 0;
+  info.param := sys.SADR(" ");
+  info.rsrvd1 := 0;
+  info.rsrvd2 := 0;
+  info.fname := "/sys/develop/board";
+  res := KOSAPI.sysfunc2(70, sys.ADR(info))
+END Open;
+
+END Debug.

+ 330 - 0
lib/KolibriOS/File.ob07

@@ -0,0 +1,330 @@
+(*
+    Copyright 2016, 2018, 2021 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE File;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+
+CONST
+
+    SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2;
+
+
+TYPE
+
+    FNAME* = ARRAY 520 OF CHAR;
+
+    FS* = POINTER TO rFS;
+
+    rFS* = RECORD
+        subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER;
+        name*: FNAME
+    END;
+
+    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;
+
+
+PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER;
+BEGIN
+    sys.CODE(
+    053H,               (*  push    ebx                    *)
+    06AH, 044H,         (*  push    68                     *)
+    058H,               (*  pop     eax                    *)
+    06AH, 01BH,         (*  push    27                     *)
+    05BH,               (*  pop     ebx                    *)
+    08BH, 04DH, 008H,   (*  mov     ecx, dword [ebp +  8]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    08BH, 04DH, 00CH,   (*  mov     ecx, dword [ebp + 12]  *)
+    089H, 011H,         (*  mov     dword [ecx], edx       *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 008H, 000H    (*  ret     8                      *)
+    )
+    RETURN 0
+END f_68_27;
+
+
+PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER;
+    RETURN f_68_27(sys.ADR(FName[0]), size)
+END Load;
+
+
+PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
+VAR
+    res2: INTEGER; fs: rFS;
+
+BEGIN
+    fs.subfunc := 5;
+    fs.pos     := 0;
+    fs.hpos    := 0;
+    fs.bytes   := 0;
+    fs.buffer  := sys.ADR(Info);
+    COPY(FName, fs.name)
+
+    RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0
+END GetFileInfo;
+
+
+PROCEDURE FileSize* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+    Info: rFD;
+    res: INTEGER;
+BEGIN
+    IF GetFileInfo(FName, Info) THEN
+        res := Info.size
+    ELSE
+        res := -1
+    END
+    RETURN res
+END FileSize;
+
+
+PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    fd: rFD;
+BEGIN
+    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
+END Exists;
+
+
+PROCEDURE Close* (VAR F: FS);
+BEGIN
+    IF F # NIL THEN
+        DISPOSE(F)
+    END
+END Close;
+
+
+PROCEDURE Open* (FName: ARRAY OF CHAR): FS;
+VAR
+    F: FS;
+
+BEGIN
+
+    IF Exists(FName) THEN
+        NEW(F);
+        IF F # NIL THEN
+            F.subfunc := 0;
+            F.pos     := 0;
+            F.hpos    := 0;
+            F.bytes   := 0;
+            F.buffer  := 0;
+            COPY(FName, F.name)
+        END
+    ELSE
+        F := NIL
+    END
+
+    RETURN F
+END Open;
+
+
+PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    F: FS;
+    res, res2: INTEGER;
+
+BEGIN
+
+    IF Exists(FName) THEN
+        NEW(F);
+        IF F # NIL THEN
+            F.subfunc := 8;
+            F.pos     := 0;
+            F.hpos    := 0;
+            F.bytes   := 0;
+            F.buffer  := 0;
+            COPY(FName, F.name);
+            res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
+            DISPOSE(F)
+        ELSE
+            res := -1
+        END
+    ELSE
+        res := -1
+    END
+
+    RETURN res = 0
+END Delete;
+
+
+PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+    fd: rFD;
+
+BEGIN
+
+    IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN
+        CASE Origin OF
+        |SEEK_BEG: F.pos := Offset
+        |SEEK_CUR: F.pos := F.pos + Offset
+        |SEEK_END: F.pos := fd.size + Offset
+        ELSE
+        END;
+        res := F.pos
+    ELSE
+        res := -1
+    END
+
+    RETURN res
+END Seek;
+
+
+PROCEDURE Read* (F: FS; Buffer, Count: INTEGER): INTEGER;
+VAR
+    res, res2: INTEGER;
+
+BEGIN
+
+    IF F # NIL THEN
+        F.subfunc := 0;
+        F.bytes   := Count;
+        F.buffer  := Buffer;
+        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
+        IF res2 > 0 THEN
+            F.pos := F.pos + res2
+        END
+    ELSE
+        res2 := 0
+    END
+
+    RETURN res2
+END Read;
+
+
+PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER;
+VAR
+    res, res2: INTEGER;
+
+BEGIN
+
+    IF F # NIL THEN
+        F.subfunc := 3;
+        F.bytes   := Count;
+        F.buffer  := Buffer;
+        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
+        IF res2 > 0 THEN
+            F.pos := F.pos + res2
+        END
+    ELSE
+        res2 := 0
+    END
+
+    RETURN res2
+END Write;
+
+
+PROCEDURE Create* (FName: ARRAY OF CHAR): FS;
+VAR
+    F: FS;
+    res2: INTEGER;
+
+BEGIN
+    NEW(F);
+
+    IF F # NIL THEN
+        F.subfunc := 2;
+        F.pos     := 0;
+        F.hpos    := 0;
+        F.bytes   := 0;
+        F.buffer  := 0;
+        COPY(FName, F.name);
+        IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN
+            DISPOSE(F)
+        END
+    END
+
+    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;
+
+
+PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    F: FS;
+    res, res2: INTEGER;
+
+BEGIN
+    NEW(F);
+
+    IF F # NIL THEN
+        F.subfunc := 9;
+        F.pos     := 0;
+        F.hpos    := 0;
+        F.bytes   := 0;
+        F.buffer  := 0;
+        COPY(DirName, F.name);
+        res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
+        DISPOSE(F)
+    ELSE
+        res := -1
+    END
+
+    RETURN res = 0
+END CreateDir;
+
+
+PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    F: FS;
+    res, res2: INTEGER;
+
+BEGIN
+
+    IF DirExists(DirName) THEN
+        NEW(F);
+        IF F # NIL THEN
+            F.subfunc := 8;
+            F.pos := 0;
+            F.hpos := 0;
+            F.bytes := 0;
+            F.buffer := 0;
+            COPY(DirName, F.name);
+            res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2);
+            DISPOSE(F)
+        ELSE
+            res := -1
+        END
+    ELSE
+        res := -1
+    END
+
+    RETURN res = 0
+END DeleteDir;
+
+
+END File.

+ 553 - 0
lib/KolibriOS/HOST.ob07

@@ -0,0 +1,553 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, K := KOSAPI, API;
+
+
+CONST
+
+    slash* = "/";
+    eol* = 0DX + 0AX;
+
+    bit_depth* = API.BIT_DEPTH;
+    maxint* = ROR(-2, 1);
+    minint* = ROR(1, 1);
+
+    MAX_PARAM = 1024;
+
+
+TYPE
+
+    DAYS = ARRAY 12, 31, 2 OF INTEGER;
+
+    FNAME = ARRAY 520 OF CHAR;
+
+    FS = POINTER TO rFS;
+
+    rFS = RECORD
+        subfunc, pos, hpos, bytes, buffer: INTEGER;
+        name: FNAME
+    END;
+
+    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;
+
+
+VAR
+
+
+    Console: BOOLEAN;
+
+    days: DAYS;
+
+    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
+    argc*: INTEGER;
+
+    maxreal*, inf*: REAL;
+
+
+PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
+
+PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN);
+
+PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER);
+
+
+PROCEDURE ExitProcess* (p1: INTEGER);
+BEGIN
+    IF Console THEN
+        con_exit(FALSE)
+    END;
+    K.sysfunc1(-1)
+END ExitProcess;
+
+
+PROCEDURE OutChar* (c: CHAR);
+BEGIN
+    IF Console THEN
+        con_write_string(SYSTEM.ADR(c), 1)
+    ELSE
+        K.sysfunc3(63, 1, ORD(c))
+    END
+END OutChar;
+
+
+PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
+VAR
+    res2: INTEGER;
+    fs:   rFS;
+
+BEGIN
+    fs.subfunc := 5;
+    fs.pos := 0;
+    fs.hpos := 0;
+    fs.bytes := 0;
+    fs.buffer := SYSTEM.ADR(Info);
+    COPY(FName, fs.name)
+    RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0
+END GetFileInfo;
+
+
+PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    fd: rFD;
+
+BEGIN
+    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
+END Exists;
+
+
+PROCEDURE Close (VAR F: FS);
+BEGIN
+    IF F # NIL THEN
+        DISPOSE(F)
+    END
+END Close;
+
+
+PROCEDURE Open (FName: ARRAY OF CHAR): FS;
+VAR
+    F: FS;
+
+BEGIN
+    IF Exists(FName) THEN
+        NEW(F);
+        IF F # NIL THEN
+            F.subfunc := 0;
+            F.pos := 0;
+            F.hpos := 0;
+            F.bytes := 0;
+            F.buffer := 0;
+            COPY(FName, F.name)
+        END
+    ELSE
+        F := NIL
+    END
+
+    RETURN F
+END Open;
+
+
+PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER;
+VAR
+    res, res2: INTEGER;
+
+BEGIN
+    IF F # NIL THEN
+        F.subfunc := 0;
+        F.bytes := Count;
+        F.buffer := Buffer;
+        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
+        IF res2 > 0 THEN
+            F.pos := F.pos + res2
+        END
+    ELSE
+        res2 := 0
+    END
+
+    RETURN res2
+END Read;
+
+
+PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER;
+VAR
+    res, res2: INTEGER;
+
+BEGIN
+    IF F # NIL THEN
+        F.subfunc := 3;
+        F.bytes := Count;
+        F.buffer := Buffer;
+        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
+        IF res2 > 0 THEN
+            F.pos := F.pos + res2
+        END
+    ELSE
+        res2 := 0
+    END
+
+    RETURN res2
+END Write;
+
+
+PROCEDURE Create (FName: ARRAY OF CHAR): FS;
+VAR
+    F:    FS;
+    res2: INTEGER;
+
+BEGIN
+    NEW(F);
+    IF F # NIL THEN
+        F.subfunc := 2;
+        F.pos := 0;
+        F.hpos := 0;
+        F.bytes := 0;
+        F.buffer := 0;
+        COPY(FName, F.name);
+        IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN
+            DISPOSE(F)
+        END
+    END
+
+    RETURN F
+END Create;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+VAR
+    n: INTEGER;
+    fs: FS;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(F), fs);
+    n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes);
+    IF n = 0 THEN
+        n := -1
+    END
+
+    RETURN n
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+VAR
+    n: INTEGER;
+    fs: FS;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(F), fs);
+    n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes);
+    IF n = 0 THEN
+        n := -1
+    END
+
+    RETURN n
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+    fs: FS;
+    res: INTEGER;
+
+BEGIN
+    fs := Create(FName);
+    SYSTEM.GET(SYSTEM.ADR(fs), res)
+    RETURN res
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+VAR
+    fs: FS;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(F), fs);
+    Close(fs)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+    fs: FS;
+    res: INTEGER;
+
+BEGIN
+    fs := Open(FName);
+    SYSTEM.GET(SYSTEM.ADR(fs), res)
+    RETURN res
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+END chmod;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+    RETURN K.sysfunc2(26, 9)
+END GetTickCount;
+
+
+PROCEDURE AppAdr (): INTEGER;
+VAR
+    buf: ARRAY 1024 OF CHAR;
+    a: INTEGER;
+
+BEGIN
+    a := K.sysfunc3(9, SYSTEM.ADR(buf), -1);
+    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
+    RETURN a
+END AppAdr;
+
+
+PROCEDURE GetCommandLine (): INTEGER;
+VAR
+    param: INTEGER;
+
+BEGIN
+    SYSTEM.GET(28 + AppAdr(), param)
+    RETURN param
+END GetCommandLine;
+
+
+PROCEDURE GetName (): INTEGER;
+VAR
+    name: INTEGER;
+
+BEGIN
+    SYSTEM.GET(32 + AppAdr(), name)
+    RETURN name
+END GetName;
+
+
+PROCEDURE GetChar (adr: INTEGER): CHAR;
+VAR
+    res: CHAR;
+
+BEGIN
+    SYSTEM.GET(adr, res)
+    RETURN res
+END GetChar;
+
+
+PROCEDURE ParamParse;
+VAR
+    p, count, name, cond: INTEGER;
+    c: CHAR;
+
+
+    PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
+    BEGIN
+        IF (c <= 20X) & (c # 0X) THEN
+            cond := A
+        ELSIF c = 22X THEN
+            cond := B
+        ELSIF c = 0X THEN
+            cond := 6
+        ELSE
+            cond := C
+        END
+    END ChangeCond;
+
+
+BEGIN
+    p := GetCommandLine();
+    name := GetName();
+    Params[0, 0] := name;
+    WHILE GetChar(name) # 0X DO
+        INC(name)
+    END;
+    Params[0, 1] := name - 1;
+    cond := 0;
+    count := 1;
+    WHILE (argc < MAX_PARAM) & (cond # 6) DO
+        c := GetChar(p);
+        CASE cond OF
+        |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
+        |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
+        |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
+        |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |6:
+        END;
+        INC(p)
+    END;
+    argc := count
+END ParamParse;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    i, j, len: INTEGER;
+    c: CHAR;
+
+BEGIN
+    j := 0;
+    IF n < argc THEN
+        len := LEN(s) - 1;
+        i := Params[n, 0];
+        WHILE (j < len) & (i <= Params[n, 1]) DO
+            c := GetChar(i);
+            IF c # 22X THEN
+                s[j] := c;
+                INC(j)
+            END;
+            INC(i)
+        END
+    END;
+    s[j] := 0X
+END GetArg;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+    n: INTEGER;
+
+BEGIN
+    n := K.sysfunc4(30, 2, SYSTEM.ADR(path[0]), LEN(path) - 2);
+    path[n - 1] := slash;
+    path[n] := 0X
+END GetCurrentDirectory;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+    RETURN path[0] # slash
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+VAR
+    date, time, year, month, day, hour, min, sec: INTEGER;
+
+BEGIN
+    date  := K.sysfunc1(29);
+    time  := K.sysfunc1(3);
+
+    year  := date MOD 16;
+    date  := date DIV 16;
+    year  := (date MOD 16) * 10 + year;
+    date  := date DIV 16;
+
+    month := date MOD 16;
+    date  := date DIV 16;
+    month := (date MOD 16) * 10 + month;
+    date  := date DIV 16;
+
+    day   := date MOD 16;
+    date  := date DIV 16;
+    day   := (date MOD 16) * 10 + day;
+    date  := date DIV 16;
+
+    hour  := time MOD 16;
+    time  := time DIV 16;
+    hour  := (time MOD 16) * 10 + hour;
+    time  := time DIV 16;
+
+    min   := time MOD 16;
+    time  := time DIV 16;
+    min   := (time MOD 16) * 10 + min;
+    time  := time DIV 16;
+
+    sec   := time MOD 16;
+    time  := time DIV 16;
+    sec   := (time MOD 16) * 10 + sec;
+    time  := time DIV 16;
+
+    INC(year, 2000)
+
+    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 UnixTime;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET32(SYSTEM.ADR(x), a);
+    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
+    RETURN a
+END splitf;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+    h, l, s, e: INTEGER;
+
+BEGIN
+    e := splitf(x, l, h);
+
+    s := ASR(h, 31) MOD 2;
+    e := (h DIV 100000H) MOD 2048;
+    IF e <= 896 THEN
+        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
+        REPEAT
+            h := h DIV 2;
+            INC(e)
+        UNTIL e = 897;
+        e := 896;
+        l := (h MOD 8) * 20000000H;
+        h := h DIV 8
+    ELSIF (1151 <= e) & (e < 2047) THEN
+        e := 1151;
+        h := 0;
+        l := 0
+    ELSIF e = 2047 THEN
+        e := 1151;
+        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
+            h := 80000H;
+            l := 0
+        END
+    END;
+    DEC(e, 896)
+
+    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
+END d2s;
+
+
+PROCEDURE init (VAR days: DAYS);
+VAR
+    i, j, n0, n1: INTEGER;
+
+BEGIN
+
+    FOR i := 0 TO 11 DO
+        FOR j := 0 TO 30 DO
+            days[i, j, 0] := 0;
+            days[i, j, 1] := 0;
+        END
+    END;
+
+    days[ 1, 28, 0] := -1;
+
+    FOR i := 0 TO 1 DO
+        days[ 1, 29, i] := -1;
+        days[ 1, 30, i] := -1;
+        days[ 3, 30, i] := -1;
+        days[ 5, 30, i] := -1;
+        days[ 8, 30, i] := -1;
+        days[10, 30, i] := -1;
+    END;
+
+    n0 := 0;
+    n1 := 0;
+    FOR i := 0 TO 11 DO
+        FOR j := 0 TO 30 DO
+            IF days[i, j, 0] = 0 THEN
+                days[i, j, 0] := n0;
+                INC(n0)
+            END;
+            IF days[i, j, 1] = 0 THEN
+                days[i, j, 1] := n1;
+                INC(n1)
+            END
+        END
+    END;
+
+    inf := SYSTEM.INF();
+    maxreal := 1.9;
+    PACK(maxreal, 1023);
+    Console := TRUE;
+    IF Console THEN
+        con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
+    END;
+    ParamParse
+END init;
+
+
+BEGIN
+    init(days)
+END HOST.

+ 282 - 0
lib/KolibriOS/In.ob07

@@ -0,0 +1,282 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE In;
+
+IMPORT sys := SYSTEM, ConsoleLib;
+
+TYPE
+
+  STRING = ARRAY 260 OF CHAR;
+
+VAR
+
+  Done* : BOOLEAN;
+
+PROCEDURE digit(ch: CHAR): BOOLEAN;
+  RETURN (ch >= "0") & (ch <= "9")
+END digit;
+
+PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN;
+VAR i: INTEGER;
+BEGIN
+  i := 0;
+  neg := FALSE;
+  WHILE (s[i] <= 20X) & (s[i] # 0X) DO
+    INC(i)
+  END;
+  IF s[i] = "-" THEN
+    neg := TRUE;
+    INC(i)
+  ELSIF s[i] = "+" THEN
+    INC(i)
+  END;
+  first := i;
+  WHILE digit(s[i]) DO
+    INC(i)
+  END;
+  last := i
+  RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first])
+END CheckInt;
+
+PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN;
+VAR i: INTEGER; min: STRING;
+BEGIN
+  i := 0;
+  min := "2147483648";
+  WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO
+    INC(i)
+  END
+  RETURN i = 10
+END IsMinInt;
+
+PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER;
+CONST maxINT = 7FFFFFFFH;
+VAR i, n, res: INTEGER; flag, neg: BOOLEAN;
+BEGIN
+  res := 0;
+  flag := CheckInt(str, i, n, neg, FALSE);
+  err := ~flag;
+  IF flag & neg & IsMinInt(str, i) THEN
+    flag := FALSE;
+    neg := FALSE;
+    res := 80000000H
+  END;
+  WHILE flag & digit(str[i]) DO
+    IF res > maxINT DIV 10 THEN
+      err := TRUE;
+      flag := FALSE;
+      res := 0
+    ELSE
+      res := res * 10;
+      IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN
+        err := TRUE;
+        flag := FALSE;
+        res := 0
+      ELSE
+        res := res + (ORD(str[i]) - ORD("0"));
+        INC(i)
+      END
+    END
+  END;
+  IF neg THEN
+    res := -res
+  END
+  RETURN res
+END StrToInt;
+
+PROCEDURE Space(s: STRING): BOOLEAN;
+VAR i: INTEGER;
+BEGIN
+  i := 0;
+  WHILE (s[i] # 0X) & (s[i] <= 20X) DO
+    INC(i)
+  END
+  RETURN s[i] = 0X
+END Space;
+
+PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN;
+VAR i: INTEGER; Res: BOOLEAN;
+BEGIN
+  Res := CheckInt(s, n, i, neg, TRUE);
+  IF Res THEN
+    IF s[i] = "." THEN
+      INC(i);
+      WHILE digit(s[i]) DO
+        INC(i)
+      END;
+      IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN
+        INC(i);
+        IF (s[i] = "+") OR (s[i] = "-") THEN
+          INC(i)
+        END;
+        Res := digit(s[i]);
+        WHILE digit(s[i]) DO
+          INC(i)
+        END
+      END
+    END
+  END
+  RETURN Res & (s[i] <= 20X)
+END CheckReal;
+
+PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL;
+CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH;
+VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN;
+
+  PROCEDURE part1 (str: STRING; VAR res, d: REAL; VAR i: INTEGER): BOOLEAN;
+  BEGIN
+    res := 0.0;
+    d := 1.0;
+    WHILE digit(str[i]) DO
+      res := res * 10.0 + FLT(ORD(str[i]) - ORD("0"));
+      INC(i)
+    END;
+    IF str[i] = "." THEN
+      INC(i);
+      WHILE digit(str[i]) DO
+        d := d / 10.0;
+        res := res + FLT(ORD(str[i]) - ORD("0")) * d;
+        INC(i)
+      END
+    END
+    RETURN str[i] # 0X
+  END part1;
+
+  PROCEDURE part2 (str: STRING; VAR i, scale: INTEGER; VAR minus, err: BOOLEAN; VAR m, res: REAL): BOOLEAN;
+  BEGIN
+    INC(i);
+    m := 10.0;
+    minus := FALSE;
+    IF str[i] = "+" THEN
+      INC(i)
+    ELSIF str[i] = "-" THEN
+      minus := TRUE;
+      INC(i);
+      m := 0.1
+    END;
+    scale := 0;
+    err := FALSE;
+    WHILE ~err & digit(str[i]) DO
+      IF scale > maxINT DIV 10 THEN
+        err := TRUE;
+        res := 0.0
+      ELSE
+        scale := scale * 10;
+        IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN
+          err := TRUE;
+          res := 0.0
+        ELSE
+          scale := scale + (ORD(str[i]) - ORD("0"));
+          INC(i)
+        END
+      END
+    END
+    RETURN ~err
+  END part2;
+
+  PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR res, m: REAL; VAR scale: INTEGER);
+  VAR i: INTEGER;
+  BEGIN
+    err := FALSE;
+    IF scale = maxINT THEN
+      err := TRUE;
+      res := 0.0
+    END;
+    i := 1;
+    WHILE ~err & (i <= scale) DO
+      IF ~minus & (res > maxDBL / m) THEN
+        err := TRUE;
+        res := 0.0
+      ELSE
+        res := res * m;
+        INC(i)
+      END
+    END
+  END part3;
+
+BEGIN
+  IF CheckReal(str, i, neg) THEN
+    IF part1(str, res, d, i) & part2(str, i, scale, minus, err, m, res) THEN
+      part3(err, minus, res, m, scale)
+    END;
+    IF neg THEN
+      res := -res
+    END
+  ELSE
+    res := 0.0;
+    err := TRUE
+  END
+  RETURN res
+END StrToFloat;
+
+PROCEDURE String*(VAR s: ARRAY OF CHAR);
+VAR res, length: INTEGER; str: STRING;
+BEGIN
+  res := ConsoleLib.gets(sys.ADR(str[0]), LEN(str));
+  length := LENGTH(str);
+  IF length > 0 THEN
+    str[length - 1] := 0X
+  END;
+  COPY(str, s);
+  Done := TRUE
+END String;
+
+PROCEDURE Char*(VAR x: CHAR);
+VAR str: STRING;
+BEGIN
+  String(str);
+  x := str[0];
+  Done := TRUE
+END Char;
+
+PROCEDURE Ln*;
+VAR str: STRING;
+BEGIN
+  String(str);
+  Done := TRUE
+END Ln;
+
+PROCEDURE Real* (VAR x: REAL);
+VAR str: STRING; err: BOOLEAN;
+BEGIN
+  err := FALSE;
+  REPEAT
+    String(str)
+  UNTIL ~Space(str);
+  x := StrToFloat(str, err);
+  Done := ~err
+END Real;
+
+
+PROCEDURE Int*(VAR x: INTEGER);
+VAR str: STRING; err: BOOLEAN;
+BEGIN
+  err := FALSE;
+  REPEAT
+    String(str)
+  UNTIL ~Space(str);
+  x := StrToInt(str, err);
+  Done := ~err
+END Int;
+
+PROCEDURE Open*;
+BEGIN
+  Done := TRUE
+END Open;
+
+END In.

+ 436 - 0
lib/KolibriOS/KOSAPI.ob07

@@ -0,0 +1,436 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2019, 2022 Anton Krotov
+    All rights reserved.
+*)
+
+MODULE KOSAPI;
+
+IMPORT SYSTEM;
+
+
+TYPE
+
+    STRING = ARRAY 1024 OF CHAR;
+
+
+VAR
+
+    DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER);
+
+
+PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp + 8]   *)
+    0CDH, 040H,         (*  int     64                     *)
+    0C9H,               (*  leave                          *)
+    0C2H, 004H, 000H    (*  ret     4                      *)
+    )
+    RETURN 0
+END sysfunc1;
+
+
+PROCEDURE [stdcall-] sysfunc2* (arg1, arg2: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 008H, 000H    (*  ret     8                      *)
+    )
+    RETURN 0
+END sysfunc2;
+
+
+PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 00CH, 000H    (*  ret     12                     *)
+    )
+    RETURN 0
+END sysfunc3;
+
+
+PROCEDURE [stdcall-] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 010H, 000H    (*  ret     16                     *)
+    )
+    RETURN 0
+END sysfunc4;
+
+
+PROCEDURE [stdcall-] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    056H,               (*  push    esi                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05EH,               (*  pop     esi                    *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 014H, 000H    (*  ret     20                     *)
+    )
+    RETURN 0
+END sysfunc5;
+
+
+PROCEDURE [stdcall-] sysfunc6* (arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    056H,               (*  push    esi                    *)
+    057H,               (*  push    edi                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
+    08BH, 07DH, 01CH,   (*  mov     edi, dword [ebp + 28]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05FH,               (*  pop     edi                    *)
+    05EH,               (*  pop     esi                    *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 018H, 000H    (*  ret     24                     *)
+    )
+    RETURN 0
+END sysfunc6;
+
+
+PROCEDURE [stdcall-] sysfunc7* (arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    056H,               (*  push    esi                    *)
+    057H,               (*  push    edi                    *)
+    055H,               (*  push    ebp                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
+    08BH, 07DH, 01CH,   (*  mov     edi, dword [ebp + 28]  *)
+    08BH, 06DH, 020H,   (*  mov     ebp, dword [ebp + 32]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    05DH,               (*  pop     ebp                    *)
+    05FH,               (*  pop     edi                    *)
+    05EH,               (*  pop     esi                    *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 01CH, 000H    (*  ret     28                     *)
+    )
+    RETURN 0
+END sysfunc7;
+
+
+PROCEDURE [stdcall-] sysfunc22* (arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    0CDH, 040H,         (*  int     64                     *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    089H, 019H,         (*  mov     dword [ecx], ebx       *)
+    05BH,               (*  pop     ebx                    *)
+    0C9H,               (*  leave                          *)
+    0C2H, 00CH, 000H    (*  ret     12                     *)
+    )
+    RETURN 0
+END sysfunc22;
+
+
+PROCEDURE mem_commit (adr, size: INTEGER);
+VAR
+    tmp: INTEGER;
+BEGIN
+    FOR tmp := adr TO adr + size - 1 BY 4096 DO
+        SYSTEM.PUT(tmp, 0)
+    END
+END mem_commit;
+
+
+PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER;
+VAR
+    ptr: INTEGER;
+BEGIN
+    SYSTEM.CODE(060H); (* pusha *)
+    IF sysfunc2(18, 16) > ASR(size, 10) THEN
+        ptr := sysfunc3(68, 12, size);
+        IF ptr # 0 THEN
+            mem_commit(ptr, size)
+        END
+    ELSE
+        ptr := 0
+    END;
+    SYSTEM.CODE(061H)  (* popa  *)
+    RETURN ptr
+END malloc;
+
+
+PROCEDURE [stdcall] free* (ptr: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(060H); (* pusha *)
+    IF ptr # 0 THEN
+        ptr := sysfunc3(68, 13, ptr)
+    END;
+    SYSTEM.CODE(061H)  (* popa  *)
+    RETURN 0
+END free;
+
+
+PROCEDURE [stdcall] realloc* (ptr, size: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(060H); (* pusha *)
+    ptr := sysfunc4(68, 20, size, ptr);
+    SYSTEM.CODE(061H)  (* popa  *)
+    RETURN ptr
+END realloc;
+
+
+PROCEDURE AppAdr (): INTEGER;
+VAR
+    buf: ARRAY 1024 OF CHAR;
+    a: INTEGER;
+BEGIN
+    a := sysfunc3(9, SYSTEM.ADR(buf), -1);
+    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
+    RETURN a
+END AppAdr;
+
+
+PROCEDURE GetCommandLine* (): INTEGER;
+VAR
+    param: INTEGER;
+BEGIN
+    SYSTEM.GET(28 + AppAdr(), param)
+    RETURN param
+END GetCommandLine;
+
+
+PROCEDURE GetName* (): INTEGER;
+VAR
+    name: INTEGER;
+BEGIN
+    SYSTEM.GET(32 + AppAdr(), name)
+    RETURN name
+END GetName;
+
+
+PROCEDURE [stdcall] dll_init2 (arg1, arg2, arg3, arg4, arg5: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    060H,               (*  pusha                          *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
+    0FFH, 0D6H,         (*  call    esi                    *)
+    061H,               (*  popa                           *)
+    0C9H,               (*  leave                          *)
+    0C2H, 014H, 000H    (*  ret     20                     *)
+    )
+END dll_init2;
+
+
+PROCEDURE GetProcAdr* (name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
+VAR
+    cur, procname, adr: INTEGER;
+
+    PROCEDURE streq (str1, str2: INTEGER): BOOLEAN;
+    VAR
+        c1, c2: CHAR;
+    BEGIN
+        REPEAT
+            SYSTEM.GET(str1, c1);
+            SYSTEM.GET(str2, c2);
+            INC(str1);
+            INC(str2)
+        UNTIL (c1 # c2) OR (c1 = 0X)
+
+        RETURN c1 = c2
+    END streq;
+
+BEGIN
+    adr := 0;
+    IF (lib # 0) & (name # "") THEN
+        cur := lib;
+        REPEAT
+            SYSTEM.GET(cur, procname);
+            INC(cur, 8)
+        UNTIL (procname = 0) OR streq(procname, SYSTEM.ADR(name[0]));
+        IF procname # 0 THEN
+            SYSTEM.GET(cur - 4, adr)
+        END
+    END
+
+    RETURN adr
+END GetProcAdr;
+
+
+PROCEDURE init (dll: INTEGER);
+VAR
+    lib_init: INTEGER;
+BEGIN
+    lib_init := GetProcAdr("lib_init", dll);
+    IF lib_init # 0 THEN
+        DLL_INIT(lib_init)
+    END;
+    lib_init := GetProcAdr("START", dll);
+    IF lib_init # 0 THEN
+        DLL_INIT(lib_init)
+    END
+END init;
+
+
+PROCEDURE OutChar* (c: CHAR);
+BEGIN
+    sysfunc3(63, 1, ORD(c))
+END OutChar;
+
+
+PROCEDURE OutLn*;
+BEGIN
+    OutChar(0DX);
+    OutChar(0AX)
+END OutLn;
+
+
+PROCEDURE OutString (s: ARRAY OF CHAR);
+VAR
+    i: INTEGER;
+BEGIN
+    i := 0;
+    WHILE (i < LEN(s)) & (s[i] # 0X) DO
+        OutChar(s[i]);
+        INC(i)
+    END
+END OutString;
+
+
+PROCEDURE imp_error (lib, proc: STRING);
+BEGIN
+    OutString("import error: ");
+    IF proc = "" THEN
+        OutString("can't load '")
+    ELSE
+        OutString("not found '"); OutString(proc); OutString("' in '")
+    END;
+    OutString(lib);
+    OutString("'" + 0DX + 0AX)
+END imp_error;
+
+
+PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING);
+VAR
+    c: CHAR;
+BEGIN
+    REPEAT
+        SYSTEM.GET(adr, c); INC(adr);
+        str[i] := c; INC(i)
+    UNTIL c = 0X
+END GetStr;
+
+
+PROCEDURE [stdcall-] dll_Load* (import_table: INTEGER): INTEGER;
+CONST
+	path = "/sys/lib/";
+VAR
+    imp, lib, exp, proc, pathLen: INTEGER;
+    procname, libname: STRING;
+BEGIN
+    SYSTEM.CODE(060H); (* pusha *)
+    libname := path;
+    pathLen := LENGTH(libname);
+
+    SYSTEM.GET(import_table, imp);
+    WHILE imp # 0 DO
+        SYSTEM.GET(import_table + 4, lib);
+        GetStr(lib, pathLen, libname);
+        exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0]));
+        IF exp = 0 THEN
+            imp_error(libname, "")
+        ELSE
+            REPEAT
+                SYSTEM.GET(imp, proc);
+                IF proc # 0 THEN
+                    GetStr(proc, 0, procname);
+                    proc := GetProcAdr(procname, exp);
+                    IF proc # 0 THEN
+                        SYSTEM.PUT(imp, proc)
+                    ELSE
+                    	proc := 1;
+                        imp_error(libname, procname)
+                    END;
+                    INC(imp, 4)
+                END
+            UNTIL proc = 0;
+            init(exp)
+        END;
+        INC(import_table, 8);
+        SYSTEM.GET(import_table, imp);
+    END;
+
+    SYSTEM.CODE(061H) (* popa *)
+    RETURN 0
+END dll_Load;
+
+
+PROCEDURE [stdcall] dll_Init (entry: INTEGER);
+BEGIN
+    SYSTEM.CODE(060H); (* pusha *)
+    IF entry # 0 THEN
+        dll_init2(SYSTEM.ADR(malloc), SYSTEM.ADR(free), SYSTEM.ADR(realloc), SYSTEM.ADR(dll_Load), entry)
+    END;
+    SYSTEM.CODE(061H); (* popa  *)
+END dll_Init;
+
+
+PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER;
+VAR
+    Lib: INTEGER;
+BEGIN
+    DLL_INIT := dll_Init;
+    Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0]));
+    IF Lib # 0 THEN
+        init(Lib)
+    END
+    RETURN Lib
+END LoadLib;
+
+
+PROCEDURE _init* (import_table: INTEGER);
+BEGIN
+    DLL_INIT := dll_Init;
+    dll_Load(import_table)
+END _init;
+
+
+END KOSAPI.

+ 449 - 0
lib/KolibriOS/Math.ob07

@@ -0,0 +1,449 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2013-2014, 2018-2022 Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Math;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    pi* = 3.141592653589793;
+    e*  = 2.718281828459045;
+
+
+PROCEDURE IsNan* (x: REAL): BOOLEAN;
+VAR
+    h, l: SET;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), l);
+    SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
+    RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+
+PROCEDURE IsInf* (x: REAL): BOOLEAN;
+    RETURN ABS(x) = SYSTEM.INF()
+END IsInf;
+
+
+PROCEDURE Max (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a > b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Max;
+
+
+PROCEDURE Min (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a < b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Min;
+
+
+PROCEDURE SameValue (a, b: REAL): BOOLEAN;
+VAR
+    eps: REAL;
+    res: BOOLEAN;
+
+BEGIN
+    eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
+    IF a > b THEN
+        res := (a - b) <= eps
+    ELSE
+        res := (b - a) <= eps
+    END
+    RETURN res
+END SameValue;
+
+
+PROCEDURE IsZero (x: REAL): BOOLEAN;
+    RETURN ABS(x) <= 1.0E-12
+END IsZero;
+
+
+PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FAH,                    (*  fsqrt                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sqrt;
+
+
+PROCEDURE [stdcall] sin* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FEH,                    (*  fsin                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sin;
+
+
+PROCEDURE [stdcall] cos* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FFH,                    (*  fcos                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END cos;
+
+
+PROCEDURE [stdcall] tan* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FBH,                    (*  fsincos                    *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END tan;
+
+
+PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F3H,                    (*  fpatan                     *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END arctan2;
+
+
+PROCEDURE [stdcall] ln* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0EDH,                    (*  fldln2                     *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END ln;
+
+
+PROCEDURE [stdcall] log* (base, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END log;
+
+
+PROCEDURE [stdcall] exp* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0EAH,                 (*  fldl2e                     *)
+    0DEH, 0C9H, 0D9H, 0C0H,
+    0D9H, 0FCH, 0DCH, 0E9H,
+    0D9H, 0C9H, 0D9H, 0F0H,
+    0D9H, 0E8H, 0DEH, 0C1H,
+    0D9H, 0FDH, 0DDH, 0D9H,
+    0C9H,                       (*  leave                      *)
+    0C2H, 008H, 000H            (*  ret     08h                *)
+    )
+    RETURN 0.0
+END exp;
+
+
+PROCEDURE [stdcall] round* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 07DH, 0F4H, 0D9H,
+    07DH, 0F6H, 066H, 081H,
+    04DH, 0F6H, 000H, 003H,
+    0D9H, 06DH, 0F6H, 0D9H,
+    0FCH, 0D9H, 06DH, 0F4H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END round;
+
+
+PROCEDURE [stdcall] frac* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    050H,
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0C0H, 0D9H, 03CH,
+    024H, 0D9H, 07CH, 024H,
+    002H, 066H, 081H, 04CH,
+    024H, 002H, 000H, 00FH,
+    0D9H, 06CH, 024H, 002H,
+    0D9H, 0FCH, 0D9H, 02CH,
+    024H, 0DEH, 0E9H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END frac;
+
+
+PROCEDURE sqri* (x: INTEGER): INTEGER;
+    RETURN x * x
+END sqri;
+
+
+PROCEDURE sqrr* (x: REAL): REAL;
+    RETURN x * x
+END sqrr;
+
+
+PROCEDURE arcsin* (x: REAL): REAL;
+    RETURN arctan2(x, sqrt(1.0 - x * x))
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+    RETURN arctan2(sqrt(1.0 - x * x), x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arctan2(x, 1.0)
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
+    ELSE
+        x := 1.0 - 2.0 / (exp(2.0 * x) + 1.0)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF SameValue(x, 1.0) THEN
+        res := SYSTEM.INF()
+    ELSIF SameValue(x, -1.0) THEN
+        res := -SYSTEM.INF()
+    ELSE
+        res := 0.5 * ln((1.0 + x) / (1.0 - x))
+    END
+    RETURN res
+END artanh;
+
+
+PROCEDURE floor* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f < 0.0 THEN
+        x := x - 1.0
+    END
+    RETURN x
+END floor;
+
+
+PROCEDURE ceil* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f > 0.0 THEN
+        x := x + 1.0
+    END
+    RETURN x
+END ceil;
+
+
+PROCEDURE power* (base, exponent: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF exponent = 0.0 THEN
+        res := 1.0
+    ELSIF (base = 0.0) & (exponent > 0.0) THEN
+        res := 0.0
+    ELSE
+        res := exp(exponent * ln(base))
+    END
+    RETURN res
+END power;
+
+
+PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := 1.0;
+
+    IF base # 0.0 THEN
+        IF exponent # 0 THEN
+            IF exponent < 0 THEN
+                base := 1.0 / base
+            END;
+            i := ABS(exponent);
+            WHILE i > 0 DO
+                WHILE ~ODD(i) DO
+                    i := LSR(i, 1);
+                    base := sqrr(base)
+                END;
+                DEC(i);
+                a := a * base
+            END
+        ELSE
+            a := 1.0
+        END
+    ELSE
+        ASSERT(exponent > 0);
+        a := 0.0
+    END
+
+    RETURN a
+END ipower;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > 0.0 THEN
+        res := 1
+    ELSIF x < 0.0 THEN
+        res := -1
+    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;
+
+
+PROCEDURE DegToRad* (x: REAL): REAL;
+    RETURN x * (pi / 180.0)
+END DegToRad;
+
+
+PROCEDURE RadToDeg* (x: REAL): REAL;
+    RETURN x * (180.0 / pi)
+END RadToDeg;
+
+
+(* Return hypotenuse of triangle *)
+PROCEDURE hypot* (x, y: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    x := ABS(x);
+    y := ABS(y);
+    IF x > y THEN
+        a := x * sqrt(1.0 + sqrr(y / x))
+    ELSE
+        IF x > 0.0 THEN
+            a := y * sqrt(1.0 + sqrr(x / y))
+        ELSE
+            a := y
+        END
+    END
+
+    RETURN a
+END hypot;
+
+
+END Math.

+ 107 - 0
lib/KolibriOS/NetDevices.ob07

@@ -0,0 +1,107 @@
+(*
+    Copyright 2017 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE NetDevices;
+
+IMPORT sys := SYSTEM, K := KOSAPI;
+
+
+CONST
+
+  //net devices types
+
+  LOOPBACK*        = 0;
+  ETH*             = 1;
+  SLIP*            = 2;
+
+  //Link status
+
+  LINK_DOWN*       = 0;
+  LINK_UNKNOWN*    = 1;
+  LINK_FD*         = 2; //full duplex flag
+  LINK_10M*        = 4;
+  LINK_100M*       = 8;
+  LINK_1G*         = 12;
+
+
+TYPE
+
+  DEVICENAME* = ARRAY 64 OF CHAR;
+
+
+PROCEDURE Number* (): INTEGER;
+  RETURN K.sysfunc2(74, -1)
+END Number;
+
+
+PROCEDURE Type* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256)
+END Type;
+
+
+PROCEDURE Name* (num: INTEGER; VAR name: DEVICENAME): BOOLEAN;
+VAR err: BOOLEAN;
+BEGIN
+  err := K.sysfunc3(74, num * 256 + 1, sys.ADR(name[0])) = -1;
+  IF err THEN
+    name := ""
+  END
+  RETURN ~err
+END Name;
+
+
+PROCEDURE Reset* (num: INTEGER): BOOLEAN;
+  RETURN K.sysfunc2(74, num * 256 + 2) # -1
+END Reset;
+
+
+PROCEDURE Stop* (num: INTEGER): BOOLEAN;
+  RETURN K.sysfunc2(74, num * 256 + 3) # -1
+END Stop;
+
+
+PROCEDURE Pointer* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 4)
+END Pointer;
+
+
+PROCEDURE SentPackets* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 6)
+END SentPackets;
+
+
+PROCEDURE ReceivedPackets* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 7)
+END ReceivedPackets;
+
+
+PROCEDURE SentBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
+  RETURN K.sysfunc22(74, num * 256 + 8, hValue)
+END SentBytes;
+
+
+PROCEDURE ReceivedBytes* (num: INTEGER; VAR hValue: INTEGER): INTEGER;
+  RETURN K.sysfunc22(74, num * 256 + 9, hValue)
+END ReceivedBytes;
+
+
+PROCEDURE LinkStatus* (num: INTEGER): INTEGER;
+  RETURN K.sysfunc2(74, num * 256 + 10)
+END LinkStatus;
+
+
+END NetDevices.

+ 158 - 0
lib/KolibriOS/OpenDlg.ob07

@@ -0,0 +1,158 @@
+(*
+    Copyright 2016, 2018, 2020-2022 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE OpenDlg;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+CONST
+  topen* = 0;
+  tsave* = 1;
+  tdir* = 2;
+
+TYPE
+
+  DRAW_WINDOW = PROCEDURE;
+
+  TDialog = RECORD
+    _type*,
+    procinfo,
+    com_area_name,
+    com_area,
+    opendir_path,
+    dir_default_path,
+    start_path: INTEGER;
+    draw_window: DRAW_WINDOW;
+    status*,
+    openfile_path,
+    filename_area: INTEGER;
+    filter_area:
+      POINTER TO RECORD
+        size: INTEGER;
+        filter: ARRAY 4096 OF CHAR
+      END;
+    X, Y: INTEGER;
+
+    procinf: ARRAY 1024 OF CHAR;
+    s_com_area_name: ARRAY 32 OF CHAR;
+    s_opendir_path,
+    s_dir_default_path,
+    FilePath*,
+    FileName*: ARRAY 4096 OF CHAR
+  END;
+
+  Dialog* = POINTER TO TDialog;
+
+VAR
+
+  Dialog_start, Dialog_init: PROCEDURE [stdcall] (od: Dialog);
+
+
+PROCEDURE Show*(od: Dialog; Width, Height: INTEGER);
+BEGIN
+  IF od # NIL THEN
+    od.X := Width;
+    od.Y := Height;
+    Dialog_start(od)
+  END
+END Show;
+
+PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog;
+VAR res: Dialog; n, i: INTEGER;
+
+  PROCEDURE replace(VAR str: ARRAY OF CHAR; c1, c2: CHAR);
+  VAR i: INTEGER;
+  BEGIN
+    i := LENGTH(str) - 1;
+    WHILE i >= 0 DO
+      IF str[i] = c1 THEN
+        str[i] := c2
+      END;
+      DEC(i)
+    END
+  END replace;
+
+BEGIN
+  NEW(res);
+  IF res # NIL THEN
+    NEW(res.filter_area);
+    IF res.filter_area # NIL THEN
+      res.s_com_area_name    := "FFFFFFFF_open_dialog";
+      res.com_area           := 0;
+      res._type              := _type;
+      res.draw_window        := draw_window;
+      COPY(def_path, res.s_dir_default_path);
+      COPY(filter,   res.filter_area.filter);
+
+      n := LENGTH(res.filter_area.filter);
+      FOR i := 0 TO 3 DO
+        res.filter_area.filter[n + i] := "|"
+      END;
+      res.filter_area.filter[n + 4] := 0X;
+
+      res.X                  := 0;
+      res.Y                  := 0;
+      res.s_opendir_path     := res.s_dir_default_path;
+      res.FilePath           := "";
+      res.FileName           := "";
+      res.status             := 0;
+      res.filter_area.size   := LENGTH(res.filter_area.filter);
+      res.procinfo           := sys.ADR(res.procinf[0]);
+      res.com_area_name      := sys.ADR(res.s_com_area_name[0]);
+      res.start_path         := sys.SADR("/sys/File managers/opendial");
+      res.opendir_path       := sys.ADR(res.s_opendir_path[0]);
+      res.dir_default_path   := sys.ADR(res.s_dir_default_path[0]);
+      res.openfile_path      := sys.ADR(res.FilePath[0]);
+      res.filename_area      := sys.ADR(res.FileName[0]);
+
+      replace(res.filter_area.filter, "|", 0X);
+      Dialog_init(res)
+    ELSE
+      DISPOSE(res)
+    END
+  END
+  RETURN res
+END Create;
+
+PROCEDURE Destroy*(VAR od: Dialog);
+BEGIN
+  IF od # NIL THEN
+    DISPOSE(od.filter_area);
+    DISPOSE(od)
+  END
+END Destroy;
+
+PROCEDURE Load;
+VAR Lib: INTEGER;
+
+  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
+  VAR a: INTEGER;
+  BEGIN
+    a := KOSAPI.GetProcAdr(name, Lib);
+    ASSERT(a # 0);
+    sys.PUT(v, a)
+  END GetProc;
+
+BEGIN
+  Lib := KOSAPI.LoadLib("/sys/Lib/Proc_lib.obj");
+  GetProc(Lib, sys.ADR(Dialog_init),  "OpenDialog_init");
+  GetProc(Lib, sys.ADR(Dialog_start), "OpenDialog_start");
+END Load;
+
+BEGIN
+  Load
+END OpenDlg.

+ 267 - 0
lib/KolibriOS/Out.ob07

@@ -0,0 +1,267 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Out;
+
+IMPORT ConsoleLib, sys := SYSTEM;
+
+CONST
+
+  d = 1.0 - 5.0E-12;
+
+VAR
+
+  Realp: PROCEDURE (x: REAL; width: INTEGER);
+
+PROCEDURE Char*(c: CHAR);
+BEGIN
+  ConsoleLib.write_string(sys.ADR(c), 1)
+END Char;
+
+PROCEDURE String*(s: ARRAY OF CHAR);
+BEGIN
+  ConsoleLib.write_string(sys.ADR(s[0]), LENGTH(s))
+END String;
+
+PROCEDURE WriteInt(x, n: INTEGER);
+VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN;
+BEGIN
+  i := 0;
+  IF n < 1 THEN
+    n := 1
+  END;
+  IF x < 0 THEN
+    x := -x;
+    DEC(n);
+    neg := TRUE
+  END;
+  REPEAT
+    a[i] := CHR(x MOD 10 + ORD("0"));
+    x := x DIV 10;
+    INC(i)
+  UNTIL x = 0;
+  WHILE n > i DO
+    Char(" ");
+    DEC(n)
+  END;
+  IF neg THEN
+    Char("-")
+  END;
+  REPEAT
+    DEC(i);
+    Char(a[i])
+  UNTIL i = 0
+END WriteInt;
+
+PROCEDURE IsNan(AValue: REAL): BOOLEAN;
+VAR h, l: SET;
+BEGIN
+  sys.GET(sys.ADR(AValue), l);
+  sys.GET(sys.ADR(AValue) + 4, h)
+  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+PROCEDURE IsInf(x: REAL): BOOLEAN;
+  RETURN ABS(x) = sys.INF()
+END IsInf;
+
+PROCEDURE Int*(x, width: INTEGER);
+VAR i: INTEGER;
+BEGIN
+  IF x # 80000000H THEN
+    WriteInt(x, width)
+  ELSE
+    FOR i := 12 TO width DO
+      Char(20X)
+    END;
+    String("-2147483648")
+  END
+END Int;
+
+PROCEDURE OutInf(x: REAL; width: INTEGER);
+VAR s: ARRAY 5 OF CHAR; i: INTEGER;
+BEGIN
+  IF IsNan(x) THEN
+    s := "Nan";
+    INC(width)
+  ELSIF IsInf(x) & (x > 0.0) THEN
+    s := "+Inf"
+  ELSIF IsInf(x) & (x < 0.0) THEN
+    s := "-Inf"
+  END;
+  FOR i := 1 TO width - 4 DO
+    Char(" ")
+  END;
+  String(s)
+END OutInf;
+
+PROCEDURE Ln*;
+BEGIN
+  Char(0DX);
+  Char(0AX)
+END Ln;
+
+PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
+VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSIF p < 0 THEN
+    Realp(x, width)
+  ELSE
+    len := 0;
+    minus := FALSE;
+    IF x < 0.0 THEN
+      minus := TRUE;
+      INC(len);
+      x := ABS(x)
+    END;
+    e := 0;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    IF e >= 0 THEN
+      len := len + e + p + 1;
+      IF x > 9.0 + d THEN
+        INC(len)
+      END;
+      IF p > 0 THEN
+        INC(len)
+      END
+    ELSE
+      len := len + p + 2
+    END;
+    FOR i := 1 TO width - len DO
+      Char(" ")
+    END;
+    IF minus THEN
+      Char("-")
+    END;
+    y := x;
+    WHILE (y < 1.0) & (y # 0.0) DO
+      y := y * 10.0;
+      DEC(e)
+    END;
+    IF e < 0 THEN
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char("1");
+        x := 0.0
+      ELSE
+        Char("0");
+        x := x * 10.0
+      END
+    ELSE
+      WHILE e >= 0 DO
+        IF x - FLT(FLOOR(x)) > d THEN
+          IF x > 9.0 THEN
+            String("10")
+          ELSE
+            Char(CHR(FLOOR(x) + ORD("0") + 1))
+          END;
+          x := 0.0
+        ELSE
+          Char(CHR(FLOOR(x) + ORD("0")));
+          x := (x - FLT(FLOOR(x))) * 10.0
+        END;
+        DEC(e)
+      END
+    END;
+    IF p > 0 THEN
+      Char(".")
+    END;
+    WHILE p > 0 DO
+      IF x - FLT(FLOOR(x)) > d THEN
+        Char(CHR(FLOOR(x) + ORD("0") + 1));
+        x := 0.0
+      ELSE
+        Char(CHR(FLOOR(x) + ORD("0")));
+        x := (x - FLT(FLOOR(x))) * 10.0
+      END;
+      DEC(p)
+    END
+  END
+END _FixReal;
+
+PROCEDURE Real*(x: REAL; width: INTEGER);
+VAR e, n, i: INTEGER; minus: BOOLEAN;
+BEGIN
+  IF IsNan(x) OR IsInf(x) THEN
+    OutInf(x, width)
+  ELSE
+    e := 0;
+    n := 0;
+    IF width > 23 THEN
+      n := width - 23;
+      width := 23
+    ELSIF width < 9 THEN
+      width := 9
+    END;
+    width := width - 5;
+    IF x < 0.0 THEN
+      x := -x;
+      minus := TRUE
+    ELSE
+      minus := FALSE
+    END;
+    WHILE x >= 10.0 DO
+      x := x / 10.0;
+      INC(e)
+    END;
+    WHILE (x < 1.0) & (x # 0.0) DO
+      x := x * 10.0;
+      DEC(e)
+    END;
+    IF x > 9.0 + d THEN
+      x := 1.0;
+      INC(e)
+    END;
+    FOR i := 1 TO n DO
+      Char(" ")
+    END;
+    IF minus THEN
+      x := -x
+    END;
+    Realp := Real;
+    _FixReal(x, width, width - 3);
+    Char("E");
+    IF e >= 0 THEN
+      Char("+")
+    ELSE
+      Char("-");
+      e := ABS(e)
+    END;
+    IF e < 100 THEN
+      Char("0")
+    END;
+    IF e < 10 THEN
+      Char("0")
+    END;
+    Int(e, 0)
+  END
+END Real;
+
+PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
+BEGIN
+  Realp := Real;
+  _FixReal(x, width, p)
+END FixReal;
+
+PROCEDURE Open*;
+END Open;
+
+END Out.

+ 543 - 0
lib/KolibriOS/RTL.ob07

@@ -0,0 +1,543 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name:  INTEGER;
+    types: INTEGER;
+
+
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
+    085H, 0C0H,          (*  test eax, eax              *)
+    07EH, 019H,          (*  jle L                      *)
+    0FCH,                (*  cld                        *)
+    057H,                (*  push edi                   *)
+    056H,                (*  push esi                   *)
+    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
+    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
+    0F3H, 0A5H,          (*  rep movsd                  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
+    0F3H, 0A4H,          (*  rep movsb                  *)
+    05EH,                (*  pop esi                    *)
+    05FH                 (*  pop edi                    *)
+                         (*  L:                         *)
+                )
+END _move;
+
+
+PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
+    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
+    049H,               (*  dec   ecx                    *)
+    053H,               (*  push  ebx                    *)
+    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
+                        (*  L:                           *)
+    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
+    089H, 010H,         (*  mov   dword [eax], edx       *)
+    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
+    049H,               (*  dec   ecx                    *)
+    075H, 0F5H,         (*  jnz   L                      *)
+    089H, 018H,         (*  mov   dword [eax], ebx       *)
+    05BH,               (*  pop   ebx                    *)
+    05DH,               (*  pop   ebp                    *)
+    0C2H, 008H, 000H    (*  ret   8                      *)
+    )
+END _rot;
+
+
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
+    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
+    039H, 0C8H,                    (*  cmp   eax, ecx               *)
+    07FH, 033H,                    (*  jg    L1                     *)
+    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
+    07FH, 02EH,                    (*  jg    L1                     *)
+    085H, 0C9H,                    (*  test  ecx, ecx               *)
+    07CH, 02AH,                    (*  jl    L1                     *)
+    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
+    07EH, 005H,                    (*  jle   L3                     *)
+    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
+                                   (*  L3:                          *)
+    085H, 0C0H,                    (*  test  eax, eax               *)
+    07DH, 002H,                    (*  jge   L2                     *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+                                   (*  L2:                          *)
+    089H, 0CAH,                    (*  mov   edx, ecx               *)
+    029H, 0C2H,                    (*  sub   edx, eax               *)
+    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    0D3H, 0F8H,                    (*  sar   eax, cl                *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
+    0F7H, 0D9H,                    (*  neg   ecx                    *)
+    0D3H, 0E8H,                    (*  shr   eax, cl                *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H,              (*  ret   8                      *)
+                                   (*  L1:                          *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H               (*  ret   8                      *)
+    )
+END _set;
+
+
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    031H, 0C0H,         (*  xor  eax, eax              *)
+    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
+    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
+    077H, 003H,         (*  ja   L                     *)
+    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
+                        (*  L:                         *)
+    )
+END _set1;
+
+
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
+BEGIN
+    SYSTEM.CODE(
+    053H,                (*  push    ebx                    *)
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
+    031H, 0D2H,          (*  xor     edx, edx               *)
+    085H, 0C0H,          (*  test    eax, eax               *)
+    074H, 018H,          (*  je      L2                     *)
+    07FH, 002H,          (*  jg      L1                     *)
+    0F7H, 0D2H,          (*  not     edx                    *)
+                         (*  L1:                            *)
+    089H, 0C3H,          (*  mov     ebx, eax               *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
+    0F7H, 0F9H,          (*  idiv    ecx                    *)
+    085H, 0D2H,          (*  test    edx, edx               *)
+    074H, 009H,          (*  je      L2                     *)
+    031H, 0CBH,          (*  xor     ebx, ecx               *)
+    085H, 0DBH,          (*  test    ebx, ebx               *)
+    07DH, 003H,          (*  jge     L2                     *)
+    048H,                (*  dec     eax                    *)
+    001H, 0CAH,          (*  add     edx, ecx               *)
+                         (*  L2:                            *)
+    05BH                 (*  pop     ebx                    *)
+               )
+END _divmod;
+
+
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD)
+    END
+END _new;
+
+
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - WORD)
+    END
+END _dispose;
+
+
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                (*  dec     eax                     *)
+                         (*  L1:                             *)
+    040H,                (*  inc     eax                     *)
+    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
+    074H, 003H,          (*  jz      L2                      *)
+    0E2H, 0F8H,          (*  loop    L1                      *)
+    040H,                (*  inc     eax                     *)
+                         (*  L2:                             *)
+    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
+               )
+END _length;
+
+
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                     (*  dec     eax                     *)
+    048H,                     (*  dec     eax                     *)
+                              (*  L1:                             *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
+    074H, 004H,               (*  jz      L2                      *)
+    0E2H, 0F6H,               (*  loop    L1                      *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+                              (*  L2:                             *)
+    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
+    0D1H, 0E8H                (*  shr     eax, 1                  *)
+               )
+END _lengthw;
+
+
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 017H,              (*  jle     L3                             *)
+    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
+    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E7H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 01BH,              (*  jle     L3                             *)
+    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
+    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E3H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _isrec;
+
+
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
+BEGIN
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    END
+
+    RETURN p MOD 2
+END _is;
+
+
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _guardrec;
+
+
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    ELSE
+        p := 1
+    END
+
+    RETURN p MOD 2
+END _guard;
+
+
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [stdcall] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+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 := 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 * WORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
+    name := modname
+END _init;
+
+
+END RTL.

+ 124 - 0
lib/KolibriOS/RasterWorks.ob07

@@ -0,0 +1,124 @@
+(*
+    Copyright 2016, 2018, 2022 KolibriOS team
+
+    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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE RasterWorks;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+
+CONST
+
+(* flags *)
+
+  bold            *=   1;
+  italic          *=   2;
+  underline       *=   4;
+  strike_through  *=   8;
+  align_right     *=  16;
+  align_center    *=  32;
+
+  bpp32           *= 128;
+
+
+(* encoding *)
+
+  cp866           *=   1;
+  utf16le         *=   2;
+  utf8            *=   3;
+
+
+VAR
+
+  // draw text on 24bpp or 32bpp image
+  // autofits text between 'x' and 'xSize'
+  drawText *: PROCEDURE (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER;
+(*
+  [canvas]:
+    xSize        dd  ?
+    ySize        dd  ?
+    picture      rb  xSize * ySize * bpp
+
+   fontColor     dd  AARRGGBB
+    AA = alpha channel   ; 0 = transparent, FF = non transparent
+
+   params        dd  ffeewwhh
+    hh = char height
+    ww = char width      ; 0 = auto (proportional)
+    ee = encoding        ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8
+    ff = flags           ; 0001 = bold, 0010 = italic
+                         ; 0100 = underline, 1000 = strike-through
+   00010000 = align right, 00100000 = align center
+   01000000 = set text area between higher and lower halfs of 'x'
+   10000000 = 32bpp canvas insted of 24bpp
+   all flags combinable, except align right + align center
+
+   returns: char width (0 = error)
+*)
+
+  // calculate amount of valid chars in UTF-8 string
+  // supports zero terminated string (set byteQuantity = -1)
+  countUTF8Z *: PROCEDURE (string, byteQuantity: INTEGER): INTEGER;
+
+
+  // calculate amount of chars that fits given width
+  charsFit *: PROCEDURE (areaWidth, charHeight: INTEGER): INTEGER;
+
+
+  // calculate string width in pixels
+  strWidth *: PROCEDURE (charQuantity, charHeight: INTEGER): INTEGER;
+
+
+PROCEDURE params* (charHeight, charWidth, encoding, flags: INTEGER): INTEGER;
+(*
+    hh = char height
+    ww = char width      ; 0 = auto (proportional)
+    ee = encoding        ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8
+    ff = flags           ; 0001 = bold, 0010 = italic
+                        ; 0100 = underline, 1000 = strike-through
+   00010000 = align right, 00100000 = align center
+   01000000 = set text area between higher and lower halfs of 'x'
+   10000000 = 32bpp canvas insted of 24bpp
+   all flags combinable, except align right + align center
+*)
+  RETURN charHeight + LSL(charWidth, 8) + LSL(encoding, 16) + LSL(flags, 24)
+END params;
+
+
+PROCEDURE main;
+VAR Lib: INTEGER;
+
+  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
+  VAR a: INTEGER;
+  BEGIN
+    a := KOSAPI.GetProcAdr(name, Lib);
+    ASSERT(a # 0);
+    sys.PUT(v, a)
+  END GetProc;
+
+BEGIN
+  Lib := KOSAPI.LoadLib("/sys/lib/RasterWorks.obj");
+  ASSERT(Lib # 0);
+  GetProc(Lib, sys.ADR(drawText),   "drawText");
+  GetProc(Lib, sys.ADR(countUTF8Z), "countUTF8Z");
+  GetProc(Lib, sys.ADR(charsFit),   "charsFit");
+  GetProc(Lib, sys.ADR(strWidth),   "strWidth");
+END main;
+
+
+BEGIN
+  main
+END RasterWorks.

+ 46 - 0
lib/KolibriOS/Read.ob07

@@ -0,0 +1,46 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Read;
+
+IMPORT File, sys := SYSTEM;
+
+PROCEDURE Char*(F: File.FS; VAR x: CHAR): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
+END Char;
+
+PROCEDURE Int*(F: File.FS; VAR x: INTEGER): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
+END Int;
+
+PROCEDURE Real*(F: File.FS; VAR x: REAL): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
+END Real;
+
+PROCEDURE Boolean*(F: File.FS; VAR x: BOOLEAN): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
+END Boolean;
+
+PROCEDURE Set*(F: File.FS; VAR x: SET): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
+END Set;
+
+PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN;
+  RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
+END WChar;
+
+END Read.

+ 64 - 0
lib/KolibriOS/UnixTime.ob07

@@ -0,0 +1,64 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2019, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE UnixTime;
+
+
+VAR
+
+    days: ARRAY 12, 31, 2 OF INTEGER;
+
+
+PROCEDURE init;
+VAR
+    i, j, k, n0, n1: INTEGER;
+BEGIN
+
+    FOR i := 0 TO 11 DO
+        FOR j := 0 TO 30 DO
+            days[i, j, 0] := 0;
+            days[i, j, 1] := 0;
+        END
+    END;
+
+    days[ 1, 28, 0] := -1;
+
+    FOR k := 0 TO 1 DO
+        days[ 1, 29, k] := -1;
+        days[ 1, 30, k] := -1;
+        days[ 3, 30, k] := -1;
+        days[ 5, 30, k] := -1;
+        days[ 8, 30, k] := -1;
+        days[10, 30, k] := -1;
+    END;
+
+    n0 := 0;
+    n1 := 0;
+    FOR i := 0 TO 11 DO
+        FOR j := 0 TO 30 DO
+            IF days[i, j, 0] = 0 THEN
+                days[i, j, 0] := n0;
+                INC(n0)
+            END;
+            IF days[i, j, 1] = 0 THEN
+                days[i, j, 1] := n1;
+                INC(n1)
+            END
+        END
+    END
+
+END init;
+
+
+PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER;
+    RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
+END time;
+
+
+BEGIN
+    init
+END UnixTime.

+ 121 - 0
lib/KolibriOS/Vector.ob07

@@ -0,0 +1,121 @@
+(*
+    Copyright 2016 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Vector;
+
+
+IMPORT sys := SYSTEM, K := KOSAPI;
+
+
+TYPE
+
+  DESC_VECTOR = RECORD
+
+    data   : INTEGER;
+    count  : INTEGER;
+    size   : INTEGER
+
+  END;
+
+  VECTOR* = POINTER TO DESC_VECTOR;
+
+  ANYREC* = RECORD END;
+
+  ANYPTR* = POINTER TO ANYREC;
+
+  DESTRUCTOR* = PROCEDURE (VAR ptr: ANYPTR);
+
+
+PROCEDURE count* (vector: VECTOR): INTEGER;
+BEGIN
+  ASSERT(vector # NIL)
+  RETURN vector.count
+END count;
+
+
+PROCEDURE push* (vector: VECTOR; value: ANYPTR);
+BEGIN
+  ASSERT(vector # NIL);
+  IF vector.count = vector.size THEN
+    vector.data := K.realloc(vector.data, (vector.size + 1024) * 4);
+    ASSERT(vector.data # 0);
+    vector.size := vector.size + 1024
+  END;
+  sys.PUT(vector.data + vector.count * 4, value);
+  INC(vector.count)
+END push;
+
+
+PROCEDURE get* (vector: VECTOR; idx: INTEGER): ANYPTR;
+VAR res: ANYPTR;
+BEGIN
+  ASSERT(vector # NIL);
+  ASSERT( (0 <= idx) & (idx < vector.count) );
+  sys.GET(vector.data + idx * 4, res)
+  RETURN res
+END get;
+
+
+PROCEDURE put* (vector: VECTOR; idx: INTEGER; value: ANYPTR);
+BEGIN
+  ASSERT(vector # NIL);
+  ASSERT( (0 <= idx) & (idx < vector.count) );
+  sys.PUT(vector.data + idx * 4, value)
+END put;
+
+
+PROCEDURE create* (size: INTEGER): VECTOR;
+VAR vector: VECTOR;
+BEGIN
+  NEW(vector);
+  IF vector # NIL THEN
+    vector.data  := K.malloc(4 * size);
+    IF vector.data # 0 THEN
+      vector.size  := size;
+      vector.count := 0
+    ELSE
+      DISPOSE(vector)
+    END
+  END
+  RETURN vector
+END create;
+
+
+PROCEDURE def_destructor (VAR any: ANYPTR);
+BEGIN
+  DISPOSE(any)
+END def_destructor;
+
+
+PROCEDURE destroy* (VAR vector: VECTOR; destructor: DESTRUCTOR);
+VAR i: INTEGER;
+    any: ANYPTR;
+BEGIN
+  ASSERT(vector # NIL);
+  IF destructor = NIL THEN
+    destructor := def_destructor
+  END;
+  FOR i := 0 TO vector.count - 1 DO
+    any := get(vector, i);
+    destructor(any)
+  END;
+  vector.data := K.free(vector.data);
+  DISPOSE(vector)
+END destroy;
+
+
+END Vector.

+ 46 - 0
lib/KolibriOS/Write.ob07

@@ -0,0 +1,46 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE Write;
+
+IMPORT File, sys := SYSTEM;
+
+PROCEDURE Char*(F: File.FS; x: CHAR): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(CHAR)) = sys.SIZE(CHAR)
+END Char;
+
+PROCEDURE Int*(F: File.FS; x: INTEGER): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(INTEGER)) = sys.SIZE(INTEGER)
+END Int;
+
+PROCEDURE Real*(F: File.FS; x: REAL): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL)
+END Real;
+
+PROCEDURE Boolean*(F: File.FS; x: BOOLEAN): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN)
+END Boolean;
+
+PROCEDURE Set*(F: File.FS; x: SET): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET)
+END Set;
+
+PROCEDURE WChar*(F: File.FS; x: WCHAR): BOOLEAN;
+  RETURN File.Write(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR)
+END WChar;
+
+END Write.

+ 492 - 0
lib/KolibriOS/kfonts.ob07

@@ -0,0 +1,492 @@
+(*
+    Copyright 2016, 2018 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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE kfonts;
+
+IMPORT sys := SYSTEM, File, KOSAPI;
+
+CONST
+
+  MIN_FONT_SIZE = 8;
+  MAX_FONT_SIZE = 46;
+
+  bold            *=   1;
+  italic          *=   2;
+  underline       *=   4;
+  strike_through  *=   8;
+  smoothing       *=  16;
+  bpp32           *=  32;
+
+TYPE
+
+  Glyph = RECORD
+    base: INTEGER;
+    xsize, ysize: INTEGER;
+    width: INTEGER
+  END;
+
+  TFont_desc = RECORD
+
+    data, size, font, char_size, width, height, font_size, mem, mempos: INTEGER;
+    glyphs: ARRAY 4, 256 OF Glyph
+
+  END;
+
+  TFont* = POINTER TO TFont_desc;
+
+
+PROCEDURE [stdcall] zeromem(size, adr: INTEGER);
+BEGIN
+  sys.CODE(057H, 08BH, 07DH, 00CH, 08BH, 04DH, 008H, 033H, 0C0H, 09CH, 0FCH, 0F3H, 0ABH, 09DH, 05FH)
+END zeromem;
+
+PROCEDURE pset(buf, x, y, color: INTEGER; bpp32: BOOLEAN);
+VAR xsize, ysize: INTEGER;
+BEGIN
+  sys.GET(buf, xsize);
+  sys.GET(buf + 4, ysize);
+  INC(buf, 8);
+  IF (0 <= x) & (x < xsize) & (0 <= y) & (y < ysize) THEN
+    IF bpp32 THEN
+      sys.PUT(buf + 4 * (xsize * y + x), color)
+    ELSE
+      sys.MOVE(sys.ADR(color), buf + 3 * (xsize * y + x), 3)
+    END
+  END
+END pset;
+
+PROCEDURE pget(buf, x, y: INTEGER; bpp32: BOOLEAN): INTEGER;
+VAR xsize, ysize, color: INTEGER;
+BEGIN
+  sys.GET(buf, xsize);
+  sys.GET(buf + 4, ysize);
+  INC(buf, 8);
+  IF (0 <= x) & (x < xsize) & (0 <= y) & (y < ysize) THEN
+    IF bpp32 THEN
+      sys.GET(buf + 4 * (xsize * y + x), color)
+    ELSE
+      sys.MOVE(buf + 3 * (xsize * y + x), sys.ADR(color), 3)
+    END
+  END
+  RETURN color
+END pget;
+
+PROCEDURE getrgb(color: INTEGER; VAR r, g, b: INTEGER);
+BEGIN
+  b := LSR(LSL(color, 24), 24);
+  g := LSR(LSL(color, 16), 24);
+  r := LSR(LSL(color,  8), 24);
+END getrgb;
+
+PROCEDURE rgb(r, g, b: INTEGER): INTEGER;
+  RETURN b + LSL(g, 8) + LSL(r, 16)
+END rgb;
+
+PROCEDURE create_glyph(VAR Font: TFont_desc; VAR glyph: Glyph; xsize, ysize: INTEGER);
+BEGIN
+  glyph.base := Font.mempos;
+  glyph.xsize := xsize;
+  glyph.ysize := ysize;
+  Font.mempos := Font.mempos + xsize * ysize
+END create_glyph;
+
+PROCEDURE getpix(Font: TFont_desc; n, x, y, xsize: INTEGER): CHAR;
+VAR res: CHAR;
+BEGIN
+  sys.GET(Font.mem + n + x + y * xsize, res)
+  RETURN res
+END getpix;
+
+PROCEDURE setpix(VAR Font: TFont_desc; n, x, y, xsize: INTEGER; c: CHAR);
+BEGIN
+  sys.PUT(Font.mem + n + x + y * xsize, c)
+END setpix;
+
+PROCEDURE smooth(VAR Font: TFont_desc; n, xsize, ysize: INTEGER);
+VAR x, y: INTEGER;
+BEGIN
+  FOR y := 1 TO ysize - 1 DO
+    FOR x := 1 TO xsize - 1 DO
+      IF (getpix(Font, n, x, y, xsize) = 1X) & (getpix(Font, n, x - 1, y - 1, xsize) = 1X) &
+         (getpix(Font, n, x - 1, y, xsize) = 0X) & (getpix(Font, n, x, y - 1, xsize) = 0X) THEN
+        setpix(Font, n, x - 1, y, xsize, 2X);
+        setpix(Font, n, x, y - 1, xsize, 2X)
+      END;
+      IF (getpix(Font, n, x, y, xsize) = 0X) & (getpix(Font, n, x - 1, y - 1, xsize) = 0X) &
+         (getpix(Font, n, x - 1, y, xsize) = 1X) & (getpix(Font, n, x, y - 1, xsize) = 1X) THEN
+        setpix(Font, n, x, y, xsize, 2X);
+        setpix(Font, n, x - 1, y - 1, xsize, 2X)
+      END
+    END
+  END
+END smooth;
+
+PROCEDURE _bold(VAR Font: TFont_desc; src, dst, src_xsize, dst_xsize, n: INTEGER);
+VAR i, j, k: INTEGER; pix: CHAR;
+BEGIN
+  FOR i := 0 TO src_xsize - 1 DO
+    FOR j := 0 TO Font.height - 1 DO
+      pix := getpix(Font, src, i, j, src_xsize);
+      IF pix = 1X THEN
+        FOR k := 0 TO n DO
+          setpix(Font, dst, i + k, j, dst_xsize, pix)
+        END
+      END
+    END
+  END
+END _bold;
+
+PROCEDURE make_glyph(VAR Font: TFont_desc; c: INTEGER);
+VAR ptr, i, j, max, x, y: INTEGER; s: SET; eoc: BOOLEAN;
+    glyph: Glyph; pix: CHAR; bold_width: INTEGER;
+BEGIN
+  create_glyph(Font, glyph, Font.width, Font.height);
+  x := 0;
+  y := 0;
+  max := 0;
+  ptr := Font.font + Font.char_size * c;
+  eoc := FALSE;
+  REPEAT
+    sys.GET(ptr, s);
+    INC(ptr, 4);
+    FOR i := 0 TO 31 DO
+      IF ~eoc THEN
+        IF i IN s THEN
+          setpix(Font, glyph.base, x, y, Font.width, 1X);
+          IF x > max THEN
+            max := x
+          END
+        ELSE
+          setpix(Font, glyph.base, x, y, Font.width, 0X)
+        END
+      END;
+      INC(x);
+      IF x = Font.width THEN
+        x := 0;
+        INC(y);
+        eoc := eoc OR (y = Font.height)
+      END
+    END
+  UNTIL eoc;
+  IF max = 0 THEN
+    max := Font.width DIV 3
+  END;
+
+  glyph.width := max;
+  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
+  Font.glyphs[0, c] := glyph;
+
+  bold_width := 1;
+
+  create_glyph(Font, glyph, Font.width + bold_width, Font.height);
+  _bold(Font, Font.glyphs[0, c].base, glyph.base, Font.glyphs[0, c].xsize, glyph.xsize, bold_width);
+  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
+  glyph.width := max + bold_width;
+  Font.glyphs[1, c] := glyph;
+
+  create_glyph(Font, glyph, Font.width + (Font.height - 1) DIV 3, Font.height);
+  FOR i := 0 TO Font.glyphs[0, c].xsize - 1 DO
+    FOR j := 0 TO Font.height - 1 DO
+      pix := getpix(Font, Font.glyphs[0, c].base, i, j, Font.glyphs[0, c].xsize);
+      IF pix = 1X THEN
+        setpix(Font, glyph.base, i + (Font.height - 1 - j) DIV 3, j, glyph.xsize, pix)
+      END
+    END
+  END;
+  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
+  glyph.width := max;
+  Font.glyphs[2, c] := glyph;
+
+  create_glyph(Font, glyph, Font.width + (Font.height - 1) DIV 3 + bold_width, Font.height);
+  _bold(Font, Font.glyphs[2, c].base, glyph.base, Font.glyphs[2, c].xsize, glyph.xsize, bold_width);
+  smooth(Font, glyph.base, glyph.xsize, glyph.ysize);
+  glyph.width := max + bold_width;
+  Font.glyphs[3, c] := glyph;
+
+END make_glyph;
+
+PROCEDURE OutChar(Font: TFont_desc; c: INTEGER; x, y: INTEGER; buf: INTEGER; bpp32, smoothing: BOOLEAN; color, style: INTEGER): INTEGER;
+VAR i, x0, y0, xsize, mem, xmax: INTEGER; r, g, b, r0, g0, b0: INTEGER; ch: CHAR; glyph: Glyph;
+BEGIN
+  x0 := x;
+  y0 := y;
+  style := style MOD 4;
+  glyph := Font.glyphs[style, c];
+  xsize := glyph.xsize;
+  xmax := x0 + xsize;
+  mem := Font.mem + glyph.base;
+  getrgb(color, r0, g0, b0);
+  FOR i := mem TO mem + xsize * Font.height - 1 DO
+    sys.GET(i, ch);
+    IF ch = 1X THEN
+      pset(buf, x, y, color, bpp32);
+    ELSIF (ch = 2X) & smoothing THEN
+      getrgb(pget(buf, x, y, bpp32), r, g, b);
+      r := (r * 3 + r0) DIV 4;
+      g := (g * 3 + g0) DIV 4;
+      b := (b * 3 + b0) DIV 4;
+      pset(buf, x, y, rgb(r, g, b), bpp32)
+    END;
+    INC(x);
+    IF x = xmax THEN
+      x := x0;
+      INC(y)
+    END
+  END
+  RETURN glyph.width
+END OutChar;
+
+PROCEDURE hline(buf, x, y, width, color: INTEGER; bpp32: BOOLEAN);
+VAR i: INTEGER;
+BEGIN
+  FOR i := x TO x + width - 1 DO
+    pset(buf, i, y, color, bpp32)
+  END
+END hline;
+
+PROCEDURE TextWidth*(Font: TFont; str, length, params: INTEGER): INTEGER;
+VAR res: INTEGER; c: CHAR;
+BEGIN
+  res := 0;
+  params := params MOD 4;
+  IF Font # NIL THEN
+    sys.GET(str, c);
+    WHILE (length > 0) OR (length = -1) & (c # 0X) DO
+      INC(str);
+      res := res + Font.glyphs[params, ORD(c)].width;
+      IF length > 0 THEN
+        DEC(length)
+      END;
+      IF length # 0 THEN
+        sys.GET(str, c)
+      END
+    END
+  END
+  RETURN res
+END TextWidth;
+
+PROCEDURE TextHeight*(Font: TFont): INTEGER;
+VAR res: INTEGER;
+BEGIN
+  IF Font # NIL THEN
+    res := Font.height
+  ELSE
+    res := 0
+  END
+  RETURN res
+END TextHeight;
+
+PROCEDURE TextClipLeft(Font: TFont; str, length, params: INTEGER; VAR x: INTEGER): INTEGER;
+VAR x1: INTEGER; c: CHAR;
+BEGIN
+  params := params MOD 4;
+  sys.GET(str, c);
+  WHILE (length > 0) OR (length = -1) & (c # 0X) DO
+    INC(str);
+    x1 := x;
+    x := x + Font.glyphs[params, ORD(c)].width;
+    IF x > 0 THEN
+      length := 0;
+    END;
+    IF length > 0 THEN
+      DEC(length)
+    END;
+    IF length # 0 THEN
+      sys.GET(str, c)
+    END
+  END;
+  x := x1
+  RETURN str - 1
+END TextClipLeft;
+
+PROCEDURE TextOut*(Font: TFont; canvas, x, y, str, length, color, params: INTEGER);
+VAR width, xsize, ysize, str1, n: INTEGER; c: CHAR; bpp32, smoothing, underline, strike: BOOLEAN;
+BEGIN
+  IF Font # NIL THEN
+    sys.GET(canvas,     xsize);
+    sys.GET(canvas + 4, ysize);
+    IF (y <= -TextHeight(Font)) OR (y >= ysize) THEN
+      length := 0
+    END;
+    IF length # 0 THEN
+      smoothing := 4 IN BITS(params);
+      bpp32 := 5 IN BITS(params);
+      underline := 2 IN BITS(params);
+      strike := 3 IN BITS(params);
+      str1 := TextClipLeft(Font, str, length, params, x);
+      n := str1 - str;
+      str := str1;
+      IF length >= n THEN
+        length := length - n
+      END;
+      sys.GET(str, c)
+    END;
+    WHILE (length > 0) OR (length = -1) & (c # 0X) DO
+      INC(str);
+      width := OutChar(Font^, ORD(c), x, y, canvas, bpp32, smoothing, color, params);
+      IF strike THEN
+        hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width + 2, color, bpp32)
+      END;
+      IF underline THEN
+        hline(canvas, x, y + Font.height - 1, width + 2, color, bpp32)
+      END;
+      x := x + width;
+      IF x > xsize THEN
+        length := 0
+      END;
+      IF length > 0 THEN
+        DEC(length)
+      END;
+      IF length # 0 THEN
+        sys.GET(str, c)
+      END
+    END
+  END
+END TextOut;
+
+PROCEDURE SetSize*(_Font: TFont; font_size: INTEGER): BOOLEAN;
+VAR temp, offset, fsize, i, memsize, mem: INTEGER;
+    c: CHAR; Font, Font2: TFont_desc;
+BEGIN
+  offset := -1;
+  IF (MIN_FONT_SIZE <= font_size) & (font_size <= MAX_FONT_SIZE) & (_Font # NIL) THEN
+    Font := _Font^;
+    Font2 := Font;
+    temp := Font.data + (font_size - 8) * 4;
+    IF (Font.data <= temp) & (temp <= Font.size + Font.data - 4) THEN
+      sys.GET(temp, offset);
+      IF offset # -1 THEN
+        Font.font_size := font_size;
+        INC(offset, 156);
+        offset := offset + Font.data;
+        IF (Font.data <= offset) & (offset <= Font.size + Font.data - 4) THEN
+          sys.GET(offset, fsize);
+          IF fsize > 256 + 6 THEN
+            temp := offset + fsize - 1;
+            IF (Font.data <= temp) & (temp <= Font.size + Font.data - 1) THEN
+              sys.GET(temp, c);
+              IF c # 0X THEN
+                Font.height := ORD(c);
+                DEC(temp);
+                sys.GET(temp, c);
+                IF c # 0X THEN
+                  Font.width := ORD(c);
+                  DEC(fsize, 6);
+                  Font.char_size := fsize DIV 256;
+                  IF fsize MOD 256 # 0 THEN
+                    INC(Font.char_size)
+                  END;
+                  IF Font.char_size > 0 THEN
+                    Font.font := offset + 4;
+                    Font.mempos := 0;
+                    memsize := (Font.width + 10) * Font.height * 1024;
+                    mem := Font.mem;
+                    Font.mem := KOSAPI.sysfunc3(68, 12, memsize);
+                    IF Font.mem # 0 THEN
+                      IF mem # 0 THEN
+                        mem := KOSAPI.sysfunc3(68, 13, mem)
+                      END;
+                      zeromem(memsize DIV 4, Font.mem);
+                      FOR i := 0 TO 255 DO
+                        make_glyph(Font, i)
+                      END
+                    ELSE
+                      offset := -1
+                    END
+                  ELSE
+                    offset := -1
+                  END
+                ELSE
+                  offset := -1
+                END
+              ELSE
+                offset := -1
+              END
+            ELSE
+              offset := -1
+            END
+          ELSE
+            offset := -1
+          END
+        ELSE
+          offset := -1
+        END
+      END;
+    ELSE
+      offset := -1
+    END;
+    IF offset # -1 THEN
+      _Font^ := Font
+    ELSE
+      _Font^ := Font2
+    END
+  END
+  RETURN offset # -1
+END SetSize;
+
+PROCEDURE Enabled*(Font: TFont; font_size: INTEGER): BOOLEAN;
+VAR offset, temp: INTEGER;
+BEGIN
+  offset := -1;
+  IF (MIN_FONT_SIZE <= font_size) & (font_size <= MAX_FONT_SIZE) & (Font # NIL) THEN
+    temp := Font.data + (font_size - 8) * 4;
+    IF (Font.data <= temp) & (temp <= Font.size + Font.data - 4) THEN
+      sys.GET(temp, offset)
+    END
+  END
+  RETURN offset # -1
+END Enabled;
+
+PROCEDURE Destroy*(VAR Font: TFont);
+BEGIN
+  IF Font # NIL THEN
+    IF Font.mem # 0 THEN
+      Font.mem := KOSAPI.sysfunc3(68, 13, Font.mem)
+    END;
+    IF Font.data # 0 THEN
+      Font.data := KOSAPI.sysfunc3(68, 13, Font.data)
+    END;
+    DISPOSE(Font)
+  END
+END Destroy;
+
+PROCEDURE LoadFont*(file_name: ARRAY OF CHAR): TFont;
+VAR Font: TFont; data, size, n: INTEGER;
+BEGIN
+  data := File.Load(file_name, size);
+  IF (data # 0) & (size > 156) THEN
+    NEW(Font);
+    Font.data := data;
+    Font.size := size;
+    Font.font_size := 0;
+    n := MIN_FONT_SIZE;
+    WHILE ~SetSize(Font, n) & (n <= MAX_FONT_SIZE) DO
+      INC(n)
+    END;
+    IF Font.font_size = 0 THEN
+      Destroy(Font)
+    END
+  ELSE
+    IF data # 0 THEN
+      data := KOSAPI.sysfunc3(68, 13, data)
+    END;
+    Font := NIL
+  END
+  RETURN Font
+END LoadFont;
+
+END kfonts.

+ 435 - 0
lib/KolibriOS/libimg.ob07

@@ -0,0 +1,435 @@
+(*
+    Copyright 2016, 2018, 2020, 2022 KolibriOS team
+
+    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
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public License
+    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*)
+
+MODULE libimg;
+
+IMPORT sys := SYSTEM, KOSAPI;
+
+
+CONST
+
+  FLIP_VERTICAL   *= 1;
+  FLIP_HORIZONTAL *= 2;
+
+
+  ROTATE_90_CW    *= 1;
+  ROTATE_180      *= 2;
+  ROTATE_270_CW   *= 3;
+  ROTATE_90_CCW   *= ROTATE_270_CW;
+  ROTATE_270_CCW  *= ROTATE_90_CW;
+
+
+  // scale type                       corresponding img_scale params
+  LIBIMG_SCALE_INTEGER     *= 1;  //    scale factor ; reserved 0
+  LIBIMG_SCALE_TILE        *= 2;  //    new width    ; new height
+  LIBIMG_SCALE_STRETCH     *= 3;  //    new width    ; new height
+  LIBIMG_SCALE_FIT_RECT    *= 4;  //    new width    ; new height
+  LIBIMG_SCALE_FIT_WIDTH   *= 5;  //    new width    ; new height
+  LIBIMG_SCALE_FIT_HEIGHT  *= 6;  //    new width    ; new height
+  LIBIMG_SCALE_FIT_MAX     *= 7;  //    new width    ; new height
+
+
+  // interpolation algorithm
+  LIBIMG_INTER_NONE        *= 0;  //    use it with LIBIMG_SCALE_INTEGER, LIBIMG_SCALE_TILE, etc
+  LIBIMG_INTER_BILINEAR    *= 1;
+  LIBIMG_INTER_DEFAULT     *= LIBIMG_INTER_BILINEAR;
+
+
+  // list of format id's
+  LIBIMG_FORMAT_BMP        *=  1;
+  LIBIMG_FORMAT_ICO        *=  2;
+  LIBIMG_FORMAT_CUR        *=  3;
+  LIBIMG_FORMAT_GIF        *=  4;
+  LIBIMG_FORMAT_PNG        *=  5;
+  LIBIMG_FORMAT_JPEG       *=  6;
+  LIBIMG_FORMAT_TGA        *=  7;
+  LIBIMG_FORMAT_PCX        *=  8;
+  LIBIMG_FORMAT_XCF        *=  9;
+  LIBIMG_FORMAT_TIFF       *= 10;
+  LIBIMG_FORMAT_PNM        *= 11;
+  LIBIMG_FORMAT_WBMP       *= 12;
+  LIBIMG_FORMAT_XBM        *= 13;
+  LIBIMG_FORMAT_Z80        *= 14;
+
+
+  // encode flags (byte 0x02 of common option)
+  LIBIMG_ENCODE_STRICT_SPECIFIC   *= 01H;
+  LIBIMG_ENCODE_STRICT_BIT_DEPTH  *= 02H;
+  LIBIMG_ENCODE_DELETE_ALPHA      *= 08H;
+  LIBIMG_ENCODE_FLUSH_ALPHA       *= 10H;
+
+
+  // values for Image.Type
+  // must be consecutive to allow fast switch on Image.Type in support functions
+  bpp8i  *=   1;  // indexed
+  bpp24  *=   2;
+  bpp32  *=   3;
+  bpp15  *=   4;
+  bpp16  *=   5;
+  bpp1   *=   6;
+  bpp8g  *=   7;  // grayscale
+  bpp2i  *=   8;
+  bpp4i  *=   9;
+  bpp8a  *=  10;  // grayscale with alpha channel; application layer only!!! kernel doesn't handle this image type, libimg can only create and destroy such images
+
+
+  // bits in Image.Flags
+  IsAnimated *= 1;
+
+
+TYPE
+
+  Image* = RECORD
+
+    Checksum  *: INTEGER;
+    Width     *: INTEGER;
+    Height    *: INTEGER;
+    Next      *: INTEGER;
+    Previous  *: INTEGER;
+    Type      *: INTEGER; // one of bppN
+    Data      *: INTEGER;
+    Palette   *: INTEGER; // used iff Type eq bpp1, bpp2, bpp4 or bpp8i
+    Extended  *: INTEGER;
+    Flags     *: INTEGER; // bitfield
+    Delay     *: INTEGER  // used iff IsAnimated is set in Flags
+
+  END;
+
+
+  ImageDecodeOptions* = RECORD
+
+    UsedSize         *: INTEGER; // if >=8, the field BackgroundColor is valid, and so on
+    BackgroundColor  *: INTEGER  // used for transparent images as background
+
+  END;
+
+
+  FormatsTableEntry* = RECORD
+
+    Format_id     *: INTEGER;
+    Is            *: INTEGER;
+    Decode        *: INTEGER;
+    Encode        *: INTEGER;
+    Capabilities  *: INTEGER
+
+  END;
+
+
+VAR
+
+    img_is_img         *: PROCEDURE (data, length: INTEGER): INTEGER;
+
+
+
+    img_to_rgb2        *: PROCEDURE (img: INTEGER; out: INTEGER);
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? decodes image data into RGB triplets and stores them where out points to                       ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to source image                                                                  ;;
+;> out = where to store RGB triplets                                                              ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_to_rgb         *: PROCEDURE (img: INTEGER): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? decodes image data into RGB triplets and returns pointer to memory area containing them        ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to source image                                                                  ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to rgb_data (array of [rgb] triplets)                                              ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_decode         *: PROCEDURE (data, length, options: INTEGER): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? decodes loaded into memory graphic file                                                        ;;
+;;------------------------------------------------------------------------------------------------;;
+;> data    = pointer to file in memory                                                            ;;
+;> length  = size in bytes of memory area pointed to by data                                      ;;
+;> options = 0 / pointer to the structure of additional options                                   ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to image                                                                           ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_encode         *: PROCEDURE (img: INTEGER; common, specific: INTEGER): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? encode image to some format                                                                    ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img      = pointer to input image                                                              ;;
+;> common   = some most important options                                                         ;;
+;     0x00 :  byte : format id                                                                    ;;
+;     0x01 :  byte : fast encoding (0) / best compression ratio (255)                             ;;
+;                    0 : store uncompressed data (if supported both by the format and libimg)     ;;
+;                    1 - 255 : use compression, if supported                                      ;;
+;                    this option may be ignored if any format specific options are defined        ;;
+;                    i.e. the 0 here will be ignored if some compression algorithm is specified   ;;
+;     0x02 :  byte : flags (bitfield)                                                             ;;
+;                   0x01 : return an error if format specific conditions cannot be met            ;;
+;                   0x02 : preserve current bit depth. means 8bpp/16bpp/24bpp and so on           ;;
+;                   0x04 : delete alpha channel, if any                                           ;;
+;                   0x08 : flush alpha channel with 0xff, if any; add it if none                  ;;
+;     0x03 :  byte : reserved, must be 0                                                          ;;
+;> specific = 0 / pointer to the structure of format specific options                             ;;
+;                   see <format_name>.inc for description                                         ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to encoded data                                                                    ;;
+;;================================================================================================;;
+  *)
+
+
+
+    img_create         *: PROCEDURE (width, height, _type: INTEGER): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? creates an Image structure and initializes some its fields                                     ;;
+;;------------------------------------------------------------------------------------------------;;
+;> width  = width of an image in pixels                                                           ;;
+;> height = height of an image in pixels                                                          ;;
+;> type   = one of the bppN constants                                                             ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to image                                                                           ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_destroy        *: PROCEDURE (img: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? frees memory occupied by an image and all the memory regions its fields point to               ;;
+;? follows Previous/Next pointers and deletes all the images in sequence                          ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE (fail) / TRUE (success)                                                                  ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_destroy_layer  *: PROCEDURE (img: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? frees memory occupied by an image and all the memory regions its fields point to               ;;
+;? for image sequences deletes only one frame and fixes Previous/Next pointers                    ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE (fail) / TRUE (success)                                                                  ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_count          *: PROCEDURE (img: INTEGER): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Get number of images in the list (e.g. in animated GIF file)                                   ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;;------------------------------------------------------------------------------------------------;;
+;< -1 (fail) / >0 (ok)                                                                            ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_flip           *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Flip all layers of image                                                                       ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;> flip_kind = one of FLIP_* constants                                                            ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE / TRUE                                                                                   ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_flip_layer     *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Flip image layer                                                                               ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;> flip_kind = one of FLIP_* constants                                                            ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE / TRUE                                                                                   ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_rotate         *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Rotate all layers of image                                                                     ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;> rotate_kind = one of ROTATE_* constants                                                        ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE / TRUE                                                                                   ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_rotate_layer   *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Rotate image layer                                                                             ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;> rotate_kind = one of ROTATE_* constants                                                        ;;
+;;------------------------------------------------------------------------------------------------;;
+;< FALSE / TRUE                                                                                   ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_draw           *: PROCEDURE (img: INTEGER; x, y, width, height, xpos, ypos: INTEGER);
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? Draw image in the window                                                                       ;;
+;;------------------------------------------------------------------------------------------------;;
+;> img = pointer to image                                                                         ;;
+;> x = x-coordinate in the window                                                                 ;;
+;> y = y-coordinate in the window                                                                 ;;
+;> width = maximum width to draw                                                                  ;;
+;> height = maximum height to draw                                                                ;;
+;> xpos = offset in image by x-axis                                                               ;;
+;> ypos = offset in image by y-axis                                                               ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_scale          *: PROCEDURE (src: INTEGER; crop_x, crop_y, crop_width, crop_height: INTEGER; dst: INTEGER; scale, inter, param1, param2: INTEGER ): INTEGER;
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? scale _image                                                                                   ;;
+;;------------------------------------------------------------------------------------------------;;
+;> src         = pointer to source image                                                          ;;
+;> crop_x      = left coord of cropping rect                                                      ;;
+;> crop_y      = top coord of cropping rect                                                       ;;
+;> crop_width  = width of cropping rect                                                           ;;
+;> crop_height = height of cropping rect                                                          ;;
+;> dst         = pointer to resulting image / 0                                                   ;;
+;> scale       = how to change width and height. see libimg.inc                                   ;;
+;> inter       = interpolation algorithm                                                          ;;
+;> param1      = see libimg.inc                                                                   ;;
+;> param2      = see libimg.inc                                                                   ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to scaled image                                                                    ;;
+;;================================================================================================;;
+*)
+
+
+
+    img_convert        *: PROCEDURE (src, dst: INTEGER; dst_type, flags, param: INTEGER);
+(*
+;;------------------------------------------------------------------------------------------------;;
+;? scale _image                                                                                   ;;
+;;------------------------------------------------------------------------------------------------;;
+;> src      = pointer to source image                                                             ;;
+;> flags    = see libimg.inc                                                                      ;;
+;> dst_type = the Image.Type of converted image                                                   ;;
+;> dst      = pointer to destination image, if any                                                ;;
+;;------------------------------------------------------------------------------------------------;;
+;< 0 / pointer to converted image                                                                 ;;
+;;================================================================================================;;
+*)
+
+
+    img_formats_table  *: ARRAY 20 OF FormatsTableEntry;
+
+
+
+PROCEDURE GetImageStruct* (img: INTEGER; VAR ImageStruct: Image): BOOLEAN;
+BEGIN
+  IF img # 0 THEN
+    sys.MOVE(img, sys.ADR(ImageStruct), sys.SIZE(Image))
+  END
+  RETURN img # 0
+END GetImageStruct;
+
+
+PROCEDURE GetFormatsTable(ptr: INTEGER);
+VAR i: INTEGER; eot: BOOLEAN;
+BEGIN
+  i := 0;
+  REPEAT
+    sys.MOVE(ptr, sys.ADR(img_formats_table[i]), sys.SIZE(FormatsTableEntry));
+    ptr := ptr + sys.SIZE(FormatsTableEntry);
+    eot := img_formats_table[i].Format_id = 0;
+    INC(i)
+  UNTIL eot OR (i = LEN(img_formats_table))
+END GetFormatsTable;
+
+
+PROCEDURE main;
+VAR Lib, formats_table_ptr: INTEGER;
+
+  PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR);
+  VAR a: INTEGER;
+  BEGIN
+    a := KOSAPI.GetProcAdr(name, Lib);
+    ASSERT(a # 0);
+    sys.PUT(v, a)
+  END GetProc;
+
+BEGIN
+  Lib := KOSAPI.LoadLib("/sys/lib/libimg.obj");
+  ASSERT(Lib # 0);
+  GetProc(Lib, sys.ADR(img_is_img)        , "img_is_img");
+  GetProc(Lib, sys.ADR(img_to_rgb)        , "img_to_rgb");
+  GetProc(Lib, sys.ADR(img_to_rgb2)       , "img_to_rgb2");
+  GetProc(Lib, sys.ADR(img_decode)        , "img_decode");
+  GetProc(Lib, sys.ADR(img_encode)        , "img_encode");
+  GetProc(Lib, sys.ADR(img_create)        , "img_create");
+  GetProc(Lib, sys.ADR(img_destroy)       , "img_destroy");
+  GetProc(Lib, sys.ADR(img_destroy_layer) , "img_destroy_layer");
+  GetProc(Lib, sys.ADR(img_count)         , "img_count");
+  GetProc(Lib, sys.ADR(img_flip)          , "img_flip");
+  GetProc(Lib, sys.ADR(img_flip_layer)    , "img_flip_layer");
+  GetProc(Lib, sys.ADR(img_rotate)        , "img_rotate");
+  GetProc(Lib, sys.ADR(img_rotate_layer)  , "img_rotate_layer");
+  GetProc(Lib, sys.ADR(img_draw)          , "img_draw");
+  GetProc(Lib, sys.ADR(img_scale)         , "img_scale");
+  GetProc(Lib, sys.ADR(img_convert)       , "img_convert");
+  GetProc(Lib, sys.ADR(formats_table_ptr) , "img_formats_table");
+  GetFormatsTable(formats_table_ptr)
+END main;
+
+
+BEGIN
+  main
+END libimg.

+ 124 - 0
lib/Linux/API.ob07

@@ -0,0 +1,124 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE API;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    OS* = "LINUX";
+    eol* = 0AX;
+
+    BIT_DEPTH* = (ORD(LSL(1, 31) > 0) + 1) * 32;
+
+    RTLD_LAZY = 1;
+
+
+TYPE
+
+    SOFINI = PROCEDURE;
+
+
+VAR
+
+    MainParam*, libc*: INTEGER;
+
+    dlopen*       : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER;
+    dlsym*        : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER;
+
+    exit*,
+    exit_thread*  : PROCEDURE [linux] (code: INTEGER);
+    puts          : PROCEDURE [linux] (pStr: INTEGER);
+    malloc        : PROCEDURE [linux] (size: INTEGER): INTEGER;
+    free          : PROCEDURE [linux] (ptr: INTEGER);
+
+    fini: SOFINI;
+
+
+PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
+BEGIN
+    puts(lpCaption);
+    puts(lpText)
+END DebugMsg;
+
+
+PROCEDURE _NEW* (size: INTEGER): INTEGER;
+VAR
+    res, ptr, words: INTEGER;
+
+BEGIN
+    res := malloc(size);
+    IF res # 0 THEN
+        ptr := res;
+        words := size DIV SYSTEM.SIZE(INTEGER);
+        WHILE words > 0 DO
+            SYSTEM.PUT(ptr, 0);
+            INC(ptr, SYSTEM.SIZE(INTEGER));
+            DEC(words)
+        END
+    END
+
+    RETURN res
+END _NEW;
+
+
+PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
+BEGIN
+    free(p)
+    RETURN 0
+END _DISPOSE;
+
+
+PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
+VAR
+    sym: INTEGER;
+
+BEGIN
+    sym := dlsym(lib, SYSTEM.ADR(name[0]));
+    ASSERT(sym # 0);
+    SYSTEM.PUT(VarAdr, sym)
+END GetSym;
+
+
+PROCEDURE init* (sp, code: INTEGER);
+BEGIN
+    fini := NIL;
+    SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
+    SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER),     dlsym);
+    MainParam := sp;
+
+    libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
+    GetSym(libc, "exit", SYSTEM.ADR(exit_thread));
+    exit := exit_thread;
+    GetSym(libc, "puts", SYSTEM.ADR(puts));
+    GetSym(libc, "malloc", SYSTEM.ADR(malloc));
+    GetSym(libc, "free", SYSTEM.ADR(free));
+END init;
+
+
+PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN 0
+END dllentry;
+
+
+PROCEDURE sofinit*;
+BEGIN
+    IF fini # NIL THEN
+        fini
+    END
+END sofinit;
+
+
+PROCEDURE SetFini* (ProcFini: SOFINI);
+BEGIN
+    fini := ProcFini
+END SetFini;
+
+
+END API.

+ 70 - 0
lib/Linux/Args.ob07

@@ -0,0 +1,70 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Args;
+
+IMPORT SYSTEM, API;
+
+
+VAR
+
+    argc*, envc*: INTEGER;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    i, len, ptr: INTEGER;
+    c: CHAR;
+
+BEGIN
+    i := 0;
+    len := LEN(s) - 1;
+    IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN
+        SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
+        REPEAT
+            SYSTEM.GET(ptr, c);
+            s[i] := c;
+            INC(i);
+            INC(ptr)
+        UNTIL (c = 0X) OR (i = len)
+    END;
+    s[i] := 0X
+END GetArg;
+
+
+PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR);
+BEGIN
+    IF (0 <= n) & (n < envc) THEN
+        GetArg(n + argc + 1, s)
+    ELSE
+        s[0] := 0X
+    END
+END GetEnv;
+
+
+PROCEDURE init;
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    IF API.MainParam # 0 THEN
+        envc := -1;
+        SYSTEM.GET(API.MainParam, argc);
+        REPEAT
+            SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr);
+            INC(envc)
+        UNTIL ptr = 0
+    ELSE
+        envc := 0;
+        argc := 0
+    END
+END init;
+
+
+BEGIN
+    init
+END Args.

+ 130 - 0
lib/Linux/File.ob07

@@ -0,0 +1,130 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE File;
+
+IMPORT SYSTEM, Libdl, API;
+
+
+CONST
+
+    OPEN_R* = "rb";  OPEN_W* = "wb";  OPEN_RW* = "r+b";
+    SEEK_BEG* = 0;   SEEK_CUR* = 1;   SEEK_END* = 2;
+
+
+VAR
+
+    fwrite,
+    fread     : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
+    fseek     : PROCEDURE [linux] (file, offset, origin: INTEGER): INTEGER;
+    ftell     : PROCEDURE [linux] (file: INTEGER): INTEGER;
+    fopen     : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
+    fclose    : PROCEDURE [linux] (file: INTEGER): INTEGER;
+    remove    : PROCEDURE [linux] (fname: INTEGER): INTEGER;
+
+
+PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
+VAR
+    sym: INTEGER;
+
+BEGIN
+    sym := Libdl.sym(lib, name);
+    ASSERT(sym # 0);
+    SYSTEM.PUT(VarAdr, sym)
+END GetSym;
+
+
+PROCEDURE init;
+VAR
+    libc: INTEGER;
+
+BEGIN
+    libc := API.libc;
+    GetSym(libc, "fread",  SYSTEM.ADR(fread));
+    GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
+    GetSym(libc, "fseek",  SYSTEM.ADR(fseek));
+    GetSym(libc, "ftell",  SYSTEM.ADR(ftell));
+    GetSym(libc, "fopen",  SYSTEM.ADR(fopen));
+    GetSym(libc, "fclose", SYSTEM.ADR(fclose));
+    GetSym(libc, "remove", SYSTEM.ADR(remove));
+END init;
+
+
+PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
+    RETURN remove(SYSTEM.ADR(FName[0])) = 0
+END Delete;
+
+
+PROCEDURE Close* (F: INTEGER);
+BEGIN
+    F := fclose(F)
+END Close;
+
+
+PROCEDURE Open* (FName, Mode: ARRAY OF CHAR): INTEGER;
+    RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.ADR(Mode[0]))
+END Open;
+
+
+PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN Open(FName, OPEN_W)
+END Create;
+
+
+PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF fseek(F, Offset, Origin) = 0 THEN
+        res := ftell(F)
+    ELSE
+        res := -1
+    END
+
+    RETURN res
+END Seek;
+
+
+PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
+    RETURN fwrite(Buffer, 1, Count, F)
+END Write;
+
+
+PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
+    RETURN fread(Buffer, 1, Count, F)
+END Read;
+
+
+PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
+VAR
+    res, n, F: INTEGER;
+
+BEGIN
+    res := 0;
+    F := Open(FName, OPEN_R);
+
+    IF F > 0 THEN
+        Size := Seek(F, 0, SEEK_END);
+        n    := Seek(F, 0, SEEK_BEG);
+        res  := API._NEW(Size);
+        IF (res = 0) OR (Read(F, res, Size) # Size) THEN
+            IF res # 0 THEN
+                res := API._DISPOSE(res);
+                Size := 0
+            END
+        END;
+        Close(F)
+    END
+
+    RETURN res
+END Load;
+
+
+BEGIN
+    init
+END File.

+ 255 - 0
lib/Linux/HOST.ob07

@@ -0,0 +1,255 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    slash* = "/";
+    eol* = 0AX;
+
+    bit_depth* = (ORD(LSL(1, 31) > 0) + 1) * 32;
+    maxint* = ROR(-2, 1);
+    minint* = ROR(1, 1);
+
+    RTLD_LAZY = 1;
+
+
+TYPE
+
+    TP = ARRAY 2 OF INTEGER;
+
+
+VAR
+
+    maxreal*, inf*: REAL;
+
+    argc: INTEGER;
+
+    libc, librt: INTEGER;
+
+    stdout: INTEGER;
+
+    fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
+    fopen         : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
+    fclose        : PROCEDURE [linux] (file: INTEGER): INTEGER;
+    _chmod        : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER;
+    time          : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
+    clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
+    exit          : PROCEDURE [linux] (code: INTEGER);
+    getcwd        : PROCEDURE [linux] (dir, len: INTEGER): INTEGER;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+    exit(code)
+END ExitProcess;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    i, len, ptr: INTEGER;
+    c: CHAR;
+
+BEGIN
+    i := 0;
+    len := LEN(s) - 1;
+    IF (n < argc) & (len > 0) THEN
+        SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr);
+        REPEAT
+            SYSTEM.GET(ptr, c);
+            s[i] := c;
+            INC(i);
+            INC(ptr)
+        UNTIL (c = 0X) OR (i = len)
+    END;
+    s[i] := 0X
+END GetArg;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+    n: INTEGER;
+
+BEGIN
+    n := getcwd(SYSTEM.ADR(path[0]), LEN(path) - 2);
+    n := LENGTH(path);
+    path[n] := slash;
+    path[n + 1] := 0X
+END GetCurrentDirectory;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
+    IF res <= 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F);
+    IF res <= 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb"))
+END FileCreate;
+
+
+PROCEDURE FileClose* (File: INTEGER);
+BEGIN
+    File := fclose(File)
+END FileClose;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+VAR
+    res: INTEGER;
+BEGIN
+    res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *)
+END chmod;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb"))
+END FileOpen;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+    res: INTEGER;
+
+BEGIN
+    res := fwrite(SYSTEM.ADR(c), 1, 1, stdout)
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+VAR
+    tp:  TP;
+    res: INTEGER;
+
+BEGIN
+    IF clock_gettime(0, tp) = 0 THEN
+        res := tp[0] * 100 + tp[1] DIV 10000000
+    ELSE
+        res := 0
+    END
+
+    RETURN res
+END GetTickCount;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+    RETURN path[0] # slash
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+    RETURN time(0)
+END UnixTime;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    a := 0;
+    b := 0;
+    SYSTEM.GET32(SYSTEM.ADR(x), a);
+    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
+    SYSTEM.GET(SYSTEM.ADR(x), res)
+    RETURN res
+END splitf;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+    h, l, s, e: INTEGER;
+
+BEGIN
+    e := splitf(x, l, h);
+
+    s := ASR(h, 31) MOD 2;
+    e := (h DIV 100000H) MOD 2048;
+    IF e <= 896 THEN
+        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
+        REPEAT
+            h := h DIV 2;
+            INC(e)
+        UNTIL e = 897;
+        e := 896;
+        l := (h MOD 8) * 20000000H;
+        h := h DIV 8
+    ELSIF (1151 <= e) & (e < 2047) THEN
+        e := 1151;
+        h := 0;
+        l := 0
+    ELSIF e = 2047 THEN
+        e := 1151;
+        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
+            h := 80000H;
+            l := 0
+        END
+    END;
+    DEC(e, 896)
+
+    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
+END d2s;
+
+
+PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
+VAR
+    sym: INTEGER;
+
+BEGIN
+    sym := API.dlsym(lib, SYSTEM.ADR(name[0]));
+    ASSERT(sym # 0);
+    SYSTEM.PUT(VarAdr, sym)
+END GetSym;
+
+
+BEGIN
+    inf := SYSTEM.INF();
+    maxreal := 1.9;
+    PACK(maxreal, 1023);
+    SYSTEM.GET(API.MainParam, argc);
+
+    libc := API.libc;
+    GetSym(libc, "fread",  SYSTEM.ADR(fread));
+    GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
+    GetSym(libc, "fopen",  SYSTEM.ADR(fopen));
+    GetSym(libc, "fclose", SYSTEM.ADR(fclose));
+    GetSym(libc, "chmod",  SYSTEM.ADR(_chmod));
+    GetSym(libc, "time",   SYSTEM.ADR(time));
+    GetSym(libc, "exit",   SYSTEM.ADR(exit));
+    GetSym(libc, "getcwd", SYSTEM.ADR(getcwd));
+    GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout, stdout);
+
+    librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY);
+    GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
+END HOST.

+ 81 - 0
lib/Linux/In.ob07

@@ -0,0 +1,81 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE In;
+
+IMPORT SYSTEM, Libdl, LINAPI, API;
+
+
+CONST
+
+    MAX_LEN = 10240;
+    bit_depth = API.BIT_DEPTH;
+
+
+VAR
+
+    Done*: BOOLEAN;
+    s: ARRAY MAX_LEN OF CHAR;
+    fmt: ARRAY 8 OF CHAR;
+
+    sscanf: PROCEDURE [linux] (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
+    fgets:  PROCEDURE [linux-] (string: INTEGER; num: INTEGER; filestream: INTEGER): INTEGER;
+
+
+PROCEDURE String* (VAR str: ARRAY OF CHAR);
+BEGIN
+    fgets(SYSTEM.ADR(s[0]), LEN(s), LINAPI.stdin);
+    COPY(s, str);
+    str[LEN(str) - 1] := 0X;
+    Done := TRUE
+END String;
+
+
+PROCEDURE Int* (VAR x: INTEGER);
+BEGIN
+    String(s);
+    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.ADR(fmt[0]), SYSTEM.ADR(x)) = 1
+END Int;
+
+
+PROCEDURE Real* (VAR x: REAL);
+BEGIN
+    String(s);
+    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
+END Real;
+
+
+PROCEDURE Char* (VAR x: CHAR);
+BEGIN
+    String(s);
+    x := s[0]
+END Char;
+
+
+PROCEDURE Ln*;
+BEGIN
+    String(s)
+END Ln;
+
+
+PROCEDURE Open*;
+BEGIN
+    Done := TRUE
+END Open;
+
+
+BEGIN
+    IF bit_depth = 32 THEN
+        fmt := "%d"
+    ELSE
+        fmt := "%lld"
+    END;
+    SYSTEM.PUT(SYSTEM.ADR(sscanf), Libdl.sym(API.libc, "sscanf"));
+    ASSERT(sscanf # NIL);
+    SYSTEM.PUT(SYSTEM.ADR(fgets), Libdl.sym(API.libc, "fgets"));
+    ASSERT(fgets # NIL);
+END In.

+ 127 - 0
lib/Linux/LINAPI.ob07

@@ -0,0 +1,127 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE LINAPI;
+
+IMPORT SYSTEM, API, Libdl;
+
+
+TYPE
+
+    TP* = ARRAY 2 OF INTEGER;
+    SOFINI* = PROCEDURE;
+
+
+VAR
+
+    libc*, librt*: INTEGER;
+
+    stdout*,
+    stdin*,
+    stderr*        : INTEGER;
+
+    malloc*        : PROCEDURE [linux] (size: INTEGER): INTEGER;
+    free*          : PROCEDURE [linux] (ptr: INTEGER);
+    exit*          : PROCEDURE [linux] (code: INTEGER);
+    puts*          : PROCEDURE [linux] (pStr: INTEGER);
+    fwrite*,
+    fread*         : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER;
+    fopen*         : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER;
+    fclose*        : PROCEDURE [linux] (file: INTEGER): INTEGER;
+    time*          : PROCEDURE [linux] (ptr: INTEGER): INTEGER;
+
+    clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER;
+
+
+PROCEDURE SetFini* (ProcFini: SOFINI);
+BEGIN
+    API.SetFini(ProcFini)
+END SetFini;
+
+
+PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER);
+VAR
+    sym: INTEGER;
+
+BEGIN
+    sym := Libdl.sym(lib, name);
+    ASSERT(sym # 0);
+    SYSTEM.PUT(VarAdr, sym)
+END GetSym;
+
+
+PROCEDURE init;
+BEGIN
+    libc := API.libc;
+
+    GetSym(libc, "exit",   SYSTEM.ADR(exit));
+    GetSym(libc, "puts",   SYSTEM.ADR(puts));
+    GetSym(libc, "malloc", SYSTEM.ADR(malloc));
+    GetSym(libc, "free",   SYSTEM.ADR(free));
+    GetSym(libc, "fread",  SYSTEM.ADR(fread));
+    GetSym(libc, "fwrite", SYSTEM.ADR(fwrite));
+    GetSym(libc, "fopen",  SYSTEM.ADR(fopen));
+    GetSym(libc, "fclose", SYSTEM.ADR(fclose));
+    GetSym(libc, "time",   SYSTEM.ADR(time));
+
+    GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout, stdout);
+    GetSym(libc, "stdin",  SYSTEM.ADR(stdin));  SYSTEM.GET(stdin,  stdin);
+    GetSym(libc, "stderr", SYSTEM.ADR(stderr)); SYSTEM.GET(stderr, stderr);
+
+    librt := Libdl.open("librt.so.1", Libdl.LAZY);
+
+    GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime))
+END init;
+
+
+$IF (CPU_X86)
+PROCEDURE [oberon-] syscall* (eax, ebx, ecx, edx, esi, edi: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    053H,               (*  push    ebx                    *)
+    056H,               (*  push    esi                    *)
+    057H,               (*  push    edi                    *)
+    08BH, 045H, 008H,   (*  mov     eax, dword [ebp +  8]  *)
+    08BH, 05DH, 00CH,   (*  mov     ebx, dword [ebp + 12]  *)
+    08BH, 04DH, 010H,   (*  mov     ecx, dword [ebp + 16]  *)
+    08BH, 055H, 014H,   (*  mov     edx, dword [ebp + 20]  *)
+    08BH, 075H, 018H,   (*  mov     esi, dword [ebp + 24]  *)
+    08BH, 07DH, 01CH,   (*  mov     edi, dword [ebp + 28]  *)
+    0CDH, 080H,         (*  int     128                    *)
+    05FH,               (*  pop     edi                    *)
+    05EH,               (*  pop     esi                    *)
+    05BH,               (*  pop     ebx                    *)
+    05DH,               (*  pop     ebp                    *)
+    0C2H, 018H, 000H    (*  ret     24                     *)
+    )
+    RETURN 0
+END syscall;
+
+
+$ELSIF (CPU_X8664)
+PROCEDURE [oberon-] syscall* (rax, rdi, rsi, rdx, r10, r8, r9: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 010H,  (*  mov rax, qword [rbp + 16]  *)
+    048H, 08BH, 07DH, 018H,  (*  mov rdi, qword [rbp + 24]  *)
+    048H, 08BH, 075H, 020H,  (*  mov rsi, qword [rbp + 32]  *)
+    048H, 08BH, 055H, 028H,  (*  mov rdx, qword [rbp + 40]  *)
+    04CH, 08BH, 055H, 030H,  (*  mov r10, qword [rbp + 48]  *)
+    04CH, 08BH, 045H, 038H,  (*  mov r8,  qword [rbp + 56]  *)
+    04CH, 08BH, 04DH, 040H,  (*  mov r9,  qword [rbp + 64]  *)
+    00FH, 005H,              (*  syscall                    *)
+    05DH,                    (*  pop rbp                    *)
+    0C2H, 038H, 000H         (*  ret 56                     *)
+    )
+    RETURN 0
+END syscall;
+$END
+
+
+BEGIN
+    init
+END LINAPI.

+ 65 - 0
lib/Linux/Libdl.ob07

@@ -0,0 +1,65 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Libdl;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    LAZY*         = 1;
+    NOW*          = 2;
+    BINDING_MASK* = 3;
+    NOLOAD*       = 4;
+    LOCAL*        = 0;
+    GLOBAL*       = 256;
+    NODELETE*     = 4096;
+
+
+VAR
+
+    _close: PROCEDURE [linux] (handle: INTEGER): INTEGER;
+    _error: PROCEDURE [linux] (): INTEGER;
+
+
+PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER;
+    RETURN API.dlopen(SYSTEM.ADR(file[0]), mode)
+END open;
+
+
+PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER;
+    RETURN API.dlsym(handle, SYSTEM.ADR(name[0]))
+END sym;
+
+
+PROCEDURE close* (handle: INTEGER): INTEGER;
+    RETURN _close(handle)
+END close;
+
+
+PROCEDURE error* (): INTEGER;
+    RETURN _error()
+END error;
+
+
+PROCEDURE init;
+VAR
+    lib: INTEGER;
+
+BEGIN
+    lib := open("libdl.so.2", LAZY);
+    SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose"));
+    ASSERT(_close # NIL);
+    SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror"));
+    ASSERT(_error # NIL)
+END init;
+
+
+BEGIN
+    init
+END Libdl.

+ 493 - 0
lib/Linux/Math.ob07

@@ -0,0 +1,493 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Math;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    pi* = 3.1415926535897932384626433832795028841972E0;
+    e*  = 2.7182818284590452353602874713526624977572E0;
+
+    ZERO      = 0.0E0;
+    ONE       = 1.0E0;
+    HALF      = 0.5E0;
+    TWO       = 2.0E0;
+    sqrtHalf  = 0.70710678118654752440E0;
+    eps       = 5.5511151E-17;
+    ln2Inv    = 1.44269504088896340735992468100189213E0;
+    piInv     = ONE / pi;
+    Limit     = 1.0536712E-8;
+    piByTwo   = pi / TWO;
+
+    expoMax   = 1023;
+    expoMin   = 1 - expoMax;
+
+
+VAR
+
+    LnInfinity, LnSmall, large, miny: REAL;
+
+
+PROCEDURE [oberon] sqrt* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= ZERO);
+
+    $IF (CPU_X8664)
+
+    SYSTEM.CODE(
+    0F2H, 0FH, 51H, 45H, 10H,  (*  sqrtsd  xmm0, qword[rbp + 10h]  *)
+    05DH,                      (*  pop     rbp                     *)
+    0C2H, 08H, 00H             (*  ret     8                       *)
+    )
+
+    $ELSIF (CPU_X86)
+
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,          (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FAH,                (*  fsqrt                      *)
+    05DH,                      (*  pop     ebp                *)
+    0C2H, 008H, 000H           (*  ret     8                  *)
+    )
+
+    $END
+
+    RETURN 0.0
+END sqrt;
+
+
+PROCEDURE sqri* (x: INTEGER): INTEGER;
+    RETURN x * x
+END sqri;
+
+
+PROCEDURE sqrr* (x: REAL): REAL;
+    RETURN x * x
+END sqrr;
+
+
+PROCEDURE exp* (x: REAL): REAL;
+CONST
+    c1 =  0.693359375E0;
+    c2 = -2.1219444005469058277E-4;
+    P0 =  0.249999999999999993E+0;
+    P1 =  0.694360001511792852E-2;
+    P2 =  0.165203300268279130E-4;
+    Q1 =  0.555538666969001188E-1;
+    Q2 =  0.495862884905441294E-3;
+
+VAR
+    xn, g, p, q, z: REAL;
+    n: INTEGER;
+
+BEGIN
+    IF x > LnInfinity THEN
+        x := SYSTEM.INF()
+    ELSIF x < LnSmall THEN
+        x := ZERO
+    ELSIF ABS(x) < eps THEN
+        x := ONE
+    ELSE
+        IF x >= ZERO THEN
+            n := FLOOR(ln2Inv * x + HALF)
+        ELSE
+            n := FLOOR(ln2Inv * x - HALF)
+        END;
+
+        xn := FLT(n);
+        g  := (x - xn * c1) - xn * c2;
+        z  := g * g;
+        p  := ((P2 * z + P1) * z + P0) * g;
+        q  := (Q2 * z + Q1) * z + HALF;
+        x  := HALF + p / (q - p);
+        PACK(x, n + 1)
+    END
+
+    RETURN x
+END exp;
+
+
+PROCEDURE ln* (x: REAL): REAL;
+CONST
+    c1 =  355.0E0 / 512.0E0;
+    c2 = -2.121944400546905827679E-4;
+    P0 = -0.64124943423745581147E+2;
+    P1 =  0.16383943563021534222E+2;
+    P2 = -0.78956112887491257267E+0;
+    Q0 = -0.76949932108494879777E+3;
+    Q1 =  0.31203222091924532844E+3;
+    Q2 = -0.35667977739034646171E+2;
+
+VAR
+    zn, zd, r, z, w, p, q, xn: REAL;
+    n: INTEGER;
+
+BEGIN
+    ASSERT(x > ZERO);
+
+    UNPK(x, n);
+    x := x * HALF;
+
+    IF x > sqrtHalf THEN
+        zn := x - ONE;
+        zd := x * HALF + HALF;
+        INC(n)
+    ELSE
+        zn := x - HALF;
+        zd := zn * HALF + HALF
+    END;
+
+    z  := zn / zd;
+    w  := z * z;
+    q  := ((w + Q2) * w + Q1) * w + Q0;
+    p  := w * ((P2 * w + P1) * w + P0);
+    r  := z + z * (p / q);
+    xn := FLT(n)
+
+    RETURN (xn * c2 + r) + xn * c1
+END ln;
+
+
+PROCEDURE power* (base, exponent: REAL): REAL;
+BEGIN
+    ASSERT(base > ZERO)
+    RETURN exp(exponent * ln(base))
+END power;
+
+
+PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := 1.0;
+
+    IF base # 0.0 THEN
+        IF exponent # 0 THEN
+            IF exponent < 0 THEN
+                base := 1.0 / base
+            END;
+            i := ABS(exponent);
+            WHILE i > 0 DO
+                WHILE ~ODD(i) DO
+                    i := LSR(i, 1);
+                    base := sqrr(base)
+                END;
+                DEC(i);
+                a := a * base
+            END
+        ELSE
+            a := 1.0
+        END
+    ELSE
+        ASSERT(exponent > 0);
+        a := 0.0
+    END
+
+    RETURN a
+END ipower;
+
+
+PROCEDURE log* (base, x: REAL): REAL;
+BEGIN
+    ASSERT(base > ZERO);
+    ASSERT(x > ZERO)
+    RETURN ln(x) / ln(base)
+END log;
+
+
+PROCEDURE SinCos (x, y, sign: REAL): REAL;
+CONST
+    ymax =  210828714;
+    c1   =  3.1416015625E0;
+    c2   = -8.908910206761537356617E-6;
+    r1   = -0.16666666666666665052E+0;
+    r2   =  0.83333333333331650314E-2;
+    r3   = -0.19841269841201840457E-3;
+    r4   =  0.27557319210152756119E-5;
+    r5   = -0.25052106798274584544E-7;
+    r6   =  0.16058936490371589114E-9;
+    r7   = -0.76429178068910467734E-12;
+    r8   =  0.27204790957888846175E-14;
+
+VAR
+    n: INTEGER;
+    xn, f, x1, g: REAL;
+
+BEGIN
+    ASSERT(y < FLT(ymax));
+
+    n := FLOOR(y * piInv + HALF);
+    xn := FLT(n);
+    IF ODD(n) THEN
+        sign := -sign
+    END;
+    x := ABS(x);
+    IF x # y THEN
+        xn := xn - HALF
+    END;
+
+    x1 := FLT(FLOOR(x));
+    f  := ((x1 - xn * c1) + (x - x1)) - xn * c2;
+
+    IF ABS(f) < Limit THEN
+        x := sign * f
+    ELSE
+        g := f * f;
+        g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g;
+        g := f + f * g;
+        x := sign * g
+    END
+
+    RETURN x
+END SinCos;
+
+
+PROCEDURE sin* (x: REAL): REAL;
+BEGIN
+    IF x < ZERO THEN
+        x := SinCos(x, -x, -ONE)
+    ELSE
+        x := SinCos(x, x, ONE)
+    END
+
+    RETURN x
+END sin;
+
+
+PROCEDURE cos* (x: REAL): REAL;
+    RETURN SinCos(x, ABS(x) + piByTwo, ONE)
+END cos;
+
+
+PROCEDURE tan* (x: REAL): REAL;
+VAR
+    s, c: REAL;
+
+BEGIN
+    s := sin(x);
+    c := sqrt(ONE - s * s);
+    x := ABS(x) / (TWO * pi);
+    x := x - FLT(FLOOR(x));
+    IF (0.25 < x) & (x < 0.75) THEN
+        c := -c
+    END
+
+    RETURN s / c
+END tan;
+
+
+PROCEDURE arctan2* (y, x: REAL): REAL;
+CONST
+    P0 = 0.216062307897242551884E+3;  P1 = 0.3226620700132512059245E+3;
+    P2 = 0.13270239816397674701E+3;   P3 = 0.1288838303415727934E+2;
+    Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3;
+    Q2 = 0.221050883028417680623E+3;  Q3 = 0.3850148650835119501E+2;
+    Sqrt3 = 1.7320508075688772935E0;
+
+VAR
+    atan, z, z2, p, q: REAL;
+    yExp, xExp, Quadrant: INTEGER;
+
+BEGIN
+    IF ABS(x) < miny THEN
+        ASSERT(ABS(y) >= miny);
+        atan := piByTwo
+    ELSE
+        z := y;
+        UNPK(z, yExp);
+        z := x;
+        UNPK(z, xExp);
+
+        IF yExp - xExp >= expoMax - 3 THEN
+            atan := piByTwo
+        ELSIF yExp - xExp < expoMin + 3 THEN
+            atan := ZERO
+        ELSE
+            IF ABS(y) > ABS(x) THEN
+                z := ABS(x / y);
+                Quadrant := 2
+            ELSE
+                z := ABS(y / x);
+                Quadrant := 0
+            END;
+
+            IF z > TWO - Sqrt3 THEN
+                z := (z * Sqrt3 - ONE) / (Sqrt3 + z);
+                INC(Quadrant)
+            END;
+
+            IF ABS(z) < Limit THEN
+                atan := z
+            ELSE
+                z2 := z * z;
+                p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z;
+                q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0;
+                atan := p / q
+            END;
+
+            CASE Quadrant OF
+            |0:
+            |1: atan := atan + pi / 6.0
+            |2: atan := piByTwo - atan
+            |3: atan := pi / 3.0 - atan
+            END
+        END;
+
+        IF x < ZERO THEN
+            atan := pi - atan
+        END
+    END;
+
+    IF y < ZERO THEN
+        atan := -atan
+    END
+
+    RETURN atan
+END arctan2;
+
+
+PROCEDURE arcsin* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= ONE)
+    RETURN arctan2(x, sqrt(ONE - x * x))
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= ONE)
+    RETURN arctan2(sqrt(ONE - x * x), x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arctan2(x, ONE)
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - ONE / x) * HALF
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + ONE / x) * HALF
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := ONE
+    ELSIF x < -15.0 THEN
+        x := -ONE
+    ELSE
+        x := ONE - TWO / (exp(TWO * x) + ONE)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + ONE))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= ONE)
+    RETURN ln(x + sqrt(x * x - ONE))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) < ONE)
+    RETURN HALF * ln((ONE + x) / (ONE - x))
+END artanh;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > ZERO THEN
+        res := 1
+    ELSIF x < ZERO THEN
+        res := -1
+    ELSE
+        res := 0
+    END
+
+    RETURN res
+END sgn;
+
+
+PROCEDURE fact* (n: INTEGER): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    res := ONE;
+    WHILE n > 1 DO
+        res := res * FLT(n);
+        DEC(n)
+    END
+
+    RETURN res
+END fact;
+
+
+PROCEDURE DegToRad* (x: REAL): REAL;
+    RETURN x * (pi / 180.0)
+END DegToRad;
+
+
+PROCEDURE RadToDeg* (x: REAL): REAL;
+    RETURN x * (180.0 / pi)
+END RadToDeg;
+
+
+(* Return hypotenuse of triangle *)
+PROCEDURE hypot* (x, y: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    x := ABS(x);
+    y := ABS(y);
+    IF x > y THEN
+        a := x * sqrt(1.0 + sqrr(y / x))
+    ELSE
+        IF x > 0.0 THEN
+            a := y * sqrt(1.0 + sqrr(x / y))
+        ELSE
+            a := y
+        END
+    END
+
+    RETURN a
+END hypot;
+
+
+BEGIN
+    large := 1.9;
+    PACK(large, expoMax);
+    miny := ONE / large;
+    LnInfinity := ln(large);
+    LnSmall    := ln(miny);
+END Math.

+ 451 - 0
lib/Linux/Math_x86.ob07

@@ -0,0 +1,451 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2013-2014, 2018-2022 Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Math_x86;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    pi* = 3.141592653589793;
+    e*  = 2.718281828459045;
+
+
+PROCEDURE IsNan* (x: REAL): BOOLEAN;
+VAR
+    h, l: SET;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), l);
+    SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
+    RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+
+PROCEDURE IsInf* (x: REAL): BOOLEAN;
+    RETURN ABS(x) = SYSTEM.INF()
+END IsInf;
+
+
+PROCEDURE Max (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a > b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Max;
+
+
+PROCEDURE Min (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a < b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Min;
+
+
+PROCEDURE SameValue (a, b: REAL): BOOLEAN;
+VAR
+    eps: REAL;
+    res: BOOLEAN;
+
+BEGIN
+    eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
+    IF a > b THEN
+        res := (a - b) <= eps
+    ELSE
+        res := (b - a) <= eps
+    END
+    RETURN res
+END SameValue;
+
+
+PROCEDURE IsZero (x: REAL): BOOLEAN;
+    RETURN ABS(x) <= 1.0E-12
+END IsZero;
+
+
+PROCEDURE [oberon] sqrt* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FAH,                    (*  fsqrt                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sqrt;
+
+
+PROCEDURE [oberon] sin* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FEH,                    (*  fsin                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sin;
+
+
+PROCEDURE [oberon] cos* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FFH,                    (*  fcos                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END cos;
+
+
+PROCEDURE [oberon] tan* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FBH,                    (*  fsincos                    *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END tan;
+
+
+PROCEDURE [oberon] arctan2* (y, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F3H,                    (*  fpatan                     *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END arctan2;
+
+
+PROCEDURE [oberon] ln* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0EDH,                    (*  fldln2                     *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END ln;
+
+
+PROCEDURE [oberon] log* (base, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END log;
+
+
+PROCEDURE [oberon] exp* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0EAH,                 (*  fldl2e                     *)
+    0DEH, 0C9H, 0D9H, 0C0H,
+    0D9H, 0FCH, 0DCH, 0E9H,
+    0D9H, 0C9H, 0D9H, 0F0H,
+    0D9H, 0E8H, 0DEH, 0C1H,
+    0D9H, 0FDH, 0DDH, 0D9H,
+    0C9H,                       (*  leave                      *)
+    0C2H, 008H, 000H            (*  ret     08h                *)
+    )
+    RETURN 0.0
+END exp;
+
+
+PROCEDURE [oberon] round* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 07DH, 0F4H, 0D9H,
+    07DH, 0F6H, 066H, 081H,
+    04DH, 0F6H, 000H, 003H,
+    0D9H, 06DH, 0F6H, 0D9H,
+    0FCH, 0D9H, 06DH, 0F4H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END round;
+
+
+PROCEDURE [oberon] frac* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    050H,
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0C0H, 0D9H, 03CH,
+    024H, 0D9H, 07CH, 024H,
+    002H, 066H, 081H, 04CH,
+    024H, 002H, 000H, 00FH,
+    0D9H, 06CH, 024H, 002H,
+    0D9H, 0FCH, 0D9H, 02CH,
+    024H, 0DEH, 0E9H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END frac;
+
+
+PROCEDURE sqri* (x: INTEGER): INTEGER;
+    RETURN x * x
+END sqri;
+
+
+PROCEDURE sqrr* (x: REAL): REAL;
+    RETURN x * x
+END sqrr;
+
+
+PROCEDURE arcsin* (x: REAL): REAL;
+    RETURN arctan2(x, sqrt(1.0 - x * x))
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+    RETURN arctan2(sqrt(1.0 - x * x), x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arctan2(x, 1.0)
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
+    ELSE
+        x := 1.0 - 2.0 / (exp(2.0 * x) + 1.0)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF SameValue(x, 1.0) THEN
+        res := SYSTEM.INF()
+    ELSIF SameValue(x, -1.0) THEN
+        res := -SYSTEM.INF()
+    ELSE
+        res := 0.5 * ln((1.0 + x) / (1.0 - x))
+    END
+    RETURN res
+END artanh;
+
+
+PROCEDURE floor* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f < 0.0 THEN
+        x := x - 1.0
+    END
+    RETURN x
+END floor;
+
+
+PROCEDURE ceil* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f > 0.0 THEN
+        x := x + 1.0
+    END
+    RETURN x
+END ceil;
+
+
+PROCEDURE power* (base, exponent: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF exponent = 0.0 THEN
+        res := 1.0
+    ELSIF (base = 0.0) & (exponent > 0.0) THEN
+        res := 0.0
+    ELSE
+        res := exp(exponent * ln(base))
+    END
+    RETURN res
+END power;
+
+
+PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := 1.0;
+
+    IF base # 0.0 THEN
+        IF exponent # 0 THEN
+            IF exponent < 0 THEN
+                base := 1.0 / base
+            END;
+            i := ABS(exponent);
+            WHILE i > 0 DO
+                WHILE ~ODD(i) DO
+                    i := LSR(i, 1);
+                    base := sqrr(base)
+                END;
+                DEC(i);
+                a := a * base
+            END
+        ELSE
+            a := 1.0
+        END
+    ELSE
+        ASSERT(exponent > 0);
+        a := 0.0
+    END
+
+    RETURN a
+END ipower;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > 0.0 THEN
+        res := 1
+    ELSIF x < 0.0 THEN
+        res := -1
+    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;
+
+
+PROCEDURE DegToRad* (x: REAL): REAL;
+    RETURN x * (pi / 180.0)
+END DegToRad;
+
+
+PROCEDURE RadToDeg* (x: REAL): REAL;
+    RETURN x * (180.0 / pi)
+END RadToDeg;
+
+
+(* Return hypotenuse of triangle *)
+PROCEDURE hypot* (x, y: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    x := ABS(x);
+    y := ABS(y);
+    IF x > y THEN
+        a := x * sqrt(1.0 + sqrr(y / x))
+    ELSE
+        IF x > 0.0 THEN
+            a := y * sqrt(1.0 + sqrr(x / y))
+        ELSE
+            a := y
+        END
+    END
+
+    RETURN a
+END hypot;
+
+
+BEGIN
+    ASSERT(API.BIT_DEPTH = 32)
+END Math_x86.

+ 97 - 0
lib/Linux/Out.ob07

@@ -0,0 +1,97 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT SYSTEM, Libdl, API;
+
+
+CONST
+
+    bit_depth = API.BIT_DEPTH;
+
+
+VAR
+
+    fmt: ARRAY 8 OF CHAR;
+
+    printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER);
+    printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER);
+    printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision: INTEGER; x: REAL);
+    printf4: PROCEDURE [linux] (fmt: INTEGER; width, precision: INTEGER; x: INTEGER);
+
+
+PROCEDURE Char* (x: CHAR);
+BEGIN
+    printf1(SYSTEM.SADR("%c"), ORD(x))
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+BEGIN
+    printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
+END String;
+
+
+PROCEDURE Ln*;
+BEGIN
+    printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX))
+END Ln;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+BEGIN
+    printf2(SYSTEM.ADR(fmt[0]), width, x)
+END Int;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+    IF bit_depth = 32 THEN
+        printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x)
+    ELSE
+        printf4(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), SYSTEM.VAL(x, INTEGER))
+    END
+END Real;
+
+
+PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
+BEGIN
+    IF bit_depth = 32 THEN
+        printf3(SYSTEM.SADR("%*.*f"), width, precision, x)
+    ELSE
+        printf4(SYSTEM.SADR("%*.*f"), width, precision, SYSTEM.VAL(x, INTEGER))
+    END
+END FixReal;
+
+
+PROCEDURE Open*;
+END Open;
+
+
+PROCEDURE init;
+VAR
+    printf: INTEGER;
+
+BEGIN
+    IF bit_depth = 32 THEN
+        fmt := "%*d"
+    ELSE
+        fmt := "%*lld"
+    END;
+    printf := Libdl.sym(API.libc, "printf");
+    ASSERT(printf # 0);
+    SYSTEM.PUT(SYSTEM.ADR(printf1), printf);
+    SYSTEM.PUT(SYSTEM.ADR(printf2), printf);
+    SYSTEM.PUT(SYSTEM.ADR(printf3), printf);
+    SYSTEM.PUT(SYSTEM.ADR(printf4), printf);
+END init;
+
+
+BEGIN
+    init
+END Out.

+ 1072 - 0
lib/Linux/RTL.ob07

@@ -0,0 +1,1072 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+(*---------------------x86_64---------------------*)
+
+$IF (CPU_X8664)
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name:  INTEGER;
+    types: INTEGER;
+
+
+PROCEDURE [oberon] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 010H,    (*  mov     rax, qword [rbp + 16]  *)
+    048H, 085H, 0C0H,          (*  test    rax, rax               *)
+    07EH, 020H,                (*  jle     L                      *)
+    0FCH,                      (*  cld                            *)
+    057H,                      (*  push    rdi                    *)
+    056H,                      (*  push    rsi                    *)
+    048H, 08BH, 075H, 020H,    (*  mov     rsi, qword [rbp + 32]  *)
+    048H, 08BH, 07DH, 018H,    (*  mov     rdi, qword [rbp + 24]  *)
+    048H, 089H, 0C1H,          (*  mov     rcx, rax               *)
+    048H, 0C1H, 0E9H, 003H,    (*  shr     rcx, 3                 *)
+    0F3H, 048H, 0A5H,          (*  rep     movsd                  *)
+    048H, 089H, 0C1H,          (*  mov     rcx, rax               *)
+    048H, 083H, 0E1H, 007H,    (*  and     rcx, 7                 *)
+    0F3H, 0A4H,                (*  rep     movsb                  *)
+    05EH,                      (*  pop     rsi                    *)
+    05FH                       (*  pop     rdi                    *)
+                               (*  L:                             *)
+                )
+END _move;
+
+
+PROCEDURE [oberon] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [oberon] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [oberon] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov   rcx, qword [rbp + 16]  *)  (* rcx <- Len *)
+    048H, 08BH, 045H, 018H,   (*  mov   rax, qword [rbp + 24]  *)  (* rax <- Ptr *)
+    048H, 0FFH, 0C9H,         (*  dec   rcx                    *)
+    04CH, 08BH, 010H,         (*  mov   r10, qword [rax]       *)
+                              (*  L:                           *)
+    048H, 08BH, 050H, 008H,   (*  mov   rdx, qword [rax + 8]   *)
+    048H, 089H, 010H,         (*  mov   qword [rax], rdx       *)
+    048H, 083H, 0C0H, 008H,   (*  add   rax, 8                 *)
+    048H, 0FFH, 0C9H,         (*  dec   rcx                    *)
+    075H, 0F0H,               (*  jnz   L                      *)
+    04CH, 089H, 010H,         (*  mov   qword [rax], r10       *)
+    05DH,                     (*  pop   rbp                    *)
+    0C2H, 010H, 000H          (*  ret   16                     *)
+    )
+END _rot;
+
+
+PROCEDURE [oberon] _set* (b, a: INTEGER); (* {a..b} -> rax *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,    (*  mov   rcx, qword ptr [rbp + 16]  *)  (* rcx <- b *)
+    048H, 08BH, 045H, 018H,    (*  mov   rax, qword ptr [rbp + 24]  *)  (* rax <- a *)
+    048H, 039H, 0C8H,          (*  cmp   rax, rcx                   *)
+    07FH, 047H,                (*  jg    L1                         *)
+    048H, 083H, 0F8H, 03FH,    (*  cmp   rax, 63                    *)
+    07FH, 041H,                (*  jg    L1                         *)
+    048H, 085H, 0C9H,          (*  test  rcx, rcx                   *)
+    07CH, 03CH,                (*  jl    L1                         *)
+    048H, 083H, 0F9H, 03FH,    (*  cmp   rcx, 63                    *)
+    07EH, 007H,                (*  jle   L3                         *)
+    048H, 0C7H, 0C1H, 03FH,    (*  mov   rcx, 63                    *)
+    000H, 000H, 000H,
+                               (*  L3:                              *)
+    048H, 085H, 0C0H,          (*  test  rax, rax                   *)
+    07DH, 003H,                (*  jge   L2                         *)
+    048H, 031H, 0C0H,          (*  xor   rax, rax                   *)
+                               (*  L2:                              *)
+    048H, 089H, 0CAH,          (*  mov   rdx, rcx                   *)
+    048H, 029H, 0C2H,          (*  sub   rdx, rax                   *)
+    048H, 0B8H, 000H, 000H,    (*  movabs   rax, minint             *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+
+    048H, 087H, 0CAH,          (*  xchg  rdx, rcx                   *)
+    048H, 0D3H, 0F8H,          (*  sar   rax, cl                    *)
+    048H, 087H, 0CAH,          (*  xchg  rdx, rcx                   *)
+    048H, 083H, 0E9H, 03FH,    (*  sub   rcx, 63                    *)
+    048H, 0F7H, 0D9H,          (*  neg   rcx                        *)
+    048H, 0D3H, 0E8H,          (*  shr   rax, cl                    *)
+    05DH,                      (*  pop   rbp                        *)
+    0C2H, 010H, 000H,          (*  ret   16                         *)
+                               (*  L1:                              *)
+    048H, 031H, 0C0H,          (*  xor   rax, rax                   *)
+    05DH,                      (*  pop   rbp                        *)
+    0C2H, 010H, 000H           (*  ret   16                         *)
+    )
+END _set;
+
+
+PROCEDURE [oberon] _set1* (a: INTEGER); (* {a} -> rax *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 031H, 0C0H,         (*  xor  rax, rax               *)
+    048H, 08BH, 04DH, 010H,   (*  mov  rcx, qword [rbp + 16]  *)  (* rcx <- a *)
+    048H, 083H, 0F9H, 03FH,   (*  cmp  rcx, 63                *)
+    077H, 004H,               (*  ja   L                      *)
+    048H, 00FH, 0ABH, 0C8H    (*  bts  rax, rcx               *)
+                              (*  L:                          *)
+    )
+END _set1;
+
+
+PROCEDURE [oberon] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,    (*  mov     rax, qword [rbp + 24]  *)  (* rax <- x *)
+    048H, 031H, 0D2H,          (*  xor     rdx, rdx               *)
+    048H, 085H, 0C0H,          (*  test    rax, rax               *)
+    074H, 022H,                (*  je      L2                     *)
+    07FH, 003H,                (*  jg      L1                     *)
+    048H, 0F7H, 0D2H,          (*  not     rdx                    *)
+                               (*  L1:                            *)
+    049H, 089H, 0C0H,          (*  mov     r8, rax                *)
+    048H, 08BH, 04DH, 010H,    (*  mov     rcx, qword [rbp + 16]  *)  (* rcx <- y *)
+    048H, 0F7H, 0F9H,          (*  idiv    rcx                    *)
+    048H, 085H, 0D2H,          (*  test    rdx, rdx               *)
+    074H, 00EH,                (*  je      L2                     *)
+    049H, 031H, 0C8H,          (*  xor     r8, rcx                *)
+    04DH, 085H, 0C0H,          (*  test    r8, r8                 *)
+    07DH, 006H,                (*  jge     L2                     *)
+    048H, 0FFH, 0C8H,          (*  dec     rax                    *)
+    048H, 001H, 0CAH           (*  add     rdx, rcx               *)
+                               (*  L2:                            *)
+               )
+END _divmod;
+
+
+PROCEDURE [oberon] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr + 8, t);
+        INC(ptr, 16)
+    END
+END _new;
+
+
+PROCEDURE [oberon] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - 16)
+    END
+END _dispose;
+
+
+PROCEDURE [oberon] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,     (*  mov     rax, qword [rbp + 24]  *)
+    048H, 08BH, 04DH, 010H,     (*  mov     rcx, qword [rbp + 16]  *)
+    048H, 0FFH, 0C8H,           (*  dec     rax                    *)
+                                (*  L1:                            *)
+    048H, 0FFH, 0C0H,           (*  inc     rax                    *)
+    080H, 038H, 000H,           (*  cmp     byte [rax], 0          *)
+    074H, 005H,                 (*  jz      L2                     *)
+    0E2H, 0F6H,                 (*  loop    L1                     *)
+    048H, 0FFH, 0C0H,           (*  inc     rax                    *)
+                                (*  L2:                            *)
+    048H, 02BH, 045H, 018H      (*  sub     rax, qword [rbp + 24]  *)
+               )
+END _length;
+
+
+PROCEDURE [oberon] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,     (*  mov     rax, qword [rbp + 24]  *)
+    048H, 08BH, 04DH, 010H,     (*  mov     rcx, qword [rbp + 16]  *)
+    048H, 083H, 0E8H, 002H,     (*  sub     rax, 2                 *)
+                                (*  L1:                            *)
+    048H, 083H, 0C0H, 002H,     (*  add     rax, 2                 *)
+    066H, 083H, 038H, 000H,     (*  cmp     word [rax], 0          *)
+    074H, 006H,                 (*  jz      L2                     *)
+    0E2H, 0F4H,                 (*  loop    L1                     *)
+    048H, 083H, 0C0H, 002H,     (*  add     rax, 2                 *)
+                                (*  L2:                            *)
+    048H, 02BH, 045H, 018H,     (*  sub     rax, qword [rbp + 24]  *)
+    048H, 0D1H, 0E8H            (*  shr     rax, 1                 *)
+               )
+END _lengthw;
+
+
+PROCEDURE [oberon] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov     rcx, qword[rbp + 16]; rcx <- a *)
+    048H, 08BH, 055H, 018H,   (*  mov     rdx, qword[rbp + 24]; rdx <- b *)
+    04CH, 08BH, 045H, 020H,   (*  mov     r8,  qword[rbp + 32]; r8  <- n *)
+    04DH, 031H, 0C9H,         (*  xor     r9, r9                         *)
+    04DH, 031H, 0D2H,         (*  xor     r10, r10                       *)
+    048H, 0B8H, 000H, 000H,   (*  movabs  rax, minint                    *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+                              (*  L1:                                    *)
+    04DH, 085H, 0C0H,         (*  test    r8, r8                         *)
+    07EH, 024H,               (*  jle     L3                             *)
+    044H, 08AH, 009H,         (*  mov     r9b, byte[rcx]                 *)
+    044H, 08AH, 012H,         (*  mov     r10b, byte[rdx]                *)
+    048H, 0FFH, 0C1H,         (*  inc     rcx                            *)
+    048H, 0FFH, 0C2H,         (*  inc     rdx                            *)
+    049H, 0FFH, 0C8H,         (*  dec     r8                             *)
+    04DH, 039H, 0D1H,         (*  cmp     r9, r10                        *)
+    074H, 008H,               (*  je      L2                             *)
+    04CH, 089H, 0C8H,         (*  mov     rax, r9                        *)
+    04CH, 029H, 0D0H,         (*  sub     rax, r10                       *)
+    0EBH, 008H,               (*  jmp     L3                             *)
+                              (*  L2:                                    *)
+    04DH, 085H, 0C9H,         (*  test    r9, r9                         *)
+    075H, 0DAH,               (*  jne     L1                             *)
+    048H, 031H, 0C0H,         (*  xor     rax, rax                       *)
+                              (*  L3:                                    *)
+    05DH,                     (*  pop     rbp                            *)
+    0C2H, 018H, 000H          (*  ret     24                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [oberon] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov     rcx, qword[rbp + 16]; rcx <- a *)
+    048H, 08BH, 055H, 018H,   (*  mov     rdx, qword[rbp + 24]; rdx <- b *)
+    04CH, 08BH, 045H, 020H,   (*  mov     r8,  qword[rbp + 32]; r8  <- n *)
+    04DH, 031H, 0C9H,         (*  xor     r9, r9                         *)
+    04DH, 031H, 0D2H,         (*  xor     r10, r10                       *)
+    048H, 0B8H, 000H, 000H,   (*  movabs  rax, minint                    *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+                              (*  L1:                                    *)
+    04DH, 085H, 0C0H,         (*  test    r8, r8                         *)
+    07EH, 028H,               (*  jle     L3                             *)
+    066H, 044H, 08BH, 009H,   (*  mov     r9w, word[rcx]                 *)
+    066H, 044H, 08BH, 012H,   (*  mov     r10w, word[rdx]                *)
+    048H, 083H, 0C1H, 002H,   (*  add     rcx, 2                         *)
+    048H, 083H, 0C2H, 002H,   (*  add     rdx, 2                         *)
+    049H, 0FFH, 0C8H,         (*  dec     r8                             *)
+    04DH, 039H, 0D1H,         (*  cmp     r9, r10                        *)
+    074H, 008H,               (*  je      L2                             *)
+    04CH, 089H, 0C8H,         (*  mov     rax, r9                        *)
+    04CH, 029H, 0D0H,         (*  sub     rax, r10                       *)
+    0EBH, 008H,               (*  jmp     L3                             *)
+                              (*  L2:                                    *)
+    04DH, 085H, 0C9H,         (*  test    r9, r9                         *)
+    075H, 0D6H,               (*  jne     L1                             *)
+    048H, 031H, 0C0H,         (*  xor     rax, rax                       *)
+                              (*  L3:                                    *)
+    05DH,                     (*  pop     rbp                            *)
+    0C2H, 018H, 000H          (*  ret     24                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+PROCEDURE [oberon] _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+PROCEDURE [oberon] _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [oberon] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [oberon] _isrec* (t0, t1, r: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _isrec;
+
+
+PROCEDURE [oberon] _is* (t0, p: INTEGER): INTEGER;
+BEGIN
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    END
+
+    RETURN p MOD 2
+END _is;
+
+
+PROCEDURE [oberon] _guardrec* (t0, t1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _guardrec;
+
+
+PROCEDURE [oberon] _guard* (t0, p: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    ELSE
+        p := 1
+    END
+
+    RETURN p MOD 2
+END _guard;
+
+
+PROCEDURE [oberon] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [oberon] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [oberon] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+PROCEDURE [oberon] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
+    t0, t1, i, j: INTEGER;
+
+BEGIN
+    API.init(param, code);
+
+    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 * WORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
+    name := modname
+END _init;
+
+
+END RTL.
+$END
+
+(*---------------------x86------------------------*)
+
+$IF (CPU_X86)
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name:  INTEGER;
+    types: INTEGER;
+
+
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
+    085H, 0C0H,          (*  test eax, eax              *)
+    07EH, 019H,          (*  jle L                      *)
+    0FCH,                (*  cld                        *)
+    057H,                (*  push edi                   *)
+    056H,                (*  push esi                   *)
+    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
+    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
+    0F3H, 0A5H,          (*  rep movsd                  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
+    0F3H, 0A4H,          (*  rep movsb                  *)
+    05EH,                (*  pop esi                    *)
+    05FH                 (*  pop edi                    *)
+                         (*  L:                         *)
+                )
+END _move;
+
+
+PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
+    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
+    049H,               (*  dec   ecx                    *)
+    053H,               (*  push  ebx                    *)
+    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
+                        (*  L:                           *)
+    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
+    089H, 010H,         (*  mov   dword [eax], edx       *)
+    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
+    049H,               (*  dec   ecx                    *)
+    075H, 0F5H,         (*  jnz   L                      *)
+    089H, 018H,         (*  mov   dword [eax], ebx       *)
+    05BH,               (*  pop   ebx                    *)
+    05DH,               (*  pop   ebp                    *)
+    0C2H, 008H, 000H    (*  ret   8                      *)
+    )
+END _rot;
+
+
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
+    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
+    039H, 0C8H,                    (*  cmp   eax, ecx               *)
+    07FH, 033H,                    (*  jg    L1                     *)
+    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
+    07FH, 02EH,                    (*  jg    L1                     *)
+    085H, 0C9H,                    (*  test  ecx, ecx               *)
+    07CH, 02AH,                    (*  jl    L1                     *)
+    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
+    07EH, 005H,                    (*  jle   L3                     *)
+    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
+                                   (*  L3:                          *)
+    085H, 0C0H,                    (*  test  eax, eax               *)
+    07DH, 002H,                    (*  jge   L2                     *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+                                   (*  L2:                          *)
+    089H, 0CAH,                    (*  mov   edx, ecx               *)
+    029H, 0C2H,                    (*  sub   edx, eax               *)
+    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    0D3H, 0F8H,                    (*  sar   eax, cl                *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
+    0F7H, 0D9H,                    (*  neg   ecx                    *)
+    0D3H, 0E8H,                    (*  shr   eax, cl                *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H,              (*  ret   8                      *)
+                                   (*  L1:                          *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H               (*  ret   8                      *)
+    )
+END _set;
+
+
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    031H, 0C0H,         (*  xor  eax, eax              *)
+    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
+    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
+    077H, 003H,         (*  ja   L                     *)
+    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
+                        (*  L:                         *)
+    )
+END _set1;
+
+
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
+BEGIN
+    SYSTEM.CODE(
+    053H,                (*  push    ebx                    *)
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
+    031H, 0D2H,          (*  xor     edx, edx               *)
+    085H, 0C0H,          (*  test    eax, eax               *)
+    074H, 018H,          (*  je      L2                     *)
+    07FH, 002H,          (*  jg      L1                     *)
+    0F7H, 0D2H,          (*  not     edx                    *)
+                         (*  L1:                            *)
+    089H, 0C3H,          (*  mov     ebx, eax               *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
+    0F7H, 0F9H,          (*  idiv    ecx                    *)
+    085H, 0D2H,          (*  test    edx, edx               *)
+    074H, 009H,          (*  je      L2                     *)
+    031H, 0CBH,          (*  xor     ebx, ecx               *)
+    085H, 0DBH,          (*  test    ebx, ebx               *)
+    07DH, 003H,          (*  jge     L2                     *)
+    048H,                (*  dec     eax                    *)
+    001H, 0CAH,          (*  add     edx, ecx               *)
+                         (*  L2:                            *)
+    05BH                 (*  pop     ebx                    *)
+               )
+END _divmod;
+
+
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr + ORD(API.OS = "LINUX")*12, t);
+        INC(ptr, 4 + ORD(API.OS = "LINUX")*12)
+    END
+END _new;
+
+
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - (4 + ORD(API.OS = "LINUX")*12))
+    END
+END _dispose;
+
+
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                (*  dec     eax                     *)
+                         (*  L1:                             *)
+    040H,                (*  inc     eax                     *)
+    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
+    074H, 003H,          (*  jz      L2                      *)
+    0E2H, 0F8H,          (*  loop    L1                      *)
+    040H,                (*  inc     eax                     *)
+                         (*  L2:                             *)
+    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
+               )
+END _length;
+
+
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                     (*  dec     eax                     *)
+    048H,                     (*  dec     eax                     *)
+                              (*  L1:                             *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
+    074H, 004H,               (*  jz      L2                      *)
+    0E2H, 0F6H,               (*  loop    L1                      *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+                              (*  L2:                             *)
+    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
+    0D1H, 0E8H                (*  shr     eax, 1                  *)
+               )
+END _lengthw;
+
+
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 017H,              (*  jle     L3                             *)
+    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
+    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E7H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 01BH,              (*  jle     L3                             *)
+    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
+    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E3H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _isrec;
+
+
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
+BEGIN
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    END
+
+    RETURN p MOD 2
+END _is;
+
+
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _guardrec;
+
+
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    ELSE
+        p := 1
+    END
+
+    RETURN p MOD 2
+END _guard;
+
+
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [stdcall] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+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 := 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 * WORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
+    name := modname
+END _init;
+
+
+END RTL.
+$END

+ 130 - 0
lib/MSP430/MSP430.ob07

@@ -0,0 +1,130 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE MSP430;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    iv = 0FFC0H;
+
+    bsl        = iv - 2;
+    sp         = bsl - 2;
+    empty_proc = sp - 2;
+    bits       = empty_proc - 272;
+    bits_offs  = bits - 32;
+    types      = bits_offs - 2;
+
+    int_offs  = 0;
+    trap_offs = 2;
+
+    GIE*     = {3};
+    CPUOFF*  = {4};
+    OSCOFF*  = {5};
+    SCG0*    = {6};
+    SCG1*    = {7};
+
+
+TYPE
+
+    TInterrupt* = RECORD priority*: INTEGER; sr*: SET; pc*: INTEGER END;
+
+    TTrapProc* = PROCEDURE (modNum, modName, err, line: INTEGER);
+
+    TIntProc*  = PROCEDURE (priority: INTEGER; interrupt: TInterrupt);
+
+
+PROCEDURE SetTrapProc* (TrapProc: TTrapProc);
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    SYSTEM.GET(sp, ptr);
+    IF TrapProc = NIL THEN
+        SYSTEM.PUT(ptr + trap_offs, empty_proc)
+    ELSE
+        SYSTEM.PUT(ptr + trap_offs, TrapProc)
+    END
+END SetTrapProc;
+
+
+PROCEDURE SetIntProc* (IntProc: TIntProc);
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    SYSTEM.GET(sp, ptr);
+    IF IntProc = NIL THEN
+        SYSTEM.PUT(ptr + int_offs, empty_proc)
+    ELSE
+        SYSTEM.PUT(ptr + int_offs, IntProc)
+    END
+END SetIntProc;
+
+
+PROCEDURE SetIntPC* (interrupt: TInterrupt; NewPC: INTEGER);
+BEGIN
+    SYSTEM.PUT(SYSTEM.ADR(interrupt.pc), NewPC)
+END SetIntPC;
+
+
+PROCEDURE SetIntSR* (interrupt: TInterrupt; NewSR: SET);
+BEGIN
+    SYSTEM.PUT(SYSTEM.ADR(interrupt.sr), NewSR)
+END SetIntSR;
+
+
+PROCEDURE [code] DInt*
+    0C232H; (*  BIC #8, SR  *)
+
+
+PROCEDURE [code] EInt*
+    0D232H; (*  BIS #8, SR  *)
+
+
+PROCEDURE [code] CpuOff*
+    0D032H, 16; (*  BIS #16, SR  *)
+
+
+PROCEDURE [code] Halt*
+    4032H, 0F0H;  (*  MOV CPUOFF+OSCOFF+SCG0+SCG1, SR  *)
+
+
+PROCEDURE [code] Restart*
+    4302H,          (*  MOV #0, SR          *)
+    4210H, 0FFFEH;  (*  MOV 0FFFEH(SR), PC  *)
+
+
+PROCEDURE [code] SetSR* (bits: SET)
+    0D112H, 2; (*  BIS 2(SP), SR  *)
+
+
+PROCEDURE [code] ClrSR* (bits: SET)
+    0C112H, 2; (*  BIC 2(SP), SR  *)
+
+
+PROCEDURE [code] Delay* (n: INTEGER)
+    4035H, 124,  (*  MOV  #124, R5   *)
+                 (*  L2:             *)
+    4114H, 2,    (*  MOV  2(SP), R4  *)
+    8324H,       (*  SUB  #2, R4     *)
+                 (*  L1:             *)
+    4303H,       (*  NOP             *)
+    4303H,       (*  NOP             *)
+    4303H,       (*  NOP             *)
+    4303H,       (*  NOP             *)
+    4303H,       (*  NOP             *)
+    8314H,       (*  SUB  #1, R4     *)
+    3800H - 7,   (*  JGE  L1         *)
+    4303H,       (*  NOP             *)
+    8315H,       (*  SUB  #1, R5     *)
+    3800H - 13;  (*  JGE  L2         *)
+
+
+END MSP430.

+ 462 - 0
lib/Math/CMath.ob07

@@ -0,0 +1,462 @@
+(* ***********************************************
+    Модуль работы с комплексными числами.
+    Вадим Исаев, 2020
+    Module for complex numbers.
+    Vadim Isaev, 2020
+*************************************************** *)
+
+MODULE CMath;
+
+IMPORT Math, Out;
+
+TYPE
+  complex* = POINTER TO RECORD
+    re*: REAL;
+    im*: REAL
+  END;
+
+VAR
+  result: complex;
+
+  i* : complex;
+  _0*: complex;
+
+(* Инициализация комплексного числа.
+   Init complex number. *)
+PROCEDURE CInit* (re : REAL; im: REAL): complex;
+VAR
+  temp: complex;
+BEGIN
+  NEW(temp);
+  temp.re:=re;
+  temp.im:=im;
+
+  RETURN temp
+END CInit;
+
+
+(* Четыре основных арифметических операций.
+   Four base operations  +, -, * , / *)
+
+(* Сложение
+   addition : z := z1 + z2 *)
+PROCEDURE CAdd* (z1, z2: complex): complex;
+BEGIN
+  result.re := z1.re + z2.re;
+  result.im := z1.im + z2.im;
+
+  RETURN result
+END CAdd;
+
+(* Сложение с REAL.
+   addition : z := z1 + r1 *)
+PROCEDURE CAdd_r* (z1: complex; r1: REAL): complex;
+BEGIN
+  result.re := z1.re + r1;
+  result.im := z1.im;
+
+  RETURN result
+END CAdd_r;
+
+(* Сложение с INTEGER.
+   addition : z := z1 + i1 *)
+PROCEDURE CAdd_i* (z1: complex; i1: INTEGER): complex;
+BEGIN
+  result.re := z1.re + FLT(i1);
+  result.im := z1.im;
+
+  RETURN result
+END CAdd_i;
+
+(* Смена знака.
+   substraction : z := - z1 *)
+PROCEDURE CNeg (z1 : complex): complex;
+BEGIN
+  result.re := -z1.re;
+  result.im := -z1.im;
+
+  RETURN result
+END CNeg;
+
+(* Вычитание.
+   substraction : z := z1 - z2 *)
+PROCEDURE CSub* (z1, z2 : complex): complex;
+BEGIN
+  result.re := z1.re - z2.re;
+  result.im := z1.im - z2.im;
+
+  RETURN result
+END CSub;
+
+(* Вычитание REAL.
+   substraction : z := z1 - r1 *)
+PROCEDURE CSub_r1* (z1 : complex; r1 : REAL): complex;
+BEGIN
+  result.re := z1.re - r1;
+  result.im := z1.im;
+
+  RETURN result
+END CSub_r1;
+
+(* Вычитание из REAL.
+   substraction : z := r1 - z1 *)
+PROCEDURE CSub_r2* (r1 : REAL; z1 : complex): complex;
+BEGIN
+  result.re := r1 - z1.re;
+  result.im := - z1.im;
+
+  RETURN result
+END CSub_r2;
+
+(* Вычитание INTEGER.
+   substraction : z := z1 - i1 *)
+PROCEDURE CSub_i* (z1 : complex; i1 : INTEGER): complex;
+BEGIN
+  result.re := z1.re - FLT(i1);
+  result.im := z1.im;
+
+  RETURN result
+END CSub_i;
+
+(* Умножение.
+   multiplication : z := z1 * z2 *)
+PROCEDURE CMul (z1, z2 : complex): complex;
+BEGIN
+  result.re := (z1.re * z2.re) - (z1.im * z2.im);
+  result.im := (z1.re * z2.im) + (z1.im * z2.re);
+
+  RETURN result
+END CMul;
+
+(* Умножение с REAL.
+   multiplication : z := z1 * r1 *)
+PROCEDURE CMul_r (z1 : complex; r1 : REAL): complex;
+BEGIN
+  result.re := z1.re * r1;
+  result.im := z1.im * r1;
+
+  RETURN result
+END CMul_r;
+
+(* Умножение с INTEGER.
+   multiplication : z := z1 * i1 *)
+PROCEDURE CMul_i (z1 : complex; i1 : INTEGER): complex;
+BEGIN
+  result.re := z1.re * FLT(i1);
+  result.im := z1.im * FLT(i1);
+
+  RETURN result
+END CMul_i;
+
+(* Деление.
+   division : z := znum / zden *)
+PROCEDURE CDiv (z1, z2 : complex): complex;
+    (* The following algorithm is used to properly handle
+      denominator overflow:
+
+                 |  a + b(d/c)   c - a(d/c)
+                 |  ---------- + ---------- I     if |d| < |c|
+      a + b I    |  c + d(d/c)   a + d(d/c)
+      -------  = |
+      c + d I    |  b + a(c/d)   -a+ b(c/d)
+                 |  ---------- + ---------- I     if |d| >= |c|
+                 |  d + c(c/d)   d + c(c/d)
+    *)
+VAR
+  tmp, denom : REAL;
+BEGIN
+   IF ( ABS(z2.re) > ABS(z2.im) ) THEN
+     tmp := z2.im / z2.re;
+     denom := z2.re + z2.im * tmp;
+     result.re := (z1.re + z1.im * tmp) / denom;
+     result.im := (z1.im - z1.re * tmp) / denom;
+   ELSE
+     tmp := z2.re / z2.im;
+     denom := z2.im + z2.re * tmp;
+     result.re := (z1.im + z1.re * tmp) / denom;
+     result.im := (-z1.re + z1.im * tmp) / denom;
+   END;
+
+   RETURN result
+END CDiv;
+
+(* Деление на REAL.
+   division : z := znum / r1 *)
+PROCEDURE CDiv_r* (z1 : complex; r1 : REAL): complex;
+BEGIN
+  result.re := z1.re / r1;
+  result.im := z1.im / r1;
+
+  RETURN result
+END CDiv_r;
+
+(* Деление на INTEGER.
+   division : z := znum / i1 *)
+PROCEDURE CDiv_i* (z1 : complex; i1 : INTEGER): complex;
+BEGIN
+  result.re := z1.re / FLT(i1);
+  result.im := z1.im / FLT(i1);
+
+  RETURN result
+END CDiv_i;
+
+(* fonctions elementaires *)
+
+(* Вывод на экран.
+   out complex number *)
+PROCEDURE CPrint* (z: complex; width: INTEGER);
+BEGIN
+  Out.Real(z.re, width);
+  IF z.im>=0.0 THEN
+    Out.String("+");
+  END;
+  Out.Real(z.im, width);
+  Out.String("i");
+END CPrint;
+
+PROCEDURE CPrintLn* (z: complex; width: INTEGER);
+BEGIN
+  CPrint(z, width);
+  Out.Ln;
+END CPrintLn;
+
+(* Вывод на экран с фиксированным кол-вом знаков
+   после запятой (p) *)
+PROCEDURE CPrintFix* (z: complex; width, p: INTEGER);
+BEGIN
+  Out.FixReal(z.re, width, p);
+  IF z.im>=0.0 THEN
+    Out.String("+");
+  END;
+  Out.FixReal(z.im, width, p);
+  Out.String("i");
+END CPrintFix;
+
+PROCEDURE CPrintFixLn* (z: complex; width, p: INTEGER);
+BEGIN
+  CPrintFix(z, width, p);
+  Out.Ln;
+END CPrintFixLn;
+
+(* Модуль числа.
+   module : r = |z| *)
+PROCEDURE CMod* (z1 : complex): REAL;
+BEGIN
+  RETURN Math.sqrt((z1.re * z1.re) + (z1.im * z1.im))
+END CMod;
+
+(* Квадрат числа.
+   square : r := z*z *)
+PROCEDURE CSqr* (z1: complex): complex;
+BEGIN
+  result.re := z1.re * z1.re - z1.im * z1.im;
+  result.im := 2.0 * z1.re * z1.im;
+
+  RETURN result
+END CSqr;
+
+(* Квадратный корень числа.
+   square root : r := sqrt(z) *)
+PROCEDURE CSqrt* (z1: complex): complex;
+VAR
+  root, q: REAL;
+BEGIN
+  IF (z1.re#0.0) OR (z1.im#0.0) THEN
+    root := Math.sqrt(0.5 * (ABS(z1.re) + CMod(z1)));
+    q := z1.im / (2.0 * root);
+    IF z1.re >= 0.0 THEN
+      result.re := root;
+      result.im := q;
+    ELSE
+      IF z1.im < 0.0 THEN
+        result.re := - q;
+        result.im := - root
+      ELSE
+        result.re :=  q;
+        result.im :=  root
+      END
+    END
+  ELSE
+    result := z1;
+  END;
+
+  RETURN result
+END CSqrt;
+
+(* Экспонента.
+   exponantial : r := exp(z) *)
+(* exp(x + iy) = exp(x).exp(iy) = exp(x).[cos(y) + i sin(y)] *)
+PROCEDURE CExp* (z: complex): complex;
+VAR
+  expz : REAL;
+BEGIN
+  expz := Math.exp(z.re);
+  result.re := expz * Math.cos(z.im);
+  result.im := expz * Math.sin(z.im);
+
+  RETURN result
+END CExp;
+
+(* Натуральный логарифм.
+   natural logarithm : r := ln(z) *)
+(* ln( p exp(i0)) = ln(p) + i0 + 2kpi *)
+PROCEDURE CLn* (z: complex): complex;
+BEGIN
+  result.re := Math.ln(CMod(z));
+  result.im := Math.arctan2(z.im, z.re);
+
+  RETURN result
+END CLn;
+
+(* Число в степени.
+   exp : z := z1^z2 *)
+PROCEDURE CPower* (z1, z2 : complex): complex;
+VAR
+  a: complex;
+BEGIN
+   a:=CLn(z1);
+   a:=CMul(z2, a);
+   result:=CExp(a);
+
+   RETURN result
+END CPower;
+
+(* Число в степени REAL.
+   multiplication : z := z1^r *)
+PROCEDURE CPower_r* (z1: complex; r: REAL): complex;
+VAR
+  a: complex;
+BEGIN
+  a:=CLn(z1);
+  a:=CMul_r(a, r);
+  result:=CExp(a);
+
+  RETURN result
+END CPower_r;
+
+(* Обратное число.
+   inverse : r := 1 / z *)
+PROCEDURE CInv* (z: complex): complex;
+VAR
+  denom : REAL;
+BEGIN
+  denom := (z.re * z.re) + (z.im * z.im);
+  (* generates a fpu exception if denom=0 as for reals *)
+  result.re:=z.re/denom;
+  result.im:=-z.im/denom;
+
+  RETURN result
+END CInv;
+
+(* direct trigonometric functions *)
+
+(* Косинус.
+   complex cosinus *)
+(* cos(x+iy) = cos(x).cos(iy) - sin(x).sin(iy) *)
+(* cos(ix) = cosh(x) et sin(ix) = i.sinh(x) *)
+PROCEDURE CCos* (z: complex): complex;
+BEGIN
+  result.re := Math.cos(z.re) * Math.cosh(z.im);
+  result.im := - Math.sin(z.re) * Math.sinh(z.im);
+
+  RETURN result
+END CCos;
+
+(* Синус.
+   sinus complex *)
+(* sin(x+iy) = sin(x).cos(iy) + cos(x).sin(iy) *)
+(* cos(ix) = cosh(x) et sin(ix) = i.sinh(x) *)
+PROCEDURE CSin (z: complex): complex;
+BEGIN
+  result.re := Math.sin(z.re) * Math.cosh(z.im);
+  result.im := Math.cos(z.re) * Math.sinh(z.im);
+
+  RETURN result
+END CSin;
+
+(* Тангенс.
+   tangente *)
+PROCEDURE CTg* (z: complex): complex;
+VAR
+  temp1, temp2: complex;
+BEGIN
+  temp1:=CSin(z);
+  temp2:=CCos(z);
+  result:=CDiv(temp1, temp2);
+
+  RETURN result
+END CTg;
+
+(* inverse complex hyperbolic functions *)
+
+(* Гиперболический арккосинус.
+   hyberbolic arg cosinus *)
+(*                          _________  *)
+(* argch(z) = -/+ ln(z + i.V 1 - z.z)  *)
+PROCEDURE CArcCosh* (z : complex): complex;
+BEGIN
+  result:=CNeg(CLn(CAdd(z, CMul(i, CSqrt(CSub_r2(1.0, CMul(z, z)))))));
+
+  RETURN result
+END CArcCosh;
+
+(* Гиперболический арксинус.
+   hyperbolic arc sinus       *)
+(*                    ________  *)
+(* argsh(z) = ln(z + V 1 + z.z) *)
+PROCEDURE CArcSinh* (z : complex): complex;
+BEGIN
+  result:=CLn(CAdd(z, CSqrt(CAdd_r(CMul(z, z), 1.0))));
+
+  RETURN result
+END CArcSinh;
+
+(* Гиперболический арктангенс.
+   hyperbolic arc tangent *)
+(* argth(z) = 1/2 ln((z + 1) / (1 - z)) *)
+PROCEDURE CArcTgh (z : complex): complex;
+BEGIN
+  result:=CDiv_r(CLn(CDiv(CAdd_r(z, 1.0), CSub_r2(1.0, z))), 2.0);
+
+  RETURN result
+END CArcTgh;
+
+(* trigonometriques inverses *)
+
+(* Арккосинус.
+   arc cosinus complex *)
+(* arccos(z) = -i.argch(z) *)
+PROCEDURE CArcCos* (z: complex): complex;
+BEGIN
+  result := CNeg(CMul(i, CArcCosh(z)));
+
+  RETURN result
+END CArcCos;
+
+(* Арксинус.
+   arc sinus complex *)
+(* arcsin(z) = -i.argsh(i.z) *)
+PROCEDURE CArcSin* (z : complex): complex;
+BEGIN
+  result := CNeg(CMul(i, CArcSinh(z)));
+
+  RETURN result
+END CArcSin;
+
+(* Арктангенс.
+   arc tangente complex *)
+(* arctg(z) = -i.argth(i.z) *)
+PROCEDURE CArcTg* (z : complex): complex;
+BEGIN
+  result := CNeg(CMul(i, CArcTgh(CMul(i, z))));
+
+  RETURN result
+END CArcTg;
+
+BEGIN
+
+  result:=CInit(0.0, 0.0);
+  i :=CInit(0.0, 1.0);
+  _0:=CInit(0.0, 0.0);
+
+END CMath.

+ 33 - 0
lib/Math/MathBits.ob07

@@ -0,0 +1,33 @@
+(* ****************************************
+   Дополнение к модулю Math.
+   Побитовые операции над целыми числами.
+   Вадим Исаев, 2020
+   Additional functions to the module Math.
+   Bitwise operations on integers.
+   Vadim Isaev, 2020
+******************************************* *)
+
+MODULE MathBits;
+
+
+PROCEDURE iand* (x, y: INTEGER): INTEGER;
+    RETURN ORD(BITS(x) * BITS(y))
+END iand;
+
+
+PROCEDURE ior* (x, y: INTEGER): INTEGER;
+    RETURN ORD(BITS(x) + BITS(y))
+END ior;
+
+
+PROCEDURE ixor* (x, y: INTEGER): INTEGER;
+    RETURN ORD(BITS(x) / BITS(y))
+END ixor;
+
+
+PROCEDURE inot* (x: INTEGER): INTEGER;
+    RETURN ORD(-BITS(x))
+END inot;
+
+
+END MathBits.

+ 99 - 0
lib/Math/MathRound.ob07

@@ -0,0 +1,99 @@
+(* ******************************************
+   Дополнительные функции к модулю Math.
+   Функции округления.
+   Вадим Исаев, 2020
+   -------------------------------------
+   Additional functions to the module Math.
+   Rounding functions.
+   Vadim Isaev, 2020
+********************************************* *)
+
+MODULE MathRound;
+
+IMPORT Math;
+
+
+(* Возвращается целая часть числа x.
+   Returns the integer part of a argument x.*)
+PROCEDURE trunc* (x: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    a := FLT(FLOOR(x));
+    IF (x < 0.0) & (x # a) THEN
+        a := a + 1.0
+    END
+
+    RETURN a
+END trunc;
+
+
+(* Возвращается дробная часть числа x.
+   Returns the fractional part of the argument x *)
+PROCEDURE frac* (x: REAL): REAL;
+    RETURN x - trunc(x)
+END frac;
+
+
+(* Округление к ближайшему целому.
+   Rounding to the nearest integer. *)
+PROCEDURE round* (x: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    a := trunc(x);
+    IF ABS(frac(x)) >= 0.5 THEN
+        a := a + FLT(Math.sgn(x))
+    END
+
+    RETURN a
+END round;
+
+
+(* Округление к бОльшему целому.
+   Rounding to a largest integer *)
+PROCEDURE ceil* (x: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    a := FLT(FLOOR(x));
+    IF x # a THEN
+        a := a + 1.0
+    END
+
+    RETURN a
+END ceil;
+
+
+(* Округление к меньшему целому.
+   Rounding to a smallest integer *)
+PROCEDURE floor* (x: REAL): REAL;
+    RETURN FLT(FLOOR(x))
+END floor;
+
+
+(* Округление до определённого количества знаков:
+   - если Digits отрицательное, то округление
+     в знаках после десятичной запятой;
+   - если Digits положительное, то округление
+     в знаках до запятой  *)
+PROCEDURE SimpleRoundTo* (AValue: REAL; Digits: INTEGER): REAL;
+VAR
+    RV, a : REAL;
+
+BEGIN
+    RV := Math.ipower(10.0, -Digits);
+    IF AValue < 0.0 THEN
+        a := trunc((AValue * RV) - 0.5)
+    ELSE
+        a := trunc((AValue * RV) + 0.5)
+    END
+
+    RETURN a / RV
+END SimpleRoundTo;
+
+
+END MathRound.

+ 238 - 0
lib/Math/MathStat.ob07

@@ -0,0 +1,238 @@
+(* ********************************************
+   Дополнение к модулю Math.
+   Статистические процедуры.
+   -------------------------------------
+   Additional functions to the module Math.
+   Statistical functions
+*********************************************** *)
+
+MODULE MathStat;
+
+IMPORT Math;
+
+
+(*Минимальное значение. Нецелое *)
+PROCEDURE MinValue* (data: ARRAY OF REAL; N: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := data[0];
+    FOR i := 1 TO N - 1 DO
+        IF data[i] < a THEN
+            a := data[i]
+        END
+    END
+
+    RETURN a
+END MinValue;
+
+
+(*Минимальное значение. Целое *)
+PROCEDURE MinIntValue* (data: ARRAY OF INTEGER; N: INTEGER): INTEGER;
+VAR
+    i: INTEGER;
+    a: INTEGER;
+
+BEGIN
+    a := data[0];
+    FOR i := 1 TO N - 1 DO
+        IF data[i] < a THEN
+            a := data[i]
+        END
+    END
+
+    RETURN a
+END MinIntValue;
+
+
+(*Максимальное значение. Нецелое *)
+PROCEDURE MaxValue* (data: ARRAY OF REAL; N: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := data[0];
+    FOR i := 1 TO N - 1 DO
+        IF data[i] > a THEN
+            a := data[i]
+        END
+    END
+
+    RETURN a
+END MaxValue;
+
+
+(*Максимальное значение. Целое *)
+PROCEDURE MaxIntValue* (data: ARRAY OF INTEGER; N: INTEGER): INTEGER;
+VAR
+    i: INTEGER;
+    a: INTEGER;
+
+BEGIN
+    a := data[0];
+    FOR i := 1 TO N - 1 DO
+        IF data[i] > a THEN
+            a := data[i]
+        END
+    END
+
+    RETURN a
+END MaxIntValue;
+
+
+(* Сумма значений массива *)
+PROCEDURE Sum* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+VAR
+    a: REAL;
+    i: INTEGER;
+
+BEGIN
+    a := 0.0;
+    FOR i := 0 TO Count - 1 DO
+        a := a + data[i]
+    END
+
+    RETURN a
+END Sum;
+
+
+(* Сумма целых значений массива *)
+PROCEDURE SumInt* (data: ARRAY OF INTEGER; Count: INTEGER): INTEGER;
+VAR
+    a: INTEGER;
+    i: INTEGER;
+
+BEGIN
+    a := 0;
+    FOR i := 0 TO Count - 1 DO
+        a := a + data[i]
+    END
+
+    RETURN a
+END SumInt;
+
+
+(* Сумма квадратов значений массива *)
+PROCEDURE SumOfSquares* (data : ARRAY OF REAL; Count: INTEGER): REAL;
+VAR
+    a: REAL;
+    i: INTEGER;
+
+BEGIN
+    a := 0.0;
+    FOR i := 0 TO Count - 1 DO
+        a := a + Math.sqrr(data[i])
+    END
+
+    RETURN a
+END SumOfSquares;
+
+
+(* Сумма значений и сумма квадратов значений массмва *)
+PROCEDURE SumsAndSquares* (data: ARRAY OF REAL; Count : INTEGER;
+                            VAR sum, sumofsquares : REAL);
+VAR
+    i: INTEGER;
+    temp: REAL;
+
+BEGIN
+    sumofsquares := 0.0;
+    sum := 0.0;
+    FOR i := 0 TO Count - 1 DO
+        temp := data[i];
+        sumofsquares := sumofsquares + Math.sqrr(temp);
+        sum := sum + temp
+    END
+END SumsAndSquares;
+
+
+(* Средниее значений массива *)
+PROCEDURE Mean* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+    RETURN Sum(data, Count) / FLT(Count)
+END Mean;
+
+
+PROCEDURE MeanAndTotalVariance* (data: ARRAY OF REAL; Count: INTEGER;
+                                 VAR mu: REAL; VAR variance: REAL);
+VAR
+    i: INTEGER;
+
+BEGIN
+    mu := Mean(data, Count);
+    variance := 0.0;
+    FOR i := 0 TO Count - 1 DO
+        variance := variance + Math.sqrr(data[i] - mu)
+    END
+END MeanAndTotalVariance;
+
+
+(* Вычисление статистической дисперсии равной сумме квадратов разницы
+   между каждым конкретным значением массива Data и средним значением *)
+PROCEDURE TotalVariance* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+VAR
+    mu, tv: REAL;
+
+BEGIN
+    MeanAndTotalVariance(data, Count, mu, tv)
+    RETURN tv
+END TotalVariance;
+
+
+(* Типовая дисперсия всех значений массива *)
+PROCEDURE Variance* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    IF Count = 1 THEN
+        a := 0.0
+    ELSE
+        a := TotalVariance(data, Count) / FLT(Count - 1)
+    END
+
+    RETURN a
+END Variance;
+
+
+(* Стандартное среднеквадратичное отклонение *)
+PROCEDURE StdDev* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+    RETURN Math.sqrt(Variance(data, Count))
+END StdDev;
+
+
+(* Среднее арифметическое всех значений массива, и среднее отклонение *)
+PROCEDURE MeanAndStdDev* (data: ARRAY OF REAL; Count: INTEGER;
+                            VAR mean: REAL; VAR stdDev: REAL);
+VAR
+    totalVariance: REAL;
+
+BEGIN
+    MeanAndTotalVariance(data, Count, mean, totalVariance);
+    IF Count < 2 THEN
+        stdDev := 0.0
+    ELSE
+        stdDev := Math.sqrt(totalVariance / FLT(Count - 1))
+    END
+END MeanAndStdDev;
+
+
+(* Евклидова норма для всех значений массива *)
+PROCEDURE Norm* (data: ARRAY OF REAL; Count: INTEGER): REAL;
+VAR
+    a: REAL;
+    i: INTEGER;
+
+BEGIN
+    a := 0.0;
+    FOR i := 0 TO Count - 1 DO
+        a := a + Math.sqrr(data[i])
+    END
+
+    RETURN Math.sqrt(a)
+END Norm;
+
+
+END MathStat.

+ 81 - 0
lib/Math/Rand.ob07

@@ -0,0 +1,81 @@
+(* ************************************
+   Генератор какбыслучайных чисел,
+   Линейный конгруэнтный метод,
+   алгоритм Лемера.
+   Вадим Исаев, 2020
+   -------------------------------
+   Generator pseudorandom numbers,
+   Linear congruential generator,
+   Algorithm by D. H. Lehmer.
+   Vadim Isaev, 2020
+*************************************** *)
+
+MODULE Rand;
+
+IMPORT HOST, Math;
+
+
+CONST
+
+    RAND_MAX = 2147483647;
+
+
+VAR
+    seed: INTEGER;
+
+
+PROCEDURE Randomize*;
+BEGIN
+    seed := HOST.GetTickCount()
+END Randomize;
+
+
+(* Целые какбыслучайные числа 0..RAND_MAX-1 *)
+PROCEDURE RandomI* (): INTEGER;
+CONST
+    a = 630360016;
+
+BEGIN
+    seed := (a * seed) MOD RAND_MAX
+    RETURN seed
+END RandomI;
+
+
+(* Какбыслучайные числа с плавающей запятой [0, 1) *)
+PROCEDURE RandomR* (): REAL;
+    RETURN FLT(RandomI()) / FLT(RAND_MAX)
+END RandomR;
+
+
+(* Какбыслучайное число в диапазоне 0..aTo-1
+   Return a random number in a range 0..aTo-1 *)
+PROCEDURE RandomITo* (aTo: INTEGER): INTEGER;
+    RETURN FLOOR(RandomR() * FLT(aTo))
+END RandomITo;
+
+
+(* Какбыслучайное число в диапазоне.
+   Return a random number in a range *)
+PROCEDURE RandomIRange* (aFrom, aTo: INTEGER): INTEGER;
+    RETURN FLOOR(RandomR() * FLT(aTo - aFrom + 1)) + aFrom
+END RandomIRange;
+
+
+(* Какбыслучайное число. Распределение Гаусса *)
+PROCEDURE RandG* (mean, stddev: REAL): REAL;
+VAR
+    U, S: REAL;
+
+BEGIN
+    REPEAT
+        U := 2.0 * RandomR() - 1.0;
+        S := Math.sqrr(U) + Math.sqrr(2.0 * RandomR() - 1.0)
+    UNTIL (1.0E-20 < S) & (S <= 1.0)
+
+    RETURN Math.sqrt(-2.0 * Math.ln(S) / S) * U * stddev + mean
+END RandG;
+
+
+BEGIN
+    seed := 654321
+END Rand.

+ 298 - 0
lib/Math/RandExt.ob07

@@ -0,0 +1,298 @@
+(* ************************************************************
+   Дополнительные алгоритмы генераторов какбыслучайных чисел.
+   Вадим Исаев, 2020
+
+   Additional generators of pseudorandom numbers.
+   Vadim Isaev, 2020
+   ************************************************************ *)
+
+MODULE RandExt;
+
+IMPORT HOST, MathRound, MathBits;
+
+CONST
+  (* Для алгоритма Мерсена-Твистера *)
+  N          = 624;
+  M          = 397;
+  MATRIX_A   = 9908B0DFH;  (* constant vector a *)
+  UPPER_MASK = 80000000H;  (* most significant w-r bits *)
+  LOWER_MASK = 7FFFFFFFH;  (* least significant r bits *)
+  INT_MAX    = 4294967295;
+
+
+TYPE
+(* структура служебных данных, для алгоритма mrg32k3a *)
+  random_t = RECORD
+    mrg32k3a_seed       : REAL;
+    mrg32k3a_x          : ARRAY 3 OF REAL;
+    mrg32k3a_y          : ARRAY 3 OF REAL
+  END;
+
+  (* Для алгоритма Мерсена-Твистера *)
+  MTKeyArray = ARRAY N OF INTEGER;
+
+VAR
+  (* Для алгоритма mrg32k3a *)
+  prndl: random_t;
+  (* Для алгоритма Мерсена-Твистера *)
+  mt  : MTKeyArray;  (* the array for the state vector *)
+  mti : INTEGER;     (* mti == N+1 means mt[N] is not initialized *)
+
+(* ---------------------------------------------------------------------------
+   Генератор какбыслучайных чисел в диапазоне [a,b].
+   Алгоритм 133б из книги "Агеев и др. - Бибилотека алгоритмов 101б-150б",
+   стр. 53.
+   Переделка из Algol на Oberon и доработка, Вадим Исаев, 2020
+
+   Generator pseudorandom numbers, algorithm 133b from
+   Comm ACM 5,10 (Oct 1962) 553.
+   Convert from Algol to Oberon Vadim Isaev, 2020.
+
+   Входные параметры:
+     a - начальное вычисляемое значение, тип REAL;
+     b - конечное вычисляемое значение, тип REAL;
+     seed - начальное значение для генерации случайного числа.
+            Должно быть в диапазоне от 10 000 000 000 до 34 359 738 368 (2^35),
+            нечётное.
+   --------------------------------------------------------------------------- *)
+PROCEDURE alg133b* (a, b: REAL; VAR seed: INTEGER): REAL;
+CONST
+  m35 = 34359738368;
+  m36 = 68719476736;
+  m37 = 137438953472;
+
+VAR
+  x: INTEGER;
+BEGIN
+  IF seed # 0 THEN
+    IF  (seed MOD 2 = 0) THEN
+      seed := seed + 1
+    END;
+    x:=seed;
+    seed:=0;
+  END;
+
+  x:=5*x;
+  IF x>=m37 THEN
+    x:=x-m37
+  END;
+  IF x>=m36 THEN
+    x:=x-m36
+  END;
+  IF x>=m35 THEN
+    x:=x-m35
+  END;
+
+  RETURN FLT(x) / FLT(m35) * (b - a) + a
+END alg133b;
+
+(* ----------------------------------------------------------
+   Генератор почти равномерно распределённых
+   какбыслучайных чисел mrg32k3a
+   (Combined Multiple Recursive Generator) от 0 до 1.
+   Период повторения последовательности = 2^127
+
+   Generator pseudorandom numbers,
+   algorithm mrg32k3a.
+
+   Переделка из FreePascal на Oberon, Вадим Исаев, 2020
+   Convert from FreePascal to Oberon, Vadim Isaev, 2020
+   ---------------------------------------------------------- *)
+(* Инициализация генератора.
+
+   Входные параметры:
+     seed  - значение для инициализации. Любое. Если передать
+             ноль, то вместо ноля будет подставлено кол-во
+             процессорных тиков. *)
+PROCEDURE mrg32k3a_init* (seed: REAL);
+BEGIN
+  prndl.mrg32k3a_x[0] := 1.0;
+  prndl.mrg32k3a_x[1] := 1.0;
+  prndl.mrg32k3a_y[0] := 1.0;
+  prndl.mrg32k3a_y[1] := 1.0;
+  prndl.mrg32k3a_y[2] := 1.0;
+
+  IF seed # 0.0 THEN
+    prndl.mrg32k3a_x[2] := seed;
+  ELSE
+    prndl.mrg32k3a_x[2] := FLT(HOST.GetTickCount());
+  END;
+
+END mrg32k3a_init;
+
+(* Генератор какбыслучайных чисел от 0.0 до 1.0. *)
+PROCEDURE mrg32k3a* (): REAL;
+
+CONST
+  (* random MRG32K3A algorithm constants *)
+  MRG32K3A_NORM = 2.328306549295728E-10;
+  MRG32K3A_M1   = 4294967087.0;
+  MRG32K3A_M2   = 4294944443.0;
+  MRG32K3A_A12  = 1403580.0;
+  MRG32K3A_A13  = 810728.0;
+  MRG32K3A_A21  = 527612.0;
+  MRG32K3A_A23  = 1370589.0;
+  RAND_BUFSIZE  = 512;
+
+VAR
+
+  xn, yn, result: REAL;
+
+BEGIN
+  (* Часть 1 *)
+  xn := MRG32K3A_A12 * prndl.mrg32k3a_x[1] - MRG32K3A_A13 * prndl.mrg32k3a_x[2];
+  xn := xn - MathRound.trunc(xn / MRG32K3A_M1) * MRG32K3A_M1;
+  IF xn < 0.0 THEN
+    xn := xn + MRG32K3A_M1;
+  END;
+
+  prndl.mrg32k3a_x[2] := prndl.mrg32k3a_x[1];
+  prndl.mrg32k3a_x[1] := prndl.mrg32k3a_x[0];
+  prndl.mrg32k3a_x[0] := xn;
+
+  (* Часть 2 *)
+  yn := MRG32K3A_A21 * prndl.mrg32k3a_y[0] - MRG32K3A_A23 * prndl.mrg32k3a_y[2];
+  yn := yn - MathRound.trunc(yn / MRG32K3A_M2) * MRG32K3A_M2;
+  IF yn < 0.0 THEN
+    yn := yn + MRG32K3A_M2;
+  END;
+
+  prndl.mrg32k3a_y[2] := prndl.mrg32k3a_y[1];
+  prndl.mrg32k3a_y[1] := prndl.mrg32k3a_y[0];
+  prndl.mrg32k3a_y[0] := yn;
+
+  (* Смешение частей *)
+  IF xn <= yn THEN
+    result := ((xn - yn + MRG32K3A_M1) * MRG32K3A_NORM)
+  ELSE
+    result := (xn - yn) * MRG32K3A_NORM;
+  END;
+
+  RETURN result
+END mrg32k3a;
+
+
+(* -------------------------------------------------------------------
+    Генератор какбыслучайных чисел, алгоритм Мерсена-Твистера (MT19937).
+    Переделка из Delphi в Oberon Вадим Исаев, 2020.
+
+    Mersenne Twister Random Number Generator.
+
+    A C-program for MT19937, with initialization improved 2002/1/26.
+    Coded by Takuji Nishimura and Makoto Matsumoto.
+
+    Adapted for DMath by Jean Debord - Feb. 2007
+    Adapted for Oberon-07 by Vadim Isaev - May 2020
+  ------------------------------------------------------------ *)
+(* Initializes MT generator with a seed *)
+PROCEDURE InitMT(Seed : INTEGER);
+VAR
+  i : INTEGER;
+BEGIN
+  mt[0] := MathBits.iand(Seed, INT_MAX);
+  FOR i := 1 TO N-1 DO
+      mt[i] := (1812433253 * MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) + i);
+        (* See Knuth TAOCP Vol2. 3rd Ed. P.106 For multiplier.
+          In the previous versions, MSBs of the seed affect
+          only MSBs of the array mt[].
+          2002/01/09 modified by Makoto Matsumoto *)
+      mt[i] := MathBits.iand(mt[i], INT_MAX);
+        (* For >32 Bit machines *)
+  END;
+  mti := N;
+END InitMT;
+
+(* Initialize MT generator with an array InitKey[0..(KeyLength - 1)] *)
+PROCEDURE InitMTbyArray(InitKey : MTKeyArray; KeyLength : INTEGER);
+VAR
+  i, j, k, k1 : INTEGER;
+BEGIN
+  InitMT(19650218);
+
+  i := 1;
+  j := 0;
+
+  IF N > KeyLength THEN
+    k1 := N
+  ELSE
+    k1 := KeyLength;
+  END;
+
+  FOR k := k1 TO 1 BY -1 DO
+    (* non linear *)
+    mt[i] := MathBits.ixor(mt[i], (MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) * 1664525)) + InitKey[j] + j;
+    mt[i] := MathBits.iand(mt[i], INT_MAX); (* for WORDSIZE > 32 machines *)
+    INC(i);
+    INC(j);
+    IF i >= N THEN
+      mt[0] := mt[N-1];
+      i := 1;
+    END;
+    IF j >= KeyLength THEN
+      j := 0;
+    END;
+  END;
+
+  FOR k := N-1 TO 1 BY -1 DO
+    (* non linear *)
+    mt[i] := MathBits.ixor(mt[i], (MathBits.ixor(mt[i-1], LSR(mt[i-1], 30)) * 1566083941)) - i;
+    mt[i] := MathBits.iand(mt[i], INT_MAX); (* for WORDSIZE > 32 machines *)
+    INC(i);
+    IF i >= N THEN
+      mt[0] := mt[N-1];
+      i := 1;
+    END;
+  END;
+
+  mt[0] := UPPER_MASK; (* MSB is 1; assuring non-zero initial array *)
+
+END InitMTbyArray;
+
+(* Generates a integer Random number on [-2^31 .. 2^31 - 1] interval *)
+PROCEDURE IRanMT(): INTEGER;
+VAR
+  mag01 : ARRAY 2 OF INTEGER;
+  y,k   : INTEGER;
+BEGIN
+  IF mti >= N THEN  (* generate N words at one Time *)
+    (* If IRanMT() has not been called, a default initial seed is used *)
+    IF mti = N + 1 THEN
+      InitMT(5489);
+    END;
+
+    FOR k := 0 TO (N-M)-1 DO
+      y := MathBits.ior(MathBits.iand(mt[k], UPPER_MASK), MathBits.iand(mt[k+1], LOWER_MASK));
+      mt[k] := MathBits.ixor(MathBits.ixor(mt[k+M], LSR(y, 1)), mag01[MathBits.iand(y, 1H)]);
+    END;
+
+    FOR k := (N-M) TO (N-2) DO
+      y := MathBits.ior(MathBits.iand(mt[k], UPPER_MASK), MathBits.iand(mt[k+1], LOWER_MASK));
+      mt[k] := MathBits.ixor(mt[k - (N - M)], MathBits.ixor(LSR(y, 1), mag01[MathBits.iand(y, 1H)]));
+    END;
+
+    y := MathBits.ior(MathBits.iand(mt[N-1], UPPER_MASK), MathBits.iand(mt[0], LOWER_MASK));
+    mt[N-1] := MathBits.ixor(mt[M-1], MathBits.ixor(LSR(y, 1), mag01[MathBits.iand(y, 1H)]));
+
+    mti := 0;
+  END;
+
+  y := mt[mti];
+  INC(mti);
+
+  (* Tempering *)
+  y := MathBits.ixor(y, LSR(y, 11));
+  y := MathBits.ixor(y, MathBits.iand(LSL(y,  7), 9D2C5680H));
+  y := MathBits.ixor(y, MathBits.iand(LSL(y, 15), 4022730752));
+  y := MathBits.ixor(y, LSR(y, 18));
+
+  RETURN y
+END IRanMT;
+
+(* Generates a real Random number on [0..1] interval *)
+PROCEDURE RRanMT(): REAL;
+BEGIN
+  RETURN FLT(IRanMT())/FLT(INT_MAX)
+END RRanMT;
+
+
+END RandExt.

+ 460 - 0
lib/RVMxI/32/FPU.ob07

@@ -0,0 +1,460 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE FPU;
+
+
+CONST
+
+    INF  = 07F800000H;
+    NINF = 0FF800000H;
+    NAN  = 07FC00000H;
+
+
+PROCEDURE div2 (b, a: INTEGER): INTEGER;
+VAR
+    n, e, r, s: INTEGER;
+
+BEGIN
+    s := ORD(BITS(a) / BITS(b) - {0..30});
+    e := (a DIV 800000H) MOD 256 - (b DIV 800000H) MOD 256 + 127;
+
+    a := a MOD 800000H + 800000H;
+    b := b MOD 800000H + 800000H;
+
+    n := 800000H;
+    r := 0;
+
+    IF a < b THEN
+        a := a * 2;
+        DEC(e)
+    END;
+
+    WHILE (a > 0) & (n > 0) DO
+        IF a >= b THEN
+            INC(r, n);
+            DEC(a, b)
+        END;
+        a := a * 2;
+        n := n DIV 2
+    END;
+
+    IF e <= 0 THEN
+        e := 0;
+        r := 800000H;
+        s := 0
+    ELSIF e >= 255 THEN
+        e := 255;
+        r := 800000H
+    END
+
+    RETURN (r - 800000H) + e * 800000H + s
+END div2;
+
+
+PROCEDURE mul2 (b, a: INTEGER): INTEGER;
+VAR
+    e, r, s: INTEGER;
+
+BEGIN
+    s := ORD(BITS(a) / BITS(b) - {0..30});
+    e := (a DIV 800000H) MOD 256 + (b DIV 800000H) MOD 256 - 127;
+
+    a := a MOD 800000H + 800000H;
+    b := b MOD 800000H + 800000H;
+
+    r := a * (b MOD 256);
+    b := b DIV 256;
+    r := LSR(r, 8);
+
+    INC(r, a * (b MOD 256));
+    b := b DIV 256;
+    r := LSR(r, 8);
+
+    INC(r, a * (b MOD 256));
+    r := LSR(r, 7);
+
+    IF r >= 1000000H THEN
+        r := r DIV 2;
+        INC(e)
+    END;
+
+    IF e <= 0 THEN
+        e := 0;
+        r := 800000H;
+        s := 0
+    ELSIF e >= 255 THEN
+        e := 255;
+        r := 800000H
+    END
+
+    RETURN (r - 800000H) + e * 800000H + s
+END mul2;
+
+
+PROCEDURE add2 (b, a: INTEGER): INTEGER;
+VAR
+    t, e, d: INTEGER;
+
+BEGIN
+    e := (a DIV 800000H) MOD 256;
+    t := (b DIV 800000H) MOD 256;
+    d := e - t;
+
+    a := a MOD 800000H + 800000H;
+    b := b MOD 800000H + 800000H;
+
+    IF d > 0 THEN
+        IF d < 24 THEN
+            b := LSR(b, d)
+        ELSE
+            b := 0
+        END
+    ELSIF d < 0 THEN
+        IF d > -24 THEN
+            a := LSR(a, -d)
+        ELSE
+            a := 0
+        END;
+        e := t
+    END;
+
+    INC(a, b);
+
+    IF a >= 1000000H THEN
+        a := a DIV 2;
+        INC(e)
+    END;
+
+    IF e >= 255 THEN
+        e := 255;
+        a := 800000H
+    END
+
+    RETURN (a - 800000H) + e * 800000H
+END add2;
+
+
+PROCEDURE sub2 (b, a: INTEGER): INTEGER;
+VAR
+    t, e, d, s: INTEGER;
+
+BEGIN
+    e := (a DIV 800000H) MOD 256;
+    t := (b DIV 800000H) MOD 256;
+
+    a := a MOD 800000H + 800000H;
+    b := b MOD 800000H + 800000H;
+
+    d := e - t;
+
+    IF (d > 0) OR (d = 0) & (a >= b) THEN
+        s := 0
+    ELSE
+        e := t;
+        d := -d;
+        t := a;
+        a := b;
+        b := t;
+        s := 80000000H
+    END;
+
+    IF d > 0 THEN
+        IF d < 24 THEN
+            b := LSR(b, d)
+        ELSE
+            b := 0
+        END
+    END;
+
+    DEC(a, b);
+
+    IF a = 0 THEN
+        e := 0;
+        a := 800000H;
+        s := 0
+    ELSE
+        WHILE a < 800000H DO
+            a := a * 2;
+            DEC(e)
+        END
+    END;
+
+    IF e <= 0 THEN
+        e := 0;
+        a := 800000H;
+        s := 0
+    END
+
+    RETURN (a - 800000H) + e * 800000H + s
+END sub2;
+
+
+PROCEDURE zero (VAR x: INTEGER);
+BEGIN
+    IF LSR(LSL(x, 1), 24) = 0 THEN
+        x := 0
+    END
+END zero;
+
+
+PROCEDURE isNaN (a: INTEGER): BOOLEAN;
+    RETURN (a > INF) OR (a < 0) & (a > NINF)
+END isNaN;
+
+
+PROCEDURE isInf (a: INTEGER): BOOLEAN;
+    RETURN LSL(a, 1) = 0FF000000H
+END isInf;
+
+
+PROCEDURE isNormal (a, b: INTEGER): BOOLEAN;
+    RETURN (LSR(LSL(a, 1), 24) # 255) & (LSR(LSL(a, 1), 24) # 0) &
+           (LSR(LSL(b, 1), 24) # 255) & (LSR(LSL(b, 1), 24) # 0)
+END isNormal;
+
+
+PROCEDURE add* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a); zero(b);
+
+    IF isNormal(a, b) THEN
+
+        IF a > 0 THEN
+            IF b > 0 THEN
+                r := add2(b, a)
+            ELSE
+                r := sub2(b, a)
+            END
+        ELSE
+            IF b > 0 THEN
+                r := sub2(a, b)
+            ELSE
+                r := add2(b, a) + 80000000H
+            END
+        END
+
+    ELSIF isNaN(a) OR isNaN(b) THEN
+        r := NAN
+    ELSIF isInf(a) & isInf(b) THEN
+        IF a = b THEN
+            r := a
+        ELSE
+            r := NAN
+        END
+    ELSIF isInf(a) THEN
+        r := a
+    ELSIF isInf(b) THEN
+        r := b
+    ELSIF a = 0 THEN
+        r := b
+    ELSIF b = 0 THEN
+        r := a
+    END
+
+    RETURN r
+END add;
+
+
+PROCEDURE sub* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a); zero(b);
+
+    IF isNormal(a, b) THEN
+
+        IF a > 0 THEN
+            IF b > 0 THEN
+                r := sub2(b, a)
+            ELSE
+                r := add2(b, a)
+            END
+        ELSE
+            IF b > 0 THEN
+                r := add2(b, a) + 80000000H
+            ELSE
+                r := sub2(a, b)
+            END
+        END
+
+    ELSIF isNaN(a) OR isNaN(b) THEN
+        r := NAN
+    ELSIF isInf(a) & isInf(b) THEN
+        IF a # b THEN
+            r := a
+        ELSE
+            r := NAN
+        END
+    ELSIF isInf(a) THEN
+        r := a
+    ELSIF isInf(b) THEN
+        r := INF + ORD(BITS(b) / {31} - {0..30})
+    ELSIF (a = 0) & (b = 0) THEN
+        r := 0
+    ELSIF a = 0 THEN
+        r := ORD(BITS(b) / {31})
+    ELSIF b = 0 THEN
+        r := a
+    END
+
+    RETURN r
+END sub;
+
+
+PROCEDURE mul* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a); zero(b);
+
+    IF isNormal(a, b) THEN
+        r := mul2(b, a)
+    ELSIF isNaN(a) OR isNaN(b) OR (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
+        r := NAN
+    ELSIF isInf(a) OR isInf(b) THEN
+        r := INF + ORD(BITS(a) / BITS(b) - {0..30})
+    ELSIF (a = 0) OR (b = 0) THEN
+        r := 0
+    END
+
+    RETURN r
+END mul;
+
+
+PROCEDURE _div* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a); zero(b);
+
+    IF isNormal(a, b) THEN
+        r := div2(b, a)
+    ELSIF isNaN(a) OR isNaN(b) OR isInf(a) & isInf(b) THEN
+        r := NAN
+    ELSIF isInf(a) THEN
+        r := INF + ORD(BITS(a) / BITS(b) - {0..30})
+    ELSIF isInf(b) THEN
+        r := 0
+    ELSIF a = 0 THEN
+        IF b = 0 THEN
+            r := NAN
+        ELSE
+            r := 0
+        END
+    ELSIF b = 0 THEN
+        IF a > 0 THEN
+            r := INF
+        ELSE
+            r := NINF
+        END
+    END
+
+    RETURN r
+END _div;
+
+
+PROCEDURE cmp* (op, b, a: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    zero(a); zero(b);
+
+    IF isNaN(a) OR isNaN(b) THEN
+        res := op = 1
+    ELSE
+        IF (a < 0) & (b < 0) THEN
+            INC(op, 6)
+        END;
+
+        CASE op OF
+        |0,  6: res := a = b
+        |1,  7: res := a # b
+        |2, 10: res := a < b
+        |3, 11: res := a <= b
+        |4,  8: res := a > b
+        |5,  9: res := a >= b
+        END
+    END
+
+    RETURN res
+END cmp;
+
+
+PROCEDURE flt* (x: INTEGER): INTEGER;
+VAR
+    n, y, s: INTEGER;
+
+BEGIN
+    IF x = 0 THEN
+        s := 0;
+        x := 800000H;
+        n := -126
+    ELSIF x = 80000000H THEN
+        s := 80000000H;
+        x := 800000H;
+        n := 32
+    ELSE
+        IF x < 0 THEN
+            s := 80000000H;
+            x := -x
+        ELSE
+            s := 0
+        END;
+        n := 0;
+        y := x;
+        WHILE y > 0 DO
+            y := y DIV 2;
+            INC(n)
+        END;
+        IF n > 24 THEN
+            x := LSR(x, n - 24)
+        ELSE
+            x := LSL(x, 24 - n)
+        END
+    END
+
+    RETURN (x - 800000H) + (n + 126) * 800000H + s
+END flt;
+
+
+PROCEDURE floor* (x: INTEGER): INTEGER;
+VAR
+    r, e: INTEGER;
+
+BEGIN
+    zero(x);
+
+    e := (x DIV 800000H) MOD 256 - 127;
+    r := x MOD 800000H + 800000H;
+
+    IF (0 <= e) & (e <= 22) THEN
+        r := LSR(r, 23 - e) + ORD((x < 0) & (LSL(r, e + 9) # 0))
+    ELSIF (23 <= e) & (e <= 54) THEN
+        r := LSL(r, e - 23)
+    ELSIF (e < 0) & (x < 0) THEN
+        r := 1
+    ELSE
+        r := 0
+    END;
+
+    IF x < 0 THEN
+        r := -r
+    END
+
+    RETURN r
+END floor;
+
+
+END FPU.

+ 186 - 0
lib/RVMxI/32/HOST.ob07

@@ -0,0 +1,186 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+    $IF (host_linux)
+
+    slash* = "/";
+    eol* = 0AX;
+
+    $ELSE
+
+    slash* = "\";
+    eol* = 0DX + 0AX;
+
+    $END
+
+    bit_depth* = 32;
+    maxint* = 7FFFFFFFH;
+    minint* = 80000000H;
+
+
+VAR
+
+    maxreal*, inf*: REAL;
+
+
+PROCEDURE syscall0 (fn: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall0;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall3;
+
+
+PROCEDURE syscall4 (fn, p1, p2, p3, p4: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall4;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+    code := syscall1(0, code)
+END ExitProcess;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall2(1, LEN(path), SYSTEM.ADR(path[0]))
+END GetCurrentDirectory;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+BEGIN
+    n := syscall3(2, n, LEN(s), SYSTEM.ADR(s[0]))
+END GetArg;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+    RETURN syscall4(3, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+    RETURN syscall4(4, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN syscall2(5, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+BEGIN
+    F := syscall1(6, F)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN syscall2(7, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall2(12, LEN(FName), SYSTEM.ADR(FName[0]))
+END chmod;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall1(8, ORD(c))
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+    RETURN syscall0(9)
+END GetTickCount;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+    RETURN syscall2(11, LEN(path), SYSTEM.ADR(path[0])) # 0
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+    RETURN syscall0(10)
+END UnixTime;
+
+
+PROCEDURE s2d (x: INTEGER; VAR h, l: INTEGER);
+VAR
+    s, e, f: INTEGER;
+BEGIN
+    s := ASR(x, 31) MOD 2;
+    f := x MOD 800000H;
+    e := (x DIV 800000H) MOD 256;
+    IF e = 255 THEN
+        e := 2047
+    ELSE
+        INC(e, 896)
+    END;
+    h := LSL(s, 31) + LSL(e, 20) + (f DIV 8);
+    l := (f MOD 8) * 20000000H
+END s2d;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+    i: INTEGER;
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), i)
+    RETURN i
+END d2s;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+BEGIN
+    s2d(d2s(x), b, a)
+    RETURN a
+END splitf;
+
+
+BEGIN
+    inf := SYSTEM.INF();
+    maxreal := 1.9;
+    PACK(maxreal, 127)
+END HOST.

+ 273 - 0
lib/RVMxI/32/Out.ob07

@@ -0,0 +1,273 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2016, 2018, 2020, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT HOST, SYSTEM;
+
+
+PROCEDURE Char* (c: CHAR);
+BEGIN
+    HOST.OutChar(c)
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+VAR
+    i, n: INTEGER;
+
+BEGIN
+    n := LENGTH(s) - 1;
+    FOR i := 0 TO n DO
+        Char(s[i])
+    END
+END String;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+VAR
+    i, a: INTEGER;
+    str: ARRAY 12 OF CHAR;
+
+BEGIN
+    IF x = 80000000H THEN
+        COPY("-2147483648", str);
+        DEC(width, 11)
+    ELSE
+        i := 0;
+        IF x < 0 THEN
+            x := -x;
+            i := 1;
+            str[0] := "-"
+        END;
+
+        a := x;
+        REPEAT
+            INC(i);
+            a := a DIV 10
+        UNTIL a = 0;
+
+        str[i] := 0X;
+        DEC(width, i);
+
+        REPEAT
+            DEC(i);
+            str[i] := CHR(x MOD 10 + ORD("0"));
+            x := x DIV 10
+        UNTIL x = 0
+    END;
+
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    String(str)
+END Int;
+
+
+PROCEDURE Inf (x: REAL; width: INTEGER);
+VAR
+    s: ARRAY 5 OF CHAR;
+
+BEGIN
+    DEC(width, 4);
+    IF x # x THEN
+        s := " Nan"
+    ELSIF x = SYSTEM.INF() THEN
+        s := "+Inf"
+    ELSIF x = -SYSTEM.INF() THEN
+        s := "-Inf"
+    END;
+
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    String(s)
+END Inf;
+
+
+PROCEDURE Ln*;
+BEGIN
+    Char(0DX);
+    Char(0AX)
+END Ln;
+
+
+PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
+VAR
+    a, b: REAL;
+
+BEGIN
+    ASSERT(x > 0.0);
+    n := 0;
+    WHILE x < 1.0 DO
+        x := x * 10.0;
+        DEC(n)
+    END;
+
+    a := 10.0;
+    b := 1.0;
+
+    WHILE a <= x DO
+        b := a;
+        a := a * 10.0;
+        INC(n)
+    END;
+    x := x / b
+END unpk10;
+
+
+PROCEDURE _Real (x: REAL; width: INTEGER);
+VAR
+    n, k, p: INTEGER;
+
+BEGIN
+    p := MIN(MAX(width - 7, 1), 10);
+
+    width := width - p - 7;
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    IF x < 0.0 THEN
+        Char("-");
+        x := -x
+    ELSE
+        Char(20X)
+    END;
+
+    unpk10(x, n);
+
+    k := FLOOR(x);
+    Char(CHR(k + 30H));
+    Char(".");
+
+    WHILE p > 0 DO
+        x := (x - FLT(k)) * 10.0;
+        k := FLOOR(x);
+        Char(CHR(k + 30H));
+        DEC(p)
+    END;
+
+    Char("E");
+    IF n >= 0 THEN
+        Char("+")
+    ELSE
+        Char("-")
+    END;
+    n := ABS(n);
+    Char(CHR(n DIV 10 + 30H));
+    Char(CHR(n MOD 10 + 30H))
+END _Real;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+    IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
+        Inf(x, width)
+    ELSIF x = 0.0 THEN
+        WHILE width > 17 DO
+            Char(20X);
+            DEC(width)
+        END;
+        DEC(width, 8);
+        String(" 0.0");
+        WHILE width > 0 DO
+            Char("0");
+            DEC(width)
+        END;
+        String("E+00")
+    ELSE
+        _Real(x, width)
+    END
+END Real;
+
+
+PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
+VAR
+    n, k: INTEGER;
+    minus: BOOLEAN;
+
+BEGIN
+    minus := x < 0.0;
+    IF minus THEN
+        x := -x
+    END;
+
+    unpk10(x, n);
+
+    DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    IF minus THEN
+        Char("-")
+    ELSE
+        Char(20X)
+    END;
+
+    IF n < 0 THEN
+        INC(n);
+        Char("0");
+        Char(".");
+        WHILE (n < 0) & (p > 0) DO
+            Char("0");
+            INC(n);
+            DEC(p)
+        END
+    ELSE
+        WHILE n >= 0 DO
+            k := FLOOR(x);
+            Char(CHR(k + 30H));
+            x := (x - FLT(k)) * 10.0;
+            DEC(n)
+        END;
+        Char(".")
+    END;
+
+    WHILE p > 0 DO
+        k := FLOOR(x);
+        Char(CHR(k + 30H));
+        x := (x - FLT(k)) * 10.0;
+        DEC(p)
+    END
+
+END _FixReal;
+
+
+PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
+BEGIN
+    IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
+        Inf(x, width)
+    ELSIF x = 0.0 THEN
+        DEC(width, 3 + MAX(p, 0));
+        WHILE width > 0 DO
+            Char(20X);
+            DEC(width)
+        END;
+        String(" 0.");
+        WHILE p > 0 DO
+            Char("0");
+            DEC(p)
+        END
+    ELSE
+        _FixReal(x, width, p)
+    END
+END FixReal;
+
+
+PROCEDURE Open*;
+END Open;
+
+
+END Out.

+ 411 - 0
lib/RVMxI/32/RTL.ob07

@@ -0,0 +1,411 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, F := FPU, Trap;
+
+
+CONST
+
+    bit_depth = 32;
+    maxint = 7FFFFFFFH;
+    minint = 80000000H;
+
+    WORD = bit_depth DIV 8;
+    MAX_SET = bit_depth - 1;
+
+
+VAR
+
+    Heap, Types, TypesCount: INTEGER;
+
+
+PROCEDURE _error* (modnum, _module, err, line: INTEGER);
+BEGIN
+    Trap.trap(modnum, _module, err, line)
+END _error;
+
+
+PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
+    RETURN F.mul(b, a)
+END _fmul;
+
+
+PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
+    RETURN F._div(b, a)
+END _fdiv;
+
+
+PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
+    RETURN F._div(a, b)
+END _fdivi;
+
+
+PROCEDURE _fadd* (b, a: INTEGER): INTEGER;
+    RETURN F.add(b, a)
+END _fadd;
+
+
+PROCEDURE _fsub* (b, a: INTEGER): INTEGER;
+    RETURN F.sub(b, a)
+END _fsub;
+
+
+PROCEDURE _fsubi* (b, a: INTEGER): INTEGER;
+    RETURN F.sub(a, b)
+END _fsubi;
+
+
+PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN;
+    RETURN F.cmp(op, b, a)
+END _fcmp;
+
+
+PROCEDURE _floor* (x: INTEGER): INTEGER;
+    RETURN F.floor(x)
+END _floor;
+
+
+PROCEDURE _flt* (x: INTEGER): INTEGER;
+    RETURN F.flt(x)
+END _flt;
+
+
+PROCEDURE _pack* (n: INTEGER; VAR x: SET);
+BEGIN
+    n := LSL((LSR(ORD(x), 23) MOD 256 + n) MOD 256, 23);
+    x := x - {23..30} + BITS(n)
+END _pack;
+
+
+PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET);
+BEGIN
+    n := LSR(ORD(x), 23) MOD 256 - 127;
+    x := x - {30} + {23..29}
+END _unpk;
+
+
+PROCEDURE _rot* (VAR A: ARRAY OF INTEGER);
+VAR
+    i, n, k: INTEGER;
+
+BEGIN
+    k := LEN(A) - 1;
+    n := A[0];
+    i := 0;
+    WHILE i < k DO
+        A[i] := A[i + 1];
+        INC(i)
+    END;
+    A[k] := n
+END _rot;
+
+
+PROCEDURE _set* (b, a: INTEGER): INTEGER;
+BEGIN
+    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;
+        a := LSR(ASR(minint, b - a), MAX_SET - b)
+    ELSE
+        a := 0
+    END
+
+    RETURN a
+END _set;
+
+
+PROCEDURE _set1* (a: INTEGER): INTEGER;
+BEGIN
+    IF ASR(a, 5) = 0 THEN
+        a := LSL(1, a)
+    ELSE
+        a := 0
+    END
+    RETURN a
+END _set1;
+
+
+PROCEDURE _length* (len, str: INTEGER): INTEGER;
+VAR
+    c: CHAR;
+    res: INTEGER;
+
+BEGIN
+    res := 0;
+    REPEAT
+        SYSTEM.GET(str, c);
+        INC(str);
+        DEC(len);
+        INC(res)
+    UNTIL (len = 0) OR (c = 0X);
+
+    RETURN res - ORD(c = 0X)
+END _length;
+
+
+PROCEDURE _move* (bytes, dest, source: INTEGER);
+VAR
+    b: BYTE;
+    i: INTEGER;
+
+BEGIN
+    IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN
+        WHILE bytes >= WORD DO
+            SYSTEM.GET(source, i);
+            SYSTEM.PUT(dest, i);
+            INC(source, WORD);
+            INC(dest, WORD);
+            DEC(bytes, WORD)
+        END
+    END;
+
+    WHILE bytes > 0 DO
+        SYSTEM.GET(source, b);
+        SYSTEM.PUT8(dest, b);
+        INC(source);
+        INC(dest);
+        DEC(bytes)
+    END
+END _move;
+
+
+PROCEDURE _lengthw* (len, str: INTEGER): INTEGER;
+VAR
+    c: WCHAR;
+    res: INTEGER;
+
+BEGIN
+    res := 0;
+    REPEAT
+        SYSTEM.GET(str, c);
+        INC(str, 2);
+        DEC(len);
+        INC(res)
+    UNTIL (len = 0) OR (c = 0X);
+
+    RETURN res - ORD(c = 0X)
+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 _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    ptr := Heap;
+    IF ptr + size < Trap.sp() - 64 THEN
+        INC(Heap, size);
+        p := ptr + WORD;
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD);
+        DEC(size, WORD);
+        WHILE size > 0 DO
+            SYSTEM.PUT(ptr, 0);
+            INC(ptr, WORD);
+            DEC(size, WORD)
+        END
+    ELSE
+        p := 0
+    END
+END _new;
+
+
+PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    ELSE
+        _type := t
+    END
+
+    RETURN _type = t
+END _guard;
+
+
+PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    _type := 0;
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    END
+
+    RETURN _type = t
+END _is;
+
+
+PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+    WHILE (t1 # t0) & (t1 # 0) DO
+        SYSTEM.GET(Types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE _init* (tcount, heap, types: INTEGER);
+BEGIN
+    Heap := heap;
+    TypesCount := tcount;
+    Types := types
+END _init;
+
+
+END RTL.

+ 133 - 0
lib/RVMxI/32/Trap.ob07

@@ -0,0 +1,133 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Trap;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    SP = 4;
+
+
+PROCEDURE [code] sp* (): INTEGER
+    22, 0, SP;  (*  MOV R0, SP  *)
+
+
+PROCEDURE [code] syscall* (ptr: INTEGER)
+    22, 0, SP,  (*  MOV      R0, SP  *)
+    27, 0, 4,   (*  ADD      R0,  4  *)
+     9, 0, 0,   (*  LDW      R0, R0  *)
+    67, 0, 0;   (*  SYSCALL  R0      *)
+
+
+PROCEDURE Char (c: CHAR);
+VAR
+    a: ARRAY 2 OF INTEGER;
+
+BEGIN
+    a[0] := 8;
+    a[1] := ORD(c);
+    syscall(SYSTEM.ADR(a[0]))
+END Char;
+
+
+PROCEDURE String (s: ARRAY OF CHAR);
+VAR
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    WHILE s[i] # 0X DO
+        Char(s[i]);
+        INC(i)
+    END
+END String;
+
+
+PROCEDURE PString (ptr: INTEGER);
+VAR
+    c: CHAR;
+
+BEGIN
+    SYSTEM.GET(ptr, c);
+    WHILE c # 0X DO
+        Char(c);
+        INC(ptr);
+        SYSTEM.GET(ptr, c)
+    END
+END PString;
+
+
+PROCEDURE Ln;
+BEGIN
+    String(0DX + 0AX)
+END Ln;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE Int (x: INTEGER);
+VAR
+    s: ARRAY 32 OF CHAR;
+
+BEGIN
+    IntToStr(x, s);
+    String(s)
+END Int;
+
+
+PROCEDURE trap* (modnum, _module, err, line: INTEGER);
+VAR
+    s: ARRAY 32 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    Ln;
+    String("error ("); Int(err); String("): "); String(s); Ln;
+    String("module: "); PString(_module); Ln;
+    String("line: "); Int(line); Ln;
+
+    SYSTEM.CODE(0, 0, 0)  (*  STOP  *)
+END trap;
+
+
+END Trap.

+ 202 - 0
lib/RVMxI/64/HOST.ob07

@@ -0,0 +1,202 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+    $IF (host_linux)
+
+    slash* = "/";
+    eol* = 0AX;
+
+    $ELSE
+
+    slash* = "\";
+    eol* = 0DX + 0AX;
+
+    $END
+
+    bit_depth* = 64;
+    maxint* = ROR(-2, 1);
+    minint* = ROR(1, 1);
+
+
+VAR
+
+    maxreal*, inf*: REAL;
+
+
+PROCEDURE syscall0 (fn: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall0;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall3;
+
+
+PROCEDURE syscall4 (fn, p1, p2, p3, p4: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall4;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+    code := syscall1(0, code)
+END ExitProcess;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall2(1, LEN(path), SYSTEM.ADR(path[0]))
+END GetCurrentDirectory;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+BEGIN
+    n := syscall3(2, n, LEN(s), SYSTEM.ADR(s[0]))
+END GetArg;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+    RETURN syscall4(3, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+    RETURN syscall4(4, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN syscall2(5, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+BEGIN
+    F := syscall1(6, F)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN syscall2(7, LEN(FName), SYSTEM.ADR(FName[0]))
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall2(12, LEN(FName), SYSTEM.ADR(FName[0]))
+END chmod;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+    a: INTEGER;
+BEGIN
+    a := syscall1(8, ORD(c))
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+    RETURN syscall0(9)
+END GetTickCount;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+    RETURN syscall2(11, LEN(path), SYSTEM.ADR(path[0])) # 0
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+    RETURN syscall0(10)
+END UnixTime;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    a := 0;
+    b := 0;
+    SYSTEM.GET32(SYSTEM.ADR(x), a);
+    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
+    SYSTEM.GET(SYSTEM.ADR(x), res)
+    RETURN res
+END splitf;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+    h, l, s, e: INTEGER;
+
+BEGIN
+    e := splitf(x, l, h);
+
+    s := ASR(h, 31) MOD 2;
+    e := (h DIV 100000H) MOD 2048;
+    IF e <= 896 THEN
+        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
+        REPEAT
+            h := h DIV 2;
+            INC(e)
+        UNTIL e = 897;
+        e := 896;
+        l := (h MOD 8) * 20000000H;
+        h := h DIV 8
+    ELSIF (1151 <= e) & (e < 2047) THEN
+        e := 1151;
+        h := 0;
+        l := 0
+    ELSIF e = 2047 THEN
+        e := 1151;
+        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
+            h := 80000H;
+            l := 0
+        END
+    END;
+    DEC(e, 896)
+
+    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
+END d2s;
+
+
+BEGIN
+    inf := SYSTEM.INF();
+    maxreal := 1.9;
+    PACK(maxreal, 1023)
+END HOST.

+ 288 - 0
lib/RVMxI/64/Out.ob07

@@ -0,0 +1,288 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2016, 2018, 2020-2021 Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT HOST, SYSTEM;
+
+
+PROCEDURE Char* (c: CHAR);
+BEGIN
+    HOST.OutChar(c)
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+VAR
+    i, n: INTEGER;
+
+BEGIN
+    n := LENGTH(s) - 1;
+    FOR i := 0 TO n DO
+        Char(s[i])
+    END
+END String;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+VAR
+    i, a: INTEGER;
+    str: ARRAY 21 OF CHAR;
+
+BEGIN
+    IF x = ROR(1, 1) THEN
+        str := "-9223372036854775808";
+        DEC(width, 20)
+    ELSE
+        i := 0;
+        IF x < 0 THEN
+            x := -x;
+            i := 1;
+            str[0] := "-"
+        END;
+
+        a := x;
+        REPEAT
+            INC(i);
+            a := a DIV 10
+        UNTIL a = 0;
+
+        str[i] := 0X;
+        DEC(width, i);
+
+        REPEAT
+            DEC(i);
+            str[i] := CHR(x MOD 10 + ORD("0"));
+            x := x DIV 10
+        UNTIL x = 0
+    END;
+
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    String(str)
+END Int;
+
+
+PROCEDURE IsNan (x: REAL): BOOLEAN;
+CONST
+    INF  = LSR(ASR(ROR(1, 1), 10), 1);
+    NINF = ASR(ASR(ROR(1, 1), 10), 1);
+
+VAR
+    a: INTEGER;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), a)
+    RETURN (a > INF) OR (a < 0) & (a > NINF)
+END IsNan;
+
+
+PROCEDURE Inf (x: REAL; width: INTEGER);
+VAR
+    s: ARRAY 5 OF CHAR;
+
+BEGIN
+    DEC(width, 4);
+    IF IsNan(x) THEN
+        s := " Nan"
+    ELSIF x = SYSTEM.INF() THEN
+        s := "+Inf"
+    ELSIF x = -SYSTEM.INF() THEN
+        s := "-Inf"
+    END;
+
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    String(s)
+END Inf;
+
+
+PROCEDURE Ln*;
+BEGIN
+    Char(0DX);
+    Char(0AX)
+END Ln;
+
+
+PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
+VAR
+    a, b: REAL;
+
+BEGIN
+    ASSERT(x > 0.0);
+    n := 0;
+    WHILE x < 1.0 DO
+        x := x * 10.0;
+        DEC(n)
+    END;
+
+    a := 10.0;
+    b := 1.0;
+
+    WHILE a <= x DO
+        b := a;
+        a := a * 10.0;
+        INC(n)
+    END;
+    x := x / b
+END unpk10;
+
+
+PROCEDURE _Real (x: REAL; width: INTEGER);
+VAR
+    n, k, p: INTEGER;
+
+BEGIN
+    p := MIN(MAX(width - 8, 1), 15);
+
+    width := width - p - 8;
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    IF x < 0.0 THEN
+        Char("-");
+        x := -x
+    ELSE
+        Char(20X)
+    END;
+
+    unpk10(x, n);
+
+    k := FLOOR(x);
+    Char(CHR(k + 30H));
+    Char(".");
+
+    WHILE p > 0 DO
+        x := (x - FLT(k)) * 10.0;
+        k := FLOOR(x);
+        Char(CHR(k + 30H));
+        DEC(p)
+    END;
+
+    Char("E");
+    IF n >= 0 THEN
+        Char("+")
+    ELSE
+        Char("-")
+    END;
+    n := ABS(n);
+    Char(CHR(n DIV 100 + 30H)); n := n MOD 100;
+    Char(CHR(n DIV 10 + 30H));
+    Char(CHR(n MOD 10 + 30H))
+END _Real;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+    IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
+        Inf(x, width)
+    ELSIF x = 0.0 THEN
+        WHILE width > 23 DO
+            Char(20X);
+            DEC(width)
+        END;
+        DEC(width, 9);
+        String(" 0.0");
+        WHILE width > 0 DO
+            Char("0");
+            DEC(width)
+        END;
+        String("E+000")
+    ELSE
+        _Real(x, width)
+    END
+END Real;
+
+
+PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
+VAR
+    n, k: INTEGER;
+    minus: BOOLEAN;
+
+BEGIN
+    minus := x < 0.0;
+    IF minus THEN
+        x := -x
+    END;
+
+    unpk10(x, n);
+
+    DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
+    WHILE width > 0 DO
+        Char(20X);
+        DEC(width)
+    END;
+
+    IF minus THEN
+        Char("-")
+    ELSE
+        Char(20X)
+    END;
+
+    IF n < 0 THEN
+        INC(n);
+        Char("0");
+        Char(".");
+        WHILE (n < 0) & (p > 0) DO
+            Char("0");
+            INC(n);
+            DEC(p)
+        END
+    ELSE
+        WHILE n >= 0 DO
+            k := FLOOR(x);
+            Char(CHR(k + 30H));
+            x := (x - FLT(k)) * 10.0;
+            DEC(n)
+        END;
+        Char(".")
+    END;
+
+    WHILE p > 0 DO
+        k := FLOOR(x);
+        Char(CHR(k + 30H));
+        x := (x - FLT(k)) * 10.0;
+        DEC(p)
+    END
+
+END _FixReal;
+
+
+PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
+BEGIN
+    IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
+        Inf(x, width)
+    ELSIF x = 0.0 THEN
+        DEC(width, 3 + MAX(p, 0));
+        WHILE width > 0 DO
+            Char(20X);
+            DEC(width)
+        END;
+        String(" 0.");
+        WHILE p > 0 DO
+            Char("0");
+            DEC(p)
+        END
+    ELSE
+        _FixReal(x, width, p)
+    END
+END FixReal;
+
+
+PROCEDURE Open*;
+END Open;
+
+
+END Out.

+ 432 - 0
lib/RVMxI/64/RTL.ob07

@@ -0,0 +1,432 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, Trap;
+
+
+CONST
+
+    bit_depth = 64;
+    maxint = ROR(-2, 1);
+    minint = ROR(1, 1);
+
+    WORD = bit_depth DIV 8;
+    MAX_SET = bit_depth - 1;
+
+
+VAR
+
+    Heap, Types, TypesCount: INTEGER;
+
+
+PROCEDURE _error* (modnum, _module, err, line: INTEGER);
+BEGIN
+    Trap.trap(modnum, _module, err, line)
+END _error;
+
+
+PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall1;
+
+
+PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall2;
+
+
+PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
+BEGIN
+    Trap.syscall(SYSTEM.ADR(fn))
+    RETURN fn
+END syscall3;
+
+
+PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(100, b, a)
+END _fmul;
+
+
+PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(101, b, a)
+END _fdiv;
+
+
+PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(101, a, b)
+END _fdivi;
+
+
+PROCEDURE _fadd* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(102, b, a)
+END _fadd;
+
+
+PROCEDURE _fsub* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(103, b, a)
+END _fsub;
+
+
+PROCEDURE _fsubi* (b, a: INTEGER): INTEGER;
+    RETURN syscall2(103, a, b)
+END _fsubi;
+
+
+PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN;
+    RETURN syscall3(104, op, b, a) # 0
+END _fcmp;
+
+
+PROCEDURE _floor* (x: INTEGER): INTEGER;
+    RETURN syscall1(105, x)
+END _floor;
+
+
+PROCEDURE _flt* (x: INTEGER): INTEGER;
+    RETURN syscall1(106, x)
+END _flt;
+
+
+PROCEDURE _pack* (n: INTEGER; VAR x: SET);
+BEGIN
+    n := LSL((LSR(ORD(x), 52) MOD 2048 + n) MOD 2048, 52);
+    x := x - {52..62} + BITS(n)
+END _pack;
+
+
+PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET);
+BEGIN
+    n := LSR(ORD(x), 52) MOD 2048 - 1023;
+    x := x - {62} + {52..61}
+END _unpk;
+
+
+PROCEDURE _rot* (VAR A: ARRAY OF INTEGER);
+VAR
+    i, n, k: INTEGER;
+
+BEGIN
+    k := LEN(A) - 1;
+    n := A[0];
+    i := 0;
+    WHILE i < k DO
+        A[i] := A[i + 1];
+        INC(i)
+    END;
+    A[k] := n
+END _rot;
+
+
+PROCEDURE _set* (b, a: INTEGER): INTEGER;
+BEGIN
+    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;
+        a := LSR(ASR(minint, b - a), MAX_SET - b)
+    ELSE
+        a := 0
+    END
+
+    RETURN a
+END _set;
+
+
+PROCEDURE _set1* (a: INTEGER): INTEGER;
+BEGIN
+    IF ASR(a, 6) = 0 THEN
+        a := LSL(1, a)
+    ELSE
+        a := 0
+    END
+    RETURN a
+END _set1;
+
+
+PROCEDURE _length* (len, str: INTEGER): INTEGER;
+VAR
+    c: CHAR;
+    res: INTEGER;
+
+BEGIN
+    res := 0;
+    REPEAT
+        SYSTEM.GET(str, c);
+        INC(str);
+        DEC(len);
+        INC(res)
+    UNTIL (len = 0) OR (c = 0X);
+
+    RETURN res - ORD(c = 0X)
+END _length;
+
+
+PROCEDURE _move* (bytes, dest, source: INTEGER);
+VAR
+    b: BYTE;
+    i: INTEGER;
+
+BEGIN
+    IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN
+        WHILE bytes >= WORD DO
+            SYSTEM.GET(source, i);
+            SYSTEM.PUT(dest, i);
+            INC(source, WORD);
+            INC(dest, WORD);
+            DEC(bytes, WORD)
+        END
+    END;
+
+    WHILE bytes > 0 DO
+        SYSTEM.GET(source, b);
+        SYSTEM.PUT8(dest, b);
+        INC(source);
+        INC(dest);
+        DEC(bytes)
+    END
+END _move;
+
+
+PROCEDURE _lengthw* (len, str: INTEGER): INTEGER;
+VAR
+    c: WCHAR;
+    res: INTEGER;
+
+BEGIN
+    res := 0;
+    REPEAT
+        SYSTEM.GET(str, c);
+        INC(str, 2);
+        DEC(len);
+        INC(res)
+    UNTIL (len = 0) OR (c = 0X);
+
+    RETURN res - ORD(c = 0X)
+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 _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    ptr := Heap;
+    IF ptr + size < Trap.sp() - 128 THEN
+        INC(Heap, size);
+        p := ptr + WORD;
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD);
+        DEC(size, WORD);
+        WHILE size > 0 DO
+            SYSTEM.PUT(ptr, 0);
+            INC(ptr, WORD);
+            DEC(size, WORD)
+        END
+    ELSE
+        p := 0
+    END
+END _new;
+
+
+PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    ELSE
+        _type := t
+    END
+
+    RETURN _type = t
+END _guard;
+
+
+PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    _type := 0;
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    END
+
+    RETURN _type = t
+END _is;
+
+
+PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+    WHILE (t1 # t0) & (t1 # 0) DO
+        SYSTEM.GET(Types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE _init* (tcount, heap, types: INTEGER);
+BEGIN
+    Heap := heap;
+    TypesCount := tcount;
+    Types := types
+END _init;
+
+
+END RTL.

+ 133 - 0
lib/RVMxI/64/Trap.ob07

@@ -0,0 +1,133 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Trap;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    SP = 4;
+
+
+PROCEDURE [code] sp* (): INTEGER
+    22, 0, SP;  (*  MOV R0, SP  *)
+
+
+PROCEDURE [code] syscall* (ptr: INTEGER)
+    22, 0, SP,  (*  MOV      R0, SP  *)
+    27, 0, 8,   (*  ADD      R0,  8  *)
+    16, 0, 0,   (*  LDD      R0, R0  *)
+    67, 0, 0;   (*  SYSCALL  R0      *)
+
+
+PROCEDURE Char (c: CHAR);
+VAR
+    a: ARRAY 2 OF INTEGER;
+
+BEGIN
+    a[0] := 8;
+    a[1] := ORD(c);
+    syscall(SYSTEM.ADR(a[0]))
+END Char;
+
+
+PROCEDURE String (s: ARRAY OF CHAR);
+VAR
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    WHILE s[i] # 0X DO
+        Char(s[i]);
+        INC(i)
+    END
+END String;
+
+
+PROCEDURE PString (ptr: INTEGER);
+VAR
+    c: CHAR;
+
+BEGIN
+    SYSTEM.GET(ptr, c);
+    WHILE c # 0X DO
+        Char(c);
+        INC(ptr);
+        SYSTEM.GET(ptr, c)
+    END
+END PString;
+
+
+PROCEDURE Ln;
+BEGIN
+    String(0DX + 0AX)
+END Ln;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE Int (x: INTEGER);
+VAR
+    s: ARRAY 32 OF CHAR;
+
+BEGIN
+    IntToStr(x, s);
+    String(s)
+END Int;
+
+
+PROCEDURE trap* (modnum, _module, err, line: INTEGER);
+VAR
+    s: ARRAY 32 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    Ln;
+    String("error ("); Int(err); String("): "); String(s); Ln;
+    String("module: "); PString(_module); Ln;
+    String("line: "); Int(line); Ln;
+
+    SYSTEM.CODE(0, 0, 0)  (*  STOP  *)
+END trap;
+
+
+END Trap.

+ 684 - 0
lib/STM32CM3/FPU.ob07

@@ -0,0 +1,684 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE FPU;
+
+IMPORT SYSTEM;
+
+CONST
+
+    INF  = 07F800000H;
+    NINF = 0FF800000H;
+    NAN  = 07FC00000H;
+
+
+PROCEDURE [code] div2 (b, a: INTEGER): INTEGER
+    0B470H,  (*  push {r4, r5, r6} *)
+    09C03H,  (*  ldr r4, [sp, 12]  *)
+    09D04H,  (*  ldr r5, [sp, 16]  *)
+    0002BH,  (*  movs r3, r5       *)
+    04063H,  (*  eors r3, r4       *)
+    00FDBH,  (*  lsrs r3, 31       *)
+    007DBH,  (*  lsls r3, 31       *)
+    0002AH,  (*  movs r2, r5       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    00026H,  (*  movs r6, r4       *)
+    00076H,  (*  lsls r6, 1        *)
+    00E36H,  (*  lsrs r6, 24       *)
+    01B92H,  (*  subs r2, r2, r6   *)
+    0327FH,  (*  adds r2, 127      *)
+    02601H,  (*  movs r6, 1        *)
+    005F6H,  (*  lsls r6, 23       *)
+    0026DH,  (*  lsls r5, 9        *)
+    00A6DH,  (*  lsrs r5, 9        *)
+    019ADH,  (*  adds r5, r5, r6   *)
+    00264H,  (*  lsls r4, 9        *)
+    00A64H,  (*  lsrs r4, 9        *)
+    019A4H,  (*  adds r4, r4, r6   *)
+    00031H,  (*  movs r1, r6       *)
+    02000H,  (*  movs r0, 0        *)
+    042A5H,  (*  cmp r5, r4        *)
+    0DA01H,  (*  bge L1            *)
+    0006DH,  (*  lsls r5, 1        *)
+    03A01H,  (*  subs r2, 1        *)
+             (*  L1:               *)
+    02D00H,  (*  cmp r5, 0         *)
+    0DD08H,  (*  ble L2            *)
+    02900H,  (*  cmp r1, 0         *)
+    0DD06H,  (*  ble L2            *)
+    042A5H,  (*  cmp r5, r4        *)
+    0DB01H,  (*  blt L3            *)
+    01840H,  (*  adds r0, r0, r1   *)
+    01B2DH,  (*  subs r5, r5, r4   *)
+             (*  L3:               *)
+    0006DH,  (*  lsls r5, 1        *)
+    00849H,  (*  lsrs r1, 1        *)
+    0E7F4H,  (*  b L1              *)
+             (*  L2:               *)
+    02A00H,  (*  cmp r2, 0         *)
+    0DC03H,  (*  bgt L4            *)
+    02200H,  (*  movs r2, 0        *)
+    00030H,  (*  movs r0, r6       *)
+    02300H,  (*  movs r3, 0        *)
+    0E003H,  (*  b L5              *)
+             (*  L4:               *)
+    02AFFH,  (*  cmp r2, 255       *)
+    0DB01H,  (*  blt L5            *)
+    022FFH,  (*  movs r2, 255      *)
+    00030H,  (*  movs r0, r6       *)
+             (*  L5:               *)
+    01B80H,  (*  subs r0, r0, r6   *)
+    005D2H,  (*  lsls r2, 23       *)
+    01880H,  (*  adds r0, r0, r2   *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    0BC70H;  (*  pop {r4, r5, r6}  *)
+
+
+PROCEDURE [code] mul2 (b, a: INTEGER): INTEGER
+    0B470H,  (*  push {r4, r5, r6} *)
+    09C03H,  (*  ldr r4, [sp, 12]  *)
+    09D04H,  (*  ldr r5, [sp, 16]  *)
+    0002BH,  (*  movs r3, r5       *)
+    04063H,  (*  eors r3, r4       *)
+    00FDBH,  (*  lsrs r3, 31       *)
+    007DBH,  (*  lsls r3, 31       *)
+    0002AH,  (*  movs r2, r5       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    00026H,  (*  movs r6, r4       *)
+    00076H,  (*  lsls r6, 1        *)
+    00E36H,  (*  lsrs r6, 24       *)
+    01992H,  (*  adds r2, r2, r6   *)
+    03A7FH,  (*  subs r2, 127      *)
+    02601H,  (*  movs r6, 1        *)
+    005F6H,  (*  lsls r6, 23       *)
+    0026DH,  (*  lsls r5, 9        *)
+    00A6DH,  (*  lsrs r5, 9        *)
+    019ADH,  (*  adds r5, r5, r6   *)
+    00264H,  (*  lsls r4, 9        *)
+    00A64H,  (*  lsrs r4, 9        *)
+    019A4H,  (*  adds r4, r4, r6   *)
+    00021H,  (*  movs r1, r4       *)
+    00609H,  (*  lsls r1, 24       *)
+    00E09H,  (*  lsrs r1, 24       *)
+    00028H,  (*  movs r0, r5       *)
+    04348H,  (*  muls r0, r1, r0   *)
+    00A24H,  (*  lsrs r4, 8        *)
+    00A00H,  (*  lsrs r0, 8        *)
+    00021H,  (*  movs r1, r4       *)
+    00609H,  (*  lsls r1, 24       *)
+    00E09H,  (*  lsrs r1, 24       *)
+    04369H,  (*  muls r1, r5, r1   *)
+    01840H,  (*  adds r0, r0, r1   *)
+    00A24H,  (*  lsrs r4, 8        *)
+    00A00H,  (*  lsrs r0, 8        *)
+    00021H,  (*  movs r1, r4       *)
+    00609H,  (*  lsls r1, 24       *)
+    00E09H,  (*  lsrs r1, 24       *)
+    04369H,  (*  muls r1, r5, r1   *)
+    01840H,  (*  adds r0, r0, r1   *)
+    009C0H,  (*  lsrs r0, 7        *)
+    02101H,  (*  movs r1, 1        *)
+    00609H,  (*  lsls r1, 24       *)
+    04288H,  (*  cmp r0, r1        *)
+    0DB01H,  (*  blt L2            *)
+    00840H,  (*  lsrs r0, 1        *)
+    03201H,  (*  adds r2, 1        *)
+             (*  L2:               *)
+    02A00H,  (*  cmp r2, 0         *)
+    0DC03H,  (*  bgt L4            *)
+    02200H,  (*  movs r2, 0        *)
+    00030H,  (*  movs r0, r6       *)
+    02300H,  (*  movs r3, 0        *)
+    0E003H,  (*  b L5              *)
+             (*  L4:               *)
+    02AFFH,  (*  cmp r2, 255       *)
+    0DB01H,  (*  blt L5            *)
+    022FFH,  (*  movs r2, 255      *)
+    00030H,  (*  movs r0, r6       *)
+             (*  L5:               *)
+    01B80H,  (*  subs r0, r0, r6   *)
+    005D2H,  (*  lsls r2, 23       *)
+    01880H,  (*  adds r0, r0, r2   *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    0BC70H;  (*  pop {r4, r5, r6}  *)
+
+
+PROCEDURE [code] add2 (b, a: INTEGER): INTEGER
+    0B410H,  (*  push {r4}         *)
+    09901H,  (*  ldr r1, [sp, 4]   *)
+    09802H,  (*  ldr r0, [sp, 8]   *)
+    00002H,  (*  movs r2, r0       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    0000BH,  (*  movs r3, r1       *)
+    0005BH,  (*  lsls r3, 1        *)
+    00E1BH,  (*  lsrs r3, 24       *)
+    01AD4H,  (*  subs r4, r2, r3   *)
+    0DA00H,  (*  bge L1            *)
+    0001AH,  (*  movs r2, r3       *)
+             (*  L1:               *)
+    02301H,  (*  movs r3, 1        *)
+    005DBH,  (*  lsls r3, 23       *)
+    00240H,  (*  lsls r0, 9        *)
+    00A40H,  (*  lsrs r0, 9        *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    00249H,  (*  lsls r1, 9        *)
+    00A49H,  (*  lsrs r1, 9        *)
+    018C9H,  (*  adds r1, r1, r3   *)
+    02C00H,  (*  cmp r4, 0         *)
+    0DB05H,  (*  blt L2            *)
+    0D009H,  (*  beq L3            *)
+    02C18H,  (*  cmp r4, 24        *)
+    0DB00H,  (*  blt L4            *)
+    02100H,  (*  movs r1, 0        *)
+             (*  L4:               *)
+    040E1H,  (*  lsrs r1, r4       *)
+    0E004H,  (*  b L3              *)
+             (*  L2:               *)
+    04264H,  (*  negs r4, r4       *)
+    02C18H,  (*  cmp r4, 24        *)
+    0DB00H,  (*  blt L5            *)
+    02000H,  (*  movs r0, 0        *)
+             (*  L5:               *)
+    040E0H,  (*  lsrs r0, r4       *)
+             (*  L3:               *)
+    01840H,  (*  adds r0, r0, r1   *)
+    02401H,  (*  movs r4, 1        *)
+    00624H,  (*  lsls r4, 24       *)
+    042A0H,  (*  cmp r0, r4        *)
+    0DB01H,  (*  blt L6            *)
+    00840H,  (*  lsrs r0, 1        *)
+    03201H,  (*  adds r2, 1        *)
+             (*  L6:               *)
+    02AFFH,  (*  cmp r2, 255       *)
+    0DB01H,  (*  blt L7            *)
+    022FFH,  (*  movs r2, 255      *)
+    00018H,  (*  movs r0, r3       *)
+             (*  L7:               *)
+    005D2H,  (*  lsls r2, 23       *)
+    01AC0H,  (*  subs r0, r0, r3   *)
+    01880H,  (*  adds r0, r0, r2   *)
+    0BC10H;  (*  pop {r4}          *)
+
+
+PROCEDURE [code] sub2 (b, a: INTEGER): INTEGER
+    0B430H,  (*  push {r4, r5}     *)
+    09902H,  (*  ldr r1, [sp, 8]   *)
+    09803H,  (*  ldr r0, [sp, 12]  *)
+    00002H,  (*  movs r2, r0       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    0000DH,  (*  movs r5, r1       *)
+    0006DH,  (*  lsls r5, 1        *)
+    00E2DH,  (*  lsrs r5, 24       *)
+    00240H,  (*  lsls r0, 9        *)
+    00A40H,  (*  lsrs r0, 9        *)
+    00249H,  (*  lsls r1, 9        *)
+    00A49H,  (*  lsrs r1, 9        *)
+    02301H,  (*  movs r3, 1        *)
+    005DBH,  (*  lsls r3, 23       *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    018C9H,  (*  adds r1, r1, r3   *)
+    01B54H,  (*  subs r4, r2, r5   *)
+    0DB04H,  (*  blt L1            *)
+    0DC01H,  (*  bgt L2            *)
+    04288H,  (*  cmp r0, r1        *)
+    0DB01H,  (*  blt L1            *)
+             (*  L2:               *)
+    02300H,  (*  movs r3, 0        *)
+    0E006H,  (*  b L3              *)
+             (*  L1:               *)
+    0002AH,  (*  movs r2, r5       *)
+    04264H,  (*  negs r4, r4       *)
+    00005H,  (*  movs r5, r0       *)
+    00008H,  (*  movs r0, r1       *)
+    00029H,  (*  movs r1, r5       *)
+    02301H,  (*  movs r3, 1        *)
+    007DBH,  (*  lsls r3, 31       *)
+             (*  L3:               *)
+    02501H,  (*  movs r5, 1        *)
+    005EDH,  (*  lsls r5, 23       *)
+    02C00H,  (*  cmp r4, 0         *)
+    0DD04H,  (*  ble L4            *)
+    02C18H,  (*  cmp r4, 24        *)
+    0DA01H,  (*  bge L5            *)
+    040E1H,  (*  lsrs r1, r4       *)
+    0E000H,  (*  b L4              *)
+             (*  L5:               *)
+    02100H,  (*  movs r1, 0        *)
+             (*  L4:               *)
+    01A40H,  (*  subs r0, r0, r1   *)
+    0D103H,  (*  bne L6            *)
+    02200H,  (*  movs r2, 0        *)
+    00028H,  (*  movs r0, r5       *)
+    02300H,  (*  movs r3, 0        *)
+    0E004H,  (*  b L7              *)
+             (*  L6:               *)
+    042A8H,  (*  cmp r0, r5        *)
+    0DA02H,  (*  bge L7            *)
+    00040H,  (*  lsls r0, 1        *)
+    03A01H,  (*  subs r2, 1        *)
+    0E7FAH,  (*  b L6              *)
+             (*  L7:               *)
+    02A00H,  (*  cmp r2, 0         *)
+    0DC02H,  (*  bgt L8            *)
+    02200H,  (*  movs r2, 0        *)
+    00028H,  (*  movs r0, r5       *)
+    02300H,  (*  movs r3, 0        *)
+             (*  L8:               *)
+    005D2H,  (*  lsls r2, 23       *)
+    01B40H,  (*  subs r0, r0, r5   *)
+    01880H,  (*  adds r0, r0, r2   *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    0BC30H;  (*  pop {r4, r5}      *)
+
+
+PROCEDURE [code] zero (VAR a, b: INTEGER)
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    00001H,  (*  movs r1, r0       *)
+    06800H,  (*  ldr r0, [r0, 0]   *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    0D100H,  (*  bne L1            *)
+    06008H,  (*  str r0, [r1, 0]   *)
+             (*  L1:               *)
+    09801H,  (*  ldr r0, [sp, 4]   *)
+    00001H,  (*  movs r1, r0       *)
+    06800H,  (*  ldr r0, [r0, 0]   *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    0D100H,  (*  bne L2            *)
+    06008H;  (*  str r0, [r1, 0]   *)
+             (*  L2:               *)
+
+
+PROCEDURE [code] isNaN (a: INTEGER): BOOLEAN
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    028FFH,  (*  cmp r0, 255       *)
+    0D104H,  (*  bne L1            *)
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    00240H,  (*  lsls r0, 9        *)
+    0D002H,  (*  beq L2            *)
+    02001H,  (*  movs r0, 1        *)
+    04770H,  (*  bx lr             *)
+             (*  L1:               *)
+    02000H;  (*  movs r0, 0        *)
+             (*  L2:               *)
+
+
+PROCEDURE [code] isInf (a: INTEGER): BOOLEAN
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    00040H,  (*  lsls r0, 1        *)
+    02118H,  (*  movs r1, 24       *)
+    041C8H,  (*  rors r0, r1       *)
+    028FFH,  (*  cmp r0, 255       *)
+    0D002H,  (*  beq L1            *)
+    02000H,  (*  movs r0, 0        *)
+    04770H,  (*  bx lr             *)
+             (*  L1:               *)
+    02001H;  (*  movs r0, 1        *)
+
+
+PROCEDURE [code] isNormal (a, b: INTEGER): BOOLEAN
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    0D00AH,  (*  beq L2            *)
+    028FFH,  (*  cmp r0, 255       *)
+    0D007H,  (*  beq L1            *)
+    09801H,  (*  ldr r0, [sp, 4]   *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    0D004H,  (*  beq L2            *)
+    028FFH,  (*  cmp r0, 255       *)
+    0D001H,  (*  beq L1            *)
+    02001H,  (*  movs r0, 1        *)
+    04770H,  (*  bx lr             *)
+             (*  L1:               *)
+    02000H;  (*  movs r0, 0        *)
+             (*  L2:               *)
+
+
+PROCEDURE add* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a, b);
+
+    IF isNormal(a, b) THEN
+
+        IF a > 0 THEN
+            IF b > 0 THEN
+                r := add2(b, a)
+            ELSE
+                r := sub2(b, a)
+            END
+        ELSE
+            IF b > 0 THEN
+                r := sub2(a, b)
+            ELSE
+                r := add2(b, a) + 80000000H
+            END
+        END
+
+    ELSIF isNaN(a) OR isNaN(b) THEN
+        r := NAN
+    ELSIF isInf(a) & isInf(b) THEN
+        IF a = b THEN
+            r := a
+        ELSE
+            r := NAN
+        END
+    ELSIF isInf(a) THEN
+        r := a
+    ELSIF isInf(b) THEN
+        r := b
+    ELSIF a = 0 THEN
+        r := b
+    ELSIF b = 0 THEN
+        r := a
+    END
+
+    RETURN r
+END add;
+
+
+PROCEDURE sub* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a, b);
+
+    IF isNormal(a, b) THEN
+
+        IF a > 0 THEN
+            IF b > 0 THEN
+                r := sub2(b, a)
+            ELSE
+                r := add2(b, a)
+            END
+        ELSE
+            IF b > 0 THEN
+                r := add2(b, a) + 80000000H
+            ELSE
+                r := sub2(a, b)
+            END
+        END
+
+    ELSIF isNaN(a) OR isNaN(b) THEN
+        r := NAN
+    ELSIF isInf(a) & isInf(b) THEN
+        IF a # b THEN
+            r := a
+        ELSE
+            r := NAN
+        END
+    ELSIF isInf(a) THEN
+        r := a
+    ELSIF isInf(b) THEN
+        r := INF + ORD(BITS(b) / {31} - {0..30})
+    ELSIF (a = 0) & (b = 0) THEN
+        r := 0
+    ELSIF a = 0 THEN
+        r := ORD(BITS(b) / {31})
+    ELSIF b = 0 THEN
+        r := a
+    END
+
+    RETURN r
+END sub;
+
+
+PROCEDURE mul* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a, b);
+
+    IF isNormal(a, b) THEN
+        r := mul2(b, a)
+    ELSIF isNaN(a) OR isNaN(b) OR (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
+        r := NAN
+    ELSIF isInf(a) OR isInf(b) THEN
+        r := INF + ORD(BITS(a) / BITS(b) - {0..30})
+    ELSIF (a = 0) OR (b = 0) THEN
+        r := 0
+    END
+
+    RETURN r
+END mul;
+
+
+PROCEDURE _div* (b, a: INTEGER): INTEGER;
+VAR
+    r: INTEGER;
+
+BEGIN
+    zero(a, b);
+
+    IF isNormal(a, b) THEN
+        r := div2(b, a)
+    ELSIF isNaN(a) OR isNaN(b) OR isInf(a) & isInf(b) THEN
+        r := NAN
+    ELSIF isInf(a) THEN
+        r := INF + ORD(BITS(a) / BITS(b) - {0..30})
+    ELSIF isInf(b) THEN
+        r := 0
+    ELSIF a = 0 THEN
+        IF b = 0 THEN
+            r := NAN
+        ELSE
+            r := 0
+        END
+    ELSIF b = 0 THEN
+        IF a > 0 THEN
+            r := INF
+        ELSE
+            r := NINF
+        END
+    END
+
+    RETURN r
+END _div;
+
+
+PROCEDURE [code] cmp* (op, b, a: INTEGER): BOOLEAN
+    09802H,  (*  ldr r0, [sp, 8]   *)
+    09901H,  (*  ldr r1, [sp, 4]   *)
+    00002H,  (*  movs r2, r0       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    0D100H,  (*  bne L1            *)
+    02000H,  (*  movs r0, 0        *)
+             (*  L1:               *)
+    0000BH,  (*  movs r3, r1       *)
+    0005BH,  (*  lsls r3, 1        *)
+    00E1BH,  (*  lsrs r3, 24       *)
+    0D100H,  (*  bne L2            *)
+    02100H,  (*  movs r1, 0        *)
+             (*  L2:               *)
+    02AFFH,  (*  cmp r2, 255       *)
+    0D103H,  (*  bne L3            *)
+    00002H,  (*  movs r2, r0       *)
+    00252H,  (*  lsls r2, 9        *)
+    00A52H,  (*  lsrs r2, 9        *)
+    0D105H,  (*  bne L4            *)
+             (*  L3:               *)
+    02BFFH,  (*  cmp r3, 255       *)
+    0D107H,  (*  bne L5            *)
+    0000BH,  (*  movs r3, r1       *)
+    0025BH,  (*  lsls r3, 9        *)
+    00A5BH,  (*  lsrs r3, 9        *)
+    0D003H,  (*  beq L5            *)
+             (*  L4:               *)
+    09A00H,  (*  ldr r2, [sp, 0]   *)
+    02A01H,  (*  cmp r2, 1         *)
+    0D123H,  (*  bne L6            *)
+    0E020H,  (*  b L8              *)
+             (*  L5:               *)
+    09A00H,  (*  ldr r2, [sp, 0]   *)
+    02800H,  (*  cmp r0, 0         *)
+    0DA02H,  (*  bge L7            *)
+    02900H,  (*  cmp r1, 0         *)
+    0DA00H,  (*  bge L7            *)
+    03206H,  (*  adds r2, 6        *)
+             (*  L7:               *)
+    00092H,  (*  lsls r2, 2        *)
+    03A02H,  (*  subs r2, 2        *)
+    04288H,  (*  cmp r0, r1        *)
+    04497H,  (*  add pc, r2        *)
+    0D117H,  (*  bne L6            *)
+    0E014H,  (*  b L8              *)
+    0D015H,  (*  beq L6            *)
+    0E012H,  (*  b L8              *)
+    0DA13H,  (*  bge L6            *)
+    0E010H,  (*  b L8              *)
+    0DC11H,  (*  bgt L6            *)
+    0E00EH,  (*  b L8              *)
+    0DD0FH,  (*  ble L6            *)
+    0E00CH,  (*  b L8              *)
+    0DB0DH,  (*  blt L6            *)
+    0E00AH,  (*  b L8              *)
+    0D10BH,  (*  bne L6            *)
+    0E008H,  (*  b L8              *)
+    0D009H,  (*  beq L6            *)
+    0E006H,  (*  b L8              *)
+    0DD07H,  (*  ble L6            *)
+    0E004H,  (*  b L8              *)
+    0DB05H,  (*  blt L6            *)
+    0E002H,  (*  b L8              *)
+    0DA03H,  (*  bge L6            *)
+    0E000H,  (*  b L8              *)
+    0DC01H,  (*  bgt L6            *)
+             (*  L8:               *)
+    02001H,  (*  movs r0, 1        *)
+    04770H,  (*  bx lr             *)
+             (*  L6:               *)
+    02000H,  (*  movs r0, 0        *)
+    04770H;  (*  bx lr             *)
+
+
+PROCEDURE [code] flt* (x: INTEGER): INTEGER
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    02800H,  (*  cmp r0, 0         *)
+    0D105H,  (*  bne L1            *)
+    02300H,  (*  movs r3, 0        *)
+    02001H,  (*  movs r0, 1        *)
+    005C0H,  (*  lsls r0, 23       *)
+    0227EH,  (*  movs r2, 126      *)
+    04252H,  (*  negs r2, r2       *)
+    0E01EH,  (*  b L9              *)
+             (*  L1:               *)
+    02101H,  (*  movs r1, 1        *)
+    007C9H,  (*  lsls r1, 31       *)
+    04288H,  (*  cmp r0, r1        *)
+    0D104H,  (*  bne L2            *)
+    00003H,  (*  movs r3, r0       *)
+    02001H,  (*  movs r0, 1        *)
+    005C0H,  (*  lsls r0, 23       *)
+    02220H,  (*  movs r2, 32       *)
+    0E015H,  (*  b L9              *)
+             (*  L2:               *)
+    02800H,  (*  cmp r0, 0         *)
+    0DA03H,  (*  bge L4            *)
+    02301H,  (*  movs r3, 1        *)
+    007DBH,  (*  lsls r3, 31       *)
+    04240H,  (*  negs r0, r0       *)
+    0E000H,  (*  b L5              *)
+             (*  L4:               *)
+    02300H,  (*  movs r3, 0        *)
+             (*  L5:               *)
+    02200H,  (*  movs r2, 0        *)
+    00001H,  (*  movs r1, r0       *)
+             (*  L7:               *)
+    02900H,  (*  cmp r1, 0         *)
+    0DD02H,  (*  ble L6            *)
+    00849H,  (*  lsrs r1, 1        *)
+    03201H,  (*  adds r2, 1        *)
+    0E7FAH,  (*  b L7              *)
+             (*  L6:               *)
+    00011H,  (*  movs r1, r2       *)
+    03A18H,  (*  subs r2, 24       *)
+    0DD01H,  (*  ble L8            *)
+    040D0H,  (*  lsrs r0, r2       *)
+    0E001H,  (*  b L3              *)
+             (*  L8:               *)
+    04252H,  (*  negs r2, r2       *)
+    04090H,  (*  lsls r0, r2       *)
+             (*  L3:               *)
+    0000AH,  (*  movs r2, r1       *)
+             (*  L9:               *)
+    02101H,  (*  movs r1, 1        *)
+    005C9H,  (*  lsls r1, 23       *)
+    01A40H,  (*  subs r0, r0, r1   *)
+    0327EH,  (*  adds r2, 126      *)
+    005D2H,  (*  lsls r2, 23       *)
+    01880H,  (*  adds r0, r0, r2   *)
+    018C0H;  (*  adds r0, r0, r3   *)
+
+
+PROCEDURE [code] floor* (x: INTEGER): INTEGER
+    09900H,  (*  ldr r1, [sp, 0]   *)
+    00008H,  (*  movs r0, r1       *)
+    00040H,  (*  lsls r0, 1        *)
+    00E00H,  (*  lsrs r0, 24       *)
+    0D100H,  (*  bne L4            *)
+    02100H,  (*  movs r1, 0        *)
+             (*  L4:               *)
+    0000AH,  (*  movs r2, r1       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    03A7FH,  (*  subs r2, 127      *)
+    00008H,  (*  movs r0, r1       *)
+    00240H,  (*  lsls r0, 9        *)
+    00A40H,  (*  lsrs r0, 9        *)
+    02301H,  (*  movs r3, 1        *)
+    005DBH,  (*  lsls r3, 23       *)
+    018C0H,  (*  adds r0, r0, r3   *)
+    02A00H,  (*  cmp r2, 0         *)
+    0DB12H,  (*  blt L1            *)
+    02A16H,  (*  cmp r2, 22        *)
+    0DC0BH,  (*  bgt L2            *)
+    03A17H,  (*  subs r2, 23       *)
+    04252H,  (*  negs r2, r2       *)
+    00003H,  (*  movs r3, r0       *)
+    040D0H,  (*  lsrs r0, r2       *)
+    04252H,  (*  negs r2, r2       *)
+    03220H,  (*  adds r2, 32       *)
+    02900H,  (*  cmp r1, 0         *)
+    0DA0CH,  (*  bge L5            *)
+    04093H,  (*  lsls r3, r2       *)
+    0D00AH,  (*  beq L5            *)
+    03001H,  (*  adds r0, 1        *)
+    0E008H,  (*  b L5              *)
+             (*  L2:               *)
+    02A36H,  (*  cmp r2, 54        *)
+    0DC05H,  (*  bgt L6            *)
+    03A17H,  (*  subs r2, 23       *)
+    04090H,  (*  lsls r0, r2       *)
+    0E003H,  (*  b L5              *)
+             (*  L1:               *)
+    00008H,  (*  movs r0, r1       *)
+    00FC0H,  (*  lsrs r0, 31       *)
+    0E000H,  (*  b L5              *)
+             (*  L6:               *)
+    02000H,  (*  movs r0, 0        *)
+             (*  L5:               *)
+    02900H,  (*  cmp r1, 0         *)
+    0DA00H,  (*  bge L3            *)
+    04240H;  (*  negs r0, r0       *)
+             (*  L3:               *)
+
+
+END FPU.

+ 478 - 0
lib/STM32CM3/RTL.ob07

@@ -0,0 +1,478 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE RTL;
+
+IMPORT SYSTEM, F := FPU;
+
+
+CONST
+
+    WORD = 4;
+
+
+VAR
+
+    Heap, Types, TypesCount: INTEGER;
+
+
+PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
+    RETURN F.mul(b, a)
+END _fmul;
+
+
+PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
+    RETURN F._div(b, a)
+END _fdiv;
+
+
+PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
+    RETURN F._div(a, b)
+END _fdivi;
+
+
+PROCEDURE _fadd* (b, a: INTEGER): INTEGER;
+    RETURN F.add(b, a)
+END _fadd;
+
+
+PROCEDURE _fsub* (b, a: INTEGER): INTEGER;
+    RETURN F.sub(b, a)
+END _fsub;
+
+
+PROCEDURE _fsubi* (b, a: INTEGER): INTEGER;
+    RETURN F.sub(a, b)
+END _fsubi;
+
+
+PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN;
+    RETURN F.cmp(op, b, a)
+END _fcmp;
+
+
+PROCEDURE _floor* (x: INTEGER): INTEGER;
+    RETURN F.floor(x)
+END _floor;
+
+
+PROCEDURE _flt* (x: INTEGER): INTEGER;
+    RETURN F.flt(x)
+END _flt;
+
+
+PROCEDURE [code] _pack* (n: INTEGER; VAR x: INTEGER)
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    09901H,  (*  ldr r1, [sp, 4]   *)
+    0680AH,  (*  ldr r2, [r1, 0]   *)
+    00013H,  (*  movs r3, r2       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    01812H,  (*  adds r2, r2, r0   *)
+    00612H,  (*  lsls r2, 24       *)
+    00852H,  (*  lsrs r2, 1        *)
+    020FFH,  (*  movs r0, 255      *)
+    005C0H,  (*  lsls r0, 23       *)
+    04383H,  (*  bics r3, r0       *)
+    04313H,  (*  orrs r3, r2       *)
+    0600BH;  (*  str r3, [r1, 0]   *)
+
+
+PROCEDURE [code] _unpk* (VAR n: INTEGER; VAR x: INTEGER)
+    09800H,  (*  ldr r0, [sp, 0]   *)
+    09901H,  (*  ldr r1, [sp, 4]   *)
+    0680AH,  (*  ldr r2, [r1, 0]   *)
+    00013H,  (*  movs r3, r2       *)
+    00052H,  (*  lsls r2, 1        *)
+    00E12H,  (*  lsrs r2, 24       *)
+    03A7FH,  (*  subs r2, 127      *)
+    06002H,  (*  str r2, [r0, 0]   *)
+    02001H,  (*  movs r0, 1        *)
+    00780H,  (*  lsls r0, 30       *)
+    04383H,  (*  bics r3, r0       *)
+    0207FH,  (*  movs r0, 127      *)
+    005C0H,  (*  lsls r0, 23       *)
+    04303H,  (*  orrs r3, r0       *)
+    0600BH;  (*  str r3, [r1, 0]   *)
+
+
+PROCEDURE [code] _rot* (VAR A: ARRAY OF INTEGER)
+    09801H,  (*  ldr r0, [sp, 4]   *)
+    09900H,  (*  ldr r1, [sp, 0]   *)
+    06802H,  (*  ldr r2, [r0, 0]   *)
+    00003H,  (*  movs r3, r0       *)
+    03004H,  (*  adds r0, 4        *)
+    03901H,  (*  subs r1, 1        *)
+    0DD08H,  (*  ble L2            *)
+    0B404H,  (*  push {r2}         *)
+             (*  L1:               *)
+    06802H,  (*  ldr r2, [r0, 0]   *)
+    0601AH,  (*  str r2, [r3, 0]   *)
+    03004H,  (*  adds r0, 4        *)
+    03304H,  (*  adds r3, 4        *)
+    03901H,  (*  subs r1, 1        *)
+    0DCF9H,  (*  bgt L1            *)
+    0BC04H,  (*  pop {r2}          *)
+    0601AH;  (*  str r2, [r3, 0]   *)
+             (*  L2:               *)
+
+
+PROCEDURE [code] _set1* (a: INTEGER): INTEGER (* {a} -> r0 *)
+    09900H,  (*  ldr r1, [sp, 0]   *)  (* r1 <- a *)
+    02900H,  (*  cmp r1, 0         *)
+    0DB04H,  (*  blt L1            *)
+    0291FH,  (*  cmp r1, 31        *)
+    0DC02H,  (*  bgt L1            *)
+    02001H,  (*  movs r0, 1        *)
+    04088H,  (*  lsls r0, r1       *)
+    04770H,  (*  bx lr             *)
+             (*  L1:               *)
+    02000H;  (*  movs r0, 0        *)
+
+
+PROCEDURE [code] _set* (b, a: INTEGER): INTEGER (* {a..b} -> r0 *)
+    09900H,  (*  ldr r1, [sp, 0]   *)  (* r1 <- b *)
+    09801H,  (*  ldr r0, [sp, 4]   *)  (* r0 <- a *)
+    04288H,  (*  cmp r0, r1        *)
+    0DC11H,  (*  bgt L1            *)
+    0281FH,  (*  cmp r0, 31        *)
+    0DC0FH,  (*  bgt L1            *)
+    02900H,  (*  cmp r1, 0         *)
+    0DB0DH,  (*  blt L1            *)
+    0291FH,  (*  cmp r1, 31        *)
+    0DD00H,  (*  ble L3            *)
+    0211FH,  (*  movs r1, 31       *)
+             (*  L3:               *)
+    02800H,  (*  cmp r0, 0         *)
+    0DA00H,  (*  bge L4            *)
+    02000H,  (*  movs r0, 0        *)
+             (*  L4:               *)
+    01A0AH,  (*  subs r2, r1, r0   *)
+    02001H,  (*  movs r0, 1        *)
+    007C0H,  (*  lsls r0, 31       *)
+    04110H,  (*  asrs r0, r2       *)
+    0391FH,  (*  subs r1, 31       *)
+    04249H,  (*  negs r1, r1       *)
+    040C8H,  (*  lsrs r0, r1       *)
+    04770H,  (*  bx lr             *)
+             (*  L1:               *)
+    02000H;  (*  movs r0, 0        *)
+
+
+PROCEDURE [code] _length* (len, str: INTEGER): INTEGER
+    09801H,  (*  ldr r0, [sp, 4]   *)
+    09900H,  (*  ldr r1, [sp, 0]   *)
+    00003H,  (*  movs r3, r0       *)
+    03801H,  (*  subs r0, 1        *)
+             (*  L1:               *)
+    03001H,  (*  adds r0, 1        *)
+    07802H,  (*  ldrb r2, [r0]     *)
+    02A00H,  (*  cmp  r2, 0        *)
+    0D002H,  (*  beq  L2           *)
+    03901H,  (*  subs r1, 1        *)
+    0DCF9H,  (*  bgt L1            *)
+    03001H,  (*  adds r0, 1        *)
+             (*  L2:               *)
+    01AC0H;  (*  subs r0, r0, r3   *)
+
+
+PROCEDURE [code] _lengthw* (len, str: INTEGER): INTEGER
+    09801H,  (*  ldr r0, [sp, 4]   *)
+    09900H,  (*  ldr r1, [sp, 0]   *)
+    00003H,  (*  movs r3, r0       *)
+    03802H,  (*  subs r0, 2        *)
+             (*  L1:               *)
+    03002H,  (*  adds r0, 2        *)
+    08802H,  (*  ldrh r2, [r0]     *)
+    02A00H,  (*  cmp  r2, 0        *)
+    0D002H,  (*  beq  L2           *)
+    03901H,  (*  subs r1, 1        *)
+    0DCF9H,  (*  bgt L1            *)
+    03002H,  (*  adds r0, 2        *)
+             (*  L2:               *)
+    01AC0H,  (*  subs r0, r0, r3   *)
+    00840H;  (*  lsrs r0, 1        *)
+
+
+PROCEDURE [code] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN
+    09904H,  (*  ldr r1, [sp, 16]  *)  (* r1 <- str1 *)
+    09A02H,  (*  ldr r2, [sp, 8]   *)  (* r2 <- str2 *)
+    09B01H,  (*  ldr r3, [sp, 4]   *)  (* r3 <- len2 *)
+    09803H,  (*  ldr r0, [sp, 12]  *)  (* r0 <- len1 *)
+    04298H,  (*  cmp r0, r3        *)
+    0DA00H,  (*  bge L5            *)
+    00003H,  (*  movs r3, r0       *)
+             (*  L5:               *)  (* r3 <- min(r0, r3) *)
+    0B430H,  (*  push {r4, r5}     *)
+
+             (*  L3:               *)
+    02B00H,  (*  cmp r3, 0         *)  (* while r3 > 0 do *)
+    0DD09H,  (*  ble L1            *)
+    0780CH,  (*  ldrb r4, [r1]     *)
+    03101H,  (*  adds r1, 1        *)
+    07815H,  (*  ldrb r5, [r2]     *)
+    03201H,  (*  adds r2, 1        *)
+    03B01H,  (*  subs r3, 1        *)
+    01B60H,  (*  subs r0, r4, r5   *)
+    0D10FH,  (*  bne L6            *)
+    02C00H,  (*  cmp r4, 0         *)
+    0D1F4H,  (*  bne L3            *)  (* end while *)
+    0E00CH,  (*  b L6              *)
+
+             (*  L1:               *)
+    09A03H,  (*  ldr r2, [sp, 12]  *)  (* r2 <- len2 *)
+    09905H,  (*  ldr r1, [sp, 20]  *)  (* r1 <- len1 *)
+    04291H,  (*  cmp r1, r2        *)
+    0DC02H,  (*  bgt L9            *)
+    0DB04H,  (*  blt L4            *)
+    02000H,  (*  movs r0, 0        *)
+    0E005H,  (*  b L6              *)
+             (*  L9:               *)
+    09806H,  (*  ldr r0, [sp, 24]  *)  (* r0 <- str1 *)
+    05C80H,  (*  ldrb r0, [r0, r2] *)  (* r0 <- str1[len2] *)
+    0E002H,  (*  b L6              *)
+             (*  L4:               *)
+    09804H,  (*  ldr r0, [sp, 16]  *)  (* r0 <- str2 *)
+    05C40H,  (*  ldrb r0, [r0, r1] *)  (* r0 <- str2[len1] *)
+    04240H,  (*  negs r0, r0       *)
+
+             (*  L6:               *)  (* case op of *)
+    09A02H,  (*  ldr r2, [sp, 8]   *)  (* r2 <- op *)
+    00092H,  (*  lsls r2, 2        *)
+    03A02H,  (*  subs r2, 2        *)
+    02800H,  (*  cmp r0, 0         *)
+    04497H,  (*  add pc, r2        *)
+    0D00AH,  (*  beq L7            *)
+    0E00CH,  (*  b L8              *)
+    0D108H,  (*  bne L7            *)
+    0E00AH,  (*  b L8              *)
+    0DB06H,  (*  blt L7            *)
+    0E008H,  (*  b L8              *)
+    0DD04H,  (*  ble L7            *)
+    0E006H,  (*  b L8              *)
+    0DC02H,  (*  bgt L7            *)
+    0E004H,  (*  b L8              *)
+    0DA00H,  (*  bge L7            *)
+    0E002H,  (*  b L8              *)
+             (*  L7:               *)
+    02001H,  (*  movs r0, 1        *)
+    0BC30H,  (*  pop {r4, r5}      *)
+    04770H,  (*  bx lr             *)
+             (*  L8:               *)
+    02000H,  (*  movs r0, 0        *)
+    0BC30H;  (*  pop {r4, r5}      *)
+
+
+PROCEDURE [code] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN
+    09904H,  (*  ldr r1, [sp, 16]  *)  (* r1 <- str1 *)
+    09A02H,  (*  ldr r2, [sp, 8]   *)  (* r2 <- str2 *)
+    09B01H,  (*  ldr r3, [sp, 4]   *)  (* r3 <- len2 *)
+    09803H,  (*  ldr r0, [sp, 12]  *)  (* r0 <- len1 *)
+    04298H,  (*  cmp r0, r3        *)
+    0DA00H,  (*  bge L5            *)
+    00003H,  (*  movs r3, r0       *)
+             (*  L5:               *)  (* r3 <- min(r0, r3) *)
+    0B430H,  (*  push {r4, r5}     *)
+
+             (*  L3:               *)
+    02B00H,  (*  cmp r3, 0         *)  (* while r3 > 0 do *)
+    0DD09H,  (*  ble L1            *)
+    0880CH,  (*  ldrh r4, [r1]     *)
+    03102H,  (*  adds r1, 2        *)
+    08815H,  (*  ldrh r5, [r2]     *)
+    03202H,  (*  adds r2, 2        *)
+    03B01H,  (*  subs r3, 1        *)
+    01B60H,  (*  subs r0, r4, r5   *)
+    0D111H,  (*  bne L6            *)
+    02C00H,  (*  cmp r4, 0         *)
+    0D1F4H,  (*  bne L3            *)  (* end while *)
+    0E00DH,  (*  b L6              *)
+
+             (*  L1:               *)
+    09A03H,  (*  ldr r2, [sp, 12]  *)  (* r2 <- len2 *)
+    09905H,  (*  ldr r1, [sp, 20]  *)  (* r1 <- len1 *)
+    00049H,  (*  lsls r1, 1        *)
+    00052H,  (*  lsls r2, 1        *)
+    04291H,  (*  cmp r1, r2        *)
+    0DC02H,  (*  bgt L9            *)
+    0DB04H,  (*  blt L4            *)
+    02000H,  (*  movs r0, 0        *)
+    0E005H,  (*  b L6              *)
+             (*  L9:               *)
+    09806H,  (*  ldr r0, [sp, 24]  *)  (* r0 <- str1 *)
+    05A80H,  (*  ldrh r0, [r0, r2] *)  (* r0 <- str1[len2] *)
+    0E002H,  (*  b L6              *)
+             (*  L4:               *)
+    09804H,  (*  ldr r0, [sp, 16]  *)  (* r0 <- str2 *)
+    05A40H,  (*  ldrh r0, [r0, r1] *)  (* r0 <- str2[len1] *)
+    04240H,  (*  negs r0, r0       *)
+
+             (*  L6:               *)  (* case op of *)
+    09A02H,  (*  ldr r2, [sp, 8]   *)  (* r2 <- op *)
+    00092H,  (*  lsls r2, 2        *)
+    03A02H,  (*  subs r2, 2        *)
+    02800H,  (*  cmp r0, 0         *)
+    04497H,  (*  add pc, r2        *)
+    0D00AH,  (*  beq L7            *)
+    0E00CH,  (*  b L8              *)
+    0D108H,  (*  bne L7            *)
+    0E00AH,  (*  b L8              *)
+    0DB06H,  (*  blt L7            *)
+    0E008H,  (*  b L8              *)
+    0DD04H,  (*  ble L7            *)
+    0E006H,  (*  b L8              *)
+    0DC02H,  (*  bgt L7            *)
+    0E004H,  (*  b L8              *)
+    0DA00H,  (*  bge L7            *)
+    0E002H,  (*  b L8              *)
+             (*  L7:               *)
+    02001H,  (*  movs r0, 1        *)
+    0BC30H,  (*  pop {r4, r5}      *)
+    04770H,  (*  bx lr             *)
+             (*  L8:               *)
+    02000H,  (*  movs r0, 0        *)
+    0BC30H;  (*  pop {r4, r5}      *)
+
+
+PROCEDURE [code] _move* (bytes, dest, source: INTEGER)
+    09802H,  (*  ldr r0, [sp, 8]   *)
+    00001H,  (*  movs r1, r0       *)
+    09A01H,  (*  ldr r2, [sp, 4]   *)
+    00013H,  (*  movs r3, r2       *)
+    00789H,  (*  lsls r1, 30       *)
+    0D10AH,  (*  bne L1            *)
+    0079BH,  (*  lsls r3, 30       *)
+    0D108H,  (*  bne L1            *)
+    09900H,  (*  ldr r1, [sp, 0]   *)
+             (*  L4:               *)
+    02904H,  (*  cmp r1, 4         *)
+    0DB06H,  (*  blt L2            *)
+    06803H,  (*  ldr r3, [r0, 0]   *)
+    06013H,  (*  str r3, [r2, 0]   *)
+    03004H,  (*  adds r0, 4        *)
+    03204H,  (*  adds r2, 4        *)
+    03904H,  (*  subs r1, 4        *)
+    0E7F7H,  (*  b L4              *)
+             (*  L1:               *)
+    09900H,  (*  ldr r1, [sp, 0]   *)
+             (*  L2:               *)
+    02900H,  (*  cmp r1, 0         *)
+    0DD05H,  (*  ble L3            *)
+             (*  L5:               *)
+    07803H,  (*  ldrb r3, [r0, 0]  *)
+    07013H,  (*  strb r3, [r2, 0]  *)
+    03001H,  (*  adds r0, 1        *)
+    03201H,  (*  adds r2, 1        *)
+    03901H,  (*  subs r1, 1        *)
+    0DCF9H;  (*  bgt L5            *)
+             (*  L3:               *)
+
+
+PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [code] GetSP (): INTEGER
+    04668H;  (*  mov r0, sp  *)
+
+
+PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
+VAR
+    ptr: INTEGER;
+
+BEGIN
+    ptr := Heap;
+    IF ptr + size < GetSP() - 64 THEN
+        INC(Heap, size);
+        p := ptr + WORD;
+        SYSTEM.PUT(ptr, t);
+        INC(ptr, WORD);
+        DEC(size, WORD);
+        WHILE size > 0 DO
+            SYSTEM.PUT(ptr, 0);
+            INC(ptr, WORD);
+            DEC(size, WORD)
+        END
+    ELSE
+        p := 0
+    END
+END _new;
+
+
+PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    ELSE
+        _type := t
+    END
+
+    RETURN _type = t
+END _guard;
+
+
+PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
+VAR
+    _type: INTEGER;
+
+BEGIN
+    _type := 0;
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, _type);
+        WHILE (_type # t) & (_type # 0) DO
+            SYSTEM.GET(Types + _type * WORD, _type)
+        END
+    END
+
+    RETURN _type = t
+END _is;
+
+
+PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN;
+BEGIN
+    WHILE (t1 # t0) & (t1 # 0) DO
+        SYSTEM.GET(Types + t1 * WORD, t1)
+    END
+
+    RETURN t1 = t0
+END _guardrec;
+
+
+PROCEDURE _init* (tcount, heap, types: INTEGER);
+BEGIN
+    Heap := heap;
+    TypesCount := tcount;
+    Types := types
+END _init;
+
+
+END RTL.

+ 134 - 0
lib/Windows/API.ob07

@@ -0,0 +1,134 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE API;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    OS* = "WINDOWS";
+    eol* = 0DX + 0AX;
+    BIT_DEPTH* = (ORD(LSL(1, 31) > 0) + 1) * 32;
+
+    SectionAlignment = 1000H;
+
+    DLL_PROCESS_ATTACH = 1;
+    DLL_THREAD_ATTACH  = 2;
+    DLL_THREAD_DETACH  = 3;
+    DLL_PROCESS_DETACH = 0;
+
+    KERNEL = "kernel32.dll";
+    USER   = "user32.dll";
+
+
+TYPE
+
+    DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
+
+
+VAR
+
+    base*: INTEGER;
+    heap:  INTEGER;
+
+    process_detach,
+    thread_detach,
+    thread_attach: DLL_ENTRY;
+
+
+PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
+PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
+PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
+PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
+PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER);
+PROCEDURE [windows-, USER,   ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
+
+
+PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
+BEGIN
+    MessageBoxA(0, lpText, lpCaption, 16)
+END DebugMsg;
+
+
+PROCEDURE _NEW* (size: INTEGER): INTEGER;
+    RETURN HeapAlloc(heap, 8, size)
+END _NEW;
+
+
+PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
+BEGIN
+    HeapFree(heap, 0, p)
+    RETURN 0
+END _DISPOSE;
+
+
+PROCEDURE init* (reserved, code: INTEGER);
+BEGIN
+    process_detach := NIL;
+    thread_detach  := NIL;
+    thread_attach  := NIL;
+    base := code - SectionAlignment;
+    heap := GetProcessHeap()
+END init;
+
+
+PROCEDURE exit* (code: INTEGER);
+BEGIN
+    ExitProcess(code)
+END exit;
+
+
+PROCEDURE exit_thread* (code: INTEGER);
+BEGIN
+    ExitThread(code)
+END exit_thread;
+
+
+PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    res := 0;
+
+    CASE fdwReason OF
+    |DLL_PROCESS_ATTACH:
+        res := 1
+    |DLL_THREAD_ATTACH:
+        IF thread_attach # NIL THEN
+            thread_attach(hinstDLL, fdwReason, lpvReserved)
+        END
+    |DLL_THREAD_DETACH:
+        IF thread_detach # NIL THEN
+            thread_detach(hinstDLL, fdwReason, lpvReserved)
+        END
+    |DLL_PROCESS_DETACH:
+        IF process_detach # NIL THEN
+            process_detach(hinstDLL, fdwReason, lpvReserved)
+        END
+    ELSE
+    END
+
+    RETURN res
+END dllentry;
+
+
+PROCEDURE sofinit*;
+END sofinit;
+
+
+PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY);
+BEGIN
+    process_detach := _process_detach;
+    thread_detach  := _thread_detach;
+    thread_attach  := _thread_attach
+END SetDll;
+
+
+END API.

+ 101 - 0
lib/Windows/Args.ob07

@@ -0,0 +1,101 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2020, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Args;
+
+IMPORT SYSTEM, WINAPI;
+
+
+CONST
+
+    MAX_PARAM = 1024;
+
+
+VAR
+
+    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
+    argc*: INTEGER;
+
+
+PROCEDURE GetChar (adr: INTEGER): CHAR;
+VAR
+    res: CHAR;
+
+BEGIN
+    SYSTEM.GET(adr, res)
+    RETURN res
+END GetChar;
+
+
+PROCEDURE ParamParse;
+VAR
+    p, count, cond: INTEGER;
+    c: CHAR;
+
+
+    PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR): INTEGER;
+    BEGIN
+        IF (c <= 20X) & (c # 0X) THEN
+            cond := A
+        ELSIF c = 22X THEN
+            cond := B
+        ELSIF c = 0X THEN
+            cond := 6
+        ELSE
+            cond := C
+        END
+
+        RETURN cond
+    END ChangeCond;
+
+
+BEGIN
+    p := WINAPI.GetCommandLineA();
+    cond := 0;
+    count := 0;
+    WHILE (count < MAX_PARAM) & (cond # 6) DO
+        c := GetChar(p);
+        CASE cond OF
+        |0: IF ChangeCond(0, 4, 1, cond, c) = 1 THEN Params[count, 0] := p END
+        |1: IF ChangeCond(0, 3, 1, cond, c) IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
+        |3: IF ChangeCond(3, 1, 3, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |4: IF ChangeCond(5, 0, 5, cond, c) = 5 THEN Params[count, 0] := p END
+        |5: IF ChangeCond(5, 1, 5, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |6:
+        END;
+        INC(p)
+    END;
+    argc := count
+END ParamParse;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    i, j, len: INTEGER;
+    c: CHAR;
+
+BEGIN
+    j := 0;
+    IF n < argc THEN
+        i := Params[n, 0];
+        len := LEN(s) - 1;
+        WHILE (j < len) & (i <= Params[n, 1]) DO
+            c := GetChar(i);
+            IF c # '"' THEN
+                s[j] := c;
+                INC(j)
+            END;
+            INC(i)
+        END
+    END;
+    s[j] := 0X
+END GetArg;
+
+
+BEGIN
+    ParamParse
+END Args.

+ 100 - 0
lib/Windows/Console.ob07

@@ -0,0 +1,100 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2020, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Console;
+
+IMPORT SYSTEM, WINAPI, In, Out;
+
+
+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;
+
+
+VAR
+
+    hConsoleOutput: INTEGER;
+
+
+PROCEDURE SetCursor* (X, Y: INTEGER);
+BEGIN
+    WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536)
+END SetCursor;
+
+
+PROCEDURE GetCursor* (VAR X, Y: INTEGER);
+VAR
+    ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
+
+BEGIN
+    WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
+    X := ORD(ScrBufInfo.dwCursorPosition.X);
+    Y := ORD(ScrBufInfo.dwCursorPosition.Y)
+END GetCursor;
+
+
+PROCEDURE Cls*;
+VAR
+    fill: INTEGER;
+    ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
+
+BEGIN
+    WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo);
+    fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y);
+    WINAPI.FillConsoleOutputCharacterA(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill));
+    WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill));
+    SetCursor(0, 0)
+END Cls;
+
+
+PROCEDURE SetColor* (FColor, BColor: INTEGER);
+BEGIN
+    IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN
+        WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor)
+    END
+END SetColor;
+
+
+PROCEDURE GetCursorX* (): INTEGER;
+VAR
+    ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
+
+BEGIN
+    WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
+    RETURN ORD(ScrBufInfo.dwCursorPosition.X)
+END GetCursorX;
+
+
+PROCEDURE GetCursorY* (): INTEGER;
+VAR
+    ScrBufInfo: WINAPI.TConsoleScreenBufferInfo;
+
+BEGIN
+    WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo)
+    RETURN ORD(ScrBufInfo.dwCursorPosition.Y)
+END GetCursorY;
+
+
+PROCEDURE open*;
+BEGIN
+    WINAPI.AllocConsole;
+    hConsoleOutput := WINAPI.GetStdHandle(-11);
+    In.Open;
+    Out.Open
+END open;
+
+
+PROCEDURE exit* (b: BOOLEAN);
+BEGIN
+    WINAPI.FreeConsole
+END exit;
+
+
+END Console.

+ 197 - 0
lib/Windows/DateTime.ob07

@@ -0,0 +1,197 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2020, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE DateTime;
+
+IMPORT WINAPI, SYSTEM;
+
+
+CONST
+
+    ERR* = -7.0E5;
+
+
+VAR
+
+    DateTable: ARRAY 120000, 3 OF INTEGER;
+    MonthsTable: ARRAY 13, 4 OF INTEGER;
+
+
+PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL;
+VAR
+    d, bis: INTEGER;
+    res: REAL;
+
+BEGIN
+    res := ERR;
+    IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) &
+        (Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) &
+        (Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) &
+        (MSec >= 0) & (MSec <= 999) THEN
+
+        bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0));
+
+        IF Day <= MonthsTable[Month][2 + bis] THEN
+            DEC(Year);
+            d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) +
+                MonthsTable[Month][bis] + Day - 693594;
+            res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0
+        END
+    END
+    RETURN res
+END Encode;
+
+
+PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+    d, t: INTEGER;
+    L, R, M: INTEGER;
+
+BEGIN
+    res := (Date >= -693593.0) & (Date < 2958466.0);
+    IF res THEN
+        d := FLOOR(Date);
+        t := FLOOR((Date - FLT(d)) * 86400000.0);
+        INC(d, 693593);
+
+        L := 0;
+        R := LEN(DateTable) - 1;
+        M := (L + R) DIV 2;
+
+        WHILE R - L > 1 DO
+            IF d > DateTable[M][0] THEN
+                L := M;
+                M := (L + R) DIV 2
+            ELSIF d < DateTable[M][0] THEN
+                R := M;
+                M := (L + R) DIV 2
+            ELSE
+                L := M;
+                R := M
+            END
+        END;
+
+        Year  := DateTable[L][1];
+        Month := DateTable[L][2];
+        Day   := d - DateTable[L][0] + 1;
+
+        Hour := t DIV 3600000; t := t MOD 3600000;
+        Min  := t DIV 60000;   t := t MOD 60000;
+        Sec  := t DIV 1000;
+        MSec := t MOD 1000
+    END
+
+    RETURN res
+END Decode;
+
+
+PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER);
+VAR
+    T: WINAPI.TSystemTime;
+
+BEGIN
+    WINAPI.GetLocalTime(T);
+    Year  := ORD(T.Year);
+    Month := ORD(T.Month);
+    Day   := ORD(T.Day);
+    Hour  := ORD(T.Hour);
+    Min   := ORD(T.Min);
+    Sec   := ORD(T.Sec);
+    MSec  := ORD(T.MSec)
+END Now;
+
+
+PROCEDURE NowEncode* (): REAL;
+VAR
+    Year, Month, Day, Hour, Min, Sec, MSec: INTEGER;
+
+BEGIN
+    Now(Year, Month, Day, Hour, Min, Sec, MSec)
+    RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec)
+END NowEncode;
+
+
+PROCEDURE NowUnixTime* (): INTEGER;
+    RETURN WINAPI.time(0)
+END NowUnixTime;
+
+
+PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER;
+VAR
+    t: WINAPI.tm;
+
+BEGIN
+    DEC(Year, 1900);
+    DEC(Month);
+    SYSTEM.GET(SYSTEM.ADR(Sec),   t.sec);
+    SYSTEM.GET(SYSTEM.ADR(Min),   t.min);
+    SYSTEM.GET(SYSTEM.ADR(Hour),  t.hour);
+    SYSTEM.GET(SYSTEM.ADR(Day),   t.mday);
+    SYSTEM.GET(SYSTEM.ADR(Month), t.mon);
+    SYSTEM.GET(SYSTEM.ADR(Year),  t.year);
+
+    RETURN WINAPI.mktime(t)
+END UnixTime;
+
+
+PROCEDURE init;
+VAR
+    day, year, month, i: INTEGER;
+    Months: ARRAY 13 OF INTEGER;
+
+BEGIN
+    Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30;
+    Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31;
+    Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31;
+
+    day := 0;
+    year := 1;
+    month := 1;
+    i := 0;
+
+    WHILE year <= 10000 DO
+        DateTable[i][0] := day;
+        DateTable[i][1] := year;
+        DateTable[i][2] := month;
+        INC(day, Months[month]);
+        IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN
+            INC(day)
+        END;
+        INC(month);
+        IF month > 12 THEN
+            month := 1;
+            INC(year)
+        END;
+        INC(i)
+    END;
+
+    MonthsTable[1][0] := 0;
+    FOR i := 2 TO 12 DO
+        MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1]
+    END;
+
+    FOR i := 1 TO 12 DO
+        MonthsTable[i][2] := Months[i]
+    END;
+
+    Months[2] := 29;
+    MonthsTable[1][1] := 0;
+    FOR i := 2 TO 12 DO
+        MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1]
+    END;
+
+    FOR i := 1 TO 12 DO
+        MonthsTable[i][3] := Months[i]
+    END
+
+END init;
+
+
+BEGIN
+    init
+END DateTime.

+ 149 - 0
lib/Windows/File.ob07

@@ -0,0 +1,149 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE File;
+
+IMPORT SYSTEM, WINAPI, API;
+
+
+CONST
+
+    OPEN_R* = 0;     OPEN_W* = 1;     OPEN_RW* = 2;
+    SEEK_BEG* = 0;   SEEK_CUR* = 1;   SEEK_END* = 2;
+
+
+PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    FindData: WINAPI.TWin32FindData;
+    Handle:   INTEGER;
+    attr:     SET;
+
+BEGIN
+    Handle := WINAPI.FindFirstFileA(SYSTEM.ADR(FName[0]), FindData);
+    IF Handle # -1 THEN
+        WINAPI.FindClose(Handle);
+        SYSTEM.GET32(SYSTEM.ADR(FindData.dwFileAttributes), attr);
+        IF 4 IN attr THEN
+            Handle := -1
+        END
+    END
+
+    RETURN Handle # -1
+END Exists;
+
+
+PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN;
+    RETURN WINAPI.DeleteFileA(SYSTEM.ADR(FName[0])) # 0
+END Delete;
+
+
+PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN WINAPI.CreateFileA(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
+END Create;
+
+
+PROCEDURE Close* (F: INTEGER);
+BEGIN
+    WINAPI.CloseHandle(F)
+END Close;
+
+
+PROCEDURE Open* (FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER;
+VAR
+    ofstr: WINAPI.OFSTRUCT;
+BEGIN
+    RETURN WINAPI.OpenFile(SYSTEM.ADR(FName[0]), ofstr, Mode)
+END Open;
+
+
+PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF API.BIT_DEPTH = 32 THEN
+        res := WINAPI.SetFilePointer(F, Offset, 0, Origin)
+    ELSE
+        res := WINAPI.SetFilePointer(F, ORD(BITS(Offset) * {0..31}), SYSTEM.ADR(Offset) + 4, Origin)
+    END
+
+    RETURN res
+END Seek;
+
+
+PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END Read;
+
+
+PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END Write;
+
+
+PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER;
+VAR
+    res, n, F: INTEGER;
+
+BEGIN
+    res := 0;
+    F := Open(FName, OPEN_R);
+
+    IF F # -1 THEN
+        Size := Seek(F, 0, SEEK_END);
+        n    := Seek(F, 0, SEEK_BEG);
+        res  := API._NEW(Size);
+        IF (res = 0) OR (Read(F, res, Size) # Size) THEN
+            IF res # 0 THEN
+                res := API._DISPOSE(res);
+                Size := 0
+            END
+        END;
+        Close(F)
+    END
+
+    RETURN res
+END Load;
+
+
+PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN;
+    RETURN WINAPI.RemoveDirectoryA(SYSTEM.ADR(DirName[0])) # 0
+END RemoveDir;
+
+
+PROCEDURE ExistsDir* (DirName: ARRAY OF CHAR): BOOLEAN;
+VAR
+    Code: SET;
+
+BEGIN
+    Code := WINAPI.GetFileAttributesA(SYSTEM.ADR(DirName[0]))
+    RETURN (Code # {0..31}) & (4 IN Code)
+END ExistsDir;
+
+
+PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN;
+    RETURN WINAPI.CreateDirectoryA(SYSTEM.ADR(DirName[0]), NIL) # 0
+END CreateDir;
+
+
+END File.

+ 340 - 0
lib/Windows/HOST.ob07

@@ -0,0 +1,340 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE HOST;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    slash* = "\";
+    eol* = 0DX + 0AX;
+
+    bit_depth* = (ORD(LSL(1, 31) > 0) + 1) * 32;
+    maxint* = ROR(-2, 1);
+    minint* = ROR(1, 1);
+
+    MAX_PARAM = 1024;
+
+    OFS_MAXPATHNAME = 128;
+
+
+TYPE
+
+    POverlapped = POINTER TO OVERLAPPED;
+
+    OVERLAPPED = RECORD
+
+        Internal:       INTEGER;
+        InternalHigh:   INTEGER;
+        Offset:         INTEGER;
+        OffsetHigh:     INTEGER;
+        hEvent:         INTEGER
+
+    END;
+
+    OFSTRUCT = RECORD
+
+        cBytes:         CHAR;
+        fFixedDisk:     CHAR;
+        nErrCode:       WCHAR;
+        Reserved1:      WCHAR;
+        Reserved2:      WCHAR;
+        szPathName:     ARRAY OFS_MAXPATHNAME OF CHAR
+
+    END;
+
+    PSecurityAttributes = POINTER TO TSecurityAttributes;
+
+    TSecurityAttributes = RECORD
+
+        nLength:               INTEGER;
+        lpSecurityDescriptor:  INTEGER;
+        bInheritHandle:        INTEGER
+
+    END;
+
+
+VAR
+
+    hConsoleOutput: INTEGER;
+
+    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
+    argc: INTEGER;
+
+    maxreal*, inf*: REAL;
+
+
+PROCEDURE [windows-, "kernel32.dll", "GetTickCount"]
+    _GetTickCount (): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"]
+    _GetStdHandle (nStdHandle: INTEGER): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"]
+    _GetCommandLine (): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "ReadFile"]
+    _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "WriteFile"]
+    _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "CloseHandle"]
+    _CloseHandle (hObject: INTEGER): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "CreateFileA"]
+    _CreateFile (
+        lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
+        lpSecurityAttributes: PSecurityAttributes;
+        dwCreationDisposition, dwFlagsAndAttributes,
+        hTemplateFile: INTEGER): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "OpenFile"]
+    _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
+
+PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"]
+    _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER;
+
+PROCEDURE [windows, "kernel32.dll", "ExitProcess"]
+    _ExitProcess (code: INTEGER);
+
+PROCEDURE [ccall, "msvcrt.dll", "time"]
+    _time (ptr: INTEGER): INTEGER;
+
+
+PROCEDURE ExitProcess* (code: INTEGER);
+BEGIN
+    _ExitProcess(code)
+END ExitProcess;
+
+
+PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
+VAR
+    n: INTEGER;
+
+BEGIN
+    n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0]));
+    path[n] := slash;
+    path[n + 1] := 0X
+END GetCurrentDirectory;
+
+
+PROCEDURE GetChar (adr: INTEGER): CHAR;
+VAR
+    res: CHAR;
+
+BEGIN
+    SYSTEM.GET(adr, res)
+    RETURN res
+END GetChar;
+
+
+PROCEDURE ParamParse;
+VAR
+    p, count, cond: INTEGER;
+    c: CHAR;
+
+
+    PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR);
+    BEGIN
+        IF (c <= 20X) & (c # 0X) THEN
+            cond := A
+        ELSIF c = 22X THEN
+            cond := B
+        ELSIF c = 0X THEN
+            cond := 6
+        ELSE
+            cond := C
+        END
+    END ChangeCond;
+
+
+BEGIN
+    p := _GetCommandLine();
+    cond := 0;
+    count := 0;
+    WHILE (count < MAX_PARAM) & (cond # 6) DO
+        c := GetChar(p);
+        CASE cond OF
+        |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END
+        |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
+        |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END
+        |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
+        |6:
+        END;
+        INC(p)
+    END;
+    argc := count
+END ParamParse;
+
+
+PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    i, j, len: INTEGER;
+    c: CHAR;
+
+BEGIN
+    j := 0;
+    IF n < argc THEN
+        len := LEN(s) - 1;
+        i := Params[n, 0];
+        WHILE (j < len) & (i <= Params[n, 1]) DO
+            c := GetChar(i);
+            IF c # 22X THEN
+                s[j] := c;
+                INC(j)
+            END;
+            INC(i)
+        END
+    END;
+    s[j] := 0X
+END GetArg;
+
+
+PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END FileRead;
+
+
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN
+        res := -1
+    END
+
+    RETURN res
+END FileWrite;
+
+
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0)
+END FileCreate;
+
+
+PROCEDURE FileClose* (F: INTEGER);
+BEGIN
+    _CloseHandle(F)
+END FileClose;
+
+
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+    ofstr: OFSTRUCT;
+    res:   INTEGER;
+
+BEGIN
+    res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0);
+    IF res = 0FFFFFFFFH THEN
+        res := -1
+    END
+
+    RETURN res
+END FileOpen;
+
+
+PROCEDURE chmod* (FName: ARRAY OF CHAR);
+END chmod;
+
+
+PROCEDURE OutChar* (c: CHAR);
+VAR
+    count: INTEGER;
+BEGIN
+    _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL)
+END OutChar;
+
+
+PROCEDURE GetTickCount* (): INTEGER;
+    RETURN _GetTickCount() DIV 10
+END GetTickCount;
+
+
+PROCEDURE letter (c: CHAR): BOOLEAN;
+    RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z")
+END letter;
+
+
+PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
+    RETURN ~(letter(path[0]) & (path[1] = ":"))
+END isRelative;
+
+
+PROCEDURE UnixTime* (): INTEGER;
+    RETURN _time(0)
+END UnixTime;
+
+
+PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    a := 0;
+    b := 0;
+    SYSTEM.GET32(SYSTEM.ADR(x), a);
+    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b);
+    SYSTEM.GET(SYSTEM.ADR(x), res)
+    RETURN res
+END splitf;
+
+
+PROCEDURE d2s* (x: REAL): INTEGER;
+VAR
+    h, l, s, e: INTEGER;
+
+BEGIN
+    e := splitf(x, l, h);
+
+    s := ASR(h, 31) MOD 2;
+    e := (h DIV 100000H) MOD 2048;
+    IF e <= 896 THEN
+        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
+        REPEAT
+            h := h DIV 2;
+            INC(e)
+        UNTIL e = 897;
+        e := 896;
+        l := (h MOD 8) * 20000000H;
+        h := h DIV 8
+    ELSIF (1151 <= e) & (e < 2047) THEN
+        e := 1151;
+        h := 0;
+        l := 0
+    ELSIF e = 2047 THEN
+        e := 1151;
+        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
+            h := 80000H;
+            l := 0
+        END
+    END;
+    DEC(e, 896)
+
+    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
+END d2s;
+
+
+BEGIN
+    inf := SYSTEM.INF();
+    maxreal := 1.9;
+    PACK(maxreal, 1023);
+    hConsoleOutput := _GetStdHandle(-11);
+    ParamParse
+END HOST.

+ 88 - 0
lib/Windows/In.ob07

@@ -0,0 +1,88 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE In;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    MAX_LEN = 1024;
+    bit_depth = API.BIT_DEPTH;
+
+
+VAR
+
+    Done*: BOOLEAN;
+    hConsoleInput: INTEGER;
+    s: ARRAY MAX_LEN + 4 OF CHAR;
+    fmt: ARRAY 8 OF CHAR;
+
+
+PROCEDURE [ccall,   "msvcrt.dll",   ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER;
+PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER;
+PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER);
+
+
+PROCEDURE String* (VAR str: ARRAY OF CHAR);
+VAR
+    count: INTEGER;
+
+BEGIN
+    ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0);
+    IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN
+        DEC(count, 2)
+    END;
+    s[count] := 0X;
+    COPY(s, str);
+    str[LEN(str) - 1] := 0X;
+    Done := TRUE
+END String;
+
+
+PROCEDURE Int* (VAR x: INTEGER);
+BEGIN
+    String(s);
+    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.ADR(fmt[0]), SYSTEM.ADR(x)) = 1
+END Int;
+
+
+PROCEDURE Real* (VAR x: REAL);
+BEGIN
+    String(s);
+    Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1
+END Real;
+
+
+PROCEDURE Char* (VAR x: CHAR);
+BEGIN
+    String(s);
+    x := s[0]
+END Char;
+
+
+PROCEDURE Ln*;
+BEGIN
+    String(s)
+END Ln;
+
+
+PROCEDURE Open*;
+BEGIN
+    hConsoleInput := GetStdHandle(-10);
+    Done := TRUE
+END Open;
+
+
+BEGIN
+    IF bit_depth = 32 THEN
+        fmt := "%d"
+    ELSE
+        fmt := "%lld"
+    END
+END In.

+ 493 - 0
lib/Windows/Math.ob07

@@ -0,0 +1,493 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Math;
+
+IMPORT SYSTEM;
+
+
+CONST
+
+    pi* = 3.1415926535897932384626433832795028841972E0;
+    e*  = 2.7182818284590452353602874713526624977572E0;
+
+    ZERO      = 0.0E0;
+    ONE       = 1.0E0;
+    HALF      = 0.5E0;
+    TWO       = 2.0E0;
+    sqrtHalf  = 0.70710678118654752440E0;
+    eps       = 5.5511151E-17;
+    ln2Inv    = 1.44269504088896340735992468100189213E0;
+    piInv     = ONE / pi;
+    Limit     = 1.0536712E-8;
+    piByTwo   = pi / TWO;
+
+    expoMax   = 1023;
+    expoMin   = 1 - expoMax;
+
+
+VAR
+
+    LnInfinity, LnSmall, large, miny: REAL;
+
+
+PROCEDURE [oberon] sqrt* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= ZERO);
+
+    $IF (CPU_X8664)
+
+    SYSTEM.CODE(
+    0F2H, 0FH, 51H, 45H, 10H,  (*  sqrtsd  xmm0, qword[rbp + 10h]  *)
+    05DH,                      (*  pop     rbp                     *)
+    0C2H, 08H, 00H             (*  ret     8                       *)
+    )
+
+    $ELSIF (CPU_X86)
+
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,          (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FAH,                (*  fsqrt                      *)
+    05DH,                      (*  pop     ebp                *)
+    0C2H, 008H, 000H           (*  ret     8                  *)
+    )
+
+    $END
+
+    RETURN 0.0
+END sqrt;
+
+
+PROCEDURE sqri* (x: INTEGER): INTEGER;
+    RETURN x * x
+END sqri;
+
+
+PROCEDURE sqrr* (x: REAL): REAL;
+    RETURN x * x
+END sqrr;
+
+
+PROCEDURE exp* (x: REAL): REAL;
+CONST
+    c1 =  0.693359375E0;
+    c2 = -2.1219444005469058277E-4;
+    P0 =  0.249999999999999993E+0;
+    P1 =  0.694360001511792852E-2;
+    P2 =  0.165203300268279130E-4;
+    Q1 =  0.555538666969001188E-1;
+    Q2 =  0.495862884905441294E-3;
+
+VAR
+    xn, g, p, q, z: REAL;
+    n: INTEGER;
+
+BEGIN
+    IF x > LnInfinity THEN
+        x := SYSTEM.INF()
+    ELSIF x < LnSmall THEN
+        x := ZERO
+    ELSIF ABS(x) < eps THEN
+        x := ONE
+    ELSE
+        IF x >= ZERO THEN
+            n := FLOOR(ln2Inv * x + HALF)
+        ELSE
+            n := FLOOR(ln2Inv * x - HALF)
+        END;
+
+        xn := FLT(n);
+        g  := (x - xn * c1) - xn * c2;
+        z  := g * g;
+        p  := ((P2 * z + P1) * z + P0) * g;
+        q  := (Q2 * z + Q1) * z + HALF;
+        x  := HALF + p / (q - p);
+        PACK(x, n + 1)
+    END
+
+    RETURN x
+END exp;
+
+
+PROCEDURE ln* (x: REAL): REAL;
+CONST
+    c1 =  355.0E0 / 512.0E0;
+    c2 = -2.121944400546905827679E-4;
+    P0 = -0.64124943423745581147E+2;
+    P1 =  0.16383943563021534222E+2;
+    P2 = -0.78956112887491257267E+0;
+    Q0 = -0.76949932108494879777E+3;
+    Q1 =  0.31203222091924532844E+3;
+    Q2 = -0.35667977739034646171E+2;
+
+VAR
+    zn, zd, r, z, w, p, q, xn: REAL;
+    n: INTEGER;
+
+BEGIN
+    ASSERT(x > ZERO);
+
+    UNPK(x, n);
+    x := x * HALF;
+
+    IF x > sqrtHalf THEN
+        zn := x - ONE;
+        zd := x * HALF + HALF;
+        INC(n)
+    ELSE
+        zn := x - HALF;
+        zd := zn * HALF + HALF
+    END;
+
+    z  := zn / zd;
+    w  := z * z;
+    q  := ((w + Q2) * w + Q1) * w + Q0;
+    p  := w * ((P2 * w + P1) * w + P0);
+    r  := z + z * (p / q);
+    xn := FLT(n)
+
+    RETURN (xn * c2 + r) + xn * c1
+END ln;
+
+
+PROCEDURE power* (base, exponent: REAL): REAL;
+BEGIN
+    ASSERT(base > ZERO)
+    RETURN exp(exponent * ln(base))
+END power;
+
+
+PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := 1.0;
+
+    IF base # 0.0 THEN
+        IF exponent # 0 THEN
+            IF exponent < 0 THEN
+                base := 1.0 / base
+            END;
+            i := ABS(exponent);
+            WHILE i > 0 DO
+                WHILE ~ODD(i) DO
+                    i := LSR(i, 1);
+                    base := sqrr(base)
+                END;
+                DEC(i);
+                a := a * base
+            END
+        ELSE
+            a := 1.0
+        END
+    ELSE
+        ASSERT(exponent > 0);
+        a := 0.0
+    END
+
+    RETURN a
+END ipower;
+
+
+PROCEDURE log* (base, x: REAL): REAL;
+BEGIN
+    ASSERT(base > ZERO);
+    ASSERT(x > ZERO)
+    RETURN ln(x) / ln(base)
+END log;
+
+
+PROCEDURE SinCos (x, y, sign: REAL): REAL;
+CONST
+    ymax =  210828714;
+    c1   =  3.1416015625E0;
+    c2   = -8.908910206761537356617E-6;
+    r1   = -0.16666666666666665052E+0;
+    r2   =  0.83333333333331650314E-2;
+    r3   = -0.19841269841201840457E-3;
+    r4   =  0.27557319210152756119E-5;
+    r5   = -0.25052106798274584544E-7;
+    r6   =  0.16058936490371589114E-9;
+    r7   = -0.76429178068910467734E-12;
+    r8   =  0.27204790957888846175E-14;
+
+VAR
+    n: INTEGER;
+    xn, f, x1, g: REAL;
+
+BEGIN
+    ASSERT(y < FLT(ymax));
+
+    n := FLOOR(y * piInv + HALF);
+    xn := FLT(n);
+    IF ODD(n) THEN
+        sign := -sign
+    END;
+    x := ABS(x);
+    IF x # y THEN
+        xn := xn - HALF
+    END;
+
+    x1 := FLT(FLOOR(x));
+    f  := ((x1 - xn * c1) + (x - x1)) - xn * c2;
+
+    IF ABS(f) < Limit THEN
+        x := sign * f
+    ELSE
+        g := f * f;
+        g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g;
+        g := f + f * g;
+        x := sign * g
+    END
+
+    RETURN x
+END SinCos;
+
+
+PROCEDURE sin* (x: REAL): REAL;
+BEGIN
+    IF x < ZERO THEN
+        x := SinCos(x, -x, -ONE)
+    ELSE
+        x := SinCos(x, x, ONE)
+    END
+
+    RETURN x
+END sin;
+
+
+PROCEDURE cos* (x: REAL): REAL;
+    RETURN SinCos(x, ABS(x) + piByTwo, ONE)
+END cos;
+
+
+PROCEDURE tan* (x: REAL): REAL;
+VAR
+    s, c: REAL;
+
+BEGIN
+    s := sin(x);
+    c := sqrt(ONE - s * s);
+    x := ABS(x) / (TWO * pi);
+    x := x - FLT(FLOOR(x));
+    IF (0.25 < x) & (x < 0.75) THEN
+        c := -c
+    END
+
+    RETURN s / c
+END tan;
+
+
+PROCEDURE arctan2* (y, x: REAL): REAL;
+CONST
+    P0 = 0.216062307897242551884E+3;  P1 = 0.3226620700132512059245E+3;
+    P2 = 0.13270239816397674701E+3;   P3 = 0.1288838303415727934E+2;
+    Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3;
+    Q2 = 0.221050883028417680623E+3;  Q3 = 0.3850148650835119501E+2;
+    Sqrt3 = 1.7320508075688772935E0;
+
+VAR
+    atan, z, z2, p, q: REAL;
+    yExp, xExp, Quadrant: INTEGER;
+
+BEGIN
+    IF ABS(x) < miny THEN
+        ASSERT(ABS(y) >= miny);
+        atan := piByTwo
+    ELSE
+        z := y;
+        UNPK(z, yExp);
+        z := x;
+        UNPK(z, xExp);
+
+        IF yExp - xExp >= expoMax - 3 THEN
+            atan := piByTwo
+        ELSIF yExp - xExp < expoMin + 3 THEN
+            atan := ZERO
+        ELSE
+            IF ABS(y) > ABS(x) THEN
+                z := ABS(x / y);
+                Quadrant := 2
+            ELSE
+                z := ABS(y / x);
+                Quadrant := 0
+            END;
+
+            IF z > TWO - Sqrt3 THEN
+                z := (z * Sqrt3 - ONE) / (Sqrt3 + z);
+                INC(Quadrant)
+            END;
+
+            IF ABS(z) < Limit THEN
+                atan := z
+            ELSE
+                z2 := z * z;
+                p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z;
+                q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0;
+                atan := p / q
+            END;
+
+            CASE Quadrant OF
+            |0:
+            |1: atan := atan + pi / 6.0
+            |2: atan := piByTwo - atan
+            |3: atan := pi / 3.0 - atan
+            END
+        END;
+
+        IF x < ZERO THEN
+            atan := pi - atan
+        END
+    END;
+
+    IF y < ZERO THEN
+        atan := -atan
+    END
+
+    RETURN atan
+END arctan2;
+
+
+PROCEDURE arcsin* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= ONE)
+    RETURN arctan2(x, sqrt(ONE - x * x))
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) <= ONE)
+    RETURN arctan2(sqrt(ONE - x * x), x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arctan2(x, ONE)
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - ONE / x) * HALF
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + ONE / x) * HALF
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := ONE
+    ELSIF x < -15.0 THEN
+        x := -ONE
+    ELSE
+        x := ONE - TWO / (exp(TWO * x) + ONE)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + ONE))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+BEGIN
+    ASSERT(x >= ONE)
+    RETURN ln(x + sqrt(x * x - ONE))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+BEGIN
+    ASSERT(ABS(x) < ONE)
+    RETURN HALF * ln((ONE + x) / (ONE - x))
+END artanh;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > ZERO THEN
+        res := 1
+    ELSIF x < ZERO THEN
+        res := -1
+    ELSE
+        res := 0
+    END
+
+    RETURN res
+END sgn;
+
+
+PROCEDURE fact* (n: INTEGER): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    res := ONE;
+    WHILE n > 1 DO
+        res := res * FLT(n);
+        DEC(n)
+    END
+
+    RETURN res
+END fact;
+
+
+PROCEDURE DegToRad* (x: REAL): REAL;
+    RETURN x * (pi / 180.0)
+END DegToRad;
+
+
+PROCEDURE RadToDeg* (x: REAL): REAL;
+    RETURN x * (180.0 / pi)
+END RadToDeg;
+
+
+(* Return hypotenuse of triangle *)
+PROCEDURE hypot* (x, y: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    x := ABS(x);
+    y := ABS(y);
+    IF x > y THEN
+        a := x * sqrt(1.0 + sqrr(y / x))
+    ELSE
+        IF x > 0.0 THEN
+            a := y * sqrt(1.0 + sqrr(x / y))
+        ELSE
+            a := y
+        END
+    END
+
+    RETURN a
+END hypot;
+
+
+BEGIN
+    large := 1.9;
+    PACK(large, expoMax);
+    miny := ONE / large;
+    LnInfinity := ln(large);
+    LnSmall    := ln(miny);
+END Math.

+ 451 - 0
lib/Windows/Math_x86.ob07

@@ -0,0 +1,451 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2013-2014, 2018-2022 Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Math_x86;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    pi* = 3.141592653589793;
+    e*  = 2.718281828459045;
+
+
+PROCEDURE IsNan* (x: REAL): BOOLEAN;
+VAR
+    h, l: SET;
+
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), l);
+    SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
+    RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
+
+
+PROCEDURE IsInf* (x: REAL): BOOLEAN;
+    RETURN ABS(x) = SYSTEM.INF()
+END IsInf;
+
+
+PROCEDURE Max (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a > b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Max;
+
+
+PROCEDURE Min (a, b: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF a < b THEN
+        res := a
+    ELSE
+        res := b
+    END
+    RETURN res
+END Min;
+
+
+PROCEDURE SameValue (a, b: REAL): BOOLEAN;
+VAR
+    eps: REAL;
+    res: BOOLEAN;
+
+BEGIN
+    eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
+    IF a > b THEN
+        res := (a - b) <= eps
+    ELSE
+        res := (b - a) <= eps
+    END
+    RETURN res
+END SameValue;
+
+
+PROCEDURE IsZero (x: REAL): BOOLEAN;
+    RETURN ABS(x) <= 1.0E-12
+END IsZero;
+
+
+PROCEDURE [oberon] sqrt* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FAH,                    (*  fsqrt                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sqrt;
+
+
+PROCEDURE [oberon] sin* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FEH,                    (*  fsin                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END sin;
+
+
+PROCEDURE [oberon] cos* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FFH,                    (*  fcos                       *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END cos;
+
+
+PROCEDURE [oberon] tan* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0FBH,                    (*  fsincos                    *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END tan;
+
+
+PROCEDURE [oberon] arctan2* (y, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F3H,                    (*  fpatan                     *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END arctan2;
+
+
+PROCEDURE [oberon] ln* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0EDH,                    (*  fldln2                     *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 008H, 000H               (*  ret     08h                *)
+    )
+    RETURN 0.0
+END ln;
+
+
+PROCEDURE [oberon] log* (base, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0D9H, 0E8H,                    (*  fld1                       *)
+    0DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0F1H,                    (*  fyl2x                      *)
+    0DEH, 0F9H,                    (*  fdivp st1, st              *)
+    0C9H,                          (*  leave                      *)
+    0C2H, 010H, 000H               (*  ret     10h                *)
+    )
+    RETURN 0.0
+END log;
+
+
+PROCEDURE [oberon] exp* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0EAH,                 (*  fldl2e                     *)
+    0DEH, 0C9H, 0D9H, 0C0H,
+    0D9H, 0FCH, 0DCH, 0E9H,
+    0D9H, 0C9H, 0D9H, 0F0H,
+    0D9H, 0E8H, 0DEH, 0C1H,
+    0D9H, 0FDH, 0DDH, 0D9H,
+    0C9H,                       (*  leave                      *)
+    0C2H, 008H, 000H            (*  ret     08h                *)
+    )
+    RETURN 0.0
+END exp;
+
+
+PROCEDURE [oberon] round* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 07DH, 0F4H, 0D9H,
+    07DH, 0F6H, 066H, 081H,
+    04DH, 0F6H, 000H, 003H,
+    0D9H, 06DH, 0F6H, 0D9H,
+    0FCH, 0D9H, 06DH, 0F4H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END round;
+
+
+PROCEDURE [oberon] frac* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+    050H,
+    0DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+    0D9H, 0C0H, 0D9H, 03CH,
+    024H, 0D9H, 07CH, 024H,
+    002H, 066H, 081H, 04CH,
+    024H, 002H, 000H, 00FH,
+    0D9H, 06CH, 024H, 002H,
+    0D9H, 0FCH, 0D9H, 02CH,
+    024H, 0DEH, 0E9H,
+    0C9H,                       (*  leave                     *)
+    0C2H, 008H, 000H            (*  ret     08h               *)
+    )
+    RETURN 0.0
+END frac;
+
+
+PROCEDURE sqri* (x: INTEGER): INTEGER;
+    RETURN x * x
+END sqri;
+
+
+PROCEDURE sqrr* (x: REAL): REAL;
+    RETURN x * x
+END sqrr;
+
+
+PROCEDURE arcsin* (x: REAL): REAL;
+    RETURN arctan2(x, sqrt(1.0 - x * x))
+END arcsin;
+
+
+PROCEDURE arccos* (x: REAL): REAL;
+    RETURN arctan2(sqrt(1.0 - x * x), x)
+END arccos;
+
+
+PROCEDURE arctan* (x: REAL): REAL;
+    RETURN arctan2(x, 1.0)
+END arctan;
+
+
+PROCEDURE sinh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x - 1.0 / x) * 0.5
+END sinh;
+
+
+PROCEDURE cosh* (x: REAL): REAL;
+BEGIN
+    x := exp(x)
+    RETURN (x + 1.0 / x) * 0.5
+END cosh;
+
+
+PROCEDURE tanh* (x: REAL): REAL;
+BEGIN
+    IF x > 15.0 THEN
+        x := 1.0
+    ELSIF x < -15.0 THEN
+        x := -1.0
+    ELSE
+        x := 1.0 - 2.0 / (exp(2.0 * x) + 1.0)
+    END
+
+    RETURN x
+END tanh;
+
+
+PROCEDURE arsinh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x + 1.0))
+END arsinh;
+
+
+PROCEDURE arcosh* (x: REAL): REAL;
+    RETURN ln(x + sqrt(x * x - 1.0))
+END arcosh;
+
+
+PROCEDURE artanh* (x: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF SameValue(x, 1.0) THEN
+        res := SYSTEM.INF()
+    ELSIF SameValue(x, -1.0) THEN
+        res := -SYSTEM.INF()
+    ELSE
+        res := 0.5 * ln((1.0 + x) / (1.0 - x))
+    END
+    RETURN res
+END artanh;
+
+
+PROCEDURE floor* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f < 0.0 THEN
+        x := x - 1.0
+    END
+    RETURN x
+END floor;
+
+
+PROCEDURE ceil* (x: REAL): REAL;
+VAR
+    f: REAL;
+
+BEGIN
+    f := frac(x);
+    x := x - f;
+    IF f > 0.0 THEN
+        x := x + 1.0
+    END
+    RETURN x
+END ceil;
+
+
+PROCEDURE power* (base, exponent: REAL): REAL;
+VAR
+    res: REAL;
+
+BEGIN
+    IF exponent = 0.0 THEN
+        res := 1.0
+    ELSIF (base = 0.0) & (exponent > 0.0) THEN
+        res := 0.0
+    ELSE
+        res := exp(exponent * ln(base))
+    END
+    RETURN res
+END power;
+
+
+PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL;
+VAR
+    i: INTEGER;
+    a: REAL;
+
+BEGIN
+    a := 1.0;
+
+    IF base # 0.0 THEN
+        IF exponent # 0 THEN
+            IF exponent < 0 THEN
+                base := 1.0 / base
+            END;
+            i := ABS(exponent);
+            WHILE i > 0 DO
+                WHILE ~ODD(i) DO
+                    i := LSR(i, 1);
+                    base := sqrr(base)
+                END;
+                DEC(i);
+                a := a * base
+            END
+        ELSE
+            a := 1.0
+        END
+    ELSE
+        ASSERT(exponent > 0);
+        a := 0.0
+    END
+
+    RETURN a
+END ipower;
+
+
+PROCEDURE sgn* (x: REAL): INTEGER;
+VAR
+    res: INTEGER;
+
+BEGIN
+    IF x > 0.0 THEN
+        res := 1
+    ELSIF x < 0.0 THEN
+        res := -1
+    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;
+
+
+PROCEDURE DegToRad* (x: REAL): REAL;
+    RETURN x * (pi / 180.0)
+END DegToRad;
+
+
+PROCEDURE RadToDeg* (x: REAL): REAL;
+    RETURN x * (180.0 / pi)
+END RadToDeg;
+
+
+(* Return hypotenuse of triangle *)
+PROCEDURE hypot* (x, y: REAL): REAL;
+VAR
+    a: REAL;
+
+BEGIN
+    x := ABS(x);
+    y := ABS(y);
+    IF x > y THEN
+        a := x * sqrt(1.0 + sqrr(y / x))
+    ELSE
+        IF x > 0.0 THEN
+            a := y * sqrt(1.0 + sqrr(x / y))
+        ELSE
+            a := y
+        END
+    END
+
+    RETURN a
+END hypot;
+
+
+BEGIN
+    ASSERT(API.BIT_DEPTH = 32)
+END Math_x86.

+ 104 - 0
lib/Windows/Out.ob07

@@ -0,0 +1,104 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2020-2022, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE Out;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    bit_depth = API.BIT_DEPTH;
+
+
+VAR
+
+    hConsoleOutput: INTEGER;
+    fmt: ARRAY 8 OF CHAR;
+
+
+PROCEDURE [ccall, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER);
+PROCEDURE [ccall, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER);
+PROCEDURE [ccall, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision: INTEGER; x: REAL);
+PROCEDURE [ccall, "msvcrt.dll", "printf"] printf4 (fmt: INTEGER; width, precision: INTEGER; x: INTEGER);
+
+PROCEDURE [windows, "kernel32.dll", ""]
+    WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER);
+
+PROCEDURE [windows, "kernel32.dll", ""]
+    GetStdHandle (nStdHandle: INTEGER): INTEGER;
+
+
+PROCEDURE CharW* (c: WCHAR);
+BEGIN
+    WriteConsoleW(hConsoleOutput, SYSTEM.ADR(c), 1, 0, 0)
+END CharW;
+
+
+PROCEDURE StringW* (s: ARRAY OF WCHAR);
+BEGIN
+    WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0)
+END StringW;
+
+
+PROCEDURE Char* (c: CHAR);
+BEGIN
+    printf1(SYSTEM.SADR("%c"), ORD(c))
+END Char;
+
+
+PROCEDURE String* (s: ARRAY OF CHAR);
+BEGIN
+    printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0]))
+END String;
+
+
+PROCEDURE Ln*;
+BEGIN
+    printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10)))
+END Ln;
+
+
+PROCEDURE Int* (x, width: INTEGER);
+BEGIN
+    printf2(SYSTEM.ADR(fmt[0]), width, x)
+END Int;
+
+
+PROCEDURE Real* (x: REAL; width: INTEGER);
+BEGIN
+    IF bit_depth = 32 THEN
+        printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x)
+    ELSE
+        printf4(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), SYSTEM.VAL(x, INTEGER))
+    END
+END Real;
+
+
+PROCEDURE FixReal* (x: REAL; width, precision: INTEGER);
+BEGIN
+    IF bit_depth = 32 THEN
+        printf3(SYSTEM.SADR("%*.*f"), width, precision, x)
+    ELSE
+        printf4(SYSTEM.SADR("%*.*f"), width, precision, SYSTEM.VAL(x, INTEGER))
+    END
+END FixReal;
+
+
+PROCEDURE Open*;
+BEGIN
+    hConsoleOutput := GetStdHandle(-11)
+END Open;
+
+
+BEGIN
+    IF bit_depth = 32 THEN
+        fmt := "%*d"
+    ELSE
+        fmt := "%*lld"
+    END
+END Out.

+ 1072 - 0
lib/Windows/RTL.ob07

@@ -0,0 +1,1072 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2018-2021, 2023, Anton Krotov
+    All rights reserved.
+*)
+
+(*---------------------x86_64---------------------*)
+
+$IF (CPU_X8664)
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name:  INTEGER;
+    types: INTEGER;
+
+
+PROCEDURE [oberon] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 010H,    (*  mov     rax, qword [rbp + 16]  *)
+    048H, 085H, 0C0H,          (*  test    rax, rax               *)
+    07EH, 020H,                (*  jle     L                      *)
+    0FCH,                      (*  cld                            *)
+    057H,                      (*  push    rdi                    *)
+    056H,                      (*  push    rsi                    *)
+    048H, 08BH, 075H, 020H,    (*  mov     rsi, qword [rbp + 32]  *)
+    048H, 08BH, 07DH, 018H,    (*  mov     rdi, qword [rbp + 24]  *)
+    048H, 089H, 0C1H,          (*  mov     rcx, rax               *)
+    048H, 0C1H, 0E9H, 003H,    (*  shr     rcx, 3                 *)
+    0F3H, 048H, 0A5H,          (*  rep     movsd                  *)
+    048H, 089H, 0C1H,          (*  mov     rcx, rax               *)
+    048H, 083H, 0E1H, 007H,    (*  and     rcx, 7                 *)
+    0F3H, 0A4H,                (*  rep     movsb                  *)
+    05EH,                      (*  pop     rsi                    *)
+    05FH                       (*  pop     rdi                    *)
+                               (*  L:                             *)
+                )
+END _move;
+
+
+PROCEDURE [oberon] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [oberon] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [oberon] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov   rcx, qword [rbp + 16]  *)  (* rcx <- Len *)
+    048H, 08BH, 045H, 018H,   (*  mov   rax, qword [rbp + 24]  *)  (* rax <- Ptr *)
+    048H, 0FFH, 0C9H,         (*  dec   rcx                    *)
+    04CH, 08BH, 010H,         (*  mov   r10, qword [rax]       *)
+                              (*  L:                           *)
+    048H, 08BH, 050H, 008H,   (*  mov   rdx, qword [rax + 8]   *)
+    048H, 089H, 010H,         (*  mov   qword [rax], rdx       *)
+    048H, 083H, 0C0H, 008H,   (*  add   rax, 8                 *)
+    048H, 0FFH, 0C9H,         (*  dec   rcx                    *)
+    075H, 0F0H,               (*  jnz   L                      *)
+    04CH, 089H, 010H,         (*  mov   qword [rax], r10       *)
+    05DH,                     (*  pop   rbp                    *)
+    0C2H, 010H, 000H          (*  ret   16                     *)
+    )
+END _rot;
+
+
+PROCEDURE [oberon] _set* (b, a: INTEGER); (* {a..b} -> rax *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,    (*  mov   rcx, qword ptr [rbp + 16]  *)  (* rcx <- b *)
+    048H, 08BH, 045H, 018H,    (*  mov   rax, qword ptr [rbp + 24]  *)  (* rax <- a *)
+    048H, 039H, 0C8H,          (*  cmp   rax, rcx                   *)
+    07FH, 047H,                (*  jg    L1                         *)
+    048H, 083H, 0F8H, 03FH,    (*  cmp   rax, 63                    *)
+    07FH, 041H,                (*  jg    L1                         *)
+    048H, 085H, 0C9H,          (*  test  rcx, rcx                   *)
+    07CH, 03CH,                (*  jl    L1                         *)
+    048H, 083H, 0F9H, 03FH,    (*  cmp   rcx, 63                    *)
+    07EH, 007H,                (*  jle   L3                         *)
+    048H, 0C7H, 0C1H, 03FH,    (*  mov   rcx, 63                    *)
+    000H, 000H, 000H,
+                               (*  L3:                              *)
+    048H, 085H, 0C0H,          (*  test  rax, rax                   *)
+    07DH, 003H,                (*  jge   L2                         *)
+    048H, 031H, 0C0H,          (*  xor   rax, rax                   *)
+                               (*  L2:                              *)
+    048H, 089H, 0CAH,          (*  mov   rdx, rcx                   *)
+    048H, 029H, 0C2H,          (*  sub   rdx, rax                   *)
+    048H, 0B8H, 000H, 000H,    (*  movabs   rax, minint             *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+
+    048H, 087H, 0CAH,          (*  xchg  rdx, rcx                   *)
+    048H, 0D3H, 0F8H,          (*  sar   rax, cl                    *)
+    048H, 087H, 0CAH,          (*  xchg  rdx, rcx                   *)
+    048H, 083H, 0E9H, 03FH,    (*  sub   rcx, 63                    *)
+    048H, 0F7H, 0D9H,          (*  neg   rcx                        *)
+    048H, 0D3H, 0E8H,          (*  shr   rax, cl                    *)
+    05DH,                      (*  pop   rbp                        *)
+    0C2H, 010H, 000H,          (*  ret   16                         *)
+                               (*  L1:                              *)
+    048H, 031H, 0C0H,          (*  xor   rax, rax                   *)
+    05DH,                      (*  pop   rbp                        *)
+    0C2H, 010H, 000H           (*  ret   16                         *)
+    )
+END _set;
+
+
+PROCEDURE [oberon] _set1* (a: INTEGER); (* {a} -> rax *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 031H, 0C0H,         (*  xor  rax, rax               *)
+    048H, 08BH, 04DH, 010H,   (*  mov  rcx, qword [rbp + 16]  *)  (* rcx <- a *)
+    048H, 083H, 0F9H, 03FH,   (*  cmp  rcx, 63                *)
+    077H, 004H,               (*  ja   L                      *)
+    048H, 00FH, 0ABH, 0C8H    (*  bts  rax, rcx               *)
+                              (*  L:                          *)
+    )
+END _set1;
+
+
+PROCEDURE [oberon] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *)
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,    (*  mov     rax, qword [rbp + 24]  *)  (* rax <- x *)
+    048H, 031H, 0D2H,          (*  xor     rdx, rdx               *)
+    048H, 085H, 0C0H,          (*  test    rax, rax               *)
+    074H, 022H,                (*  je      L2                     *)
+    07FH, 003H,                (*  jg      L1                     *)
+    048H, 0F7H, 0D2H,          (*  not     rdx                    *)
+                               (*  L1:                            *)
+    049H, 089H, 0C0H,          (*  mov     r8, rax                *)
+    048H, 08BH, 04DH, 010H,    (*  mov     rcx, qword [rbp + 16]  *)  (* rcx <- y *)
+    048H, 0F7H, 0F9H,          (*  idiv    rcx                    *)
+    048H, 085H, 0D2H,          (*  test    rdx, rdx               *)
+    074H, 00EH,                (*  je      L2                     *)
+    049H, 031H, 0C8H,          (*  xor     r8, rcx                *)
+    04DH, 085H, 0C0H,          (*  test    r8, r8                 *)
+    07DH, 006H,                (*  jge     L2                     *)
+    048H, 0FFH, 0C8H,          (*  dec     rax                    *)
+    048H, 001H, 0CAH           (*  add     rdx, rcx               *)
+                               (*  L2:                            *)
+               )
+END _divmod;
+
+
+PROCEDURE [oberon] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr + 8, t);
+        INC(ptr, 16)
+    END
+END _new;
+
+
+PROCEDURE [oberon] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - 16)
+    END
+END _dispose;
+
+
+PROCEDURE [oberon] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,     (*  mov     rax, qword [rbp + 24]  *)
+    048H, 08BH, 04DH, 010H,     (*  mov     rcx, qword [rbp + 16]  *)
+    048H, 0FFH, 0C8H,           (*  dec     rax                    *)
+                                (*  L1:                            *)
+    048H, 0FFH, 0C0H,           (*  inc     rax                    *)
+    080H, 038H, 000H,           (*  cmp     byte [rax], 0          *)
+    074H, 005H,                 (*  jz      L2                     *)
+    0E2H, 0F6H,                 (*  loop    L1                     *)
+    048H, 0FFH, 0C0H,           (*  inc     rax                    *)
+                                (*  L2:                            *)
+    048H, 02BH, 045H, 018H      (*  sub     rax, qword [rbp + 24]  *)
+               )
+END _length;
+
+
+PROCEDURE [oberon] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 045H, 018H,     (*  mov     rax, qword [rbp + 24]  *)
+    048H, 08BH, 04DH, 010H,     (*  mov     rcx, qword [rbp + 16]  *)
+    048H, 083H, 0E8H, 002H,     (*  sub     rax, 2                 *)
+                                (*  L1:                            *)
+    048H, 083H, 0C0H, 002H,     (*  add     rax, 2                 *)
+    066H, 083H, 038H, 000H,     (*  cmp     word [rax], 0          *)
+    074H, 006H,                 (*  jz      L2                     *)
+    0E2H, 0F4H,                 (*  loop    L1                     *)
+    048H, 083H, 0C0H, 002H,     (*  add     rax, 2                 *)
+                                (*  L2:                            *)
+    048H, 02BH, 045H, 018H,     (*  sub     rax, qword [rbp + 24]  *)
+    048H, 0D1H, 0E8H            (*  shr     rax, 1                 *)
+               )
+END _lengthw;
+
+
+PROCEDURE [oberon] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov     rcx, qword[rbp + 16]; rcx <- a *)
+    048H, 08BH, 055H, 018H,   (*  mov     rdx, qword[rbp + 24]; rdx <- b *)
+    04CH, 08BH, 045H, 020H,   (*  mov     r8,  qword[rbp + 32]; r8  <- n *)
+    04DH, 031H, 0C9H,         (*  xor     r9, r9                         *)
+    04DH, 031H, 0D2H,         (*  xor     r10, r10                       *)
+    048H, 0B8H, 000H, 000H,   (*  movabs  rax, minint                    *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+                              (*  L1:                                    *)
+    04DH, 085H, 0C0H,         (*  test    r8, r8                         *)
+    07EH, 024H,               (*  jle     L3                             *)
+    044H, 08AH, 009H,         (*  mov     r9b, byte[rcx]                 *)
+    044H, 08AH, 012H,         (*  mov     r10b, byte[rdx]                *)
+    048H, 0FFH, 0C1H,         (*  inc     rcx                            *)
+    048H, 0FFH, 0C2H,         (*  inc     rdx                            *)
+    049H, 0FFH, 0C8H,         (*  dec     r8                             *)
+    04DH, 039H, 0D1H,         (*  cmp     r9, r10                        *)
+    074H, 008H,               (*  je      L2                             *)
+    04CH, 089H, 0C8H,         (*  mov     rax, r9                        *)
+    04CH, 029H, 0D0H,         (*  sub     rax, r10                       *)
+    0EBH, 008H,               (*  jmp     L3                             *)
+                              (*  L2:                                    *)
+    04DH, 085H, 0C9H,         (*  test    r9, r9                         *)
+    075H, 0DAH,               (*  jne     L1                             *)
+    048H, 031H, 0C0H,         (*  xor     rax, rax                       *)
+                              (*  L3:                                    *)
+    05DH,                     (*  pop     rbp                            *)
+    0C2H, 018H, 000H          (*  ret     24                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [oberon] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    048H, 08BH, 04DH, 010H,   (*  mov     rcx, qword[rbp + 16]; rcx <- a *)
+    048H, 08BH, 055H, 018H,   (*  mov     rdx, qword[rbp + 24]; rdx <- b *)
+    04CH, 08BH, 045H, 020H,   (*  mov     r8,  qword[rbp + 32]; r8  <- n *)
+    04DH, 031H, 0C9H,         (*  xor     r9, r9                         *)
+    04DH, 031H, 0D2H,         (*  xor     r10, r10                       *)
+    048H, 0B8H, 000H, 000H,   (*  movabs  rax, minint                    *)
+    000H, 000H, 000H, 000H,
+    000H, 080H,
+                              (*  L1:                                    *)
+    04DH, 085H, 0C0H,         (*  test    r8, r8                         *)
+    07EH, 028H,               (*  jle     L3                             *)
+    066H, 044H, 08BH, 009H,   (*  mov     r9w, word[rcx]                 *)
+    066H, 044H, 08BH, 012H,   (*  mov     r10w, word[rdx]                *)
+    048H, 083H, 0C1H, 002H,   (*  add     rcx, 2                         *)
+    048H, 083H, 0C2H, 002H,   (*  add     rdx, 2                         *)
+    049H, 0FFH, 0C8H,         (*  dec     r8                             *)
+    04DH, 039H, 0D1H,         (*  cmp     r9, r10                        *)
+    074H, 008H,               (*  je      L2                             *)
+    04CH, 089H, 0C8H,         (*  mov     rax, r9                        *)
+    04CH, 029H, 0D0H,         (*  sub     rax, r10                       *)
+    0EBH, 008H,               (*  jmp     L3                             *)
+                              (*  L2:                                    *)
+    04DH, 085H, 0C9H,         (*  test    r9, r9                         *)
+    075H, 0D6H,               (*  jne     L1                             *)
+    048H, 031H, 0C0H,         (*  xor     rax, rax                       *)
+                              (*  L3:                                    *)
+    05DH,                     (*  pop     rbp                            *)
+    0C2H, 018H, 000H          (*  ret     24                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+PROCEDURE [oberon] _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+PROCEDURE [oberon] _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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [oberon] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [oberon] _isrec* (t0, t1, r: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _isrec;
+
+
+PROCEDURE [oberon] _is* (t0, p: INTEGER): INTEGER;
+BEGIN
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    END
+
+    RETURN p MOD 2
+END _is;
+
+
+PROCEDURE [oberon] _guardrec* (t0, t1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _guardrec;
+
+
+PROCEDURE [oberon] _guard* (t0, p: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    ELSE
+        p := 1
+    END
+
+    RETURN p MOD 2
+END _guard;
+
+
+PROCEDURE [oberon] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [oberon] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [oberon] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+PROCEDURE [oberon] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
+    t0, t1, i, j: INTEGER;
+
+BEGIN
+    API.init(param, code);
+
+    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 * WORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
+    name := modname
+END _init;
+
+
+END RTL.
+$END
+
+(*---------------------x86------------------------*)
+
+$IF (CPU_X86)
+MODULE RTL;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    minint = ROR(1, 1);
+
+    WORD = API.BIT_DEPTH DIV 8;
+
+
+VAR
+
+    name:  INTEGER;
+    types: INTEGER;
+
+
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
+    085H, 0C0H,          (*  test eax, eax              *)
+    07EH, 019H,          (*  jle L                      *)
+    0FCH,                (*  cld                        *)
+    057H,                (*  push edi                   *)
+    056H,                (*  push esi                   *)
+    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
+    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
+    0F3H, 0A5H,          (*  rep movsd                  *)
+    089H, 0C1H,          (*  mov ecx, eax               *)
+    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
+    0F3H, 0A4H,          (*  rep movsb                  *)
+    05EH,                (*  pop esi                    *)
+    05FH                 (*  pop edi                    *)
+                         (*  L:                         *)
+                )
+END _move;
+
+
+PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
+VAR
+    res: BOOLEAN;
+
+BEGIN
+    IF len_src > len_dst THEN
+        res := FALSE
+    ELSE
+        _move(len_src * base_size, dst, src);
+        res := TRUE
+    END
+
+    RETURN res
+END _arrcpy;
+
+
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
+BEGIN
+    _move(MIN(len_dst, len_src) * chr_size, dst, src)
+END _strcpy;
+
+
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,   (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- Len *)
+    08BH, 045H, 00CH,   (*  mov   eax, dword [ebp + 12]  *)  (* eax <- Ptr *)
+    049H,               (*  dec   ecx                    *)
+    053H,               (*  push  ebx                    *)
+    08BH, 018H,         (*  mov   ebx, dword [eax]       *)
+                        (*  L:                           *)
+    08BH, 050H, 004H,   (*  mov   edx, dword [eax + 4]   *)
+    089H, 010H,         (*  mov   dword [eax], edx       *)
+    083H, 0C0H, 004H,   (*  add   eax, 4                 *)
+    049H,               (*  dec   ecx                    *)
+    075H, 0F5H,         (*  jnz   L                      *)
+    089H, 018H,         (*  mov   dword [eax], ebx       *)
+    05BH,               (*  pop   ebx                    *)
+    05DH,               (*  pop   ebp                    *)
+    0C2H, 008H, 000H    (*  ret   8                      *)
+    )
+END _rot;
+
+
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    08BH, 04DH, 008H,              (*  mov   ecx, dword [ebp +  8]  *)  (* ecx <- b *)
+    08BH, 045H, 00CH,              (*  mov   eax, dword [ebp + 12]  *)  (* eax <- a *)
+    039H, 0C8H,                    (*  cmp   eax, ecx               *)
+    07FH, 033H,                    (*  jg    L1                     *)
+    083H, 0F8H, 01FH,              (*  cmp   eax, 31                *)
+    07FH, 02EH,                    (*  jg    L1                     *)
+    085H, 0C9H,                    (*  test  ecx, ecx               *)
+    07CH, 02AH,                    (*  jl    L1                     *)
+    083H, 0F9H, 01FH,              (*  cmp   ecx, 31                *)
+    07EH, 005H,                    (*  jle   L3                     *)
+    0B9H, 01FH, 000H, 000H, 000H,  (*  mov   ecx, 31                *)
+                                   (*  L3:                          *)
+    085H, 0C0H,                    (*  test  eax, eax               *)
+    07DH, 002H,                    (*  jge   L2                     *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+                                   (*  L2:                          *)
+    089H, 0CAH,                    (*  mov   edx, ecx               *)
+    029H, 0C2H,                    (*  sub   edx, eax               *)
+    0B8H, 000H, 000H, 000H, 080H,  (*  mov   eax, 0x80000000        *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    0D3H, 0F8H,                    (*  sar   eax, cl                *)
+    087H, 0CAH,                    (*  xchg  edx, ecx               *)
+    083H, 0E9H, 01FH,              (*  sub   ecx, 31                *)
+    0F7H, 0D9H,                    (*  neg   ecx                    *)
+    0D3H, 0E8H,                    (*  shr   eax, cl                *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H,              (*  ret   8                      *)
+                                   (*  L1:                          *)
+    031H, 0C0H,                    (*  xor   eax, eax               *)
+    05DH,                          (*  pop   ebp                    *)
+    0C2H, 008H, 000H               (*  ret   8                      *)
+    )
+END _set;
+
+
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
+BEGIN
+    SYSTEM.CODE(
+    031H, 0C0H,         (*  xor  eax, eax              *)
+    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
+    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
+    077H, 003H,         (*  ja   L                     *)
+    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
+                        (*  L:                         *)
+    )
+END _set1;
+
+
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
+BEGIN
+    SYSTEM.CODE(
+    053H,                (*  push    ebx                    *)
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
+    031H, 0D2H,          (*  xor     edx, edx               *)
+    085H, 0C0H,          (*  test    eax, eax               *)
+    074H, 018H,          (*  je      L2                     *)
+    07FH, 002H,          (*  jg      L1                     *)
+    0F7H, 0D2H,          (*  not     edx                    *)
+                         (*  L1:                            *)
+    089H, 0C3H,          (*  mov     ebx, eax               *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
+    0F7H, 0F9H,          (*  idiv    ecx                    *)
+    085H, 0D2H,          (*  test    edx, edx               *)
+    074H, 009H,          (*  je      L2                     *)
+    031H, 0CBH,          (*  xor     ebx, ecx               *)
+    085H, 0DBH,          (*  test    ebx, ebx               *)
+    07DH, 003H,          (*  jge     L2                     *)
+    048H,                (*  dec     eax                    *)
+    001H, 0CAH,          (*  add     edx, ecx               *)
+                         (*  L2:                            *)
+    05BH                 (*  pop     ebx                    *)
+               )
+END _divmod;
+
+
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
+BEGIN
+    ptr := API._NEW(size);
+    IF ptr # 0 THEN
+        SYSTEM.PUT(ptr + ORD(API.OS = "LINUX")*12, t);
+        INC(ptr, 4 + ORD(API.OS = "LINUX")*12)
+    END
+END _new;
+
+
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
+BEGIN
+    IF ptr # 0 THEN
+        ptr := API._DISPOSE(ptr - (4 + ORD(API.OS = "LINUX")*12))
+    END
+END _dispose;
+
+
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                (*  dec     eax                     *)
+                         (*  L1:                             *)
+    040H,                (*  inc     eax                     *)
+    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
+    074H, 003H,          (*  jz      L2                      *)
+    0E2H, 0F8H,          (*  loop    L1                      *)
+    040H,                (*  inc     eax                     *)
+                         (*  L2:                             *)
+    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
+               )
+END _length;
+
+
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
+BEGIN
+    SYSTEM.CODE(
+    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
+    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
+    048H,                     (*  dec     eax                     *)
+    048H,                     (*  dec     eax                     *)
+                              (*  L1:                             *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
+    074H, 004H,               (*  jz      L2                      *)
+    0E2H, 0F6H,               (*  loop    L1                      *)
+    040H,                     (*  inc     eax                     *)
+    040H,                     (*  inc     eax                     *)
+                              (*  L2:                             *)
+    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
+    0D1H, 0E8H                (*  shr     eax, 1                  *)
+               )
+END _lengthw;
+
+
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 017H,              (*  jle     L3                             *)
+    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
+    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E7H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmp;
+
+
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.CODE(
+    056H,                    (*  push    esi                            *)
+    057H,                    (*  push    edi                            *)
+    053H,                    (*  push    ebx                            *)
+    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
+    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
+    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
+    031H, 0C9H,              (*  xor     ecx, ecx                       *)
+    031H, 0D2H,              (*  xor     edx, edx                       *)
+    0B8H,
+    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
+                             (*  L1:                                    *)
+    085H, 0DBH,              (*  test    ebx, ebx                       *)
+    07EH, 01BH,              (*  jle     L3                             *)
+    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
+    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
+    046H,                    (*  inc     esi                            *)
+    046H,                    (*  inc     esi                            *)
+    047H,                    (*  inc     edi                            *)
+    047H,                    (*  inc     edi                            *)
+    04BH,                    (*  dec     ebx                            *)
+    039H, 0D1H,              (*  cmp     ecx, edx                       *)
+    074H, 006H,              (*  je      L2                             *)
+    089H, 0C8H,              (*  mov     eax, ecx                       *)
+    029H, 0D0H,              (*  sub     eax, edx                       *)
+    0EBH, 006H,              (*  jmp     L3                             *)
+                             (*  L2:                                    *)
+    085H, 0C9H,              (*  test    ecx, ecx                       *)
+    075H, 0E3H,              (*  jne     L1                             *)
+    031H, 0C0H,              (*  xor     eax, eax                       *)
+                             (*  L3:                                    *)
+    05BH,                    (*  pop     ebx                            *)
+    05FH,                    (*  pop     edi                            *)
+    05EH,                    (*  pop     esi                            *)
+    05DH,                    (*  pop     ebp                            *)
+    0C2H, 00CH, 000H         (*  ret     12                             *)
+    )
+    RETURN 0
+END strncmpw;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmp;
+
+
+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 = 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
+    |0: bRes := res =  0
+    |1: bRes := res #  0
+    |2: bRes := res <  0
+    |3: bRes := res <= 0
+    |4: bRes := res >  0
+    |5: bRes := res >= 0
+    END
+
+    RETURN bRes
+END _strcmpw;
+
+
+PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
+VAR
+    c: CHAR;
+    i: INTEGER;
+
+BEGIN
+    i := 0;
+    REPEAT
+        SYSTEM.GET(pchar, c);
+        s[i] := c;
+        INC(pchar);
+        INC(i)
+    UNTIL c = 0X
+END PCharToStr;
+
+
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
+VAR
+    i, a: INTEGER;
+
+BEGIN
+    i := 0;
+    a := x;
+    REPEAT
+        INC(i);
+        a := a DIV 10
+    UNTIL a = 0;
+
+    str[i] := 0X;
+
+    REPEAT
+        DEC(i);
+        str[i] := CHR(x MOD 10 + ORD("0"));
+        x := x DIV 10
+    UNTIL x = 0
+END IntToStr;
+
+
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
+VAR
+    n1, n2: INTEGER;
+
+BEGIN
+    n1 := LENGTH(s1);
+    n2 := LENGTH(s2);
+
+    ASSERT(n1 + n2 < LEN(s1));
+
+    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
+    s1[n1 + n2] := 0X
+END append;
+
+
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
+VAR
+    s, temp: ARRAY 1024 OF CHAR;
+
+BEGIN
+    CASE err OF
+    | 1: s := "assertion failure"
+    | 2: s := "NIL dereference"
+    | 3: s := "bad divisor"
+    | 4: s := "NIL procedure call"
+    | 5: s := "type guard error"
+    | 6: s := "index out of range"
+    | 7: s := "invalid CASE"
+    | 8: s := "array assignment error"
+    | 9: s := "CHR out of range"
+    |10: s := "WCHR out of range"
+    |11: s := "BYTE out of range"
+    END;
+
+    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
+    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
+
+    API.DebugMsg(SYSTEM.ADR(s[0]), name);
+
+    API.exit_thread(0)
+END _error;
+
+
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _isrec;
+
+
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
+BEGIN
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    END
+
+    RETURN p MOD 2
+END _is;
+
+
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
+END _guardrec;
+
+
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
+BEGIN
+    SYSTEM.GET(p, p);
+    IF p # 0 THEN
+        SYSTEM.GET(p - WORD, p);
+        SYSTEM.GET(t0 + p + types, p)
+    ELSE
+        p := 1
+    END
+
+    RETURN p MOD 2
+END _guard;
+
+
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
+    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
+END _dllentry;
+
+
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    API.sofinit
+END _sofinit;
+
+
+PROCEDURE [stdcall] _exit* (code: INTEGER);
+BEGIN
+    API.exit(code)
+END _exit;
+
+
+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 := 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 * WORD, t1)
+            END;
+
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
+        END
+    END;
+
+    name := modname
+END _init;
+
+
+END RTL.
+$END

+ 224 - 0
lib/Windows/WINAPI.ob07

@@ -0,0 +1,224 @@
+(*
+    BSD 2-Clause License
+
+    Copyright (c) 2019-2021, Anton Krotov
+    All rights reserved.
+*)
+
+MODULE WINAPI;
+
+IMPORT SYSTEM, API;
+
+
+CONST
+
+    OFS_MAXPATHNAME* = 128;
+
+    KERNEL = "kernel32.dll";
+    USER   = "user32.dll";
+    MSVCRT = "msvcrt.dll";
+
+
+TYPE
+
+    DLL_ENTRY* = API.DLL_ENTRY;
+
+    STRING = ARRAY 260 OF CHAR;
+
+    TCoord* = RECORD
+
+        X*, Y*: WCHAR
+
+    END;
+
+    TSmallRect* = RECORD
+
+        Left*, Top*, Right*, Bottom*: WCHAR
+
+    END;
+
+    TConsoleScreenBufferInfo* = RECORD
+
+        dwSize*:               TCoord;
+        dwCursorPosition*:     TCoord;
+        wAttributes*:          WCHAR;
+        srWindow*:             TSmallRect;
+        dwMaximumWindowSize*:  TCoord
+
+    END;
+
+    TSystemTime* = RECORD
+
+        Year*,
+        Month*,
+        DayOfWeek*,
+        Day*,
+        Hour*,
+        Min*,
+        Sec*,
+        MSec*:  WCHAR
+
+    END;
+
+    tm* = RECORD
+
+        sec*,
+        min*,
+        hour*,
+        mday*,
+        mon*,
+        year*,
+        wday*,
+        yday*,
+        isdst*: SYSTEM.CARD32
+
+    END;
+
+    PSecurityAttributes* = POINTER TO TSecurityAttributes;
+
+    TSecurityAttributes* = RECORD
+
+        nLength*:               SYSTEM.CARD32;
+        lpSecurityDescriptor*:  INTEGER;
+        bInheritHandle*:        SYSTEM.CARD32 (* BOOL *)
+
+    END;
+
+    TFileTime* = RECORD
+
+        dwLowDateTime*,
+        dwHighDateTime*: SYSTEM.CARD32
+
+    END;
+
+    TWin32FindData* = RECORD
+
+        dwFileAttributes*:    SYSTEM.CARD32;
+        ftCreationTime*:      TFileTime;
+        ftLastAccessTime*:    TFileTime;
+        ftLastWriteTime*:     TFileTime;
+        nFileSizeHigh*:       SYSTEM.CARD32;
+        nFileSizeLow*:        SYSTEM.CARD32;
+        dwReserved0*:         SYSTEM.CARD32;
+        dwReserved1*:         SYSTEM.CARD32;
+        cFileName*:           STRING;
+        cAlternateFileName*:  ARRAY 14 OF CHAR;
+        dwFileType*:          SYSTEM.CARD32;
+        dwCreatorType*:       SYSTEM.CARD32;
+        wFinderFlags*:        WCHAR
+
+    END;
+
+    OFSTRUCT* = RECORD
+
+        cBytes*:      BYTE;
+        fFixedDisk*:  BYTE;
+        nErrCode*:    WCHAR;
+        Reserved1*:   WCHAR;
+        Reserved2*:   WCHAR;
+        szPathName*:  ARRAY OFS_MAXPATHNAME OF CHAR
+
+    END;
+
+    POverlapped* = POINTER TO OVERLAPPED;
+
+    OVERLAPPED* = RECORD
+
+        Internal*:      INTEGER;
+        InternalHigh*:  INTEGER;
+        Offset*:        SYSTEM.CARD32;
+        OffsetHigh*:    SYSTEM.CARD32;
+        hEvent*:        INTEGER
+
+    END;
+
+
+PROCEDURE [windows-, KERNEL, ""] SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputCharacterA* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GetStdHandle* (nStdHandle: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] CloseHandle* (hObject: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GetCommandLineA* (): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GlobalFree* (hMem: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] ExitProcess* (code: INTEGER);
+
+PROCEDURE [windows-, KERNEL, ""] GetTickCount* (): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] Sleep* (dwMilliseconds: INTEGER);
+
+PROCEDURE [windows-, KERNEL, ""] FreeLibrary* (hLibModule: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GetProcAddress* (hModule, name: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] LoadLibraryA* (name: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] AllocConsole* (): BOOLEAN;
+
+PROCEDURE [windows-, KERNEL, ""] FreeConsole* (): BOOLEAN;
+
+PROCEDURE [windows-, KERNEL, ""] GetLocalTime* (T: TSystemTime);
+
+PROCEDURE [windows-, KERNEL, ""] RemoveDirectoryA* (lpPathName: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] GetFileAttributesA* (lpPathName: INTEGER): SET;
+
+PROCEDURE [windows-, KERNEL, ""] CreateDirectoryA* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] FindFirstFileA* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] DeleteFileA* (lpFileName: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] FindClose* (hFindFile: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] CreateFileA* (
+        lpFileName, dwDesiredAccess, dwShareMode: INTEGER;
+        lpSecurityAttributes: PSecurityAttributes;
+        dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] ReadConsoleA* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
+
+PROCEDURE [windows-, KERNEL, ""] WriteConsoleA* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER;
+
+PROCEDURE [windows-, USER,   ""] MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
+
+PROCEDURE [windows-, USER,   ""] MessageBoxW* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
+
+PROCEDURE [windows-, USER,   ""] CreateWindowExA* (
+        dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y,
+        nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER;
+
+PROCEDURE [ccall-, MSVCRT, ""] time* (ptr: INTEGER): INTEGER;
+
+PROCEDURE [ccall-, MSVCRT, ""] mktime* (time: tm): INTEGER;
+
+
+PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
+BEGIN
+    API.SetDll(process_detach, thread_detach, thread_attach)
+END SetDllEntry;
+
+
+END WINAPI.

+ 5 - 0
samples/KolibriOS/BUILD_ALL.SH

@@ -0,0 +1,5 @@
+#SHS
+/kolibrios/develop/oberon07/compiler.kex HW.ob07 kosexe -out /tmp0/1/HW.kex -stk 1
+/kolibrios/develop/oberon07/compiler.kex HW_con.ob07 kosexe -out /tmp0/1/HW_con.kex -stk 1
+/kolibrios/develop/oberon07/compiler.kex Dialogs.ob07 kosexe -out /tmp0/1/Dialogs.kex -stk 1
+exit

+ 159 - 0
samples/KolibriOS/Dialogs.ob07

@@ -0,0 +1,159 @@
+MODULE Dialogs;
+
+IMPORT
+	KOSAPI, SYSTEM, OpenDlg, ColorDlg;
+
+
+CONST
+	btnNone  =  0;
+	btnClose =  1;
+	btnOpen  = 17;
+	btnColor = 18;
+
+
+VAR
+	header: ARRAY 1024 OF CHAR;
+	back_color: INTEGER;
+
+
+PROCEDURE BeginDraw;
+BEGIN
+	KOSAPI.sysfunc2(12, 1)
+END BeginDraw;
+
+
+PROCEDURE EndDraw;
+BEGIN
+	KOSAPI.sysfunc2(12, 2)
+END EndDraw;
+
+
+PROCEDURE DefineAndDrawWindow (left, top, width, height, color, style, hcolor, hstyle: INTEGER; header: ARRAY OF CHAR);
+BEGIN
+	KOSAPI.sysfunc6(0, left*65536 + width, top*65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(header[0]))
+END DefineAndDrawWindow;
+
+
+PROCEDURE WaitForEvent (): INTEGER;
+	RETURN KOSAPI.sysfunc1(10)
+END WaitForEvent;
+
+
+PROCEDURE ExitApp;
+BEGIN
+	KOSAPI.sysfunc1(-1)
+END ExitApp;
+
+
+PROCEDURE pause (t: INTEGER);
+BEGIN
+	KOSAPI.sysfunc2(5, t)
+END pause;
+
+
+PROCEDURE Buttons;
+
+	PROCEDURE Button (id, X, Y, W, H: INTEGER; Caption: ARRAY OF CHAR);
+	VAR
+		n: INTEGER;
+	BEGIN
+		n := LENGTH(Caption);
+		KOSAPI.sysfunc5(8, X*65536 + W, Y*65536 + H, id, 00C0C0C0H);
+		X := X + (W - 8*n) DIV 2;
+		Y := Y + (H - 14) DIV 2;
+		KOSAPI.sysfunc6(4, X*65536 + Y, LSL(48, 24), SYSTEM.ADR(Caption[0]), n, 0)
+	END Button;
+
+BEGIN
+	Button(btnOpen,   5, 5, 70, 25, "open");
+	Button(btnColor, 85, 5, 70, 25, "color");
+END Buttons;
+
+
+PROCEDURE draw_window;
+BEGIN
+	BeginDraw;
+	DefineAndDrawWindow(200, 200, 500, 100, back_color, 51, 0, 0, header);
+	Buttons;
+	EndDraw;
+END draw_window;
+
+
+PROCEDURE OpenFile (Open: OpenDlg.Dialog);
+BEGIN
+	IF Open # NIL THEN
+		OpenDlg.Show(Open, 500, 450);
+		WHILE Open.status = 2 DO
+			pause(30)
+		END;
+		IF Open.status = 1 THEN
+			COPY(Open.FilePath, header)
+		END
+	END
+END OpenFile;
+
+
+PROCEDURE SelColor (Color: ColorDlg.Dialog);
+BEGIN
+	IF Color # NIL THEN
+		ColorDlg.Show(Color);
+		WHILE Color.status = 2 DO
+			pause(30)
+		END;
+		IF Color.status = 1 THEN
+			back_color := Color.color
+		END
+	END
+END SelColor;
+
+
+PROCEDURE GetButton (): INTEGER;
+VAR
+	btn: INTEGER;
+BEGIN
+	btn := KOSAPI.sysfunc1(17);
+	IF btn MOD 256 = 0 THEN
+		btn := btn DIV 256
+	ELSE
+		btn := btnNone
+	END
+	RETURN btn
+END GetButton;
+
+
+PROCEDURE main;
+CONST
+	EVENT_REDRAW = 1;
+	EVENT_KEY    = 2;
+	EVENT_BUTTON = 3;
+VAR
+	Open: OpenDlg.Dialog;
+	Color: ColorDlg.Dialog;
+BEGIN
+	back_color := 00FFFFFFH;
+	header := "Dialogs";
+	Open := OpenDlg.Create(draw_window, 0, "/sys", "ASM|TXT|INI");
+	Color := ColorDlg.Create(draw_window);
+
+	WHILE TRUE DO
+		CASE WaitForEvent() OF
+		|EVENT_REDRAW:
+			draw_window
+
+		|EVENT_KEY:
+
+		|EVENT_BUTTON:
+			CASE GetButton() OF
+			|btnNone:
+			|btnClose: ExitApp
+			|btnOpen:  OpenFile(Open)
+			|btnColor: SelColor(Color)
+			END
+		END
+	END
+END main;
+
+
+BEGIN
+	main
+END Dialogs.

+ 78 - 0
samples/KolibriOS/HW.ob07

@@ -0,0 +1,78 @@
+MODULE HW;
+
+IMPORT
+	SYSTEM, KOSAPI;
+
+
+PROCEDURE BeginDraw;
+BEGIN
+	KOSAPI.sysfunc2(12, 1)
+END BeginDraw;
+
+
+PROCEDURE EndDraw;
+BEGIN
+	KOSAPI.sysfunc2(12, 2)
+END EndDraw;
+
+
+PROCEDURE DefineAndDrawWindow (left, top, width, height, color, style, hcolor, hstyle: INTEGER; header: ARRAY OF CHAR);
+BEGIN
+	KOSAPI.sysfunc6(0, left*65536 + width, top*65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), SYSTEM.ADR(header[0]))
+END DefineAndDrawWindow;
+
+
+PROCEDURE WriteTextToWindow (x, y, color: INTEGER; text: ARRAY OF CHAR);
+BEGIN
+	KOSAPI.sysfunc6(4, x*65536 + y, color + LSL(48, 24), SYSTEM.ADR(text[0]), LENGTH(text), 0)
+END WriteTextToWindow;
+
+
+PROCEDURE WaitForEvent (): INTEGER;
+	RETURN KOSAPI.sysfunc1(10)
+END WaitForEvent;
+
+
+PROCEDURE ExitApp;
+BEGIN
+	KOSAPI.sysfunc1(-1)
+END ExitApp;
+
+
+PROCEDURE draw_window (header, text: ARRAY OF CHAR);
+CONST
+	WHITE = 0FFFFFFH;
+	RED   = 0C00000H;
+	GREEN = 0008000H;
+	BLUE  = 00000C0H;
+	GRAY  = 0808080H;
+BEGIN
+	BeginDraw;
+	DefineAndDrawWindow(200, 200, 300, 150, WHITE, 51, 0, 0, header);
+	WriteTextToWindow( 5, 10, RED,   text);
+	WriteTextToWindow(35, 30, GREEN, text);
+	WriteTextToWindow(65, 50, BLUE,  text);
+	WriteTextToWindow(95, 70, GRAY,  text);
+	EndDraw
+END draw_window;
+
+
+PROCEDURE main (header, text: ARRAY OF CHAR);
+CONST
+	EVENT_REDRAW = 1;
+	EVENT_KEY    = 2;
+	EVENT_BUTTON = 3;
+BEGIN
+	WHILE TRUE DO
+		CASE WaitForEvent() OF
+		|EVENT_REDRAW: draw_window(header, text)
+		|EVENT_KEY:    ExitApp
+		|EVENT_BUTTON: ExitApp
+		END
+	END
+END main;
+
+
+BEGIN
+	main("Hello", "Hello, world!")
+END HW.

+ 59 - 0
samples/KolibriOS/HW_con.ob07

@@ -0,0 +1,59 @@
+MODULE HW_con;
+
+IMPORT
+	Out, In, Console, DateTime;
+
+
+PROCEDURE OutInt2 (n: INTEGER);
+BEGIN
+	ASSERT((0 <= n) & (n <= 99));
+	IF n < 10 THEN
+		Out.Char("0")
+	END;
+	Out.Int(n, 0)
+END OutInt2;
+
+
+PROCEDURE OutMonth (n: INTEGER);
+VAR
+	str: ARRAY 4 OF CHAR;
+BEGIN
+	CASE n OF
+	| 1: str := "jan"
+	| 2: str := "feb"
+	| 3: str := "mar"
+	| 4: str := "apr"
+	| 5: str := "may"
+	| 6: str := "jun"
+	| 7: str := "jul"
+	| 8: str := "aug"
+	| 9: str := "sep"
+	|10: str := "oct"
+	|11: str := "nov"
+	|12: str := "dec"
+	END;
+	Out.String(str)
+END OutMonth;
+
+
+PROCEDURE main;
+VAR
+	Year, Month, Day,
+	Hour, Min, Sec, Msec: INTEGER;
+BEGIN
+	Out.String("Hello, world!"); Out.Ln;
+	Console.SetColor(Console.White, Console.Red);
+	DateTime.Now(Year, Month, Day, Hour, Min, Sec, Msec);
+	OutInt2(Day); Out.Char("-"); OutMonth(Month); Out.Char("-"); Out.Int(Year, 0); Out.Char(" ");
+	OutInt2(Hour); Out.Char(":"); OutInt2(Min); Out.Char(":"); OutInt2(Sec); Out.Ln;
+	Console.SetColor(Console.Blue, Console.LightGray);
+	Out.Ln; Out.String("press enter...");
+	In.Ln
+END main;
+
+
+BEGIN
+	Console.open;
+	main;
+	Console.exit(TRUE)
+END HW_con.

+ 43 - 0
samples/MSP430/Blink.ob07

@@ -0,0 +1,43 @@
+(*
+
+Пример для LaunchPad MSP-EXP430G2 Rev1.5
+
+  Мигает красный светодиод.
+
+*)
+MODULE Blink;
+
+IMPORT SYSTEM, MSP430;
+
+
+CONST
+
+    REDLED = {0};
+
+    (* регистры порта P1 *)
+    P1OUT = 21H;
+    P1DIR = 22H;
+
+
+PROCEDURE inv_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) / bits)
+END inv_bits;
+
+
+BEGIN
+    (* инициализация регистра P1DIR *)
+    SYSTEM.PUT8(P1DIR, REDLED);
+
+    (* бесконечный цикл *)
+    WHILE TRUE DO
+        (* изменить состояние светодиода *)
+        inv_bits(P1OUT, REDLED);
+        (* задержка *)
+        MSP430.Delay(800)
+    END
+END Blink.

+ 103 - 0
samples/MSP430/Button.ob07

@@ -0,0 +1,103 @@
+(*
+
+Пример для LaunchPad MSP-EXP430G2 Rev1.5
+
+  Мигает зеленый светодиод.
+  При нажатии на кнопку P1.3, включается/выключается красный светодиод.
+
+*)
+
+MODULE Button;
+
+IMPORT SYSTEM, MSP430;
+
+
+CONST
+
+    REDLED   = {0};
+    GREENLED = {6};
+    BUTTON   = {3};
+
+    (* регистры порта P1 *)
+    P1OUT = 21H;
+    P1DIR = 22H;
+    P1IFG = 23H;
+    P1IE  = 25H;
+    P1REN = 27H;
+
+
+PROCEDURE test_bits (mem: INTEGER; bits: SET): SET;
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b)
+    RETURN bits * BITS(b)
+END test_bits;
+
+
+PROCEDURE set_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) + bits)
+END set_bits;
+
+
+PROCEDURE clr_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) - bits)
+END clr_bits;
+
+
+PROCEDURE inv_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) / bits)
+END inv_bits;
+
+
+(* обработчик прерываний *)
+PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
+BEGIN
+    IF priority = 18 THEN                          (* прерывание от порта P1 *)
+        IF test_bits(P1IFG, BUTTON) = BUTTON THEN  (* нажата кнопка *)
+            inv_bits(P1OUT, REDLED);               (* изменить состояние светодиода *)
+            MSP430.Delay(500);                     (* задержка для отпускания кнопки *)
+            clr_bits(P1IFG, BUTTON)                (* сбросить флаг прерывания *)
+        END
+    END
+END int;
+
+
+PROCEDURE main;
+BEGIN
+    (* инициализация регистров порта P1 *)
+    SYSTEM.PUT8(P1DIR, REDLED + GREENLED);  (* выход *)
+    set_bits(P1REN, BUTTON);                (* включить подтягивающий резистор *)
+    set_bits(P1OUT, BUTTON);                (* подтяжка к питанию *)
+    set_bits(P1IE,  BUTTON);                (* разрешить прерывания от кнопки *)
+
+    MSP430.SetIntProc(int);  (* назначить обработчик прерываний *)
+    MSP430.EInt;             (* разрешить прерывания *)
+
+    (* бесконечный цикл *)
+    WHILE TRUE DO
+        inv_bits(P1OUT, GREENLED); (* изменить состояние светодиода *)
+        MSP430.Delay(800)          (* задержка *)
+    END
+END main;
+
+
+BEGIN
+    main
+END Button.

+ 156 - 0
samples/MSP430/Flash.ob07

@@ -0,0 +1,156 @@
+(*
+
+Пример для LaunchPad MSP-EXP430G2 Rev1.5
+
+  Запись флэш-памяти.
+  При успешном завершении, включается зеленый светодиод,
+  иначе - красный.
+
+*)
+
+MODULE Flash;
+
+IMPORT SYSTEM, MSP430;
+
+
+CONST
+
+    REDLED   = {0};
+    GREENLED = {6};
+
+    (* регистры порта P1 *)
+    P1OUT = 21H;
+    P1DIR = 22H;
+
+    FERASE = {1};  (* режим "стереть"  *)
+    FWRITE = {6};  (* режим "записать" *)
+
+
+PROCEDURE set_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) + bits)
+END set_bits;
+
+
+PROCEDURE clr_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) - bits)
+END clr_bits;
+
+
+(*
+    стирание и запись флэш-памяти
+    adr   - адрес
+    value - значение для записи
+    mode  - режим (стереть/записать)
+*)
+PROCEDURE Write (adr, value: INTEGER; mode: SET);
+CONST
+    (* сторожевой таймер *)
+    WDTCTL = 0120H;
+        WDTHOLD  = {7};
+        WDTPW    = {9, 11, 12, 14};
+
+    (* регистры контроллера флэш-памяти *)
+    FCTL1 = 0128H;
+        ERASE = {1};
+        WRT   = {6};
+
+    FCTL2 = 012AH;
+        FN0 = {0};
+        FN1 = {1};
+        FN2 = {2};
+        FN3 = {3};
+        FN4 = {4};
+        FN5 = {5};
+        FSSEL0 = {6};
+        FSSEL1 = {7};
+
+    FCTL3 = 012CH;
+        LOCK = {4};
+
+    FWKEY = {8, 10, 13, 15};
+
+VAR
+    wdt: SET;
+
+BEGIN
+    IF (mode = ERASE) OR (mode = WRT) THEN         (* проверить заданный режим *)
+        SYSTEM.GET(WDTCTL, wdt);                   (* сохранить значение регистра сторожевого таймера *)
+        SYSTEM.PUT(WDTCTL, WDTPW + WDTHOLD);       (* остановить сторожевой таймер *)
+        SYSTEM.PUT(FCTL2, FWKEY + FSSEL1 + FN0);   (* тактовый генератор контроллера флэш-памяти = SMCLK, делитель = 2 *)
+        SYSTEM.PUT(FCTL3, FWKEY);                  (* сбросить флаг LOCK *)
+        SYSTEM.PUT(FCTL1, FWKEY + mode);           (* установить режим (записать или стереть) *)
+        SYSTEM.PUT(adr, value);                    (* запись *)
+        SYSTEM.PUT(FCTL1, FWKEY);                  (* сбросить режим *)
+        SYSTEM.PUT(FCTL3, FWKEY + LOCK);           (* установить LOCK *)
+        SYSTEM.PUT(WDTCTL, WDTPW + wdt * {0..7})   (* восстановить сторожевой таймер *)
+    END
+END Write;
+
+
+(* обработчик ошибок *)
+PROCEDURE trap (modNum, modName, err, line: INTEGER);
+BEGIN
+    set_bits(P1OUT, REDLED) (* включить красный светодиод *)
+END trap;
+
+
+PROCEDURE main;
+CONST
+    seg_adr = 0F800H; (* адрес сегмента для стирания и записи (ДОЛЖЕН БЫТЬ СВОБОДНЫМ!) *)
+
+VAR
+    adr, x, i, entry: INTEGER;
+
+BEGIN
+    (* инициализация регистров порта P1 *)
+    SYSTEM.PUT8(P1DIR, REDLED + GREENLED);  (* выход *)
+
+    (* выключить светодиоды *)
+    clr_bits(P1OUT, REDLED + GREENLED);
+
+    MSP430.SetTrapProc(trap); (* назначить обработчик ошибок *)
+
+    ASSERT(seg_adr MOD 512 = 0); (* адрес сегмента должен быть кратным 512 *)
+
+    (* получить адрес используемой части флэш-памяти
+      (совпадает с точкой входа в программу) *)
+    SYSTEM.GET(0FFFEH, entry);
+
+    (* проверить, свободен ли сегмент *)
+    ASSERT(seg_adr + 511 < entry);
+
+    Write(seg_adr, 0, FERASE); (* стереть сегмент *)
+
+    (* записать в сегмент числа 0..255 (256 слов) *)
+    adr := seg_adr;
+    FOR i := 0 TO 255 DO
+        Write(adr, i, FWRITE);
+        INC(adr, 2)
+    END;
+
+    (* проверить запись *)
+    adr := seg_adr;
+    FOR i := 0 TO 255 DO
+        SYSTEM.GET(adr, x);
+        ASSERT(x = i); (* если x # i, будет вызван обработчик ошибок *)
+        INC(adr, 2)
+    END;
+
+    (* если нет ошибок, включить зеленый светодиод *)
+    set_bits(P1OUT, GREENLED)
+END main;
+
+
+BEGIN
+    main
+END Flash.

+ 106 - 0
samples/MSP430/Restart.ob07

@@ -0,0 +1,106 @@
+(*
+
+Пример для LaunchPad MSP-EXP430G2 Rev1.5
+
+  При нажатии на кнопку P1.3, инкрементируется
+  переменная-счетчик перезапусков и программа
+  перезапускается.
+  В зависимости от четности счетчика перезапусков,
+  включается зеленый или красный светодиод.
+
+*)
+
+MODULE Restart;
+
+IMPORT SYSTEM, MSP430;
+
+
+CONST
+
+    REDLED   = {0};
+    GREENLED = {6};
+    BUTTON   = {3};
+
+    (* регистры порта P1 *)
+    P1OUT = 21H;
+    P1DIR = 22H;
+    P1IFG = 23H;
+    P1IE  = 25H;
+    P1REN = 27H;
+
+
+VAR
+
+    count: INTEGER; (* счетчик перезапусков *)
+
+
+PROCEDURE set_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) + bits)
+END set_bits;
+
+
+PROCEDURE clr_bits (mem: INTEGER; bits: SET);
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b);
+    SYSTEM.PUT8(mem, BITS(b) - bits)
+END clr_bits;
+
+
+PROCEDURE test_bits (mem: INTEGER; bits: SET): SET;
+VAR
+    b: BYTE;
+
+BEGIN
+    SYSTEM.GET(mem, b)
+    RETURN bits * BITS(b)
+END test_bits;
+
+
+(* обработчик прерываний *)
+PROCEDURE int (priority: INTEGER; interrupt: MSP430.TInterrupt);
+BEGIN
+    IF priority = 18 THEN                          (* прерывание от порта P1 *)
+        IF test_bits(P1IFG, BUTTON) = BUTTON THEN  (* нажата кнопка *)
+            INC(count);                            (* увеличить счетчик *)
+            MSP430.Delay(500);                     (* задержка для отпускания кнопки *)
+            clr_bits(P1IFG, BUTTON);               (* сбросить флаг прерывания *)
+            MSP430.Restart                         (* перезапустить программу *)
+        END
+    END
+END int;
+
+
+PROCEDURE main;
+BEGIN
+    (* инициализация регистров порта P1 *)
+    SYSTEM.PUT8(P1DIR, REDLED + GREENLED);  (* выход *)
+    set_bits(P1REN, BUTTON);                (* включить подтягивающий резистор *)
+    set_bits(P1OUT, BUTTON);                (* подтяжка к питанию *)
+    set_bits(P1IE,  BUTTON);                (* разрешить прерывания от кнопки *)
+
+    (* выключить светодиоды *)
+    clr_bits(P1OUT, REDLED + GREENLED);
+
+    MSP430.SetIntProc(int);  (* назначить обработчик прерываний *)
+    MSP430.EInt;             (* разрешить прерывания *)
+
+    IF ODD(count) THEN
+        set_bits(P1OUT, GREENLED) (* нечетное - вкл. зеленый *)
+    ELSE
+        set_bits(P1OUT, REDLED)   (* четное - вкл. красный *)
+    END
+
+END main;
+
+
+BEGIN
+    main
+END Restart.

Algunos archivos no se mostraron porque demasiados archivos cambiaron en este cambio