libc.obj: Added strtok_r (#341)

Reviewed-on: KolibriOS/kolibrios#341
Reviewed-by: Max Logaev <maxlogaev@proton.me>
Co-authored-by: Egor00f <y.yarin@inbox.ru>
Co-committed-by: Egor00f <y.yarin@inbox.ru>

.gitea/workflows/build.yaml

@@ -29,6 +29,7 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
         with:
+          submodules: true
           fetch-depth: 0
 
       - name: Get describe

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "programs/develop/oberon07"]
+	path = programs/develop/oberon07
+	url = https://github.com/AntKrotov/oberon-07-compiler.git

data/Tupfile.lua

@@ -25,7 +25,6 @@ img_files = {
  {"MACROS.INC", SRC_PROGS .. "/macros.inc"},
 -- {"CONFIG.INC", SRC_PROGS .. "/config.inc"},
  {"STRUCT.INC", SRC_PROGS .. "/struct.inc"},
- {"FB2READ", "common/fb2read"},
  {"ALLGAMES", "common/allgames"},
  {"HOME.PNG", "common/wallpapers/T_Home.png"},
  {"ICONS32.PNG", "common/icons32.png"},
@@ -176,10 +175,15 @@ extra_files = {
  {"kolibrios/develop/c--/manual_c--.htm", SRC_PROGS .. "/cmm/c--/manual_c--.htm"},
  {"kolibrios/develop/fpc/", "common/develop/fpc/*"},
  {"kolibrios/develop/fpc/examples/", "../programs/develop/fp/examples/src/*"},
- {"kolibrios/develop/oberon07/", "../programs/develop/oberon07/*"},
- {"kolibrios/develop/oberon07/doc/", "../programs/develop/oberon07/doc/*"},
- {"kolibrios/develop/oberon07/lib/KolibriOS/", "../programs/develop/oberon07/lib/KolibriOS/*"},
- {"kolibrios/develop/oberon07/samples/", SRC_PROGS .. "/develop/oberon07/samples/*"},
+ {"kolibrios/develop/oberon07/compiler.kex", SRC_PROGS .. "/develop/oberon07/Compiler.kex"},
+ {"kolibrios/develop/oberon07/LICENSE", SRC_PROGS .. "/develop/oberon07/LICENSE"},
+ {"kolibrios/develop/oberon07/doc/CC.txt", SRC_PROGS .. "/develop/oberon07/doc/CC.txt"},
+ {"kolibrios/develop/oberon07/doc/KOSLib.txt", SRC_PROGS .. "/develop/oberon07/doc/KOSLib.txt"},
+ {"kolibrios/develop/oberon07/doc/x86.txt", SRC_PROGS .. "/develop/oberon07/doc/x86.txt"},
+ {"kolibrios/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf", SRC_PROGS .. "/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf"},
+ {"kolibrios/develop/oberon07/lib/KolibriOS/", SRC_PROGS .. "/develop/oberon07/lib/KolibriOS/*"},
+ {"kolibrios/develop/oberon07/lib/Math/", SRC_PROGS .. "/develop/oberon07/lib/Math/*"},
+ {"kolibrios/develop/oberon07/samples/", SRC_PROGS .. "/develop/oberon07/samples/KolibriOS/*"},
  {"kolibrios/develop/tcc/lib/", SRC_PROGS ..  "/develop/ktcc/trunk/bin/lib/*"},
  {"kolibrios/develop/tcc/include/", SRC_PROGS ..  "/develop/ktcc/trunk/libc.obj/include/*"},
  {"kolibrios/develop/tcc/include/clayer/", SRC_PROGS ..  "/develop/ktcc/trunk/libc.obj/include/clayer/*"},
@@ -467,7 +471,6 @@ tup.append_table(img_files, {
  {"DEMOS/ZEROLINE", VAR_PROGS .. "/demos/zeroline/trunk/zeroline"},
  {"DEVELOP/BOARD", VAR_PROGS .. "/system/board/trunk/board"},
  {"DEVELOP/DBGBOARD", VAR_PROGS .. "/system/dbgboard/dbgboard"},
- {"DEVELOP/CEDIT", SRC_PROGS .. "/develop/cedit/CEDIT"},
  {"DEVELOP/CHARSETS", VAR_PROGS .. "/develop/charsets/charsets"},
  {"DEVELOP/COBJ", VAR_PROGS .. "/develop/cObj/trunk/cObj"},
  {"DEVELOP/ENTROPYV", VAR_PROGS .. "/develop/entropyview/entropyview"},
@@ -529,6 +532,7 @@ tup.append_table(img_files, {
  {"MEDIA/MP3INFO", VAR_PROGS .. "/media/mp3info/mp3info"},
  {"MEDIA/PALITRA", VAR_PROGS .. "/media/palitra/trunk/palitra"},
  {"MEDIA/PIANO", VAR_PROGS .. "/media/piano/piano"},
+ {"MEDIA/PIANO.MAP", VAR_PROGS .. "/media/piano/piano.map"},
  {"MEDIA/STARTMUS", VAR_PROGS .. "/media/startmus/trunk/STARTMUS"},
  {"NETWORK/PING", VAR_PROGS .. "/network/ping/ping"},
  {"NETWORK/NETCFG", VAR_PROGS .. "/network/netcfg/netcfg"},
@@ -731,7 +735,6 @@ tup.append_table(extra_files, {
  {"kolibrios/develop/TinyBasic/TinyBasic", VAR_PROGS .. "/develop/tinybasic-1.0.4/tinybasic"},
  {"kolibrios/develop/TinyBasic/bas/", SRC_PROGS .. "/develop/tinybasic-1.0.4/bas/*"},
  {"kolibrios/develop/TinyBasic/TinyBasic.man", SRC_PROGS .. "/develop/tinybasic-1.0.4/doc/tinybasic.man"},
--- {"kolibrios/utils/teatool", VAR_PROGS .. "/other/TEAtool/teatool"},
  {"kolibrios/utils/passwordgen", VAR_PROGS .. "/other/PasswordGen/passwordgen"},
  {"kolibrios/utils/kruler", VAR_PROGS .. "/other/kruler/kruler"},
  {"kolibrios/media/qr_tool", SRC_PROGS .. "/media/qr_tool/qr_tool"},
@@ -741,13 +744,20 @@ tup.append_table(extra_files, {
 })
 end -- tup.getconfig('NO_TCC') ~= 'full'
 
+-- Programs that require oberon07 compiler.
+if tup.getconfig('NO_OB07') ~= 'full' then
+tup.append_table(img_files, {
+ {"DEVELOP/CEDIT", VAR_PROGS .. "/develop/cedit/cedit"},
+ {"FB2READ", VAR_PROGS .. "/other/fb2reader/fb2read"},
+})
+end -- tup.getconfig('NO_OB07') ~= 'full'
+
 -- Programs that require GCC to compile.
 if tup.getconfig('NO_GCC') ~= 'full' then
 tup.append_table(img_files, {
  {"GAMES/REVERSI", VAR_PROGS .. "/games/reversi/reversi"},
  {"LIB/BASE64.OBJ", VAR_PROGS .. "/develop/libraries/base64/base64.obj"},
  {"LIB/ICONV.OBJ", VAR_PROGS .. "/develop/libraries/iconv/iconv.obj"},
- -- {"LIB/MTAR.OBJ", VAR_PROGS .. "/develop/libraries/microtar/mtar.obj"},
 })
 tup.append_table(extra_files, {
 -- {"kolibrios/3D/cubeline", VAR_PROGS .. "/demos/cubeline/trunk/cubeline"},

kernel/trunk/docs/sysfuncr.txt

@@ -1985,7 +1985,7 @@ path    db  'HD0/1',0
     подфункция 2 функции 15.
 
 ---------------------- Константы для регистров: ----------------------
-  eax - SF_BACKGROUND_GET_RECT (39)
+  eax - SF_BACKGROUND_GET (39)
 ======================================================================
 == Функция 39, подфункция 3 - получить прямоугольную область фона    =
 ======================================================================
@@ -2169,7 +2169,7 @@ path    db  'HD0/1',0
   * ebx = 2 - номер подфункции
   * ecx = указатель на таблицу цветов
   * edx = размер таблицы цветов
-    (должен быть 40 байт для будущей совместимости)
+    (до 192 байт; 40 байт для базовой структуры)
 Формат таблицы цветов указан в описании подфункции 3.
 Возвращаемое значение:
   * функция не возвращает значения
@@ -2196,32 +2196,33 @@ path    db  'HD0/1',0
   * ecx = указатель на буфер размером edx байт,
     куда будет записана таблица
   * edx = размер таблицы цветов
-    (должен быть 40 байт для будущей совместимости)
+    (до 192 байт; 40 байт для базовой структуры)
 Возвращаемое значение:
   * функция не возвращает значения
 Формат таблицы цветов: каждый элемент -
 dword-значение цвета 0x00RRGGBB
-  * +0: dword: none - зарезервировано
-  * +4: dword: none - зарезервировано
+  * +0: dword: frame
+  * +4: dword: grab
   * +8: dword: work_dark - темный цвет рабочей области для придания
     объемна элементам интерфейса
   * +12 = +0xC: dword: work_light - светлый цвет рабочей области для
     придания объемна элементам интерфейса
   * +16 = +0x10: dword: grab_text - цвет текста на заголовке
   * +20 = +0x14: dword: work - цвет рабочей области
-  * +24 = +0x18: dword: button - цвет кнопки в рабочей области
-  * +28 = +0x1C: dword: button_text - цвет текста на кнопке
+  * +24 = +0x18: dword: work_button - цвет кнопки в рабочей области
+  * +28 = +0x1C: dword: work_button_text - цвет текста на кнопке
     в рабочей области
   * +32 = +0x20: dword: work_text - цвет текста в рабочей области
   * +36 = +0x24: dword: graph - цвет графики в рабочей области
 Замечания:
   * Структура таблицы цветов описана в стандартном включаемом файле
     macros.inc под названием system_colors; например, можно писать:
-    	sc	system_colors		; объявление переменной
-    	...				; где-то надо вызвать
-    					; описываемую функцию с ecx=sc
-    	mov	ecx, [sc.button_text]	; читаем цвет текста
-    					; на кнопке в рабочей области
+      sc  system_colors ; объявление переменной
+      ...               ; вызов описываемой функции с ecx = sc
+      mov ecx, [sc.work_button_text]  ; устанавливаем цвет текста
+                                      ; на кнопке в рабочей области
+  * Таблица может быть больше (до 192 байт); дополнительные поля
+    копируются как есть и интерпретируются скинами.
   * Использование/неиспользование этих цветов - дело исключительно
     самой программы. Для использования нужно просто при вызове функций
     рисования указывать цвет, взятый из этой таблицы.
@@ -2491,6 +2492,7 @@ dword-значение цвета 0x00RRGGBB
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_SET_WINDOW_SHAPE (50)
+
 ======================================================================
 ===================== Функция 51, подфункция 1 =======================
 ========================== Создать поток =============================
@@ -2505,16 +2507,19 @@ dword-значение цвета 0x00RRGGBB
   * иначе eax = TID - идентификатор потока
 
 ---------------------- Константы для регистров: ----------------------
-  eax - SF_CREATE_THREAD (51)
+  eax - SF_CREATE_THREAD (51) /
+  ebx - SSF_CREATE_THREAD (1), SSF_GET_CURR_THREAD_SLOT (2),
+        SSF_GET_THREAD_PRIORITY (3), SSF_SET_THREAD_PRIORITY (4)
+
 ======================================================================
 ===================== Функция 51, подфункция 2 =======================
-=================== Получить номер слота потока ======================
+============= Получить номер слота текущего потока ===================
 ======================================================================
 Параметры:
   * eax = 51 - номер функции
   * ebx = 2 - номер подфункции
 Возвращаемое значение:
-  * eax = номер слота потока
+  * eax = номер слота текущего потока
 
 ======================================================================
 ===================== Функция 51, подфункция 3 =======================
@@ -2755,10 +2760,10 @@ IPC применяется для посылок сообщений от одн
 Программе доступны данные графического экрана (область памяти, которая
 собственно и отображает содержимое экрана) напрямую без вызовов
 системных функций через селектор gs:
-	mov	eax, [gs:0]
+  mov eax, [gs:0]
 поместит в eax первый dword буфера, содержащий информацию о цвете
 левой верхней точки (и, возможно, цвета нескольких следующих).
-	mov	[gs:0], eax
+  mov [gs:0], eax
 при работе в режимах VESA c LFB
 установит цвет левой верхней точки
 (и возможно, цвета нескольких следующих).
@@ -3356,6 +3361,7 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
 ---------------------- Константы для регистров: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_MEM_FREE (13)
+
 ======================================================================
 ====================== Функция 68, подфункция 14 =====================
 ====== Ожидать получения сигнала от других приложений/драйверов. =====
@@ -3368,12 +3374,16 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
   * eax разрушается
   * буфер, на который указывает ecx, содержит следующую информацию:
     * +0: dword: идентификатор последующих данных сигнала
-    * +4: данные принятого сигнала (20 байт), формат которых
+    * +4: 5 dword: данные принятого сигнала, формат которых
           определяется первым dword-ом
+Замечания:
+  * Бесконечно ожидает любое событие в очереди событий текущего потока.
+  * Сбрасывает байт приоритета в буфере.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_WAIT_SIGNAL (14)
+
 ======================================================================
 =========== Функция 68, подфункция 16 - загрузить драйвер. ===========
 ======================================================================
@@ -3382,19 +3392,20 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
   * ebx = 16 - номер подфункции
   * ecx = указатель на ASCIIZ-строку с именем драйвера
 Возвращаемое значение:
-  * eax = 0 - неудача
-  * иначе eax = хэндл драйвера
+  * eax = хэндл драйвера
+          0 при ошибке
 Замечания:
   * Если драйвер ещё не загружен, он загружается;
     если драйвер уже загружен, ничего не меняется.
   * Имя драйвера чувствительно к регистру символов.
     Максимальная длина имени - 16 символов, включая завершающий
     нулевой символ, остальные символы игнорируются.
-  * Драйвер с именем ABC загружается из файла /sys/drivers/ABC.sys.
+  * Драйвер с именем "ABC" загружается из файла /sys/drivers/ABC.sys.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_LOAD_DRIVER (16)
+
 ======================================================================
 ========== Функция 68, подфункция 17 - управление драйвером. =========
 ======================================================================
@@ -3405,19 +3416,21 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
     * +0: dword: хэндл драйвера
     * +4: dword: код функции драйвера
     * +8: dword: указатель на входные данные
-    * +12 = +0xC: dword: размер входных данных
+    * +12 = +0x0C: dword: размер входных данных
     * +16 = +0x10: dword: указатель на выходные данные
     * +20 = +0x14: dword: размер выходных данных
 Возвращаемое значение:
   * eax = определяется драйвером
+          -1 при ошибке
 Замечания:
   * Коды функций и структура входных/выходных данных
     определяются драйвером.
-  * Предварительно должен быть получен хэндл драйвера подфункцией 16.
+  * Хэндл драйвера необходимо предварительно получить подфункцией 16.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_CONTROL_DRIVER (17)
+
 ======================================================================
 == Функция 68, подфункция 18 - загрузить DLL с указанием кодировки. ==
 ======================================================================
@@ -3482,7 +3495,7 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
 Параметры:
   * eax = 68 - номер функции
   * ebx = 21 - номер подфункции
-  * ecx = указатель на ASCIIZ-строку с именем драйвера
+  * ecx = указатель на ASCIIZ-строку с путем к файлу драйвера
   * edx = указатель на командную строку
 Возвращаемое значение:
   * eax = 0 - неудача
@@ -3674,22 +3687,40 @@ Architecture Software Developer's Manual, Volume 3, Appendix B);
   * функция загружает и, при необходимости, распаковывает файл (kunpack)
 
 ======================================================================
-======== Функция 68, подфункция 29 - allocate ring memory. =========
+======= Функция 68, подфункция 29 - выделить кольцевую память. =======
 ======================================================================
-Parameters:
-  * eax = 68 - function number
-  * ebx = 29 - subfunction number
-  * ecx = required size in bytes
-Returned value:
-  * eax = 0 - failed
-  * eax = pointer to the allocated ring
-Remarks:
-  * The requested size must be an exact multiple of pagesize (4 Kb)
-  * The function allocates memory in such a way that you can read and
-    write beyond the size of the allocated memory and will reach the 
-    beginning of the buffer again.
+Параметры:
+  * eax = 68 - номер функции
+  * ebx = 29 - номер подфункции
+  * ecx = требуемый размер в байтах
+Возвращаемое значение:
+  * eax = 0 - неудача
+  * eax = указатель на выделенную кольцевую память
+Замечания:
+  * Запрошенный размер должен быть кратен размеру страницы (4 Кб).
+  * Память выделяется так, что доступ за пределами буфера приводит
+    к чтению/записи в его начало.
 
 
+======================================================================
+=========== Функция 68, подфункция 30 - выгрузить драйвер. ===========
+======================================================================
+Параметры:
+  * eax = 68 - номер функции
+  * ebx = 30 - номер подфункции
+  * ecx = указатель на структуру SRV (хэндл драйвера)
+  * edx = указатель на командную строку (может быть 0)
+Возвращаемое значение:
+  * eax = -1 - неверные параметры
+  * eax = -2 - ошибка при освобождении памяти драйвера
+  * иначе eax = указатель на следующую структуру SRV (бывший SRV.fd)
+Замечания:
+  * Перед выгрузкой вызывается точка входа драйвера с DRV_EXIT.
+
+---------------------- Константы для регистров: ----------------------
+  eax - SF_SYS_MISC (68)
+  ebx - SSF_UNLOAD_DRIVER (30)
+
 ======================================================================
 ======== Функция 68, подфункция 31 - получить данные драйвера. =======
 ======================================================================
@@ -3788,7 +3819,7 @@ Remarks:
     и при поступлении нового сообщения система будет ждать.
     Для синхронизации обрамляйте всю работу с буфером операциями
     блокировки/разблокировки
-    	neg	[bufsize]
+      neg [bufsize]
   * Данные в буфере трактуются как массив элементов переменной длины -
     сообщений. Формат сообщения указан в общем описании.
 
@@ -4527,7 +4558,7 @@ Remarks:
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_NETWORK_GET (74)
-   bl - SSF_DEVICE_COUNT (255)
+   bl - SSF_DEVICE_COUNT (-1)
 ======================================================================
 ==== Функция 74, подфункция 0, Получить тип сетевого устройства. =====
 ======================================================================
@@ -4723,10 +4754,11 @@ Remarks:
 Возвращаемое значение:
   * eax = число пакетов, полученных с ошибкой с момента запуска 
     устройства, -1 при ошибке
-	
+
 ---------------------- Константы для регистров: ----------------------
   eax - SF_NETWORK_GET (74)
    bl - SSF_RX_PACKET_ERROR_COUNT (14)
+
 ======================================================================
 == Функция 74.15, Получить число пакетов отброшенных при получении. ==
 ======================================================================
@@ -4740,7 +4772,7 @@ Remarks:
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_NETWORK_GET (74)
-   bl - SSF_RX_PACKET_DROP_COUNT (12)
+   bl - SSF_RX_PACKET_DROP_COUNT (15)
 ======================================================================
 === Функция 74.16, Получить число пакетов утерянных при получении. ===
 ======================================================================
@@ -4990,13 +5022,39 @@ Remarks:
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_NETWORK_PROTOCOL (76)
+  ebx - SSF_ETHERNET_READ_MAC (0x0000)
+  ebx - SSF_IP4_PACKETS_SENT (0x10000)
+  ebx - SSF_IP4_PACKETS_RECEIVED (0x10001)
+  ebx - SSF_IP4_READ_IP (0x10002)
+  ebx - SSF_IP4_WRITE_IP (0x10003)
+  ebx - SSF_IP4_READ_DNS (0x10004)
+  ebx - SSF_IP4_WRITE_DNS (0x10005)
+  ebx - SSF_IP4_READ_SUBNET (0x10006)
+  ebx - SSF_IP4_WRITE_SUBNET (0x10007)
+  ebx - SSF_IP4_READ_GATEWAY (0x10008)
+  ebx - SSF_IP4_WRITE_GATEWAY (0x10009)
+  ebx - SSF_ICMP_PACKETS_SENT (0x20000)
+  ebx - SSF_ICMP_PACKETS_RECEIVED (0x20001)
+  ebx - SSF_ICMP_ECHO_REPLY (0x20003)
+  ebx - SSF_UDP_PACKETS_SENT (0x30000)
+  ebx - SSF_UDP_PACKETS_RECEIVED (0x30001)
+  ebx - SSF_TCP_PACKETS_SENT (0x40000)
+  ebx - SSF_TCP_PACKETS_RECEIVED (0x40001)
+  ebx - SSF_ARP_PACKETS_SENT (0x50000)
+  ebx - SSF_ARP_PACKETS_RECEIVED (0x50001)
+  ebx - SSF_ARP_GET_ENTRY_COUNT (0x50002)
+  ebx - SSF_ARP_READ_ENTRY (0x50003)
+  ebx - SSF_ARP_ADD_STATIC_ENTRY (0x50004)
+  ebx - SSF_ARP_DEL_ENTRY (0x50005)
+  ebx - SSF_ARP_SEND_ANNOUNCE (0x50006)
+  ebx - SSF_ARP_CONFLICTS_COUNT (0x50007)
 ======================================================================
 ============= Функция 77, подфункция 0, Создать фьютекс. =============
 ======================================================================
 Параметры:
   * eax = 77 - номер функции
   * ebx = 0 - номер подфункции
-  * ecx = указатель на контрольное значение фьютекса (dword)
+  * ecx = контрольное значение фьютекса (dword)
 Возвращаемое значение:
   * eax = дескриптор фьютекса, 0 при ошибке
 
@@ -5025,11 +5083,12 @@ Remarks:
   * eax = 77 - номер функции
   * ebx = 2 - номер подфункции
   * ecx = дескриптор фьютекса
-  * edx = контрольное значение
+  * edx = контрольное значение фьютекса (dword)
   * esi = таймаут в сотых секунды, 0 - ждать бесконечно
 Возвращаемое значение:
-  * eax = 0 - успешно, -1 - таймаут,
-        -2 - контрольное значение не соответствует
+  * eax = 0 - успешно,
+         -1 - таймаут,
+         -2 - контрольное значение фьютекса не соответствует
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_FUTEX (77)
@@ -5049,7 +5108,11 @@ Remarks:
   eax - SF_FUTEX (77)
   ebx - SSF_WAKE (3)
 ======================================================================
-======= Функция 77, подфункция 10, Прочитать из файла в буфер. =======
+Замечания:
+  * Подфункции 4-7 зарезервированы и сейчас возвращают -1.
+  * Подфункции 8, 9 и 12 не реализованы и возвращают -EBADF (-9).
+======================================================================
+=========== Функция 77, подфункция 10, Прочитать из файла. ===========
 ======================================================================
 Параметры:
   * eax = 77 - номер функции
@@ -5059,10 +5122,15 @@ Remarks:
   * esi = сколько байт прочитать
 Возвращаемое значение:
   * eax = количество прочитанных байт
+          0 при EOF
+          -EBADF (-9) при ошибке
+Замечания:
+  * Поддерживаются только pipe-дескрипторы.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_FUTEX (77)
-  ebx - ...
+  ebx - SSF_FILE_READ (10)
+
 ======================================================================
 ======== Функция 77, подфункция 11, Записать из буфера в файл. =======
 ======================================================================
@@ -5070,14 +5138,19 @@ Remarks:
   * eax = 77 - номер функции
   * ebx = 11 - номер подфункции
   * ecx = дескриптор файла
-  * edx =  указатель на буфер, откуда брать данные для записи
+  * edx = указатель на буфер, откуда брать данные для записи
   * esi = сколько байт записать
 Возвращаемое значение:
   * eax = количество записанных байт
+          -EBADF (-9) при ошибке
+          -EPIPE (-32) если нет читателей
+Замечания:
+  * Поддерживаются только pipe-дескрипторы.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_FUTEX (77)
-  ebx - ...
+  ebx - SSF_FILE_WRITE (11)
+
 ======================================================================
 =========== Функция 77, подфункция 13, Создать новый pipe. ===========
 ======================================================================
@@ -5089,15 +5162,20 @@ Remarks:
   * eax = 77 - номер функции
   * ebx = 13 - номер подфункции
   * ecx = адрес pipefd
-  * edx = флаги. На данный момент если поднят O_CLOEXEC (0x40000), то
-    сисфункция завершится с ошибкой. Поэтому в качестве флагов можно
-    передать просто 0.
+  * edx = флаги. Разрешен только O_CLOEXEC (0x40000).
+    Любые другие биты приводят к -EINVAL (-11).
 Возвращаемое значение:
-  * eax = 0 если успех, иначе ошибка.
+  * eax = 0 если успех,
+          иначе отрицательный код ошибки:
+          -EINVAL (-11), -EFAULT (-14), -ENFILE (-23), -EMFILE (-24)
+Примечания:
+  * В случае успеха pipefd[0] является дескриптором чтения, а pipefd[1]
+    - дескриптором записи.
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_FUTEX (77)
-  ebx - ...
+  ebx - SSF_PIPE_CREATE (13)
+
 ======================================================================
 ========== Функция -1 - завершить выполнение потока/процесса =========
 ======================================================================
@@ -5115,6 +5193,7 @@ Remarks:
 
 ---------------------- Константы для регистров: ----------------------
   eax - SF_TERMINATE_PROCESS (-1)
+
 ======================================================================
 === Функция 80 - работа с файловой системой с указанием кодировки. ===
 ======================================================================

kernel/trunk/docs/sysfuncs.txt

@@ -1972,7 +1972,7 @@ Remarks:
     subfunction 2 of function 15.
 
 ---------------------- Constants for registers: ----------------------
-  eax - SF_BACKGROUND_GET_RECT (39)
+  eax - SF_BACKGROUND_GET (39)
 ======================================================================
 == Function 39, subfunction 3 - get rect from the background image.  =
 ======================================================================
@@ -2152,7 +2152,7 @@ Parameters:
   * ebx = 2 - subfunction number
   * ecx = pointer to the color table
   * edx = size of the color table
-    (must be 40 bytes for future compatibility)
+    (up to 192 bytes; 40 bytes for the base structure)
 Format of the color table is shown in description of subfunction 3.
 Returned value:
   * function does not return value
@@ -2179,21 +2179,21 @@ Parameters:
   * ecx = pointer to the buffer with size edx bytes,
     where table will be written
   * edx = size of color table
-    (must be 40 bytes for future compatibility)
+    (up to 192 bytes; 40 bytes for the base structure)
 Returned value:
   * function does not return value
 Format of the color table:
 each item is dword-value for color 0x00RRGGBB
-  * +0: dword: none - reserved
-  * +4: dword: none - reserved
+  * +0: dword: frame
+  * +4: dword: grab
   * +8: dword: work_dark - dark color of working area 
     used to give a user 3D-like feelings about interface elements
   * +12 = +0xC: dword: work_light - light color of working area 
     used to give a user 3D-like feelings about interface elements
   * +16 = +0x10: dword: grab_text - color of text on header
   * +20 = +0x14: dword: work - color of working area
-  * +24 = +0x18: dword: button - color of button in working area
-  * +28 = +0x1C: dword: button_text - color of text on button
+  * +24 = +0x18: dword: work_button - color of button in working area
+  * +28 = +0x1C: dword: work_button_text - color of text on button
     in working area
   * +32 = +0x20: dword: work_text - color of text in working area
   * +36 = +0x24: dword: graph - color of graphics in working area
@@ -2206,6 +2206,8 @@ Remarks:
                                         ; this function with ecx=sc
         mov     ecx, [sc.work_button_text]      ; read text color on
                                         ; button in working area
+  * The table may be longer (up to 192 bytes); extra fields are copied
+    as-is and are interpreted by skins.
   * A program itself decides to use or not to use color table.
     For usage program must simply at calls to drawing functions select
     color taken from the table.
@@ -2478,11 +2480,11 @@ Remarks:
 ---------------------- Constants for registers: ----------------------
   eax - SF_SET_WINDOW_SHAPE (50)
 ======================================================================
-==================== Function 51 - create thread. ====================
+============= Function 51, subfunction 1 - create thread. ============
 ======================================================================
 Parameters:
   * eax = 51 - function number
-  * ebx = 1 - unique subfunction
+  * ebx = 1 - subfunction number
   * ecx = address of thread entry point (starting eip)
   * edx = pointer to thread stack (starting esp)
 Returned value:
@@ -2491,6 +2493,49 @@ Returned value:
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_CREATE_THREAD (51)
+  ebx - SSF_CREATE_THREAD (1), SSF_GET_CURR_THREAD_SLOT (2),
+        SSF_GET_THREAD_PRIORITY (3), SSF_SET_THREAD_PRIORITY (4)
+======================================================================
+================== Function 51, subfunction 2 ========================
+================== Get current thread slot number ====================
+======================================================================
+Parameters:
+  * eax = 51 - function number
+  * ebx = 2 - subfunction number
+Returned value:
+  * eax = slot number of the current thread
+
+======================================================================
+================== Function 51, subfunction 3 ========================
+===================== Get thread priority ============================
+======================================================================
+Parameters:
+  * eax = 51 - function number
+  * ebx = 3 - subfunction number
+  * ecx = slot number of the thread or -1 (current thread)
+Returned value:
+  * eax = -1 - error (invalid slot number or thread terminated)
+  * otherwise eax = thread priority
+Remarks:
+  * Priority range is 0..255.
+    0 is the highest priority and is set by default at creation.
+
+======================================================================
+================== Function 51, subfunction 4 ========================
+===================== Set thread priority ============================
+======================================================================
+Parameters:
+  * eax = 51 - function number
+  * ebx = 4 - subfunction number
+  * ecx = slot number of the thread or -1 (current thread)
+  * edx = new thread priority
+Returned value:
+  * eax = -1 - error (invalid slot number or thread terminated)
+  * otherwise eax = previous thread priority
+Remarks:
+  * Priority range is 0..255.
+    0 is the highest priority and is set by default at creation.
+
 ======================================================================
 ==================== Function 54, subfunction 0 ======================
 ============== Get the number of slots in the clipboard. =============
@@ -3289,61 +3334,63 @@ Remarks:
   ebx - SSF_MEM_FREE (13)
 ======================================================================
 ===================== Function 68, subfunction 14 ====================
-============ Wait for signal from another program/driver. ============
+======= Wait for a signal from other applications/drivers. ===========
 ======================================================================
 Parameters:
   * eax = 68 - function number
   * ebx = 14 - subfunction number
-  * ecx = pointer to the buffer for information (24 bytes)
+  * ecx = pointer to data buffer (6 dword = 24 bytes)
 Returned value:
+  * eax is destroyed
   * buffer pointed to by ecx contains the following information:
-    * +0: dword: identifier for following data of signal
-    * +4: dword: data of signal (20 bytes), format of which is defined
-          by the first dword
+    * +0: dword: EVENT.code (identifier of following data)
+    * +4: 5 dword: EVENT.data, format depends on EVENT.code
+Remarks:
+  * Waits indefinitely for any event in the current thread event queue.
+  * The priority byte in the buffer is cleared by the kernel.
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_WAIT_SIGNAL (14)
 ======================================================================
-============= Function 68, subfunction 16 - load driver. =============
+=========== Function 68, subfunction 16 - load driver. ===============
 ======================================================================
 Parameters:
   * eax = 68 - function number
   * ebx = 16 - subfunction number
   * ecx = pointer to ASCIIZ-string with driver name
 Returned value:
-  * eax = 0 - failed
-  * otherwise eax = driver handle
+  * eax = driver handle, 0 on error
 Remarks:
-  * If the driver was not loaded yet, it is loaded;
-    if the driver was loaded yet, nothing happens.
+  * If the driver is not loaded yet, it is loaded;
+    if the driver is already loaded, nothing changes.
   * Driver name is case-sensitive.
     Maximum length of the name is 16 characters, including
     terminating null character, the rest is ignored.
-  * Driver ABC is loaded from file /sys/drivers/ABC.sys.
+  * Driver with name "ABC" is loaded from /sys/drivers/ABC.sys.
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_SYS_MISC (68)
   ebx - SSF_LOAD_DRIVER (16)
 ======================================================================
-============ Function 68, subfunction 17 - driver control. ===========
+========== Function 68, subfunction 17 - control driver. =============
 ======================================================================
 Parameters:
   * eax = 68 - function number
   * ebx = 17 - subfunction number
   * ecx = pointer to the control structure:
-    * +0: dword: handle of driver
-    * +4: dword: code of driver function
-    * +8: dword: pointer to input data
-    * +12 = +0xC: dword: size of input data
-    * +16 = +0x10: dword: pointer to output data
-    * +20 = +0x14: dword: size of output data
+    * +0:  dword: driver handle
+    * +4:  dword: driver function code
+    * +8:  dword: pointer to input data
+    * +12: dword: size of input data
+    * +16: dword: pointer to output data
+    * +20: dword: size of output data
 Returned value:
-  * eax = determined by driver
+  * eax = determined by driver, -1 on error
 Remarks:
   * Function codes and the structure of input/output data
-    are defined by driver.
-  * Previously one must obtain driver handle by subfunction 16.
+    are defined by the driver.
+  * Driver handle can be obtained by subfunction 16.
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_SYS_MISC (68)
@@ -3411,7 +3458,7 @@ Remarks:
 Parameters:
   * eax = 68 - function number
   * ebx = 21 - subfunction number
-  * ecx = pointer to ASCIIZ-string with driver name
+  * ecx = pointer to ASCIIZ-string with path to driver file
   * edx = pointer to command line
 Returned value:
   * eax = 0 - failed
@@ -3616,9 +3663,24 @@ Remarks:
     write beyond the size of the allocated memory and will reach the 
     beginning of the buffer again.
 
+======================================================================
+=========== Function 68, subfunction 30 - unload driver. ============
+======================================================================
+Parameters:
+  * eax = 68 - function number
+  * ebx = 30 - subfunction number
+  * ecx = pointer to SRV structure (driver handle)
+  * edx = pointer to command line (may be 0)
+Returned value:
+  * eax = -1 - invalid parameters
+  * eax = -2 - error while freeing driver memory
+  * otherwise eax = pointer to the next SRV structure (former SRV.fd)
+Remarks:
+  * The driver entry is called with DRV_EXIT before unloading.
+
 ---------------------- Constants for registers: ----------------------
   eax - SF_SYS_MISC (68)
-  ebx - SSF_MEM_ALLOC_RING (29)  
+  ebx - SSF_UNLOAD_DRIVER (30)
 
 ======================================================================
 =========== Function 68, subfunction 31 - get driver data. ===========
@@ -3833,7 +3895,7 @@ Remarks:
   eax - SF_DEBUG (69)
   ebx - SSF_RESUME (5)
 ======================================================================
-= Fucntion 69, subfunction 6 - read from memory of debugged process. =
+= Function 69, subfunction 6 - read from memory of debugged process. =
 ======================================================================
 Parameters:
   * eax = 69 - function number
@@ -4442,17 +4504,17 @@ Returned value:
 ---------------------- Constants for registers: ----------------------
   eax - SF_BLITTER (73)
 ======================================================================
-= Function 74, Subfunction 255, Get number of active network devices. =
+= Function 74, Subfunction -1, Get number of active network devices. =
 ======================================================================
 Parameters:
   * eax = 74 - function number
-  * bl = 255 - subfunction number
+  * bl = -1 - subfunction number
 Returned value:
   * eax = number of active network devices
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_NETWORK_GET (74)
-   bl - SSF_DEVICE_COUNT (255)
+   bl - SSF_DEVICE_COUNT (-1)
 ======================================================================
 ======== Function 74, Subfunction 0, Get network device type. ========
 ======================================================================
@@ -4605,7 +4667,7 @@ Parameters:
   * bl = 11 - subfunction number
   * bh = device number
 Returned value:
-  * eax = Number of erroneous packets received since device start, -1 on error
+  * eax = Number of erroneous packets transmitted since device start, -1 on error
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_NETWORK_GET (74)
@@ -4661,7 +4723,7 @@ Returned value:
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_NETWORK_GET (74)
-   bl - SSF_RX_PACKET_DROP_COUNT (12)    
+   bl - SSF_RX_PACKET_DROP_COUNT (15)
 ======================================================================
 ==== Function 74, Subfunction 16, Get RX missed packets counter. =====
 ======================================================================
@@ -5174,19 +5236,41 @@ Returned value:
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_NETWORK_PROTOCOL (76)
+  ebx - SSF_ETHERNET_READ_MAC (0x0000)
+  ebx - SSF_IP4_PACKETS_SENT (0x10000)
+  ebx - SSF_IP4_PACKETS_RECEIVED (0x10001)
+  ebx - SSF_IP4_READ_IP (0x10002)
+  ebx - SSF_IP4_WRITE_IP (0x10003)
+  ebx - SSF_IP4_READ_DNS (0x10004)
+  ebx - SSF_IP4_WRITE_DNS (0x10005)
+  ebx - SSF_IP4_READ_SUBNET (0x10006)
+  ebx - SSF_IP4_WRITE_SUBNET (0x10007)
+  ebx - SSF_IP4_READ_GATEWAY (0x10008)
+  ebx - SSF_IP4_WRITE_GATEWAY (0x10009)
+  ebx - SSF_ICMP_PACKETS_SENT (0x20000)
+  ebx - SSF_ICMP_PACKETS_RECEIVED (0x20001)
+  ebx - SSF_ICMP_ECHO_REPLY (0x20003)
+  ebx - SSF_UDP_PACKETS_SENT (0x30000)
+  ebx - SSF_UDP_PACKETS_RECEIVED (0x30001)
+  ebx - SSF_TCP_PACKETS_SENT (0x40000)
+  ebx - SSF_TCP_PACKETS_RECEIVED (0x40001)
+  ebx - SSF_ARP_PACKETS_SENT (0x50000)
+  ebx - SSF_ARP_PACKETS_RECEIVED (0x50001)
+  ebx - SSF_ARP_GET_ENTRY_COUNT (0x50002)
+  ebx - SSF_ARP_READ_ENTRY (0x50003)
+  ebx - SSF_ARP_ADD_STATIC_ENTRY (0x50004)
+  ebx - SSF_ARP_DEL_ENTRY (0x50005)
+  ebx - SSF_ARP_SEND_ANNOUNCE (0x50006)
+  ebx - SSF_ARP_CONFLICTS_COUNT (0x50007)
 ======================================================================
 ========== Function 77, Subfunction 0, Create futex object ===========
 ======================================================================
 Parameters:
   * eax = 77 - function number
   * ebx = 0 - subfunction number
-  * ecx = pointer to futex dword
+  * ecx = futex control value (dword)
 Returned value:
   * eax = futex handle, 0 on error
-Remarks:
-  * Use subfunction 1 to destroy the futex.
-    The kernel destroys the futexes automatically when the process
-    terminates.
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_FUTEX (77)
@@ -5201,7 +5285,8 @@ Parameters:
 Returned value:
   * eax = 0 - successfull, -1 on error
 Remarks:
-  * The futex handle must have been created by subfunction 0
+  * The kernel destroys the futexes automatically when the process
+    terminates.
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_FUTEX (77)
@@ -5213,17 +5298,12 @@ Parameters:
   * eax = 77 - function number
   * ebx = 2 - subfunction number
   * ecx = futex handle
-  * edx = control value
-  * esi = timeout in system ticks or 0 for infinity
+  * edx = futex control value (dword)
+  * esi = timeout in hundredths of a second, 0 - wait forever
 Returned value:
   * eax = 0 - successfull
-	 -1 - timeout
-	 -2 - futex dword does not have the same value as edx
-Remarks:
-  * This functionn tests that the value at the futex dword still
-    contains the expected control value, and if so, then sleeps
-    waiting for a wake operation on the futex.
-  * The futex handle must have been created by subfunction 0
+         -1 - timeout
+         -2 - futex control value doesn't match
 
 ---------------------- Constants for registers: ----------------------
   eax - SF_FUTEX (77)
@@ -5239,15 +5319,71 @@ Parameters:
 Returned value:
   * eax = number of waiters that were woken up
 
-Remarks:
-  * This function wakes at most edx of the waiters that are
-    waiting (e.g., inside futex wait) on the futex dword
-  * The futex handle must have been created by subfunction 0
-
 ---------------------- Constants for registers: ----------------------
   eax - SF_FUTEX (77)
   ebx - SSF_WAKE (3)
 ======================================================================
+Remarks:
+  * Subfunctions 4-7 are reserved and currently return -1.
+  * Subfunctions 8-9 and 12 are not implemented and return -EBADF (-9).
+======================================================================
+============ Function 77, Subfunction 10, Read from file. ============
+======================================================================
+Parameters:
+  * eax = 77 - function number
+  * ebx = 10 - subfunction number
+  * ecx = file handle
+  * edx = pointer to destination buffer
+  * esi = number of bytes to read
+Returned value:
+  * eax = number of bytes read,
+          0 on EOF,
+          -EBADF (-9) on error
+Remarks:
+  * Only pipe descriptors are supported.
+
+---------------------- Constants for registers: ----------------------
+  eax - SF_FUTEX (77)
+  ebx - SSF_FILE_READ (10)
+======================================================================
+=========== Function 77, Subfunction 11, Write to file. =============
+======================================================================
+Parameters:
+  * eax = 77 - function number
+  * ebx = 11 - subfunction number
+  * ecx = file handle
+  * edx = pointer to source buffer
+  * esi = number of bytes to write
+Returned value:
+  * eax = number of bytes written,
+          -EBADF (-9) on error,
+          -EPIPE (-32) if no readers
+Remarks:
+  * Only pipe descriptors are supported.
+
+---------------------- Constants for registers: ----------------------
+  eax - SF_FUTEX (77)
+  ebx - SSF_FILE_WRITE (11)
+======================================================================
+========== Function 77, Subfunction 13, Create pipe. ================
+======================================================================
+Parameters:
+  * eax = 77 - function number
+  * ebx = 13 - subfunction number
+  * ecx = pointer to pipefd[2] array (two dword handles)
+  * edx = flags (only O_CLOEXEC is allowed)
+Returned value:
+  * eax = 0 on success,
+          negative errno value on error:
+          -EINVAL (-11), -EFAULT (-14), -ENFILE (-23), -EMFILE (-24)
+Remarks:
+  * On success, pipefd[0] is a read handle and pipefd[1] is a
+    write handle.
+
+---------------------- Constants for registers: ----------------------
+  eax - SF_FUTEX (77)
+  ebx - SSF_PIPE_CREATE (13)
+======================================================================
 === Function 80 - file system interface with parameter of encoding ===
 ======================================================================
 Parameters:

programs/KOSfuncs.inc

@@ -70,11 +70,11 @@ SF_SYSTEM=18
   SSF_WINDOW_BEHAVIOR=25        ; window focus relation with other windows
     SSSF_GET_WB=1
     SSSF_SET_WB=2
-SF_MIDI=20
-  SSF_RESET=1
-  SSF_OUTPUT=2
+SF_MIDI=20              ; deprecated/undefined in current kernel
+  SSF_RESET=1           ; deprecated
+  SSF_OUTPUT=2          ; deprecated
 SF_SYSTEM_SET=21
-  SSF_MPU_MIDI_BASE=1
+  SSF_MPU_MIDI_BASE=1   ; not used (reserved)
   SSF_KEYBOARD_LAYOUT=2
   SSF_SYS_LANG=5
   SSF_ACCESS_HD_LBA=11  ; setting of low-level access to HD
@@ -112,7 +112,7 @@ SF_BACKGROUND_GET=39
   ;SSF_PIXEL_BG=2
   ;SSF_MODE_BG=4
 SF_SET_EVENTS_MASK=40   ; turn on/off desired events
-SF_PORT_IN_OUT=43       ; input/output to a port
+SF_PORT_IN_OUT=43       ; deprecated/undefined in current kernel
 SF_SET_PORTS=46         ; reserve/free a group of input/output ports
 SF_DRAW_NUMBER=47       ; draw number to the window
 SF_STYLE_SETTINGS=48
@@ -132,6 +132,10 @@ SF_STYLE_SETTINGS=48
 SF_APM=49
 SF_SET_WINDOW_SHAPE=50
 SF_CREATE_THREAD=51
+  SSF_CREATE_THREAD=1
+  SSF_GET_CURR_THREAD_SLOT=2
+  SSF_GET_THREAD_PRIORITY=3
+  SSF_SET_THREAD_PRIORITY=4
 SF_CLIPBOARD=54
   SSF_GET_SLOT_COUNT=0  ; get the number of slots in the clipboard
   SSF_READ_CB=1
@@ -184,7 +188,7 @@ SF_SYS_MISC=68
   SSF_HEAP_INIT=11
   SSF_MEM_ALLOC=12
   SSF_MEM_FREE=13
-  SSF_WAIT_SIGNAL=14    ; wait for signal from another program/driver
+  SSF_WAIT_SIGNAL=14    ; wait for a signal from other process
   SSF_LOAD_DRIVER=16
   SSF_CONTROL_DRIVER=17
   SSF_LOAD_DLL=19
@@ -196,6 +200,9 @@ SF_SYS_MISC=68
   SSF_SET_EXCEPTION_STATE=25
   SSF_MEM_FREE_EXT=26
   SSF_LOAD_FILE=27
+  SSF_MEM_ALLOC_RING=29
+  SSF_UNLOAD_DRIVER=30
+  SSF_GET_DRIVER_DATA=31
 SF_DEBUG=69
   SSF_SET_MESSAGE_AREA=0
   SSF_GET_REGISTERS=1
@@ -221,7 +228,7 @@ SF_FILE=70
 SF_SET_CAPTION=71
 SF_SEND_MESSAGE=72
 SF_BLITTER=73
-SF_NETWORK_DEVICE=74
+SF_NETWORK_GET=74
   SSF_DEVICE_COUNT=255  ; get number of active network devices
   SSF_DEVICE_TYPE=0
   SSF_DEVICE_NAME=1
@@ -250,7 +257,7 @@ SF_NETWORK_SOCKET=75
   SSF_RECEIVE=7
   SSF_SET_OPTIONS=8
   SSF_GET_OPTIONS=9
-  SSF_SOCKET_PAIR=10
+  SSF_GET_PAIR=10
 SF_NETWORK_PROTOCOL=76
   SSF_ETHERNET_READ_MAC=0
   SSF_IP4_PACKETS_SENT=10000h
@@ -283,6 +290,9 @@ SF_FUTEX=77
   SSF_DESTROY=1
   SSF_WAIT=2
   SSF_WAKE=3
+  SSF_FILE_READ=10
+  SSF_FILE_WRITE=11
+  SSF_PIPE_CREATE=13
 
 ; File system errors:
 FSERR_SUCCESS=0

programs/develop/cedit/Tupfile.lua

@@ -0,0 +1,9 @@
+if tup.getconfig("NO_OB07") ~= "" then return end
+if tup.getconfig("HELPERDIR") == ""
+then
+  HELPERDIR = "../../"
+end
+
+tup.include(HELPERDIR .. "/use_ob07.lua")
+
+build_ob07({"SRC/CEdit.ob07"}, "cedit"); 

programs/develop/koldbg/koldbg.asm

@@ -172,7 +172,7 @@ else
 end if
 }
 
-include 'kosfuncs.inc'
+include '../../KOSfuncs.inc'
 include '../../macros.inc'
 
 include 'font.inc'

programs/develop/koldbg/kosfuncs.inc

@@ -1,298 +0,0 @@
-
-; KolibriOS system functions:
-SF_TERMINATE_PROCESS=-1
-SF_CREATE_WINDOW=0      ; define and draw the window
-SF_PUT_PIXEL=1          ; draw pixel to the window
-SF_GET_KEY=2            ; get code of the pressed key
-SF_GET_SYS_TIME=3
-SF_DRAW_TEXT=4
-SF_SLEEP=5              ; pause process
-SF_PUT_IMAGE=7          ; draw image to the window
-SF_DEFINE_BUTTON=8      ; define/delete the button
-SF_THREAD_INFO=9        ; information on execution thread
-SF_WAIT_EVENT=10        ; wait for event
-SF_CHECK_EVENT=11       ; check for event and return
-SF_REDRAW=12
-  SSF_BEGIN_DRAW=1
-  SSF_END_DRAW=2
-SF_DRAW_RECT=13         ; draw rectangle to the window
-SF_GET_SCREEN_SIZE=14   ; get screen resolution
-SF_BACKGROUND_SET=15    ; work with desktop background graphics
-  SSF_SIZE_BG=1         ; set a size of the background image
-  SSF_PIXEL_BG=2        ; put pixel on the background image
-  SSF_REDRAW_BG=3       ; redraw background
-  SSF_MODE_BG=4         ; set drawing mode for the background
-  SSF_IMAGE_BG=5        ; put block of pixels on the background image
-  SSF_MAP_BG=6          ; map background image to the address space of the process
-  SSF_UNMAP_BG=7        ; close mapped background data
-  SSF_LAST_DRAW=8       ; get coordinates of the last draw to the background
-  SSF_REDRAW_RECT=9     ; redraws a rectangular part of the background
-SF_RD_TO_FLOPPY=16      ; save ramdisk on the floppy
-SF_GET_BUTTON=17        ; get ID of the pressed button
-SF_SYSTEM=18
-  SSF_UNFOCUS_WINDOW=1          ; take focus from the window of the given thread
-  SSF_TERMINATE_THREAD=2        ; terminate process/thread by the slot number
-  SSF_FOCUS_WINDOW=3            ; give focus to the window of the given thread
-  SSF_GET_IDLE_COUNT=4          ; get counter of idle cycles per second
-  SSF_GET_CPU_FREQUENCY=5        ; get CPU clock rate
-  SSF_RD_TO_HDD=6               ; save ramdisk to the file on hard disk
-  SSF_GET_ACTIVE_WINDOW=7       ; get slot number of the active window
-  SSF_SPEAKER=8
-    SSSF_GET_STATE=1
-    SSSF_TOGGLE=2
-  SSF_SHUTDOWN=9                ; system shutdown/reboot
-  SSF_MINIMIZE_WINDOW=10        ; minimize active window
-  SSF_INFO_DISC_SYS=11          ; get disk subsystem information
-  SSF_KERNEL_VERSION=13         ; get kernel version
-  SSF_WAIT_RETRACE=14           ; wait for screen retrace
-  SSF_CURSOR_CENTER=15          ; center mouse cursor on the screen
-  SSF_GET_FREE_RAM=16           ; get size of free RAM
-  SSF_GET_TOTAL_RAM=17          ; get total amount of RAM
-  SSF_TERMINATE_THREAD_ID=18    ; Terminate process/thread by the ID
-  SSF_MOUSE_SETTINGS=19
-    SSSF_GET_SPEED=0
-    SSSF_SET_SPEED=1
-    SSSF_GET_SPEEDUP=2
-    SSSF_SET_SPEEDUP=3          ; set mouse acceleration
-    SSSF_SET_POS=4              ; set mouse pointer position
-    SSSF_SET_BUTTON=5           ; simulate state of mouse buttons
-    SSSF_GET_DOUBLE_CLICK_DELAY=6
-    SSSF_SET_DOUBLE_CLICK_DELAY=7
-  SSF_GET_RAM_INFO=20           ; get information on RAM
-  SSF_GET_THREAD_SLOT=21        ; get slot number of process/thread by the ID
-  SSF_FOREIGN_WINDOW=22         ; operations with window of another thread by slot/ID
-    SSSF_MINIMIZE=0
-    SSSF_MINIMIZE_ID=1
-    SSSF_RESTORE=2
-    SSSF_RESTORE_ID=3
-  SSF_MINIMIZE_ALL=23
-  SSF_SET_SCREEN_LIMITS=24
-  SSF_WINDOW_BEHAVIOR=25        ; window focus relation with other windows
-    SSSF_GET_WB=1
-    SSSF_SET_WB=2
-SF_MIDI=20
-  SSF_RESET=1
-  SSF_OUTPUT=2
-SF_SYSTEM_SET=21
-  SSF_MPU_MIDI_BASE=1
-  SSF_KEYBOARD_LAYOUT=2
-  SSF_SYS_LANG=5
-  SSF_ACCESS_HD_LBA=11  ; setting of low-level access to HD
-  SSF_ACCESS_PCI=12     ; setting of low-level access to PCI
-SF_SET_TIME_DATE=22
-SF_WAIT_EVENT_TIMEOUT=23; wait for event with timeout
-SF_CD=24
-  SSF_EJECT_TRAY=4
-  SSF_INSERT_TRAY=5
-SF_SCREEN_PUT_IMAGE=25  ; put image on the background layer
-SF_SYSTEM_GET=26
-  ; Same as SF_SYSTEM_SET, plus:
-  SSF_TIME_COUNT=9
-  SSF_TIME_COUNT_PRO=10 ; get value of the high precision time counter
-SF_GET_SYS_DATE=29
-SF_CURRENT_FOLDER=30
-  SSF_SET_CF=1          ; set current folder for the thread
-  SSF_GET_CF=2
-  SSF_ADD_SYS_FOLDER=3  ; install the add.system directory for the kernel
-SF_GET_PIXEL_OWNER=34   ; get slot number of the screen pixel owner
-SF_GET_PIXEL=35         ; read the screen pixel color
-SF_GET_IMAGE=36         ; read the screen area
-SF_MOUSE_GET=37
-  SSF_SCREEN_POSITION=0
-  SSF_WINDOW_POSITION=1
-  SSF_BUTTON=2          ; states of the mouse buttons
-  SSF_BUTTON_EXT=3      ; states and events of the mouse buttons
-  SSF_LOAD_CURSOR=4
-  SSF_SET_CURSOR=5
-  SSF_DEL_CURSOR=6
-  SSF_SCROLL_DATA=7
-SF_DRAW_LINE=38
-SF_BACKGROUND_GET=39
-  ;SSF_SIZE_BG=1
-  ;SSF_PIXEL_BG=2
-  ;SSF_MODE_BG=4
-SF_SET_EVENTS_MASK=40   ; turn on/off desired events
-SF_PORT_IN_OUT=43       ; input/output to a port
-SF_SET_PORTS=46         ; reserve/free a group of input/output ports
-SF_DRAW_NUMBER=47       ; draw number to the window
-SF_STYLE_SETTINGS=48
-  SSF_APPLY=0           ; apply screen settings
-  SSF_SET_BUTTON_STYLE=1
-  SSF_SET_COLORS=2
-  SSF_GET_COLORS=3      ; get standard window colors
-  SSF_GET_SKIN_HEIGHT=4
-  SSF_GET_SCREEN_AREA=5 ; get screen working area
-  SSF_SET_SCREEN_AREA=6
-  SSF_GET_SKIN_MARGINS=7
-  SSF_SET_SKIN=8
-  SSF_GET_FONT_SMOOTH=9
-  SSF_SET_FONT_SMOOTH=10
-  SSF_GET_FONT_SIZE=11
-  SSF_SET_FONT_SIZE=12
-SF_APM=49
-SF_SET_WINDOW_SHAPE=50
-SF_CREATE_THREAD=51
-SF_CLIPBOARD=54
-  SSF_GET_SLOT_COUNT=0  ; get the number of slots in the clipboard
-  SSF_READ_CB=1
-  SSF_WRITE_CB=2
-  SSF_DEL_SLOT=3        ; delete the last slot in the clipboard
-  SSF_UNLOCK_BUFFER=4   ; emergency buffer unlock
-SF_SPEAKER_PLAY=55
-SF_PCI_BIOS=57
-SF_IPC=60               ; Inter Process Communication
-  SSF_SET_AREA=1        ; set area for IPC receiving
-  SSF_SEND_MESSAGE=2
-SF_GET_GRAPHICAL_PARAMS=61
-  SSF_SCREEN_SIZE=1
-  SSF_BITS_PER_PIXEL=2
-  SSF_BYTES_PER_LINE=3
-SF_PCI=62
-  SSF_GET_VERSION=0     ; get version of PCI-interface
-  SSF_GET_LAST_BUS=1    ; get number of the last PCI-bus
-  SSF_GET_ADRR_MODE=2   ; get addressing mode of the PCI configuration space
-  SSF_READ_BYTE=4
-  SSF_READ_WORD=5
-  SSF_READ_DWORD=6
-  SSF_WRITE_BYTE=8
-  SSF_WRITE_WORD=9
-  SSF_WRITE_DWORD=10
-SF_BOARD=63
-  SSF_DEBUG_WRITE=1
-  SSF_DEBUG_READ=2
-SF_MEMORY_RESIZE=64     ; resize total application memory
-SF_PUT_IMAGE_EXT=65     ; draw image with palette to the window
-SF_KEYBOARD=66
-  SSF_SET_INPUT_MODE=1
-  SSF_GET_INPUT_MODE=2
-  SSF_GET_CONTROL_KEYS=3; get status of control keys
-  SSF_SET_SYS_HOTKEY=4
-  SSF_DEL_SYS_HOTKEY=5
-  SSF_LOCK_INPUT=6      ; block normal input
-  SSF_UNLOCK_INPUT=7    ; restore normal input
-SF_CHANGE_WINDOW=67     ; change position/sizes of the window
-SF_SYS_MISC=68
-  SSF_GET_TASK_SWITCH_COUNT=0
-  SSF_SWITCH_TASK=1
-  SSF_PERFORMANCE=2
-    SSSF_ALLOW_RDPMC=0
-    SSSF_CACHE_STATUS=1
-    SSSF_CACHE_ON=2
-    SSSF_CACHE_OFF=3
-  SSF_READ_MSR=3
-  SSF_WRITE_MSR=4
-  SSF_HEAP_INIT=11
-  SSF_MEM_ALLOC=12
-  SSF_MEM_FREE=13
-  SSF_WAIT_SIGNAL=14    ; wait for signal from another program/driver
-  SSF_LOAD_DRIVER=16
-  SSF_CONTROL_DRIVER=17
-  SSF_LOAD_DLL=19
-  SSF_MEM_REALLOC=20
-  SSF_LOAD_DRIVER_PE=21
-  SSF_MEM_OPEN=22       ; open named memory area
-  SSF_MEM_CLOSE=23
-  SSF_SET_EXCEPTION_HANDLER=24
-  SSF_SET_EXCEPTION_STATE=25
-  SSF_MEM_FREE_EXT=26
-  SSF_LOAD_FILE=27
-SF_DEBUG=69
-  SSF_SET_MESSAGE_AREA=0
-  SSF_GET_REGISTERS=1
-  SSF_SET_REGISTERS=2
-  SSF_DETACH=3
-  SSF_SUSPEND=4
-  SSF_RESUME=5
-  SSF_READ_MEMORY=6
-  SSF_WRITE_MEMORY=7
-  SSF_TERMINATE=8
-  SSF_DEFINE_BREAKPOINT=9
-SF_FILE=70
-  SSF_READ_FILE=0
-  SSF_READ_FOLDER=1
-  SSF_CREATE_FILE=2
-  SSF_WRITE_FILE=3
-  SSF_SET_END=4
-  SSF_GET_INFO=5
-  SSF_SET_INFO=6
-  SSF_START_APP=7
-  SSF_DELETE=8
-  SSF_CREATE_FOLDER=9
-SF_SET_CAPTION=71
-SF_SEND_MESSAGE=72
-SF_BLITTER=73
-SF_NETWORK_DEVICE=74
-  SSF_DEVICE_COUNT=255  ; get number of active network devices
-  SSF_DEVICE_TYPE=0
-  SSF_DEVICE_NAME=1
-  SSF_RESET_DEVICE=2
-  SSF_STOP_DEVICE=3
-  SSF_DEVICE_POINTER=4
-  SSF_TX_PACKET_COUNT=6
-  SSF_RX_PACKET_COUNT=7
-  SSF_TX_BYTE_COUNT=8
-  SSF_RX_BYTE_COUNT=9
-  SSF_LINK_STATUS=10
-  SSF_TX_PACKET_ERROR_COUNT=11
-  SSF_TX_PACKET_DROP_COUNT=12
-  SSF_TX_PACKET_MISS_COUNT=13
-  SSF_RX_PACKET_ERROR_COUNT=14
-  SSF_RX_PACKET_DROP_COUNT=15
-  SSF_RX_PACKET_MISS_COUNT=16
-SF_NETWORK_SOCKET=75
-  SSF_OPEN=0
-  SSF_CLOSE=1
-  SSF_BIND=2
-  SSF_LISTEN=3
-  SSF_CONNECT=4
-  SSF_ACCEPT=5
-  SSF_SEND=6
-  SSF_RECEIVE=7
-  SSF_SET_OPTIONS=8
-  SSF_GET_OPTIONS=9
-  SSF_SOCKET_PAIR=10
-SF_NETWORK_PROTOCOL=76
-  SSF_ETHERNET_READ_MAC=0
-  SSF_IP4_PACKETS_SENT=10000h
-  SSF_IP4_PACKETS_RECEIVED=10001h
-  SSF_IP4_READ_IP=10002h
-  SSF_IP4_WRITE_IP=10003h
-  SSF_IP4_READ_DNS=10004h
-  SSF_IP4_WRITE_DNS=10005h
-  SSF_IP4_READ_SUBNET=10006h
-  SSF_IP4_WRITE_SUBNET=10007h
-  SSF_IP4_READ_GATEWAY=10008h
-  SSF_IP4_WRITE_GATEWAY=10009h
-  SSF_ICMP_PACKETS_SENT=20000h
-  SSF_ICMP_PACKETS_RECEIVED=20001h
-  SSF_ICMP_ECHO_REPLY=20003h
-  SSF_UDP_PACKETS_SENT=30000h
-  SSF_UDP_PACKETS_RECEIVED=30001h
-  SSF_TCP_PACKETS_SENT=40000h
-  SSF_TCP_PACKETS_RECEIVED=40001h
-  SSF_ARP_PACKETS_SENT=50000h
-  SSF_ARP_PACKETS_RECEIVED=50001h
-  SSF_ARP_GET_ENTRY_COUNT=50002h
-  SSF_ARP_READ_ENTRY=50003h
-  SSF_ARP_ADD_STATIC_ENTRY=50004h
-  SSF_ARP_DEL_ENTRY=50005h
-  SSF_ARP_SEND_ANNOUNCE=50006h
-  SSF_ARP_CONFLICTS_COUNT=50007h
-SF_FUTEX=77
-  SSF_CREATE=0
-  SSF_DESTROY=1
-  SSF_WAIT=2
-  SSF_WAKE=3
-
-; File system errors:
-FSERR_SUCCESS=0
-FSERR_UNSUPPORTED=2
-FSERR_UNKNOWN=3
-FSERR_FILE_NOT_FOUND=5
-FSERR_END_OF_FILE=6
-FSERR_INVALID_BUFFER=7
-FSERR_DISK_FULL=8
-FSERR_FAIL=9
-FSERR_ACCESS_DENIED=10
-FSERR_DEVICE_FAIL=11
-FSERR_OUT_OF_MEMORY=12

programs/develop/ktcc/trunk/bin/lib/libc.def

@@ -52,10 +52,7 @@ atol
 atoll
 atof
 calloc
-_exit
 exit
-atexit
-abort
 free
 itoa
 labs
@@ -68,7 +65,6 @@ rand
 qsort
 strtod
 __assert_fail
-system
 ;____STRING____
 memchr
 memcmp
@@ -90,7 +86,6 @@ strrev
 strspn
 strstr
 strtok
-strtok_r
 strxfrm
 __errno
 ;____SYS____

programs/develop/ktcc/trunk/libc.obj/.gitignore

@@ -1,6 +0,0 @@
-.vscode/*
-.tup/*
-
-*.o
-*.kex
-*.obj

programs/develop/ktcc/trunk/libc.obj/include/stdlib.h

@@ -11,9 +11,6 @@
 #define min(a, b) ((a) < (b) ? (a) : (b))
 #define max(a, b) ((a) > (b) ? (a) : (b))
 
-#define EXIT_SUCCESS 0 // Successful execution of a program
-#define EXIT_FAILURE 1 // Unsuccessful execution of a program
-
 typedef struct {
     int quot;
     int rem;
@@ -51,15 +48,7 @@ DLLAPI void free(void* ptr);
 
 DLLAPI long int strtol(const char* str, char** endptr, int base);
 
-DLLAPI void _exit(int status);
-
-#ifndef _Exit
-#define _Exit(status) _exit(status)
-#endif
-
-DLLAPI void abort();
 DLLAPI void exit(int status);
-DLLAPI int atexit(void (*func)(void));
 
 DLLAPI void srand(unsigned s);
 DLLAPI int rand(void);
@@ -79,6 +68,4 @@ DLLAPI int abs(int);
 DLLAPI long labs(long);
 DLLAPI long long llabs(long long);
 
-DLLAPI int system(const char* command);
-
 #endif

programs/develop/ktcc/trunk/libc.obj/include/string.h

@@ -33,7 +33,6 @@ DLLAPI size_t strspn(const char* s1, const char* s2);
 DLLAPI char* strstr(const char* s1, const char* s2);
 DLLAPI char* strtok(char* s1, const char* s2);
 DLLAPI char* strtok_r(char* s1, const char* s2, char** saveptr);
-
 DLLAPI char* strerror(int errnum);
 DLLAPI size_t strlen(const char* s);
 DLLAPI char* strrev(char* str);

programs/develop/ktcc/trunk/libc.obj/samples/Makefile

@@ -27,10 +27,7 @@ BIN = \
 	libc_test.kex \
 	pipe.kex \
 	defgen.kex \
-	futex.kex	\
-	atexit_test.kex	\
-	malloc_test.kex	\
-	system_test.kex
+	futex.kex
 	
 all: $(BIN)
 	

programs/develop/ktcc/trunk/libc.obj/samples/assert_test.c

@@ -7,6 +7,4 @@ int main()
 {
     assert(a != b);
     assert(a == b);
-    
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/atexit_test.c

@@ -1,18 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-
-void f()
-{
-    static int c = 1;
-    printf("exit #%d\n", c);
-    c++;
-}
-
-int main()
-{
-    atexit(&f);
-    atexit(&f);
-    atexit(&f);
-
-    return 0;
-}

programs/develop/ktcc/trunk/libc.obj/samples/build_all.sh

@@ -23,7 +23,5 @@ cp     clayer/logo.png /tmp0/1/tcc_samples/logo.png
 ../tcc defgen.c -o /tmp0/1/tcc_samples/defgen
 ../tcc pipe.c -o /tmp0/1/tcc_samples/pipe
 ../tcc futex.c -o /tmp0/1/tcc_samples/futex
-../tcc malloc_test.c -o /tmp0/1/tcc_samples/malloc_test
-../tcc atexit_test.c -o /tmp0/1/tcc_samples/atexit_test
 "/sys/File managers/Eolite" /tmp0/1/tcc_samples
 exit

programs/develop/ktcc/trunk/libc.obj/samples/clayer/msgbox.c

@@ -5,6 +5,4 @@ int main()
     msgbox* msg1 = NULL;
     msg1 = kolibri_new_msgbox("Title", "Text in window", 0, "Ok");
     kolibri_start_msgbox(msg1, NULL);
-    
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/clayer/rasterworks.c

@@ -43,7 +43,7 @@ int main()
 
         case KSYS_EVENT_BUTTON:
             if (_ksys_get_button() == 1)
-                return 0;
+                exit(0);
             break;
         };
     }

programs/develop/ktcc/trunk/libc.obj/samples/consoleio.c

@@ -18,5 +18,4 @@ int main()
     }
 
     (*con_exit)(0);
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/dir_example.c

@@ -41,6 +41,4 @@ int main()
     path = getcwd(NULL, PATH_MAX);
     printf("Move to the directory: %s\n", path);
     free(path);
-    
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/file_io.c

@@ -47,5 +47,4 @@ int main(int argc, char** argv)
         puts("TEST: FAIL!");
     }
     fclose(f);
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/http_tcp_demo.c

@@ -55,5 +55,5 @@ int main()
 
     close(sock);
     puts("\n goodbye)\n");
-    return 0;
+    exit(0);
 }

programs/develop/ktcc/trunk/libc.obj/samples/libc_test.c

@@ -86,5 +86,5 @@ int main()
     printf(asctime(libc_tm));
 
     puts("End testing.");
-    return 0;
+    exit(0);
 }

programs/develop/ktcc/trunk/libc.obj/samples/malloc_test.c

@@ -1,296 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include <stdbool.h>
-#include "../source/stdlib/_mem.h"
-
-#define RUN_TEST(func)                                      \
-    do {                                                    \
-        printf("---\tRUN TEST: %s\t---\n", #func);          \
-        if (func()) {                                       \
-            printf("[SUCCESS]\tTest %s is ok.\n\n", #func); \
-        } else {                                            \
-            printf("[FAIL]\tTest %s failed.\n\n", #func);   \
-            exit(EXIT_FAILURE);                             \
-        }                                                   \
-    } while (0)
-
-// c between a and b
-#define IN_RANGE(a, b, c, len) ((a > c && c > b) || ((a > c + len && c + len > b)))
-
-bool test_malloc_basic_allocation()
-{
-    void* ptr = malloc(sizeof(int));
-
-    if (ptr)
-        free(ptr);
-
-    return ptr;
-}
-bool test_malloc_zero_bytes()
-{
-    return malloc(0) == NULL;
-}
-
-bool test_malloc_multiple_allocations()
-{
-    void* ptr[512];
-
-    for (int i = 1; i < sizeof(ptr) / sizeof(*ptr); i++) {
-        ptr[i] = malloc(i);
-        if (ptr[i] == NULL) {
-            return false;
-        }
-    }
-    for (int i = 1; i < sizeof(ptr) / sizeof(*ptr); i++) {
-        for (int j = 1; j < sizeof(ptr) / sizeof(*ptr); j++) {
-            if (i != j) {
-                if (ptr[i] == ptr[j]) {
-                    printf("ptrs[%d] == ptrs[%d].\n", i, j);
-                    return false;
-                } else if (IN_RANGE(
-                               (char*)GET_MEM_NODE_HEADER(ptr[i]) + GET_MEM_NODE_HEADER(ptr[i])->size,
-                               (char*)GET_MEM_NODE_HEADER(ptr[i]),
-                               (char*)GET_MEM_NODE_HEADER(ptr[j]),
-                               GET_MEM_NODE_HEADER(ptr[j])->size)) {
-                    printf("node %p in node %p", GET_MEM_NODE_HEADER(ptr[i]), GET_MEM_NODE_HEADER(ptr[j]));
-                    // additional info
-                    printf("node %p\nsize:%p\nfree:%p\nnext: %p\nlast: %p\n", GET_MEM_NODE_HEADER(ptr[i]), GET_MEM_NODE_HEADER(ptr[i])->size, GET_MEM_NODE_HEADER(ptr[i])->free, GET_MEM_NODE_HEADER(ptr[i])->next, GET_MEM_NODE_HEADER(ptr[i])->last);
-                    printf("node %p\nsize:%p\nfree:%p\nnext: %p\nlast: %p\n", GET_MEM_NODE_HEADER(ptr[j]), GET_MEM_NODE_HEADER(ptr[j])->size, GET_MEM_NODE_HEADER(ptr[j])->free, GET_MEM_NODE_HEADER(ptr[j])->next, GET_MEM_NODE_HEADER(ptr[j])->last);
-                    exit(EXIT_FAILURE);
-                }
-            }
-        }
-    }
-
-    for (int i = 1; i < sizeof(ptr) / sizeof(*ptr); i++) {
-        free(ptr[i]);
-    }
-
-    return true;
-}
-bool test_malloc_data_integrity()
-{
-    const char* As = "AAA";
-    const char* Cs = "CCC";
-
-    char* A = (char*)malloc(10);
-    char* B = (char*)malloc(10);
-    char* C = (char*)malloc(10);
-
-    if (!A || !B || !C) {
-        printf("can't alloc\n");
-        free(A);
-        free(B);
-        free(C);
-        return false;
-    }
-
-    strcpy(A, As);
-    strcpy(C, Cs);
-
-    free(B);
-
-    if (strcmp(A, As) != 0) {
-        printf("A data is broken after free(B). A = '%s'\n", A);
-        free(A);
-        free(C);
-        return false;
-    }
-    if (strcmp(C, Cs) != 0) {
-        printf("C data is broken after free(B). C = '%s'\n", C);
-        free(A);
-        free(C);
-        return false;
-    }
-
-    free(A);
-    free(C);
-    return true;
-}
-bool test_malloc_large_allocation()
-{
-    void* ptr = malloc(1024 * 1024 * 16); // alloc 16mb
-
-    if (ptr)
-        free(ptr);
-
-    return ptr;
-}
-bool test_malloc_allocation_and_free()
-{
-    free(malloc(sizeof(int)));
-    return true;
-}
-
-void fill_buffer(void *ptr, size_t size, unsigned char pattern) {
-    if (ptr) {
-        memset(ptr, pattern, size);
-    }
-}
-
-bool check_buffer(void *ptr, size_t size, unsigned char pattern) {
-    if (!ptr) {
-        return false; // Нельзя проверить NULL
-    }
-    unsigned char *byte_ptr = (unsigned char *)ptr;
-    for (size_t i = 0; i < size; ++i) {
-        if (byte_ptr[i] != pattern) {
-            fprintf(stderr, "Ошибка: Байт %zu не соответствует паттерну. Ожидалось %02X, получено %02X\n",
-                    i, pattern, byte_ptr[i]);
-            return false;
-        }
-    }
-    return true;
-}
-
-bool test_realloc_basic_grow() {
-    size_t old_size = 10;
-    size_t new_size = 20;
-    int *ptr = (int *)malloc(old_size * sizeof(int));
-
-    if (ptr == NULL) {
-        return false;
-    }
-    fill_buffer(ptr, old_size * sizeof(int), 0xAA);
-
-    int *new_ptr = (int *)realloc(ptr, new_size * sizeof(int));
-
-    if (new_ptr == NULL) {
-        free(ptr); // Оригинальный блок все еще действителен
-        return false;
-    }
-
-    // Проверяем, что старые данные сохранились
-    if (!check_buffer(new_ptr, old_size * sizeof(int), 0xAA)) {
-        free(new_ptr);
-        return false;
-    }
-
-    // Проверяем, что новый участок доступен для записи
-    fill_buffer(new_ptr + old_size, (new_size - old_size) * sizeof(int), 0xBB);
-    if (!check_buffer(new_ptr + old_size, (new_size - old_size) * sizeof(int), 0xBB)) {
-        free(new_ptr);
-        return false;
-    }
-
-    free(new_ptr);
-    return true;
-}
-
-bool test_realloc_basic_shrink() {
-    size_t old_size = 20;
-    size_t new_size = 10;
-    int *ptr = (int *)malloc(old_size * sizeof(int));
-
-    if (ptr == NULL) {
-        return false;
-    }
-    fill_buffer(ptr, old_size * sizeof(int), 0xCC);
-
-    int *new_ptr = (int *)realloc(ptr, new_size * sizeof(int));
-
-    if (new_ptr == NULL) {
-        free(ptr);
-        return false;
-    }
-
-    if (!check_buffer(new_ptr, new_size * sizeof(int), 0xCC)) {
-        free(new_ptr);
-        return false;
-    }
-
-    free(new_ptr);
-    return true;
-}
-
-bool test_realloc_same_size() {
-    size_t size = 15;
-    int *ptr = (int *)malloc(size * sizeof(int));
-
-    if (ptr == NULL) {
-        return false;
-    }
-    fill_buffer(ptr, size * sizeof(int), 0xDD);
-
-    int *new_ptr = (int *)realloc(ptr, size * sizeof(int));
-
-    if (new_ptr == NULL) {
-        free(ptr);
-        return false;
-    }
-
-    // Проверяем, что данные сохранились
-    if (!check_buffer(new_ptr, size * sizeof(int), 0xDD)) {
-        free(new_ptr);
-        return false;
-    }
-
-    free(new_ptr);
-    
-    return true;
-}
-
-bool test_realloc_null_ptr() {
-    size_t size = 25;
-    void *ptr = realloc(NULL, size);
-
-    if (ptr == NULL) {
-        return false;
-    }
-    
-    // Проверяем, что память доступна
-    fill_buffer(ptr, size, 0xEE);
-    if (!check_buffer(ptr, size, 0xEE)) {
-        free(ptr);
-        return false;
-    }
-
-    free(ptr);
-    
-    return true;
-}
-
-bool test_realloc_to_zero_size() {
-    size_t old_size = 30;
-    void *ptr = malloc(old_size);
-
-    if (ptr == NULL) {
-        return false;
-    }
-    fill_buffer(ptr, old_size, 0xFF);
-
-    void *new_ptr = realloc(ptr, 0);
-
-    // Стандарт C11 (7.22.3.5) говорит, что realloc(ptr, 0) может вернуть NULL
-    // или указатель, который можно передать free().
-    // Если возвращается NULL, оригинальный указатель ptr все еще действителен и должен быть освобожден.
-    // Если возвращается не-NULL, оригинальный ptr недействителен, а новый ptr должен быть освобожден.
-    if (new_ptr == NULL) {
-        printf("realloc(ptr, 0) return NULL.\n");
-        free(ptr); // Освобождаем оригинальный ptr
-    } else {
-        printf("realloc(ptr, 0) return: %p.\n", new_ptr);
-        free(new_ptr); // Освобождаем новый ptr
-    }
-    return true;
-}
-
-
-int main()
-{
-    RUN_TEST(test_malloc_basic_allocation);
-    RUN_TEST(test_malloc_zero_bytes);
-    RUN_TEST(test_malloc_multiple_allocations);
-    RUN_TEST(test_malloc_data_integrity);
-    RUN_TEST(test_malloc_large_allocation);
-    RUN_TEST(test_malloc_basic_allocation);
-    RUN_TEST(test_malloc_allocation_and_free);
-    RUN_TEST(test_realloc_basic_grow);
-    RUN_TEST(test_realloc_basic_shrink);
-    RUN_TEST(test_realloc_same_size);
-    RUN_TEST(test_realloc_null_ptr);
-    RUN_TEST(test_realloc_to_zero_size);
-
-    return 0;
-}

programs/develop/ktcc/trunk/libc.obj/samples/math_test.c

@@ -38,5 +38,4 @@ int main()
         result = frexp(param, &n);
         printf("%f = %f * 2^%d\n", param, result, n);
     }
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/pipe.c

@@ -23,7 +23,7 @@ void tmain()
     printf("RECV: %s\n", recv_message);
     assert(!strcmp(recv_message, send_message));
     puts("Successful pipe test");
-    _ksys_exit();
+    exit(0);
 }
 
 void create_thread(void)
@@ -42,7 +42,7 @@ void create_thread(void)
     printf("New thread created (TID=%u)\n", tid);
 }
 
-int main()
+void main()
 {
     if (_ksys_posix_pipe2(pipefd, 0)) {
         puts("Pipe creation error!");
@@ -51,5 +51,4 @@ int main()
     printf("SEND: %s\n", send_message);
     _ksys_posix_write(pipefd[1], send_message, MESSAGE_SIZE);
     create_thread();
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/shell_test.c

@@ -17,6 +17,5 @@ int main()
     string[0] = shell_getc();
     shell_printf("\n\rYou pressed: %c", string[0]);
     shell_exit();
-    
     return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/string_test.c

@@ -16,5 +16,4 @@ int main(int argc, char** argv)
         printf("memcpy: Failure\n");
         return -1;
     }
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/system_test.c

@@ -1,15 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <sys/ksys.h>
-
-#define EXIT_CODE_FORMAT "Exit Code: %d\n"
-
-int main()
-{
-    printf(EXIT_CODE_FORMAT, system("ls ."));
-
-    _ksys_delay(500);
-    printf(EXIT_CODE_FORMAT, system("/sys/sysmon"));
-
-    return 0;
-}

programs/develop/ktcc/trunk/libc.obj/samples/thread_work.c

@@ -64,10 +64,9 @@ int main()
                 create_thread();
                 break;
             case BTN_QUIT:
-                return 0;
+                _ksys_exit();
             }
             break;
         }
     }
-    return 0;
 }

programs/develop/ktcc/trunk/libc.obj/samples/tmpdisk_work.c

@@ -30,7 +30,7 @@ int main()
     ksys_drv_hand_t tmpdisk_drv = _ksys_load_driver("tmpdisk");
     if (!tmpdisk_drv) {
         puts("tmpdisk.sys driver not load!");
-        return 0;
+        exit(0);
     } else {
         puts("tmpdisk.sys driver is load!");
     }
@@ -53,6 +53,5 @@ int main()
     } else {
         puts(tmpdisk_res_text[6]);
     }
-    
-    return 0;
+    exit(0);
 }

programs/develop/ktcc/trunk/libc.obj/samples/whois.c

@@ -19,6 +19,9 @@ FILE* out = stdout;
 FILE* out = stderr;
 #endif
 
+#define EXIT_SUCCESS 0
+#define EXIT_FAILURE 1
+
 #define fprintf fprintf
 
 void show_help()
@@ -48,18 +51,18 @@ int main(int argc, char* argv[])
         domain = strdup(argv[1]);
         if ((out = fopen(argv[3], "w")) == NULL) {
             printf("Error writing to file: '%s' !\n", argv[3]);
-            return 0;
+            exit(0);
         }
     } else {
         show_help();
-        return 0;
+        exit(0);
     }
     if (out == stdout) {
         con_init();
         (*con_set_title)("Whois");
     }
     get_whois_data(domain, &data);
-    return 0;
+    exit(0);
 }
 
 /*

programs/develop/ktcc/trunk/libc.obj/source/Tupfile.lua

@@ -1,10 +1,6 @@
-if tup.getconfig("NO_TCC") ~= "" then
-    return
-end
+if tup.getconfig("NO_TCC") ~= "" then return end
 
-CC = "kos32-tcc"
-
-CFLAGS = " -r -nostdinc -nostdlib -DGNUC -D_BUILD_LIBC -Wall -Werror"
+CFLAGS = " -r -nostdinc -nostdlib -DGNUC -D_BUILD_LIBC "
 INCLUDES = " -I../include"
 
 GAS_SRC = {
@@ -33,18 +29,14 @@ GAS_SRC = {
     "math/sqrt.s",
     "math/tan.s",
     "string/memset.s",
-    "string/memmove.s",
+    "string/memmove.s"
 }
 
-FASM_SRC = {
-    "crt/crt0.asm",
-}
+OBJS = {"libc.c"}
 
-LIBC_OBJS = { "libc.c" }
+tup.append_table(OBJS,
+  tup.foreach_rule(GAS_SRC, "as --32 %f -o %o", "%B.o")
+)
 
-tup.append_table(LIBC_OBJS, tup.foreach_rule(GAS_SRC, "as --32 %f -o %o", "%B.o"))
-
-tup.rule(LIBC_OBJS, CC .. CFLAGS .. INCLUDES .. " %f -o %o " .. " && strip %o --strip-unneeded ", "libc.o")
+tup.rule(OBJS, "kos32-tcc" .. CFLAGS .. INCLUDES .. " %f -o %o " .. " && strip %o --strip-unneeded " , "libc.o")
 tup.rule("libc.o", "objconv -fcoff32 %f %o " .. tup.getconfig("KPACK_CMD"), "%B.obj")
-
-tup.rule(FASM_SRC, "fasm %f %o", "%B.o")

programs/develop/ktcc/trunk/libc.obj/source/crt/crt0.asm

@@ -14,7 +14,6 @@ public start
 public start as '_start'
 
 extrn main
-extrn exit
 
 include '../../../../../../proc32.inc'
 include '../../../../../../macros.inc'
@@ -39,36 +38,36 @@ start:
     call push_param
 ; retrieving parameters
     mov  esi, params
-    xor  edx, edx  ; dl - is it a parameter (1) or delimiters (0)
-                   ; dh - character with which the parameter started (1 quotes, 0 everything else)
+    xor  edx, edx  ; dl - èä¸ò ïàðàìåòð(1) èëè ðàçäåëèòåëè(0)
+                   ; dh - ñèìâîë ñ êîòîðîãî íà÷àëñÿ ïàðàìåòð (1 êàâû÷êè, 0 îñòàëüíîå)
     mov  ecx, 1    ; cl = 1
-                   ; ch = 0  just zero
+                   ; ch = 0  ïðîñòî íîëü
 .parse: 
     lodsb
     test al, al
     jz   .run
     test dl, dl
     jnz  .findendparam
-                     ;{if it was a delimiter
+                     ;{åñëè áûë ðàçäåëèòåëü
     cmp  al, ' '
-    jz   .parse  ; space loaded, load next character
-    mov  dl, cl  ; parameter starts
+    jz   .parse  ;çàãðóæåí ïðîáåë, ãðóçèì ñëåäóþùèé ñèìâîë
+    mov  dl, cl  ;íà÷èíàåòñÿ ïàðàìåòð
     cmp  al, '"'
-    jz   @f      ; quotes loaded
-    mov  dh, ch     ; parameter without quotes
+    jz   @f      ;çàãðóæåíû êàâû÷êè
+    mov  dh, ch     ;ïàðàìåòð áåç êàâû÷åê
     dec  esi
     call push_param
     inc  esi
     jmp  .parse
 
   @@:  
-    mov  dh, cl     ; parameter in quotes
-    call push_param ; if not a space, then some parameter starts
-    jmp  .parse     ; if it was a delimiter}
+    mov  dh, cl     ;ïàðàìåòð â êàâû÷åêàõ
+    call push_param ;åñëè íå ïðîáåë çíà÷èò íà÷èíàåòñÿ êàêîé òî ïàðàìåòð
+    jmp  .parse     ;åñëè áûë ðàçäåëèòåëü}
 
 .findendparam:
     test dh, dh
-    jz   @f ; without quotes
+    jz   @f ; áåç êàâû÷åê
     cmp  al, '"'
     jz   .clear
     jmp  .parse
@@ -87,9 +86,10 @@ start:
     push [argc]
     call main
 .exit:
-    push eax
-    call dword [exit]
-    dd -1
+    xor  eax,eax
+    dec  eax
+    int  0x40
+    dd   -1
 .crash:
     jmp  .exit
 ;============================

programs/develop/ktcc/trunk/libc.obj/source/libc.c

@@ -82,7 +82,6 @@
 #include "string/strstr.c"
 #include "string/strtok.c"
 #include "string/strxfrm.c"
-
 #include "stdlib/abs.c"
 #include "stdlib/assert.c"
 #include "stdlib/atof.c"
@@ -90,8 +89,6 @@
 #include "stdlib/atol.c"
 #include "stdlib/atoll.c"
 #include "stdlib/calloc.c"
-#include "stdlib/atexit.c"  // must be before exit.c
-#include "stdlib/_exit.c"
 #include "stdlib/exit.c"
 #include "stdlib/free.c"
 #include "stdlib/itoa.c"
@@ -103,8 +100,6 @@
 #include "stdlib/realloc.c"
 #include "stdlib/strtod.c"
 #include "stdlib/strtol.c"
-#include "stdlib/abort.c"
-#include "stdlib/system.c"
 
 #include "math/acosh.c"
 #include "math/asinh.c"
@@ -175,8 +170,6 @@ ksys_dll_t EXPORTS[] = {
     { "atoll", &atoll },
     { "atof", &atof },
     { "calloc", &calloc },
-    { "atexit", &atexit },
-    { "_exit", &_exit },
     { "exit", &exit },
     { "free", &free },
     { "itoa", &itoa },
@@ -185,8 +178,6 @@ ksys_dll_t EXPORTS[] = {
     { "malloc", &malloc },
     { "realloc", &realloc },
     { "strtol", &strtol },
-    { "abort", &abort},
-    { "system", &system },
     { "srand", &srand },
     { "rand", &rand },
     { "qsort", &qsort },
@@ -212,7 +203,7 @@ ksys_dll_t EXPORTS[] = {
     { "strspn", &strspn },
     { "strstr", &strstr },
     { "strtok", &strtok },
-    { "strtok_r", &strtok_r},
+    { "strtok_r", &strtok_r },
     { "strxfrm", &strxfrm },
     { "strpbrk", &strpbrk },
     { "__errno", &__errno },

programs/develop/ktcc/trunk/libc.obj/source/stdio/printf.c

@@ -4,13 +4,11 @@
 #include <stdio.h>
 #include <stdlib.h>
 
-// #include "format_print.h"
+//#include "format_print.h"
 
-int printf(const char* format, ...)
+int printf(const char *format, ...)
 {
-    va_list arg;
-    va_start(arg, format);
-    int ret = vprintf(format, arg);
-    va_end(arg);
-    return ret;
+  va_list arg;
+  va_start(arg, format);
+  return vprintf(format, arg);
 }

programs/develop/ktcc/trunk/libc.obj/source/stdlib/_exit.c

@@ -1,29 +0,0 @@
-#include <conio.h>
-#include <stdio.h>
-#include <sys/ksys.h>
-#include "_exit.h"
-
-void _exit(int status)
-{
-    __libc_exit(status, NULL);
-}
-
-void __libc_exit(int status, void (*before_exit)(int status))
-{
-    // return error and this is not abort
-    if (status && status != 128) {
-        fprintf(stderr, "\nexit code: %d\n", status);
-    }
-
-    WRITE_EXIT_CODE(status);
-
-    if (before_exit) {
-        before_exit(status);
-    }
-
-    if (__con_is_load) {
-        con_exit(0);
-    }
-
-    _ksys_exit();
-}

programs/develop/ktcc/trunk/libc.obj/source/stdlib/_exit.h

@@ -1,69 +0,0 @@
-#ifndef __STDLIB_EXIT_H__
-#define __STDLIB_EXIT_H__
-
-#include <stdio.h>
-#include <sys/dir.h>
-#include <sys/ksys.h>
-
-#define __PATH_TO_STATUS_FILE        "/tmp0/1/.libc"
-#define __STATUS_FILE_EXTENSION      ".status"
-#define __STATUS_FILE_FORMAT         "%d"
-#define __FULL_STATUS_FILE_NAME      __PATH_TO_STATUS_FILE "/%d" __STATUS_FILE_EXTENSION
-#define __FULL_STATUS_FILE_NAME_SIZE (sizeof(__PATH_TO_STATUS_FILE) + 32 + sizeof(__STATUS_FILE_EXTENSION))
-
-void __libc_exit(int status, void (*before_exit)(int status));
-
-// Save exit code
-inline void WRITE_EXIT_CODE(int status)
-{
-    mkdir(__PATH_TO_STATUS_FILE);
-
-    char buff[__FULL_STATUS_FILE_NAME_SIZE];
-    ksys_thread_t t;
-
-    _ksys_thread_info(&t, -1);
-    snprintf(buff, sizeof(buff), __FULL_STATUS_FILE_NAME, t.pid);
-
-    FILE* f = fopen(buff, "w");
-
-    if (f) {
-        snprintf(buff, sizeof(buff), __STATUS_FILE_FORMAT, status);
-        fputs(buff, f);
-        fflush(f);
-        fclose(f);
-    } else {
-        _ksys_debug_puts("error while write status\n");
-    }
-}
-
-// Read exit code
-inline int READ_EXIT_CODE(int pid, ksys_thread_t* t)
-{
-    char buff[__FULL_STATUS_FILE_NAME_SIZE];
-    int status = 0;
-    bool free_t = false;
-
-    if (!t) {
-        t = malloc(sizeof(ksys_thread_t));
-        _ksys_thread_info(t, -1);
-        free_t = true;
-    }
-    snprintf(buff, sizeof(buff), __FULL_STATUS_FILE_NAME, t->pid);
-
-    FILE* f = fopen(buff, "r");
-    if (f) {
-        fscanf(f, __STATUS_FILE_FORMAT, &status);
-        fclose(f);
-    } else if (t && t->slot_state == 4) // it was stopped before it created status file
-    {
-        status = -1;
-    }
-
-    if (free_t) {
-        free(t);
-    }
-
-    return status;
-}
-
-#endif // __STDLIB_EXIT_H__

programs/develop/ktcc/trunk/libc.obj/source/stdlib/_mem.h

@@ -1,81 +0,0 @@
-#ifndef _LIBC_STDLIB__MEM_
-#define _LIBC_STDLIB__MEM_
-
-#include <stddef.h>
-
-struct mem_node {
-    size_t free; // Amount of free space in this node.  When equal to size, the entire node is free.
-
-    size_t size; // Total size of this memory node.
-
-    struct mem_node* last; // Pointer to the previous memory node in the linked list.
-    struct mem_node* next; // Pointer to the next memory node in the linked list.
-};
-
-struct mem_block {
-    size_t size; // Size of the allocated memory block.
-
-    size_t a; // align to 8bytes
-};
-
-// Size of the blocks allocated by `_ksys_alloc`
-#define ALLOC_BLOCK_SIZE 4096
-
-// Macro to get a pointer to the user data area from a mem_node pointer.
-// This is done by adding the size of the mem_node structure to the mem_node pointer.
-#define GET_MEM_NODE_PTR(node) (char*)((char*)(node) + sizeof(struct mem_node))
-
-// Macro to check if a memory node is completely free.
-#define MEM_NODE_IS_FREE(node) (node->free == node->size)
-
-// Macro to get the amount of used memory in a memory node.
-#define GET_MEM_NODE_USED_MEM(node) (node->size - node->free)
-
-// Macro to get a pointer to the mem_node structure from a user data pointer.
-// This is done by subtracting the size of the mem_node structure from the user data pointer.
-#define GET_MEM_NODE_HEADER(ptr) ((struct mem_node*)(((char*)ptr) - sizeof(struct mem_node)))
-
-// Macro to check if two adjacent memory nodes are in the same block.
-// Checks if the end of the left node's allocated space is the start of the right node.
-#define MEM_NODES_ARE_IN_ONE_BLOCK(left, right) (GET_MEM_NODE_PTR(left) + ((struct mem_node*)left)->size == (char*)right)
-
-// Macro to merge two adjacent memory nodes.
-#define CHECK_SIDE_IN_OTHER_BLOCK(node, side) (side == NULL || ((side != NULL) && !MEM_NODES_ARE_IN_ONE_BLOCK(node, side)))
-
-// align a value to a specified alignment.
-// Ensures that the allocated memory is aligned to a certain boundary
-inline size_t __mem_align(size_t value, size_t align)
-{
-    return ((value + align - 1) & ~(align - 1));
-}
-
-#define __mem_default_align(value) __mem_align(value, 8)
-
-inline struct mem_node* __mem_MERGE_MEM_NODES(struct mem_node* base, struct mem_node* addition)
-{
-    // addition is free && nodes base and addition both in one block, else merge is impossible
-    if (MEM_NODE_IS_FREE(addition) && MEM_NODES_ARE_IN_ONE_BLOCK(base, addition)) {
-        // just change size
-        const size_t s = addition->size + sizeof(struct mem_node);
-        base->size += s;
-        base->free += s;
-
-        // and delete addition from list
-        if (addition->next != NULL) {
-            addition->next->last = base;
-            base->next = addition->next;
-        } else {
-            base->next = NULL;
-        }
-        return base;
-    }
-    return NULL;
-}
-
-// Static pointer to the first memory node in the linked list.
-// This acts as the head of the memory pool.
-static struct mem_node* __mem_node = NULL;
-
-static struct mem_node* __last_biggest_mem_node = NULL;
-
-#endif // _LIBC_STDLIB_MEM_

programs/develop/ktcc/trunk/libc.obj/source/stdlib/abort.c

@@ -1,12 +0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-#include <sys/ksys.h>
-
-void abort()
-{
-    ksys_thread_t t;
-    _ksys_thread_info(&t, -1);
-    fprintf(stderr, "\nAbort in %d\n", t.pid);
-
-    _exit(128);
-}

programs/develop/ktcc/trunk/libc.obj/source/stdlib/atexit.c

@@ -1,35 +0,0 @@
-#include <stdlib.h>
-
-struct atexit_n {
-    struct atexit_n* last;
-    void (*func)(void);
-};
-
-static struct atexit_n* __last_n = NULL;
-
-int atexit(void (*func)(void))
-{
-    struct atexit_n* n = malloc(sizeof(struct atexit_n));
-
-    if (n == NULL) {
-        return 1;
-    }
-
-    n->last = __last_n;
-    n->func = func;
-
-    __last_n = n;
-
-    return 0;
-}
-
-void __run_atexit()
-{
-    struct atexit_n* n = __last_n;
-    while (n != NULL) {
-        n->func();
-        struct atexit_n* to_free = n;
-        n = n->last;
-        free(to_free);
-    }
-}

programs/develop/ktcc/trunk/libc.obj/source/stdlib/calloc.c

@@ -1,11 +1,14 @@
+#include <errno.h>
 #include <stdlib.h>
 #include <sys/ksys.h>
 
 void* calloc(size_t num, size_t size)
 {
-    void* ptr = malloc(num * size);
-    if (ptr) {
-        memset(ptr, 0, num * size);
+    void* ptr = _ksys_alloc(num * size);
+    if (!ptr) {
+        __errno = ENOMEM;
+        return NULL;
     }
+    memset(ptr, 0, num * size);
     return ptr;
 }

programs/develop/ktcc/trunk/libc.obj/source/stdlib/exit.c

@@ -1,34 +1,12 @@
 /* Copyright (C) 2021 Logaev Maxim (turbocat2001), GPLv2 */
 
-#include <stdlib.h>
+#include <conio.h>
 #include <sys/ksys.h>
-#include "_exit.h"
-#include "_mem.h"
-
-static void __close_all()
-{
-}
-
-static void __free_all_mem()
-{
-    struct mem_node* current_node = __mem_node;
-
-    while (current_node != NULL) {
-        struct mem_node* tmp = current_node;
-        current_node = current_node->next;
-
-        free(GET_MEM_NODE_PTR(tmp));
-    }
-}
-
-void __normal_exit(int status)
-{
-    __run_atexit();
-    __close_all();
-    __free_all_mem();
-}
 
 void exit(int status)
 {
-    __libc_exit(status, &__normal_exit);
+    if (__con_is_load) {
+        con_exit(status);
+    }
+    _ksys_exit();
 }

programs/develop/ktcc/trunk/libc.obj/source/stdlib/free.c

@@ -1,97 +1,7 @@
 #include <stdlib.h>
-#include <stdbool.h>
 #include <sys/ksys.h>
-#include "_mem.h"
 
 void free(void* ptr)
 {
-    // Handle NULL pointer.
-    if (ptr == NULL)
-        return;
-
-    // Get a pointer to the mem_node header from the user data pointer.
-    struct mem_node* node = GET_MEM_NODE_HEADER(ptr);
-
-    // Mark the memory node as free.
-    node->free = node->size;
-
-    if (__last_biggest_mem_node == node) {
-        if (node->last) {
-            __last_biggest_mem_node = node->last; // anyway node will be merged with next
-                                                  // and last and last will have size = last + node + next(if its free too)
-        }
-    }
-
-    // Merge with the next node if possible.
-    if (node->next != NULL)
-        __mem_MERGE_MEM_NODES(node, node->next);
-
-    // Merge with the previous node if possible.
-    if (node->last != NULL)
-        node = __mem_MERGE_MEM_NODES(node->last, node);
-
-    if (node) {
-
-        // If the current node is not adjacent to either the next or previous node,
-        // it might be a separate block that can be freed.
-        if (MEM_NODE_IS_FREE(node) // check it because node maybe was merged with last
-            && (node->last == NULL || !MEM_NODES_ARE_IN_ONE_BLOCK(node, node->next))
-            && (node->next == NULL || !MEM_NODES_ARE_IN_ONE_BLOCK(node->last, node))) {
-
-            // Get a pointer to the mem_block header from the mem_node header.
-            struct mem_block* block = (struct mem_block*)(((char*)node) - sizeof(struct mem_block));
-
-            // Check if the block size matches the node size.
-            if (block->size == node->size + sizeof(struct mem_block) + sizeof(struct mem_node)) {
-
-                // Update the linked list pointers to remove the current node.
-                if (node->last != NULL)
-                    node->last->next = node->next;
-
-                if (node->next != NULL)
-                    node->next->last = node->last;
-
-                // Update the head of the linked list if necessary.
-                if (__mem_node == node) {
-                    if (node->last != NULL) {
-                        __mem_node = node->last;
-                    } else if (node->next != NULL) {
-                        __mem_node = node->next;
-                    } else {
-                        __mem_node = NULL;
-                    }
-                }
-
-                struct mem_node* a = node->next;
-                struct mem_node* b = node->last;
-
-                if (!a && !b) {
-                    __last_biggest_mem_node = NULL;
-                } else if (a && !b) {
-                    __last_biggest_mem_node = a;
-                } else if (!a && b) {
-                    __last_biggest_mem_node = b;
-                } else if (a && b) {
-                    __last_biggest_mem_node = (a->free > b->free) ? a : b;
-                }
-
-                if (__last_biggest_mem_node == node) {
-                    if (node->next && !(node->last)) {
-                        __last_biggest_mem_node = node->next;
-                    } else if (node->last && !(node->next)) {
-                        __last_biggest_mem_node = node->last;
-                    } else if (node->next && node->last) {
-                        if (node->last->free > node->next->free) {
-                            __last_biggest_mem_node = node->last;
-                        } else {
-                            __last_biggest_mem_node = node->next;
-                        }
-                    }
-                }
-
-                // Free the memory block using the ksys_free function.
-                _ksys_free(block);
-            }
-        }
-    }
-}
+    _ksys_free(ptr);
+}

programs/develop/ktcc/trunk/libc.obj/source/stdlib/malloc.c

@@ -1,128 +1,7 @@
-#include <string.h>
 #include <stdlib.h>
-#include <errno.h>
 #include <sys/ksys.h>
-#include <stdbool.h>
-#include "_mem.h"
-
-static struct mem_node* __new_mem_node_from_exist(struct mem_node* current_node, size_t size, bool* from_empty_node)
-{
-    struct mem_node* new_node = NULL;
-    // Check if the current node has enough free space for the requested size.
-    if (size + sizeof(struct mem_node) <= current_node->free) {
-
-        *from_empty_node = MEM_NODE_IS_FREE(current_node);
-        if (*from_empty_node) {
-            new_node = current_node;
-        } else {
-            // Calculate the used memory in current node
-            const size_t s = GET_MEM_NODE_USED_MEM(current_node);
-
-            // Create a new memory node after the current node's used space.
-            new_node = (struct mem_node*)(GET_MEM_NODE_PTR(current_node) + s);
-
-            // Update current node's size
-            current_node->size = s;
-
-            // Set the size of the new node.
-            // for new node give all free space in current node
-            new_node->size = current_node->free - sizeof(struct mem_node);
-
-            // Mark current node as used.
-            current_node->free = 0;
-        }
-    }
-    return new_node;
-}
 
 void* malloc(size_t size)
 {
-    char b[32];
-
-    // Handle zero-size allocation.
-    if (size == 0) {
-        return NULL;
-    }
-
-    // Align the size to 8 bytes.
-    size = __mem_default_align(size);
-
-    struct mem_node* current_node = __mem_node;
-    struct mem_node* new_node = NULL; // Pointer to the new node that will be created.
-    bool from_empty_node = false;
-
-    if (__last_biggest_mem_node != NULL)
-        new_node = __new_mem_node_from_exist(__last_biggest_mem_node, size, &from_empty_node); // try find free space in last created node
-
-    // if cant find in __last_biggest_mem_node
-    if (new_node == NULL) {
-        // Iterate through the linked list of memory nodes.
-        while (current_node != NULL) {
-            new_node = __new_mem_node_from_exist(current_node, size, &from_empty_node);
-            if (new_node)
-                break; // Found a suitable node, exit the loop.
-
-            current_node = current_node->next; // Move to the next node in the list.
-        }
-    }
-
-    // If no suitable node was found in the existing list:
-    if (new_node == NULL) {
-        // Calculate the size of the new block, including the mem_block header, mem_node header and alignment.
-        const size_t s = __mem_align(size + sizeof(struct mem_block) + sizeof(struct mem_node), ALLOC_BLOCK_SIZE);
-
-        // Allocate a new block of memory using the ksys_alloc function (presumably a kernel-level allocation function).
-        struct mem_block* block = (struct mem_block*)_ksys_alloc(s);
-
-        // Check if the allocation was successful.
-        if (block == NULL) {
-            __errno = ENOMEM; // Set the error number to indicate memory allocation failure.
-            return NULL;      // Return NULL to indicate allocation failure.
-        }
-
-        block->size = s;
-
-        // Create a new memory node after the mem_block header.
-        new_node = (struct mem_node*)(((char*)block) + sizeof(struct mem_block));
-
-        // Set the size of the new node.
-        new_node->size = s - sizeof(struct mem_block) - sizeof(struct mem_node);
-    }
-
-    // Set the free space in the new node.
-    new_node->free = new_node->size - size;
-
-    if (!from_empty_node) {
-        // Set the last pointer of the new node to the current node.
-        new_node->last = current_node;
-
-        // Link the new node into the linked list.
-        if (current_node != NULL) {
-            // Set the next pointer of the current node to the new node.
-            new_node->next = current_node->next;
-
-            // Update the last pointer of the next node, if it exists.
-            if (current_node->next != NULL) {
-                current_node->next->last = new_node;
-            }
-            current_node->next = new_node;
-        } else {
-            // If the current node is NULL, the new node is the first node in the list.
-            new_node->next = NULL;
-        }
-    }
-
-    // If the linked list was empty, set the head to the new node.
-    if (__mem_node == NULL) {
-        __mem_node = new_node;
-    }
-
-    if (__last_biggest_mem_node == NULL || new_node->free > __last_biggest_mem_node->free) {
-        __last_biggest_mem_node = new_node;
-    }
-
-    // Return a pointer to the user data area of the new node.
-    return GET_MEM_NODE_PTR(new_node);
-}
-
-#undef __mem_align
+    return _ksys_alloc(size);
+}

programs/develop/ktcc/trunk/libc.obj/source/stdlib/realloc.c

@@ -1,76 +1,7 @@
 #include <stdlib.h>
-#include <string.h>
 #include <sys/ksys.h>
-#include "_mem.h"
-
-// realloc mem. using if other ways not working
-static void* fail_realloc(void* ptr, size_t newsize)
-{
-    // Allocate a new block of memory with the new size.
-    void* new_ptr = malloc(newsize);
-
-    // If both the old pointer and the new pointer are not NULL:
-    if (ptr != NULL && new_ptr != NULL) {
-        // Copy the data from the old block to the new block.
-        memcpy(new_ptr, ptr, min(newsize, GET_MEM_NODE_USED_MEM(GET_MEM_NODE_HEADER(ptr))));
-    }
-
-    if (ptr) {
-        free(ptr); // Free the old block.
-    }
-
-    return new_ptr;
-}
 
 void* realloc(void* ptr, size_t newsize)
 {
-
-    void* new_ptr = NULL;
-    struct mem_node* node = NULL;
-
-    if (ptr && newsize) {
-
-        // Get a pointer to the mem_node header from the user data pointer.
-        node = GET_MEM_NODE_HEADER(ptr);
-
-        newsize = __mem_default_align(newsize);
-
-        if (node->size >= newsize) { // current node have enough mem
-                                     // it work always if newsize is smaller
-            // Update the free space in the current node.
-            node->free = node->size - newsize;
-            // Return the original pointer.
-            new_ptr = ptr;
-        } else if (node->last && MEM_NODE_IS_FREE(node->last) && node->size + node->last->size >= newsize) {
-            // So what happens here is that the node merges with the last node if their volume is sufficient.
-            // And a reallock is called in the hopes that the first condition will be met.
-            // if merge failed realloc anyway return pointer, but it will got from `fail_realloc`
-            struct mem_node* l = node->last;
-
-            l = __mem_MERGE_MEM_NODES(l, node);
-            if (l) {
-                memmove(GET_MEM_NODE_PTR(l), ptr, GET_MEM_NODE_USED_MEM(node));
-                new_ptr = realloc(GET_MEM_NODE_PTR(l), newsize);
-            }
-        }
-    }
-
-    if (new_ptr == NULL) {
-
-        // Allocate a new block of memory with the new size.
-        new_ptr = malloc(newsize);
-
-        // If both the old pointer and the new pointer are not NULL:
-        if (ptr != NULL && new_ptr != NULL) {
-            // Copy the data from the old block to the new block.
-            memcpy(new_ptr, ptr, min(newsize, GET_MEM_NODE_USED_MEM(GET_MEM_NODE_HEADER(ptr))));
-        }
-
-        if (ptr) {
-            free(ptr); // Free the old block.
-        }
-    }
-
-    // Return the new pointer.
-    return new_ptr;
+    return _ksys_realloc(ptr, newsize);
 }

programs/develop/ktcc/trunk/libc.obj/source/stdlib/system.c

@@ -1,44 +0,0 @@
-#include <stdlib.h>
-#include <stdio.h>
-#include <errno.h>
-#include <sys/ksys.h>
-#include "_exit.h"
-
-int system(const char* command)
-{
-
-    const char shell[] = "/sys/shell";
-    if (command == NULL || *command == '\0') {
-        FILE* f = fopen(shell, "r");
-        if (f) {
-            fclose(f);
-        }
-
-        return f != 0;
-    }
-
-    FILE* f = tmpfile();
-    if (!f)
-        return -1;
-
-    fputs("#SHS\n", f);
-    fputs(command, f);
-    fputs("\nexit\n", f);
-
-    int pid = _ksys_exec(shell, f->name);
-
-    fclose(f);
-
-    if (pid < 0) {
-        return -1;
-    }
-
-    // wait of end of shell
-
-    ksys_thread_t t;
-    while (_ksys_thread_info(&t, pid) != -1 && t.slot_state != 3 && t.slot_state != 4 && t.slot_state != 9) {
-        _ksys_thread_yield();
-    }
-
-    return READ_EXIT_CODE(pid, &t);
-}

programs/develop/ktcc/trunk/libc.obj/source/string/strdup.c

@@ -4,9 +4,7 @@
 char* strdup(const char* str)
 {
     char* buf = malloc(strlen(str) + 1);
-    if (buf) {
-        buf[strlen(str)] = '\0';
-        strcpy(buf, str);
-    }
+    buf[strlen(str)] = '\0';
+    strcpy(buf, str);
     return buf;
 }

programs/develop/libraries/microtar/LICENSE

@@ -1,19 +0,0 @@
-Copyright (c) 2017 rxi
-
-Permission is hereby granted, free of charge, to any person obtaining a copy of
-this software and associated documentation files (the "Software"), to deal in
-the Software without restriction, including without limitation the rights to
-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
-of the Software, and to permit persons to whom the Software is furnished to do
-so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.

programs/develop/libraries/microtar/README.md

@@ -1,99 +0,0 @@
-# microtar
-A lightweight tar library written in ANSI C
-
-
-## Basic Usage
-The library consists of `microtar.c` and `microtar.h`. These two files can be
-dropped into an existing project and compiled along with it.
-
-
-#### Reading
-```c
-mtar_t tar;
-mtar_header_t h;
-char *p;
-
-/* Open archive for reading */
-mtar_open(&tar, "test.tar", "r");
-
-/* Print all file names and sizes */
-while ( (mtar_read_header(&tar, &h)) != MTAR_ENULLRECORD ) {
-  printf("%s (%d bytes)\n", h.name, h.size);
-  mtar_next(&tar);
-}
-
-/* Load and print contents of file "test.txt" */
-mtar_find(&tar, "test.txt", &h);
-p = calloc(1, h.size + 1);
-mtar_read_data(&tar, p, h.size);
-printf("%s", p);
-free(p);
-
-/* Close archive */
-mtar_close(&tar);
-```
-
-#### Writing
-```c
-mtar_t tar;
-const char *str1 = "Hello world";
-const char *str2 = "Goodbye world";
-
-/* Open archive for writing */
-mtar_open(&tar, "test.tar", "w");
-
-/* Write strings to files `test1.txt` and `test2.txt` */
-mtar_write_file_header(&tar, "test1.txt", strlen(str1));
-mtar_write_data(&tar, str1, strlen(str1));
-mtar_write_file_header(&tar, "test2.txt", strlen(str2));
-mtar_write_data(&tar, str2, strlen(str2));
-
-/* Finalize -- this needs to be the last thing done before closing */
-mtar_finalize(&tar);
-
-/* Close archive */
-mtar_close(&tar);
-```
-
-
-## Error handling
-All functions which return an `int` will return `MTAR_ESUCCESS` if the operation
-is successful. If an error occurs an error value less-than-zero will be
-returned; this value can be passed to the function `mtar_strerror()` to get its
-corresponding error string.
-
-
-## Wrapping a stream
-If you want to read or write from something other than a file, the `mtar_t`
-struct can be manually initialized with your own callback functions and a
-`stream` pointer.
-
-All callback functions are passed a pointer to the `mtar_t` struct as their
-first argument. They should return `MTAR_ESUCCESS` if the operation succeeds
-without an error, or an integer below zero if an error occurs.
-
-After the `stream` field has been set, all required callbacks have been set and
-all unused fields have been zeroset the `mtar_t` struct can be safely used with
-the microtar functions. `mtar_open` *should not* be called if the `mtar_t`
-struct was initialized manually.
-
-#### Reading
-The following callbacks should be set for reading an archive from a stream:
-
-Name    | Arguments                                | Description
---------|------------------------------------------|---------------------------
-`read`  | `mtar_t *tar, void *data, unsigned size` | Read data from the stream
-`seek`  | `mtar_t *tar, unsigned pos`              | Set the position indicator
-`close` | `mtar_t *tar`                            | Close the stream
-
-#### Writing
-The following callbacks should be set for writing an archive to a stream:
-
-Name    | Arguments                                      | Description
---------|------------------------------------------------|---------------------
-`write` | `mtar_t *tar, const void *data, unsigned size` | Write data to the stream
-
-
-## License
-This library is free software; you can redistribute it and/or modify it under
-the terms of the MIT license. See [LICENSE](LICENSE) for details.

programs/develop/libraries/microtar/Tupfile.lua

@@ -1,8 +0,0 @@
-if tup.getconfig("NO_GCC") ~= "" then return end
-HELPERDIR = (tup.getconfig("HELPERDIR") == "") and "../../../" or tup.getconfig("HELPERDIR")
-tup.include(HELPERDIR .. "/use_gcc.lua")
-
-CFLAGS = " -c -w -nostdinc -DGNUC -DMTAR_OBJ -Os -fno-common -fno-builtin -fno-leading-underscore -fno-pie" 
-INCLUDES = " -I../include -I../../ktcc/trunk/libc.obj/include"
-
-tup.rule("microtar.c", "kos32-gcc" .. CFLAGS .. INCLUDES .. " -o %o %f " .. tup.getconfig("KPACK_CMD"), "mtar.obj")

programs/develop/libraries/microtar/example/read.asm

@@ -1,78 +0,0 @@
-format binary as "kex"
-
-use32
-        org     0x0
-        db      'MENUET01'      
-        dd      0x01            
-        dd      START           
-        dd      IM_END          
-        dd      MEM  
-        dd      MEM
-        dd      0
-        dd      0
-
-include '../../../../macros.inc'
-include '../../../../proc32.inc'
-include '../../../../KOSfuncs.inc'
-include '../../../../dll.inc'
-include '../mtar.inc'
-;include '../../../../debug-fdo.inc'
-
-;__DEBUG__               = 1
-;__DEBUG_LEVEL__         = 2   
-
-
-START:
-        stdcall dll.Load, @IMPORT ; Имортироуем функции из mtar.obj
-        test    eax, eax
-        jnz     exit
-     
-        ccall [mtar_init] ; Инициализируем библиотеку (на самом деле подгружается libc.obj
-        ccall [mtar_open], tar, tar_fname, tar_fmode ; Открываем для чтения файл 'test.tar'
-        
-       ; DEBUGF 2, "%d", eax
-        
-print_next:
-        ccall [mtar_read_header], tar, header ; Читаем заголовок
-        cmp eax, MTAR_ENULLRECORD ; Если заголовок не был прочитан (return -7) выходим из цикла
-        je exit
-        ccall [printf], format_str, header+mtar_header_t.name, dword[header+mtar_header_t.size] ; Выводим в консоль имя файла и размер в байтах
-        ccall [mtar_next], tar ; Переходим к следующему заголовку
-        jmp print_next ; прыгаем в начало цикла
-        
-exit:
-        ccall [mtar_close], tar ; Закрываем 'test.tar'
-        mcall SF_TERMINATE_PROCESS ; Выходим из программы
-        
-; data
-       
-tar_fname db 'test.tar', 0
-tar_fmode db 'r', 0
-
-tar    rb sizeof.mtar_t
-header rb sizeof.mtar_header_t 
-
-format_str db '%-10s (%-4d bytes)', 0x0A,0
-
-align 4
-
-@IMPORT:
-library mtar,   'mtar.obj', libc , 'libc.obj'
-import  mtar,   \
-        mtar_init, 'mtar_init', \
-        mtar_open, 'mtar_open', \
-        mtar_next, 'mtar_next', \
-        mtar_strerror, 'mtar_strerror', \
-        mtar_read_header, 'mtar_read_header', \
-        mtar_write_data, 'mtar_write_data', \
-        mtar_finalize, 'mtar_finalize', \
-        mtar_close, 'mtar_close'
-
-import  libc,   \
-        printf, 'printf'
-
-
-IM_END:
-align   4
-rb      4096    ; stack
-MEM:  

programs/develop/libraries/microtar/example/write.asm

@@ -1,70 +0,0 @@
-format binary as "kex"
-
-use32
-        org     0x0
-        db      'MENUET01'      
-        dd      0x01            
-        dd      START           
-        dd      IM_END          
-        dd      MEM  
-        dd      MEM
-        dd      0
-        dd      0
-
-include '../../../../macros.inc'
-include '../../../../proc32.inc'
-include '../../../../KOSfuncs.inc'
-include '../../../../dll.inc'
-include '../mtar.inc'
-;include '../../../../debug-fdo.inc'
-
-;__DEBUG__               = 1
-;__DEBUG_LEVEL__         = 2  
-
-START:
-        stdcall dll.Load, @IMPORT ; Имортироуем функции из mtar.obj
-        test    eax, eax
-        jnz     exit
-      
-        ccall [mtar_init] ; Инициализируем библиотеку (на самом деле подгружается libc.obj
-        ccall [mtar_open], tar, tar_fname, tar_fmode ; Создаём новый файл 'test.tar'
-        ccall [mtar_write_file_header], tar, test1_txt , str1_len ; Создаём внутри 'test.tar' пустрой файл 'test1.txt'
-        
-        ccall [mtar_write_data], tar, str1,  str1_len ; Записываем данныев в этот файл
-        
-        ccall [mtar_finalize], tar  ; Указываем что больше с tar работать не будем
-        ccall [mtar_close], tar ; Закрываем 'test.tar'
-        
-exit:
-        mcall   SF_TERMINATE_PROCESS ; Выходим из программы
-        
-; data
-
-str1 db 'Hello world!', 0
-str1_len = $ - str1
-
-str2 db 'Goodbye world!', 0
-       
-tar_fname db 'test.tar', 0
-tar_fmode db 'w', 0
-
-test1_txt db 'test1.txt', 0
-
-tar rb 32 
-
-align 4
-
-@IMPORT:
-library mtar,   'mtar.obj'
-import  mtar,   \
-        mtar_init, 'mtar_init', \
-        mtar_open, 'mtar_open', \
-        mtar_write_file_header, 'mtar_write_file_header', \
-        mtar_write_data, 'mtar_write_data', \
-        mtar_finalize, 'mtar_finalize', \
-        mtar_close, 'mtar_close'
-
-IM_END:
-align   4
-rb      4096    ; stack
-MEM:  

programs/develop/libraries/microtar/microtar.c

@@ -1,450 +0,0 @@
-/*
- * Copyright (c) 2017 rxi
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to
- * deal in the Software without restriction, including without limitation the
- * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
- * sell copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
- * IN THE SOFTWARE.
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <stddef.h>
-#include <string.h>
-
-#include <sys/ksys.h>
-
-#include "microtar.h"
-
-typedef struct {
-  char name[100];
-  char mode[8];
-  char owner[8];
-  char group[8];
-  char size[12];
-  char mtime[12];
-  char checksum[8];
-  char type;
-  char linkname[100];
-  char _padding[255];
-} mtar_raw_header_t;
-
-static void * mtar_memset( void * s, int c, size_t n ){
-  unsigned char * p = ( unsigned char * ) s;
-  while ( n-- ){
-      *p++ = ( unsigned char ) c;
-  }
-  return s;
-}
-
-#ifdef MTAR_OBJ
-// All pointers was changed for compatible to latest version tcc and the libc.obj headers
-size_t (*_fread)(void *restrict, size_t size, size_t count, FILE *restrict)=NULL;
-size_t (*_fwrite)(const void *restrict, size_t size, size_t count, FILE *restrict)=NULL;
-int    (*_fclose)(FILE *)=NULL;
-FILE*  (*_fopen)(const char *restrict, const char *restrict)=NULL;
-int    (*_fseek)(FILE *, long, int)=NULL;
-long   (*_ftell)(FILE *)=NULL;
-int    (*_sprintf)(char* buffer, const char* format, ...)=NULL;
-int    (*_sscanf)(const char*, const char *restrict, ...)=NULL;
-int    (*_strcmp)(const char * s1, const char* s2)=NULL;
-char*  (*_strchr)(const char* s, int c)=NULL;
-char*  (*_strcpy)(char*  s1, const char* s2)=NULL;
-
-#endif
-
-static unsigned round_up(unsigned n, unsigned incr) {
-  return n + (incr - n % incr) % incr;
-}
-
-
-static unsigned checksum(const mtar_raw_header_t* rh) {
-  unsigned i;
-  unsigned char *p = (unsigned char*) rh;
-  unsigned res = 256;
-  for (i = 0; i < offsetof(mtar_raw_header_t, checksum); i++) {
-    res += p[i];
-  }
-  for (i = offsetof(mtar_raw_header_t, type); i < sizeof(*rh); i++) {
-    res += p[i];
-  }
-  return res;
-}
-
-
-static int tread(mtar_t *tar, void *data, unsigned size) {
-  int err = tar->read(tar, data, size);
-  tar->pos += size;
-  return err;
-}
-
-
-static int twrite(mtar_t *tar, const void *data, unsigned size) {
-
-  int err = tar->write(tar, data, size);
-  tar->pos += size;
-  return err;
-}
-
-
-static int write_null_bytes(mtar_t *tar, int n) {
-  int i, err;
-  char nul = '\0';
-  for (i = 0; i < n; i++) {
-    err = twrite(tar, &nul, 1);
-    if (err) {
-      return err;
-    }
-  }
-  return MTAR_ESUCCESS;
-}
-
-
-static int raw_to_header(mtar_header_t *h, const mtar_raw_header_t *rh) {
-  unsigned chksum1, chksum2;
-
-  /* If the checksum starts with a null byte we assume the record is NULL */
-  if (*rh->checksum == '\0') {
-    return MTAR_ENULLRECORD;
-  }
-
-  /* Build and compare checksum */
-  chksum1 = checksum(rh);
-  _sscanf(rh->checksum, "%o", &chksum2);
-  if (chksum1 != chksum2) {
-    return MTAR_EBADCHKSUM;
-  }
-
-  /* Load raw header into header */
-  _sscanf(rh->mode, "%o", &h->mode);
-  _sscanf(rh->owner, "%o", &h->owner);
-  _sscanf(rh->size, "%o", &h->size);
-  _sscanf(rh->mtime, "%o", &h->mtime);
-  h->type = rh->type;
-  _strcpy(h->name, rh->name);
-  _strcpy(h->linkname, rh->linkname);
-
-  return MTAR_ESUCCESS;
-}
-
-
-static int header_to_raw(mtar_raw_header_t *rh, const mtar_header_t *h) {
-  unsigned chksum;
-
-  /* Load header into raw header */
-  mtar_memset(rh, 0, sizeof(*rh));
-  _sprintf(rh->mode, "%o", h->mode);
-  _sprintf(rh->owner, "%o", h->owner);
-  _sprintf(rh->size, "%o", h->size);
-  _sprintf(rh->mtime, "%o", h->mtime);
-  rh->type = h->type ? h->type : MTAR_TREG;
-  _strcpy(rh->name, h->name);
-  _strcpy(rh->linkname, h->linkname);
-
-  /* Calculate and write checksum */
-  chksum = checksum(rh);
-  _sprintf(rh->checksum, "%06o", chksum);
-  rh->checksum[7] = ' ';
-
-  return MTAR_ESUCCESS;
-}
-
-
-const char* mtar_strerror(int err) {
-  switch (err) {
-    case MTAR_ESUCCESS     : return "success";
-    case MTAR_EFAILURE     : return "failure";
-    case MTAR_EOPENFAIL    : return "could not open";
-    case MTAR_EREADFAIL    : return "could not read";
-    case MTAR_EWRITEFAIL   : return "could not write";
-    case MTAR_ESEEKFAIL    : return "could not seek";
-    case MTAR_EBADCHKSUM   : return "bad checksum";
-    case MTAR_ENULLRECORD  : return "null record";
-    case MTAR_ENOTFOUND    : return "file not found";
-  }
-  return "unknown error";
-}
-
-
-static int file_write(mtar_t *tar, const void *data, unsigned size) {
-  unsigned res = _fwrite(data, 1, size, tar->stream);
-  return (res == size) ? MTAR_ESUCCESS : MTAR_EWRITEFAIL;
-}
-
-static int file_read(mtar_t *tar, void *data, unsigned size) {
-  unsigned res = _fread(data, 1, size, tar->stream);
-  return (res == size) ? MTAR_ESUCCESS : MTAR_EREADFAIL;
-}
-
-static int file_seek(mtar_t *tar, unsigned offset) {
-    int res = _fseek(tar->stream, offset, SEEK_SET);
-  return (res == 0) ? MTAR_ESUCCESS : MTAR_ESEEKFAIL;
-}
-
-static int file_close(mtar_t *tar) {
-  _fclose(tar->stream);
-  return MTAR_ESUCCESS;
-}
-
-
-int mtar_open(mtar_t *tar, const char *filename, const char *mode) {
-  int err;
-  mtar_header_t h;
-
-  /* Init tar struct and functions */
-  mtar_memset(tar, 0, sizeof(*tar));
-  tar->write = file_write;
-  tar->read = file_read;
-  tar->seek = file_seek;
-  tar->close = file_close;
-
-  /* Assure mode is always binary */
-  if ( _strchr(mode, 'r') ) mode = "rb";
-  if ( _strchr(mode, 'w') ) mode = "wb";
-  if ( _strchr(mode, 'a') ) mode = "ab";
-  /* Open file */
-  tar->stream = _fopen(filename, mode);
-  if (!tar->stream) {
-    return MTAR_EOPENFAIL;
-  }
-  /* Read first header to check it is valid if mode is `r` */
-  if (*mode == 'r') {
-    err = mtar_read_header(tar, &h);
-    if (err != MTAR_ESUCCESS) {
-      mtar_close(tar);
-      return err;
-    }
-  }
-
-  /* Return ok */
-  return MTAR_ESUCCESS;
-}
-
-
-int mtar_close(mtar_t *tar) {
-  return tar->close(tar);
-}
-
-
-int mtar_seek(mtar_t *tar, unsigned pos) {
-  int err = tar->seek(tar, pos);
-  tar->pos = pos;
-  return err;
-}
-
-
-int mtar_rewind(mtar_t *tar) {
-  tar->remaining_data = 0;
-  tar->last_header = 0;
-  return mtar_seek(tar, 0);
-}
-
-
-int mtar_next(mtar_t *tar) {
-  int err, n;
-  mtar_header_t h;
-  /* Load header */
-  err = mtar_read_header(tar, &h);
-  if (err) {
-    return err;
-  }
-  /* Seek to next record */
-  n = round_up(h.size, 512) + sizeof(mtar_raw_header_t);
-  return mtar_seek(tar, tar->pos + n);
-}
-
-
-int mtar_find(mtar_t *tar, const char *name, mtar_header_t *h) {
-  int err;
-  mtar_header_t header;
-  /* Start at beginning */
-  err = mtar_rewind(tar);
-  if (err) {
-    return err;
-  }
-  /* Iterate all files until we hit an error or find the file */
-  while ( (err = mtar_read_header(tar, &header)) == MTAR_ESUCCESS ) {
-    if ( !_strcmp(header.name, name) ) {
-      if (h) {
-        *h = header;
-      }
-      return MTAR_ESUCCESS;
-    }
-    mtar_next(tar);
-  }
-  /* Return error */
-  if (err == MTAR_ENULLRECORD) {
-    err = MTAR_ENOTFOUND;
-  }
-  return err;
-}
-
-
-int mtar_read_header(mtar_t *tar, mtar_header_t *h) {
-  int err;
-  mtar_raw_header_t rh;
-  /* Save header position */
-  tar->last_header = tar->pos;
-  /* Read raw header */
-  err = tread(tar, &rh, sizeof(rh));
-  if (err) {
-    return err;
-  }
-  /* Seek back to start of header */
-  err = mtar_seek(tar, tar->last_header);
-  if (err) {
-    return err;
-  }
-  /* Load raw header into header struct and return */
-  return raw_to_header(h, &rh);
-}
-
-
-int mtar_read_data(mtar_t *tar, void *ptr, unsigned size) {
-  int err;
-  /* If we have no remaining data then this is the first read, we get the size,
-   * set the remaining data and seek to the beginning of the data */
-  if (tar->remaining_data == 0) {
-    mtar_header_t h;
-    /* Read header */
-    err = mtar_read_header(tar, &h);
-    if (err) {
-      return err;
-    }
-    /* Seek past header and init remaining data */
-    err = mtar_seek(tar, tar->pos + sizeof(mtar_raw_header_t));
-    if (err) {
-      return err;
-    }
-    tar->remaining_data = h.size;
-  }
-  /* Read data */
-  err = tread(tar, ptr, size);
-  if (err) {
-    return err;
-  }
-  tar->remaining_data -= size;
-  /* If there is no remaining data we've finished reading and seek back to the
-   * header */
-  if (tar->remaining_data == 0) {
-    return mtar_seek(tar, tar->last_header);
-  }
-  return MTAR_ESUCCESS;
-}
-
-
-int mtar_write_header(mtar_t *tar, const mtar_header_t *h) {
-  mtar_raw_header_t rh;
-  /* Build raw header and write */
-  header_to_raw(&rh, h);
-  tar->remaining_data = h->size;
-  return twrite(tar, &rh, sizeof(rh));
-}
-
-int mtar_write_file_header(mtar_t *tar, const char *name, unsigned size) {
-  mtar_header_t h;
-  /* Build header */
-  mtar_memset(&h, 0, sizeof(h));
-  _strcpy(h.name, name);
-  h.size = size;
-  h.type = MTAR_TREG;
-  h.mode = 0664;
-  /* Write header */
-  return mtar_write_header(tar, &h);
-}
-
-
-int mtar_write_dir_header(mtar_t *tar, const char *name) {
-  mtar_header_t h;
-  /* Build header */
-  mtar_memset(&h, 0, sizeof(h));
-  _strcpy(h.name, name);
-  h.type = MTAR_TDIR;
-  h.mode = 0775;
-  /* Write header */
-  return mtar_write_header(tar, &h);
-}
-
-
-int mtar_write_data(mtar_t *tar, const void *data, unsigned size) {
-  int err;
-  /* Write data */
-  err = twrite(tar, data, size);
-  if (err) {
-    return err;
-  }
-  tar->remaining_data -= size;
-  /* Write padding if we've written all the data for this file */
-  if (tar->remaining_data == 0) {
-    return write_null_bytes(tar, round_up(tar->pos, 512) - tar->pos);
-  }
-  return MTAR_ESUCCESS;
-}
-
-
-int mtar_finalize(mtar_t *tar) {
-  /* Write two NULL records */
-  return write_null_bytes(tar, sizeof(mtar_raw_header_t) * 2);
-}
-
-/* Load libc.obj */
-
-#ifdef MTAR_OBJ
-
-#include <sys/ksys.h>
-
-int mtar_init(){
-  ksys_dll_t *libc = _ksys_dlopen("/sys/lib/libc.obj");
-  if(!libc){
-    _ksys_debug_puts("mtar.obj: libc.obj not loaded!");
-    return 1;
-  }
-
-  _fread  = _ksys_dlsym(libc, "fread");
-  _fwrite = _ksys_dlsym(libc, "fwrite");
-  _fclose = _ksys_dlsym(libc, "fclose");
-  _fopen  = _ksys_dlsym(libc, "fopen");
-  _fseek  = _ksys_dlsym(libc, "fseek");
-  _ftell  = _ksys_dlsym(libc, "ftell");
-  _sprintf= _ksys_dlsym(libc, "sprintf");
-  _sscanf = _ksys_dlsym(libc, "sscanf");
-  _strcmp = _ksys_dlsym(libc, "strcmp");
-  _strchr = _ksys_dlsym(libc, "strchr");
-  _strcpy = _ksys_dlsym(libc, "strcpy");
-  return 0;
-}
-
-
-ksys_dll_t EXPORTS[] = {
-  {"mtar_init", mtar_init},
-  {"mtar_open", mtar_open},
-  {"mtar_close", mtar_close},
-  {"mtar_seek", mtar_seek},
-  {"mtar_rewind", mtar_rewind},
-  {"mtar_next", mtar_next},
-  {"mtar_find", mtar_find},
-  {"mtar_read_header", mtar_read_header},
-  {"mtar_read_data", mtar_read_data},
-  {"mtar_write_header", mtar_write_header},
-  {"mtar_write_file_header", mtar_write_file_header},
-  {"mtar_write_dir_header",  mtar_write_dir_header},
-  {"mtar_write_data",mtar_write_data},
-  {"mtar_finalize", mtar_finalize},
-  {"mtar_strerror", mtar_strerror},
-  NULL
-};
-
-#endif

programs/develop/libraries/microtar/microtar.h

@@ -1,91 +0,0 @@
-/**
- * Copyright (c) 2017 rxi
- *
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the MIT license. See `microtar.c` for details.
- */
-
-#ifndef MICROTAR_H
-#define MICROTAR_H
-
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#define MTAR_VERSION "0.1.0"
-
-enum {
-  MTAR_ESUCCESS     =  0,
-  MTAR_EFAILURE     = -1,
-  MTAR_EOPENFAIL    = -2,
-  MTAR_EREADFAIL    = -3,
-  MTAR_EWRITEFAIL   = -4,
-  MTAR_ESEEKFAIL    = -5,
-  MTAR_EBADCHKSUM   = -6,
-  MTAR_ENULLRECORD  = -7,
-  MTAR_ENOTFOUND    = -8
-};
-
-enum {
-  MTAR_TREG   = '0',
-  MTAR_TLNK   = '1',
-  MTAR_TSYM   = '2',
-  MTAR_TCHR   = '3',
-  MTAR_TBLK   = '4',
-  MTAR_TDIR   = '5',
-  MTAR_TFIFO  = '6'
-};
-
-typedef struct {
-  unsigned mode;
-  unsigned owner;
-  unsigned size;
-  unsigned mtime;
-  unsigned type;
-  char name[100];
-  char linkname[100];
-} mtar_header_t;
-
-
-typedef struct mtar_t mtar_t;
-
-#pragma pack(push,1)
-struct mtar_t {
-  int (*read)(mtar_t *tar, void *data, unsigned size);
-  int (*write)(mtar_t *tar, const void *data, unsigned size);
-  int (*seek)(mtar_t *tar, unsigned pos);
-  int (*close)(mtar_t *tar);
-  void *stream;
-  unsigned pos;
-  unsigned remaining_data;
-  unsigned last_header;
-};
-#pragma pack(pop)
-
-const char* mtar_strerror(int err);
-
-int mtar_open(mtar_t *tar, const char *filename, const char *mode);
-int mtar_close(mtar_t *tar);
-
-int mtar_seek(mtar_t *tar, unsigned pos);
-int mtar_rewind(mtar_t *tar);
-int mtar_next(mtar_t *tar);
-int mtar_find(mtar_t *tar, const char *name, mtar_header_t *h);
-int mtar_read_header(mtar_t *tar, mtar_header_t *h);
-int mtar_read_data(mtar_t *tar, void *ptr, unsigned size);
-
-int mtar_write_header(mtar_t *tar, const mtar_header_t *h);
-int mtar_write_file_header(mtar_t *tar, const char *name, unsigned size);
-int mtar_write_dir_header(mtar_t *tar, const char *name);
-int mtar_write_data(mtar_t *tar, const void *data, unsigned size);
-int mtar_finalize(mtar_t *tar);
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif

programs/develop/libraries/microtar/mtar.inc

@@ -1,38 +0,0 @@
-MTAR_ESUCCESS     =  0
-MTAR_EFAILURE     = -1
-MTAR_EOPENFAIL    = -2
-MTAR_EREADFAIL    = -3
-MTAR_EWRITEFAIL   = -4
-MTAR_ESEEKFAIL    = -5
-MTAR_EBADCHKSUM   = -6
-MTAR_ENULLRECORD  = -7
-MTAR_ENOTFOUND    = -8
-
-MTAR_TREG   = '0'
-MTAR_TLNK   = '1'
-MTAR_TSYM   = '2'
-MTAR_TCHR   = '3'
-MTAR_TBLK   = '4'
-MTAR_TDIR   = '5'
-MTAR_TFIFO  = '6'
-
-struct mtar_header_t
-  mode      dd ?
-  owner     dd ?
-  size      dd ?
-  mtime     dd ?
-  type      dd ?
-  name      rb 100
-  linkname  rb 100
-ends
-
-struct mtar_t 
-  read_func       dd ? 
-  write_func      dd ?
-  seek_func       dd ?
-  close_func      dd ?
-  stream          dd ?
-  pos             dd ?
-  remaining_data  dd ?
-  last_header     dd ?
-ends

programs/develop/oberon07/LICENSE

@@ -1,25 +0,0 @@
-BSD 2-Clause License
-
-Copyright (c) 2018-2023, Anton Krotov
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
-  this list of conditions and the following disclaimer in the documentation
-  and/or other materials provided with the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

programs/develop/oberon07/doc/CC.txt

@@ -1,61 +0,0 @@
-Условная компиляция
-
-синтаксис:
-
-    $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

programs/develop/oberon07/doc/KOSLib.txt

@@ -1,566 +0,0 @@
-==============================================================================
-
-        Библиотека (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
-------------------------------------------------------------------------------

programs/develop/oberon07/doc/x86.txt

@@ -1,423 +0,0 @@
-        Компилятор языка программирования 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 вывести список импортированных модулей
-
-      параметр -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.

programs/develop/oberon07/lib/KolibriOS/API.ob07

@@ -1,290 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Args.ob07

@@ -1,100 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/ColorDlg.ob07

@@ -1,105 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Console.ob07

@@ -1,94 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/ConsoleLib.ob07

@@ -1,103 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/DateTime.ob07

@@ -1,141 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Debug.ob07

@@ -1,292 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/File.ob07

@@ -1,330 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/HOST.ob07

@@ -1,553 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/In.ob07

@@ -1,282 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/KOSAPI.ob07

@@ -1,436 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Math.ob07

@@ -1,449 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/NetDevices.ob07

@@ -1,107 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/OpenDlg.ob07

@@ -1,158 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Out.ob07

@@ -1,267 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/RTL.ob07

@@ -1,543 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/RasterWorks.ob07

@@ -1,124 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Read.ob07

@@ -1,46 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/UnixTime.ob07

@@ -1,64 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Vector.ob07

@@ -1,121 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/Write.ob07

@@ -1,46 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/kfonts.ob07

@@ -1,492 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/KolibriOS/libimg.ob07

@@ -1,435 +0,0 @@
-(*
-    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.

programs/develop/oberon07/lib/Math/CMath.ob07

@@ -1,462 +0,0 @@
-(* ***********************************************
-    Модуль работы с комплексными числами.
-    Вадим Исаев, 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.

programs/develop/oberon07/lib/Math/MathBits.ob07

@@ -1,33 +0,0 @@
-(* ****************************************
-   Дополнение к модулю 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.

programs/develop/oberon07/lib/Math/MathRound.ob07

@@ -1,99 +0,0 @@
-(* ******************************************
-   Дополнительные функции к модулю 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.

programs/develop/oberon07/lib/Math/MathStat.ob07

@@ -1,238 +0,0 @@
-(* ********************************************
-   Дополнение к модулю 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.

programs/develop/oberon07/lib/Math/Rand.ob07

@@ -1,81 +0,0 @@
-(* ************************************
-   Генератор какбыслучайных чисел,
-   Линейный конгруэнтный метод,
-   алгоритм Лемера.
-   Вадим Исаев, 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;
-
-
-(* Целые какбыслучайные числа до RAND_MAX *)
-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 до l.
-   Return a random number in a range 0 ... l *)
-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)) + 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.

programs/develop/oberon07/lib/Math/RandExt.ob07

@@ -1,298 +0,0 @@
-(* ************************************************************
-   Дополнительные алгоритмы генераторов какбыслучайных чисел.
-   Вадим Исаев, 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.

programs/develop/oberon07/samples/BUILD_ALL.SH

@@ -1,5 +0,0 @@
-#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

programs/develop/oberon07/samples/Dialogs.ob07

@@ -1,159 +0,0 @@
-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.

programs/develop/oberon07/samples/HW.ob07

@@ -1,78 +0,0 @@
-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.