forked from KolibriOS/kolibrios
Compare commits
18 Commits
egor00f-pa
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| 91dc4d8cad | |||
| 6f2a947deb | |||
| 735b86c476 | |||
| cc1034d849 | |||
| 06c1497624 | |||
| b52da3e1c3 | |||
|
|
f9425f5bd0 | ||
| 864210679c | |||
| 7f8e028ffd | |||
| e9b6cf3fc9 | |||
| 4658a928d4 | |||
| b6a5171cd9 | |||
|
|
668fd4deeb | ||
| dd9a7b92d8 | |||
|
|
1173ca7b26 | ||
| ccd0c183ec | |||
| f065cc6e69 | |||
| f1b99bad84 |
@@ -29,6 +29,7 @@ jobs:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
submodules: true
|
||||
fetch-depth: 0
|
||||
|
||||
- name: Get describe
|
||||
|
||||
3
.gitmodules
vendored
Normal file
3
.gitmodules
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
[submodule "programs/develop/oberon07"]
|
||||
path = programs/develop/oberon07
|
||||
url = https://github.com/AntKrotov/oberon-07-compiler.git
|
||||
@@ -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"},
|
||||
@@ -722,6 +726,7 @@ tup.append_table(img_files, {
|
||||
{"SHELL", VAR_PROGS .. "/system/shell/shell"},
|
||||
{"GAMES/DINO", VAR_PROGS .. "/games/dino/dino"},
|
||||
{"GAMES/FLPYBIRD", VAR_PROGS .. "/games/flpybird/flpybird"},
|
||||
{"LIB/LIBC.OBJ", VAR_PROGS .. "/develop/ktcc/trunk/libc.obj/source/libc.obj"},
|
||||
})
|
||||
tup.append_table(extra_files, {
|
||||
{"kolibrios/utils/thashview", VAR_PROGS .. "/other/TinyHashView/thashview"},
|
||||
@@ -730,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"},
|
||||
@@ -740,14 +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/LIBC.OBJ", VAR_PROGS .. "/develop/ktcc/trunk/libc.obj/source/libc.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"},
|
||||
|
||||
Binary file not shown.
@@ -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 - работа с файловой системой с указанием кодировки. ===
|
||||
======================================================================
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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
|
||||
|
||||
Binary file not shown.
@@ -47,3 +47,9 @@
|
||||
перемещение по тексту:
|
||||
(ctrl+)Home, (ctrl+)End, (ctrl+)PageUp, (ctrl+)PageDown
|
||||
ctrl+Left, ctrl+Right
|
||||
|
||||
перемещение в панели поиска:
|
||||
Tab к следующему полю ввода
|
||||
Shift-Tab к предыдущему полю ввода
|
||||
Enter поиск следующего вхождения
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@ IMPORT
|
||||
RW, Ini, EB := EditBox, Tabs, Toolbar, SB := StatusBar;
|
||||
|
||||
CONST
|
||||
HEADER = "CEdit (30-apr-2025)";
|
||||
HEADER = "CEdit (11-jan-2026)";
|
||||
|
||||
ShellFilter = "";
|
||||
EditFilter = "sh|inc|txt|asm|ob07|c|cpp|h|pas|pp|lua|ini|json";
|
||||
@@ -1750,7 +1750,15 @@ BEGIN
|
||||
ELSE
|
||||
IF EditBox_Focus(FindEdit) THEN
|
||||
IF keyCode = 15 THEN (* Tab *)
|
||||
SetFocus(ReplaceEdit, TRUE)
|
||||
IF shift THEN
|
||||
SetFocus(GotoEdit, TRUE)
|
||||
ELSE
|
||||
SetFocus(ReplaceEdit, TRUE)
|
||||
END
|
||||
ELSIF keyCode = 28 THEN (* Enter *)
|
||||
IF searchOpened & (searchText # "") THEN
|
||||
notFound := ~T.findNext(text, BKW.value)
|
||||
END
|
||||
ELSE
|
||||
EB.key(FindEdit, key);
|
||||
EditBox_Get(FindEdit, new_searchText);
|
||||
@@ -1761,14 +1769,26 @@ BEGIN
|
||||
END
|
||||
ELSIF EditBox_Focus(ReplaceEdit) THEN
|
||||
IF keyCode = 15 THEN (* Tab *)
|
||||
SetFocus(GotoEdit, TRUE)
|
||||
IF shift THEN
|
||||
SetFocus(FindEdit, TRUE)
|
||||
ELSE
|
||||
SetFocus(GotoEdit, TRUE)
|
||||
END
|
||||
ELSIF keyCode = 28 THEN (* Enter *)
|
||||
IF searchOpened & (searchText # "") THEN
|
||||
notFound := ~T.findNext(text, BKW.value)
|
||||
END
|
||||
ELSE
|
||||
EB.key(ReplaceEdit, key);
|
||||
EditBox_Get(ReplaceEdit, replaceText)
|
||||
END
|
||||
ELSIF EditBox_Focus(GotoEdit) THEN
|
||||
IF keyCode = 15 THEN (* Tab *)
|
||||
SetFocus(FindEdit, TRUE)
|
||||
IF shift THEN
|
||||
SetFocus(ReplaceEdit, TRUE)
|
||||
ELSE
|
||||
SetFocus(FindEdit, TRUE)
|
||||
END
|
||||
ELSE
|
||||
IF (key DIV 256) MOD 256 = 13 THEN
|
||||
goto
|
||||
|
||||
9
programs/develop/cedit/Tupfile.lua
Normal file
9
programs/develop/cedit/Tupfile.lua
Normal file
@@ -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");
|
||||
@@ -172,7 +172,7 @@ else
|
||||
end if
|
||||
}
|
||||
|
||||
include 'kosfuncs.inc'
|
||||
include '../../KOSfuncs.inc'
|
||||
include '../../macros.inc'
|
||||
|
||||
include 'font.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
|
||||
@@ -32,6 +32,7 @@ DLLAPI char* strrchr(const char* s, int c);
|
||||
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);
|
||||
|
||||
@@ -203,7 +203,9 @@ ksys_dll_t EXPORTS[] = {
|
||||
{ "strspn", &strspn },
|
||||
{ "strstr", &strstr },
|
||||
{ "strtok", &strtok },
|
||||
{ "strtok_r", &strtok_r },
|
||||
{ "strxfrm", &strxfrm },
|
||||
{ "strpbrk", &strpbrk },
|
||||
{ "__errno", &__errno },
|
||||
{ "closedir", &closedir },
|
||||
{ "opendir", &opendir },
|
||||
|
||||
@@ -1,14 +1,12 @@
|
||||
/* Copyright (C) 1994 DJ Delorie, see COPYING.DJ for details */
|
||||
#include <string.h>
|
||||
|
||||
char* strtok(char* s, const char* delim)
|
||||
char* strtok_r(char* s, const char* delim, char** last)
|
||||
{
|
||||
const char* spanp;
|
||||
char *spanp, *tok;
|
||||
int c, sc;
|
||||
char* tok;
|
||||
static char* last;
|
||||
|
||||
if (s == NULL && (s = last) == NULL)
|
||||
if (s == NULL && (s = *last) == NULL)
|
||||
return (NULL);
|
||||
|
||||
/*
|
||||
@@ -16,13 +14,13 @@ char* strtok(char* s, const char* delim)
|
||||
*/
|
||||
cont:
|
||||
c = *s++;
|
||||
for (spanp = delim; (sc = *spanp++) != 0;) {
|
||||
for (spanp = (char*)delim; (sc = *spanp++) != 0;) {
|
||||
if (c == sc)
|
||||
goto cont;
|
||||
}
|
||||
|
||||
if (c == 0) { /* no non-delimiter characters */
|
||||
last = NULL;
|
||||
*last = NULL;
|
||||
return (NULL);
|
||||
}
|
||||
tok = s - 1;
|
||||
@@ -33,17 +31,24 @@ cont:
|
||||
*/
|
||||
for (;;) {
|
||||
c = *s++;
|
||||
spanp = delim;
|
||||
spanp = (char*)delim;
|
||||
do {
|
||||
if ((sc = *spanp++) == c) {
|
||||
if (c == 0)
|
||||
s = NULL;
|
||||
else
|
||||
s[-1] = 0;
|
||||
last = s;
|
||||
s[-1] = '\0';
|
||||
*last = s;
|
||||
return (tok);
|
||||
}
|
||||
} while (sc != 0);
|
||||
}
|
||||
/* NOTREACHED */
|
||||
}
|
||||
|
||||
char *strtok(char *s, const char *delim)
|
||||
{
|
||||
static char *last;
|
||||
|
||||
return (strtok_r(s, delim, &last));
|
||||
}
|
||||
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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")
|
||||
@@ -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:
|
||||
@@ -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:
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -122,7 +122,13 @@ struc fpcvt
|
||||
.sizeof:
|
||||
}
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Command flags
|
||||
|
||||
CMD_WITHOUT_PARAM = 1b ; command may be called without parameters
|
||||
CMD_WITH_PARAM = 10b ; command may be called with parameters
|
||||
CMD_WITHOUT_LOADED_APP = 100b ; command may be called without loaded program
|
||||
CMD_WITH_LOADED_APP = 1000b ; command may be called with loaded program
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Entry point
|
||||
@@ -449,63 +455,56 @@ z1:
|
||||
mov esi, commands
|
||||
call find_cmd
|
||||
mov eax, aUnknownCommand
|
||||
jc .x11
|
||||
|
||||
; check command requirements
|
||||
; flags field:
|
||||
; &1: command may be called without parameters
|
||||
; &2: command may be called with parameters
|
||||
; &4: command may be called without loaded program
|
||||
; &8: command may be called with loaded program
|
||||
jc .cmd_procg
|
||||
mov eax, [esi+8]
|
||||
mov ecx, [curarg]
|
||||
cmp byte [ecx], 0
|
||||
jz .noargs
|
||||
test byte [esi+16], 2
|
||||
jz .x11
|
||||
test byte [esi+16], CMD_WITH_PARAM
|
||||
jz .cmd_procg
|
||||
jmp @f
|
||||
|
||||
.noargs:
|
||||
test byte [esi+16], 1
|
||||
jz .x11
|
||||
test byte [esi+16], CMD_WITHOUT_PARAM
|
||||
jz .cmd_procg
|
||||
|
||||
@@:
|
||||
cmp [debuggee_pid], 0
|
||||
jz .nodebuggee
|
||||
mov eax, aAlreadyLoaded
|
||||
test byte [esi+16], 8
|
||||
jz .x11
|
||||
jmp .x9
|
||||
test byte [esi+16], CMD_WITH_LOADED_APP
|
||||
jz .cmd_procg
|
||||
jmp .run_cmd
|
||||
|
||||
.nodebuggee:
|
||||
mov eax, need_debuggee
|
||||
test byte [esi+16], 4
|
||||
jnz .x9
|
||||
test byte [esi+16], CMD_WITHOUT_LOADED_APP
|
||||
jnz .run_cmd
|
||||
|
||||
.x11:
|
||||
.cmd_procg:
|
||||
xchg esi, eax
|
||||
call put_message
|
||||
|
||||
; store cmdline for repeating
|
||||
.x10:
|
||||
.cmd_procg_no_put_msg:
|
||||
mov esi, cmdline
|
||||
mov ecx, [cmdline_len]
|
||||
|
||||
@@:
|
||||
cmp ecx, 0
|
||||
jle .we
|
||||
jle .wait_event
|
||||
mov al, [esi + ecx]
|
||||
mov [cmdline_prev + ecx], al
|
||||
dec ecx
|
||||
jmp @b
|
||||
|
||||
.we:
|
||||
.wait_event:
|
||||
mov [cmdline_len], 0
|
||||
jmp waitevent
|
||||
|
||||
.x9:
|
||||
.run_cmd:
|
||||
call dword [esi+4]
|
||||
jmp .x10
|
||||
jmp .cmd_procg_no_put_msg
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Cmdline handling
|
||||
|
||||
@@ -2,7 +2,10 @@
|
||||
COLOR_THEME fix MOVIEOS
|
||||
|
||||
format binary as ""
|
||||
|
||||
include '../../macros.inc'
|
||||
include '../../KOSfuncs.inc'
|
||||
|
||||
use32
|
||||
db 'MENUET01'
|
||||
dd 1
|
||||
@@ -1145,6 +1148,105 @@ OnDump:
|
||||
.ret:
|
||||
ret
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Print Backtrace
|
||||
|
||||
struct STACK_FRAME
|
||||
prev_frame rd 1
|
||||
ret_addr rd 1
|
||||
ends
|
||||
|
||||
OnBacktrace:
|
||||
push ebp
|
||||
|
||||
; Set max depth counter
|
||||
xor eax, eax
|
||||
dec eax
|
||||
|
||||
mov esi, [curarg]
|
||||
cmp byte [esi], 0
|
||||
jz .save_depth
|
||||
|
||||
call get_hex_number
|
||||
mov esi, aParseError
|
||||
jc .exit
|
||||
|
||||
; If depth 0
|
||||
test eax, eax
|
||||
jz .done
|
||||
|
||||
.save_depth:
|
||||
mov [bt_depth], eax
|
||||
|
||||
; Get start frame addres
|
||||
mov ebp, [_ebp]
|
||||
test ebp, ebp
|
||||
jz .done
|
||||
|
||||
mov edi, stack_frame_dump
|
||||
|
||||
.next:
|
||||
mcall SF_DEBUG, SSF_READ_MEMORY, [debuggee_pid], sizeof.STACK_FRAME, ebp
|
||||
cmp eax, -1
|
||||
mov esi, read_mem_err
|
||||
jz .exit
|
||||
|
||||
; The address of the previous frame must be less than the current one
|
||||
mov eax, [edi + STACK_FRAME.prev_frame]
|
||||
test eax, eax
|
||||
jz .done
|
||||
|
||||
; Save stack_frame_dump
|
||||
push edi
|
||||
; Save previous frame
|
||||
push ebp
|
||||
; Save return address
|
||||
mov eax, [edi + STACK_FRAME.ret_addr]
|
||||
push eax
|
||||
|
||||
; Print frame address and return address
|
||||
push eax ; pop in put_message_nodraw
|
||||
push ebp ; pop in put_message_nodraw
|
||||
mov esi, aBacktraceFmt
|
||||
call put_message_nodraw
|
||||
|
||||
; Restore return address
|
||||
pop eax
|
||||
|
||||
; Find symbol by return address
|
||||
call find_near_symbol
|
||||
test esi, esi
|
||||
jnz .print_sym
|
||||
|
||||
mov esi, aBacktraceSymStub
|
||||
|
||||
.print_sym:
|
||||
call put_message_nodraw
|
||||
mov esi, newline
|
||||
call put_message_nodraw
|
||||
|
||||
; Restore previous frame
|
||||
pop ebp
|
||||
; Restore stack_frame_dump
|
||||
pop edi
|
||||
|
||||
; The address of the previous frame must be greater than the current one.
|
||||
cmp [edi + STACK_FRAME.prev_frame], ebp
|
||||
jna .done
|
||||
|
||||
; Set previous frame
|
||||
mov ebp, [edi + STACK_FRAME.prev_frame]
|
||||
dec [bt_depth]
|
||||
jnz .next
|
||||
|
||||
.done:
|
||||
mov esi, newline
|
||||
|
||||
.exit:
|
||||
call put_message
|
||||
pop ebp
|
||||
ret
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Dissassemble block of executable event
|
||||
|
||||
@@ -1864,7 +1966,7 @@ include 'disasm.inc'
|
||||
|
||||
caption_str db 'Kolibri Debugger',0
|
||||
|
||||
begin_str db 'Kolibri Debugger, version 0.35',10
|
||||
begin_str db 'Kolibri Debugger, version 0.36',10
|
||||
db 'Hint: type "help" for help, "quit" to quit'
|
||||
newline db 10,0
|
||||
prompt db '> ',0
|
||||
@@ -1880,66 +1982,88 @@ help_groups:
|
||||
;-----------------------------------------------------------------------------
|
||||
; Commands format definitions
|
||||
|
||||
; TODO: make it with macros
|
||||
|
||||
; flags field:
|
||||
; &1: command may be called without parameters
|
||||
; &2: command may be called with parameters
|
||||
; &4: command may be called without loaded program
|
||||
; &8: command may be called with loaded program
|
||||
commands:
|
||||
dd _aH, OnHelp, HelpSyntax, HelpHelp
|
||||
db 0Fh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aHelp, OnHelp, HelpSyntax, HelpHelp
|
||||
db 0Fh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aQuit, OnQuit, QuitSyntax, QuitHelp
|
||||
db 0Dh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aLoad, OnLoad, LoadSyntax, LoadHelp
|
||||
db 6
|
||||
db CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP
|
||||
|
||||
dd aReload, OnReload, ReloadSyntax, ReloadHelp
|
||||
db 0Dh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aTerminate, OnTerminate, TerminateSyntax, TerminateHelp
|
||||
db 9
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aDetach, OnDetach, DetachSyntax, DetachHelp
|
||||
db 9
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aSuspend, OnSuspend, SuspendSyntax, SuspendHelp
|
||||
db 9
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aResume, OnResume, ResumeSyntax, ResumeHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aStep, OnStepMultiple, StepSyntax, StepHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aProceed, OnProceedMultiple, ProceedSyntax, ProceedHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aCalc, OnCalc, CalcSyntax, CalcHelp
|
||||
db 0Eh
|
||||
db CMD_WITH_PARAM or CMD_WITHOUT_LOADED_APP or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aDump, OnDump, DumpSyntax, DumpHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBacktrace, OnBacktrace, BacktraceSyntax, BacktraceHelp
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aUnassemble, OnUnassemble, UnassembleSyntax, UnassembleHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBp, OnBp, BpSyntax, BpHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBpm, OnBpmb, BpmSyntax, BpmHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBpmb, OnBpmb, BpmSyntax, BpmHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBpmw, OnBpmw, BpmSyntax, BpmHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBpmd, OnBpmd, BpmSyntax, BpmHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBl, OnBl, BlSyntax, BlHelp
|
||||
db 0Bh
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBc, OnBc, BcSyntax, BcHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBd, OnBd, BdSyntax, BdHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aBe, OnBe, BeSyntax, BeHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aReg, OnReg, RSyntax, RHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aUnpack, OnUnpack, UnpackSyntax, UnpackHelp
|
||||
db 9
|
||||
db CMD_WITHOUT_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd aLoadSymbols, OnLoadSymbols, LoadSymbolsSyntax, LoadSymbolsHelp
|
||||
db 0Ah
|
||||
db CMD_WITH_PARAM or CMD_WITH_LOADED_APP
|
||||
|
||||
dd 0
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
@@ -1980,7 +2104,8 @@ help_data_msg db 'List of data commands:',10
|
||||
db 'd [<expression>] - dump data at given address',10
|
||||
db 'u [<expression>] - unassemble instructions at given address',10
|
||||
db 'r <register> <expression> or',10
|
||||
db 'r <register>=<expression> - set register value',10,0
|
||||
db 'r <register>=<expression> - set register value',10
|
||||
db 'bt [<number>] - display backtrace / stacktrace',10,0
|
||||
|
||||
; Breakpoints commands group
|
||||
|
||||
@@ -2038,6 +2163,11 @@ DumpHelp db 'Dump data of debugged program',10
|
||||
DumpSyntax db 'Usage: d <expression> - dump data at specified address',10
|
||||
db ' or: d - continue current dump',10,0
|
||||
|
||||
aBacktrace db 3,'bt',0
|
||||
BacktraceHelp db 'Display backtrace / stacktrace',10
|
||||
BacktraceSyntax db 'Usage: bt <number> - display backtrace with depth',10
|
||||
db ' or: bt display all backtrace',10,0
|
||||
|
||||
aCalc db 2,'?',0
|
||||
CalcHelp db 'Calculate value of expression',10
|
||||
CalcSyntax db 'Usage: ? <expression>',10,0
|
||||
@@ -2102,6 +2232,11 @@ LoadSymbolsSyntax db 'Usage: load-symbols <symbols-file-name>',10,0
|
||||
|
||||
aUnknownCommand db 'Unknown command',10,0
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Info messages
|
||||
aBacktraceSymStub db '??',0
|
||||
aBacktraceFmt db '[0x%8X] 0x%8X in ',0
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Error messages
|
||||
|
||||
@@ -2474,11 +2609,13 @@ disasm_cur_pos dd ?
|
||||
disasm_cur_str dd ?
|
||||
disasm_string rb 256
|
||||
|
||||
thread_info process_information
|
||||
stack_frame_dump rb sizeof.STACK_FRAME
|
||||
bt_depth rd 1
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
; Coordinates and sizes for GUI
|
||||
|
||||
thread_info process_information
|
||||
data_x_size_dd dd ?, ?
|
||||
messages_x_size_dd dd ?, ?
|
||||
registers_x_pos_dd dd ?, ?
|
||||
|
||||
@@ -4,6 +4,11 @@
|
||||
|
||||
include 'sort.inc'
|
||||
|
||||
struct DEBUG_SYMBOL
|
||||
addr rd 1
|
||||
string rd 0
|
||||
ends
|
||||
|
||||
; compare proc for sorter
|
||||
compare:
|
||||
cmpsd
|
||||
@@ -459,4 +464,69 @@ find_symbol_name:
|
||||
|
||||
@@:
|
||||
pop esi
|
||||
ret
|
||||
ret
|
||||
|
||||
;-----------------------------------------------------------------------------
|
||||
;
|
||||
; Find the nearest symol using binary search
|
||||
;
|
||||
; in: eax - target addres
|
||||
; out: esi - symbol name
|
||||
; destroys: ebx, ecx, edx, edi, ebp
|
||||
;
|
||||
find_near_symbol:
|
||||
mov edi, [symbols]
|
||||
|
||||
xor esi, esi ; Result
|
||||
mov ecx, esi ; Left
|
||||
mov edx, [num_symbols] ; Right
|
||||
dec edx
|
||||
js .end
|
||||
|
||||
; If the first address is already greater than the target
|
||||
mov ebp, [edi + ecx * sizeof.DEBUG_SYMBOL]
|
||||
cmp [ebp + DEBUG_SYMBOL.addr], eax
|
||||
ja .end
|
||||
|
||||
; If the last address is less than or equal to the target
|
||||
mov ebp, [edi + edx * sizeof.DEBUG_SYMBOL]
|
||||
cmp [ebp + DEBUG_SYMBOL.addr], eax
|
||||
jbe .found
|
||||
|
||||
.loop:
|
||||
cmp ecx, edx
|
||||
ja .end
|
||||
|
||||
; Calc middle:
|
||||
mov ebx, edx ; Middle
|
||||
sub ebx, ecx ; (right - left)
|
||||
shr ebx, 1 ; / 2
|
||||
add ebx, ecx ; + left
|
||||
|
||||
; Equal
|
||||
mov ebp, [edi + ebx * sizeof.DEBUG_SYMBOL]
|
||||
cmp [ebp + DEBUG_SYMBOL.addr], eax
|
||||
jz .found
|
||||
jb .update_left
|
||||
|
||||
; Update right
|
||||
mov edx, ebx
|
||||
dec edx
|
||||
jmp .loop
|
||||
|
||||
.update_left:
|
||||
; Save potential result
|
||||
mov esi, ebp
|
||||
add esi, DEBUG_SYMBOL.string
|
||||
|
||||
; Update left
|
||||
mov ecx, ebx
|
||||
inc ecx
|
||||
jmp .loop
|
||||
|
||||
.found:
|
||||
mov esi, ebp
|
||||
add esi, DEBUG_SYMBOL.string
|
||||
|
||||
.end:
|
||||
ret
|
||||
|
||||
1
programs/develop/oberon07
Submodule
1
programs/develop/oberon07
Submodule
Submodule programs/develop/oberon07 added at 07f0da001b
Binary file not shown.
@@ -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.
|
||||
@@ -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
|
||||
@@ -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
|
||||
------------------------------------------------------------------------------
|
||||
Binary file not shown.
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -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
|
||||
@@ -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.
|
||||
@@ -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.
|
||||
@@ -1,59 +0,0 @@
|
||||
MODULE HW_con;
|
||||
|
||||
IMPORT
|
||||
Out, In, Console, DateTime;
|
||||
|
||||
|
||||
PROCEDURE OutInt2 (n: INTEGER);
|
||||
BEGIN
|
||||
ASSERT((0 <= n) & (n <= 99));
|
||||
IF n < 10 THEN
|
||||
Out.Char("0")
|
||||
END;
|
||||
Out.Int(n, 0)
|
||||
END OutInt2;
|
||||
|
||||
|
||||
PROCEDURE OutMonth (n: INTEGER);
|
||||
VAR
|
||||
str: ARRAY 4 OF CHAR;
|
||||
BEGIN
|
||||
CASE n OF
|
||||
| 1: str := "jan"
|
||||
| 2: str := "feb"
|
||||
| 3: str := "mar"
|
||||
| 4: str := "apr"
|
||||
| 5: str := "may"
|
||||
| 6: str := "jun"
|
||||
| 7: str := "jul"
|
||||
| 8: str := "aug"
|
||||
| 9: str := "sep"
|
||||
|10: str := "oct"
|
||||
|11: str := "nov"
|
||||
|12: str := "dec"
|
||||
END;
|
||||
Out.String(str)
|
||||
END OutMonth;
|
||||
|
||||
|
||||
PROCEDURE main;
|
||||
VAR
|
||||
Year, Month, Day,
|
||||
Hour, Min, Sec, Msec: INTEGER;
|
||||
BEGIN
|
||||
Out.String("Hello, world!"); Out.Ln;
|
||||
Console.SetColor(Console.White, Console.Red);
|
||||
DateTime.Now(Year, Month, Day, Hour, Min, Sec, Msec);
|
||||
OutInt2(Day); Out.Char("-"); OutMonth(Month); Out.Char("-"); Out.Int(Year, 0); Out.Char(" ");
|
||||
OutInt2(Hour); Out.Char(":"); OutInt2(Min); Out.Char(":"); OutInt2(Sec); Out.Ln;
|
||||
Console.SetColor(Console.Blue, Console.LightGray);
|
||||
Out.Ln; Out.String("press enter...");
|
||||
In.Ln
|
||||
END main;
|
||||
|
||||
|
||||
BEGIN
|
||||
Console.open;
|
||||
main;
|
||||
Console.exit(TRUE)
|
||||
END HW_con.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,797 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2022, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE ARITH;
|
||||
|
||||
IMPORT STRINGS, UTILS, LISTS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
tINTEGER* = 1; tREAL* = 2; tSET* = 3;
|
||||
tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6;
|
||||
tSTRING* = 7;
|
||||
|
||||
opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;
|
||||
opIN* = 6; opIS* = 7;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
VALUE* = RECORD
|
||||
|
||||
typ*: INTEGER;
|
||||
|
||||
int: INTEGER;
|
||||
float: REAL;
|
||||
set: SET;
|
||||
bool: BOOLEAN;
|
||||
|
||||
string*: LISTS.ITEM
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
digit: ARRAY 256 OF INTEGER;
|
||||
|
||||
|
||||
PROCEDURE Int* (v: VALUE): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
|
||||
CASE v.typ OF
|
||||
|tINTEGER, tCHAR, tWCHAR:
|
||||
res := v.int
|
||||
|tSET:
|
||||
res := UTILS.Long(ORD(v.set))
|
||||
|tBOOLEAN:
|
||||
res := ORD(v.bool)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE getBool* (v: VALUE): BOOLEAN;
|
||||
BEGIN
|
||||
ASSERT(v.typ = tBOOLEAN);
|
||||
|
||||
RETURN v.bool
|
||||
END getBool;
|
||||
|
||||
|
||||
PROCEDURE Float* (v: VALUE): REAL;
|
||||
BEGIN
|
||||
ASSERT(v.typ = tREAL);
|
||||
|
||||
RETURN v.float
|
||||
END Float;
|
||||
|
||||
|
||||
PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
|
||||
RETURN (a <= i.int) & (i.int <= b)
|
||||
END range;
|
||||
|
||||
|
||||
PROCEDURE check* (v: VALUE): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
CASE v.typ OF
|
||||
|tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)
|
||||
|tCHAR: res := range(v, 0, 255)
|
||||
|tWCHAR: res := range(v, 0, 65535)
|
||||
|tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END check;
|
||||
|
||||
|
||||
PROCEDURE isZero* (v: VALUE): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
CASE v.typ OF
|
||||
|tINTEGER: res := v.int = 0
|
||||
|tREAL: res := v.float = 0.0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END isZero;
|
||||
|
||||
|
||||
PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
|
||||
VAR
|
||||
value: INTEGER;
|
||||
i: INTEGER;
|
||||
d: INTEGER;
|
||||
|
||||
BEGIN
|
||||
error := 0;
|
||||
value := 0;
|
||||
|
||||
i := 0;
|
||||
WHILE STRINGS.digit(s[i]) & (error = 0) DO
|
||||
d := digit[ORD(s[i])];
|
||||
IF value <= (UTILS.maxint - d) DIV 10 THEN
|
||||
value := value * 10 + d;
|
||||
INC(i)
|
||||
ELSE
|
||||
error := 1
|
||||
END
|
||||
END;
|
||||
|
||||
IF error = 0 THEN
|
||||
v.int := value;
|
||||
v.typ := tINTEGER;
|
||||
IF ~check(v) THEN
|
||||
error := 1
|
||||
END
|
||||
END
|
||||
|
||||
END iconv;
|
||||
|
||||
|
||||
PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
|
||||
VAR
|
||||
value: INTEGER;
|
||||
i: INTEGER;
|
||||
n: INTEGER;
|
||||
d: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ASSERT(STRINGS.digit(s[0]));
|
||||
|
||||
error := 0;
|
||||
value := 0;
|
||||
|
||||
n := -1;
|
||||
i := 0;
|
||||
WHILE (s[i] # "H") & (s[i] # "X") & (s[i] # "h") & (s[i] # "x") & (error = 0) DO
|
||||
|
||||
d := digit[ORD(s[i])];
|
||||
IF (n = -1) & (d # 0) THEN
|
||||
n := i
|
||||
END;
|
||||
|
||||
IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
|
||||
error := 2
|
||||
ELSE
|
||||
value := value * 16 + d;
|
||||
INC(i)
|
||||
END
|
||||
|
||||
END;
|
||||
|
||||
value := UTILS.Long(value);
|
||||
|
||||
IF ((s[i] = "X") OR (s[i] = "x")) & (n # -1) & (i - n > 4) THEN
|
||||
error := 3
|
||||
END;
|
||||
|
||||
IF error = 0 THEN
|
||||
v.int := value;
|
||||
IF (s[i] = "X") OR (s[i] = "x") THEN
|
||||
v.typ := tCHAR;
|
||||
IF ~check(v) THEN
|
||||
v.typ := tWCHAR;
|
||||
IF ~check(v) THEN
|
||||
error := 3
|
||||
END
|
||||
END
|
||||
ELSE
|
||||
v.typ := tINTEGER;
|
||||
IF ~check(v) THEN
|
||||
error := 2
|
||||
END
|
||||
END
|
||||
END
|
||||
|
||||
END hconv;
|
||||
|
||||
|
||||
PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
CASE op OF
|
||||
|"+": a := a + b
|
||||
|"-": a := a - b
|
||||
|"*": a := a * b
|
||||
|"/": a := a / b
|
||||
END
|
||||
|
||||
RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)
|
||||
END opFloat2;
|
||||
|
||||
|
||||
PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
|
||||
VAR
|
||||
value: REAL;
|
||||
exp10: REAL;
|
||||
i, n, d: INTEGER;
|
||||
minus: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
error := 0;
|
||||
value := 0.0;
|
||||
minus := FALSE;
|
||||
n := 0;
|
||||
|
||||
exp10 := 0.0;
|
||||
WHILE (error = 0) & (STRINGS.digit(s[i]) OR (s[i] = ".")) DO
|
||||
IF s[i] = "." THEN
|
||||
exp10 := 1.0;
|
||||
INC(i)
|
||||
ELSE
|
||||
IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") & opFloat2(exp10, 10.0, "*") THEN
|
||||
INC(i)
|
||||
ELSE
|
||||
error := 4
|
||||
END
|
||||
END
|
||||
END;
|
||||
|
||||
IF ~opFloat2(value, exp10, "/") THEN
|
||||
error := 4
|
||||
END;
|
||||
|
||||
IF (s[i] = "E") OR (s[i] = "e") THEN
|
||||
INC(i)
|
||||
END;
|
||||
|
||||
IF (s[i] = "-") OR (s[i] = "+") THEN
|
||||
minus := s[i] = "-";
|
||||
INC(i)
|
||||
END;
|
||||
|
||||
WHILE (error = 0) & STRINGS.digit(s[i]) DO
|
||||
d := digit[ORD(s[i])];
|
||||
IF n <= (UTILS.maxint - d) DIV 10 THEN
|
||||
n := n * 10 + d;
|
||||
INC(i)
|
||||
ELSE
|
||||
error := 5
|
||||
END
|
||||
END;
|
||||
|
||||
exp10 := 1.0;
|
||||
WHILE (error = 0) & (n > 0) DO
|
||||
IF opFloat2(exp10, 10.0, "*") THEN
|
||||
DEC(n)
|
||||
ELSE
|
||||
error := 4
|
||||
END
|
||||
END;
|
||||
|
||||
IF error = 0 THEN
|
||||
IF minus THEN
|
||||
IF ~opFloat2(value, exp10, "/") THEN
|
||||
error := 4
|
||||
END
|
||||
ELSE
|
||||
IF ~opFloat2(value, exp10, "*") THEN
|
||||
error := 4
|
||||
END
|
||||
END
|
||||
END;
|
||||
|
||||
IF error = 0 THEN
|
||||
v.float := value;
|
||||
v.typ := tREAL;
|
||||
IF ~check(v) THEN
|
||||
error := 4
|
||||
END
|
||||
END
|
||||
|
||||
END fconv;
|
||||
|
||||
|
||||
PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);
|
||||
BEGIN
|
||||
v.typ := tCHAR;
|
||||
v.int := ord
|
||||
END setChar;
|
||||
|
||||
|
||||
PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);
|
||||
BEGIN
|
||||
v.typ := tWCHAR;
|
||||
v.int := ord
|
||||
END setWChar;
|
||||
|
||||
|
||||
PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
error: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
IF (a > 0) & (b > 0) THEN
|
||||
error := a > UTILS.maxint - b
|
||||
ELSIF (a < 0) & (b < 0) THEN
|
||||
error := a < UTILS.minint - b
|
||||
ELSE
|
||||
error := FALSE
|
||||
END;
|
||||
|
||||
IF ~error THEN
|
||||
a := a + b
|
||||
ELSE
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN ~error
|
||||
END addInt;
|
||||
|
||||
|
||||
PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
error: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
IF (a > 0) & (b < 0) THEN
|
||||
error := a > UTILS.maxint + b
|
||||
ELSIF (a < 0) & (b > 0) THEN
|
||||
error := a < UTILS.minint + b
|
||||
ELSIF (a = 0) & (b < 0) THEN
|
||||
error := b = UTILS.minint
|
||||
ELSE
|
||||
error := FALSE
|
||||
END;
|
||||
|
||||
IF ~error THEN
|
||||
a := a - b
|
||||
ELSE
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN ~error
|
||||
END subInt;
|
||||
|
||||
|
||||
PROCEDURE lg2 (x: INTEGER): INTEGER;
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ASSERT(x > 0);
|
||||
|
||||
n := UTILS.Log2(x);
|
||||
IF n = -1 THEN
|
||||
n := 255
|
||||
END
|
||||
|
||||
RETURN n
|
||||
END lg2;
|
||||
|
||||
|
||||
PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
error: BOOLEAN;
|
||||
min, max: INTEGER;
|
||||
|
||||
BEGIN
|
||||
min := UTILS.minint;
|
||||
max := UTILS.maxint;
|
||||
|
||||
IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN
|
||||
error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))
|
||||
|
||||
ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN
|
||||
error := (a = min) OR (b = min);
|
||||
IF ~error THEN
|
||||
IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN
|
||||
error := ABS(a) > max DIV ABS(b)
|
||||
END
|
||||
END
|
||||
|
||||
ELSE
|
||||
error := FALSE
|
||||
END;
|
||||
|
||||
IF ~error THEN
|
||||
a := a * b
|
||||
ELSE
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN ~error
|
||||
END mulInt;
|
||||
|
||||
|
||||
PROCEDURE _ASR (x, n: INTEGER): INTEGER;
|
||||
RETURN ASR(UTILS.Long(x), n)
|
||||
END _ASR;
|
||||
|
||||
|
||||
PROCEDURE _LSR (x, n: INTEGER): INTEGER;
|
||||
RETURN UTILS.Long(LSR(UTILS.Short(x), n))
|
||||
END _LSR;
|
||||
|
||||
|
||||
PROCEDURE _LSL (x, n: INTEGER): INTEGER;
|
||||
RETURN UTILS.Long(LSL(x, n))
|
||||
END _LSL;
|
||||
|
||||
|
||||
PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
x := UTILS.Short(x);
|
||||
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
|
||||
RETURN UTILS.Long(x)
|
||||
END _ROR1_32;
|
||||
|
||||
|
||||
PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
x := x MOD 65536;
|
||||
x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
|
||||
RETURN UTILS.Long(x)
|
||||
END _ROR1_16;
|
||||
|
||||
|
||||
PROCEDURE _ROR (x, n: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
|
||||
CASE UTILS.bit_diff OF
|
||||
|0: x := ROR(x, n)
|
||||
|16, 48:
|
||||
n := n MOD 16;
|
||||
WHILE n > 0 DO
|
||||
x := _ROR1_16(x);
|
||||
DEC(n)
|
||||
END
|
||||
|32:
|
||||
n := n MOD 32;
|
||||
WHILE n > 0 DO
|
||||
x := _ROR1_32(x);
|
||||
DEC(n)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN x
|
||||
END _ROR;
|
||||
|
||||
|
||||
PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
|
||||
VAR
|
||||
success: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
success := TRUE;
|
||||
|
||||
CASE op OF
|
||||
|"+": success := addInt(a.int, b.int)
|
||||
|"-": success := subInt(a.int, b.int)
|
||||
|"*": success := mulInt(a.int, b.int)
|
||||
|"/": success := FALSE
|
||||
|"D": a.int := a.int DIV b.int
|
||||
|"M": a.int := a.int MOD b.int
|
||||
|"L": a.int := _LSL(a.int, b.int)
|
||||
|"A": a.int := _ASR(a.int, b.int)
|
||||
|"O": a.int := _ROR(a.int, b.int)
|
||||
|"R": a.int := _LSR(a.int, b.int)
|
||||
|"m": a.int := MIN(a.int, b.int)
|
||||
|"x": a.int := MAX(a.int, b.int)
|
||||
END;
|
||||
a.typ := tINTEGER
|
||||
|
||||
RETURN success & check(a)
|
||||
END opInt;
|
||||
|
||||
|
||||
PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
s[0] := CHR(c.int);
|
||||
s[1] := 0X
|
||||
END charToStr;
|
||||
|
||||
|
||||
PROCEDURE opSet* (VAR a: VALUE; b: VALUE; op: CHAR);
|
||||
BEGIN
|
||||
CASE op OF
|
||||
|"+": a.set := a.set + b.set
|
||||
|"-": a.set := a.set - b.set
|
||||
|"*": a.set := a.set * b.set
|
||||
|"/": a.set := a.set / b.set
|
||||
END;
|
||||
a.typ := tSET
|
||||
END opSet;
|
||||
|
||||
|
||||
PROCEDURE opFloat* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
|
||||
BEGIN
|
||||
a.typ := tREAL
|
||||
RETURN opFloat2(a.float, b.float, op) & check(a)
|
||||
END opFloat;
|
||||
|
||||
|
||||
PROCEDURE ord* (VAR v: VALUE);
|
||||
BEGIN
|
||||
CASE v.typ OF
|
||||
|tCHAR, tWCHAR:
|
||||
|tBOOLEAN: v.int := ORD(v.bool)
|
||||
|tSET: v.int := UTILS.Long(ORD(v.set))
|
||||
END;
|
||||
v.typ := tINTEGER
|
||||
END ord;
|
||||
|
||||
|
||||
PROCEDURE odd* (VAR v: VALUE);
|
||||
BEGIN
|
||||
v.typ := tBOOLEAN;
|
||||
v.bool := ODD(v.int)
|
||||
END odd;
|
||||
|
||||
|
||||
PROCEDURE bits* (VAR v: VALUE);
|
||||
BEGIN
|
||||
v.typ := tSET;
|
||||
v.set := BITS(v.int)
|
||||
END bits;
|
||||
|
||||
|
||||
PROCEDURE abs* (VAR v: VALUE): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
|
||||
CASE v.typ OF
|
||||
|tREAL:
|
||||
v.float := ABS(v.float);
|
||||
res := TRUE
|
||||
|tINTEGER:
|
||||
IF v.int # UTILS.minint THEN
|
||||
v.int := ABS(v.int);
|
||||
res := TRUE
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END abs;
|
||||
|
||||
|
||||
PROCEDURE floor* (VAR v: VALUE): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
v.typ := tINTEGER;
|
||||
res := (FLT(UTILS.minint) <= v.float) & (v.float <= FLT(UTILS.maxint));
|
||||
IF res THEN
|
||||
v.int := FLOOR(v.float)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END floor;
|
||||
|
||||
|
||||
PROCEDURE flt* (VAR v: VALUE);
|
||||
BEGIN
|
||||
v.typ := tREAL;
|
||||
v.float := FLT(v.int)
|
||||
END flt;
|
||||
|
||||
|
||||
PROCEDURE neg* (VAR v: VALUE): BOOLEAN;
|
||||
VAR
|
||||
z: VALUE;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := TRUE;
|
||||
|
||||
z.typ := tINTEGER;
|
||||
z.int := 0;
|
||||
|
||||
CASE v.typ OF
|
||||
|tREAL: v.float := -v.float
|
||||
|tSET: v.set := -v.set
|
||||
|tINTEGER: res := opInt(z, v, "-"); v := z
|
||||
|tBOOLEAN: v.bool := ~v.bool
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END neg;
|
||||
|
||||
|
||||
PROCEDURE setbool* (VAR v: VALUE; b: BOOLEAN);
|
||||
BEGIN
|
||||
v.bool := b;
|
||||
v.typ := tBOOLEAN
|
||||
END setbool;
|
||||
|
||||
|
||||
PROCEDURE opBoolean* (VAR a: VALUE; b: VALUE; op: CHAR);
|
||||
BEGIN
|
||||
CASE op OF
|
||||
|"&": a.bool := a.bool & b.bool
|
||||
|"|": a.bool := a.bool OR b.bool
|
||||
END;
|
||||
a.typ := tBOOLEAN
|
||||
END opBoolean;
|
||||
|
||||
|
||||
PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
|
||||
IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
|
||||
CASE v.typ OF
|
||||
|tINTEGER,
|
||||
tWCHAR,
|
||||
tCHAR: res := v.int < v2.int
|
||||
|tREAL: res := v.float < v2.float
|
||||
|tBOOLEAN,
|
||||
tSET: error := 1
|
||||
END
|
||||
ELSE
|
||||
error := 1
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END less;
|
||||
|
||||
|
||||
PROCEDURE equal (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
|
||||
IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN
|
||||
CASE v.typ OF
|
||||
|tINTEGER,
|
||||
tWCHAR,
|
||||
tCHAR: res := v.int = v2.int
|
||||
|tREAL: res := v.float = v2.float
|
||||
|tBOOLEAN: res := v.bool = v2.bool
|
||||
|tSET: res := v.set = v2.set
|
||||
END
|
||||
ELSE
|
||||
error := 1
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END equal;
|
||||
|
||||
|
||||
PROCEDURE relation* (VAR v: VALUE; v2: VALUE; op: INTEGER; VAR error: INTEGER);
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
error := 0;
|
||||
|
||||
res := FALSE;
|
||||
|
||||
CASE op OF
|
||||
|
||||
|opEQ:
|
||||
res := equal(v, v2, error)
|
||||
|
||||
|opNE:
|
||||
res := ~equal(v, v2, error)
|
||||
|
||||
|opLT:
|
||||
res := less(v, v2, error)
|
||||
|
||||
|opLE:
|
||||
res := less(v, v2, error);
|
||||
IF error = 0 THEN
|
||||
res := equal(v, v2, error) OR res
|
||||
END
|
||||
|
||||
|opGE:
|
||||
res := ~less(v, v2, error)
|
||||
|
||||
|opGT:
|
||||
res := less(v, v2, error);
|
||||
IF error = 0 THEN
|
||||
res := equal(v, v2, error) OR res
|
||||
END;
|
||||
res := ~res
|
||||
|
||||
|opIN:
|
||||
IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN
|
||||
IF range(v, 0, UTILS.target.maxSet) THEN
|
||||
res := v.int IN v2.set
|
||||
ELSE
|
||||
error := 2
|
||||
END
|
||||
ELSE
|
||||
error := 1
|
||||
END
|
||||
|
||||
END;
|
||||
|
||||
IF error = 0 THEN
|
||||
v.bool := res;
|
||||
v.typ := tBOOLEAN
|
||||
END
|
||||
|
||||
END relation;
|
||||
|
||||
|
||||
PROCEDURE emptySet* (VAR v: VALUE);
|
||||
BEGIN
|
||||
v.typ := tSET;
|
||||
v.set := {}
|
||||
END emptySet;
|
||||
|
||||
|
||||
PROCEDURE constrSet* (VAR v: VALUE; a, b: VALUE);
|
||||
BEGIN
|
||||
v.typ := tSET;
|
||||
v.set := {a.int .. b.int}
|
||||
END constrSet;
|
||||
|
||||
|
||||
PROCEDURE getInt* (v: VALUE): INTEGER;
|
||||
BEGIN
|
||||
ASSERT(check(v))
|
||||
|
||||
RETURN v.int
|
||||
END getInt;
|
||||
|
||||
|
||||
PROCEDURE setInt* (VAR v: VALUE; i: INTEGER): BOOLEAN;
|
||||
BEGIN
|
||||
v.int := i;
|
||||
v.typ := tINTEGER
|
||||
|
||||
RETURN check(v)
|
||||
END setInt;
|
||||
|
||||
|
||||
PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := LENGTH(s) + LENGTH(s1) < LEN(s);
|
||||
IF res THEN
|
||||
STRINGS.append(s, s1)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END concat;
|
||||
|
||||
|
||||
PROCEDURE init;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO LEN(digit) - 1 DO
|
||||
digit[i] := -1
|
||||
END;
|
||||
|
||||
FOR i := ORD("0") TO ORD("9") DO
|
||||
digit[i] := i - ORD("0")
|
||||
END;
|
||||
|
||||
FOR i := ORD("A") TO ORD("F") DO
|
||||
digit[i] := i - ORD("A") + 10
|
||||
END
|
||||
END init;
|
||||
|
||||
|
||||
BEGIN
|
||||
init
|
||||
END ARITH.
|
||||
@@ -1,197 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE AVLTREES;
|
||||
|
||||
IMPORT C := COLLECTIONS;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
DATA* = POINTER TO RECORD (C.ITEM) END;
|
||||
|
||||
NODE* = POINTER TO RECORD (C.ITEM)
|
||||
|
||||
data*: DATA;
|
||||
|
||||
height: INTEGER;
|
||||
|
||||
left*, right*: NODE
|
||||
|
||||
END;
|
||||
|
||||
CMP* = PROCEDURE (a, b: DATA): INTEGER;
|
||||
|
||||
DESTRUCTOR* = PROCEDURE (VAR data: DATA);
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
nodes: C.COLLECTION;
|
||||
|
||||
|
||||
PROCEDURE NewNode (data: DATA): NODE;
|
||||
VAR
|
||||
node: NODE;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(nodes);
|
||||
IF citem = NIL THEN
|
||||
NEW(node)
|
||||
ELSE
|
||||
node := citem(NODE)
|
||||
END;
|
||||
|
||||
node.data := data;
|
||||
node.left := NIL;
|
||||
node.right := NIL;
|
||||
node.height := 1
|
||||
|
||||
RETURN node
|
||||
END NewNode;
|
||||
|
||||
|
||||
PROCEDURE height (p: NODE): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF p = NIL THEN
|
||||
res := 0
|
||||
ELSE
|
||||
res := p.height
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END height;
|
||||
|
||||
|
||||
PROCEDURE bfactor (p: NODE): INTEGER;
|
||||
RETURN height(p.right) - height(p.left)
|
||||
END bfactor;
|
||||
|
||||
|
||||
PROCEDURE fixheight (p: NODE);
|
||||
BEGIN
|
||||
p.height := MAX(height(p.left), height(p.right)) + 1
|
||||
END fixheight;
|
||||
|
||||
|
||||
PROCEDURE rotateright (p: NODE): NODE;
|
||||
VAR
|
||||
q: NODE;
|
||||
|
||||
BEGIN
|
||||
q := p.left;
|
||||
p.left := q.right;
|
||||
q.right := p;
|
||||
fixheight(p);
|
||||
fixheight(q)
|
||||
|
||||
RETURN q
|
||||
END rotateright;
|
||||
|
||||
|
||||
PROCEDURE rotateleft (q: NODE): NODE;
|
||||
VAR
|
||||
p: NODE;
|
||||
|
||||
BEGIN
|
||||
p := q.right;
|
||||
q.right := p.left;
|
||||
p.left := q;
|
||||
fixheight(q);
|
||||
fixheight(p)
|
||||
|
||||
RETURN p
|
||||
END rotateleft;
|
||||
|
||||
|
||||
PROCEDURE balance (p: NODE): NODE;
|
||||
VAR
|
||||
res: NODE;
|
||||
|
||||
BEGIN
|
||||
fixheight(p);
|
||||
|
||||
IF bfactor(p) = 2 THEN
|
||||
IF bfactor(p.right) < 0 THEN
|
||||
p.right := rotateright(p.right)
|
||||
END;
|
||||
res := rotateleft(p)
|
||||
|
||||
ELSIF bfactor(p) = -2 THEN
|
||||
IF bfactor(p.left) > 0 THEN
|
||||
p.left := rotateleft(p.left)
|
||||
END;
|
||||
res := rotateright(p)
|
||||
|
||||
ELSE
|
||||
res := p
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END balance;
|
||||
|
||||
|
||||
PROCEDURE insert* (p: NODE; data: DATA; cmp: CMP; VAR newnode: BOOLEAN; VAR node: NODE): NODE;
|
||||
VAR
|
||||
res: NODE;
|
||||
rescmp: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF p = NIL THEN
|
||||
res := NewNode(data);
|
||||
node := res;
|
||||
newnode := TRUE
|
||||
ELSE
|
||||
|
||||
rescmp := cmp(data, p.data);
|
||||
IF rescmp < 0 THEN
|
||||
p.left := insert(p.left, data, cmp, newnode, node);
|
||||
res := balance(p)
|
||||
ELSIF rescmp > 0 THEN
|
||||
p.right := insert(p.right, data, cmp, newnode, node);
|
||||
res := balance(p)
|
||||
ELSE
|
||||
res := p;
|
||||
node := res;
|
||||
newnode := FALSE
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END insert;
|
||||
|
||||
|
||||
PROCEDURE destroy* (VAR node: NODE; destructor: DESTRUCTOR);
|
||||
VAR
|
||||
left, right: NODE;
|
||||
|
||||
BEGIN
|
||||
IF node # NIL THEN
|
||||
left := node.left;
|
||||
right := node.right;
|
||||
|
||||
IF destructor # NIL THEN
|
||||
destructor(node.data)
|
||||
END;
|
||||
|
||||
C.push(nodes, node);
|
||||
node := NIL;
|
||||
|
||||
destroy(left, destructor);
|
||||
destroy(right, destructor)
|
||||
END
|
||||
END destroy;
|
||||
|
||||
|
||||
BEGIN
|
||||
nodes := C.create()
|
||||
END AVLTREES.
|
||||
@@ -1,384 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE BIN;
|
||||
|
||||
IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
RCODE* = 0; PICCODE* = RCODE + 1;
|
||||
RDATA* = 2; PICDATA* = RDATA + 1;
|
||||
RBSS* = 4; PICBSS* = RBSS + 1;
|
||||
RIMP* = 6; PICIMP* = RIMP + 1;
|
||||
|
||||
IMPTAB* = 8;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
RELOC* = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
opcode*: INTEGER;
|
||||
offset*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
IMPRT* = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
nameoffs*: INTEGER;
|
||||
label*: INTEGER;
|
||||
|
||||
OriginalFirstThunk*,
|
||||
FirstThunk*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
EXPRT* = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
nameoffs*: INTEGER;
|
||||
label*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
PROGRAM* = POINTER TO RECORD
|
||||
|
||||
code*: CHL.BYTELIST;
|
||||
data*: CHL.BYTELIST;
|
||||
labels: CHL.INTLIST;
|
||||
bss*: INTEGER;
|
||||
stack*: INTEGER;
|
||||
vmajor*,
|
||||
vminor*: WCHAR;
|
||||
modname*: INTEGER;
|
||||
_import*: CHL.BYTELIST;
|
||||
export*: CHL.BYTELIST;
|
||||
rel_list*: LISTS.LIST;
|
||||
imp_list*: LISTS.LIST;
|
||||
exp_list*: LISTS.LIST
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE create* (NumberOfLabels: INTEGER): PROGRAM;
|
||||
VAR
|
||||
program: PROGRAM;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
NEW(program);
|
||||
|
||||
program.bss := 0;
|
||||
|
||||
program.labels := CHL.CreateIntList();
|
||||
FOR i := 0 TO NumberOfLabels - 1 DO
|
||||
CHL.PushInt(program.labels, 0)
|
||||
END;
|
||||
|
||||
program.rel_list := LISTS.create(NIL);
|
||||
program.imp_list := LISTS.create(NIL);
|
||||
program.exp_list := LISTS.create(NIL);
|
||||
|
||||
program.data := CHL.CreateByteList();
|
||||
program.code := CHL.CreateByteList();
|
||||
program._import := CHL.CreateByteList();
|
||||
program.export := CHL.CreateByteList()
|
||||
|
||||
RETURN program
|
||||
END create;
|
||||
|
||||
|
||||
PROCEDURE SetParams* (program: PROGRAM; bss, stack: INTEGER; vmajor, vminor: WCHAR);
|
||||
BEGIN
|
||||
program.bss := bss;
|
||||
program.stack := stack;
|
||||
program.vmajor := vmajor;
|
||||
program.vminor := vminor
|
||||
END SetParams;
|
||||
|
||||
|
||||
PROCEDURE PutReloc* (program: PROGRAM; opcode: INTEGER);
|
||||
VAR
|
||||
cmd: RELOC;
|
||||
|
||||
BEGIN
|
||||
NEW(cmd);
|
||||
cmd.opcode := opcode;
|
||||
cmd.offset := CHL.Length(program.code);
|
||||
LISTS.push(program.rel_list, cmd)
|
||||
END PutReloc;
|
||||
|
||||
|
||||
PROCEDURE PutData* (program: PROGRAM; b: BYTE);
|
||||
BEGIN
|
||||
CHL.PushByte(program.data, b)
|
||||
END PutData;
|
||||
|
||||
|
||||
PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
x: INTEGER;
|
||||
|
||||
BEGIN
|
||||
x := 0;
|
||||
|
||||
FOR i := 3 TO 0 BY -1 DO
|
||||
x := LSL(x, 8) + CHL.GetByte(_array, idx + i)
|
||||
END;
|
||||
|
||||
IF UTILS.bit_depth = 64 THEN
|
||||
x := LSL(x, 16);
|
||||
x := LSL(x, 16);
|
||||
x := ASR(x, 16);
|
||||
x := ASR(x, 16)
|
||||
END
|
||||
|
||||
RETURN x
|
||||
END get32le;
|
||||
|
||||
|
||||
PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.SetByte(_array, idx + i, UTILS.Byte(x, i))
|
||||
END
|
||||
END put32le;
|
||||
|
||||
|
||||
PROCEDURE PutData32LE* (program: PROGRAM; x: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.PushByte(program.data, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutData32LE;
|
||||
|
||||
|
||||
PROCEDURE PutData64LE* (program: PROGRAM; x: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 7 DO
|
||||
CHL.PushByte(program.data, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutData64LE;
|
||||
|
||||
|
||||
PROCEDURE PutDataStr* (program: PROGRAM; s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE s[i] # 0X DO
|
||||
PutData(program, ORD(s[i]));
|
||||
INC(i)
|
||||
END
|
||||
END PutDataStr;
|
||||
|
||||
|
||||
PROCEDURE PutCode* (program: PROGRAM; b: BYTE);
|
||||
BEGIN
|
||||
CHL.PushByte(program.code, b)
|
||||
END PutCode;
|
||||
|
||||
|
||||
PROCEDURE PutCode32LE* (program: PROGRAM; x: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
CHL.PushByte(program.code, UTILS.Byte(x, i))
|
||||
END
|
||||
END PutCode32LE;
|
||||
|
||||
|
||||
PROCEDURE PutCode16LE* (program: PROGRAM; x: INTEGER);
|
||||
BEGIN
|
||||
CHL.PushByte(program.code, UTILS.Byte(x, 0));
|
||||
CHL.PushByte(program.code, UTILS.Byte(x, 1))
|
||||
END PutCode16LE;
|
||||
|
||||
|
||||
PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER);
|
||||
BEGIN
|
||||
CHL.SetInt(program.labels, label, offset)
|
||||
END SetLabel;
|
||||
|
||||
|
||||
PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
|
||||
VAR
|
||||
imp: IMPRT;
|
||||
|
||||
BEGIN
|
||||
CHL.PushByte(program._import, 0);
|
||||
CHL.PushByte(program._import, 0);
|
||||
|
||||
IF ODD(CHL.Length(program._import)) THEN
|
||||
CHL.PushByte(program._import, 0)
|
||||
END;
|
||||
|
||||
NEW(imp);
|
||||
imp.nameoffs := CHL.PushStr(program._import, name);
|
||||
imp.label := label;
|
||||
LISTS.push(program.imp_list, imp)
|
||||
END Import;
|
||||
|
||||
|
||||
PROCEDURE less (bytes: CHL.BYTELIST; a, b: EXPRT): BOOLEAN;
|
||||
VAR
|
||||
i, j: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := a.nameoffs;
|
||||
j := b.nameoffs;
|
||||
|
||||
WHILE (CHL.GetByte(bytes, i) # 0) & (CHL.GetByte(bytes, j) # 0) &
|
||||
(CHL.GetByte(bytes, i) = CHL.GetByte(bytes, j)) DO
|
||||
INC(i);
|
||||
INC(j)
|
||||
END
|
||||
|
||||
RETURN CHL.GetByte(bytes, i) < CHL.GetByte(bytes, j)
|
||||
END less;
|
||||
|
||||
|
||||
PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
|
||||
VAR
|
||||
exp, cur: EXPRT;
|
||||
|
||||
BEGIN
|
||||
NEW(exp);
|
||||
exp.label := CHL.GetInt(program.labels, label);
|
||||
exp.nameoffs := CHL.PushStr(program.export, name);
|
||||
|
||||
cur := program.exp_list.first(EXPRT);
|
||||
WHILE (cur # NIL) & less(program.export, cur, exp) DO
|
||||
cur := cur.next(EXPRT)
|
||||
END;
|
||||
|
||||
IF cur # NIL THEN
|
||||
IF cur.prev # NIL THEN
|
||||
LISTS.insert(program.exp_list, cur.prev, exp)
|
||||
ELSE
|
||||
LISTS.insertL(program.exp_list, cur, exp)
|
||||
END
|
||||
ELSE
|
||||
LISTS.push(program.exp_list, exp)
|
||||
END
|
||||
|
||||
END Export;
|
||||
|
||||
|
||||
PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT;
|
||||
VAR
|
||||
_import, res: IMPRT;
|
||||
|
||||
BEGIN
|
||||
_import := program.imp_list.first(IMPRT);
|
||||
|
||||
res := NIL;
|
||||
WHILE (_import # NIL) & (n >= 0) DO
|
||||
IF _import.label # 0 THEN
|
||||
res := _import;
|
||||
DEC(n)
|
||||
END;
|
||||
_import := _import.next(IMPRT)
|
||||
END;
|
||||
|
||||
ASSERT(n = -1)
|
||||
RETURN res
|
||||
END GetIProc;
|
||||
|
||||
|
||||
PROCEDURE GetLabel* (program: PROGRAM; label: INTEGER): INTEGER;
|
||||
RETURN CHL.GetInt(program.labels, label)
|
||||
END GetLabel;
|
||||
|
||||
|
||||
PROCEDURE NewLabel* (program: PROGRAM);
|
||||
BEGIN
|
||||
CHL.PushInt(program.labels, 0)
|
||||
END NewLabel;
|
||||
|
||||
|
||||
PROCEDURE fixup* (program: PROGRAM);
|
||||
VAR
|
||||
rel: RELOC;
|
||||
imp: IMPRT;
|
||||
nproc: INTEGER;
|
||||
L: INTEGER;
|
||||
|
||||
BEGIN
|
||||
|
||||
nproc := 0;
|
||||
imp := program.imp_list.first(IMPRT);
|
||||
WHILE imp # NIL DO
|
||||
IF imp.label # 0 THEN
|
||||
CHL.SetInt(program.labels, imp.label, nproc);
|
||||
INC(nproc)
|
||||
END;
|
||||
imp := imp.next(IMPRT)
|
||||
END;
|
||||
|
||||
rel := program.rel_list.first(RELOC);
|
||||
WHILE rel # NIL DO
|
||||
|
||||
IF rel.opcode IN {RIMP, PICIMP} THEN
|
||||
L := get32le(program.code, rel.offset);
|
||||
put32le(program.code, rel.offset, GetLabel(program, L))
|
||||
END;
|
||||
|
||||
rel := rel.next(RELOC)
|
||||
END
|
||||
|
||||
END fixup;
|
||||
|
||||
|
||||
PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, k: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE hexdgt (dgt: CHAR): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF dgt < "A" THEN
|
||||
res := ORD(dgt) - ORD("0")
|
||||
ELSE
|
||||
res := ORD(dgt) - ORD("A") + 10
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END hexdgt;
|
||||
|
||||
|
||||
BEGIN
|
||||
k := LENGTH(hex);
|
||||
ASSERT(~ODD(k));
|
||||
k := k DIV 2;
|
||||
|
||||
FOR i := 0 TO k - 1 DO
|
||||
_array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
|
||||
END;
|
||||
|
||||
INC(idx, k)
|
||||
END InitArray;
|
||||
|
||||
|
||||
END BIN.
|
||||
@@ -1,255 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE CHUNKLISTS;
|
||||
|
||||
IMPORT LISTS, WR := WRITER;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
LENOFBYTECHUNK = 65536;
|
||||
LENOFINTCHUNK = 16384;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
ANYLIST = POINTER TO RECORD (LISTS.LIST)
|
||||
|
||||
length: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
BYTELIST* = POINTER TO RECORD (ANYLIST) END;
|
||||
|
||||
BYTECHUNK = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
data: ARRAY LENOFBYTECHUNK OF BYTE;
|
||||
count: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
INTLIST* = POINTER TO RECORD (ANYLIST) END;
|
||||
|
||||
INTCHUNK = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
data: ARRAY LENOFINTCHUNK OF INTEGER;
|
||||
count: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE SetByte* (list: BYTELIST; idx: INTEGER; byte: BYTE);
|
||||
VAR
|
||||
chunk: BYTECHUNK;
|
||||
item: LISTS.ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(idx >= 0);
|
||||
ASSERT(list # NIL);
|
||||
|
||||
item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
|
||||
ASSERT(item # NIL);
|
||||
chunk := item(BYTECHUNK);
|
||||
idx := idx MOD LENOFBYTECHUNK;
|
||||
ASSERT(idx < chunk.count);
|
||||
chunk.data[idx] := byte
|
||||
END SetByte;
|
||||
|
||||
|
||||
PROCEDURE GetByte* (list: BYTELIST; idx: INTEGER): BYTE;
|
||||
VAR
|
||||
chunk: BYTECHUNK;
|
||||
item: LISTS.ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(idx >= 0);
|
||||
ASSERT(list # NIL);
|
||||
|
||||
item := LISTS.getidx(list, idx DIV LENOFBYTECHUNK);
|
||||
ASSERT(item # NIL);
|
||||
chunk := item(BYTECHUNK);
|
||||
idx := idx MOD LENOFBYTECHUNK;
|
||||
ASSERT(idx < chunk.count)
|
||||
RETURN chunk.data[idx]
|
||||
END GetByte;
|
||||
|
||||
|
||||
PROCEDURE PushByte* (list: BYTELIST; byte: BYTE);
|
||||
VAR
|
||||
chunk: BYTECHUNK;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
|
||||
chunk := list.last(BYTECHUNK);
|
||||
|
||||
IF chunk.count = LENOFBYTECHUNK THEN
|
||||
NEW(chunk);
|
||||
chunk.count := 0;
|
||||
LISTS.push(list, chunk)
|
||||
END;
|
||||
|
||||
chunk.data[chunk.count] := byte;
|
||||
INC(chunk.count);
|
||||
|
||||
INC(list.length)
|
||||
END PushByte;
|
||||
|
||||
|
||||
PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER;
|
||||
VAR
|
||||
i, res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := list.length;
|
||||
i := 0;
|
||||
REPEAT
|
||||
PushByte(list, ORD(str[i]));
|
||||
INC(i)
|
||||
UNTIL str[i - 1] = 0X
|
||||
|
||||
RETURN res
|
||||
END PushStr;
|
||||
|
||||
|
||||
PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := FALSE;
|
||||
i := 0;
|
||||
WHILE (pos < list.length) & (i < LEN(str)) & ~res DO
|
||||
str[i] := CHR(GetByte(list, pos));
|
||||
res := str[i] = 0X;
|
||||
INC(pos);
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END GetStr;
|
||||
|
||||
|
||||
PROCEDURE WriteToFile* (list: BYTELIST);
|
||||
VAR
|
||||
chunk: BYTECHUNK;
|
||||
|
||||
BEGIN
|
||||
chunk := list.first(BYTECHUNK);
|
||||
WHILE chunk # NIL DO
|
||||
WR.Write(chunk.data, chunk.count);
|
||||
chunk := chunk.next(BYTECHUNK)
|
||||
END
|
||||
END WriteToFile;
|
||||
|
||||
|
||||
PROCEDURE CreateByteList* (): BYTELIST;
|
||||
VAR
|
||||
bytelist: BYTELIST;
|
||||
list: LISTS.LIST;
|
||||
chunk: BYTECHUNK;
|
||||
|
||||
BEGIN
|
||||
NEW(bytelist);
|
||||
list := LISTS.create(bytelist);
|
||||
bytelist.length := 0;
|
||||
|
||||
NEW(chunk);
|
||||
chunk.count := 0;
|
||||
LISTS.push(list, chunk)
|
||||
|
||||
RETURN list(BYTELIST)
|
||||
END CreateByteList;
|
||||
|
||||
|
||||
PROCEDURE SetInt* (list: INTLIST; idx: INTEGER; int: INTEGER);
|
||||
VAR
|
||||
chunk: INTCHUNK;
|
||||
item: LISTS.ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(idx >= 0);
|
||||
ASSERT(list # NIL);
|
||||
|
||||
item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
|
||||
ASSERT(item # NIL);
|
||||
chunk := item(INTCHUNK);
|
||||
idx := idx MOD LENOFINTCHUNK;
|
||||
ASSERT(idx < chunk.count);
|
||||
chunk.data[idx] := int
|
||||
END SetInt;
|
||||
|
||||
|
||||
PROCEDURE GetInt* (list: INTLIST; idx: INTEGER): INTEGER;
|
||||
|
||||
VAR
|
||||
chunk: INTCHUNK;
|
||||
item: LISTS.ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(idx >= 0);
|
||||
ASSERT(list # NIL);
|
||||
|
||||
item := LISTS.getidx(list, idx DIV LENOFINTCHUNK);
|
||||
ASSERT(item # NIL);
|
||||
chunk := item(INTCHUNK);
|
||||
idx := idx MOD LENOFINTCHUNK;
|
||||
ASSERT(idx < chunk.count)
|
||||
RETURN chunk.data[idx]
|
||||
END GetInt;
|
||||
|
||||
|
||||
PROCEDURE PushInt* (list: INTLIST; int: INTEGER);
|
||||
VAR
|
||||
chunk: INTCHUNK;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
|
||||
chunk := list.last(INTCHUNK);
|
||||
|
||||
IF chunk.count = LENOFINTCHUNK THEN
|
||||
NEW(chunk);
|
||||
chunk.count := 0;
|
||||
LISTS.push(list, chunk)
|
||||
END;
|
||||
|
||||
chunk.data[chunk.count] := int;
|
||||
INC(chunk.count);
|
||||
|
||||
INC(list.length)
|
||||
END PushInt;
|
||||
|
||||
|
||||
PROCEDURE CreateIntList* (): INTLIST;
|
||||
VAR
|
||||
intlist: INTLIST;
|
||||
list: LISTS.LIST;
|
||||
chunk: INTCHUNK;
|
||||
|
||||
BEGIN
|
||||
NEW(intlist);
|
||||
list := LISTS.create(intlist);
|
||||
intlist.length := 0;
|
||||
|
||||
NEW(chunk);
|
||||
chunk.count := 0;
|
||||
LISTS.push(list, chunk)
|
||||
|
||||
RETURN list(INTLIST)
|
||||
END CreateIntList;
|
||||
|
||||
|
||||
PROCEDURE Length* (list: ANYLIST): INTEGER;
|
||||
RETURN list.length
|
||||
END Length;
|
||||
|
||||
|
||||
END CHUNKLISTS.
|
||||
@@ -1,59 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2019, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE COLLECTIONS;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
ITEM* = POINTER TO RECORD
|
||||
|
||||
link: ITEM
|
||||
|
||||
END;
|
||||
|
||||
COLLECTION* = POINTER TO RECORD
|
||||
|
||||
last: ITEM
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE push* (collection: COLLECTION; item: ITEM);
|
||||
BEGIN
|
||||
item.link := collection.last;
|
||||
collection.last := item
|
||||
END push;
|
||||
|
||||
|
||||
PROCEDURE pop* (collection: COLLECTION): ITEM;
|
||||
VAR
|
||||
item: ITEM;
|
||||
|
||||
BEGIN
|
||||
item := collection.last;
|
||||
IF item # NIL THEN
|
||||
collection.last := item.link
|
||||
END
|
||||
|
||||
RETURN item
|
||||
END pop;
|
||||
|
||||
|
||||
PROCEDURE create* (): COLLECTION;
|
||||
VAR
|
||||
collection: COLLECTION;
|
||||
|
||||
BEGIN
|
||||
NEW(collection);
|
||||
collection.last := NIL
|
||||
|
||||
RETURN collection
|
||||
END create;
|
||||
|
||||
|
||||
END COLLECTIONS.
|
||||
@@ -1,78 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE CONSOLE;
|
||||
|
||||
IMPORT UTILS, STRINGS;
|
||||
|
||||
|
||||
PROCEDURE String* (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(s)) & (s[i] # 0X) DO
|
||||
UTILS.OutChar(s[i]);
|
||||
INC(i)
|
||||
END
|
||||
END String;
|
||||
|
||||
|
||||
PROCEDURE Int* (x: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 24 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
STRINGS.IntToStr(x, s);
|
||||
String(s)
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE Int2* (x: INTEGER);
|
||||
BEGIN
|
||||
IF x < 10 THEN
|
||||
String("0")
|
||||
END;
|
||||
Int(x)
|
||||
END Int2;
|
||||
|
||||
|
||||
PROCEDURE Ln*;
|
||||
BEGIN
|
||||
String(UTILS.eol)
|
||||
END Ln;
|
||||
|
||||
|
||||
PROCEDURE StringLn* (s: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
String(s);
|
||||
Ln
|
||||
END StringLn;
|
||||
|
||||
|
||||
PROCEDURE IntLn* (x: INTEGER);
|
||||
BEGIN
|
||||
Int(x);
|
||||
Ln
|
||||
END IntLn;
|
||||
|
||||
|
||||
PROCEDURE Int2Ln* (x: INTEGER);
|
||||
BEGIN
|
||||
Int2(x);
|
||||
Ln
|
||||
END Int2Ln;
|
||||
|
||||
|
||||
PROCEDURE Dashes*;
|
||||
BEGIN
|
||||
StringLn("------------------------------------------------")
|
||||
END Dashes;
|
||||
|
||||
|
||||
END CONSOLE.
|
||||
@@ -1,352 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2023, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE Compiler;
|
||||
|
||||
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE,
|
||||
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN, TEXTDRV;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
DEF_WINDOWS = "WINDOWS";
|
||||
DEF_LINUX = "LINUX";
|
||||
DEF_KOLIBRIOS = "KOLIBRIOS";
|
||||
DEF_CPU_X86 = "CPU_X86";
|
||||
DEF_CPU_X8664 = "CPU_X8664";
|
||||
|
||||
|
||||
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH);
|
||||
VAR
|
||||
param: PARS.PATH;
|
||||
i, j: INTEGER;
|
||||
_end: BOOLEAN;
|
||||
value: INTEGER;
|
||||
minor,
|
||||
major: INTEGER;
|
||||
checking: SET;
|
||||
|
||||
|
||||
PROCEDURE getVal (VAR i: INTEGER; VAR value: INTEGER);
|
||||
VAR
|
||||
param: PARS.PATH;
|
||||
val: INTEGER;
|
||||
BEGIN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, val) THEN
|
||||
value := val
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
END getVal;
|
||||
|
||||
|
||||
BEGIN
|
||||
options.lower := TRUE;
|
||||
out := "";
|
||||
checking := options.checking;
|
||||
_end := FALSE;
|
||||
i := 3;
|
||||
REPEAT
|
||||
UTILS.GetArg(i, param);
|
||||
|
||||
IF param = "-stk" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN
|
||||
options.stack := value
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
ELSIF param = "-out" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
ELSE
|
||||
out := param
|
||||
END
|
||||
|
||||
ELSIF param = "-tab" THEN
|
||||
getVal(i, options.tab)
|
||||
|
||||
ELSIF param = "-ram" THEN
|
||||
getVal(i, options.ram)
|
||||
|
||||
ELSIF param = "-rom" THEN
|
||||
getVal(i, options.rom)
|
||||
|
||||
ELSIF param = "-nochk" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
ELSE
|
||||
j := 0;
|
||||
WHILE param[j] # 0X DO
|
||||
|
||||
IF param[j] = "p" THEN
|
||||
EXCL(checking, ST.chkPTR)
|
||||
ELSIF param[j] = "t" THEN
|
||||
EXCL(checking, ST.chkGUARD)
|
||||
ELSIF param[j] = "i" THEN
|
||||
EXCL(checking, ST.chkIDX)
|
||||
ELSIF param[j] = "b" THEN
|
||||
EXCL(checking, ST.chkBYTE)
|
||||
ELSIF param[j] = "c" THEN
|
||||
EXCL(checking, ST.chkCHR)
|
||||
ELSIF param[j] = "w" THEN
|
||||
EXCL(checking, ST.chkWCHR)
|
||||
ELSIF param[j] = "r" THEN
|
||||
EXCL(checking, ST.chkCHR);
|
||||
EXCL(checking, ST.chkWCHR);
|
||||
EXCL(checking, ST.chkBYTE)
|
||||
ELSIF param[j] = "s" THEN
|
||||
EXCL(checking, ST.chkSTK)
|
||||
ELSIF param[j] = "a" THEN
|
||||
checking := {}
|
||||
END;
|
||||
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
END
|
||||
|
||||
ELSIF param = "-ver" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
IF STRINGS.StrToVer(param, major, minor) THEN
|
||||
options.version := major * 65536 + minor
|
||||
END;
|
||||
IF param[0] = "-" THEN
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
ELSIF param = "-lower" THEN
|
||||
options.lower := TRUE
|
||||
|
||||
ELSIF param = "-upper" THEN
|
||||
options.lower := FALSE
|
||||
|
||||
ELSIF param = "-pic" THEN
|
||||
options.pic := TRUE
|
||||
|
||||
ELSIF param = "-uses" THEN
|
||||
options.uses := TRUE
|
||||
|
||||
ELSIF param = "-def" THEN
|
||||
INC(i);
|
||||
UTILS.GetArg(i, param);
|
||||
SCAN.NewDef(param)
|
||||
|
||||
ELSIF param = "" THEN
|
||||
_end := TRUE
|
||||
|
||||
ELSE
|
||||
ERRORS.BadParam(param)
|
||||
END;
|
||||
|
||||
INC(i)
|
||||
UNTIL _end;
|
||||
|
||||
options.checking := checking
|
||||
END keys;
|
||||
|
||||
|
||||
PROCEDURE OutTargetItem (target: INTEGER; text: ARRAY OF CHAR);
|
||||
VAR
|
||||
width: INTEGER;
|
||||
|
||||
BEGIN
|
||||
width := 15;
|
||||
width := width - LENGTH(TARGETS.Targets[target].ComLinePar) - 4;
|
||||
C.String(" '"); C.String(TARGETS.Targets[target].ComLinePar); C.String("'");
|
||||
WHILE width > 0 DO
|
||||
C.String(20X);
|
||||
DEC(width)
|
||||
END;
|
||||
C.StringLn(text)
|
||||
END OutTargetItem;
|
||||
|
||||
|
||||
PROCEDURE main;
|
||||
VAR
|
||||
path: PARS.PATH;
|
||||
inname: PARS.PATH;
|
||||
ext: PARS.PATH;
|
||||
app_path: PARS.PATH;
|
||||
lib_path: PARS.PATH;
|
||||
modname: PARS.PATH;
|
||||
outname: PARS.PATH;
|
||||
param: PARS.PATH;
|
||||
temp: PARS.PATH;
|
||||
target: INTEGER;
|
||||
time: INTEGER;
|
||||
options: PROG.OPTIONS;
|
||||
|
||||
BEGIN
|
||||
options.stack := 2;
|
||||
options.tab := TEXTDRV.defTabSize;
|
||||
options.version := 65536;
|
||||
options.pic := FALSE;
|
||||
options.lower := FALSE;
|
||||
options.uses := FALSE;
|
||||
options.checking := ST.chkALL;
|
||||
|
||||
PATHS.GetCurrentDirectory(app_path);
|
||||
|
||||
UTILS.GetArg(0, temp);
|
||||
PATHS.split(temp, path, modname, ext);
|
||||
IF PATHS.isRelative(path) THEN
|
||||
PATHS.RelPath(app_path, path, temp);
|
||||
path := temp
|
||||
END;
|
||||
lib_path := path;
|
||||
|
||||
UTILS.GetArg(1, inname);
|
||||
STRINGS.replace(inname, "\", UTILS.slash);
|
||||
STRINGS.replace(inname, "/", UTILS.slash);
|
||||
|
||||
C.Ln;
|
||||
C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
|
||||
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date);
|
||||
C.StringLn("Copyright (c) 2018-2023, Anton Krotov");
|
||||
|
||||
IF inname = "" THEN
|
||||
C.Ln;
|
||||
C.StringLn("Usage: Compiler <main module> <target> [optional settings]"); C.Ln;
|
||||
C.StringLn("target =");
|
||||
IF UTILS.bit_depth = 64 THEN
|
||||
OutTargetItem(TARGETS.Win64C, "Windows64 Console");
|
||||
OutTargetItem(TARGETS.Win64GUI, "Windows64 GUI");
|
||||
OutTargetItem(TARGETS.Win64DLL, "Windows64 DLL");
|
||||
OutTargetItem(TARGETS.Linux64, "Linux64 Exec");
|
||||
OutTargetItem(TARGETS.Linux64SO, "Linux64 SO")
|
||||
END;
|
||||
OutTargetItem(TARGETS.Win32C, "Windows32 Console");
|
||||
OutTargetItem(TARGETS.Win32GUI, "Windows32 GUI");
|
||||
OutTargetItem(TARGETS.Win32DLL, "Windows32 DLL");
|
||||
OutTargetItem(TARGETS.Linux32, "Linux32 Exec");
|
||||
OutTargetItem(TARGETS.Linux32SO, "Linux32 SO");
|
||||
OutTargetItem(TARGETS.KolibriOS, "KolibriOS Exec");
|
||||
OutTargetItem(TARGETS.KolibriOSDLL, "KolibriOS DLL");
|
||||
OutTargetItem(TARGETS.MSP430, "MSP430x{1,2}xx microcontrollers");
|
||||
OutTargetItem(TARGETS.STM32CM3, "STM32 Cortex-M3 microcontrollers");
|
||||
C.Ln;
|
||||
C.StringLn("optional settings:"); C.Ln;
|
||||
C.StringLn(" -out <file name> output"); C.Ln;
|
||||
C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
|
||||
C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,");
|
||||
C.StringLn(" BYTE, CHR, WCHR)"); C.Ln;
|
||||
C.StringLn(" -lower allow lower case for keywords (default)"); C.Ln;
|
||||
C.StringLn(" -upper only upper case for keywords"); C.Ln;
|
||||
C.StringLn(" -def <identifier> define conditional compilation symbol"); C.Ln;
|
||||
C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln;
|
||||
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
|
||||
C.StringLn(" -rom <size> set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;
|
||||
C.StringLn(" -tab <width> set width for tabs"); C.Ln;
|
||||
C.StringLn(" -uses list imported modules"); C.Ln;
|
||||
UTILS.Exit(0)
|
||||
END;
|
||||
|
||||
C.Dashes;
|
||||
PATHS.split(inname, path, modname, ext);
|
||||
|
||||
IF ext # UTILS.FILE_EXT THEN
|
||||
ERRORS.Error(207)
|
||||
END;
|
||||
|
||||
IF PATHS.isRelative(path) THEN
|
||||
PATHS.RelPath(app_path, path, temp);
|
||||
path := temp
|
||||
END;
|
||||
|
||||
UTILS.GetArg(2, param);
|
||||
IF param = "" THEN
|
||||
ERRORS.Error(205)
|
||||
END;
|
||||
|
||||
SCAN.NewDef(param);
|
||||
|
||||
IF TARGETS.Select(param) THEN
|
||||
target := TARGETS.target
|
||||
ELSE
|
||||
ERRORS.Error(206)
|
||||
END;
|
||||
|
||||
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
|
||||
options.ram := MSP430.minRAM;
|
||||
options.rom := MSP430.minROM
|
||||
END;
|
||||
|
||||
IF (TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE) THEN
|
||||
options.ram := THUMB.minRAM;
|
||||
options.rom := THUMB.minROM
|
||||
END;
|
||||
|
||||
IF UTILS.bit_depth < TARGETS.BitDepth THEN
|
||||
ERRORS.Error(206)
|
||||
END;
|
||||
|
||||
STRINGS.append(lib_path, "lib");
|
||||
STRINGS.append(lib_path, UTILS.slash);
|
||||
STRINGS.append(lib_path, TARGETS.LibDir);
|
||||
STRINGS.append(lib_path, UTILS.slash);
|
||||
|
||||
keys(options, outname);
|
||||
TEXTDRV.setTabSize(options.tab);
|
||||
IF outname = "" THEN
|
||||
outname := path;
|
||||
STRINGS.append(outname, modname);
|
||||
STRINGS.append(outname, TARGETS.FileExt)
|
||||
ELSE
|
||||
IF PATHS.isRelative(outname) THEN
|
||||
PATHS.RelPath(app_path, outname, temp);
|
||||
outname := temp
|
||||
END
|
||||
END;
|
||||
|
||||
PARS.init(options);
|
||||
|
||||
CASE TARGETS.OS OF
|
||||
|TARGETS.osNONE:
|
||||
|TARGETS.osWIN32,
|
||||
TARGETS.osWIN64: SCAN.NewDef(DEF_WINDOWS)
|
||||
|TARGETS.osLINUX32,
|
||||
TARGETS.osLINUX64: SCAN.NewDef(DEF_LINUX)
|
||||
|TARGETS.osKOS: SCAN.NewDef(DEF_KOLIBRIOS)
|
||||
END;
|
||||
|
||||
CASE TARGETS.CPU OF
|
||||
|TARGETS.cpuX86: SCAN.NewDef(DEF_CPU_X86)
|
||||
|TARGETS.cpuAMD64: SCAN.NewDef(DEF_CPU_X8664)
|
||||
|TARGETS.cpuMSP430:
|
||||
|TARGETS.cpuTHUMB:
|
||||
|TARGETS.cpuRVM32I:
|
||||
|TARGETS.cpuRVM64I:
|
||||
END;
|
||||
|
||||
ST.compile(path, lib_path, modname, outname, target, options);
|
||||
|
||||
time := UTILS.GetTickCount() - UTILS.time;
|
||||
C.Dashes;
|
||||
C.Int(PARS.lines); C.String(" lines, ");
|
||||
C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, ");
|
||||
C.Int(WRITER.counter); C.StringLn(" bytes");
|
||||
|
||||
UTILS.Exit(0)
|
||||
END main;
|
||||
|
||||
|
||||
BEGIN
|
||||
main
|
||||
END Compiler.
|
||||
@@ -1,592 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE ELF;
|
||||
|
||||
IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS, STRINGS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
EI_NIDENT = 16;
|
||||
ET_EXEC = 2;
|
||||
ET_DYN = 3;
|
||||
|
||||
EM_386 = 3;
|
||||
EM_8664 = 3EH;
|
||||
|
||||
ELFCLASS32 = 1;
|
||||
ELFCLASS64 = 2;
|
||||
|
||||
ELFDATA2LSB = 1;
|
||||
ELFDATA2MSB = 2;
|
||||
|
||||
PF_X = 1;
|
||||
PF_W = 2;
|
||||
PF_R = 4;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
Elf32_Ehdr = RECORD
|
||||
|
||||
e_ident: ARRAY EI_NIDENT OF BYTE;
|
||||
|
||||
e_type,
|
||||
e_machine: WCHAR;
|
||||
|
||||
e_version,
|
||||
e_entry,
|
||||
e_phoff,
|
||||
e_shoff,
|
||||
e_flags: INTEGER;
|
||||
|
||||
e_ehsize,
|
||||
e_phentsize,
|
||||
e_phnum,
|
||||
e_shentsize,
|
||||
e_shnum,
|
||||
e_shstrndx: WCHAR
|
||||
|
||||
END;
|
||||
|
||||
|
||||
Elf32_Phdr = RECORD
|
||||
|
||||
p_type,
|
||||
p_offset,
|
||||
p_vaddr,
|
||||
p_paddr,
|
||||
p_filesz,
|
||||
p_memsz,
|
||||
p_flags,
|
||||
p_align: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
d_tag, d_val: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
Elf32_Sym = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
name, value, size: INTEGER;
|
||||
info, other: CHAR;
|
||||
shndx: WCHAR
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
dynamic: LISTS.LIST;
|
||||
strtab: CHL.BYTELIST;
|
||||
symtab: LISTS.LIST;
|
||||
|
||||
hashtab, bucket, chain: CHL.INTLIST;
|
||||
|
||||
|
||||
PROCEDURE Write16 (w: WCHAR);
|
||||
BEGIN
|
||||
WR.Write16LE(ORD(w))
|
||||
END Write16;
|
||||
|
||||
|
||||
PROCEDURE WritePH (ph: Elf32_Phdr);
|
||||
BEGIN
|
||||
WR.Write32LE(ph.p_type);
|
||||
WR.Write32LE(ph.p_offset);
|
||||
WR.Write32LE(ph.p_vaddr);
|
||||
WR.Write32LE(ph.p_paddr);
|
||||
WR.Write32LE(ph.p_filesz);
|
||||
WR.Write32LE(ph.p_memsz);
|
||||
WR.Write32LE(ph.p_flags);
|
||||
WR.Write32LE(ph.p_align)
|
||||
END WritePH;
|
||||
|
||||
|
||||
PROCEDURE WritePH64 (ph: Elf32_Phdr);
|
||||
BEGIN
|
||||
WR.Write32LE(ph.p_type);
|
||||
WR.Write32LE(ph.p_flags);
|
||||
WR.Write64LE(ph.p_offset);
|
||||
WR.Write64LE(ph.p_vaddr);
|
||||
WR.Write64LE(ph.p_paddr);
|
||||
WR.Write64LE(ph.p_filesz);
|
||||
WR.Write64LE(ph.p_memsz);
|
||||
WR.Write64LE(ph.p_align)
|
||||
END WritePH64;
|
||||
|
||||
|
||||
PROCEDURE NewDyn (tag, val: INTEGER);
|
||||
VAR
|
||||
dyn: Elf32_Dyn;
|
||||
|
||||
BEGIN
|
||||
NEW(dyn);
|
||||
dyn.d_tag := tag;
|
||||
dyn.d_val := val;
|
||||
LISTS.push(dynamic, dyn)
|
||||
END NewDyn;
|
||||
|
||||
|
||||
PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR);
|
||||
VAR
|
||||
sym: Elf32_Sym;
|
||||
|
||||
BEGIN
|
||||
NEW(sym);
|
||||
sym.name := name;
|
||||
sym.value := value;
|
||||
sym.size := size;
|
||||
sym.info := info;
|
||||
sym.other := other;
|
||||
sym.shndx := shndx;
|
||||
|
||||
LISTS.push(symtab, sym)
|
||||
END NewSym;
|
||||
|
||||
|
||||
PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER);
|
||||
VAR
|
||||
symi, hi, k: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR symi := 0 TO symCount - 1 DO
|
||||
CHL.SetInt(chain, symi, 0);
|
||||
hi := CHL.GetInt(hashtab, symi) MOD symCount;
|
||||
IF CHL.GetInt(bucket, hi) # 0 THEN
|
||||
k := symi;
|
||||
WHILE CHL.GetInt(chain, k) # 0 DO
|
||||
k := CHL.GetInt(chain, k)
|
||||
END;
|
||||
CHL.SetInt(chain, k, CHL.GetInt(bucket, hi))
|
||||
END;
|
||||
CHL.SetInt(bucket, hi, symi)
|
||||
END
|
||||
END MakeHash;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN);
|
||||
CONST
|
||||
interp = 0;
|
||||
dyn = 1;
|
||||
header = 2;
|
||||
text = 3;
|
||||
data = 4;
|
||||
bss = 5;
|
||||
|
||||
linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2";
|
||||
linuxInterpreter32 = "/lib/ld-linux.so.2";
|
||||
|
||||
exeBaseAddress32 = 8048000H;
|
||||
exeBaseAddress64 = 400000H;
|
||||
dllBaseAddress = 0;
|
||||
|
||||
DT_NULL = 0;
|
||||
DT_NEEDED = 1;
|
||||
DT_HASH = 4;
|
||||
DT_STRTAB = 5;
|
||||
DT_SYMTAB = 6;
|
||||
DT_RELA = 7;
|
||||
DT_RELASZ = 8;
|
||||
DT_RELAENT = 9;
|
||||
DT_STRSZ = 10;
|
||||
DT_SYMENT = 11;
|
||||
DT_INIT = 12;
|
||||
DT_FINI = 13;
|
||||
DT_SONAME = 14;
|
||||
DT_REL = 17;
|
||||
DT_RELSZ = 18;
|
||||
DT_RELENT = 19;
|
||||
|
||||
VAR
|
||||
ehdr: Elf32_Ehdr;
|
||||
phdr: ARRAY 16 OF Elf32_Phdr;
|
||||
|
||||
i, BaseAdr, DynAdr, offset, pad, VA, symCount: INTEGER;
|
||||
|
||||
SizeOf: RECORD header, code, data, bss: INTEGER END;
|
||||
|
||||
Offset: RECORD symtab, reltab, hash, strtab: INTEGER END;
|
||||
|
||||
Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER;
|
||||
|
||||
item: LISTS.ITEM;
|
||||
|
||||
Name: ARRAY 2048 OF CHAR;
|
||||
|
||||
Address: PE32.VIRTUAL_ADDR;
|
||||
|
||||
BEGIN
|
||||
dynamic := LISTS.create(NIL);
|
||||
symtab := LISTS.create(NIL);
|
||||
strtab := CHL.CreateByteList();
|
||||
|
||||
IF amd64 THEN
|
||||
BaseAdr := exeBaseAddress64;
|
||||
Interpreter := linuxInterpreter64
|
||||
ELSE
|
||||
BaseAdr := exeBaseAddress32;
|
||||
Interpreter := linuxInterpreter32
|
||||
END;
|
||||
|
||||
IF so THEN
|
||||
BaseAdr := dllBaseAddress
|
||||
END;
|
||||
|
||||
lenInterpreter := LENGTH(Interpreter) + 1;
|
||||
|
||||
SizeOf.code := CHL.Length(program.code);
|
||||
SizeOf.data := CHL.Length(program.data);
|
||||
SizeOf.bss := program.bss;
|
||||
|
||||
ehdr.e_ident[0] := 7FH;
|
||||
ehdr.e_ident[1] := ORD("E");
|
||||
ehdr.e_ident[2] := ORD("L");
|
||||
ehdr.e_ident[3] := ORD("F");
|
||||
IF amd64 THEN
|
||||
ehdr.e_ident[4] := ELFCLASS64
|
||||
ELSE
|
||||
ehdr.e_ident[4] := ELFCLASS32
|
||||
END;
|
||||
ehdr.e_ident[5] := ELFDATA2LSB;
|
||||
ehdr.e_ident[6] := 1;
|
||||
ehdr.e_ident[7] := 3;
|
||||
FOR i := 8 TO EI_NIDENT - 1 DO
|
||||
ehdr.e_ident[i] := 0
|
||||
END;
|
||||
|
||||
IF so THEN
|
||||
ehdr.e_type := WCHR(ET_DYN)
|
||||
ELSE
|
||||
ehdr.e_type := WCHR(ET_EXEC)
|
||||
END;
|
||||
|
||||
ehdr.e_version := 1;
|
||||
ehdr.e_shoff := 0;
|
||||
ehdr.e_flags := 0;
|
||||
ehdr.e_shnum := WCHR(0);
|
||||
ehdr.e_shstrndx := WCHR(0);
|
||||
ehdr.e_phnum := WCHR(6);
|
||||
|
||||
IF amd64 THEN
|
||||
ehdr.e_machine := WCHR(EM_8664);
|
||||
ehdr.e_phoff := 40H;
|
||||
ehdr.e_ehsize := WCHR(40H);
|
||||
ehdr.e_phentsize := WCHR(38H);
|
||||
ehdr.e_shentsize := WCHR(40H)
|
||||
ELSE
|
||||
ehdr.e_machine := WCHR(EM_386);
|
||||
ehdr.e_phoff := 34H;
|
||||
ehdr.e_ehsize := WCHR(34H);
|
||||
ehdr.e_phentsize := WCHR(20H);
|
||||
ehdr.e_shentsize := WCHR(28H)
|
||||
END;
|
||||
|
||||
SizeOf.header := ORD(ehdr.e_ehsize) + ORD(ehdr.e_phentsize) * ORD(ehdr.e_phnum);
|
||||
|
||||
phdr[interp].p_type := 3;
|
||||
phdr[interp].p_offset := SizeOf.header;
|
||||
phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset;
|
||||
phdr[interp].p_paddr := phdr[interp].p_vaddr;
|
||||
phdr[interp].p_filesz := lenInterpreter;
|
||||
phdr[interp].p_memsz := lenInterpreter;
|
||||
phdr[interp].p_flags := PF_R;
|
||||
phdr[interp].p_align := 1;
|
||||
|
||||
phdr[dyn].p_type := 2;
|
||||
phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz;
|
||||
phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset;
|
||||
phdr[dyn].p_paddr := phdr[dyn].p_vaddr;
|
||||
|
||||
hashtab := CHL.CreateIntList();
|
||||
|
||||
CHL.PushInt(hashtab, STRINGS.HashStr(""));
|
||||
NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X);
|
||||
CHL.PushInt(hashtab, STRINGS.HashStr("dlopen"));
|
||||
NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X);
|
||||
CHL.PushInt(hashtab, STRINGS.HashStr("dlsym"));
|
||||
NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X);
|
||||
|
||||
IF so THEN
|
||||
item := program.exp_list.first;
|
||||
WHILE item # NIL DO
|
||||
ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name));
|
||||
CHL.PushInt(hashtab, STRINGS.HashStr(Name));
|
||||
NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X);
|
||||
item := item.next
|
||||
END;
|
||||
ASSERT(CHL.GetStr(program.data, program.modname, Name))
|
||||
END;
|
||||
|
||||
symCount := LISTS.count(symtab);
|
||||
|
||||
bucket := CHL.CreateIntList();
|
||||
chain := CHL.CreateIntList();
|
||||
|
||||
FOR i := 1 TO symCount DO
|
||||
CHL.PushInt(bucket, 0);
|
||||
CHL.PushInt(chain, 0)
|
||||
END;
|
||||
|
||||
MakeHash(bucket, chain, symCount);
|
||||
|
||||
NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2"));
|
||||
NewDyn(DT_STRTAB, 0);
|
||||
NewDyn(DT_STRSZ, CHL.Length(strtab));
|
||||
NewDyn(DT_SYMTAB, 0);
|
||||
|
||||
IF amd64 THEN
|
||||
NewDyn(DT_SYMENT, 24);
|
||||
NewDyn(DT_RELA, 0);
|
||||
NewDyn(DT_RELASZ, 48);
|
||||
NewDyn(DT_RELAENT, 24)
|
||||
ELSE
|
||||
NewDyn(DT_SYMENT, 16);
|
||||
NewDyn(DT_REL, 0);
|
||||
NewDyn(DT_RELSZ, 16);
|
||||
NewDyn(DT_RELENT, 8)
|
||||
END;
|
||||
|
||||
NewDyn(DT_HASH, 0);
|
||||
|
||||
IF so THEN
|
||||
NewDyn(DT_SONAME, CHL.PushStr(strtab, Name));
|
||||
NewDyn(DT_INIT, 0);
|
||||
NewDyn(DT_FINI, 0)
|
||||
END;
|
||||
|
||||
NewDyn(DT_NULL, 0);
|
||||
|
||||
Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64));
|
||||
Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64));
|
||||
Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2;
|
||||
Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4;
|
||||
|
||||
DynAdr := phdr[dyn].p_offset + BaseAdr;
|
||||
|
||||
item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + DynAdr;
|
||||
item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + DynAdr;
|
||||
item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + DynAdr;
|
||||
item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + DynAdr;
|
||||
|
||||
phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64);
|
||||
phdr[dyn].p_memsz := phdr[dyn].p_filesz;
|
||||
|
||||
phdr[dyn].p_flags := PF_R;
|
||||
phdr[dyn].p_align := 1;
|
||||
|
||||
offset := 0;
|
||||
|
||||
phdr[header].p_type := 1;
|
||||
phdr[header].p_offset := offset;
|
||||
phdr[header].p_vaddr := BaseAdr;
|
||||
phdr[header].p_paddr := BaseAdr;
|
||||
phdr[header].p_filesz := SizeOf.header + lenInterpreter + phdr[dyn].p_filesz;
|
||||
phdr[header].p_memsz := phdr[header].p_filesz;
|
||||
phdr[header].p_flags := PF_R + PF_W;
|
||||
phdr[header].p_align := 1000H;
|
||||
|
||||
INC(offset, phdr[header].p_filesz);
|
||||
VA := BaseAdr + offset + 1000H;
|
||||
|
||||
phdr[text].p_type := 1;
|
||||
phdr[text].p_offset := offset;
|
||||
phdr[text].p_vaddr := VA;
|
||||
phdr[text].p_paddr := VA;
|
||||
phdr[text].p_filesz := SizeOf.code;
|
||||
phdr[text].p_memsz := SizeOf.code;
|
||||
phdr[text].p_flags := PF_X + PF_R;
|
||||
phdr[text].p_align := 1000H;
|
||||
|
||||
ehdr.e_entry := phdr[text].p_vaddr;
|
||||
|
||||
INC(offset, phdr[text].p_filesz);
|
||||
VA := BaseAdr + offset + 2000H;
|
||||
pad := (16 - VA MOD 16) MOD 16;
|
||||
|
||||
phdr[data].p_type := 1;
|
||||
phdr[data].p_offset := offset;
|
||||
phdr[data].p_vaddr := VA;
|
||||
phdr[data].p_paddr := VA;
|
||||
phdr[data].p_filesz := SizeOf.data + pad;
|
||||
phdr[data].p_memsz := SizeOf.data + pad;
|
||||
phdr[data].p_flags := PF_R + PF_W;
|
||||
phdr[data].p_align := 1000H;
|
||||
|
||||
INC(offset, phdr[data].p_filesz);
|
||||
VA := BaseAdr + offset + 3000H;
|
||||
|
||||
phdr[bss].p_type := 1;
|
||||
phdr[bss].p_offset := offset;
|
||||
phdr[bss].p_vaddr := VA;
|
||||
phdr[bss].p_paddr := VA;
|
||||
phdr[bss].p_filesz := 0;
|
||||
phdr[bss].p_memsz := SizeOf.bss + 16;
|
||||
phdr[bss].p_flags := PF_R + PF_W;
|
||||
phdr[bss].p_align := 1000H;
|
||||
|
||||
Address.Code := ehdr.e_entry;
|
||||
Address.Data := phdr[data].p_vaddr + pad;
|
||||
Address.Bss := WR.align(phdr[bss].p_vaddr, 16);
|
||||
Address.Import := 0;
|
||||
|
||||
PE32.fixup(program, Address, amd64);
|
||||
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
IF item(Elf32_Sym).value # 0 THEN
|
||||
INC(item(Elf32_Sym).value, ehdr.e_entry)
|
||||
END;
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
IF so THEN
|
||||
item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry;
|
||||
item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry
|
||||
END;
|
||||
|
||||
WR.Create(FileName);
|
||||
|
||||
FOR i := 0 TO EI_NIDENT - 1 DO
|
||||
WR.WriteByte(ehdr.e_ident[i])
|
||||
END;
|
||||
|
||||
Write16(ehdr.e_type);
|
||||
Write16(ehdr.e_machine);
|
||||
|
||||
WR.Write32LE(ehdr.e_version);
|
||||
IF amd64 THEN
|
||||
WR.Write64LE(ehdr.e_entry);
|
||||
WR.Write64LE(ehdr.e_phoff);
|
||||
WR.Write64LE(ehdr.e_shoff)
|
||||
ELSE
|
||||
WR.Write32LE(ehdr.e_entry);
|
||||
WR.Write32LE(ehdr.e_phoff);
|
||||
WR.Write32LE(ehdr.e_shoff)
|
||||
END;
|
||||
WR.Write32LE(ehdr.e_flags);
|
||||
|
||||
Write16(ehdr.e_ehsize);
|
||||
Write16(ehdr.e_phentsize);
|
||||
Write16(ehdr.e_phnum);
|
||||
Write16(ehdr.e_shentsize);
|
||||
Write16(ehdr.e_shnum);
|
||||
Write16(ehdr.e_shstrndx);
|
||||
|
||||
IF amd64 THEN
|
||||
WritePH64(phdr[interp]);
|
||||
WritePH64(phdr[dyn]);
|
||||
WritePH64(phdr[header]);
|
||||
WritePH64(phdr[text]);
|
||||
WritePH64(phdr[data]);
|
||||
WritePH64(phdr[bss])
|
||||
ELSE
|
||||
WritePH(phdr[interp]);
|
||||
WritePH(phdr[dyn]);
|
||||
WritePH(phdr[header]);
|
||||
WritePH(phdr[text]);
|
||||
WritePH(phdr[data]);
|
||||
WritePH(phdr[bss])
|
||||
END;
|
||||
|
||||
FOR i := 0 TO lenInterpreter - 1 DO
|
||||
WR.WriteByte(ORD(Interpreter[i]))
|
||||
END;
|
||||
|
||||
IF amd64 THEN
|
||||
item := dynamic.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write64LE(item(Elf32_Dyn).d_tag);
|
||||
WR.Write64LE(item(Elf32_Dyn).d_val);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(item(Elf32_Sym).name);
|
||||
WR.WriteByte(ORD(item(Elf32_Sym).info));
|
||||
WR.WriteByte(ORD(item(Elf32_Sym).other));
|
||||
Write16(item(Elf32_Sym).shndx);
|
||||
WR.Write64LE(item(Elf32_Sym).value);
|
||||
WR.Write64LE(item(Elf32_Sym).size);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 16);
|
||||
WR.Write32LE(1);
|
||||
WR.Write32LE(1);
|
||||
WR.Write64LE(0);
|
||||
WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 8);
|
||||
WR.Write32LE(1);
|
||||
WR.Write32LE(2);
|
||||
WR.Write64LE(0)
|
||||
|
||||
ELSE
|
||||
item := dynamic.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(item(Elf32_Dyn).d_tag);
|
||||
WR.Write32LE(item(Elf32_Dyn).d_val);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
item := symtab.first;
|
||||
WHILE item # NIL DO
|
||||
WR.Write32LE(item(Elf32_Sym).name);
|
||||
WR.Write32LE(item(Elf32_Sym).value);
|
||||
WR.Write32LE(item(Elf32_Sym).size);
|
||||
WR.WriteByte(ORD(item(Elf32_Sym).info));
|
||||
WR.WriteByte(ORD(item(Elf32_Sym).other));
|
||||
Write16(item(Elf32_Sym).shndx);
|
||||
item := item.next
|
||||
END;
|
||||
|
||||
WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 8);
|
||||
WR.Write32LE(00000101H);
|
||||
WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 4);
|
||||
WR.Write32LE(00000201H)
|
||||
|
||||
END;
|
||||
|
||||
WR.Write32LE(symCount);
|
||||
WR.Write32LE(symCount);
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(CHL.GetInt(bucket, i))
|
||||
END;
|
||||
|
||||
FOR i := 0 TO symCount - 1 DO
|
||||
WR.Write32LE(CHL.GetInt(chain, i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(strtab);
|
||||
|
||||
IF amd64 THEN
|
||||
WR.Write64LE(0);
|
||||
WR.Write64LE(0)
|
||||
ELSE
|
||||
WR.Write32LE(0);
|
||||
WR.Write32LE(0)
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(program.code);
|
||||
WHILE pad > 0 DO
|
||||
WR.WriteByte(0);
|
||||
DEC(pad)
|
||||
END;
|
||||
CHL.WriteToFile(program.data);
|
||||
WR.Close;
|
||||
UTILS.chmod(FileName)
|
||||
END write;
|
||||
|
||||
|
||||
END ELF.
|
||||
@@ -1,222 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2022, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE ERRORS;
|
||||
|
||||
IMPORT C := CONSOLE, UTILS;
|
||||
|
||||
|
||||
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER);
|
||||
BEGIN
|
||||
IF hint = 0 THEN
|
||||
C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
C.String("variable '"); C.String(name); C.StringLn("' never used")
|
||||
END
|
||||
END HintMsg;
|
||||
|
||||
|
||||
PROCEDURE WarningMsg* (line, col, warning: INTEGER);
|
||||
BEGIN
|
||||
C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
CASE warning OF
|
||||
|0: C.StringLn("passing a string value as a fixed array")
|
||||
|1: C.StringLn("endless FOR loop")
|
||||
|2: C.StringLn("identifier too long")
|
||||
END
|
||||
END WarningMsg;
|
||||
|
||||
|
||||
PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER);
|
||||
VAR
|
||||
str: ARRAY 80 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") ");
|
||||
|
||||
CASE errno OF
|
||||
| 1: str := "missing 'H' or 'X'"
|
||||
| 2: str := "missing scale"
|
||||
| 3: str := "unclosed string"
|
||||
| 4: str := "illegal character"
|
||||
| 5: str := "string too long"
|
||||
|
||||
| 7: str := "number too long"
|
||||
| 8..12: str := "number too large"
|
||||
| 13: str := "real numbers not supported"
|
||||
|
||||
| 21: str := "'MODULE' expected"
|
||||
| 22: str := "identifier expected"
|
||||
| 23: str := "module name does not match file name"
|
||||
| 24: str := "';' expected"
|
||||
| 25: str := "identifier does not match module name"
|
||||
| 26: str := "'.' expected"
|
||||
| 27: str := "'END' expected"
|
||||
| 28: str := "',', ';' or ':=' expected"
|
||||
| 29: str := "module not found"
|
||||
| 30: str := "multiply defined identifier"
|
||||
| 31: str := "recursive import"
|
||||
| 32: str := "'=' expected"
|
||||
| 33: str := "')' expected"
|
||||
| 34: str := "syntax error in expression"
|
||||
| 35: str := "'}' expected"
|
||||
| 36: str := "incompatible operand"
|
||||
| 37: str := "incompatible operands"
|
||||
| 38: str := "'RETURN' expected"
|
||||
| 39: str := "integer overflow"
|
||||
| 40: str := "floating point overflow"
|
||||
| 41: str := "not enough floating point registers; simplify expression"
|
||||
| 42: str := "out of range 0..255"
|
||||
| 43: str := "expression is not an integer"
|
||||
| 44: str := "out of range 0..MAXSET"
|
||||
| 45: str := "division by zero"
|
||||
| 46: str := "IV out of range"
|
||||
| 47: str := "'OF' or ',' expected"
|
||||
| 48: str := "undeclared identifier"
|
||||
| 49: str := "type expected"
|
||||
| 50: str := "recursive type definition"
|
||||
| 51: str := "illegal value of constant"
|
||||
| 52: str := "not a record type"
|
||||
| 53: str := "':' expected"
|
||||
| 54: str := "need to import SYSTEM"
|
||||
| 55: str := "pointer type not defined"
|
||||
| 56: str := "out of range 0..MAXSET"
|
||||
| 57: str := "'TO' expected"
|
||||
| 58: str := "not a record type"
|
||||
| 59: str := "this expression cannot be a procedure"
|
||||
| 60: str := "identifier does not match procedure name"
|
||||
| 61: str := "illegally marked identifier"
|
||||
| 62: str := "expression should be constant"
|
||||
| 63: str := "not enough RAM"
|
||||
| 64: str := "'(' expected"
|
||||
| 65: str := "',' expected"
|
||||
| 66: str := "incompatible parameter"
|
||||
| 67: str := "'OF' expected"
|
||||
| 68: str := "type expected"
|
||||
| 69: str := "result type of procedure is not a basic type"
|
||||
| 70: str := "import not supported"
|
||||
| 71: str := "']' expected"
|
||||
| 72: str := "expression is not BOOLEAN"
|
||||
| 73: str := "not a record"
|
||||
| 74: str := "undefined record field"
|
||||
| 75: str := "not an array"
|
||||
| 76: str := "expression is not an integer"
|
||||
| 77: str := "not a pointer"
|
||||
| 78: str := "type guard not allowed"
|
||||
| 79: str := "not a type"
|
||||
| 80: str := "not a record type"
|
||||
| 81: str := "not a pointer type"
|
||||
| 82: str := "type guard not allowed"
|
||||
| 83: str := "index out of range"
|
||||
| 84: str := "dimension too large"
|
||||
| 85: str := "procedure must have level 0"
|
||||
| 86: str := "not a procedure"
|
||||
| 87: str := "incompatible expression (RETURN)"
|
||||
| 88: str := "'THEN' expected"
|
||||
| 89: str := "'DO' expected"
|
||||
| 90: str := "'UNTIL' expected"
|
||||
| 91: str := "incompatible assignment"
|
||||
| 92: str := "procedure call of a function"
|
||||
| 93: str := "not a variable"
|
||||
| 94: str := "read only variable"
|
||||
| 95: str := "invalid type of expression (CASE)"
|
||||
| 96: str := "':=' expected"
|
||||
| 97: str := "not INTEGER variable"
|
||||
| 98: str := "illegal value of constant (0)"
|
||||
| 99: str := "incompatible label"
|
||||
|100: str := "multiply defined label"
|
||||
|101: str := "too large parameter of WCHR"
|
||||
|102: str := "label expected"
|
||||
|103: str := "illegal value of constant"
|
||||
|104: str := "type too large"
|
||||
|105: str := "access to intermediate variables not allowed"
|
||||
|106: str := "qualified identifier expected"
|
||||
|107: str := "too large parameter of CHR"
|
||||
|108: str := "a variable or a procedure expected"
|
||||
|109: str := "expression should be constant"
|
||||
|110: str := "out of range 0..65535"
|
||||
|111: str := "record [noalign] cannot have a base type"
|
||||
|112: str := "record [noalign] cannot be a base type"
|
||||
|113: str := "result type of procedure should not be REAL"
|
||||
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|
||||
|115: str := "recursive constant definition"
|
||||
|116: str := "procedure too deep nested"
|
||||
|117: str := "string expected"
|
||||
|118: str := "'$END', '$ELSE' or '$ELSIF' without '$IF'"
|
||||
|119: str := "'$IF', '$ELSIF', '$ELSE' or '$END' expected"
|
||||
|120: str := "too many formal parameters"
|
||||
|121: str := "multiply defined handler"
|
||||
|122: str := "bad divisor"
|
||||
|123: str := "illegal flag"
|
||||
|124: str := "unknown flag"
|
||||
|125: str := "flag not supported"
|
||||
|126: str := "type of formal parameter should not be REAL"
|
||||
END;
|
||||
C.StringLn(str);
|
||||
C.String(" file: "); C.StringLn(fname);
|
||||
UTILS.Exit(1)
|
||||
END ErrorMsg;
|
||||
|
||||
|
||||
PROCEDURE Error1 (s1: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.StringLn(s1);
|
||||
UTILS.Exit(1)
|
||||
END Error1;
|
||||
|
||||
|
||||
PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(s1); C.String(s2); C.StringLn(s3);
|
||||
UTILS.Exit(1)
|
||||
END Error3;
|
||||
|
||||
|
||||
PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
C.Ln;
|
||||
C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5);
|
||||
UTILS.Exit(1)
|
||||
END Error5;
|
||||
|
||||
|
||||
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error5("procedure ", UTILS.RTL_NAME, ".", ProcName, " not found")
|
||||
END WrongRTL;
|
||||
|
||||
|
||||
PROCEDURE BadParam* (param: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error3("bad parameter: ", param, "")
|
||||
END BadParam;
|
||||
|
||||
|
||||
PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
Error5("file ", Path, Name, Ext, " not found")
|
||||
END FileNotFound;
|
||||
|
||||
|
||||
PROCEDURE Error* (n: INTEGER);
|
||||
BEGIN
|
||||
CASE n OF
|
||||
|201: Error1("writing file error")
|
||||
|202: Error1("too many relocations")
|
||||
|203: Error1("size of program is too large")
|
||||
|204: Error1("size of variables is too large")
|
||||
|205: Error1("not enough parameters")
|
||||
|206: Error1("bad parameter <target>")
|
||||
|207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"')
|
||||
|208: Error1("not enough RAM")
|
||||
END
|
||||
END Error;
|
||||
|
||||
|
||||
END ERRORS.
|
||||
@@ -1,200 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2022, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE FILES;
|
||||
|
||||
IMPORT UTILS, C := COLLECTIONS;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
FILE* = POINTER TO RECORD (C.ITEM)
|
||||
|
||||
ptr: INTEGER;
|
||||
|
||||
buffer: ARRAY 64*1024 OF BYTE;
|
||||
count: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
VAR
|
||||
|
||||
files: C.COLLECTION;
|
||||
|
||||
|
||||
PROCEDURE copy (src: ARRAY OF BYTE; src_idx: INTEGER; VAR dst: ARRAY OF BYTE; dst_idx: INTEGER; bytes: INTEGER);
|
||||
BEGIN
|
||||
WHILE bytes > 0 DO
|
||||
dst[dst_idx] := src[src_idx];
|
||||
INC(dst_idx);
|
||||
INC(src_idx);
|
||||
DEC(bytes)
|
||||
END
|
||||
END copy;
|
||||
|
||||
|
||||
PROCEDURE flush (file: FILE): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF file # NIL THEN
|
||||
res := UTILS.FileWrite(file.ptr, file.buffer, file.count);
|
||||
IF res < 0 THEN
|
||||
res := 0
|
||||
END
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END flush;
|
||||
|
||||
|
||||
PROCEDURE NewFile (): FILE;
|
||||
VAR
|
||||
file: FILE;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(files);
|
||||
IF citem = NIL THEN
|
||||
NEW(file)
|
||||
ELSE
|
||||
file := citem(FILE)
|
||||
END
|
||||
|
||||
RETURN file
|
||||
END NewFile;
|
||||
|
||||
|
||||
PROCEDURE create* (name: ARRAY OF CHAR): FILE;
|
||||
VAR
|
||||
file: FILE;
|
||||
ptr: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ptr := UTILS.FileCreate(name);
|
||||
|
||||
IF ptr > 0 THEN
|
||||
file := NewFile();
|
||||
file.ptr := ptr;
|
||||
file.count := 0
|
||||
ELSE
|
||||
file := NIL
|
||||
END
|
||||
|
||||
RETURN file
|
||||
END create;
|
||||
|
||||
|
||||
PROCEDURE open* (name: ARRAY OF CHAR): FILE;
|
||||
VAR
|
||||
file: FILE;
|
||||
ptr: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ptr := UTILS.FileOpen(name);
|
||||
|
||||
IF ptr > 0 THEN
|
||||
file := NewFile();
|
||||
file.ptr := ptr;
|
||||
file.count := -1
|
||||
ELSE
|
||||
file := NIL
|
||||
END
|
||||
|
||||
RETURN file
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE close* (VAR file: FILE);
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF file # NIL THEN
|
||||
|
||||
IF file.count > 0 THEN
|
||||
n := flush(file)
|
||||
END;
|
||||
|
||||
file.count := -1;
|
||||
|
||||
UTILS.FileClose(file.ptr);
|
||||
file.ptr := 0;
|
||||
|
||||
C.push(files, file);
|
||||
file := NIL
|
||||
END
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF file # NIL THEN
|
||||
res := UTILS.FileRead(file.ptr, chunk, MAX(MIN(bytes, LEN(chunk)), 0));
|
||||
IF res < 0 THEN
|
||||
res := 0
|
||||
END
|
||||
ELSE
|
||||
res := 0
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END read;
|
||||
|
||||
|
||||
PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
|
||||
VAR
|
||||
free, n, idx: INTEGER;
|
||||
|
||||
BEGIN
|
||||
idx := 0;
|
||||
IF (file # NIL) & (file.count >= 0) THEN
|
||||
|
||||
free := LEN(file.buffer) - file.count;
|
||||
WHILE bytes > 0 DO
|
||||
n := MIN(free, bytes);
|
||||
copy(chunk, idx, file.buffer, file.count, n);
|
||||
DEC(free, n);
|
||||
DEC(bytes, n);
|
||||
INC(idx, n);
|
||||
INC(file.count, n);
|
||||
IF free = 0 THEN
|
||||
IF flush(file) # LEN(file.buffer) THEN
|
||||
bytes := 0;
|
||||
DEC(idx, n)
|
||||
ELSE
|
||||
file.count := 0;
|
||||
free := LEN(file.buffer)
|
||||
END
|
||||
END
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
RETURN idx
|
||||
END write;
|
||||
|
||||
|
||||
PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN;
|
||||
VAR
|
||||
arr: ARRAY 1 OF BYTE;
|
||||
|
||||
BEGIN
|
||||
arr[0] := byte
|
||||
RETURN write(file, arr, 1) = 1
|
||||
END WriteByte;
|
||||
|
||||
|
||||
BEGIN
|
||||
files := C.create()
|
||||
END FILES.
|
||||
@@ -1,117 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE HEX;
|
||||
|
||||
IMPORT WRITER, CHL := CHUNKLISTS, UTILS;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
chksum: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE Byte (byte: BYTE);
|
||||
BEGIN
|
||||
WRITER.WriteByte(UTILS.hexdgt(byte DIV 16));
|
||||
WRITER.WriteByte(UTILS.hexdgt(byte MOD 16));
|
||||
INC(chksum, byte)
|
||||
END Byte;
|
||||
|
||||
|
||||
PROCEDURE Byte4 (a, b, c, d: BYTE);
|
||||
BEGIN
|
||||
Byte(a);
|
||||
Byte(b);
|
||||
Byte(c);
|
||||
Byte(d)
|
||||
END Byte4;
|
||||
|
||||
|
||||
PROCEDURE NewLine;
|
||||
BEGIN
|
||||
Byte((-chksum) MOD 256);
|
||||
chksum := 0;
|
||||
WRITER.WriteByte(0DH);
|
||||
WRITER.WriteByte(0AH)
|
||||
END NewLine;
|
||||
|
||||
|
||||
PROCEDURE StartCode;
|
||||
BEGIN
|
||||
WRITER.WriteByte(ORD(":"));
|
||||
chksum := 0
|
||||
END StartCode;
|
||||
|
||||
|
||||
PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER);
|
||||
VAR
|
||||
i, len: INTEGER;
|
||||
|
||||
BEGIN
|
||||
WHILE cnt > 0 DO
|
||||
len := MIN(cnt, 16);
|
||||
StartCode;
|
||||
Byte4(len, idx DIV 256, idx MOD 256, 0);
|
||||
FOR i := 1 TO len DO
|
||||
Byte(mem[idx]);
|
||||
INC(idx)
|
||||
END;
|
||||
DEC(cnt, len);
|
||||
NewLine
|
||||
END
|
||||
END Data;
|
||||
|
||||
|
||||
PROCEDURE ExtLA* (LA: INTEGER);
|
||||
BEGIN
|
||||
ASSERT((0 <= LA) & (LA <= 0FFFFH));
|
||||
StartCode;
|
||||
Byte4(2, 0, 0, 4);
|
||||
Byte(LA DIV 256);
|
||||
Byte(LA MOD 256);
|
||||
NewLine
|
||||
END ExtLA;
|
||||
|
||||
|
||||
PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER);
|
||||
VAR
|
||||
i, len, offset: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ExtLA(LA);
|
||||
offset := 0;
|
||||
WHILE cnt > 0 DO
|
||||
ASSERT(offset <= 65536);
|
||||
IF offset = 65536 THEN
|
||||
INC(LA);
|
||||
ExtLA(LA);
|
||||
offset := 0
|
||||
END;
|
||||
len := MIN(cnt, 16);
|
||||
StartCode;
|
||||
Byte4(len, offset DIV 256, offset MOD 256, 0);
|
||||
FOR i := 1 TO len DO
|
||||
Byte(CHL.GetByte(mem, idx));
|
||||
INC(idx);
|
||||
INC(offset)
|
||||
END;
|
||||
DEC(cnt, len);
|
||||
NewLine
|
||||
END
|
||||
END Data2;
|
||||
|
||||
|
||||
PROCEDURE End*;
|
||||
BEGIN
|
||||
StartCode;
|
||||
Byte4(0, 0, 0, 1);
|
||||
NewLine
|
||||
END End;
|
||||
|
||||
|
||||
END HEX.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,206 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE KOS;
|
||||
|
||||
IMPORT BIN, WR := WRITER, LISTS, CHL := CHUNKLISTS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
HEADER_SIZE = 36;
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
HEADER = RECORD
|
||||
|
||||
menuet01: ARRAY 9 OF CHAR;
|
||||
ver, start, size, mem, sp, param, path: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
imp: BIN.IMPRT;
|
||||
|
||||
BEGIN
|
||||
libcount := 0;
|
||||
imp := program.imp_list.first(BIN.IMPRT);
|
||||
WHILE imp # NIL DO
|
||||
IF imp.label = 0 THEN
|
||||
INC(libcount)
|
||||
END;
|
||||
imp := imp.next(BIN.IMPRT)
|
||||
END;
|
||||
|
||||
len := libcount * 2 + 2;
|
||||
size := (LISTS.count(program.imp_list) + len + 1) * SIZE_OF_DWORD;
|
||||
|
||||
ImportTable := CHL.CreateIntList();
|
||||
FOR i := 0 TO size DIV SIZE_OF_DWORD - 1 DO
|
||||
CHL.PushInt(ImportTable, 0)
|
||||
END;
|
||||
|
||||
i := 0;
|
||||
imp := program.imp_list.first(BIN.IMPRT);
|
||||
WHILE imp # NIL DO
|
||||
|
||||
IF imp.label = 0 THEN
|
||||
CHL.SetInt(ImportTable, len, 0);
|
||||
INC(len);
|
||||
CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD);
|
||||
INC(i);
|
||||
CHL.SetInt(ImportTable, i, imp.nameoffs + size + idata);
|
||||
INC(i)
|
||||
ELSE
|
||||
CHL.SetInt(ImportTable, len, imp.nameoffs + size + idata);
|
||||
imp.label := len * SIZE_OF_DWORD;
|
||||
INC(len)
|
||||
END;
|
||||
|
||||
imp := imp.next(BIN.IMPRT)
|
||||
END;
|
||||
CHL.SetInt(ImportTable, len, 0);
|
||||
CHL.SetInt(ImportTable, i, 0);
|
||||
CHL.SetInt(ImportTable, i + 1, 0);
|
||||
INC(len);
|
||||
INC(size, CHL.Length(program._import))
|
||||
END Import;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR);
|
||||
|
||||
CONST
|
||||
|
||||
PARAM_SIZE = 2048;
|
||||
FileAlignment = 16;
|
||||
|
||||
|
||||
VAR
|
||||
header: HEADER;
|
||||
|
||||
base, text, data, idata, bss, offset: INTEGER;
|
||||
|
||||
reloc: BIN.RELOC;
|
||||
iproc: BIN.IMPRT;
|
||||
L: INTEGER;
|
||||
delta: INTEGER;
|
||||
|
||||
i: INTEGER;
|
||||
|
||||
ImportTable: CHL.INTLIST;
|
||||
ILen, libcount, isize: INTEGER;
|
||||
|
||||
icount, dcount, ccount: INTEGER;
|
||||
|
||||
code: CHL.BYTELIST;
|
||||
|
||||
BEGIN
|
||||
base := 0;
|
||||
|
||||
icount := CHL.Length(program._import);
|
||||
dcount := CHL.Length(program.data);
|
||||
ccount := CHL.Length(program.code);
|
||||
|
||||
text := base + HEADER_SIZE;
|
||||
data := WR.align(text + ccount, FileAlignment);
|
||||
idata := WR.align(data + dcount, FileAlignment);
|
||||
|
||||
Import(program, idata, ImportTable, ILen, libcount, isize);
|
||||
|
||||
bss := WR.align(idata + isize, FileAlignment);
|
||||
|
||||
header.menuet01 := "MENUET01";
|
||||
header.ver := 1;
|
||||
header.start := text;
|
||||
header.size := idata + isize - base;
|
||||
header.mem := WR.align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment);
|
||||
header.sp := base + header.mem - PARAM_SIZE * 2;
|
||||
header.param := header.sp;
|
||||
header.path := header.param + PARAM_SIZE;
|
||||
|
||||
code := program.code;
|
||||
reloc := program.rel_list.first(BIN.RELOC);
|
||||
WHILE reloc # NIL DO
|
||||
|
||||
offset := reloc.offset;
|
||||
L := BIN.get32le(code, offset);
|
||||
delta := 3 - offset - text;
|
||||
|
||||
CASE reloc.opcode OF
|
||||
|
||||
|BIN.RIMP:
|
||||
iproc := BIN.GetIProc(program, L);
|
||||
delta := idata + iproc.label
|
||||
|
||||
|BIN.RBSS:
|
||||
delta := L + bss
|
||||
|
||||
|BIN.RDATA:
|
||||
delta := L + data
|
||||
|
||||
|BIN.RCODE:
|
||||
delta := BIN.GetLabel(program, L) + text
|
||||
|
||||
|BIN.PICDATA:
|
||||
INC(delta, L + data)
|
||||
|
||||
|BIN.PICCODE:
|
||||
INC(delta, BIN.GetLabel(program, L) + text)
|
||||
|
||||
|BIN.PICBSS:
|
||||
INC(delta, L + bss)
|
||||
|
||||
|BIN.PICIMP:
|
||||
iproc := BIN.GetIProc(program, L);
|
||||
INC(delta, idata + iproc.label)
|
||||
|
||||
|BIN.IMPTAB:
|
||||
INC(delta, idata)
|
||||
|
||||
END;
|
||||
BIN.put32le(code, offset, delta);
|
||||
|
||||
reloc := reloc.next(BIN.RELOC)
|
||||
END;
|
||||
|
||||
WR.Create(FileName);
|
||||
|
||||
FOR i := 0 TO 7 DO
|
||||
WR.WriteByte(ORD(header.menuet01[i]))
|
||||
END;
|
||||
|
||||
WR.Write32LE(header.ver);
|
||||
WR.Write32LE(header.start);
|
||||
WR.Write32LE(header.size);
|
||||
WR.Write32LE(header.mem);
|
||||
WR.Write32LE(header.sp);
|
||||
WR.Write32LE(header.param);
|
||||
WR.Write32LE(header.path);
|
||||
|
||||
CHL.WriteToFile(code);
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
CHL.WriteToFile(program.data);
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
FOR i := 0 TO ILen - 1 DO
|
||||
WR.Write32LE(CHL.GetInt(ImportTable, i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(program._import);
|
||||
|
||||
WR.Close
|
||||
END write;
|
||||
|
||||
|
||||
END KOS.
|
||||
@@ -1,199 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE LISTS;
|
||||
|
||||
IMPORT C := COLLECTIONS;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
ITEM* = POINTER TO RECORD (C.ITEM)
|
||||
|
||||
prev*, next*: ITEM
|
||||
|
||||
END;
|
||||
|
||||
LIST* = POINTER TO RECORD
|
||||
|
||||
first*, last*: ITEM
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE push* (list: LIST; item: ITEM);
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(item # NIL);
|
||||
|
||||
IF list.first = NIL THEN
|
||||
list.first := item;
|
||||
item.prev := NIL
|
||||
ELSE
|
||||
ASSERT(list.last # NIL);
|
||||
item.prev := list.last;
|
||||
list.last.next := item
|
||||
END;
|
||||
list.last := item;
|
||||
item.next := NIL
|
||||
END push;
|
||||
|
||||
|
||||
PROCEDURE pop* (list: LIST): ITEM;
|
||||
VAR
|
||||
last: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
|
||||
last := list.last;
|
||||
|
||||
IF last # NIL THEN
|
||||
IF last = list.first THEN
|
||||
list.first := NIL;
|
||||
list.last := NIL
|
||||
ELSE
|
||||
list.last := last.prev;
|
||||
list.last.next := NIL
|
||||
END;
|
||||
|
||||
last.next := NIL;
|
||||
last.prev := NIL
|
||||
END
|
||||
|
||||
RETURN last
|
||||
END pop;
|
||||
|
||||
|
||||
PROCEDURE insert* (list: LIST; cur, nov: ITEM);
|
||||
VAR
|
||||
next: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(nov # NIL);
|
||||
ASSERT(cur # NIL);
|
||||
|
||||
next := cur.next;
|
||||
|
||||
IF next # NIL THEN
|
||||
next.prev := nov;
|
||||
nov.next := next;
|
||||
cur.next := nov;
|
||||
nov.prev := cur
|
||||
ELSE
|
||||
push(list, nov)
|
||||
END
|
||||
|
||||
END insert;
|
||||
|
||||
|
||||
PROCEDURE insertL* (list: LIST; cur, nov: ITEM);
|
||||
VAR
|
||||
prev: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(nov # NIL);
|
||||
ASSERT(cur # NIL);
|
||||
|
||||
prev := cur.prev;
|
||||
|
||||
IF prev # NIL THEN
|
||||
prev.next := nov;
|
||||
nov.prev := prev
|
||||
ELSE
|
||||
nov.prev := NIL;
|
||||
list.first := nov
|
||||
END;
|
||||
cur.prev := nov;
|
||||
nov.next := cur
|
||||
END insertL;
|
||||
|
||||
|
||||
PROCEDURE delete* (list: LIST; item: ITEM);
|
||||
VAR
|
||||
prev, next: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(item # NIL);
|
||||
|
||||
prev := item.prev;
|
||||
next := item.next;
|
||||
|
||||
IF next # NIL THEN
|
||||
IF prev # NIL THEN
|
||||
prev.next := next;
|
||||
next.prev := prev
|
||||
ELSE
|
||||
next.prev := NIL;
|
||||
list.first := next
|
||||
END
|
||||
ELSE
|
||||
IF prev # NIL THEN
|
||||
prev.next := NIL;
|
||||
list.last := prev
|
||||
ELSE
|
||||
list.first := NIL;
|
||||
list.last := NIL
|
||||
END
|
||||
END
|
||||
END delete;
|
||||
|
||||
|
||||
PROCEDURE count* (list: LIST): INTEGER;
|
||||
VAR
|
||||
item: ITEM;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
res := 0;
|
||||
|
||||
item := list.first;
|
||||
WHILE item # NIL DO
|
||||
INC(res);
|
||||
item := item.next
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END count;
|
||||
|
||||
|
||||
PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM;
|
||||
VAR
|
||||
item: ITEM;
|
||||
|
||||
BEGIN
|
||||
ASSERT(list # NIL);
|
||||
ASSERT(idx >= 0);
|
||||
|
||||
item := list.first;
|
||||
WHILE (item # NIL) & (idx > 0) DO
|
||||
item := item.next;
|
||||
DEC(idx)
|
||||
END
|
||||
|
||||
RETURN item
|
||||
END getidx;
|
||||
|
||||
|
||||
PROCEDURE create* (list: LIST): LIST;
|
||||
BEGIN
|
||||
IF list = NIL THEN
|
||||
NEW(list)
|
||||
END;
|
||||
|
||||
list.first := NIL;
|
||||
list.last := NIL
|
||||
|
||||
RETURN list
|
||||
END create;
|
||||
|
||||
|
||||
END LISTS.
|
||||
@@ -1,309 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE MSCOFF;
|
||||
|
||||
IMPORT BIN, PE32, KOS, WR := WRITER, UTILS, ERRORS, LISTS, CHL := CHUNKLISTS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
|
||||
(* SectionHeader.Characteristics *)
|
||||
|
||||
SHC_flat = 040500020H;
|
||||
SHC_data = 0C0500040H;
|
||||
SHC_bss = 0C03000C0H;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
FH = PE32.IMAGE_FILE_HEADER;
|
||||
|
||||
SH = PE32.IMAGE_SECTION_HEADER;
|
||||
|
||||
|
||||
PROCEDURE WriteReloc (VirtualAddress, SymbolTableIndex, Type: INTEGER);
|
||||
BEGIN
|
||||
WR.Write32LE(VirtualAddress);
|
||||
WR.Write32LE(SymbolTableIndex);
|
||||
WR.Write16LE(Type)
|
||||
END WriteReloc;
|
||||
|
||||
|
||||
PROCEDURE Reloc (program: BIN.PROGRAM);
|
||||
VAR
|
||||
reloc: BIN.RELOC;
|
||||
offset: INTEGER;
|
||||
|
||||
BEGIN
|
||||
reloc := program.rel_list.first(BIN.RELOC);
|
||||
WHILE reloc # NIL DO
|
||||
|
||||
offset := reloc.offset;
|
||||
CASE reloc.opcode OF
|
||||
|BIN.RIMP,
|
||||
BIN.IMPTAB: WriteReloc(offset, 4, 6)
|
||||
|BIN.RBSS: WriteReloc(offset, 5, 6)
|
||||
|BIN.RDATA: WriteReloc(offset, 2, 6)
|
||||
|BIN.RCODE: WriteReloc(offset, 1, 6)
|
||||
END;
|
||||
|
||||
reloc := reloc.next(BIN.RELOC)
|
||||
END;
|
||||
END Reloc;
|
||||
|
||||
|
||||
PROCEDURE RelocCount (program: BIN.PROGRAM): INTEGER;
|
||||
VAR
|
||||
reloc: BIN.RELOC;
|
||||
iproc: BIN.IMPRT;
|
||||
res, L: INTEGER;
|
||||
offset: INTEGER;
|
||||
code: CHL.BYTELIST;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
code := program.code;
|
||||
reloc := program.rel_list.first(BIN.RELOC);
|
||||
WHILE reloc # NIL DO
|
||||
|
||||
INC(res);
|
||||
offset := reloc.offset;
|
||||
|
||||
IF reloc.opcode = BIN.RIMP THEN
|
||||
L := BIN.get32le(code, offset);
|
||||
iproc := BIN.GetIProc(program, L);
|
||||
BIN.put32le(code, offset, iproc.label)
|
||||
END;
|
||||
|
||||
IF reloc.opcode = BIN.RCODE THEN
|
||||
L := BIN.get32le(code, offset);
|
||||
BIN.put32le(code, offset, BIN.GetLabel(program, L))
|
||||
END;
|
||||
|
||||
reloc := reloc.next(BIN.RELOC)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END RelocCount;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER);
|
||||
VAR
|
||||
exp: BIN.EXPRT;
|
||||
n, i: INTEGER;
|
||||
|
||||
szversion: PE32.NAME;
|
||||
|
||||
ImportTable: CHL.INTLIST;
|
||||
ILen, LibCount, isize: INTEGER;
|
||||
|
||||
ExpCount: INTEGER;
|
||||
|
||||
icount, ecount, dcount, ccount: INTEGER;
|
||||
|
||||
FileHeader: FH;
|
||||
|
||||
flat, data, edata, idata, bss: SH;
|
||||
|
||||
|
||||
PROCEDURE ICount (ImportTable: CHL.INTLIST; ILen: INTEGER): INTEGER;
|
||||
VAR
|
||||
i, res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
|
||||
FOR i := 0 TO ILen - 1 DO
|
||||
IF CHL.GetInt(ImportTable, i) # 0 THEN
|
||||
INC(res)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END ICount;
|
||||
|
||||
|
||||
PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER);
|
||||
BEGIN
|
||||
IF NumberOfRelocations >= 65536 THEN
|
||||
ERRORS.Error(202)
|
||||
END;
|
||||
section.NumberOfRelocations := WCHR(NumberOfRelocations)
|
||||
END SetNumberOfRelocations;
|
||||
|
||||
|
||||
BEGIN
|
||||
|
||||
szversion := "version";
|
||||
|
||||
ASSERT(LENGTH(szversion) = 7);
|
||||
|
||||
KOS.Import(program, 0, ImportTable, ILen, LibCount, isize);
|
||||
ExpCount := LISTS.count(program.exp_list);
|
||||
|
||||
icount := CHL.Length(program._import);
|
||||
dcount := CHL.Length(program.data);
|
||||
ccount := CHL.Length(program.code);
|
||||
ecount := CHL.Length(program.export);
|
||||
|
||||
FileHeader.Machine := 014CX;
|
||||
FileHeader.NumberOfSections := 5X;
|
||||
FileHeader.TimeDateStamp := UTILS.UnixTime();
|
||||
(* FileHeader.PointerToSymbolTable := 0; *)
|
||||
FileHeader.NumberOfSymbols := 6;
|
||||
FileHeader.SizeOfOptionalHeader := 0X;
|
||||
FileHeader.Characteristics := 0184X;
|
||||
|
||||
flat.Name := ".flat";
|
||||
flat.VirtualSize := 0;
|
||||
flat.VirtualAddress := 0;
|
||||
flat.SizeOfRawData := ccount;
|
||||
flat.PointerToRawData := ORD(FileHeader.NumberOfSections) * PE32.SIZE_OF_IMAGE_SECTION_HEADER + PE32.SIZE_OF_IMAGE_FILE_HEADER;
|
||||
(* flat.PointerToRelocations := 0; *)
|
||||
flat.PointerToLinenumbers := 0;
|
||||
SetNumberOfRelocations(flat, RelocCount(program));
|
||||
flat.NumberOfLinenumbers := 0X;
|
||||
flat.Characteristics := SHC_flat;
|
||||
|
||||
data.Name := ".data";
|
||||
data.VirtualSize := 0;
|
||||
data.VirtualAddress := 0;
|
||||
data.SizeOfRawData := dcount;
|
||||
data.PointerToRawData := flat.PointerToRawData + flat.SizeOfRawData;
|
||||
data.PointerToRelocations := 0;
|
||||
data.PointerToLinenumbers := 0;
|
||||
data.NumberOfRelocations := 0X;
|
||||
data.NumberOfLinenumbers := 0X;
|
||||
data.Characteristics := SHC_data;
|
||||
|
||||
edata.Name := ".edata";
|
||||
edata.VirtualSize := 0;
|
||||
edata.VirtualAddress := 0;
|
||||
edata.SizeOfRawData := ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD + LENGTH(szversion) + 1 + ecount;
|
||||
edata.PointerToRawData := data.PointerToRawData + data.SizeOfRawData;
|
||||
(* edata.PointerToRelocations := 0; *)
|
||||
edata.PointerToLinenumbers := 0;
|
||||
SetNumberOfRelocations(edata, ExpCount * 2 + 1);
|
||||
edata.NumberOfLinenumbers := 0X;
|
||||
edata.Characteristics := SHC_data;
|
||||
|
||||
idata.Name := ".idata";
|
||||
idata.VirtualSize := 0;
|
||||
idata.VirtualAddress := 0;
|
||||
idata.SizeOfRawData := isize;
|
||||
idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData;
|
||||
(* idata.PointerToRelocations := 0; *)
|
||||
idata.PointerToLinenumbers := 0;
|
||||
SetNumberOfRelocations(idata, ICount(ImportTable, ILen));
|
||||
idata.NumberOfLinenumbers := 0X;
|
||||
idata.Characteristics := SHC_data;
|
||||
|
||||
bss.Name := ".bss";
|
||||
bss.VirtualSize := 0;
|
||||
bss.VirtualAddress := 0;
|
||||
bss.SizeOfRawData := program.bss;
|
||||
bss.PointerToRawData := 0;
|
||||
bss.PointerToRelocations := 0;
|
||||
bss.PointerToLinenumbers := 0;
|
||||
bss.NumberOfRelocations := 0X;
|
||||
bss.NumberOfLinenumbers := 0X;
|
||||
bss.Characteristics := SHC_bss;
|
||||
|
||||
flat.PointerToRelocations := idata.PointerToRawData + idata.SizeOfRawData;
|
||||
edata.PointerToRelocations := flat.PointerToRelocations + ORD(flat.NumberOfRelocations) * 10;
|
||||
idata.PointerToRelocations := edata.PointerToRelocations + ORD(edata.NumberOfRelocations) * 10;
|
||||
|
||||
FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10;
|
||||
|
||||
WR.Create(FileName);
|
||||
|
||||
PE32.WriteFileHeader(FileHeader);
|
||||
|
||||
PE32.WriteSectionHeader(flat);
|
||||
PE32.WriteSectionHeader(data);
|
||||
PE32.WriteSectionHeader(edata);
|
||||
PE32.WriteSectionHeader(idata);
|
||||
PE32.WriteSectionHeader(bss);
|
||||
|
||||
CHL.WriteToFile(program.code);
|
||||
CHL.WriteToFile(program.data);
|
||||
|
||||
exp := program.exp_list.first(BIN.EXPRT);
|
||||
WHILE exp # NIL DO
|
||||
WR.Write32LE(exp.nameoffs + edata.SizeOfRawData - ecount);
|
||||
WR.Write32LE(exp.label);
|
||||
exp := exp.next(BIN.EXPRT)
|
||||
END;
|
||||
|
||||
WR.Write32LE(((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD);
|
||||
WR.Write32LE(ver);
|
||||
|
||||
WR.Write32LE(0);
|
||||
|
||||
PE32.WriteName(szversion);
|
||||
CHL.WriteToFile(program.export);
|
||||
|
||||
FOR i := 0 TO ILen - 1 DO
|
||||
WR.Write32LE(CHL.GetInt(ImportTable, i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(program._import);
|
||||
|
||||
Reloc(program);
|
||||
|
||||
n := 0;
|
||||
exp := program.exp_list.first(BIN.EXPRT);
|
||||
WHILE exp # NIL DO
|
||||
WriteReloc(n, 3, 6);
|
||||
INC(n, 4);
|
||||
|
||||
WriteReloc(n, 1, 6);
|
||||
INC(n, 4);
|
||||
|
||||
exp := exp.next(BIN.EXPRT)
|
||||
END;
|
||||
|
||||
WriteReloc(n, 3, 6);
|
||||
|
||||
FOR i := 0 TO LibCount * 2 - 1 DO
|
||||
WriteReloc(i * SIZE_OF_DWORD, 4, 6)
|
||||
END;
|
||||
|
||||
FOR i := LibCount * 2 TO ILen - 1 DO
|
||||
IF CHL.GetInt(ImportTable, i) # 0 THEN
|
||||
WriteReloc(i * SIZE_OF_DWORD, 4, 6)
|
||||
END
|
||||
END;
|
||||
|
||||
PE32.WriteName("EXPORTS");
|
||||
WriteReloc(0, 3, 2);
|
||||
|
||||
PE32.WriteName(".flat");
|
||||
WriteReloc(0, 1, 3);
|
||||
|
||||
PE32.WriteName(".data");
|
||||
WriteReloc(0, 2, 3);
|
||||
|
||||
PE32.WriteName(".edata");
|
||||
WriteReloc(0, 3, 3);
|
||||
|
||||
PE32.WriteName(".idata");
|
||||
WriteReloc(0, 4, 3);
|
||||
|
||||
PE32.WriteName(".bss");
|
||||
WriteReloc(0, 5, 3);
|
||||
|
||||
WR.Write32LE(4);
|
||||
|
||||
WR.Close
|
||||
END write;
|
||||
|
||||
|
||||
END MSCOFF.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,671 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE MSP430RTL;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
_mul* = 0;
|
||||
_divmod* = 1;
|
||||
_lsl* = 2;
|
||||
_asr* = 3;
|
||||
_ror* = 4;
|
||||
_lsr* = 5;
|
||||
_in* = 6;
|
||||
_in2* = 7;
|
||||
_set1* = 8;
|
||||
_incl* = 9;
|
||||
_excl* = 10;
|
||||
_move* = 11;
|
||||
_set* = 12;
|
||||
_arrcpy* = 13;
|
||||
_rot* = 14;
|
||||
_strcmp* = 15;
|
||||
_error* = 16;
|
||||
_is* = 17;
|
||||
_guard* = 18;
|
||||
_guardrec* = 19;
|
||||
_length* = 20;
|
||||
_new* = 21;
|
||||
|
||||
|
||||
HP* = 15;
|
||||
|
||||
LenIV* = 32;
|
||||
|
||||
iv = 10000H - LenIV * 2;
|
||||
bsl = iv - 2;
|
||||
sp = bsl - 2;
|
||||
empty_proc* = sp - 2;
|
||||
bits = empty_proc - 272;
|
||||
bits_offs = bits - 32;
|
||||
DataSize* = iv - bits_offs;
|
||||
types = bits_offs - 2;
|
||||
|
||||
IntVectorSize* = LenIV * 2 + DataSize;
|
||||
|
||||
VarSize* = 4;
|
||||
|
||||
StkReserve* = 40;
|
||||
|
||||
trap = 2;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
EMITPROC = PROCEDURE (n: INTEGER);
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
ram*: INTEGER;
|
||||
|
||||
rtl*: ARRAY 22 OF
|
||||
RECORD
|
||||
label*: INTEGER;
|
||||
used: BOOLEAN
|
||||
END;
|
||||
|
||||
Label, Word, Call: EMITPROC;
|
||||
|
||||
|
||||
PROCEDURE Gen*;
|
||||
|
||||
|
||||
PROCEDURE Word1 (word: INTEGER);
|
||||
BEGIN
|
||||
Word(word)
|
||||
END Word1;
|
||||
|
||||
|
||||
PROCEDURE Word2 (word1, word2: INTEGER);
|
||||
BEGIN
|
||||
Word1(word1);
|
||||
Word1(word2)
|
||||
END Word2;
|
||||
|
||||
|
||||
PROCEDURE Word3 (word1, word2, word3: INTEGER);
|
||||
BEGIN
|
||||
Word1(word1);
|
||||
Word1(word2);
|
||||
Word1(word3)
|
||||
END Word3;
|
||||
|
||||
|
||||
BEGIN
|
||||
(* _lsl (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_lsl].used THEN
|
||||
Label(rtl[_lsl].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 3); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _asr (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_asr].used THEN
|
||||
Label(rtl[_asr].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(1104H); (* RRA R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 3); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _ror (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_ror].used THEN
|
||||
Label(rtl[_ror].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 5); (* JZ L1 *)
|
||||
Word1(4406H); (* MOV R4, R6 *)
|
||||
(* L2: *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(1004H); (* RRC R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 4); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _lsr (n, x: INTEGER): INTEGER *)
|
||||
IF rtl[_lsr].used THEN
|
||||
Label(rtl[_lsr].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *)
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *)
|
||||
Word2(0F035H, 15); (* AND #15, R5 *)
|
||||
Word1(2400H + 4); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1004H); (* RRC R4 *)
|
||||
Word1(8315H); (* SUB #1, R5 *)
|
||||
Word1(2000H + 400H - 4); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _set (b, a: INTEGER): SET *)
|
||||
IF rtl[_set].used THEN
|
||||
Label(rtl[_set].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
|
||||
Word1(9504H); (* CMP R5, R4 *)
|
||||
Word1(3800H + 24); (* JL L1 *)
|
||||
Word2(9035H, 16); (* CMP #16, R5 *)
|
||||
Word1(3400H + 21); (* JGE L1 *)
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(3800H + 19); (* JL L1 *)
|
||||
Word2(9034H, 16); (* CMP #16, R4 *)
|
||||
Word1(3800H + 2); (* JL L2 *)
|
||||
Word2(4034H, 15); (* MOV #15, R4 *)
|
||||
(* L2: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(3400H + 1); (* JGE L3 *)
|
||||
Word1(4305H); (* MOV #0, R5 *)
|
||||
(* L3: *)
|
||||
Word1(8504H); (* SUB R5, R4 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits_offs); (* ADD bits_offs, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(5405H); (* ADD R4, R5 *)
|
||||
Word2(5035H, bits); (* ADD bits, R5 *)
|
||||
Word1(4524H); (* MOV @R5, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L1: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _set1 (a: INTEGER): SET *)
|
||||
IF rtl[_set1].used THEN
|
||||
Label(rtl[_set1].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 5); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L1: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _in2 (i, s: INTEGER): BOOLEAN *)
|
||||
IF rtl[_in2].used THEN
|
||||
Label(rtl[_in2].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(0F114H, 4); (* AND 4(SP), R4 *)
|
||||
Word1(2400H + 1); (* JZ L1 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _in (s, i: INTEGER): BOOLEAN *)
|
||||
IF rtl[_in].used THEN
|
||||
Label(rtl[_in].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 9); (* JNZ L2 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(0F114H, 2); (* AND 2(SP), R4 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L2: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _incl (VAR s: SET; i: INTEGER) *)
|
||||
IF rtl[_incl].used THEN
|
||||
Label(rtl[_incl].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 8); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
|
||||
Word2(0D485H, 0); (* BIS R4, 0(R5) *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _excl (VAR s: SET; i: INTEGER) *)
|
||||
IF rtl[_excl].used THEN
|
||||
Label(rtl[_excl].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *)
|
||||
Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *)
|
||||
Word1(2000H + 8); (* JNZ L1 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word2(5034H, bits); (* ADD bits, R4 *)
|
||||
Word1(4424H); (* MOV @R4, R4 *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *)
|
||||
Word2(0C485H, 0); (* BIC R4, 0(R5) *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _rot (len, adr: INTEGER) *)
|
||||
IF rtl[_rot].used THEN
|
||||
Label(rtl[_rot].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *)
|
||||
Word1(8314H); (* SUB #1, R4 *)
|
||||
Word1(5404H); (* ADD R4, R4 *)
|
||||
Word1(1225H); (* PUSH @R5 *)
|
||||
Word1(4406H); (* MOV R4, R6 *)
|
||||
(* L1: *)
|
||||
Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *)
|
||||
Word1(5325H); (* ADD #2, R5 *)
|
||||
Word1(8326H); (* SUB #2, R6 *)
|
||||
Word1(2000H + 400H - 6); (* JNZ L1 *)
|
||||
Word2(41B5H, 0); (* MOV @SP+, 0(R5) *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *)
|
||||
IF rtl[_divmod].used THEN
|
||||
Label(rtl[_divmod].label);
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L1: *)
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 17); (* JL L3 *)
|
||||
Word1(4327H); (* MOV #2, R7 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
(* L4: *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 6); (* JZ L2 *)
|
||||
Word1(3800H + 5); (* JL L2 *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 3); (* JL L2 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(5707H); (* ADD R7, R7 *)
|
||||
Word1(3C00H + 400H - 8); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1007H); (* RRC R7 *)
|
||||
Word1(8605H); (* SUB R6, R5 *)
|
||||
Word1(5704H); (* ADD R7, R4 *)
|
||||
Word1(3C00H + 400H - 21); (* JMP L1 *)
|
||||
(* L3: *)
|
||||
(*----------- (a < 0) --------------*)
|
||||
(* L1: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(3400H + 23); (* JGE L3 *)
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *)
|
||||
Word1(4327H); (* MOV #2, R7 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
(* L4: *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 6); (* JZ L2 *)
|
||||
Word1(3800H + 5); (* JL L2 *)
|
||||
Word1(9605H); (* CMP R6, R5 *)
|
||||
Word1(3800H + 3); (* JL L2 *)
|
||||
Word1(5606H); (* ADD R6, R6 *)
|
||||
Word1(5707H); (* ADD R7, R7 *)
|
||||
Word1(3C00H + 400H - 8); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1007H); (* RRC R7 *)
|
||||
Word1(5605H); (* ADD R6, R5 *)
|
||||
Word1(8704H); (* SUB R7, R4 *)
|
||||
Word1(3C00H + 400H - 25); (* JMP L1 *)
|
||||
(* L3: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _mul (a, b: INTEGER): INTEGER *)
|
||||
IF rtl[_mul].used THEN
|
||||
Label(rtl[_mul].label);
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *)
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *)
|
||||
Word1(4304H); (* MOV #0, R4; res := 0 *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(2400H + 7); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word1(0B316H); (* BIT #1, R6 *)
|
||||
Word1(2400H + 1); (* JZ L3 *)
|
||||
Word1(5504H); (* ADD R5, R4 *)
|
||||
(* L3: *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(0C312H); (* BIC #1, SR *)
|
||||
Word1(1006H); (* RRC R6 *)
|
||||
Word1(2000H + 400H - 7); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _error (modNum, modName, err, line: INTEGER) *)
|
||||
IF rtl[_error].used THEN
|
||||
Label(rtl[_error].label);
|
||||
Word1(5321H); (* ADD #2, SP *)
|
||||
Word1(4134H); (* POP R4; R4 <- modNum *)
|
||||
Word1(4135H); (* POP R5; R5 <- modName *)
|
||||
Word1(4136H); (* POP R6; R6 <- err *)
|
||||
Word1(4137H); (* POP R7; R7 <- line *)
|
||||
Word2(4211H, sp); (* MOV sp(SR), SP *)
|
||||
Word1(1207H); (* PUSH R7 *)
|
||||
Word1(1206H); (* PUSH R6 *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Word2(4214H, sp); (* MOV sp(SR), R4 *)
|
||||
Word2(1294H, trap); (* CALL trap(R4) *)
|
||||
Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *)
|
||||
END;
|
||||
|
||||
(* _new (t, size: INTEGER; VAR ptr: INTEGER) *)
|
||||
IF rtl[_new].used THEN
|
||||
Label(rtl[_new].label);
|
||||
Word1(1202H); (* PUSH SR *)
|
||||
Word1(4302H); (* MOV #0, SR *)
|
||||
Word1(4303H); (* NOP *)
|
||||
Word1(4104H); (* MOV SP, R4 *)
|
||||
Word2(8034H, StkReserve); (* SUB #StkReserve, R4 *)
|
||||
Word1(4005H + 100H * HP); (* MOV HP, R5 *)
|
||||
Word2(5115H, 6); (* ADD 6(SP), R5 *)
|
||||
Word1(9504H); (* CMP R5, R4 *)
|
||||
Word2(4114H, 8); (* MOV 8(SP), R4 *)
|
||||
Word1(3800H + 12); (* JL L1 *)
|
||||
Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *)
|
||||
Word1(5320H + HP); (* ADD #2, HP *)
|
||||
Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *)
|
||||
(* L3 *)
|
||||
Word2(4380H + HP, 0); (* MOV #0, 0(HP) *)
|
||||
Word1(5320H + HP); (* ADD #2, HP *)
|
||||
Word1(9500H + HP); (* CMP R5, HP *)
|
||||
Word1(3800H + 400H - 5); (* JL L3 *)
|
||||
Word1(3C00H + 2); (* JMP L2 *)
|
||||
(* L1 *)
|
||||
Word2(4384H, 0); (* MOV #0, 0(R4) *)
|
||||
(* L2 *)
|
||||
Word1(1300H) (* RETI *)
|
||||
END;
|
||||
|
||||
(* _guardrec (t0, t1: INTEGER): INTEGER *)
|
||||
IF rtl[_guardrec].used THEN
|
||||
Label(rtl[_guardrec].label);
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *)
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *)
|
||||
Word2(4036H, types); (* MOV #types, R6 *)
|
||||
(* L3: *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(2400H + 8); (* JZ L1 *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 10); (* JZ L2 *)
|
||||
Word1(5505H); (* ADD R5, R5 *)
|
||||
Word1(0E335H); (* XOR #-1, R5 *)
|
||||
Word1(5315H); (* ADD #1, R5 *)
|
||||
Word1(5605H); (* ADD R6, R5 *)
|
||||
Word1(4525H); (* MOV @R5, R5 *)
|
||||
Word1(3C00H + 400H - 10); (* JMP L3 *)
|
||||
(* L1: *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 2); (* JZ L2 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L2: *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _is (t, p: INTEGER): INTEGER *)
|
||||
IF rtl[_is].used THEN
|
||||
Label(rtl[_is].label);
|
||||
Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *)
|
||||
Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *)
|
||||
Word1(9304H); (* TST R4 *)
|
||||
Word1(2400H + 2); (* JZ L *)
|
||||
Word2(4414H, -2); (* MOV -2(R4), R4 *)
|
||||
(* L: *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Call(rtl[_guardrec].label); (* CALL _guardrec *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _guard (t, p: INTEGER): INTEGER *)
|
||||
IF rtl[_guard].used THEN
|
||||
Label(rtl[_guard].label);
|
||||
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4525H); (* MOV @R5, R5 *)
|
||||
Word1(9305H); (* TST R5 *)
|
||||
Word1(2400H + 9); (* JZ L *)
|
||||
Word2(4515H, -2); (* MOV -2(R5), R5 *)
|
||||
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *)
|
||||
Word1(1205H); (* PUSH R5 *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Call(rtl[_guardrec].label); (* CALL _guardrec *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
(* L: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _move (bytes, dest, source: INTEGER) *)
|
||||
IF rtl[_move].used THEN
|
||||
Label(rtl[_move].label);
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *)
|
||||
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *)
|
||||
Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *)
|
||||
Word1(9306H); (* CMP #0, R6 *)
|
||||
Word1(3800H + 6); (* JL L1 *)
|
||||
Word1(2400H + 5); (* JZ L1 *)
|
||||
(* L2: *)
|
||||
Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *)
|
||||
Word1(5317H); (* ADD #1, R7 *)
|
||||
Word1(8316H); (* SUB #1, R6 *)
|
||||
Word1(2000H + 400H - 5); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *)
|
||||
IF rtl[_arrcpy].used THEN
|
||||
Label(rtl[_arrcpy].label);
|
||||
Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *)
|
||||
Word1(3800H + 18); (* JL L1 *)
|
||||
Word2(1211H, 12); (* PUSH 12(SP) *)
|
||||
Word2(1211H, 10); (* PUSH 10(SP) *)
|
||||
Word2(1211H, 14); (* PUSH 14(SP) *)
|
||||
Word2(1211H, 10); (* PUSH 10(SP) *)
|
||||
Call(rtl[_mul].label); (* CALL _mul *)
|
||||
Word1(5221H); (* ADD #4, SP *)
|
||||
Word1(1204H); (* PUSH R4 *)
|
||||
Call(rtl[_move].label); (* CALL _move *)
|
||||
Word2(5031H, 6); (* ADD #6, SP *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(4130H); (* RET *)
|
||||
(* L1 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _length (len, str: INTEGER): INTEGER *)
|
||||
IF rtl[_length].used THEN
|
||||
Label(rtl[_length].label);
|
||||
Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *)
|
||||
Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *)
|
||||
Word1(4304H); (* MOV #0, R4; res := 0 *)
|
||||
(* L2: *)
|
||||
Word1(4775H); (* MOV.B @R7+, R5 *)
|
||||
Word1(9305H); (* CMP #0, R5 *)
|
||||
Word1(2400H + 3); (* JZ L1 *)
|
||||
Word1(5314H); (* ADD #1, R4 *)
|
||||
Word1(8316H); (* SUB #1, R6 *)
|
||||
Word1(2000H + 400H - 6); (* JNZ L2 *)
|
||||
(* L1: *)
|
||||
Word1(4130H) (* RET *)
|
||||
END;
|
||||
|
||||
(* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *)
|
||||
IF rtl[_strcmp].used THEN
|
||||
Label(rtl[_strcmp].label);
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
|
||||
Word1(9607H); (* CMP R6, R7 *)
|
||||
Word1(3400H + 1); (* JGE L5 *)
|
||||
Word1(4706H); (* MOV R7, R6 *)
|
||||
(* L5: *)
|
||||
Word1(1206H); (* PUSH R6 *)
|
||||
Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *)
|
||||
(* L3: *)
|
||||
Word2(9381H, 0); (* CMP #0, 0(SP) *)
|
||||
Word1(2400H + 11); (* JZ L1 *)
|
||||
Word1(4674H); (* MOV.B @R6+, R4 *)
|
||||
Word1(4775H); (* MOV.B @R7+, R5 *)
|
||||
Word2(8391H, 0); (* SUB #1, 0(SP) *)
|
||||
Word1(9405H); (* CMP R4, R5 *)
|
||||
Word1(2400H + 2); (* JZ L2 *)
|
||||
Word1(8504H); (* SUB R5, R4 *)
|
||||
Word1(3C00H + 5); (* JMP L4 *)
|
||||
(* L2: *)
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(2000H + 400H - 13); (* JNZ L3 *)
|
||||
Word1(3C00H + 2); (* JMP L4 *)
|
||||
(* L1: *)
|
||||
Word2(4034H, 8000H); (* MOV #8000H, R4 *)
|
||||
(* L4: *)
|
||||
Word1(5321H); (* ADD #2, SP *)
|
||||
|
||||
Word2(9034H, 8000H); (* CMP #8000H, R4 *)
|
||||
Word1(2000H + 18); (* JNZ L6 *)
|
||||
Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *)
|
||||
Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *)
|
||||
Word1(9607H); (* CMP R6, R7 *)
|
||||
Word1(2400H + 11); (* JZ L7 *)
|
||||
Word1(3800H + 4); (* JL L8 *)
|
||||
Word2(5116H, 10); (* ADD 10(SP), R6 *)
|
||||
Word1(4664H); (* MOV.B @R6, R4 *)
|
||||
Word1(3C00H + 7); (* JMP L6 *)
|
||||
(* L8: *)
|
||||
Word2(5117H, 6); (* ADD 6(SP), R7 *)
|
||||
Word1(4764H); (* MOV.B @R7, R4 *)
|
||||
Word1(0E334H); (* XOR #-1, R4 *)
|
||||
Word1(5314H); (* ADD #1, R4 *)
|
||||
Word1(3C00H + 1); (* JMP L6 *)
|
||||
(* L7: *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L6: *)
|
||||
|
||||
Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(2000H + 1); (* JNZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3800H + 1); (* JL L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
Word1(4303H); (* NOP *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3800H + 2); (* JL L *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
Word1(3800H + 2); (* JL L *)
|
||||
Word1(2400H + 1); (* JZ L *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H); (* RET *)
|
||||
|
||||
Word1(9304H); (* CMP #0, R4 *)
|
||||
Word1(4314H); (* MOV #1, R4 *)
|
||||
Word1(3400H + 1); (* JGE L *)
|
||||
Word1(4304H); (* MOV #0, R4 *)
|
||||
(* L *)
|
||||
Word1(4130H) (* RET *)
|
||||
END
|
||||
|
||||
END Gen;
|
||||
|
||||
|
||||
PROCEDURE Set* (idx, label: INTEGER);
|
||||
BEGIN
|
||||
rtl[idx].label := label;
|
||||
rtl[idx].used := FALSE
|
||||
END Set;
|
||||
|
||||
|
||||
PROCEDURE Used* (idx: INTEGER);
|
||||
BEGIN
|
||||
rtl[idx].used := TRUE;
|
||||
IF (idx = _guard) OR (idx = _is) THEN
|
||||
rtl[_guardrec].used := TRUE
|
||||
ELSIF idx = _arrcpy THEN
|
||||
rtl[_move].used := TRUE;
|
||||
rtl[_mul].used := TRUE
|
||||
END
|
||||
END Used;
|
||||
|
||||
|
||||
PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC);
|
||||
BEGIN
|
||||
Label := pLabel;
|
||||
Word := pWord;
|
||||
Call := pCall;
|
||||
ram := 200H;
|
||||
END Init;
|
||||
|
||||
|
||||
END MSP430RTL.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,151 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE PATHS;
|
||||
|
||||
IMPORT STRINGS, UTILS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
slash = UTILS.slash;
|
||||
|
||||
PATHLEN = 2048;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
PATH* = ARRAY PATHLEN OF CHAR;
|
||||
|
||||
|
||||
PROCEDURE split* (fname: ARRAY OF CHAR; VAR path, name, ext: ARRAY OF CHAR);
|
||||
VAR
|
||||
pos1, pos2, len: INTEGER;
|
||||
|
||||
BEGIN
|
||||
len := LENGTH(fname);
|
||||
pos1 := len - 1;
|
||||
pos2 := pos1;
|
||||
STRINGS.search(fname, pos1, slash, FALSE);
|
||||
STRINGS.search(fname, pos2, ".", FALSE);
|
||||
|
||||
path := fname;
|
||||
path[pos1 + 1] := 0X;
|
||||
|
||||
IF (pos2 = -1) OR (pos2 < pos1) THEN
|
||||
pos2 := len
|
||||
END;
|
||||
|
||||
INC(pos1);
|
||||
|
||||
STRINGS.copy(fname, name, pos1, 0, pos2 - pos1);
|
||||
name[pos2 - pos1] := 0X;
|
||||
STRINGS.copy(fname, ext, pos2, 0, len - pos2);
|
||||
ext[len - pos2] := 0X
|
||||
END split;
|
||||
|
||||
|
||||
PROCEDURE RelPath* (absolute, relative: ARRAY OF CHAR; VAR res: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, j: INTEGER;
|
||||
error: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
COPY(absolute, res);
|
||||
i := LENGTH(res) - 1;
|
||||
WHILE (i >= 0) & (res[i] # slash) DO
|
||||
DEC(i)
|
||||
END;
|
||||
|
||||
INC(i);
|
||||
res[i] := 0X;
|
||||
|
||||
error := FALSE;
|
||||
j := 0;
|
||||
WHILE (relative[j] = ".") & (relative[j + 1] = slash) DO
|
||||
INC(j, 2)
|
||||
ELSIF relative[j] = slash DO
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
WHILE ~error & (relative[j] # 0X) DO
|
||||
IF (relative[j] = ".") & (relative[j + 1] = ".") & (relative[j + 2] = slash) & (i > 0) & (res[i - 1] = slash) THEN
|
||||
DEC(i, 2);
|
||||
WHILE (i >= 0) & (res[i] # slash) DO
|
||||
DEC(i)
|
||||
END;
|
||||
IF i < 0 THEN
|
||||
error := TRUE
|
||||
ELSE
|
||||
INC(i);
|
||||
INC(j, 3)
|
||||
END
|
||||
ELSE
|
||||
res[i] := relative[j];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END
|
||||
END;
|
||||
|
||||
IF error THEN
|
||||
COPY(relative, res)
|
||||
ELSE
|
||||
res[i] := 0X
|
||||
END
|
||||
|
||||
END RelPath;
|
||||
|
||||
|
||||
PROCEDURE DelSlashes* (VAR path: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, j, k: INTEGER;
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
j := 0;
|
||||
k := 0;
|
||||
REPEAT
|
||||
c := path[j];
|
||||
INC(j);
|
||||
IF c = slash THEN
|
||||
INC(k)
|
||||
ELSE
|
||||
k := 0
|
||||
END;
|
||||
IF k <= 1 THEN
|
||||
path[i] := c;
|
||||
INC(i)
|
||||
END
|
||||
UNTIL c = 0X;
|
||||
|
||||
i := 0;
|
||||
j := 0;
|
||||
REPEAT
|
||||
c := path[j];
|
||||
INC(j);
|
||||
path[i] := c;
|
||||
INC(i);
|
||||
IF (c = slash) & (path[j] = ".") & (path[j + 1] = slash) THEN
|
||||
INC(j, 2)
|
||||
END
|
||||
UNTIL c = 0X
|
||||
END DelSlashes;
|
||||
|
||||
|
||||
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
|
||||
RETURN UTILS.isRelative(path)
|
||||
END isRelative;
|
||||
|
||||
|
||||
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
UTILS.GetCurrentDirectory(path)
|
||||
END GetCurrentDirectory;
|
||||
|
||||
|
||||
END PATHS.
|
||||
@@ -1,695 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE PE32;
|
||||
|
||||
IMPORT BIN, LISTS, UTILS, WR := WRITER, CHL := CHUNKLISTS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
SIZE_OF_DWORD = 4;
|
||||
SIZE_OF_WORD = 2;
|
||||
|
||||
SIZE_OF_IMAGE_EXPORT_DIRECTORY = 40;
|
||||
|
||||
IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16;
|
||||
|
||||
IMAGE_SIZEOF_SHORT_NAME = 8;
|
||||
|
||||
SIZE_OF_IMAGE_FILE_HEADER* = 20;
|
||||
|
||||
SIZE_OF_IMAGE_SECTION_HEADER* = 40;
|
||||
|
||||
(* SectionHeader.Characteristics *)
|
||||
|
||||
SHC_text = 060000020H;
|
||||
SHC_data = 040000040H;
|
||||
SHC_bss = 0C0000080H;
|
||||
|
||||
SectionAlignment = 1000H;
|
||||
FileAlignment = 200H;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
WORD = WCHAR;
|
||||
DWORD = INTEGER;
|
||||
|
||||
NAME* = ARRAY IMAGE_SIZEOF_SHORT_NAME OF CHAR;
|
||||
|
||||
|
||||
IMAGE_DATA_DIRECTORY = RECORD
|
||||
|
||||
VirtualAddress: DWORD;
|
||||
Size: DWORD
|
||||
|
||||
END;
|
||||
|
||||
|
||||
IMAGE_OPTIONAL_HEADER = RECORD
|
||||
|
||||
Magic: WORD;
|
||||
MajorLinkerVersion: BYTE;
|
||||
MinorLinkerVersion: BYTE;
|
||||
SizeOfCode: DWORD;
|
||||
SizeOfInitializedData: DWORD;
|
||||
SizeOfUninitializedData: DWORD;
|
||||
AddressOfEntryPoint: DWORD;
|
||||
BaseOfCode: DWORD;
|
||||
BaseOfData: DWORD;
|
||||
ImageBase: DWORD;
|
||||
SectionAlignment: DWORD;
|
||||
FileAlignment: DWORD;
|
||||
MajorOperatingSystemVersion: WORD;
|
||||
MinorOperatingSystemVersion: WORD;
|
||||
MajorImageVersion: WORD;
|
||||
MinorImageVersion: WORD;
|
||||
MajorSubsystemVersion: WORD;
|
||||
MinorSubsystemVersion: WORD;
|
||||
Win32VersionValue: DWORD;
|
||||
SizeOfImage: DWORD;
|
||||
SizeOfHeaders: DWORD;
|
||||
CheckSum: DWORD;
|
||||
Subsystem: WORD;
|
||||
DllCharacteristics: WORD;
|
||||
SizeOfStackReserve: DWORD;
|
||||
SizeOfStackCommit: DWORD;
|
||||
SizeOfHeapReserve: DWORD;
|
||||
SizeOfHeapCommit: DWORD;
|
||||
LoaderFlags: DWORD;
|
||||
NumberOfRvaAndSizes: DWORD;
|
||||
|
||||
DataDirectory: ARRAY IMAGE_NUMBEROF_DIRECTORY_ENTRIES OF IMAGE_DATA_DIRECTORY
|
||||
|
||||
END;
|
||||
|
||||
|
||||
IMAGE_FILE_HEADER* = RECORD
|
||||
|
||||
Machine*: WORD;
|
||||
NumberOfSections*: WORD;
|
||||
TimeDateStamp*: DWORD;
|
||||
PointerToSymbolTable*: DWORD;
|
||||
NumberOfSymbols*: DWORD;
|
||||
SizeOfOptionalHeader*: WORD;
|
||||
Characteristics*: WORD
|
||||
|
||||
END;
|
||||
|
||||
|
||||
IMAGE_SECTION_HEADER* = RECORD
|
||||
|
||||
Name*: NAME;
|
||||
|
||||
VirtualSize*,
|
||||
VirtualAddress*,
|
||||
SizeOfRawData*,
|
||||
PointerToRawData*,
|
||||
PointerToRelocations*,
|
||||
PointerToLinenumbers*: DWORD;
|
||||
|
||||
NumberOfRelocations*,
|
||||
NumberOfLinenumbers*: WORD;
|
||||
|
||||
Characteristics*: DWORD
|
||||
|
||||
END;
|
||||
|
||||
|
||||
IMAGE_EXPORT_DIRECTORY = RECORD
|
||||
|
||||
Characteristics: DWORD;
|
||||
TimeDateStamp: DWORD;
|
||||
MajorVersion: WORD;
|
||||
MinorVersion: WORD;
|
||||
Name,
|
||||
Base,
|
||||
NumberOfFunctions,
|
||||
NumberOfNames,
|
||||
AddressOfFunctions,
|
||||
AddressOfNames,
|
||||
AddressOfNameOrdinals: DWORD
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VIRTUAL_ADDR* = RECORD
|
||||
|
||||
Code*, Data*, Bss*, Import*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
Signature: ARRAY 4 OF BYTE;
|
||||
FileHeader: IMAGE_FILE_HEADER;
|
||||
OptionalHeader: IMAGE_OPTIONAL_HEADER;
|
||||
|
||||
msdos: ARRAY 128 OF BYTE;
|
||||
SectionHeaders: ARRAY 16 OF IMAGE_SECTION_HEADER;
|
||||
libcnt: INTEGER;
|
||||
SizeOfWord: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE Export (program: BIN.PROGRAM; name: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER;
|
||||
BEGIN
|
||||
|
||||
ExportDir.Characteristics := 0;
|
||||
ExportDir.TimeDateStamp := FileHeader.TimeDateStamp;
|
||||
ExportDir.MajorVersion := 0X;
|
||||
ExportDir.MinorVersion := 0X;
|
||||
ExportDir.Name := name;
|
||||
ExportDir.Base := 0;
|
||||
ExportDir.NumberOfFunctions := LISTS.count(program.exp_list);
|
||||
ExportDir.NumberOfNames := ExportDir.NumberOfFunctions;
|
||||
ExportDir.AddressOfFunctions := SIZE_OF_IMAGE_EXPORT_DIRECTORY;
|
||||
ExportDir.AddressOfNames := ExportDir.AddressOfFunctions + ExportDir.NumberOfFunctions * SIZE_OF_DWORD;
|
||||
ExportDir.AddressOfNameOrdinals := ExportDir.AddressOfNames + ExportDir.NumberOfFunctions * SIZE_OF_DWORD
|
||||
|
||||
RETURN SIZE_OF_IMAGE_EXPORT_DIRECTORY + ExportDir.NumberOfFunctions * (2 * SIZE_OF_DWORD + SIZE_OF_WORD)
|
||||
END Export;
|
||||
|
||||
|
||||
PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER;
|
||||
VAR
|
||||
imp: BIN.IMPRT;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
imp := lib.next(BIN.IMPRT);
|
||||
WHILE (imp # NIL) & (imp.label # 0) DO
|
||||
INC(res);
|
||||
imp := imp.next(BIN.IMPRT)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END GetProcCount;
|
||||
|
||||
|
||||
PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER;
|
||||
VAR
|
||||
imp: BIN.IMPRT;
|
||||
proccnt: INTEGER;
|
||||
procoffs: INTEGER;
|
||||
OriginalCurrentThunk,
|
||||
CurrentThunk: INTEGER;
|
||||
|
||||
BEGIN
|
||||
libcnt := 0;
|
||||
proccnt := 0;
|
||||
imp := imp_list.first(BIN.IMPRT);
|
||||
WHILE imp # NIL DO
|
||||
IF imp.label = 0 THEN
|
||||
INC(libcnt)
|
||||
ELSE
|
||||
INC(proccnt)
|
||||
END;
|
||||
imp := imp.next(BIN.IMPRT)
|
||||
END;
|
||||
|
||||
procoffs := 0;
|
||||
|
||||
imp := imp_list.first(BIN.IMPRT);
|
||||
WHILE imp # NIL DO
|
||||
IF imp.label = 0 THEN
|
||||
imp.OriginalFirstThunk := procoffs;
|
||||
imp.FirstThunk := procoffs + (GetProcCount(imp) + 1);
|
||||
OriginalCurrentThunk := imp.OriginalFirstThunk;
|
||||
CurrentThunk := imp.FirstThunk;
|
||||
INC(procoffs, (GetProcCount(imp) + 1) * 2)
|
||||
ELSE
|
||||
imp.OriginalFirstThunk := OriginalCurrentThunk;
|
||||
imp.FirstThunk := CurrentThunk;
|
||||
INC(OriginalCurrentThunk);
|
||||
INC(CurrentThunk)
|
||||
END;
|
||||
imp := imp.next(BIN.IMPRT)
|
||||
END
|
||||
|
||||
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord
|
||||
END GetImportSize;
|
||||
|
||||
|
||||
PROCEDURE fixup* (program: BIN.PROGRAM; Address: VIRTUAL_ADDR; amd64: BOOLEAN);
|
||||
VAR
|
||||
reloc: BIN.RELOC;
|
||||
iproc: BIN.IMPRT;
|
||||
code: CHL.BYTELIST;
|
||||
L, delta, delta0, AdrImp, offset: INTEGER;
|
||||
|
||||
BEGIN
|
||||
AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD;
|
||||
code := program.code;
|
||||
reloc := program.rel_list.first(BIN.RELOC);
|
||||
delta0 := 3 - 7 * ORD(amd64) - Address.Code;
|
||||
|
||||
WHILE reloc # NIL DO
|
||||
|
||||
offset := reloc.offset;
|
||||
L := BIN.get32le(code, offset);
|
||||
delta := delta0 - offset;
|
||||
|
||||
CASE reloc.opcode OF
|
||||
|BIN.PICDATA:
|
||||
INC(delta, L + Address.Data)
|
||||
|
||||
|BIN.PICCODE:
|
||||
INC(delta, BIN.GetLabel(program, L) + Address.Code)
|
||||
|
||||
|BIN.PICBSS:
|
||||
INC(delta, L + Address.Bss)
|
||||
|
||||
|BIN.PICIMP:
|
||||
iproc := BIN.GetIProc(program, L);
|
||||
INC(delta, iproc.FirstThunk * SizeOfWord + AdrImp)
|
||||
END;
|
||||
BIN.put32le(code, offset, delta);
|
||||
|
||||
reloc := reloc.next(BIN.RELOC)
|
||||
END
|
||||
END fixup;
|
||||
|
||||
|
||||
PROCEDURE WriteWord (w: WORD);
|
||||
BEGIN
|
||||
WR.Write16LE(ORD(w))
|
||||
END WriteWord;
|
||||
|
||||
|
||||
PROCEDURE WriteName* (name: NAME);
|
||||
VAR
|
||||
i, nameLen: INTEGER;
|
||||
|
||||
BEGIN
|
||||
nameLen := LENGTH(name);
|
||||
|
||||
FOR i := 0 TO nameLen - 1 DO
|
||||
WR.WriteByte(ORD(name[i]))
|
||||
END;
|
||||
|
||||
i := LEN(name) - nameLen;
|
||||
WHILE i > 0 DO
|
||||
WR.WriteByte(0);
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
END WriteName;
|
||||
|
||||
|
||||
PROCEDURE WriteSectionHeader* (h: IMAGE_SECTION_HEADER);
|
||||
VAR
|
||||
i, nameLen: INTEGER;
|
||||
|
||||
BEGIN
|
||||
nameLen := LENGTH(h.Name);
|
||||
|
||||
FOR i := 0 TO nameLen - 1 DO
|
||||
WR.WriteByte(ORD(h.Name[i]))
|
||||
END;
|
||||
|
||||
i := LEN(h.Name) - nameLen;
|
||||
WHILE i > 0 DO
|
||||
WR.WriteByte(0);
|
||||
DEC(i)
|
||||
END;
|
||||
|
||||
WR.Write32LE(h.VirtualSize);
|
||||
WR.Write32LE(h.VirtualAddress);
|
||||
WR.Write32LE(h.SizeOfRawData);
|
||||
WR.Write32LE(h.PointerToRawData);
|
||||
WR.Write32LE(h.PointerToRelocations);
|
||||
WR.Write32LE(h.PointerToLinenumbers);
|
||||
|
||||
WriteWord(h.NumberOfRelocations);
|
||||
WriteWord(h.NumberOfLinenumbers);
|
||||
|
||||
WR.Write32LE(h.Characteristics)
|
||||
END WriteSectionHeader;
|
||||
|
||||
|
||||
PROCEDURE WriteFileHeader* (h: IMAGE_FILE_HEADER);
|
||||
BEGIN
|
||||
WriteWord(h.Machine);
|
||||
WriteWord(h.NumberOfSections);
|
||||
|
||||
WR.Write32LE(h.TimeDateStamp);
|
||||
WR.Write32LE(h.PointerToSymbolTable);
|
||||
WR.Write32LE(h.NumberOfSymbols);
|
||||
|
||||
WriteWord(h.SizeOfOptionalHeader);
|
||||
WriteWord(h.Characteristics)
|
||||
END WriteFileHeader;
|
||||
|
||||
|
||||
PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN);
|
||||
VAR
|
||||
i, n, temp: INTEGER;
|
||||
|
||||
Size: RECORD
|
||||
|
||||
Code, Data, Bss, Import, Reloc, Export: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
BaseAddress: INTEGER;
|
||||
|
||||
Address: VIRTUAL_ADDR;
|
||||
|
||||
_import: BIN.IMPRT;
|
||||
ImportTable: CHL.INTLIST;
|
||||
|
||||
ExportDir: IMAGE_EXPORT_DIRECTORY;
|
||||
export: BIN.EXPRT;
|
||||
|
||||
|
||||
PROCEDURE WriteExportDir (e: IMAGE_EXPORT_DIRECTORY);
|
||||
BEGIN
|
||||
WR.Write32LE(e.Characteristics);
|
||||
WR.Write32LE(e.TimeDateStamp);
|
||||
|
||||
WriteWord(e.MajorVersion);
|
||||
WriteWord(e.MinorVersion);
|
||||
|
||||
WR.Write32LE(e.Name);
|
||||
WR.Write32LE(e.Base);
|
||||
WR.Write32LE(e.NumberOfFunctions);
|
||||
WR.Write32LE(e.NumberOfNames);
|
||||
WR.Write32LE(e.AddressOfFunctions);
|
||||
WR.Write32LE(e.AddressOfNames);
|
||||
WR.Write32LE(e.AddressOfNameOrdinals)
|
||||
END WriteExportDir;
|
||||
|
||||
|
||||
PROCEDURE WriteOptHeader (h: IMAGE_OPTIONAL_HEADER; amd64: BOOLEAN);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
WriteWord(h.Magic);
|
||||
|
||||
WR.WriteByte(h.MajorLinkerVersion);
|
||||
WR.WriteByte(h.MinorLinkerVersion);
|
||||
|
||||
WR.Write32LE(h.SizeOfCode);
|
||||
WR.Write32LE(h.SizeOfInitializedData);
|
||||
WR.Write32LE(h.SizeOfUninitializedData);
|
||||
WR.Write32LE(h.AddressOfEntryPoint);
|
||||
WR.Write32LE(h.BaseOfCode);
|
||||
|
||||
IF amd64 THEN
|
||||
WR.Write64LE(h.ImageBase)
|
||||
ELSE
|
||||
WR.Write32LE(h.BaseOfData);
|
||||
WR.Write32LE(h.ImageBase)
|
||||
END;
|
||||
|
||||
WR.Write32LE(h.SectionAlignment);
|
||||
WR.Write32LE(h.FileAlignment);
|
||||
|
||||
WriteWord(h.MajorOperatingSystemVersion);
|
||||
WriteWord(h.MinorOperatingSystemVersion);
|
||||
WriteWord(h.MajorImageVersion);
|
||||
WriteWord(h.MinorImageVersion);
|
||||
WriteWord(h.MajorSubsystemVersion);
|
||||
WriteWord(h.MinorSubsystemVersion);
|
||||
|
||||
WR.Write32LE(h.Win32VersionValue);
|
||||
WR.Write32LE(h.SizeOfImage);
|
||||
WR.Write32LE(h.SizeOfHeaders);
|
||||
WR.Write32LE(h.CheckSum);
|
||||
|
||||
WriteWord(h.Subsystem);
|
||||
WriteWord(h.DllCharacteristics);
|
||||
|
||||
IF amd64 THEN
|
||||
WR.Write64LE(h.SizeOfStackReserve);
|
||||
WR.Write64LE(h.SizeOfStackCommit);
|
||||
WR.Write64LE(h.SizeOfHeapReserve);
|
||||
WR.Write64LE(h.SizeOfHeapCommit)
|
||||
ELSE
|
||||
WR.Write32LE(h.SizeOfStackReserve);
|
||||
WR.Write32LE(h.SizeOfStackCommit);
|
||||
WR.Write32LE(h.SizeOfHeapReserve);
|
||||
WR.Write32LE(h.SizeOfHeapCommit)
|
||||
END;
|
||||
|
||||
WR.Write32LE(h.LoaderFlags);
|
||||
WR.Write32LE(h.NumberOfRvaAndSizes);
|
||||
|
||||
FOR i := 0 TO LEN(h.DataDirectory) - 1 DO
|
||||
WR.Write32LE(h.DataDirectory[i].VirtualAddress);
|
||||
WR.Write32LE(h.DataDirectory[i].Size)
|
||||
END
|
||||
|
||||
END WriteOptHeader;
|
||||
|
||||
|
||||
PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; VirtualSize: INTEGER; Characteristics: DWORD);
|
||||
BEGIN
|
||||
section.Name := Name;
|
||||
section.VirtualSize := VirtualSize;
|
||||
section.SizeOfRawData := WR.align(VirtualSize, FileAlignment);
|
||||
section.PointerToRelocations := 0;
|
||||
section.PointerToLinenumbers := 0;
|
||||
section.NumberOfRelocations := 0X;
|
||||
section.NumberOfLinenumbers := 0X;
|
||||
section.Characteristics := Characteristics
|
||||
END InitSection;
|
||||
|
||||
|
||||
BEGIN
|
||||
SizeOfWord := SIZE_OF_DWORD * (ORD(amd64) + 1);
|
||||
|
||||
Size.Code := CHL.Length(program.code);
|
||||
Size.Data := CHL.Length(program.data);
|
||||
Size.Bss := program.bss;
|
||||
|
||||
IF dll THEN
|
||||
BaseAddress := 10000000H
|
||||
ELSE
|
||||
BaseAddress := 400000H
|
||||
END;
|
||||
|
||||
Signature[0] := 50H;
|
||||
Signature[1] := 45H;
|
||||
Signature[2] := 0;
|
||||
Signature[3] := 0;
|
||||
|
||||
IF amd64 THEN
|
||||
FileHeader.Machine := 08664X
|
||||
ELSE
|
||||
FileHeader.Machine := 014CX
|
||||
END;
|
||||
|
||||
FileHeader.NumberOfSections := WCHR(4 + ORD(dll));
|
||||
|
||||
FileHeader.TimeDateStamp := UTILS.UnixTime();
|
||||
FileHeader.PointerToSymbolTable := 0H;
|
||||
FileHeader.NumberOfSymbols := 0H;
|
||||
FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64));
|
||||
FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll));
|
||||
|
||||
OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64));
|
||||
OptionalHeader.MajorLinkerVersion := UTILS.vMajor;
|
||||
OptionalHeader.MinorLinkerVersion := UTILS.vMinor;
|
||||
OptionalHeader.SizeOfCode := WR.align(Size.Code, FileAlignment);
|
||||
OptionalHeader.SizeOfInitializedData := 0;
|
||||
OptionalHeader.SizeOfUninitializedData := 0;
|
||||
OptionalHeader.AddressOfEntryPoint := SectionAlignment;
|
||||
OptionalHeader.BaseOfCode := SectionAlignment;
|
||||
OptionalHeader.BaseOfData := OptionalHeader.BaseOfCode + WR.align(Size.Code, SectionAlignment);
|
||||
OptionalHeader.ImageBase := BaseAddress;
|
||||
OptionalHeader.SectionAlignment := SectionAlignment;
|
||||
OptionalHeader.FileAlignment := FileAlignment;
|
||||
OptionalHeader.MajorOperatingSystemVersion := 1X;
|
||||
OptionalHeader.MinorOperatingSystemVersion := 0X;
|
||||
OptionalHeader.MajorImageVersion := 0X;
|
||||
OptionalHeader.MinorImageVersion := 0X;
|
||||
OptionalHeader.MajorSubsystemVersion := 4X;
|
||||
OptionalHeader.MinorSubsystemVersion := 0X;
|
||||
OptionalHeader.Win32VersionValue := 0H;
|
||||
OptionalHeader.SizeOfImage := SectionAlignment;
|
||||
OptionalHeader.SizeOfHeaders := 400H;
|
||||
OptionalHeader.CheckSum := 0;
|
||||
OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll));
|
||||
OptionalHeader.DllCharacteristics := 0040X;
|
||||
OptionalHeader.SizeOfStackReserve := 100000H;
|
||||
OptionalHeader.SizeOfStackCommit := 10000H;
|
||||
OptionalHeader.SizeOfHeapReserve := 100000H;
|
||||
OptionalHeader.SizeOfHeapCommit := 10000H;
|
||||
OptionalHeader.LoaderFlags := 0;
|
||||
OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES;
|
||||
|
||||
FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO
|
||||
OptionalHeader.DataDirectory[i].VirtualAddress := 0;
|
||||
OptionalHeader.DataDirectory[i].Size := 0
|
||||
END;
|
||||
|
||||
InitSection(SectionHeaders[0], ".text", Size.Code, SHC_text);
|
||||
SectionHeaders[0].VirtualAddress := SectionAlignment;
|
||||
SectionHeaders[0].PointerToRawData := OptionalHeader.SizeOfHeaders;
|
||||
|
||||
InitSection(SectionHeaders[1], ".data", Size.Data, SHC_data);
|
||||
SectionHeaders[1].VirtualAddress := WR.align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment);
|
||||
SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData;
|
||||
|
||||
InitSection(SectionHeaders[2], ".bss", Size.Bss, SHC_bss);
|
||||
SectionHeaders[2].VirtualAddress := WR.align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment);
|
||||
SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData;
|
||||
SectionHeaders[2].SizeOfRawData := 0;
|
||||
|
||||
Size.Import := GetImportSize(program.imp_list);
|
||||
|
||||
InitSection(SectionHeaders[3], ".idata", Size.Import + CHL.Length(program._import), SHC_data);
|
||||
SectionHeaders[3].VirtualAddress := WR.align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment);
|
||||
SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData;
|
||||
|
||||
Address.Code := SectionHeaders[0].VirtualAddress + OptionalHeader.ImageBase;
|
||||
Address.Data := SectionHeaders[1].VirtualAddress + OptionalHeader.ImageBase;
|
||||
Address.Bss := SectionHeaders[2].VirtualAddress + OptionalHeader.ImageBase;
|
||||
Address.Import := SectionHeaders[3].VirtualAddress + OptionalHeader.ImageBase;
|
||||
|
||||
fixup(program, Address, amd64);
|
||||
|
||||
IF dll THEN
|
||||
Size.Export := Export(program, SectionHeaders[1].VirtualAddress + program.modname, ExportDir);
|
||||
|
||||
InitSection(SectionHeaders[4], ".edata", Size.Export + CHL.Length(program.export), SHC_data);
|
||||
SectionHeaders[4].VirtualAddress := WR.align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment);
|
||||
SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData;
|
||||
|
||||
OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress;
|
||||
OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize
|
||||
END;
|
||||
|
||||
OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress;
|
||||
OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize;
|
||||
|
||||
FOR i := 1 TO ORD(FileHeader.NumberOfSections) - 1 DO
|
||||
INC(OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData)
|
||||
END;
|
||||
|
||||
OptionalHeader.SizeOfUninitializedData := WR.align(SectionHeaders[2].VirtualSize, FileAlignment);
|
||||
|
||||
FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
|
||||
INC(OptionalHeader.SizeOfImage, WR.align(SectionHeaders[i].VirtualSize, SectionAlignment))
|
||||
END;
|
||||
|
||||
n := 0;
|
||||
BIN.InitArray(msdos, n, "4D5A80000100000004001000FFFF000040010000000000004000000000000000");
|
||||
BIN.InitArray(msdos, n, "0000000000000000000000000000000000000000000000000000000080000000");
|
||||
BIN.InitArray(msdos, n, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F");
|
||||
BIN.InitArray(msdos, n, "742062652072756E20696E20444F53206D6F64652E0D0A240000000000000000");
|
||||
|
||||
WR.Create(FileName);
|
||||
|
||||
WR.Write(msdos, LEN(msdos));
|
||||
|
||||
WR.Write(Signature, LEN(Signature));
|
||||
WriteFileHeader(FileHeader);
|
||||
WriteOptHeader(OptionalHeader, amd64);
|
||||
|
||||
FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO
|
||||
WriteSectionHeader(SectionHeaders[i])
|
||||
END;
|
||||
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
CHL.WriteToFile(program.code);
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
CHL.WriteToFile(program.data);
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
n := (libcnt + 1) * 5;
|
||||
ImportTable := CHL.CreateIntList();
|
||||
|
||||
FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SizeOfWord + n - 1 DO
|
||||
CHL.PushInt(ImportTable, 0)
|
||||
END;
|
||||
|
||||
i := 0;
|
||||
_import := program.imp_list.first(BIN.IMPRT);
|
||||
WHILE _import # NIL DO
|
||||
IF _import.label = 0 THEN
|
||||
CHL.SetInt(ImportTable, i + 0, _import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
|
||||
CHL.SetInt(ImportTable, i + 1, 0);
|
||||
CHL.SetInt(ImportTable, i + 2, 0);
|
||||
CHL.SetInt(ImportTable, i + 3, _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress);
|
||||
CHL.SetInt(ImportTable, i + 4, _import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD);
|
||||
INC(i, 5)
|
||||
END;
|
||||
_import := _import.next(BIN.IMPRT)
|
||||
END;
|
||||
|
||||
CHL.SetInt(ImportTable, i + 0, 0);
|
||||
CHL.SetInt(ImportTable, i + 1, 0);
|
||||
CHL.SetInt(ImportTable, i + 2, 0);
|
||||
CHL.SetInt(ImportTable, i + 3, 0);
|
||||
CHL.SetInt(ImportTable, i + 4, 0);
|
||||
|
||||
_import := program.imp_list.first(BIN.IMPRT);
|
||||
WHILE _import # NIL DO
|
||||
IF _import.label # 0 THEN
|
||||
temp := _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2;
|
||||
CHL.SetInt(ImportTable, _import.OriginalFirstThunk + n, temp);
|
||||
CHL.SetInt(ImportTable, _import.FirstThunk + n, temp)
|
||||
END;
|
||||
_import := _import.next(BIN.IMPRT)
|
||||
END;
|
||||
|
||||
FOR i := 0 TO n - 1 DO
|
||||
WR.Write32LE(CHL.GetInt(ImportTable, i))
|
||||
END;
|
||||
|
||||
FOR i := n TO CHL.Length(ImportTable) - 1 DO
|
||||
IF amd64 THEN
|
||||
WR.Write64LE(CHL.GetInt(ImportTable, i))
|
||||
ELSE
|
||||
WR.Write32LE(CHL.GetInt(ImportTable, i))
|
||||
END
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(program._import);
|
||||
WR.Padding(FileAlignment);
|
||||
|
||||
IF dll THEN
|
||||
|
||||
INC(ExportDir.AddressOfFunctions, SectionHeaders[4].VirtualAddress);
|
||||
INC(ExportDir.AddressOfNames, SectionHeaders[4].VirtualAddress);
|
||||
INC(ExportDir.AddressOfNameOrdinals, SectionHeaders[4].VirtualAddress);
|
||||
|
||||
WriteExportDir(ExportDir);
|
||||
|
||||
export := program.exp_list.first(BIN.EXPRT);
|
||||
WHILE export # NIL DO
|
||||
WR.Write32LE(export.label + SectionHeaders[0].VirtualAddress);
|
||||
export := export.next(BIN.EXPRT)
|
||||
END;
|
||||
|
||||
export := program.exp_list.first(BIN.EXPRT);
|
||||
WHILE export # NIL DO
|
||||
WR.Write32LE(export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress);
|
||||
export := export.next(BIN.EXPRT)
|
||||
END;
|
||||
|
||||
FOR i := 0 TO ExportDir.NumberOfFunctions - 1 DO
|
||||
WriteWord(WCHR(i))
|
||||
END;
|
||||
|
||||
CHL.WriteToFile(program.export);
|
||||
WR.Padding(FileAlignment)
|
||||
END;
|
||||
|
||||
WR.Close
|
||||
END write;
|
||||
|
||||
|
||||
END PE32.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,286 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE REG;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
N = 16;
|
||||
|
||||
R0* = 0; R1* = 1; R2* = 2; R3* = 3;
|
||||
R4* = 4; R5* = 5; R6* = 6; R7* = 7;
|
||||
R8* = 8; R9* = 9; R10* = 10; R11* = 11;
|
||||
R12* = 12; R13* = 13; R14* = 14; R15* = 15;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
OP1 = PROCEDURE (arg: INTEGER);
|
||||
OP2 = PROCEDURE (arg1, arg2: INTEGER);
|
||||
|
||||
REGS* = RECORD
|
||||
|
||||
regs*: SET;
|
||||
stk*: ARRAY N OF INTEGER;
|
||||
top*: INTEGER;
|
||||
pushed*: INTEGER;
|
||||
|
||||
push, pop: OP1;
|
||||
mov, xch: OP2
|
||||
|
||||
END;
|
||||
|
||||
|
||||
PROCEDURE push (VAR R: REGS);
|
||||
VAR
|
||||
i, reg: INTEGER;
|
||||
|
||||
BEGIN
|
||||
reg := R.stk[0];
|
||||
INCL(R.regs, reg);
|
||||
R.push(reg);
|
||||
FOR i := 0 TO R.top - 1 DO
|
||||
R.stk[i] := R.stk[i + 1]
|
||||
END;
|
||||
DEC(R.top);
|
||||
INC(R.pushed)
|
||||
END push;
|
||||
|
||||
|
||||
PROCEDURE pop (VAR R: REGS; reg: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := R.top + 1 TO 1 BY -1 DO
|
||||
R.stk[i] := R.stk[i - 1]
|
||||
END;
|
||||
R.stk[0] := reg;
|
||||
EXCL(R.regs, reg);
|
||||
R.pop(reg);
|
||||
INC(R.top);
|
||||
DEC(R.pushed)
|
||||
END pop;
|
||||
|
||||
|
||||
PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := R.top;
|
||||
WHILE (i >= 0) & (R.stk[i] # reg) DO
|
||||
DEC(i)
|
||||
END
|
||||
|
||||
RETURN i
|
||||
END InStk;
|
||||
|
||||
|
||||
PROCEDURE GetFreeReg (R: REGS): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < N) & ~(i IN R.regs) DO
|
||||
INC(i)
|
||||
END;
|
||||
|
||||
IF i = N THEN
|
||||
i := -1
|
||||
END
|
||||
|
||||
RETURN i
|
||||
END GetFreeReg;
|
||||
|
||||
|
||||
PROCEDURE Put (VAR R: REGS; reg: INTEGER);
|
||||
BEGIN
|
||||
EXCL(R.regs, reg);
|
||||
INC(R.top);
|
||||
R.stk[R.top] := reg
|
||||
END Put;
|
||||
|
||||
|
||||
PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
|
||||
VAR
|
||||
reg: INTEGER;
|
||||
|
||||
BEGIN
|
||||
reg := GetFreeReg(R);
|
||||
ASSERT(reg # -1);
|
||||
ASSERT(R.top < LEN(R.stk) - 1);
|
||||
ASSERT(R.pushed > 0);
|
||||
pop(R, reg)
|
||||
|
||||
RETURN reg
|
||||
END PopAnyReg;
|
||||
|
||||
|
||||
PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
|
||||
VAR
|
||||
reg: INTEGER;
|
||||
|
||||
BEGIN
|
||||
reg := GetFreeReg(R);
|
||||
IF reg = -1 THEN
|
||||
ASSERT(R.top >= 0);
|
||||
reg := R.stk[0];
|
||||
push(R)
|
||||
END;
|
||||
|
||||
Put(R, reg)
|
||||
|
||||
RETURN reg
|
||||
END GetAnyReg;
|
||||
|
||||
|
||||
PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
free: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
|
||||
PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
|
||||
VAR
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := InStk(R, reg1);
|
||||
n2 := InStk(R, reg2);
|
||||
R.stk[n1] := reg2;
|
||||
R.stk[n2] := reg1;
|
||||
R.xch(reg1, reg2)
|
||||
END exch;
|
||||
|
||||
|
||||
BEGIN
|
||||
IF reg IN R.regs THEN
|
||||
Put(R, reg);
|
||||
res := TRUE
|
||||
ELSE
|
||||
res := InStk(R, reg) # -1;
|
||||
IF res THEN
|
||||
free := GetFreeReg(R);
|
||||
IF free # -1 THEN
|
||||
Put(R, free);
|
||||
exch(R, reg, free)
|
||||
ELSE
|
||||
push(R);
|
||||
free := GetFreeReg(R);
|
||||
ASSERT(free # -1);
|
||||
Put(R, free);
|
||||
IF free # reg THEN
|
||||
exch(R, reg, free)
|
||||
END
|
||||
END
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END GetReg;
|
||||
|
||||
|
||||
PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
n1, n2: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := TRUE;
|
||||
|
||||
IF reg1 # reg2 THEN
|
||||
n1 := InStk(R, reg1);
|
||||
n2 := InStk(R, reg2);
|
||||
|
||||
IF (n1 # -1) & (n2 # -1) THEN
|
||||
R.stk[n1] := reg2;
|
||||
R.stk[n2] := reg1;
|
||||
R.xch(reg2, reg1)
|
||||
ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
|
||||
R.stk[n1] := reg2;
|
||||
INCL(R.regs, reg1);
|
||||
EXCL(R.regs, reg2);
|
||||
R.mov(reg2, reg1)
|
||||
ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
|
||||
R.stk[n2] := reg1;
|
||||
EXCL(R.regs, reg1);
|
||||
INCL(R.regs, reg2);
|
||||
R.mov(reg1, reg2)
|
||||
ELSE
|
||||
res := FALSE
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END Exchange;
|
||||
|
||||
|
||||
PROCEDURE Drop* (VAR R: REGS);
|
||||
BEGIN
|
||||
INCL(R.regs, R.stk[R.top]);
|
||||
DEC(R.top)
|
||||
END Drop;
|
||||
|
||||
|
||||
PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
|
||||
BEGIN
|
||||
IF R.top > 0 THEN
|
||||
reg1 := R.stk[R.top - 1];
|
||||
reg2 := R.stk[R.top]
|
||||
ELSIF R.top = 0 THEN
|
||||
reg1 := PopAnyReg(R);
|
||||
reg2 := R.stk[1]
|
||||
ELSE (* R.top = -1 *)
|
||||
reg2 := PopAnyReg(R);
|
||||
reg1 := PopAnyReg(R)
|
||||
END
|
||||
END BinOp;
|
||||
|
||||
|
||||
PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
|
||||
BEGIN
|
||||
IF R.top >= 0 THEN
|
||||
reg := R.stk[R.top]
|
||||
ELSE
|
||||
reg := PopAnyReg(R)
|
||||
END
|
||||
END UnOp;
|
||||
|
||||
|
||||
PROCEDURE PushAll* (VAR R: REGS);
|
||||
BEGIN
|
||||
WHILE R.top >= 0 DO
|
||||
push(R)
|
||||
END
|
||||
END PushAll;
|
||||
|
||||
|
||||
PROCEDURE PushAll_1* (VAR R: REGS);
|
||||
BEGIN
|
||||
WHILE R.top >= 1 DO
|
||||
push(R)
|
||||
END
|
||||
END PushAll_1;
|
||||
|
||||
|
||||
PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; regs: SET);
|
||||
BEGIN
|
||||
R.regs := regs;
|
||||
R.pushed := 0;
|
||||
R.top := -1;
|
||||
|
||||
R.push := push;
|
||||
R.pop := pop;
|
||||
R.mov := mov;
|
||||
R.xch := xch;
|
||||
END Init;
|
||||
|
||||
|
||||
END REG.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,783 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE SCAN;
|
||||
|
||||
IMPORT TXT := TEXTDRV, ARITH, S := STRINGS, ERRORS, LISTS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
NUMLEN = 256;
|
||||
IDLEN = 256;
|
||||
TEXTLEN = 512;
|
||||
|
||||
lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3;
|
||||
lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7;
|
||||
lxEOF* = 8;
|
||||
|
||||
lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24;
|
||||
lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28;
|
||||
lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32;
|
||||
lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36;
|
||||
lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40;
|
||||
lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44;
|
||||
lxASSIGN* = 45; lxRANGE* = 46;
|
||||
|
||||
lxKW = 51;
|
||||
|
||||
lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54;
|
||||
lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58;
|
||||
lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62;
|
||||
lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66;
|
||||
lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70;
|
||||
lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74;
|
||||
lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78;
|
||||
lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82;
|
||||
lxWHILE* = 83;
|
||||
|
||||
lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4;
|
||||
lxERROR05* = -5; (*lxERROR06* = -6;*) lxERROR07* = -7; lxERROR08* = -8;
|
||||
lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12;
|
||||
lxERROR13* = -13;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
TEXTSTR* = ARRAY TEXTLEN OF CHAR;
|
||||
IDSTR* = ARRAY IDLEN OF CHAR;
|
||||
|
||||
DEF = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
ident: IDSTR
|
||||
|
||||
END;
|
||||
|
||||
STRING* = POINTER TO RECORD (LISTS.ITEM)
|
||||
|
||||
s*: TEXTSTR;
|
||||
offset*, offsetW*, hash: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
IDENT* = RECORD
|
||||
|
||||
s*: IDSTR;
|
||||
hash*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
POSITION* = RECORD
|
||||
|
||||
line*, col*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
LEX* = RECORD
|
||||
|
||||
sym*: INTEGER;
|
||||
pos*: POSITION;
|
||||
ident*: IDENT;
|
||||
string*: STRING;
|
||||
value*: ARITH.VALUE;
|
||||
error*: INTEGER
|
||||
|
||||
END;
|
||||
|
||||
SCANNER* = TXT.TEXT;
|
||||
|
||||
KEYWORD = ARRAY 10 OF CHAR;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
delimiters: ARRAY 256 OF BOOLEAN;
|
||||
|
||||
upto, LowerCase, _if: BOOLEAN;
|
||||
|
||||
strings, def: LISTS.LIST;
|
||||
|
||||
KW: ARRAY 33 OF RECORD upper, lower: KEYWORD; uhash, lhash: INTEGER END;
|
||||
|
||||
|
||||
PROCEDURE enterKW (s: KEYWORD; idx: INTEGER);
|
||||
BEGIN
|
||||
KW[idx].lower := s;
|
||||
KW[idx].upper := s;
|
||||
S.UpCase(KW[idx].upper);
|
||||
KW[idx].uhash := S.HashStr(KW[idx].upper);
|
||||
KW[idx].lhash := S.HashStr(KW[idx].lower);
|
||||
END enterKW;
|
||||
|
||||
|
||||
PROCEDURE checkKW (ident: IDENT): INTEGER;
|
||||
VAR
|
||||
i, res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := lxIDENT;
|
||||
i := 0;
|
||||
WHILE i < LEN(KW) DO
|
||||
IF (KW[i].uhash = ident.hash) & (KW[i].upper = ident.s)
|
||||
OR LowerCase & (KW[i].lhash = ident.hash) & (KW[i].lower = ident.s) THEN
|
||||
res := i + lxKW;
|
||||
i := LEN(KW)
|
||||
END;
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END checkKW;
|
||||
|
||||
|
||||
PROCEDURE enterStr* (s: TEXTSTR): STRING;
|
||||
VAR
|
||||
str, res: STRING;
|
||||
hash: INTEGER;
|
||||
|
||||
BEGIN
|
||||
hash := S.HashStr(s);
|
||||
str := strings.first(STRING);
|
||||
res := NIL;
|
||||
WHILE str # NIL DO
|
||||
IF (str.hash = hash) & (str.s = s) THEN
|
||||
res := str;
|
||||
str := NIL
|
||||
ELSE
|
||||
str := str.next(STRING)
|
||||
END
|
||||
END;
|
||||
IF res = NIL THEN
|
||||
NEW(res);
|
||||
res.s := s;
|
||||
res.offset := -1;
|
||||
res.offsetW := -1;
|
||||
res.hash := hash;
|
||||
LISTS.push(strings, res)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END enterStr;
|
||||
|
||||
|
||||
PROCEDURE nextc (text: TXT.TEXT): CHAR;
|
||||
BEGIN
|
||||
TXT.next(text)
|
||||
RETURN text.peak
|
||||
END nextc;
|
||||
|
||||
|
||||
PROCEDURE setIdent* (VAR ident: IDENT; s: IDSTR);
|
||||
BEGIN
|
||||
ident.s := s;
|
||||
ident.hash := S.HashStr(s)
|
||||
END setIdent;
|
||||
|
||||
|
||||
PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
|
||||
VAR
|
||||
c: CHAR;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
c := text.peak;
|
||||
ASSERT(S.letter(c));
|
||||
|
||||
i := 0;
|
||||
WHILE (i < IDLEN - 1) & (S.letter(c) OR S.digit(c)) DO
|
||||
lex.ident.s[i] := c;
|
||||
INC(i);
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
lex.ident.s[i] := 0X;
|
||||
lex.ident.hash := S.HashStr(lex.ident.s);
|
||||
lex.sym := checkKW(lex.ident);
|
||||
|
||||
IF S.letter(c) OR S.digit(c) THEN
|
||||
ERRORS.WarningMsg(lex.pos.line, lex.pos.col, 2);
|
||||
WHILE S.letter(c) OR S.digit(c) DO
|
||||
c := nextc(text)
|
||||
END
|
||||
END
|
||||
END ident;
|
||||
|
||||
|
||||
PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
|
||||
TYPE
|
||||
NUMSTR = ARRAY NUMLEN OF CHAR;
|
||||
|
||||
VAR
|
||||
c: CHAR;
|
||||
hex: BOOLEAN;
|
||||
error, sym, i: INTEGER;
|
||||
num: NUMSTR;
|
||||
|
||||
|
||||
PROCEDURE push (VAR num: NUMSTR; VAR i: INTEGER; c: CHAR);
|
||||
BEGIN
|
||||
IF i < NUMLEN - 1 THEN
|
||||
num[i] := c;
|
||||
INC(i)
|
||||
END
|
||||
END push;
|
||||
|
||||
|
||||
BEGIN
|
||||
c := text.peak;
|
||||
ASSERT(S.digit(c));
|
||||
|
||||
i := 0;
|
||||
|
||||
error := 0;
|
||||
|
||||
sym := lxINTEGER;
|
||||
hex := FALSE;
|
||||
|
||||
WHILE S.digit(c) DO
|
||||
push(num, i, c);
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
WHILE S.hexdigit(c) OR LowerCase & ("a" <= c) & (c <= "f") DO
|
||||
S.cap(c);
|
||||
push(num, i, c);
|
||||
c := nextc(text);
|
||||
hex := TRUE
|
||||
END;
|
||||
|
||||
IF (c = "H") OR LowerCase & (c = "h") THEN
|
||||
push(num, i, c);
|
||||
TXT.next(text);
|
||||
sym := lxHEX
|
||||
|
||||
ELSIF (c = "X") OR LowerCase & (c = "x") THEN
|
||||
push(num, i, c);
|
||||
TXT.next(text);
|
||||
sym := lxCHAR
|
||||
|
||||
ELSIF c = "." THEN
|
||||
|
||||
IF hex THEN
|
||||
sym := lxERROR01
|
||||
ELSE
|
||||
|
||||
c := nextc(text);
|
||||
|
||||
IF c # "." THEN
|
||||
push(num, i, ".");
|
||||
sym := lxFLOAT
|
||||
ELSE
|
||||
sym := lxINTEGER;
|
||||
text.peak := 7FX;
|
||||
upto := TRUE
|
||||
END;
|
||||
|
||||
WHILE S.digit(c) DO
|
||||
push(num, i, c);
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
IF (c = "E") OR LowerCase & (c = "e") THEN
|
||||
|
||||
push(num, i, c);
|
||||
c := nextc(text);
|
||||
IF (c = "+") OR (c = "-") THEN
|
||||
push(num, i, c);
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
IF S.digit(c) THEN
|
||||
WHILE S.digit(c) DO
|
||||
push(num, i, c);
|
||||
c := nextc(text)
|
||||
END
|
||||
ELSE
|
||||
sym := lxERROR02
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
ELSIF hex THEN
|
||||
sym := lxERROR01
|
||||
|
||||
END;
|
||||
|
||||
IF (i = NUMLEN - 1) & (sym >= 0) THEN
|
||||
sym := lxERROR07
|
||||
END;
|
||||
|
||||
num[i] := 0X;
|
||||
|
||||
IF sym = lxINTEGER THEN
|
||||
ARITH.iconv(num, lex.value, error)
|
||||
ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
|
||||
ARITH.hconv(num, lex.value, error)
|
||||
ELSIF sym = lxFLOAT THEN
|
||||
ARITH.fconv(num, lex.value, error)
|
||||
END;
|
||||
|
||||
CASE error OF
|
||||
|0:
|
||||
|1: sym := lxERROR08
|
||||
|2: sym := lxERROR09
|
||||
|3: sym := lxERROR10
|
||||
|4: sym := lxERROR11
|
||||
|5: sym := lxERROR12
|
||||
END;
|
||||
|
||||
lex.sym := sym
|
||||
END number;
|
||||
|
||||
|
||||
PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
|
||||
VAR
|
||||
c: CHAR;
|
||||
i: INTEGER;
|
||||
str: TEXTSTR;
|
||||
|
||||
BEGIN
|
||||
c := nextc(text);
|
||||
|
||||
i := 0;
|
||||
WHILE (i < LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
|
||||
str[i] := c;
|
||||
c := nextc(text);
|
||||
INC(i)
|
||||
END;
|
||||
|
||||
str[i] := 0X;
|
||||
|
||||
IF (i = LEN(str) - 1) & (c # quot) & (c # 0X) & ~text.eol & ~text.eof THEN
|
||||
lex.sym := lxERROR05
|
||||
END;
|
||||
|
||||
IF c = quot THEN
|
||||
TXT.next(text);
|
||||
IF i # 1 THEN
|
||||
lex.sym := lxSTRING
|
||||
ELSE
|
||||
lex.sym := lxCHAR;
|
||||
ARITH.setChar(lex.value, ORD(str[0]))
|
||||
END
|
||||
ELSIF lex.sym # lxERROR05 THEN
|
||||
lex.sym := lxERROR03
|
||||
END;
|
||||
|
||||
IF lex.sym = lxSTRING THEN
|
||||
lex.string := enterStr(str);
|
||||
lex.value.typ := ARITH.tSTRING;
|
||||
lex.value.string := lex.string
|
||||
END
|
||||
|
||||
END string;
|
||||
|
||||
|
||||
PROCEDURE comment (text: TXT.TEXT);
|
||||
VAR
|
||||
c: CHAR;
|
||||
cond, depth: INTEGER;
|
||||
|
||||
BEGIN
|
||||
cond := 0;
|
||||
depth := 1;
|
||||
|
||||
REPEAT
|
||||
|
||||
c := text.peak;
|
||||
TXT.next(text);
|
||||
|
||||
IF c = "*" THEN
|
||||
IF cond = 1 THEN
|
||||
cond := 0;
|
||||
INC(depth)
|
||||
ELSE
|
||||
cond := 2
|
||||
END
|
||||
ELSIF c = ")" THEN
|
||||
IF cond = 2 THEN
|
||||
DEC(depth)
|
||||
END;
|
||||
cond := 0
|
||||
ELSIF c = "(" THEN
|
||||
cond := 1
|
||||
ELSE
|
||||
cond := 0
|
||||
END
|
||||
|
||||
UNTIL (depth = 0) OR text.eof
|
||||
|
||||
END comment;
|
||||
|
||||
|
||||
PROCEDURE delimiter (text: TXT.TEXT; c: CHAR): INTEGER;
|
||||
VAR
|
||||
sym: INTEGER;
|
||||
c0: CHAR;
|
||||
|
||||
BEGIN
|
||||
c0 := c;
|
||||
c := nextc(text);
|
||||
|
||||
CASE c0 OF
|
||||
|"+":
|
||||
sym := lxPLUS
|
||||
|
||||
|"-":
|
||||
sym := lxMINUS
|
||||
|
||||
|"*":
|
||||
sym := lxMUL
|
||||
|
||||
|"/":
|
||||
sym := lxSLASH;
|
||||
|
||||
IF c = "/" THEN
|
||||
sym := lxCOMMENT;
|
||||
REPEAT
|
||||
TXT.next(text)
|
||||
UNTIL text.eol OR text.eof
|
||||
END
|
||||
|
||||
|"~":
|
||||
sym := lxNOT
|
||||
|
||||
|"&":
|
||||
sym := lxAND
|
||||
|
||||
|".":
|
||||
sym := lxPOINT;
|
||||
|
||||
IF c = "." THEN
|
||||
sym := lxRANGE;
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|",":
|
||||
sym := lxCOMMA
|
||||
|
||||
|";":
|
||||
sym := lxSEMI
|
||||
|
||||
|"|":
|
||||
sym := lxBAR
|
||||
|
||||
|"(":
|
||||
sym := lxLROUND;
|
||||
|
||||
IF c = "*" THEN
|
||||
sym := lxCOMMENT;
|
||||
TXT.next(text);
|
||||
comment(text)
|
||||
END
|
||||
|
||||
|"[":
|
||||
sym := lxLSQUARE
|
||||
|
||||
|"{":
|
||||
sym := lxLCURLY
|
||||
|
||||
|"^":
|
||||
sym := lxCARET
|
||||
|
||||
|"=":
|
||||
sym := lxEQ
|
||||
|
||||
|"#":
|
||||
sym := lxNE
|
||||
|
||||
|"<":
|
||||
sym := lxLT;
|
||||
|
||||
IF c = "=" THEN
|
||||
sym := lxLE;
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|">":
|
||||
sym := lxGT;
|
||||
|
||||
IF c = "=" THEN
|
||||
sym := lxGE;
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|":":
|
||||
sym := lxCOLON;
|
||||
|
||||
IF c = "=" THEN
|
||||
sym := lxASSIGN;
|
||||
TXT.next(text)
|
||||
END
|
||||
|
||||
|")":
|
||||
sym := lxRROUND
|
||||
|
||||
|"]":
|
||||
sym := lxRSQUARE
|
||||
|
||||
|"}":
|
||||
sym := lxRCURLY
|
||||
|
||||
END
|
||||
|
||||
RETURN sym
|
||||
END delimiter;
|
||||
|
||||
|
||||
PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
|
||||
PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER);
|
||||
BEGIN
|
||||
IF ~cond THEN
|
||||
ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno)
|
||||
END
|
||||
END check;
|
||||
|
||||
|
||||
PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
cur: DEF;
|
||||
|
||||
BEGIN
|
||||
cur := def.first(DEF);
|
||||
WHILE (cur # NIL) & (cur.ident # str) DO
|
||||
cur := cur.next(DEF)
|
||||
END
|
||||
|
||||
RETURN cur # NIL
|
||||
END IsDef;
|
||||
|
||||
|
||||
PROCEDURE Skip (text: SCANNER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i <= text.ifc) & ~text._skip[i] DO
|
||||
INC(i)
|
||||
END;
|
||||
text.skip := i <= text.ifc
|
||||
END Skip;
|
||||
|
||||
|
||||
PROCEDURE prep_if (text: SCANNER; VAR lex: LEX);
|
||||
VAR
|
||||
skip: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
INC(text.ifc);
|
||||
text._elsif[text.ifc] := lex.sym = lxELSIF;
|
||||
IF lex.sym = lxIF THEN
|
||||
INC(text.elsec);
|
||||
text._else[text.elsec] := FALSE
|
||||
END;
|
||||
_if := TRUE;
|
||||
skip := TRUE;
|
||||
text.skip := FALSE;
|
||||
|
||||
Next(text, lex);
|
||||
check(lex.sym = lxLROUND, text, lex, 64);
|
||||
|
||||
Next(text, lex);
|
||||
check(lex.sym = lxIDENT, text, lex, 22);
|
||||
|
||||
REPEAT
|
||||
IF IsDef(lex.ident.s) THEN
|
||||
skip := FALSE
|
||||
END;
|
||||
|
||||
Next(text, lex);
|
||||
IF lex.sym = lxBAR THEN
|
||||
Next(text, lex);
|
||||
check(lex.sym = lxIDENT, text, lex, 22)
|
||||
ELSE
|
||||
check(lex.sym = lxRROUND, text, lex, 33)
|
||||
END
|
||||
UNTIL lex.sym = lxRROUND;
|
||||
|
||||
_if := FALSE;
|
||||
text._skip[text.ifc] := skip;
|
||||
Skip(text);
|
||||
Next(text, lex)
|
||||
END prep_if;
|
||||
|
||||
|
||||
PROCEDURE prep_end (text: SCANNER; VAR lex: LEX);
|
||||
BEGIN
|
||||
check(text.ifc > 0, text, lex, 118);
|
||||
IF lex.sym = lxEND THEN
|
||||
WHILE text._elsif[text.ifc] DO
|
||||
DEC(text.ifc)
|
||||
END;
|
||||
DEC(text.ifc);
|
||||
DEC(text.elsec)
|
||||
ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
|
||||
check(~text._else[text.elsec], text, lex, 118);
|
||||
text._skip[text.ifc] := ~text._skip[text.ifc];
|
||||
text._else[text.elsec] := lex.sym = lxELSE
|
||||
END;
|
||||
Skip(text);
|
||||
IF lex.sym = lxELSIF THEN
|
||||
prep_if(text, lex)
|
||||
ELSE
|
||||
Next(text, lex)
|
||||
END
|
||||
END prep_end;
|
||||
|
||||
|
||||
BEGIN
|
||||
|
||||
REPEAT
|
||||
c := text.peak;
|
||||
|
||||
WHILE S.space(c) DO
|
||||
c := nextc(text)
|
||||
END;
|
||||
|
||||
lex.pos.line := text.line;
|
||||
lex.pos.col := text.col;
|
||||
|
||||
IF S.letter(c) THEN
|
||||
ident(text, lex)
|
||||
ELSIF S.digit(c) THEN
|
||||
number(text, lex)
|
||||
ELSIF (c = '"') OR (c = "'") THEN
|
||||
string(text, lex, c)
|
||||
ELSIF delimiters[ORD(c)] THEN
|
||||
lex.sym := delimiter(text, c)
|
||||
ELSIF c = "$" THEN
|
||||
IF S.letter(nextc(text)) THEN
|
||||
ident(text, lex);
|
||||
IF lex.sym = lxIF THEN
|
||||
IF ~_if THEN
|
||||
prep_if(text, lex)
|
||||
END
|
||||
ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
|
||||
IF ~_if THEN
|
||||
prep_end(text, lex)
|
||||
END
|
||||
ELSE
|
||||
check(FALSE, text, lex, 119)
|
||||
END
|
||||
ELSE
|
||||
check(FALSE, text, lex, 119)
|
||||
END
|
||||
ELSIF c = 0X THEN
|
||||
lex.sym := lxEOF;
|
||||
text.skip := FALSE;
|
||||
IF text.eof THEN
|
||||
INC(lex.pos.col)
|
||||
END
|
||||
ELSIF (c = 7FX) & upto THEN
|
||||
upto := FALSE;
|
||||
lex.sym := lxRANGE;
|
||||
DEC(lex.pos.col);
|
||||
TXT.next(text)
|
||||
ELSE
|
||||
TXT.next(text);
|
||||
lex.sym := lxERROR04
|
||||
END;
|
||||
|
||||
IF lex.sym < 0 THEN
|
||||
lex.error := -lex.sym
|
||||
ELSE
|
||||
lex.error := 0
|
||||
END
|
||||
|
||||
UNTIL (lex.sym # lxCOMMENT) & ~text.skip
|
||||
|
||||
END Next;
|
||||
|
||||
|
||||
PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
|
||||
RETURN TXT.open(name)
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE close* (VAR scanner: SCANNER);
|
||||
BEGIN
|
||||
TXT.close(scanner)
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE init* (lower: BOOLEAN);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
delim: ARRAY 23 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
upto := FALSE;
|
||||
LowerCase := lower;
|
||||
|
||||
FOR i := 0 TO 255 DO
|
||||
delimiters[i] := FALSE
|
||||
END;
|
||||
|
||||
delim := "+-*/~&.,;|([{^=#<>:)]}";
|
||||
|
||||
FOR i := 0 TO LEN(delim) - 2 DO
|
||||
delimiters[ORD(delim[i])] := TRUE
|
||||
END;
|
||||
|
||||
enterKW("array", 0);
|
||||
enterKW("begin", 1);
|
||||
enterKW("by", 2);
|
||||
enterKW("case", 3);
|
||||
enterKW("const", 4);
|
||||
enterKW("div", 5);
|
||||
enterKW("do", 6);
|
||||
enterKW("else", 7);
|
||||
enterKW("elsif", 8);
|
||||
enterKW("end", 9);
|
||||
enterKW("false", 10);
|
||||
enterKW("for", 11);
|
||||
enterKW("if", 12);
|
||||
enterKW("import", 13);
|
||||
enterKW("in", 14);
|
||||
enterKW("is", 15);
|
||||
enterKW("mod", 16);
|
||||
enterKW("module", 17);
|
||||
enterKW("nil", 18);
|
||||
enterKW("of", 19);
|
||||
enterKW("or", 20);
|
||||
enterKW("pointer", 21);
|
||||
enterKW("procedure", 22);
|
||||
enterKW("record", 23);
|
||||
enterKW("repeat", 24);
|
||||
enterKW("return", 25);
|
||||
enterKW("then", 26);
|
||||
enterKW("to", 27);
|
||||
enterKW("true", 28);
|
||||
enterKW("type", 29);
|
||||
enterKW("until", 30);
|
||||
enterKW("var", 31);
|
||||
enterKW("while", 32)
|
||||
END init;
|
||||
|
||||
|
||||
PROCEDURE NewDef* (str: ARRAY OF CHAR);
|
||||
VAR
|
||||
item: DEF;
|
||||
|
||||
BEGIN
|
||||
NEW(item);
|
||||
COPY(str, item.ident);
|
||||
LISTS.push(def, item)
|
||||
END NewDef;
|
||||
|
||||
|
||||
BEGIN
|
||||
def := LISTS.create(NIL);
|
||||
strings := LISTS.create(NIL)
|
||||
END SCAN.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,342 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE STRINGS;
|
||||
|
||||
IMPORT UTILS;
|
||||
|
||||
|
||||
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
|
||||
BEGIN
|
||||
WHILE count > 0 DO
|
||||
dst[dpos] := src[spos];
|
||||
INC(spos);
|
||||
INC(dpos);
|
||||
DEC(count)
|
||||
END
|
||||
END copy;
|
||||
|
||||
|
||||
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));
|
||||
|
||||
copy(s2, s1, 0, n1, n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF x = UTILS.minint THEN
|
||||
IF UTILS.bit_depth = 32 THEN
|
||||
COPY("-2147483648", str)
|
||||
ELSIF UTILS.bit_depth = 64 THEN
|
||||
COPY("-9223372036854775808", str)
|
||||
END
|
||||
|
||||
ELSE
|
||||
i := 0;
|
||||
IF x < 0 THEN
|
||||
x := -x;
|
||||
i := 1;
|
||||
str[0] := "-"
|
||||
END;
|
||||
|
||||
a := x;
|
||||
REPEAT
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
|
||||
VAR
|
||||
length: INTEGER;
|
||||
|
||||
BEGIN
|
||||
length := LENGTH(s);
|
||||
|
||||
IF (0 <= pos) & (pos < length) THEN
|
||||
IF forward THEN
|
||||
WHILE (pos < length) & (s[pos] # c) DO
|
||||
INC(pos)
|
||||
END;
|
||||
IF pos = length THEN
|
||||
pos := -1
|
||||
END
|
||||
ELSE
|
||||
WHILE (pos >= 0) & (s[pos] # c) DO
|
||||
DEC(pos)
|
||||
END
|
||||
END
|
||||
ELSE
|
||||
pos := -1
|
||||
END
|
||||
END search;
|
||||
|
||||
|
||||
PROCEDURE replace* (VAR s: ARRAY OF CHAR; find, repl: CHAR);
|
||||
VAR
|
||||
i, strlen: INTEGER;
|
||||
|
||||
BEGIN
|
||||
strlen := LENGTH(s) - 1;
|
||||
FOR i := 0 TO strlen DO
|
||||
IF s[i] = find THEN
|
||||
s[i] := repl
|
||||
END
|
||||
END
|
||||
END replace;
|
||||
|
||||
|
||||
PROCEDURE trim* (source: ARRAY OF CHAR; VAR result: ARRAY OF CHAR);
|
||||
VAR
|
||||
LenS, start, _end, i, j: INTEGER;
|
||||
|
||||
BEGIN
|
||||
LenS := LENGTH(source) - 1;
|
||||
j := 0;
|
||||
IF LenS >= 0 THEN
|
||||
start := 0;
|
||||
WHILE (start <= LenS) & (source[start] <= 20X) DO
|
||||
INC(start)
|
||||
END;
|
||||
|
||||
_end := LenS;
|
||||
WHILE (_end >= 0) & (source[_end] <= 20X) DO
|
||||
DEC(_end)
|
||||
END;
|
||||
|
||||
FOR i := start TO _end DO
|
||||
result[j] := source[i];
|
||||
INC(j)
|
||||
END
|
||||
END;
|
||||
result[j] := 0X
|
||||
END trim;
|
||||
|
||||
|
||||
PROCEDURE letter* (c: CHAR): BOOLEAN;
|
||||
RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") OR (c = "_")
|
||||
END letter;
|
||||
|
||||
|
||||
PROCEDURE digit* (c: CHAR): BOOLEAN;
|
||||
RETURN ("0" <= c) & (c <= "9")
|
||||
END digit;
|
||||
|
||||
|
||||
PROCEDURE hexdigit* (c: CHAR): BOOLEAN;
|
||||
RETURN ("0" <= c) & (c <= "9") OR ("A" <= c) & (c <= "F")
|
||||
END hexdigit;
|
||||
|
||||
|
||||
PROCEDURE space* (c: CHAR): BOOLEAN;
|
||||
RETURN (0X < c) & (c <= 20X)
|
||||
END space;
|
||||
|
||||
|
||||
PROCEDURE cap* (VAR c: CHAR);
|
||||
BEGIN
|
||||
IF ("a" <= c) & (c <= "z") THEN
|
||||
c := CHR(ORD(c) - 32)
|
||||
END
|
||||
END cap;
|
||||
|
||||
|
||||
PROCEDURE UpCase* (VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := LENGTH(str) - 1;
|
||||
WHILE i >= 0 DO
|
||||
cap(str[i]);
|
||||
DEC(i)
|
||||
END
|
||||
END UpCase;
|
||||
|
||||
|
||||
PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
i, k: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := TRUE;
|
||||
i := 0;
|
||||
x := 0;
|
||||
k := LENGTH(str);
|
||||
WHILE i < k DO
|
||||
IF digit(str[i]) THEN
|
||||
x := x * 10 + ORD(str[i]) - ORD("0")
|
||||
ELSE
|
||||
i := k;
|
||||
res := FALSE
|
||||
END;
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END StrToInt;
|
||||
|
||||
|
||||
PROCEDURE CheckVer (str: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
i, k: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
k := LENGTH(str);
|
||||
res := k < LEN(str);
|
||||
|
||||
IF res & digit(str[0]) THEN
|
||||
i := 0;
|
||||
WHILE (i < k) & digit(str[i]) DO
|
||||
INC(i)
|
||||
END;
|
||||
IF (i < k) & (str[i] = ".") THEN
|
||||
INC(i);
|
||||
IF i < k THEN
|
||||
WHILE (i < k) & digit(str[i]) DO
|
||||
INC(i)
|
||||
END
|
||||
ELSE
|
||||
res := FALSE
|
||||
END
|
||||
ELSE
|
||||
res := FALSE
|
||||
END;
|
||||
|
||||
res := res & (i = k)
|
||||
ELSE
|
||||
res := FALSE
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END CheckVer;
|
||||
|
||||
|
||||
PROCEDURE StrToVer* (str: ARRAY OF CHAR; VAR major, minor: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := CheckVer(str);
|
||||
|
||||
IF res THEN
|
||||
i := 0;
|
||||
minor := 0;
|
||||
major := 0;
|
||||
WHILE digit(str[i]) DO
|
||||
major := major * 10 + ORD(str[i]) - ORD("0");
|
||||
INC(i)
|
||||
END;
|
||||
INC(i);
|
||||
WHILE digit(str[i]) DO
|
||||
minor := minor * 10 + ORD(str[i]) - ORD("0");
|
||||
INC(i)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END StrToVer;
|
||||
|
||||
|
||||
PROCEDURE Utf8To16* (src: ARRAY OF CHAR; VAR dst: ARRAY OF WCHAR): INTEGER;
|
||||
VAR
|
||||
i, j, u, srclen, dstlen: INTEGER;
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
srclen := LEN(src);
|
||||
dstlen := LEN(dst);
|
||||
i := 0;
|
||||
j := 0;
|
||||
WHILE (i < srclen) & (j < dstlen) & (src[i] # 0X) DO
|
||||
c := src[i];
|
||||
CASE c OF
|
||||
|00X..7FX:
|
||||
u := ORD(c)
|
||||
|
||||
|0C1X..0DFX:
|
||||
u := (ORD(c) - 0C0H) * 64;
|
||||
IF i + 1 < srclen THEN
|
||||
INC(i);
|
||||
INC(u, ORD(src[i]) MOD 64)
|
||||
END
|
||||
|
||||
|0E1X..0EFX:
|
||||
u := (ORD(c) - 0E0H) * 4096;
|
||||
IF i + 1 < srclen THEN
|
||||
INC(i);
|
||||
INC(u, (ORD(src[i]) MOD 64) * 64)
|
||||
END;
|
||||
IF i + 1 < srclen THEN
|
||||
INC(i);
|
||||
INC(u, ORD(src[i]) MOD 64)
|
||||
END
|
||||
(*
|
||||
|0F1X..0F7X:
|
||||
|0F9X..0FBX:
|
||||
|0FDX:
|
||||
*)
|
||||
ELSE
|
||||
END;
|
||||
INC(i);
|
||||
dst[j] := WCHR(u);
|
||||
INC(j)
|
||||
END;
|
||||
IF j < dstlen THEN
|
||||
dst[j] := WCHR(0)
|
||||
END
|
||||
|
||||
RETURN j
|
||||
END Utf8To16;
|
||||
|
||||
|
||||
PROCEDURE HashStr* (name: ARRAY OF CHAR): INTEGER;
|
||||
VAR
|
||||
i, h: INTEGER;
|
||||
g: SET;
|
||||
|
||||
BEGIN
|
||||
h := 0;
|
||||
i := 0;
|
||||
WHILE name[i] # 0X DO
|
||||
h := h * 16 + ORD(name[i]);
|
||||
g := BITS(h) * {28..31};
|
||||
h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g);
|
||||
INC(i)
|
||||
END
|
||||
|
||||
RETURN h
|
||||
END HashStr;
|
||||
|
||||
|
||||
END STRINGS.
|
||||
@@ -1,154 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2021, 2023, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE TARGETS;
|
||||
|
||||
IMPORT UTILS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
MSP430* = 0;
|
||||
Win32C* = 1;
|
||||
Win32GUI* = 2;
|
||||
Win32DLL* = 3;
|
||||
KolibriOS* = 4;
|
||||
KolibriOSDLL* = 5;
|
||||
Win64C* = 6;
|
||||
Win64GUI* = 7;
|
||||
Win64DLL* = 8;
|
||||
Linux32* = 9;
|
||||
Linux32SO* = 10;
|
||||
Linux64* = 11;
|
||||
Linux64SO* = 12;
|
||||
STM32CM3* = 13;
|
||||
RVM32I* = 14;
|
||||
RVM64I* = 15;
|
||||
|
||||
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
|
||||
cpuRVM32I* = 4; cpuRVM64I* = 5;
|
||||
|
||||
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
|
||||
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
|
||||
|
||||
noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I};
|
||||
|
||||
noRTL = {MSP430};
|
||||
|
||||
libRVM32I = "RVMxI" + UTILS.slash + "32";
|
||||
libRVM64I = "RVMxI" + UTILS.slash + "64";
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
STRING = ARRAY 32 OF CHAR;
|
||||
|
||||
TARGET = RECORD
|
||||
|
||||
target, CPU, OS, RealSize: INTEGER;
|
||||
ComLinePar*, LibDir, FileExt: STRING
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
Targets*: ARRAY 16 OF TARGET;
|
||||
|
||||
CPUs: ARRAY 6 OF
|
||||
RECORD
|
||||
BitDepth, InstrSize: INTEGER;
|
||||
LittleEndian: BOOLEAN
|
||||
END;
|
||||
|
||||
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER;
|
||||
ComLinePar*, LibDir*, FileExt*: STRING;
|
||||
Import*, Dispose*, RTL*, Dll*, LittleEndian*, WinLin*: BOOLEAN;
|
||||
|
||||
|
||||
PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING);
|
||||
BEGIN
|
||||
Targets[idx].target := idx;
|
||||
Targets[idx].CPU := CPU;
|
||||
Targets[idx].RealSize := RealSize;
|
||||
Targets[idx].OS := OS;
|
||||
Targets[idx].ComLinePar := ComLinePar;
|
||||
Targets[idx].LibDir := LibDir;
|
||||
Targets[idx].FileExt := FileExt;
|
||||
END Enter;
|
||||
|
||||
|
||||
PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO
|
||||
INC(i)
|
||||
END;
|
||||
|
||||
res := i < LEN(Targets);
|
||||
IF res THEN
|
||||
target := Targets[i].target;
|
||||
CPU := Targets[i].CPU;
|
||||
BitDepth := CPUs[CPU].BitDepth;
|
||||
InstrSize := CPUs[CPU].InstrSize;
|
||||
LittleEndian := CPUs[CPU].LittleEndian;
|
||||
RealSize := Targets[i].RealSize;
|
||||
OS := Targets[i].OS;
|
||||
ComLinePar := Targets[i].ComLinePar;
|
||||
LibDir := Targets[i].LibDir;
|
||||
FileExt := Targets[i].FileExt;
|
||||
|
||||
Import := OS IN {osWIN32, osWIN64, osKOS};
|
||||
Dispose := ~(target IN noDISPOSE);
|
||||
RTL := ~(target IN noRTL);
|
||||
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
|
||||
WinLin := OS IN {osWIN32, osLINUX32, osWIN64, osLINUX64};
|
||||
WordSize := BitDepth DIV 8;
|
||||
AdrSize := WordSize
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END Select;
|
||||
|
||||
|
||||
PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN);
|
||||
BEGIN
|
||||
CPUs[cpu].BitDepth := BitDepth;
|
||||
CPUs[cpu].InstrSize := InstrSize;
|
||||
CPUs[cpu].LittleEndian := LittleEndian
|
||||
END EnterCPU;
|
||||
|
||||
|
||||
BEGIN
|
||||
EnterCPU(cpuX86, 32, 1, TRUE);
|
||||
EnterCPU(cpuAMD64, 64, 1, TRUE);
|
||||
EnterCPU(cpuMSP430, 16, 2, TRUE);
|
||||
EnterCPU(cpuTHUMB, 32, 2, TRUE);
|
||||
EnterCPU(cpuRVM32I, 32, 4, TRUE);
|
||||
EnterCPU(cpuRVM64I, 64, 8, TRUE);
|
||||
|
||||
Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex");
|
||||
Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows", ".exe");
|
||||
Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows", ".exe");
|
||||
Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows", ".dll");
|
||||
Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", "");
|
||||
Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj");
|
||||
Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows", ".exe");
|
||||
Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows", ".exe");
|
||||
Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows", ".dll");
|
||||
Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux", "");
|
||||
Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux", ".so");
|
||||
Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux", "");
|
||||
Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux", ".so");
|
||||
Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
|
||||
Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", libRVM32I, ".bin");
|
||||
Enter( RVM64I, cpuRVM64I, 8, osNONE, "rvm64i", libRVM64I, ".bin");
|
||||
END TARGETS.
|
||||
@@ -1,210 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE TEXTDRV;
|
||||
|
||||
IMPORT FILES, C := COLLECTIONS;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
CR = 0DX; LF = 0AX; HT = 9X;
|
||||
|
||||
CHUNK = 1024 * 256;
|
||||
|
||||
defTabSize* = 4;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
TEXT* = POINTER TO RECORD (C.ITEM)
|
||||
|
||||
chunk: ARRAY CHUNK OF CHAR;
|
||||
pos, size: INTEGER;
|
||||
file: FILES.FILE;
|
||||
utf8: BOOLEAN;
|
||||
CR: BOOLEAN;
|
||||
|
||||
line*, col*: INTEGER;
|
||||
ifc*: INTEGER;
|
||||
elsec*: INTEGER;
|
||||
eof*: BOOLEAN;
|
||||
eol*: BOOLEAN;
|
||||
skip*: BOOLEAN;
|
||||
peak*: CHAR;
|
||||
_skip*,
|
||||
_elsif*,
|
||||
_else*: ARRAY 100 OF BOOLEAN;
|
||||
fname*: ARRAY 2048 OF CHAR
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
texts: C.COLLECTION;
|
||||
TabSize: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE load (text: TEXT);
|
||||
BEGIN
|
||||
IF ~text.eof THEN
|
||||
text.size := FILES.read(text.file, text.chunk, LEN(text.chunk));
|
||||
text.pos := 0;
|
||||
IF text.size = 0 THEN
|
||||
text.eof := TRUE;
|
||||
text.chunk[0] := 0X
|
||||
END;
|
||||
text.peak := text.chunk[0]
|
||||
END
|
||||
END load;
|
||||
|
||||
|
||||
PROCEDURE next* (text: TEXT);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
IF text.pos < text.size - 1 THEN
|
||||
INC(text.pos);
|
||||
text.peak := text.chunk[text.pos]
|
||||
ELSE
|
||||
load(text)
|
||||
END;
|
||||
|
||||
IF ~text.eof THEN
|
||||
|
||||
c := text.peak;
|
||||
|
||||
IF c = CR THEN
|
||||
INC(text.line);
|
||||
text.col := 0;
|
||||
text.eol := TRUE;
|
||||
text.CR := TRUE
|
||||
ELSIF c = LF THEN
|
||||
IF ~text.CR THEN
|
||||
INC(text.line);
|
||||
text.col := 0;
|
||||
text.eol := TRUE
|
||||
ELSE
|
||||
text.eol := FALSE
|
||||
END;
|
||||
text.CR := FALSE
|
||||
ELSIF c = HT THEN
|
||||
text.col := text.col + TabSize - text.col MOD TabSize;
|
||||
text.eol := FALSE;
|
||||
text.CR := FALSE
|
||||
ELSE
|
||||
IF text.utf8 THEN
|
||||
IF ORD(c) DIV 64 # 2 THEN
|
||||
INC(text.col)
|
||||
END
|
||||
ELSE
|
||||
INC(text.col)
|
||||
END;
|
||||
text.eol := FALSE;
|
||||
text.CR := FALSE
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
END next;
|
||||
|
||||
|
||||
PROCEDURE init (text: TEXT);
|
||||
BEGIN
|
||||
IF (text.pos = 0) & (text.size >= 3) THEN
|
||||
IF (text.chunk[0] = 0EFX) &
|
||||
(text.chunk[1] = 0BBX) &
|
||||
(text.chunk[2] = 0BFX) THEN
|
||||
text.pos := 3;
|
||||
text.utf8 := TRUE
|
||||
END
|
||||
END;
|
||||
|
||||
IF text.size = 0 THEN
|
||||
text.chunk[0] := 0X;
|
||||
text.size := 1;
|
||||
text.eof := FALSE
|
||||
END;
|
||||
|
||||
text.line := 1;
|
||||
text.col := 1;
|
||||
|
||||
text.peak := text.chunk[text.pos]
|
||||
END init;
|
||||
|
||||
|
||||
PROCEDURE close* (VAR text: TEXT);
|
||||
BEGIN
|
||||
IF text # NIL THEN
|
||||
IF text.file # NIL THEN
|
||||
FILES.close(text.file)
|
||||
END;
|
||||
|
||||
C.push(texts, text);
|
||||
text := NIL
|
||||
END
|
||||
END close;
|
||||
|
||||
|
||||
PROCEDURE open* (name: ARRAY OF CHAR): TEXT;
|
||||
VAR
|
||||
text: TEXT;
|
||||
citem: C.ITEM;
|
||||
|
||||
BEGIN
|
||||
citem := C.pop(texts);
|
||||
IF citem = NIL THEN
|
||||
NEW(text)
|
||||
ELSE
|
||||
text := citem(TEXT)
|
||||
END;
|
||||
|
||||
IF text # NIL THEN
|
||||
text.chunk[0] := 0X;
|
||||
text.pos := 0;
|
||||
text.size := 0;
|
||||
text.utf8 := FALSE;
|
||||
text.CR := FALSE;
|
||||
text.line := 1;
|
||||
text.col := 1;
|
||||
text.eof := FALSE;
|
||||
text.eol := FALSE;
|
||||
text.skip := FALSE;
|
||||
text.ifc := 0;
|
||||
text.elsec := 0;
|
||||
text._skip[0] := FALSE;
|
||||
text.peak := 0X;
|
||||
text.file := FILES.open(name);
|
||||
COPY(name, text.fname);
|
||||
IF text.file # NIL THEN
|
||||
load(text);
|
||||
init(text)
|
||||
ELSE
|
||||
close(text)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN text
|
||||
END open;
|
||||
|
||||
|
||||
PROCEDURE setTabSize* (n: INTEGER);
|
||||
BEGIN
|
||||
IF (0 < n) & (n <= 64) THEN
|
||||
TabSize := n
|
||||
ELSE
|
||||
TabSize := defTabSize
|
||||
END
|
||||
END setTabSize;
|
||||
|
||||
|
||||
BEGIN
|
||||
TabSize := defTabSize;
|
||||
texts := C.create()
|
||||
END TEXTDRV.
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,217 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2023, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE UTILS;
|
||||
|
||||
IMPORT HOST;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
slash* = HOST.slash;
|
||||
eol* = HOST.eol;
|
||||
|
||||
bit_depth* = HOST.bit_depth;
|
||||
maxint* = HOST.maxint;
|
||||
minint* = HOST.minint;
|
||||
|
||||
min32* = -2147483647-1;
|
||||
max32* = 2147483647;
|
||||
|
||||
vMajor* = 1;
|
||||
vMinor* = 64;
|
||||
Date* = "22-jan-2023";
|
||||
|
||||
FILE_EXT* = ".ob07";
|
||||
RTL_NAME* = "RTL";
|
||||
|
||||
MAX_GLOBAL_SIZE* = 1600000000;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
time*: INTEGER;
|
||||
|
||||
maxreal*, inf*: REAL;
|
||||
|
||||
target*:
|
||||
|
||||
RECORD
|
||||
|
||||
bit_depth*,
|
||||
maxInt*,
|
||||
minInt*,
|
||||
maxSet*,
|
||||
maxHex*: INTEGER;
|
||||
|
||||
maxReal*: REAL
|
||||
|
||||
END;
|
||||
|
||||
bit_diff*: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
|
||||
RETURN HOST.FileRead(F, Buffer, bytes)
|
||||
END FileRead;
|
||||
|
||||
|
||||
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
|
||||
RETURN HOST.FileWrite(F, Buffer, bytes)
|
||||
END FileWrite;
|
||||
|
||||
|
||||
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
|
||||
RETURN HOST.FileCreate(FName)
|
||||
END FileCreate;
|
||||
|
||||
|
||||
PROCEDURE FileClose* (F: INTEGER);
|
||||
BEGIN
|
||||
HOST.FileClose(F)
|
||||
END FileClose;
|
||||
|
||||
|
||||
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
|
||||
RETURN HOST.FileOpen(FName)
|
||||
END FileOpen;
|
||||
|
||||
|
||||
PROCEDURE chmod* (FName: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
HOST.chmod(FName)
|
||||
END chmod;
|
||||
|
||||
|
||||
PROCEDURE GetArg* (i: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
HOST.GetArg(i, str)
|
||||
END GetArg;
|
||||
|
||||
|
||||
PROCEDURE Exit* (code: INTEGER);
|
||||
BEGIN
|
||||
HOST.ExitProcess(code)
|
||||
END Exit;
|
||||
|
||||
|
||||
PROCEDURE GetTickCount* (): INTEGER;
|
||||
RETURN HOST.GetTickCount()
|
||||
END GetTickCount;
|
||||
|
||||
|
||||
PROCEDURE OutChar* (c: CHAR);
|
||||
BEGIN
|
||||
HOST.OutChar(c)
|
||||
END OutChar;
|
||||
|
||||
|
||||
PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
|
||||
RETURN HOST.splitf(x, a, b)
|
||||
END splitf;
|
||||
|
||||
|
||||
PROCEDURE d2s* (x: REAL): INTEGER;
|
||||
RETURN HOST.d2s(x)
|
||||
END d2s;
|
||||
|
||||
|
||||
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
|
||||
RETURN HOST.isRelative(path)
|
||||
END isRelative;
|
||||
|
||||
|
||||
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
HOST.GetCurrentDirectory(path)
|
||||
END GetCurrentDirectory;
|
||||
|
||||
|
||||
PROCEDURE UnixTime* (): INTEGER;
|
||||
RETURN HOST.UnixTime()
|
||||
END UnixTime;
|
||||
|
||||
|
||||
PROCEDURE SetBitDepth* (BitDepth: INTEGER; Double: BOOLEAN);
|
||||
BEGIN
|
||||
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64));
|
||||
bit_diff := bit_depth - BitDepth;
|
||||
ASSERT(bit_diff >= 0);
|
||||
|
||||
target.bit_depth := BitDepth;
|
||||
target.maxSet := BitDepth - 1;
|
||||
target.maxHex := BitDepth DIV 4;
|
||||
target.minInt := ASR(minint, bit_diff);
|
||||
target.maxInt := ASR(maxint, bit_diff);
|
||||
|
||||
IF Double THEN
|
||||
target.maxReal := maxreal
|
||||
ELSE
|
||||
target.maxReal := 1.9;
|
||||
PACK(target.maxReal, 127)
|
||||
END
|
||||
END SetBitDepth;
|
||||
|
||||
|
||||
PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE;
|
||||
RETURN ASR(n, 8 * idx) MOD 256
|
||||
END Byte;
|
||||
|
||||
|
||||
PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN;
|
||||
BEGIN
|
||||
INC(bytes, (-bytes) MOD align)
|
||||
RETURN bytes >= 0
|
||||
END Align;
|
||||
|
||||
|
||||
PROCEDURE Long* (value: INTEGER): INTEGER;
|
||||
RETURN ASR(LSL(value, bit_diff), bit_diff)
|
||||
END Long;
|
||||
|
||||
|
||||
PROCEDURE Short* (value: INTEGER): INTEGER;
|
||||
RETURN LSR(LSL(value, bit_diff), bit_diff)
|
||||
END Short;
|
||||
|
||||
|
||||
PROCEDURE Log2* (x: INTEGER): INTEGER;
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n := 0;
|
||||
WHILE ~ODD(x) DO
|
||||
x := x DIV 2;
|
||||
INC(n)
|
||||
END;
|
||||
|
||||
IF x # 1 THEN
|
||||
n := -1
|
||||
END
|
||||
|
||||
RETURN n
|
||||
END Log2;
|
||||
|
||||
|
||||
PROCEDURE hexdgt* (n: BYTE): BYTE;
|
||||
BEGIN
|
||||
IF n < 10 THEN
|
||||
INC(n, ORD("0"))
|
||||
ELSE
|
||||
INC(n, ORD("A") - 10)
|
||||
END
|
||||
|
||||
RETURN n
|
||||
END hexdgt;
|
||||
|
||||
|
||||
BEGIN
|
||||
time := HOST.GetTickCount();
|
||||
inf := HOST.inf;
|
||||
maxreal := HOST.maxreal
|
||||
END UTILS.
|
||||
@@ -1,104 +0,0 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2018-2021, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE WRITER;
|
||||
|
||||
IMPORT FILES, ERRORS, UTILS;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
counter*: INTEGER;
|
||||
file: FILES.FILE;
|
||||
|
||||
|
||||
PROCEDURE align* (n, _align: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
ASSERT(UTILS.Align(n, _align))
|
||||
RETURN n
|
||||
END align;
|
||||
|
||||
|
||||
PROCEDURE WriteByte* (n: BYTE);
|
||||
BEGIN
|
||||
IF FILES.WriteByte(file, n) THEN
|
||||
INC(counter)
|
||||
ELSE
|
||||
ERRORS.Error(201)
|
||||
END
|
||||
END WriteByte;
|
||||
|
||||
|
||||
PROCEDURE Write* (chunk: ARRAY OF BYTE; bytes: INTEGER);
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n := FILES.write(file, chunk, bytes);
|
||||
IF n # bytes THEN
|
||||
ERRORS.Error(201)
|
||||
END;
|
||||
INC(counter, n)
|
||||
END Write;
|
||||
|
||||
|
||||
PROCEDURE Write64LE* (n: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 7 DO
|
||||
WriteByte(UTILS.Byte(n, i))
|
||||
END
|
||||
END Write64LE;
|
||||
|
||||
|
||||
PROCEDURE Write32LE* (n: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
FOR i := 0 TO 3 DO
|
||||
WriteByte(UTILS.Byte(n, i))
|
||||
END
|
||||
END Write32LE;
|
||||
|
||||
|
||||
PROCEDURE Write16LE* (n: INTEGER);
|
||||
BEGIN
|
||||
WriteByte(UTILS.Byte(n, 0));
|
||||
WriteByte(UTILS.Byte(n, 1))
|
||||
END Write16LE;
|
||||
|
||||
|
||||
PROCEDURE Padding* (FileAlignment: INTEGER);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := align(counter, FileAlignment) - counter;
|
||||
WHILE i > 0 DO
|
||||
WriteByte(0);
|
||||
DEC(i)
|
||||
END
|
||||
END Padding;
|
||||
|
||||
|
||||
PROCEDURE Create* (FileName: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
counter := 0;
|
||||
file := FILES.create(FileName)
|
||||
END Create;
|
||||
|
||||
|
||||
PROCEDURE Close*;
|
||||
BEGIN
|
||||
FILES.close(file)
|
||||
END Close;
|
||||
|
||||
|
||||
END WRITER.
|
||||
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user