forked from KolibriOS/kolibrios
oberon07: Source code removed
Signed-off-by: Max Logaev <maxlogaev@proton.me>
This commit is contained in:
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
Reference in New Issue
Block a user