/programs/develop/oberon07/Compiler |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programs/develop/oberon07/Compiler.exe |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
Property changes: |
Added: svn:mime-type |
+application/octet-stream |
\ No newline at end of property |
/programs/develop/oberon07/Compiler.kex |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |
/programs/develop/oberon07/Docs/About866.txt |
---|
File deleted |
\ No newline at end of file |
/programs/develop/oberon07/Docs/About1251.txt |
---|
File deleted |
\ No newline at end of file |
/programs/develop/oberon07/Docs/KOSLib1251.txt |
---|
File deleted |
\ No newline at end of file |
/programs/develop/oberon07/Docs/KOSLib866.txt |
---|
File deleted |
\ No newline at end of file |
/programs/develop/oberon07/Docs/KOSLib.txt |
---|
0,0 → 1,566 |
============================================================================== |
Библиотека (KolibriOS) |
------------------------------------------------------------------------------ |
MODULE Out - консольный вывод |
PROCEDURE Open |
формально открывает консольный вывод |
PROCEDURE Int(x, width: INTEGER) |
вывод целого числа x; |
width - количество знакомест, используемых для вывода |
PROCEDURE Real(x: REAL; width: INTEGER) |
вывод вещественного числа x в плавающем формате; |
width - количество знакомест, используемых для вывода |
PROCEDURE Char(x: CHAR) |
вывод символа x |
PROCEDURE FixReal(x: REAL; width, p: INTEGER) |
вывод вещественного числа x в фиксированном формате; |
width - количество знакомест, используемых для вывода; |
p - количество знаков после десятичной точки |
PROCEDURE Ln |
переход на следующую строку |
PROCEDURE String(s: ARRAY OF CHAR) |
вывод строки s |
------------------------------------------------------------------------------ |
MODULE In - консольный ввод |
VAR Done: BOOLEAN |
принимает значение TRUE в случае успешного выполнения |
операции ввода, иначе FALSE |
PROCEDURE Open |
формально открывает консольный ввод, |
также присваивает переменной Done значение TRUE |
PROCEDURE Int(VAR x: INTEGER) |
ввод числа типа INTEGER |
PROCEDURE Char(VAR x: CHAR) |
ввод символа |
PROCEDURE Real(VAR x: REAL) |
ввод числа типа REAL |
PROCEDURE String(VAR s: ARRAY OF CHAR) |
ввод строки |
PROCEDURE Ln |
ожидание нажатия ENTER |
------------------------------------------------------------------------------ |
MODULE Console - дополнительные процедуры консольного вывода |
CONST |
Следующие константы определяют цвет консольного вывода |
Black = 0 Blue = 1 Green = 2 |
Cyan = 3 Red = 4 Magenta = 5 |
Brown = 6 LightGray = 7 DarkGray = 8 |
LightBlue = 9 LightGreen = 10 LightCyan = 11 |
LightRed = 12 LightMagenta = 13 Yellow = 14 |
White = 15 |
PROCEDURE Cls |
очистка окна консоли |
PROCEDURE SetColor(FColor, BColor: INTEGER) |
установка цвета консольного вывода: FColor - цвет текста, |
BColor - цвет фона, возможные значения - вышеперечисленные |
константы |
PROCEDURE SetCursor(x, y: INTEGER) |
установка курсора консоли в позицию (x, y) |
PROCEDURE GetCursor(VAR x, y: INTEGER) |
записывает в параметры текущие координаты курсора консоли |
PROCEDURE GetCursorX(): INTEGER |
возвращает текущую x-координату курсора консоли |
PROCEDURE GetCursorY(): INTEGER |
возвращает текущую y-координату курсора консоли |
------------------------------------------------------------------------------ |
MODULE ConsoleLib - обертка библиотеки console.obj |
------------------------------------------------------------------------------ |
MODULE Math - математические функции |
CONST |
pi = 3.141592653589793E+00 |
e = 2.718281828459045E+00 |
PROCEDURE IsNan(x: REAL): BOOLEAN |
возвращает TRUE, если x - не число |
PROCEDURE IsInf(x: REAL): BOOLEAN |
возвращает TRUE, если x - бесконечность |
PROCEDURE sqrt(x: REAL): REAL |
квадратный корень x |
PROCEDURE exp(x: REAL): REAL |
экспонента x |
PROCEDURE ln(x: REAL): REAL |
натуральный логарифм x |
PROCEDURE sin(x: REAL): REAL |
синус x |
PROCEDURE cos(x: REAL): REAL |
косинус x |
PROCEDURE tan(x: REAL): REAL |
тангенс x |
PROCEDURE arcsin(x: REAL): REAL |
арксинус x |
PROCEDURE arccos(x: REAL): REAL |
арккосинус x |
PROCEDURE arctan(x: REAL): REAL |
арктангенс x |
PROCEDURE arctan2(y, x: REAL): REAL |
арктангенс y/x |
PROCEDURE power(base, exponent: REAL): REAL |
возведение числа base в степень exponent |
PROCEDURE log(base, x: REAL): REAL |
логарифм x по основанию base |
PROCEDURE sinh(x: REAL): REAL |
гиперболический синус x |
PROCEDURE cosh(x: REAL): REAL |
гиперболический косинус x |
PROCEDURE tanh(x: REAL): REAL |
гиперболический тангенс x |
PROCEDURE arsinh(x: REAL): REAL |
обратный гиперболический синус x |
PROCEDURE arcosh(x: REAL): REAL |
обратный гиперболический косинус x |
PROCEDURE artanh(x: REAL): REAL |
обратный гиперболический тангенс x |
PROCEDURE round(x: REAL): REAL |
округление x до ближайшего целого |
PROCEDURE frac(x: REAL): REAL; |
дробная часть числа x |
PROCEDURE floor(x: REAL): REAL |
наибольшее целое число (представление как REAL), |
не больше x: floor(1.2) = 1.0 |
PROCEDURE ceil(x: REAL): REAL |
наименьшее целое число (представление как REAL), |
не меньше x: ceil(1.2) = 2.0 |
PROCEDURE sgn(x: REAL): INTEGER |
если x > 0 возвращает 1 |
если x < 0 возвращает -1 |
если x = 0 возвращает 0 |
PROCEDURE fact(n: INTEGER): REAL |
факториал n |
------------------------------------------------------------------------------ |
MODULE Debug - вывод на доску отладки |
Интерфейс как модуль Out |
PROCEDURE Open |
открывает доску отладки |
------------------------------------------------------------------------------ |
MODULE File - работа с файловой системой |
TYPE |
FNAME = ARRAY 520 OF CHAR |
FS = POINTER TO rFS |
rFS = RECORD (* информационная структура файла *) |
subfunc, pos, hpos, bytes, buffer: INTEGER; |
name: FNAME |
END |
FD = POINTER TO rFD |
rFD = RECORD (* структура блока данных входа каталога *) |
attr: INTEGER; |
ntyp: CHAR; |
reserved: ARRAY 3 OF CHAR; |
time_create, date_create, |
time_access, date_access, |
time_modif, date_modif, |
size, hsize: INTEGER; |
name: FNAME |
END |
CONST |
SEEK_BEG = 0 |
SEEK_CUR = 1 |
SEEK_END = 2 |
PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; |
Загружает в память файл с именем FName, записывает в параметр |
size размер файла, возвращает адрес загруженного файла |
или 0 (ошибка). При необходимости, распаковывает |
файл (kunpack). |
PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN |
Записывает структуру блока данных входа каталога для файла |
или папки с именем FName в параметр Info. |
При ошибке возвращает FALSE. |
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN |
возвращает TRUE, если файл с именем FName существует |
PROCEDURE Close(VAR F: FS) |
освобождает память, выделенную для информационной структуры |
файла F и присваивает F значение NIL |
PROCEDURE Open(FName: ARRAY OF CHAR): FS |
возвращает указатель на информационную структуру файла с |
именем FName, при ошибке возвращает NIL |
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN |
удаляет файл с именем FName, при ошибке возвращает FALSE |
PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER |
устанавливает позицию чтения-записи файла F на Offset, |
относительно Origin = (SEEK_BEG - начало файла, |
SEEK_CUR - текущая позиция, SEEK_END - конец файла), |
возвращает позицию относительно начала файла, например: |
Seek(F, 0, SEEK_END) |
устанавливает позицию на конец файла и возвращает длину |
файла; при ошибке возвращает -1 |
PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER |
Читает данные из файла в память. F - указатель на |
информационную структуру файла, Buffer - адрес области |
памяти, Count - количество байт, которое требуется прочитать |
из файла; возвращает количество байт, которое было прочитано |
и соответствующим образом изменяет позицию чтения/записи в |
информационной структуре F. |
PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER |
Записывает данные из памяти в файл. F - указатель на |
информационную структуру файла, Buffer - адрес области |
памяти, Count - количество байт, которое требуется записать |
в файл; возвращает количество байт, которое было записано и |
соответствующим образом изменяет позицию чтения/записи в |
информационной структуре F. |
PROCEDURE Create(FName: ARRAY OF CHAR): FS |
создает новый файл с именем FName (полное имя), возвращает |
указатель на информационную структуру файла, |
при ошибке возвращает NIL |
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN |
создает папку с именем DirName, все промежуточные папки |
должны существовать, при ошибке возвращает FALSE |
PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN |
удаляет пустую папку с именем DirName, |
при ошибке возвращает FALSE |
PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN |
возвращает TRUE, если папка с именем DirName существует |
------------------------------------------------------------------------------ |
MODULE Read - чтение основных типов данных из файла F |
Процедуры возвращают TRUE в случае успешной операции чтения и |
соответствующим образом изменяют позицию чтения/записи в |
информационной структуре F |
PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN |
PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN |
PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN |
PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN |
PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN |
PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN |
------------------------------------------------------------------------------ |
MODULE Write - запись основных типов данных в файл F |
Процедуры возвращают TRUE в случае успешной операции записи и |
соответствующим образом изменяют позицию чтения/записи в |
информационной структуре F |
PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN |
PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN |
PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN |
PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN |
PROCEDURE Set(F: File.FS; x: SET): BOOLEAN |
PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN |
------------------------------------------------------------------------------ |
MODULE DateTime - дата, время |
CONST ERR = -7.0E5 |
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) |
записывает в параметры компоненты текущей системной даты и |
времени |
PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL |
возвращает дату, полученную из компонентов |
Year, Month, Day, Hour, Min, Sec; |
при ошибке возвращает константу ERR = -7.0E5 |
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
Hour, Min, Sec: INTEGER): BOOLEAN |
извлекает компоненты |
Year, Month, Day, Hour, Min, Sec из даты Date; |
при ошибке возвращает FALSE |
------------------------------------------------------------------------------ |
MODULE Args - параметры программы |
VAR argc: INTEGER |
количество параметров программы, включая имя |
исполняемого файла |
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) |
записывает в строку s n-й параметр программы, |
нумерация параметров от 0 до argc - 1, |
нулевой параметр -- имя исполняемого файла |
------------------------------------------------------------------------------ |
MODULE KOSAPI |
PROCEDURE sysfunc1(arg1: INTEGER): INTEGER |
PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER |
... |
PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER |
Обертки для функций API ядра KolibriOS. |
arg1 .. arg7 соответствуют регистрам |
eax, ebx, ecx, edx, esi, edi, ebp; |
возвращают значение регистра eax после системного вызова. |
PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER |
Обертка для функций API ядра KolibriOS. |
arg1 - регистр eax, arg2 - регистр ebx, |
res2 - значение регистра ebx после системного вызова; |
возвращает значение регистра eax после системного вызова. |
PROCEDURE malloc(size: INTEGER): INTEGER |
Выделяет блок памяти. |
size - размер блока в байтах, |
возвращает адрес выделенного блока |
PROCEDURE free(ptr: INTEGER): INTEGER |
Освобождает ранее выделенный блок памяти с адресом ptr, |
возвращает 0 |
PROCEDURE realloc(ptr, size: INTEGER): INTEGER |
Перераспределяет блок памяти, |
ptr - адрес ранее выделенного блока, |
size - новый размер, |
возвращает указатель на перераспределенный блок, |
0 при ошибке |
PROCEDURE GetCommandLine(): INTEGER |
Возвращает адрес строки параметров |
PROCEDURE GetName(): INTEGER |
Возвращает адрес строки с именем программы |
PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER |
Загружает DLL с полным именем name. Возвращает адрес таблицы |
экспорта. При ошибке возвращает 0. |
PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER |
name - имя процедуры |
lib - адрес таблицы экспорта DLL |
Возвращает адрес процедуры. При ошибке возвращает 0. |
------------------------------------------------------------------------------ |
MODULE ColorDlg - работа с диалогом "Color Dialog" |
TYPE |
Dialog = POINTER TO RECORD (* структура диалога *) |
status: INTEGER (* состояние диалога: |
0 - пользователь нажал Cancel |
1 - пользователь нажал OK |
2 - диалог открыт *) |
color: INTEGER (* выбранный цвет *) |
END |
PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog |
создать диалог |
draw_window - процедура перерисовки основного окна |
(TYPE DRAW_WINDOW = PROCEDURE); |
процедура возвращает указатель на структуру диалога |
PROCEDURE Show(cd: Dialog) |
показать диалог |
cd - указатель на структуру диалога, который был создан ранее |
процедурой Create |
PROCEDURE Destroy(VAR cd: Dialog) |
уничтожить диалог |
cd - указатель на структуру диалога |
------------------------------------------------------------------------------ |
MODULE OpenDlg - работа с диалогом "Open Dialog" |
TYPE |
Dialog = POINTER TO RECORD (* структура диалога *) |
status: INTEGER (* состояние диалога: |
0 - пользователь нажал Cancel |
1 - пользователь нажал OK |
2 - диалог открыт *) |
FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) |
FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного |
файла *) |
END |
PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, |
filter: ARRAY OF CHAR): Dialog |
создать диалог |
draw_window - процедура перерисовки основного окна |
(TYPE DRAW_WINDOW = PROCEDURE) |
type - тип диалога |
0 - открыть |
1 - сохранить |
2 - выбрать папку |
def_path - путь по умолчанию, папка def_path будет открыта |
при первом запуске диалога |
filter - в строке записано перечисление расширений файлов, |
которые будут показаны в диалоговом окне, расширения |
разделяются символом "|", например: "ASM|TXT|INI" |
процедура возвращает указатель на структуру диалога |
PROCEDURE Show(od: Dialog; Width, Height: INTEGER) |
показать диалог |
od - указатель на структуру диалога, который был создан ранее |
процедурой Create |
Width и Height - ширина и высота диалогового окна |
PROCEDURE Destroy(VAR od: Dialog) |
уничтожить диалог |
od - указатель на структуру диалога |
------------------------------------------------------------------------------ |
MODULE kfonts - работа с kf-шрифтами |
CONST |
bold = 1 |
italic = 2 |
underline = 4 |
strike_through = 8 |
smoothing = 16 |
bpp32 = 32 |
TYPE |
TFont = POINTER TO TFont_desc (* указатель на шрифт *) |
PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont |
загрузить шрифт из файла |
file_name имя kf-файла |
рез-т: указатель на шрифт/NIL (ошибка) |
PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN |
установить размер шрифта |
Font указатель на шрифт |
font_size размер шрифта |
рез-т: TRUE/FALSE (ошибка) |
PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN |
проверить, есть ли шрифт, заданного размера |
Font указатель на шрифт |
font_size размер шрифта |
рез-т: TRUE/FALSE (шрифта нет) |
PROCEDURE Destroy(VAR Font: TFont) |
выгрузить шрифт, освободить динамическую память |
Font указатель на шрифт |
Присваивает переменной Font значение NIL |
PROCEDURE TextHeight(Font: TFont): INTEGER |
получить высоту строки текста |
Font указатель на шрифт |
рез-т: высота строки текста в пикселях |
PROCEDURE TextWidth(Font: TFont; |
str, length, params: INTEGER): INTEGER |
получить ширину строки текста |
Font указатель на шрифт |
str адрес строки текста в кодировке Win-1251 |
length количество символов в строке или -1, если строка |
завершается нулем |
params параметры-флаги см. ниже |
рез-т: ширина строки текста в пикселях |
PROCEDURE TextOut(Font: TFont; |
canvas, x, y, str, length, color, params: INTEGER) |
вывести текст в буфер |
для вывода буфера в окно, использовать ф.65 или |
ф.7 (если буфер 24-битный) |
Font указатель на шрифт |
canvas адрес графического буфера |
структура буфера: |
Xsize dd |
Ysize dd |
picture rb Xsize * Ysize * 4 (32 бита) |
или Xsize * Ysize * 3 (24 бита) |
x, y координаты текста относительно левого верхнего |
угла буфера |
str адрес строки текста в кодировке Win-1251 |
length количество символов в строке или -1, если строка |
завершается нулем |
color цвет текста 0x00RRGGBB |
params параметры-флаги: |
1 жирный |
2 курсив |
4 подчеркнутый |
8 перечеркнутый |
16 применить сглаживание |
32 вывод в 32-битный буфер |
возможно использование флагов в любых сочетаниях |
------------------------------------------------------------------------------ |
MODULE RasterWorks - обертка библиотеки Rasterworks.obj |
------------------------------------------------------------------------------ |
MODULE libimg - обертка библиотеки libimg.obj |
------------------------------------------------------------------------------ |
/programs/develop/oberon07/Docs/WinLib.txt |
---|
0,0 → 1,312 |
============================================================================== |
Библиотека (Windows) |
------------------------------------------------------------------------------ |
MODULE Out - консольный вывод |
PROCEDURE Open |
открывает консольный вывод |
PROCEDURE Int(x, width: INTEGER) |
вывод целого числа x; |
width - количество знакомест, используемых для вывода |
PROCEDURE Real(x: REAL; width: INTEGER) |
вывод вещественного числа x в плавающем формате; |
width - количество знакомест, используемых для вывода |
PROCEDURE Char(x: CHAR) |
вывод символа x |
PROCEDURE FixReal(x: REAL; width, p: INTEGER) |
вывод вещественного числа x в фиксированном формате; |
width - количество знакомест, используемых для вывода; |
p - количество знаков после десятичной точки |
PROCEDURE Ln |
переход на следующую строку |
PROCEDURE String(s: ARRAY OF CHAR) |
вывод строки s (ASCII) |
PROCEDURE StringW(s: ARRAY OF WCHAR) |
вывод строки s (UTF-16) |
------------------------------------------------------------------------------ |
MODULE In - консольный ввод |
VAR Done: BOOLEAN |
принимает значение TRUE в случае успешного выполнения |
операции ввода и FALSE в противном случае |
PROCEDURE Open |
открывает консольный ввод, |
также присваивает переменной Done значение TRUE |
PROCEDURE Int(VAR x: INTEGER) |
ввод числа типа INTEGER |
PROCEDURE Char(VAR x: CHAR) |
ввод символа |
PROCEDURE Real(VAR x: REAL) |
ввод числа типа REAL |
PROCEDURE String(VAR s: ARRAY OF CHAR) |
ввод строки |
PROCEDURE Ln |
ожидание нажатия ENTER |
------------------------------------------------------------------------------ |
MODULE Console - дополнительные процедуры консольного вывода |
CONST |
Следующие константы определяют цвет консольного вывода |
Black = 0 Blue = 1 Green = 2 |
Cyan = 3 Red = 4 Magenta = 5 |
Brown = 6 LightGray = 7 DarkGray = 8 |
LightBlue = 9 LightGreen = 10 LightCyan = 11 |
LightRed = 12 LightMagenta = 13 Yellow = 14 |
White = 15 |
PROCEDURE Cls |
очистка окна консоли |
PROCEDURE SetColor(FColor, BColor: INTEGER) |
установка цвета консольного вывода: FColor - цвет текста, |
BColor - цвет фона, возможные значения - вышеперечисленные |
константы |
PROCEDURE SetCursor(x, y: INTEGER) |
установка курсора консоли в позицию (x, y) |
PROCEDURE GetCursor(VAR x, y: INTEGER) |
записывает в параметры текущие координаты курсора консоли |
PROCEDURE GetCursorX(): INTEGER |
возвращает текущую x-координату курсора консоли |
PROCEDURE GetCursorY(): INTEGER |
возвращает текущую y-координату курсора консоли |
------------------------------------------------------------------------------ |
MODULE Math - математические функции |
CONST |
pi = 3.141592653589793E+00 |
e = 2.718281828459045E+00 |
PROCEDURE IsNan(x: REAL): BOOLEAN |
возвращает TRUE, если x - не число |
PROCEDURE IsInf(x: REAL): BOOLEAN |
возвращает TRUE, если x - бесконечность |
PROCEDURE sqrt(x: REAL): REAL |
квадратный корень x |
PROCEDURE exp(x: REAL): REAL |
экспонента x |
PROCEDURE ln(x: REAL): REAL |
натуральный логарифм x |
PROCEDURE sin(x: REAL): REAL |
синус x |
PROCEDURE cos(x: REAL): REAL |
косинус x |
PROCEDURE tan(x: REAL): REAL |
тангенс x |
PROCEDURE arcsin(x: REAL): REAL |
арксинус x |
PROCEDURE arccos(x: REAL): REAL |
арккосинус x |
PROCEDURE arctan(x: REAL): REAL |
арктангенс x |
PROCEDURE arctan2(y, x: REAL): REAL |
арктангенс y/x |
PROCEDURE power(base, exponent: REAL): REAL |
возведение числа base в степень exponent |
PROCEDURE log(base, x: REAL): REAL |
логарифм x по основанию base |
PROCEDURE sinh(x: REAL): REAL |
гиперболический синус x |
PROCEDURE cosh(x: REAL): REAL |
гиперболический косинус x |
PROCEDURE tanh(x: REAL): REAL |
гиперболический тангенс x |
PROCEDURE arsinh(x: REAL): REAL |
обратный гиперболический синус x |
PROCEDURE arcosh(x: REAL): REAL |
обратный гиперболический косинус x |
PROCEDURE artanh(x: REAL): REAL |
обратный гиперболический тангенс x |
PROCEDURE round(x: REAL): REAL |
округление x до ближайшего целого |
PROCEDURE frac(x: REAL): REAL; |
дробная часть числа x |
PROCEDURE floor(x: REAL): REAL |
наибольшее целое число (представление как REAL), |
не больше x: floor(1.2) = 1.0 |
PROCEDURE ceil(x: REAL): REAL |
наименьшее целое число (представление как REAL), |
не меньше x: ceil(1.2) = 2.0 |
PROCEDURE sgn(x: REAL): INTEGER |
если x > 0 возвращает 1 |
если x < 0 возвращает -1 |
если x = 0 возвращает 0 |
PROCEDURE fact(n: INTEGER): REAL |
факториал n |
------------------------------------------------------------------------------ |
MODULE File - работа с файловой системой |
CONST |
OPEN_R = 0 |
OPEN_W = 1 |
OPEN_RW = 2 |
SEEK_BEG = 0 |
SEEK_CUR = 1 |
SEEK_END = 2 |
PROCEDURE Create(FName: ARRAY OF CHAR): INTEGER |
создает новый файл с именем FName (полное имя с путем), |
открывет файл для записи и возвращает идентификатор файла |
(целое число), в случае ошибки, возвращает -1 |
PROCEDURE Open(FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER |
открывает существующий файл с именем FName (полное имя с |
путем) в режиме Mode = (OPEN_R (только чтение), OPEN_W |
(только запись), OPEN_RW (чтение и запись)), возвращает |
идентификатор файла (целое число), в случае ошибки, |
возвращает -1 |
PROCEDURE Read(F, Buffer, Count: INTEGER): INTEGER |
Читает данные из файла в память. F - числовой идентификатор |
файла, Buffer - адрес области памяти, Count - количество байт, |
которое требуется прочитать из файла; возвращает количество |
байт, которое было прочитано из файла |
PROCEDURE Write(F, Buffer, Count: INTEGER): INTEGER |
Записывает данные из памяти в файл. F - числовой идентификатор |
файла, Buffer - адрес области памяти, Count - количество байт, |
которое требуется записать в файл; возвращает количество байт, |
которое было записано в файл |
PROCEDURE Seek(F, Offset, Origin: INTEGER): INTEGER |
устанавливает позицию чтения-записи файла с идентификатором F |
на Offset, относительно Origin = (SEEK_BEG - начало файла, |
SEEK_CUR - текущая позиция, SEEK_END - конец файла), |
возвращает позицию относительно начала файла, например: |
Seek(F, 0, 2) - устанавливает позицию на конец файла и |
возвращает длину файла; при ошибке возвращает -1 |
PROCEDURE Close(F: INTEGER) |
закрывает ранее открытый файл с идентификатором F |
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN |
удаляет файл с именем FName (полное имя с путем), |
возвращает TRUE, если файл успешно удален |
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN |
возвращает TRUE, если файл с именем FName (полное имя) |
существует |
PROCEDURE Load(FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER |
загружает в память существующий файл с именем FName (полное имя с |
путем), возвращает адрес памяти, куда был загружен файл, |
записывает размер файла в параметр Size; |
при ошибке возвращает 0 |
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN |
создает папку с именем DirName, все промежуточные папки |
должны существовать. В случае ошибки, возвращает FALSE |
PROCEDURE RemoveDir(DirName: ARRAY OF CHAR): BOOLEAN |
удаляет пустую папку с именем DirName. В случае ошибки, |
возвращает FALSE |
PROCEDURE ExistsDir(DirName: ARRAY OF CHAR): BOOLEAN |
возвращает TRUE, если папка с именем DirName существует |
------------------------------------------------------------------------------ |
MODULE DateTime - дата, время |
CONST ERR = -7.0E5 |
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER) |
возвращает в параметрах компоненты текущей системной даты и |
времени |
PROCEDURE NowEncode(): REAL; |
возвращает текущую системную дату и |
время (представление REAL) |
PROCEDURE Encode(Year, Month, Day, |
Hour, Min, Sec, MSec: INTEGER): REAL |
возвращает дату, полученную из компонентов |
Year, Month, Day, Hour, Min, Sec, MSec; |
при ошибке возвращает константу ERR = -7.0E5 |
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
Hour, Min, Sec, MSec: INTEGER): BOOLEAN |
извлекает компоненты |
Year, Month, Day, Hour, Min, Sec, MSec из даты Date; |
при ошибке возвращает FALSE |
------------------------------------------------------------------------------ |
MODULE Args - параметры программы |
VAR argc: INTEGER |
количество параметров программы, включая имя |
исполняемого файла |
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) |
записывает в строку s n-й параметр программы, |
нумерация параметров от 0 до argc - 1, |
нулевой параметр -- имя исполняемого файла |
------------------------------------------------------------------------------ |
MODULE Utils - разное |
PROCEDURE Utf8To16(source: ARRAY OF CHAR; |
VAR dest: ARRAY OF CHAR): INTEGER; |
преобразует символы строки source из кодировки UTF-8 в |
кодировку UTF-16, результат записывает в строку dest, |
возвращает количество 16-битных символов, записанных в dest |
PROCEDURE PutSeed(seed: INTEGER) |
Инициализация генератора случайных чисел целым числом seed |
PROCEDURE Rnd(range: INTEGER): INTEGER |
Целые случайные числа в диапазоне 0 <= x < range |
------------------------------------------------------------------------------ |
MODULE WINAPI - привязки к некоторым API-функциям Windows |
/programs/develop/oberon07/Docs/x86.txt |
---|
0,0 → 1,358 |
Компилятор языка программирования 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 Мб) |
-nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) |
-ver <major.minor> версия программы (только для kosdll) |
параметр -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 |
------------------------------------------------------------------------------ |
Особенности реализации |
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. Максимальная длина идентификаторов - 1024 символов |
3. Максимальная длина строковых констант - 1024 символов (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 SIZE(T): INTEGER |
возвращает размер типа T |
PROCEDURE TYPEID(T): INTEGER |
T - тип-запись или тип-указатель, |
возвращает номер типа в таблице типов-записей |
PROCEDURE INF(): REAL |
возвращает специальное вещественное значение "бесконечность" |
PROCEDURE GET(a: INTEGER; |
VAR v: любой основной тип, PROCEDURE, POINTER) |
v := Память[a] |
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) |
Память[a] := младшие 8 бит (x) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Память[a] := младшие 16 бит (x) |
PROCEDURE MOVE(Source, Dest, n: INTEGER) |
Копирует n байт памяти из Source в Dest, |
области Source и Dest не могут перекрываться |
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 нельзя использовать в константных выражениях. |
------------------------------------------------------------------------------ |
Системные флаги |
При объявлении процедурных типов и глобальных процедур, после ключевого |
слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall], |
[ccall], [ccall16], [windows], [linux]. Например: |
PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; |
Если указан флаг [ccall16], то принимается соглашение ccall, но перед |
вызовом указатель стэка будет выравнен по границе 16 байт. |
Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall16]. |
Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что |
результат процедуры можно игнорировать (не допускается для типа REAL). |
При объявлении типов-записей, после ключевого слова RECORD может быть |
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей |
записи. Записи с системным флагом не могут иметь базовый тип и не могут быть |
базовыми типами для других записей. |
Для использования системных флагов, требуется импортировать SYSTEM. |
------------------------------------------------------------------------------ |
Оператор CASE |
Синтаксис оператора CASE: |
CaseStatement = |
CASE Expression OF Сase {"|" Сase} |
[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 c BOM. |
------------------------------------------------------------------------------ |
Проверка и охрана типа нулевого указателя |
Оригинальное сообщение о языке не определяет поведение программы при |
выполнении охраны 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 |
------------------------------------------------------------------------------ |
Импортированные процедуры |
Синтаксис импорта: |
PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; |
- callconv -- соглашение о вызове |
- "library" -- имя файла динамической библиотеки |
- "function" -- имя импортируемой процедуры |
например: |
PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (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 импортировать процедуры можно только из библиотек, размещенных |
в /rd/1/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 |
Разрешается экспортировать только процедуры. Для этого, процедура должна |
находиться в главном модуле программы, и ее имя должно быть отмечено символом |
экспорта ("*"). KolibriOS DLL всегда экспортируют идентификаторы "version" |
(версия программы) и "lib_init" - адрес процедуры инициализации DLL: |
PROCEDURE [stdcall] lib_init (): INTEGER |
Эта процедура должна быть вызвана перед использованием DLL. |
Процедура всегда возвращает 1. |
/programs/develop/oberon07/Docs/x86_64.txt |
---|
0,0 → 1,346 |
Компилятор языка программирования Oberon-07/16 для x86_64 |
Windows/Linux |
------------------------------------------------------------------------------ |
Параметры командной строки |
Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или |
UTF-8 с BOM-сигнатурой. |
Выход - испоняемый файл формата PE32+ или ELF64. |
Параметры: |
1) имя главного модуля |
2) тип приложения |
"win64con" - Windows64 console |
"win64gui" - Windows64 GUI |
"win64dll" - Windows64 DLL |
"linux64exe" - Linux ELF64-EXEC |
"linux64so" - Linux ELF64-SO |
3) необязательные параметры-ключи |
-out <file_name> имя результирующего файла; по умолчанию, |
совпадает с именем главного модуля, но с другим расширением |
(соответствует типу исполняемого файла) |
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб, |
допустимо от 1 до 32 Мб) |
-nochk <"ptibcwra"> отключить проверки при выполнении |
параметр -nochk задается в виде строки из символов: |
"p" - указатели |
"t" - типы |
"i" - индексы |
"b" - неявное приведение INTEGER к BYTE |
"c" - диапазон аргумента функции CHR |
"w" - диапазон аргумента функции WCHR |
"r" - эквивалентно "bcw" |
"a" - все проверки |
Порядок символов может быть любым. Наличие в строке того или иного |
символа отключает соответствующую проверку. |
Например: -nochk it - отключить проверку индексов и охрану типа. |
-nochk a - отключить все отключаемые проверки. |
Например: |
Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1 |
Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti |
Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a |
В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. |
------------------------------------------------------------------------------ |
Отличия от оригинала |
1. Расширен псевдомодуль SYSTEM |
2. В идентификаторах допускается символ "_" |
3. Добавлены системные флаги |
4. Усовершенствован оператор CASE (добавлены константные выражения в |
метках вариантов и необязательная ветка ELSE) |
5. Расширен набор стандартных процедур |
6. Семантика охраны/проверки типа уточнена для нулевого указателя |
7. Добавлены однострочные комментарии (начинаются с пары символов "//") |
8. Разрешено наследование от типа-указателя |
9. Добавлен синтаксис для импорта процедур из внешних библиотек |
10. "Строки" можно заключать также в одиночные кавычки: 'строка' |
11. Добавлен тип WCHAR |
------------------------------------------------------------------------------ |
Особенности реализации |
1. Основные типы |
Тип Диапазон значений Размер, байт |
INTEGER -9223372036854775808 .. 9223372036854775807 8 |
REAL 4.94E-324 .. 1.70E+308 8 |
CHAR символ ASCII (0X .. 0FFX) 1 |
BOOLEAN FALSE, TRUE 1 |
SET множество из целых чисел {0 .. 63} 8 |
BYTE 0 .. 255 1 |
WCHAR символ юникода (0X .. 0FFFFX) 2 |
2. Максимальная длина идентификаторов - 1024 символов |
3. Максимальная длина строковых констант - 1024 символов (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 SIZE(T): INTEGER |
возвращает размер типа T |
PROCEDURE TYPEID(T): INTEGER |
T - тип-запись или тип-указатель, |
возвращает номер типа в таблице типов-записей |
PROCEDURE INF(): REAL |
возвращает специальное вещественное значение "бесконечность" |
PROCEDURE GET(a: INTEGER; |
VAR v: любой основной тип, PROCEDURE, POINTER) |
v := Память[a] |
PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) |
Память[a] := x; |
Если x: BYTE или x: WCHAR, то значение x будет расширено |
до 64 бит, для записи байтов использовать SYSTEM.PUT8, |
для WCHAR -- SYSTEM.PUT16 |
PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Память[a] := младшие 8 бит (x) |
PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Память[a] := младшие 16 бит (x) |
PROCEDURE PUT32(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
Память[a] := младшие 32 бит (x) |
PROCEDURE MOVE(Source, Dest, n: INTEGER) |
Копирует n байт памяти из Source в Dest, |
области Source и Dest не могут перекрываться |
PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) |
Копирует n байт памяти из Source в Dest. |
Эквивалентно |
SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) |
PROCEDURE CODE(byte1, byte2,... : BYTE) |
Вставка машинного кода, |
byte1, byte2 ... - константы в диапазоне 0..255, |
например: |
SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *) |
Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не |
допускаются никакие явные операции, за исключением присваивания. |
Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. |
------------------------------------------------------------------------------ |
Системные флаги |
При объявлении процедурных типов и глобальных процедур, после ключевого |
слова PROCEDURE может быть указан флаг соглашения о вызове: [win64], [systemv], |
[windows], [linux]. |
Например: |
PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER; |
Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv]. |
Знак "-" после имени флага ([win64-], [linux-], ...) означает, что |
результат процедуры можно игнорировать (не допускается для типа REAL). |
Если флаг не указан, то принимается внутреннее соглашение о вызове. |
[win64] и [systemv] используются для связи с операционной системой и внешними |
приложениями. |
При объявлении типов-записей, после ключевого слова RECORD может быть |
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей |
записи. Записи с системным флагом не могут иметь базовый тип и не могут быть |
базовыми типами для других записей. |
Для использования системных флагов, требуется импортировать SYSTEM. |
------------------------------------------------------------------------------ |
Оператор CASE |
Синтаксис оператора CASE: |
CaseStatement = |
CASE Expression OF Сase {"|" Сase} |
[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 c BOM. |
------------------------------------------------------------------------------ |
Проверка и охрана типа нулевого указателя |
Оригинальное сообщение о языке не определяет поведение программы при |
выполнении охраны 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 |
------------------------------------------------------------------------------ |
Импортированные процедуры |
Синтаксис импорта: |
PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; |
- callconv -- соглашение о вызове |
- "library" -- имя файла динамической библиотеки |
- "function" -- имя импортируемой процедуры |
например: |
PROCEDURE [win64, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); |
В конце объявления может быть добавлено (необязательно) "END proc_name;" |
Объявления импортированных процедур должны располагаться в глобальной |
области видимости модуля после объявления переменных, вместе с объявлением |
"обычных" процедур, от которых импортированные отличаются только отсутствием |
тела процедуры. В остальном, к таким процедурам применимы те же правила: |
их можно вызвать, присвоить процедурной переменной или получить адрес. |
Так как импортированная процедура всегда имеет явное указание соглашения о |
вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием |
соглашения о вызове: |
VAR |
ExitProcess: PROCEDURE [win64] (code: INTEGER); |
Для Linux, импортированные процедуры не реализованы. |
------------------------------------------------------------------------------ |
Скрытые параметры процедур |
Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке |
формальных параметров, но учитываются компилятором при трансляции вызовов. |
Это возможно в следующих случаях: |
1. Процедура имеет формальный параметр открытый массив: |
PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); |
Вызов транслируется так: |
Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) |
2. Процедура имеет формальный параметр-переменную типа RECORD: |
PROCEDURE Proc (VAR x: Rec); |
Вызов транслируется так: |
Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) |
------------------------------------------------------------------------------ |
Модуль RTL |
Все программы неявно используют модуль RTL. Компилятор транслирует |
некоторые операции (проверка и охрана типа, сравнение строк, сообщения об |
ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не |
следует вызывать эти процедуры явно. |
Сообщения об ошибках времени выполнения выводятся в диалоговых окнах |
(Windows), в терминал (Linux). |
------------------------------------------------------------------------------ |
Модуль API |
Существуют несколько реализаций модуля API (для различных ОС). |
Как и модуль RTL, модуль API не предназначен для прямого использования. |
Он обеспечивает связь RTL с ОС. |
------------------------------------------------------------------------------ |
Генерация исполняемых файлов DLL |
Разрешается экспортировать только процедуры. Для этого, процедура должна |
находиться в главном модуле программы, ее имя должно быть отмечено символом |
экспорта ("*") и должно быть указано соглашение о вызове. |
/programs/develop/oberon07/GitHub.url |
---|
0,0 → 1,2 |
[InternetShortcut] |
URL=https://github.com/AntKrotov/oberon-07-compiler |
/programs/develop/oberon07/LICENSE |
---|
0,0 → 1,25 |
BSD 2-Clause License |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
Redistribution and use in source and binary forms, with or without |
modification, are permitted provided that the following conditions are met: |
* Redistributions of source code must retain the above copyright notice, this |
list of conditions and the following disclaimer. |
* Redistributions in binary form must reproduce the above copyright notice, |
this list of conditions and the following disclaimer in the documentation |
and/or other materials provided with the distribution. |
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE |
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE |
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, |
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
/programs/develop/oberon07/Lib/KolibriOS/API.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018, Anton Krotov |
Copyright (c) 2018, 2020, Anton Krotov |
All rights reserved. |
*) |
318,4 → 318,13 |
END GetTickCount; |
END API. |
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
RETURN 0 |
END dllentry; |
PROCEDURE sofinit*; |
END sofinit; |
END API. |
/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/File.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
57,7 → 57,9 |
eol*: ARRAY 3 OF CHAR; |
maxreal*: 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); |
453,6 → 455,42 |
END UnixTime; |
PROCEDURE d2s* (x: REAL): INTEGER; |
VAR |
h, l, s, e: INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), l); |
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 (l # 0) 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), a); |
463,9 → 501,11 |
BEGIN |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
maxreal := 1.9; |
PACK(maxreal, 1023); |
Console := API.import; |
IF Console THEN |
con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) |
END; |
ParamParse |
END HOST. |
END HOST. |
/programs/develop/oberon07/Lib/KolibriOS/In.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2013, 2014, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2017 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
16,36 → 16,16 |
maxint* = 7FFFFFFFH; |
minint* = 80000000H; |
DLL_PROCESS_ATTACH = 1; |
DLL_THREAD_ATTACH = 2; |
DLL_THREAD_DETACH = 3; |
DLL_PROCESS_DETACH = 0; |
WORD = bit_depth DIV 8; |
MAX_SET = bit_depth - 1; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
name: INTEGER; |
types: INTEGER; |
bits: ARRAY MAX_SET + 1 OF INTEGER; |
dll: RECORD |
process_detach, |
thread_detach, |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); |
BEGIN |
SYSTEM.CODE( |
97,7 → 77,6 |
i, n, k: INTEGER; |
BEGIN |
k := LEN(A) - 1; |
n := A[0]; |
i := 0; |
106,7 → 85,6 |
INC(i) |
END; |
A[k] := n |
END _rot; |
128,14 → 106,16 |
END _set; |
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; |
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) |
BEGIN |
IF ASR(a, 5) = 0 THEN |
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) |
ELSE |
a := 0 |
END |
RETURN a |
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; |
315,7 → 295,6 |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
349,7 → 328,6 |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
398,7 → 376,6 |
c: CHAR; |
BEGIN |
i := 0; |
REPEAT |
str[i] := CHR(x MOD 10 + ORD("0")); |
422,6 → 399,7 |
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
437,7 → 415,6 |
END; |
s1[j] := 0X |
END append; |
446,20 → 423,18 |
s, temp: ARRAY 1024 OF CHAR; |
BEGIN |
s := ""; |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
| 4: append(s, "NIL procedure call") |
| 5: append(s, "type guard error") |
| 6: append(s, "index out of range") |
| 7: append(s, "invalid CASE") |
| 8: append(s, "array assignment error") |
| 9: append(s, "CHR out of range") |
|10: append(s, "WCHR out of range") |
|11: append(s, "BYTE out of range") |
| 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); |
513,36 → 488,16 |
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
CASE fdwReason OF |
|DLL_PROCESS_ATTACH: |
res := 1 |
|DLL_THREAD_ATTACH: |
res := 0; |
IF dll.thread_attach # NIL THEN |
dll.thread_attach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_THREAD_DETACH: |
res := 0; |
IF dll.thread_detach # NIL THEN |
dll.thread_detach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_PROCESS_DETACH: |
res := 0; |
IF dll.process_detach # NIL THEN |
dll.process_detach(hinstDLL, fdwReason, lpvReserved) |
END |
ELSE |
res := 0 |
END |
API.sofinit |
END _sofinit; |
RETURN res |
END _dllentry; |
PROCEDURE [stdcall] _exit* (code: INTEGER); |
BEGIN |
API.exit(code) |
571,42 → 526,8 |
END |
END; |
j := 1; |
FOR i := 0 TO MAX_SET DO |
bits[i] := j; |
j := LSL(j, 1) |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
name := modname |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
BEGIN |
dll.process_detach := process_detach; |
dll.thread_detach := thread_detach; |
dll.thread_attach := thread_attach |
END SetDll; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
END RTL. |
/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 KolibriOS team |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
Copyright 2016, 2018 KolibriOS team |
This program is free software: you can redistribute it and/or modify |
/programs/develop/oberon07/Lib/Linux32/API.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
13,11 → 13,13 |
CONST |
RTLD_LAZY* = 1; |
BIT_DEPTH* = 32; |
TYPE |
TP* = ARRAY 2 OF INTEGER; |
SOFINI* = PROCEDURE; |
VAR |
46,7 → 48,9 |
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
fini: SOFINI; |
PROCEDURE putc* (c: CHAR); |
VAR |
res: INTEGER; |
103,6 → 107,7 |
PROCEDURE init* (sp, code: INTEGER); |
BEGIN |
fini := NIL; |
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); |
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); |
MainParam := sp; |
142,4 → 147,23 |
END exit_thread; |
END API. |
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
RETURN 0 |
END dllentry; |
PROCEDURE sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END sofinit; |
PROCEDURE SetFini* (ProcFini: SOFINI); |
BEGIN |
fini := ProcFini |
END SetFini; |
END API. |
/programs/develop/oberon07/Lib/Linux32/HOST.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
26,7 → 26,9 |
eol*: ARRAY 2 OF CHAR; |
maxreal*: REAL; |
PROCEDURE ExitProcess* (code: INTEGER); |
BEGIN |
API.exit(code) |
148,6 → 150,42 |
END UnixTime; |
PROCEDURE d2s* (x: REAL): INTEGER; |
VAR |
h, l, s, e: INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), l); |
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 (l # 0) 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
164,5 → 202,7 |
BEGIN |
eol := 0AX; |
maxreal := 1.9; |
PACK(maxreal, 1023); |
SYSTEM.GET(API.MainParam, argc) |
END HOST. |
END HOST. |
/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
13,6 → 13,7 |
TYPE |
TP* = API.TP; |
SOFINI* = API.SOFINI; |
VAR |
69,12 → 70,17 |
END GetEnv; |
PROCEDURE SetFini* (ProcFini: SOFINI); |
BEGIN |
API.SetFini(ProcFini) |
END SetFini; |
PROCEDURE init; |
VAR |
ptr: INTEGER; |
BEGIN |
IF API.MainParam # 0 THEN |
envc := -1; |
SYSTEM.GET(API.MainParam, argc); |
/programs/develop/oberon07/Lib/Linux32/Libdl.ob07 |
---|
0,0 → 1,65 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Libdl; |
IMPORT SYSTEM, API; |
CONST |
LAZY* = 1; |
NOW* = 2; |
BINDING_MASK* = 3; |
NOLOAD* = 4; |
LOCAL* = 0; |
GLOBAL* = 256; |
NODELETE* = 4096; |
VAR |
_close: PROCEDURE [linux] (handle: INTEGER): INTEGER; |
_error: PROCEDURE [linux] (): INTEGER; |
PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER; |
RETURN API.dlopen(SYSTEM.ADR(file[0]), mode) |
END open; |
PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER; |
RETURN API.dlsym(handle, SYSTEM.ADR(name[0])) |
END sym; |
PROCEDURE close* (handle: INTEGER): INTEGER; |
RETURN _close(handle) |
END close; |
PROCEDURE error* (): INTEGER; |
RETURN _error() |
END error; |
PROCEDURE init; |
VAR |
lib: INTEGER; |
BEGIN |
lib := open("libdl.so.2", LAZY); |
SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose")); |
ASSERT(_close # NIL); |
SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror")); |
ASSERT(_error # NIL) |
END init; |
BEGIN |
init |
END Libdl. |
/programs/develop/oberon07/Lib/Linux32/Math.ob07 |
---|
0,0 → 1,384 |
(* |
Copyright 2013, 2014, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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 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 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 := exp(2.0 * x); |
x := (x - 1.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 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; |
END Math. |
/programs/develop/oberon07/Lib/Linux32/Out.ob07 |
---|
0,0 → 1,277 |
(* |
Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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 sys := SYSTEM, API; |
CONST |
d = 1.0 - 5.0E-12; |
VAR |
Realp: PROCEDURE (x: REAL; width: INTEGER); |
PROCEDURE Char*(x: CHAR); |
BEGIN |
API.putc(x) |
END Char; |
PROCEDURE String*(s: ARRAY OF CHAR); |
VAR |
i: INTEGER; |
BEGIN |
i := 0; |
WHILE (i < LEN(s)) & (s[i] # 0X) DO |
Char(s[i]); |
INC(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(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 |
Realp := Real; |
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; |
_FixReal(x, width, width - 3); |
Char("E"); |
IF e >= 0 THEN |
Char("+") |
ELSE |
Char("-"); |
e := ABS(e) |
END; |
IF e < 100 THEN |
Char("0") |
END; |
IF e < 10 THEN |
Char("0") |
END; |
Int(e, 0) |
END |
END Real; |
PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
BEGIN |
Realp := Real; |
_FixReal(x, width, p) |
END FixReal; |
PROCEDURE Open*; |
END Open; |
END Out. |
/programs/develop/oberon07/Lib/Linux32/RTL.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
16,36 → 16,16 |
maxint* = 7FFFFFFFH; |
minint* = 80000000H; |
DLL_PROCESS_ATTACH = 1; |
DLL_THREAD_ATTACH = 2; |
DLL_THREAD_DETACH = 3; |
DLL_PROCESS_DETACH = 0; |
WORD = bit_depth DIV 8; |
MAX_SET = bit_depth - 1; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
name: INTEGER; |
types: INTEGER; |
bits: ARRAY MAX_SET + 1 OF INTEGER; |
dll: RECORD |
process_detach, |
thread_detach, |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); |
BEGIN |
SYSTEM.CODE( |
97,7 → 77,6 |
i, n, k: INTEGER; |
BEGIN |
k := LEN(A) - 1; |
n := A[0]; |
i := 0; |
106,7 → 85,6 |
INC(i) |
END; |
A[k] := n |
END _rot; |
128,14 → 106,16 |
END _set; |
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; |
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) |
BEGIN |
IF ASR(a, 5) = 0 THEN |
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) |
ELSE |
a := 0 |
END |
RETURN a |
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; |
315,7 → 295,6 |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
349,7 → 328,6 |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
398,7 → 376,6 |
c: CHAR; |
BEGIN |
i := 0; |
REPEAT |
str[i] := CHR(x MOD 10 + ORD("0")); |
422,6 → 399,7 |
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
437,7 → 415,6 |
END; |
s1[j] := 0X |
END append; |
446,20 → 423,18 |
s, temp: ARRAY 1024 OF CHAR; |
BEGIN |
s := ""; |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
| 4: append(s, "NIL procedure call") |
| 5: append(s, "type guard error") |
| 6: append(s, "index out of range") |
| 7: append(s, "invalid CASE") |
| 8: append(s, "array assignment error") |
| 9: append(s, "CHR out of range") |
|10: append(s, "WCHR out of range") |
|11: append(s, "BYTE out of range") |
| 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); |
513,36 → 488,16 |
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
CASE fdwReason OF |
|DLL_PROCESS_ATTACH: |
res := 1 |
|DLL_THREAD_ATTACH: |
res := 0; |
IF dll.thread_attach # NIL THEN |
dll.thread_attach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_THREAD_DETACH: |
res := 0; |
IF dll.thread_detach # NIL THEN |
dll.thread_detach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_PROCESS_DETACH: |
res := 0; |
IF dll.process_detach # NIL THEN |
dll.process_detach(hinstDLL, fdwReason, lpvReserved) |
END |
ELSE |
res := 0 |
END |
API.sofinit |
END _sofinit; |
RETURN res |
END _dllentry; |
PROCEDURE [stdcall] _exit* (code: INTEGER); |
BEGIN |
API.exit(code) |
571,42 → 526,8 |
END |
END; |
j := 1; |
FOR i := 0 TO MAX_SET DO |
bits[i] := j; |
j := LSL(j, 1) |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
name := modname |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
BEGIN |
dll.process_detach := process_detach; |
dll.thread_detach := thread_detach; |
dll.thread_attach := thread_attach |
END SetDll; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
END RTL. |
/programs/develop/oberon07/Lib/Linux64/API.ob07 |
---|
0,0 → 1,169 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE API; |
IMPORT SYSTEM; |
CONST |
RTLD_LAZY* = 1; |
BIT_DEPTH* = 64; |
TYPE |
TP* = ARRAY 2 OF INTEGER; |
SOFINI* = PROCEDURE; |
VAR |
eol*: ARRAY 2 OF CHAR; |
MainParam*: INTEGER; |
libc*, librt*: INTEGER; |
dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER; |
dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER; |
stdout*, |
stdin*, |
stderr* : INTEGER; |
malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; |
free* : PROCEDURE [linux] (ptr: INTEGER); |
_exit* : PROCEDURE [linux] (code: INTEGER); |
puts* : PROCEDURE [linux] (pStr: INTEGER); |
fwrite*, |
fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; |
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
fini: SOFINI; |
PROCEDURE putc* (c: CHAR); |
VAR |
res: INTEGER; |
BEGIN |
res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) |
END putc; |
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
BEGIN |
puts(lpCaption); |
puts(lpText) |
END DebugMsg; |
PROCEDURE _NEW* (size: INTEGER): INTEGER; |
VAR |
res, ptr, words: INTEGER; |
BEGIN |
res := malloc(size); |
IF res # 0 THEN |
ptr := res; |
words := size DIV SYSTEM.SIZE(INTEGER); |
WHILE words > 0 DO |
SYSTEM.PUT(ptr, 0); |
INC(ptr, SYSTEM.SIZE(INTEGER)); |
DEC(words) |
END |
END |
RETURN res |
END _NEW; |
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; |
BEGIN |
free(p) |
RETURN 0 |
END _DISPOSE; |
PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
VAR |
sym: INTEGER; |
BEGIN |
sym := dlsym(lib, SYSTEM.ADR(name[0])); |
ASSERT(sym # 0); |
SYSTEM.PUT(VarAdr, sym) |
END GetProcAdr; |
PROCEDURE init* (sp, code: INTEGER); |
BEGIN |
fini := NIL; |
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); |
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); |
MainParam := sp; |
eol := 0AX; |
libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY); |
GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc)); |
GetProcAdr(libc, "free", SYSTEM.ADR(free)); |
GetProcAdr(libc, "exit", SYSTEM.ADR(_exit)); |
GetProcAdr(libc, "stdout", SYSTEM.ADR(stdout)); |
GetProcAdr(libc, "stdin", SYSTEM.ADR(stdin)); |
GetProcAdr(libc, "stderr", SYSTEM.ADR(stderr)); |
SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); |
SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); |
GetProcAdr(libc, "puts", SYSTEM.ADR(puts)); |
GetProcAdr(libc, "fwrite", SYSTEM.ADR(fwrite)); |
GetProcAdr(libc, "fread", SYSTEM.ADR(fread)); |
GetProcAdr(libc, "fopen", SYSTEM.ADR(fopen)); |
GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); |
GetProcAdr(libc, "time", SYSTEM.ADR(time)); |
librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); |
GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
END init; |
PROCEDURE exit* (code: INTEGER); |
BEGIN |
_exit(code) |
END exit; |
PROCEDURE exit_thread* (code: INTEGER); |
BEGIN |
_exit(code) |
END exit_thread; |
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
RETURN 0 |
END dllentry; |
PROCEDURE sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END sofinit; |
PROCEDURE SetFini* (ProcFini: SOFINI); |
BEGIN |
fini := ProcFini |
END SetFini; |
END API. |
/programs/develop/oberon07/Lib/Linux64/HOST.ob07 |
---|
0,0 → 1,208 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE HOST; |
IMPORT SYSTEM, API, RTL; |
CONST |
slash* = "/"; |
OS* = "LINUX"; |
bit_depth* = RTL.bit_depth; |
maxint* = RTL.maxint; |
minint* = RTL.minint; |
VAR |
argc: INTEGER; |
eol*: ARRAY 2 OF CHAR; |
maxreal*: REAL; |
PROCEDURE ExitProcess* (code: INTEGER); |
BEGIN |
API.exit(code) |
END ExitProcess; |
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
i, len, ptr: INTEGER; |
c: CHAR; |
BEGIN |
i := 0; |
len := LEN(s) - 1; |
IF (n < argc) & (len > 0) THEN |
SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); |
REPEAT |
SYSTEM.GET(ptr, c); |
s[i] := c; |
INC(i); |
INC(ptr) |
UNTIL (c = 0X) OR (i = len) |
END; |
s[i] := 0X |
END GetArg; |
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
VAR |
n: INTEGER; |
BEGIN |
GetArg(0, path); |
n := LENGTH(path) - 1; |
WHILE path[n] # slash DO |
DEC(n) |
END; |
path[n + 1] := 0X |
END GetCurrentDirectory; |
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
IF res <= 0 THEN |
res := -1 |
END |
RETURN res |
END FileRead; |
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
IF res <= 0 THEN |
res := -1 |
END |
RETURN res |
END FileWrite; |
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) |
END FileCreate; |
PROCEDURE FileClose* (File: INTEGER); |
BEGIN |
File := API.fclose(File) |
END FileClose; |
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) |
END FileOpen; |
PROCEDURE OutChar* (c: CHAR); |
BEGIN |
API.putc(c) |
END OutChar; |
PROCEDURE GetTickCount* (): INTEGER; |
VAR |
tp: API.TP; |
res: INTEGER; |
BEGIN |
IF API.clock_gettime(0, tp) = 0 THEN |
res := tp[0] * 100 + tp[1] DIV 10000000 |
ELSE |
res := 0 |
END |
RETURN res |
END GetTickCount; |
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; |
RETURN path[0] # slash |
END isRelative; |
PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
END now; |
PROCEDURE UnixTime* (): INTEGER; |
RETURN API.time(0) |
END UnixTime; |
PROCEDURE d2s* (x: REAL): INTEGER; |
VAR |
h, l, s, e: INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), l); |
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
a := 0; |
b := 0; |
SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
SYSTEM.GET(SYSTEM.ADR(x), res) |
RETURN res |
END splitf; |
BEGIN |
eol := 0AX; |
maxreal := 1.9; |
PACK(maxreal, 1023); |
SYSTEM.GET(API.MainParam, argc) |
END HOST. |
/programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 |
---|
0,0 → 1,138 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE LINAPI; |
IMPORT SYSTEM, API; |
TYPE |
TP* = API.TP; |
SOFINI* = API.SOFINI; |
VAR |
argc*, envc*: INTEGER; |
libc*, librt*: INTEGER; |
stdout*, |
stdin*, |
stderr* : INTEGER; |
malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; |
free* : PROCEDURE [linux] (ptr: INTEGER); |
exit* : PROCEDURE [linux] (code: INTEGER); |
puts* : PROCEDURE [linux] (pStr: INTEGER); |
fwrite*, |
fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; |
time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
i, len, ptr: INTEGER; |
c: CHAR; |
BEGIN |
i := 0; |
len := LEN(s) - 1; |
IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN |
SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); |
REPEAT |
SYSTEM.GET(ptr, c); |
s[i] := c; |
INC(i); |
INC(ptr) |
UNTIL (c = 0X) OR (i = len) |
END; |
s[i] := 0X |
END GetArg; |
PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR); |
BEGIN |
IF (0 <= n) & (n < envc) THEN |
GetArg(n + argc + 1, s) |
ELSE |
s[0] := 0X |
END |
END GetEnv; |
PROCEDURE SetFini* (ProcFini: SOFINI); |
BEGIN |
API.SetFini(ProcFini) |
END SetFini; |
PROCEDURE init; |
VAR |
ptr: INTEGER; |
BEGIN |
IF API.MainParam # 0 THEN |
envc := -1; |
SYSTEM.GET(API.MainParam, argc); |
REPEAT |
SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr); |
INC(envc) |
UNTIL ptr = 0 |
ELSE |
envc := 0; |
argc := 0 |
END; |
libc := API.libc; |
stdout := API.stdout; |
stdin := API.stdin; |
stderr := API.stderr; |
malloc := API.malloc; |
free := API.free; |
exit := API._exit; |
puts := API.puts; |
fwrite := API.fwrite; |
fread := API.fread; |
fopen := API.fopen; |
fclose := API.fclose; |
time := API.time; |
librt := API.librt; |
clock_gettime := API.clock_gettime |
END init; |
PROCEDURE [stdcall64-] syscall* (rax, rdi, rsi, rdx, r10, r8, r9: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) |
048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) |
048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) |
048H, 08BH, 055H, 028H, (* mov rdx, qword [rbp + 40] *) |
04CH, 08BH, 055H, 030H, (* mov r10, qword [rbp + 48] *) |
04CH, 08BH, 045H, 038H, (* mov r8, qword [rbp + 56] *) |
04CH, 08BH, 04DH, 040H, (* mov r9, qword [rbp + 64] *) |
00FH, 005H, (* syscall *) |
0C9H, (* leave *) |
0C2H, 038H, 000H (* ret 56 *) |
) |
RETURN 0 |
END syscall; |
BEGIN |
init |
END LINAPI. |
/programs/develop/oberon07/Lib/Linux64/Libdl.ob07 |
---|
0,0 → 1,65 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Libdl; |
IMPORT SYSTEM, API; |
CONST |
LAZY* = 1; |
NOW* = 2; |
BINDING_MASK* = 3; |
NOLOAD* = 4; |
LOCAL* = 0; |
GLOBAL* = 256; |
NODELETE* = 4096; |
VAR |
_close: PROCEDURE [linux] (handle: INTEGER): INTEGER; |
_error: PROCEDURE [linux] (): INTEGER; |
PROCEDURE open* (file: ARRAY OF CHAR; mode: INTEGER): INTEGER; |
RETURN API.dlopen(SYSTEM.ADR(file[0]), mode) |
END open; |
PROCEDURE sym* (handle: INTEGER; name: ARRAY OF CHAR): INTEGER; |
RETURN API.dlsym(handle, SYSTEM.ADR(name[0])) |
END sym; |
PROCEDURE close* (handle: INTEGER): INTEGER; |
RETURN _close(handle) |
END close; |
PROCEDURE error* (): INTEGER; |
RETURN _error() |
END error; |
PROCEDURE init; |
VAR |
lib: INTEGER; |
BEGIN |
lib := open("libdl.so.2", LAZY); |
SYSTEM.PUT(SYSTEM.ADR(_close), sym(lib, "dlclose")); |
ASSERT(_close # NIL); |
SYSTEM.PUT(SYSTEM.ADR(_error), sym(lib, "dlerror")); |
ASSERT(_error # NIL) |
END init; |
BEGIN |
init |
END Libdl. |
/programs/develop/oberon07/Lib/Linux64/Math.ob07 |
---|
0,0 → 1,311 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Math; |
IMPORT SYSTEM; |
CONST |
e *= 2.71828182845904523; |
pi *= 3.14159265358979324; |
ln2 *= 0.693147180559945309; |
eps = 1.0E-16; |
MaxCosArg = 1000000.0 * pi; |
VAR |
Exp: ARRAY 710 OF REAL; |
PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; |
BEGIN |
ASSERT(x >= 0.0); |
SYSTEM.CODE( |
0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) |
05DH, (* pop rbp *) |
0C2H, 08H, 00H (* ret 8 *) |
) |
RETURN 0.0 |
END sqrt; |
PROCEDURE exp* (x: REAL): REAL; |
CONST |
e25 = 1.284025416687741484; (* exp(0.25) *) |
VAR |
a, s, res: REAL; |
neg: BOOLEAN; |
n: INTEGER; |
BEGIN |
neg := x < 0.0; |
IF neg THEN |
x := -x |
END; |
IF x < FLT(LEN(Exp)) THEN |
res := Exp[FLOOR(x)]; |
x := x - FLT(FLOOR(x)); |
WHILE x >= 0.25 DO |
res := res * e25; |
x := x - 0.25 |
END |
ELSE |
res := SYSTEM.INF(); |
x := 0.0 |
END; |
n := 0; |
a := 1.0; |
s := 1.0; |
REPEAT |
INC(n); |
a := a * x / FLT(n); |
s := s + a |
UNTIL a < eps; |
IF neg THEN |
res := 1.0 / (res * s) |
ELSE |
res := res * s |
END |
RETURN res |
END exp; |
PROCEDURE ln* (x: REAL): REAL; |
VAR |
a, x2, res: REAL; |
n: INTEGER; |
BEGIN |
ASSERT(x > 0.0); |
UNPK(x, n); |
x := (x - 1.0) / (x + 1.0); |
x2 := x * x; |
res := x + FLT(n) * (ln2 * 0.5); |
n := 1; |
REPEAT |
INC(n, 2); |
x := x * x2; |
a := x / FLT(n); |
res := res + a |
UNTIL a < eps |
RETURN res * 2.0 |
END ln; |
PROCEDURE power* (base, exponent: REAL): REAL; |
BEGIN |
ASSERT(base > 0.0) |
RETURN exp(exponent * ln(base)) |
END power; |
PROCEDURE log* (base, x: REAL): REAL; |
BEGIN |
ASSERT(base > 0.0); |
ASSERT(x > 0.0) |
RETURN ln(x) / ln(base) |
END log; |
PROCEDURE cos* (x: REAL): REAL; |
VAR |
a, res: REAL; |
n: INTEGER; |
BEGIN |
x := ABS(x); |
ASSERT(x <= MaxCosArg); |
x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); |
x := x * x; |
res := 0.0; |
a := 1.0; |
n := -1; |
REPEAT |
INC(n, 2); |
res := res + a; |
a := -a * x / FLT(n*n + n) |
UNTIL ABS(a) < eps |
RETURN res |
END cos; |
PROCEDURE sin* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= MaxCosArg); |
x := cos(x) |
RETURN sqrt(1.0 - x * x) |
END sin; |
PROCEDURE tan* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= MaxCosArg); |
x := cos(x) |
RETURN sqrt(1.0 - x * x) / x |
END tan; |
PROCEDURE arcsin* (x: REAL): REAL; |
PROCEDURE arctan (x: REAL): REAL; |
VAR |
z, p, k: REAL; |
BEGIN |
p := x / (x * x + 1.0); |
z := p * x; |
x := 0.0; |
k := 0.0; |
REPEAT |
k := k + 2.0; |
x := x + p; |
p := p * k * z / (k + 1.0) |
UNTIL p < eps |
RETURN x |
END arctan; |
BEGIN |
ASSERT(ABS(x) <= 1.0); |
IF ABS(x) >= 0.707 THEN |
x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) |
ELSE |
x := arctan(x / sqrt(1.0 - x * x)) |
END |
RETURN x |
END arcsin; |
PROCEDURE arccos* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= 1.0) |
RETURN 0.5 * pi - arcsin(x) |
END arccos; |
PROCEDURE arctan* (x: REAL): REAL; |
RETURN arcsin(x / sqrt(1.0 + x * x)) |
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 := exp(2.0 * x); |
x := (x - 1.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; |
BEGIN |
ASSERT(x >= 1.0) |
RETURN ln(x + sqrt(x * x - 1.0)) |
END arcosh; |
PROCEDURE artanh* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) < 1.0) |
RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) |
END artanh; |
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 init; |
VAR |
i: INTEGER; |
BEGIN |
Exp[0] := 1.0; |
FOR i := 1 TO LEN(Exp) - 1 DO |
Exp[i] := Exp[i - 1] * e |
END |
END init; |
BEGIN |
init |
END Math. |
/programs/develop/oberon07/Lib/Linux64/Out.ob07 |
---|
0,0 → 1,276 |
(* |
Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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 sys := SYSTEM, API; |
CONST |
d = 1.0 - 5.0E-12; |
VAR |
Realp: PROCEDURE (x: REAL; width: INTEGER); |
PROCEDURE Char*(x: CHAR); |
BEGIN |
API.putc(x) |
END Char; |
PROCEDURE String*(s: ARRAY OF CHAR); |
VAR |
i: INTEGER; |
BEGIN |
i := 0; |
WHILE (i < LEN(s)) & (s[i] # 0X) DO |
Char(s[i]); |
INC(i) |
END |
END String; |
PROCEDURE WriteInt(x, n: INTEGER); |
VAR i: INTEGER; a: ARRAY 24 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 s: SET; |
BEGIN |
sys.GET(sys.ADR(AValue), s) |
RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {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(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 |
Realp := Real; |
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; |
_FixReal(x, width, width - 3); |
Char("E"); |
IF e >= 0 THEN |
Char("+") |
ELSE |
Char("-"); |
e := ABS(e) |
END; |
IF e < 100 THEN |
Char("0") |
END; |
IF e < 10 THEN |
Char("0") |
END; |
Int(e, 0) |
END |
END Real; |
PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
BEGIN |
Realp := Real; |
_FixReal(x, width, p) |
END FixReal; |
PROCEDURE Open*; |
END Open; |
END Out. |
/programs/develop/oberon07/Lib/Linux64/RTL.ob07 |
---|
0,0 → 1,516 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE RTL; |
IMPORT SYSTEM, API; |
CONST |
bit_depth* = 64; |
maxint* = 7FFFFFFFFFFFFFFFH; |
minint* = 8000000000000000H; |
WORD = bit_depth DIV 8; |
MAX_SET = bit_depth - 1; |
VAR |
name: INTEGER; |
types: INTEGER; |
sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; |
PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) |
048H, 085H, 0C0H, (* test rax, rax *) |
07EH, 020H, (* jle L *) |
0FCH, (* cld *) |
057H, (* push rdi *) |
056H, (* push rsi *) |
048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) |
048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) |
048H, 089H, 0C1H, (* mov rcx, rax *) |
048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *) |
0F3H, 048H, 0A5H, (* rep movsd *) |
048H, 089H, 0C1H, (* mov rcx, rax *) |
048H, 083H, 0E1H, 007H, (* and rcx, 7 *) |
0F3H, 0A4H, (* rep movsb *) |
05EH, (* pop rsi *) |
05FH (* pop rdi *) |
(* L: *) |
) |
END _move; |
PROCEDURE [stdcall64] _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 [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, dst, src) |
END _strcpy; |
PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER); |
VAR |
i, n, k: INTEGER; |
BEGIN |
k := LEN(A) - 1; |
n := A[0]; |
i := 0; |
WHILE i < k DO |
A[i] := A[i + 1]; |
INC(i) |
END; |
A[k] := n |
END _rot; |
PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER; |
BEGIN |
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a) |
ELSE |
a := 0 |
END |
RETURN a |
END _set; |
PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *) |
BEGIN |
SYSTEM.CODE( |
048H, 031H, 0C0H, (* xor rax, rax *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *) |
048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *) |
077H, 004H, (* ja L *) |
048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *) |
(* L: *) |
) |
END _set1; |
PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *) |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *) |
048H, 031H, 0D2H, (* xor rdx, rdx *) |
048H, 085H, 0C0H, (* test rax, rax *) |
074H, 022H, (* je L2 *) |
07FH, 003H, (* jg L1 *) |
048H, 0F7H, 0D2H, (* not rdx *) |
(* L1: *) |
049H, 089H, 0C0H, (* mov r8, rax *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *) |
048H, 0F7H, 0F9H, (* idiv rcx *) |
048H, 085H, 0D2H, (* test rdx, rdx *) |
074H, 00EH, (* je L2 *) |
049H, 031H, 0C8H, (* xor r8, rcx *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07DH, 006H, (* jge L2 *) |
048H, 0FFH, 0C8H, (* dec rax *) |
048H, 001H, 0CAH (* add rdx, rcx *) |
(* L2: *) |
) |
END _divmod; |
PROCEDURE [stdcall64] _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 [stdcall64] _dispose* (VAR ptr: INTEGER); |
BEGIN |
IF ptr # 0 THEN |
ptr := API._DISPOSE(ptr - WORD) |
END |
END _dispose; |
PROCEDURE [stdcall64] _length* (len, str: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
048H, 0FFH, 0C8H, (* dec rax *) |
(* L1: *) |
048H, 0FFH, 0C0H, (* inc rax *) |
080H, 038H, 000H, (* cmp byte [rax], 0 *) |
074H, 005H, (* jz L2 *) |
0E2H, 0F6H, (* loop L1 *) |
048H, 0FFH, 0C0H, (* inc rax *) |
(* L2: *) |
048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *) |
) |
END _length; |
PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
048H, 083H, 0E8H, 002H, (* sub rax, 2 *) |
(* L1: *) |
048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
066H, 083H, 038H, 000H, (* cmp word [rax], 0 *) |
074H, 006H, (* jz L2 *) |
0E2H, 0F4H, (* loop L1 *) |
048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
(* L2: *) |
048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *) |
048H, 0D1H, 0E8H (* shr rax, 1 *) |
) |
END _lengthw; |
PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
04DH, 031H, 0C9H, (* xor r9, r9 *) |
04DH, 031H, 0D2H, (* xor r10, r10 *) |
048H, 0B8H, 000H, 000H, |
000H, 000H, 000H, 000H, |
000H, 080H, (* movabs rax, minint *) |
(* L1: *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07EH, 024H, (* jle L3 *) |
044H, 08AH, 009H, (* mov r9b, byte[rcx] *) |
044H, 08AH, 012H, (* mov r10b, byte[rdx] *) |
048H, 0FFH, 0C1H, (* inc rcx *) |
048H, 0FFH, 0C2H, (* inc rdx *) |
049H, 0FFH, 0C8H, (* dec r8 *) |
04DH, 039H, 0D1H, (* cmp r9, r10 *) |
074H, 008H, (* je L2 *) |
04CH, 089H, 0C8H, (* mov rax, r9 *) |
04CH, 029H, 0D0H, (* sub rax, r10 *) |
0EBH, 008H, (* jmp L3 *) |
(* L2: *) |
04DH, 085H, 0C9H, (* test r9, r9 *) |
075H, 0DAH, (* jne L1 *) |
048H, 031H, 0C0H, (* xor rax, rax *) |
(* L3: *) |
05DH, (* pop rbp *) |
0C2H, 018H, 000H (* ret 24 *) |
) |
RETURN 0 |
END strncmp; |
PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
04DH, 031H, 0C9H, (* xor r9, r9 *) |
04DH, 031H, 0D2H, (* xor r10, r10 *) |
048H, 0B8H, 000H, 000H, |
000H, 000H, 000H, 000H, |
000H, 080H, (* movabs rax, minint *) |
(* L1: *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07EH, 028H, (* jle L3 *) |
066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *) |
066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *) |
048H, 083H, 0C1H, 002H, (* add rcx, 2 *) |
048H, 083H, 0C2H, 002H, (* add rdx, 2 *) |
049H, 0FFH, 0C8H, (* dec r8 *) |
04DH, 039H, 0D1H, (* cmp r9, r10 *) |
074H, 008H, (* je L2 *) |
04CH, 089H, 0C8H, (* mov rax, r9 *) |
04CH, 029H, 0D0H, (* sub rax, r10 *) |
0EBH, 008H, (* jmp L3 *) |
(* L2: *) |
04DH, 085H, 0C9H, (* test r9, r9 *) |
075H, 0D6H, (* jne L1 *) |
048H, 031H, 0C0H, (* xor rax, rax *) |
(* L3: *) |
05DH, (* pop rbp *) |
0C2H, 018H, 000H (* ret 24 *) |
) |
RETURN 0 |
END strncmpw; |
PROCEDURE [stdcall64] _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 [stdcall64] _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, b: INTEGER; |
c: CHAR; |
BEGIN |
i := 0; |
REPEAT |
str[i] := CHR(x MOD 10 + ORD("0")); |
x := x DIV 10; |
INC(i) |
UNTIL x = 0; |
a := 0; |
b := i - 1; |
WHILE a < b DO |
c := str[a]; |
str[a] := str[b]; |
str[b] := c; |
INC(a); |
DEC(b) |
END; |
str[i] := 0X |
END IntToStr; |
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
ASSERT(n1 + n2 < LEN(s1)); |
i := 0; |
j := n1; |
WHILE i < n2 DO |
s1[j] := s2[i]; |
INC(i); |
INC(j) |
END; |
s1[j] := 0X |
END append; |
PROCEDURE [stdcall64] _error* (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); |
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
append(s, "line: "); IntToStr(line, temp); append(s, temp); |
API.DebugMsg(SYSTEM.ADR(s[0]), name); |
API.exit_thread(0) |
END _error; |
PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER; |
BEGIN |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _isrec; |
PROCEDURE [stdcall64] _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 [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER; |
BEGIN |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _guardrec; |
PROCEDURE [stdcall64] _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 [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
PROCEDURE [stdcall64] _sofinit*; |
BEGIN |
API.sofinit |
END _sofinit; |
PROCEDURE [stdcall64] _exit* (code: INTEGER); |
BEGIN |
API.exit(code) |
END _exit; |
PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
VAR |
t0, t1, i, j: INTEGER; |
BEGIN |
API.init(param, code); |
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
ASSERT(types # 0); |
FOR i := 0 TO tcount - 1 DO |
FOR j := 0 TO tcount - 1 DO |
t0 := i; t1 := j; |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(_types + t1 * WORD, t1) |
END; |
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
FOR i := 0 TO MAX_SET DO |
FOR j := 0 TO i DO |
sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i) |
END |
END; |
name := modname |
END _init; |
END RTL. |
/programs/develop/oberon07/Lib/Windows32/API.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
14,7 → 14,17 |
SectionAlignment = 1000H; |
DLL_PROCESS_ATTACH = 1; |
DLL_THREAD_ATTACH = 2; |
DLL_THREAD_DETACH = 3; |
DLL_PROCESS_DETACH = 0; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
VAR |
eol*: ARRAY 3 OF CHAR; |
21,7 → 31,11 |
base*: INTEGER; |
heap: INTEGER; |
process_detach, |
thread_detach, |
thread_attach: DLL_ENTRY; |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER; |
51,6 → 65,9 |
PROCEDURE init* (reserved, code: INTEGER); |
BEGIN |
process_detach := NIL; |
thread_detach := NIL; |
thread_attach := NIL; |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
base := code - SectionAlignment; |
heap := GetProcessHeap() |
69,4 → 86,45 |
END exit_thread; |
END API. |
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
res := 0; |
CASE fdwReason OF |
|DLL_PROCESS_ATTACH: |
res := 1 |
|DLL_THREAD_ATTACH: |
IF thread_attach # NIL THEN |
thread_attach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_THREAD_DETACH: |
IF thread_detach # NIL THEN |
thread_detach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_PROCESS_DETACH: |
IF process_detach # NIL THEN |
process_detach(hinstDLL, fdwReason, lpvReserved) |
END |
ELSE |
END |
RETURN res |
END dllentry; |
PROCEDURE sofinit*; |
END sofinit; |
PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); |
BEGIN |
process_detach := _process_detach; |
thread_detach := _thread_detach; |
thread_attach := _thread_attach |
END SetDll; |
END API. |
/programs/develop/oberon07/Lib/Windows32/Args.ob07 |
---|
0,0 → 1,101 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Args; |
IMPORT SYSTEM, WINAPI; |
CONST |
MAX_PARAM = 1024; |
VAR |
Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
argc*: INTEGER; |
PROCEDURE GetChar (adr: INTEGER): CHAR; |
VAR |
res: CHAR; |
BEGIN |
SYSTEM.GET(adr, res) |
RETURN res |
END GetChar; |
PROCEDURE ParamParse; |
VAR |
p, count, cond: INTEGER; |
c: CHAR; |
PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR): INTEGER; |
BEGIN |
IF (c <= 20X) & (c # 0X) THEN |
cond := A |
ELSIF c = 22X THEN |
cond := B |
ELSIF c = 0X THEN |
cond := 6 |
ELSE |
cond := C |
END |
RETURN cond |
END ChangeCond; |
BEGIN |
p := WINAPI.GetCommandLine(); |
cond := 0; |
count := 0; |
WHILE (count < MAX_PARAM) & (cond # 6) DO |
c := GetChar(p); |
CASE cond OF |
|0: IF ChangeCond(0, 4, 1, cond, c) = 1 THEN Params[count, 0] := p END |
|1: IF ChangeCond(0, 3, 1, cond, c) IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END |
|3: IF ChangeCond(3, 1, 3, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END |
|4: IF ChangeCond(5, 0, 5, cond, c) = 5 THEN Params[count, 0] := p END |
|5: IF ChangeCond(5, 1, 5, cond, c) = 6 THEN Params[count, 1] := p - 1; INC(count) END |
|6: |
END; |
INC(p) |
END; |
argc := count |
END ParamParse; |
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
i, j, len: INTEGER; |
c: CHAR; |
BEGIN |
j := 0; |
IF n < argc THEN |
i := Params[n, 0]; |
len := LEN(s) - 1; |
WHILE (j < len) & (i <= Params[n, 1]) DO |
c := GetChar(i); |
IF c # '"' THEN |
s[j] := c; |
INC(j) |
END; |
INC(i) |
END |
END; |
s[j] := 0X |
END GetArg; |
BEGIN |
ParamParse |
END Args. |
/programs/develop/oberon07/Lib/Windows32/Console.ob07 |
---|
0,0 → 1,100 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Console; |
IMPORT SYSTEM, WINAPI, In, Out; |
CONST |
Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; |
Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; |
DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; |
LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; |
VAR |
hConsoleOutput: INTEGER; |
PROCEDURE SetCursor* (X, Y: INTEGER); |
BEGIN |
WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536) |
END SetCursor; |
PROCEDURE GetCursor* (VAR X, Y: INTEGER); |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
X := ORD(ScrBufInfo.dwCursorPosition.X); |
Y := ORD(ScrBufInfo.dwCursorPosition.Y) |
END GetCursor; |
PROCEDURE Cls*; |
VAR |
fill: INTEGER; |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); |
WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); |
SetCursor(0, 0) |
END Cls; |
PROCEDURE SetColor* (FColor, BColor: INTEGER); |
BEGIN |
IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN |
WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor) |
END |
END SetColor; |
PROCEDURE GetCursorX* (): INTEGER; |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) |
RETURN ORD(ScrBufInfo.dwCursorPosition.X) |
END GetCursorX; |
PROCEDURE GetCursorY* (): INTEGER; |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) |
RETURN ORD(ScrBufInfo.dwCursorPosition.Y) |
END GetCursorY; |
PROCEDURE open*; |
BEGIN |
WINAPI.AllocConsole; |
hConsoleOutput := WINAPI.GetStdHandle(-11); |
In.Open; |
Out.Open |
END open; |
PROCEDURE exit* (b: BOOLEAN); |
BEGIN |
WINAPI.FreeConsole |
END exit; |
END Console. |
/programs/develop/oberon07/Lib/Windows32/DateTime.ob07 |
---|
0,0 → 1,174 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE DateTime; |
IMPORT WINAPI; |
CONST |
ERR* = -7.0E5; |
VAR |
DateTable: ARRAY 120000, 3 OF INTEGER; |
MonthsTable: ARRAY 13, 4 OF INTEGER; |
PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL; |
VAR |
d, bis: INTEGER; |
res: REAL; |
BEGIN |
res := ERR; |
IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) & |
(Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) & |
(Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) & |
(MSec >= 0) & (MSec <= 999) THEN |
bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0)); |
IF Day <= MonthsTable[Month][2 + bis] THEN |
DEC(Year); |
d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + |
MonthsTable[Month][bis] + Day - 693594; |
res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0 |
END |
END |
RETURN res |
END Encode; |
PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
d, t: INTEGER; |
L, R, M: INTEGER; |
BEGIN |
res := (Date >= -693593.0) & (Date < 2958466.0); |
IF res THEN |
d := FLOOR(Date); |
t := FLOOR((Date - FLT(d)) * 86400000.0); |
INC(d, 693593); |
L := 0; |
R := LEN(DateTable) - 1; |
M := (L + R) DIV 2; |
WHILE R - L > 1 DO |
IF d > DateTable[M][0] THEN |
L := M; |
M := (L + R) DIV 2 |
ELSIF d < DateTable[M][0] THEN |
R := M; |
M := (L + R) DIV 2 |
ELSE |
L := M; |
R := M |
END |
END; |
Year := DateTable[L][1]; |
Month := DateTable[L][2]; |
Day := d - DateTable[L][0] + 1; |
Hour := t DIV 3600000; t := t MOD 3600000; |
Min := t DIV 60000; t := t MOD 60000; |
Sec := t DIV 1000; |
MSec := t MOD 1000 |
END |
RETURN res |
END Decode; |
PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER); |
VAR |
T: WINAPI.TSystemTime; |
BEGIN |
WINAPI.GetLocalTime(T); |
Year := ORD(T.Year); |
Month := ORD(T.Month); |
Day := ORD(T.Day); |
Hour := ORD(T.Hour); |
Min := ORD(T.Min); |
Sec := ORD(T.Sec); |
MSec := ORD(T.MSec) |
END Now; |
PROCEDURE NowEncode* (): REAL; |
VAR |
Year, Month, Day, Hour, Min, Sec, MSec: INTEGER; |
BEGIN |
Now(Year, Month, Day, Hour, Min, Sec, MSec) |
RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec) |
END NowEncode; |
PROCEDURE init; |
VAR |
day, year, month, i: INTEGER; |
Months: ARRAY 13 OF INTEGER; |
BEGIN |
Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30; |
Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31; |
Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31; |
day := 0; |
year := 1; |
month := 1; |
i := 0; |
WHILE year <= 10000 DO |
DateTable[i][0] := day; |
DateTable[i][1] := year; |
DateTable[i][2] := month; |
INC(day, Months[month]); |
IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN |
INC(day) |
END; |
INC(month); |
IF month > 12 THEN |
month := 1; |
INC(year) |
END; |
INC(i) |
END; |
MonthsTable[1][0] := 0; |
FOR i := 2 TO 12 DO |
MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1] |
END; |
FOR i := 1 TO 12 DO |
MonthsTable[i][2] := Months[i] |
END; |
Months[2] := 29; |
MonthsTable[1][1] := 0; |
FOR i := 2 TO 12 DO |
MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1] |
END; |
FOR i := 1 TO 12 DO |
MonthsTable[i][3] := Months[i] |
END |
END init; |
BEGIN |
init |
END DateTime. |
/programs/develop/oberon07/Lib/Windows32/File.ob07 |
---|
0,0 → 1,142 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE File; |
IMPORT SYSTEM, WINAPI; |
CONST |
OPEN_R* = 0; OPEN_W* = 1; OPEN_RW* = 2; |
SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2; |
PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN; |
VAR |
FindData: WINAPI.TWin32FindData; |
Handle: INTEGER; |
BEGIN |
Handle := WINAPI.FindFirstFile(SYSTEM.ADR(FName[0]), FindData); |
IF Handle # -1 THEN |
WINAPI.FindClose(Handle); |
IF 4 IN FindData.dwFileAttributes THEN |
Handle := -1 |
END |
END |
RETURN Handle # -1 |
END Exists; |
PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; |
RETURN WINAPI.DeleteFile(SYSTEM.ADR(FName[0])) # 0 |
END Delete; |
PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER; |
RETURN WINAPI.CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) |
END Create; |
PROCEDURE Close* (F: INTEGER); |
BEGIN |
WINAPI.CloseHandle(F) |
END Close; |
PROCEDURE Open* (FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER; |
VAR |
ofstr: WINAPI.OFSTRUCT; |
BEGIN |
RETURN WINAPI.OpenFile(SYSTEM.ADR(FName[0]), ofstr, Mode) |
END Open; |
PROCEDURE Seek* (F, Offset, Origin: INTEGER): INTEGER; |
RETURN WINAPI.SetFilePointer(F, Offset, 0, Origin) |
END Seek; |
PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER; |
VAR |
res, n: INTEGER; |
BEGIN |
IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN |
res := -1 |
ELSE |
res := n |
END |
RETURN res |
END Read; |
PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER; |
VAR |
res, n: INTEGER; |
BEGIN |
IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN |
res := -1 |
ELSE |
res := n |
END |
RETURN res |
END Write; |
PROCEDURE Load* (FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER; |
VAR |
res, n, F: INTEGER; |
BEGIN |
res := 0; |
F := Open(FName, OPEN_R); |
IF F # -1 THEN |
Size := Seek(F, 0, SEEK_END); |
n := Seek(F, 0, SEEK_BEG); |
res := WINAPI.GlobalAlloc(64, Size); |
IF (res = 0) OR (Read(F, res, Size) # Size) THEN |
IF res # 0 THEN |
WINAPI.GlobalFree(Size); |
res := 0; |
Size := 0 |
END |
END; |
Close(F) |
END |
RETURN res |
END Load; |
PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN; |
RETURN WINAPI.RemoveDirectory(SYSTEM.ADR(DirName[0])) # 0 |
END RemoveDir; |
PROCEDURE ExistsDir* (DirName: ARRAY OF CHAR): BOOLEAN; |
VAR |
Code: SET; |
BEGIN |
Code := WINAPI.GetFileAttributes(SYSTEM.ADR(DirName[0])) |
RETURN (Code # {0..31}) & (4 IN Code) |
END ExistsDir; |
PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; |
RETURN WINAPI.CreateDirectory(SYSTEM.ADR(DirName[0]), NIL) # 0 |
END CreateDir; |
END File. |
/programs/develop/oberon07/Lib/Windows32/HOST.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
82,7 → 82,9 |
eol*: ARRAY 3 OF CHAR; |
maxreal*: REAL; |
PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
_GetTickCount (): INTEGER; |
310,6 → 312,42 |
END UnixTime; |
PROCEDURE d2s* (x: REAL): INTEGER; |
VAR |
h, l, s, e: INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), l); |
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 (l # 0) 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
326,6 → 364,8 |
BEGIN |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
maxreal := 1.9; |
PACK(maxreal, 1023); |
hConsoleOutput := _GetStdHandle(-11); |
ParamParse |
END HOST. |
END HOST. |
/programs/develop/oberon07/Lib/Windows32/In.ob07 |
---|
0,0 → 1,289 |
(* |
Copyright 2013, 2017, 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, WINAPI; |
TYPE |
STRING = ARRAY 260 OF CHAR; |
VAR |
Done*: BOOLEAN; |
hConsoleInput: INTEGER; |
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(VAR res, d: REAL; VAR i: INTEGER; str: STRING): 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(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): 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 scale: INTEGER; VAR res, m: REAL); |
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(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN |
part3(err, minus, scale, res, m) |
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 count, i: INTEGER; str: STRING; |
BEGIN |
WINAPI.ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); |
IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN |
DEC(count, 2) |
END; |
str[256] := 0X; |
str[count] := 0X; |
i := 0; |
WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO |
s[i] := str[i]; |
INC(i) |
END; |
s[i] := 0X; |
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 |
hConsoleInput := WINAPI.GetStdHandle(-10); |
Done := TRUE |
END Open; |
END In. |
/programs/develop/oberon07/Lib/Windows32/Math.ob07 |
---|
0,0 → 1,384 |
(* |
Copyright 2013, 2014, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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 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 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 := exp(2.0 * x); |
x := (x - 1.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 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; |
END Math. |
/programs/develop/oberon07/Lib/Windows32/Out.ob07 |
---|
0,0 → 1,280 |
(* |
Copyright 2013, 2014, 2017, 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 sys := SYSTEM, WINAPI; |
CONST |
d = 1.0 - 5.0E-12; |
VAR |
hConsoleOutput: INTEGER; |
Realp: PROCEDURE (x: REAL; width: INTEGER); |
PROCEDURE String*(s: ARRAY OF CHAR); |
VAR count: INTEGER; |
BEGIN |
WINAPI.WriteFile(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), NIL) |
END String; |
PROCEDURE StringW*(s: ARRAY OF WCHAR); |
VAR count: INTEGER; |
BEGIN |
WINAPI.WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) |
END StringW; |
PROCEDURE Char*(x: CHAR); |
VAR count: INTEGER; |
BEGIN |
WINAPI.WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) |
END Char; |
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 |
Realp := Real; |
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; |
_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*; |
BEGIN |
hConsoleOutput := WINAPI.GetStdHandle(-11) |
END Open; |
END Out. |
/programs/develop/oberon07/Lib/Windows32/RTL.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
16,36 → 16,16 |
maxint* = 7FFFFFFFH; |
minint* = 80000000H; |
DLL_PROCESS_ATTACH = 1; |
DLL_THREAD_ATTACH = 2; |
DLL_THREAD_DETACH = 3; |
DLL_PROCESS_DETACH = 0; |
WORD = bit_depth DIV 8; |
MAX_SET = bit_depth - 1; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
PROC = PROCEDURE; |
VAR |
name: INTEGER; |
types: INTEGER; |
bits: ARRAY MAX_SET + 1 OF INTEGER; |
dll: RECORD |
process_detach, |
thread_detach, |
thread_attach: DLL_ENTRY |
END; |
fini: PROC; |
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); |
BEGIN |
SYSTEM.CODE( |
97,7 → 77,6 |
i, n, k: INTEGER; |
BEGIN |
k := LEN(A) - 1; |
n := A[0]; |
i := 0; |
106,7 → 85,6 |
INC(i) |
END; |
A[k] := n |
END _rot; |
128,14 → 106,16 |
END _set; |
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; |
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) |
BEGIN |
IF ASR(a, 5) = 0 THEN |
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) |
ELSE |
a := 0 |
END |
RETURN a |
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; |
315,7 → 295,6 |
c: CHAR; |
BEGIN |
res := strncmp(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
349,7 → 328,6 |
c: WCHAR; |
BEGIN |
res := strncmpw(str1, str2, MIN(len1, len2)); |
IF res = minint THEN |
IF len1 > len2 THEN |
398,7 → 376,6 |
c: CHAR; |
BEGIN |
i := 0; |
REPEAT |
str[i] := CHR(x MOD 10 + ORD("0")); |
422,6 → 399,7 |
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
437,7 → 415,6 |
END; |
s1[j] := 0X |
END append; |
446,20 → 423,18 |
s, temp: ARRAY 1024 OF CHAR; |
BEGIN |
s := ""; |
CASE err OF |
| 1: append(s, "assertion failure") |
| 2: append(s, "NIL dereference") |
| 3: append(s, "division by zero") |
| 4: append(s, "NIL procedure call") |
| 5: append(s, "type guard error") |
| 6: append(s, "index out of range") |
| 7: append(s, "invalid CASE") |
| 8: append(s, "array assignment error") |
| 9: append(s, "CHR out of range") |
|10: append(s, "WCHR out of range") |
|11: append(s, "BYTE out of range") |
| 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); |
513,36 → 488,16 |
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
CASE fdwReason OF |
|DLL_PROCESS_ATTACH: |
res := 1 |
|DLL_THREAD_ATTACH: |
res := 0; |
IF dll.thread_attach # NIL THEN |
dll.thread_attach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_THREAD_DETACH: |
res := 0; |
IF dll.thread_detach # NIL THEN |
dll.thread_detach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_PROCESS_DETACH: |
res := 0; |
IF dll.process_detach # NIL THEN |
dll.process_detach(hinstDLL, fdwReason, lpvReserved) |
END |
ELSE |
res := 0 |
END |
API.sofinit |
END _sofinit; |
RETURN res |
END _dllentry; |
PROCEDURE [stdcall] _exit* (code: INTEGER); |
BEGIN |
API.exit(code) |
571,42 → 526,8 |
END |
END; |
j := 1; |
FOR i := 0 TO MAX_SET DO |
bits[i] := j; |
j := LSL(j, 1) |
END; |
name := modname; |
dll.process_detach := NIL; |
dll.thread_detach := NIL; |
dll.thread_attach := NIL; |
fini := NIL |
name := modname |
END _init; |
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
IF fini # NIL THEN |
fini |
END |
END _sofinit; |
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
BEGIN |
dll.process_detach := process_detach; |
dll.thread_detach := thread_detach; |
dll.thread_attach := thread_attach |
END SetDll; |
PROCEDURE SetFini* (ProcFini: PROC); |
BEGIN |
fini := ProcFini |
END SetFini; |
END RTL. |
END RTL. |
/programs/develop/oberon07/Lib/Windows32/UnixTime.ob07 |
---|
0,0 → 1,64 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
All rights reserved. |
*) |
MODULE UnixTime; |
VAR |
days: ARRAY 12, 31, 2 OF INTEGER; |
PROCEDURE init; |
VAR |
i, j, k, n0, n1: INTEGER; |
BEGIN |
FOR i := 0 TO 11 DO |
FOR j := 0 TO 30 DO |
days[i, j, 0] := 0; |
days[i, j, 1] := 0; |
END |
END; |
days[ 1, 28, 0] := -1; |
FOR k := 0 TO 1 DO |
days[ 1, 29, k] := -1; |
days[ 1, 30, k] := -1; |
days[ 3, 30, k] := -1; |
days[ 5, 30, k] := -1; |
days[ 8, 30, k] := -1; |
days[10, 30, k] := -1; |
END; |
n0 := 0; |
n1 := 0; |
FOR i := 0 TO 11 DO |
FOR j := 0 TO 30 DO |
IF days[i, j, 0] = 0 THEN |
days[i, j, 0] := n0; |
INC(n0) |
END; |
IF days[i, j, 1] = 0 THEN |
days[i, j, 1] := n1; |
INC(n1) |
END |
END |
END |
END init; |
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; |
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
END time; |
BEGIN |
init |
END UnixTime. |
/programs/develop/oberon07/Lib/Windows32/Utils.ob07 |
---|
0,0 → 1,76 |
(* |
Copyright 2013, 2017, 2018, 2020 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 Utils; |
IMPORT WINAPI; |
PROCEDURE PutSeed*(seed: INTEGER); |
BEGIN |
WINAPI.srand(seed) |
END PutSeed; |
PROCEDURE Rnd*(range : INTEGER): INTEGER; |
RETURN WINAPI.rand() MOD range |
END Rnd; |
PROCEDURE Utf8To16*(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR): INTEGER; |
VAR i, j, L, u, N: INTEGER; |
BEGIN |
L := LEN(source); |
N := LEN(dest); |
N := N - N MOD 2 - 1; |
i := 0; |
j := 0; |
WHILE (i < L) & (j < N) & (source[i] # 0X) DO |
CASE source[i] OF |
|00X..7FX: u := ORD(source[i]); |
|0C1X..0DFX: |
u := LSL(ORD(source[i]) - 0C0H, 6); |
IF i + 1 < L THEN |
u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); |
INC(i) |
END |
|0E1X..0EFX: |
u := LSL(ORD(source[i]) - 0E0H, 12); |
IF i + 1 < L THEN |
u := u + ROR(LSL(ORD(source[i + 1]), 26), 20); |
INC(i) |
END; |
IF i + 1 < L THEN |
u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); |
INC(i) |
END |
(* |0F1X..0F7X: |
|0F9X..0FBX: |
|0FDX:*) |
ELSE |
END; |
INC(i); |
dest[j] := CHR(u MOD 256); |
INC(j); |
dest[j] := CHR(u DIV 256); |
INC(j); |
END; |
IF j < N THEN |
dest[j] := 0X; |
dest[j + 1] := 0X |
END |
RETURN j DIV 2 |
END Utf8To16; |
END Utils. |
/programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 |
---|
0,0 → 1,241 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE WINAPI; |
IMPORT SYSTEM, API; |
CONST |
OFS_MAXPATHNAME* = 128; |
TYPE |
DLL_ENTRY* = API.DLL_ENTRY; |
STRING = ARRAY 260 OF CHAR; |
TCoord* = RECORD |
X*, Y*: WCHAR |
END; |
TSmallRect* = RECORD |
Left*, Top*, Right*, Bottom*: WCHAR |
END; |
TConsoleScreenBufferInfo* = RECORD |
dwSize*: TCoord; |
dwCursorPosition*: TCoord; |
wAttributes*: WCHAR; |
srWindow*: TSmallRect; |
dwMaximumWindowSize*: TCoord |
END; |
TSystemTime* = RECORD |
Year*, |
Month*, |
DayOfWeek*, |
Day*, |
Hour*, |
Min*, |
Sec*, |
MSec*: WCHAR |
END; |
PSecurityAttributes* = POINTER TO TSecurityAttributes; |
TSecurityAttributes* = RECORD |
nLength*: INTEGER; |
lpSecurityDescriptor*: INTEGER; |
bInheritHandle*: INTEGER |
END; |
TFileTime* = RECORD |
dwLowDateTime*, |
dwHighDateTime*: INTEGER |
END; |
TWin32FindData* = RECORD |
dwFileAttributes*: SET; |
ftCreationTime*: TFileTime; |
ftLastAccessTime*: TFileTime; |
ftLastWriteTime*: TFileTime; |
nFileSizeHigh*: INTEGER; |
nFileSizeLow*: INTEGER; |
dwReserved0*: INTEGER; |
dwReserved1*: INTEGER; |
cFileName*: STRING; |
cAlternateFileName*: ARRAY 14 OF CHAR |
END; |
OFSTRUCT* = RECORD |
cBytes*: CHAR; |
fFixedDisk*: CHAR; |
nErrCode*: WCHAR; |
Reserved1*: WCHAR; |
Reserved2*: WCHAR; |
szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR |
END; |
POverlapped* = POINTER TO OVERLAPPED; |
OVERLAPPED* = RECORD |
Internal*: INTEGER; |
InternalHigh*: INTEGER; |
Offset*: INTEGER; |
OffsetHigh*: INTEGER; |
hEvent*: INTEGER |
END; |
PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] |
SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] |
GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] |
FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] |
FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] |
SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] |
GetLocalTime* (T: TSystemTime); |
PROCEDURE [windows-, "kernel32.dll", "RemoveDirectoryA"] |
RemoveDirectory* (lpPathName: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetFileAttributesA"] |
GetFileAttributes* (lpPathName: INTEGER): SET; |
PROCEDURE [windows-, "kernel32.dll", "CreateDirectoryA"] |
CreateDirectory* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FindFirstFileA"] |
FindFirstFile* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "DeleteFileA"] |
DeleteFile* (lpFileName: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FindClose"] |
FindClose* (hFindFile: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
CloseHandle* (hObject: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] |
CreateFile* ( |
lpFileName, dwDesiredAccess, dwShareMode: INTEGER; |
lpSecurityAttributes: PSecurityAttributes; |
dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "OpenFile"] |
OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "SetFilePointer"] |
SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] |
ReadConsole* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
GetCommandLine* (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] |
GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] |
GlobalFree* (hMem: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] |
WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
ExitProcess* (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "WriteConsoleA"] |
WriteConsole* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
GetTickCount* (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "Sleep"] |
Sleep* (dwMilliseconds: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] |
FreeLibrary* (hLibModule: INTEGER): INTEGER; |
PROCEDURE [ccall, "msvcrt.dll", "rand"] |
rand* (): INTEGER; |
PROCEDURE [ccall, "msvcrt.dll", "srand"] |
srand* (seed: INTEGER); |
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] |
MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
PROCEDURE [windows-, "user32.dll", "MessageBoxW"] |
MessageBox* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
PROCEDURE [windows-, "user32.dll", "CreateWindowExA"] |
CreateWindowEx* ( |
dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, |
nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] |
GetProcAddress* (hModule, name: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] |
LoadLibraryA* (name: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] |
AllocConsole* (): BOOLEAN; |
PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] |
FreeConsole* (): BOOLEAN; |
PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
BEGIN |
API.SetDll(process_detach, thread_detach, thread_attach) |
END SetDllEntry; |
END WINAPI. |
/programs/develop/oberon07/Lib/Windows64/API.ob07 |
---|
0,0 → 1,130 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE API; |
IMPORT SYSTEM; |
CONST |
SectionAlignment = 1000H; |
DLL_PROCESS_ATTACH = 1; |
DLL_THREAD_ATTACH = 2; |
DLL_THREAD_DETACH = 3; |
DLL_PROCESS_DETACH = 0; |
TYPE |
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
VAR |
eol*: ARRAY 3 OF CHAR; |
base*: INTEGER; |
heap: INTEGER; |
process_detach, |
thread_detach, |
thread_attach: DLL_ENTRY; |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER); |
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
BEGIN |
MessageBoxA(0, lpText, lpCaption, 16) |
END DebugMsg; |
PROCEDURE _NEW* (size: INTEGER): INTEGER; |
RETURN HeapAlloc(heap, 8, size) |
END _NEW; |
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; |
BEGIN |
HeapFree(heap, 0, p) |
RETURN 0 |
END _DISPOSE; |
PROCEDURE init* (reserved, code: INTEGER); |
BEGIN |
process_detach := NIL; |
thread_detach := NIL; |
thread_attach := NIL; |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
base := code - SectionAlignment; |
heap := GetProcessHeap() |
END init; |
PROCEDURE exit* (code: INTEGER); |
BEGIN |
ExitProcess(code) |
END exit; |
PROCEDURE exit_thread* (code: INTEGER); |
BEGIN |
ExitThread(code) |
END exit_thread; |
PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
res := 0; |
CASE fdwReason OF |
|DLL_PROCESS_ATTACH: |
res := 1 |
|DLL_THREAD_ATTACH: |
IF thread_attach # NIL THEN |
thread_attach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_THREAD_DETACH: |
IF thread_detach # NIL THEN |
thread_detach(hinstDLL, fdwReason, lpvReserved) |
END |
|DLL_PROCESS_DETACH: |
IF process_detach # NIL THEN |
process_detach(hinstDLL, fdwReason, lpvReserved) |
END |
ELSE |
END |
RETURN res |
END dllentry; |
PROCEDURE sofinit*; |
END sofinit; |
PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); |
BEGIN |
process_detach := _process_detach; |
thread_detach := _thread_detach; |
thread_attach := _thread_attach |
END SetDll; |
END API. |
/programs/develop/oberon07/Lib/Windows64/Console.ob07 |
---|
0,0 → 1,100 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Console; |
IMPORT SYSTEM, WINAPI, In, Out; |
CONST |
Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; |
Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; |
DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; |
LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; |
VAR |
hConsoleOutput: INTEGER; |
PROCEDURE SetCursor* (X, Y: INTEGER); |
BEGIN |
WINAPI.SetConsoleCursorPosition(hConsoleOutput, X + Y * 65536) |
END SetCursor; |
PROCEDURE GetCursor* (VAR X, Y: INTEGER); |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
X := ORD(ScrBufInfo.dwCursorPosition.X); |
Y := ORD(ScrBufInfo.dwCursorPosition.Y) |
END GetCursor; |
PROCEDURE Cls*; |
VAR |
fill: INTEGER; |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); |
WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); |
SetCursor(0, 0) |
END Cls; |
PROCEDURE SetColor* (FColor, BColor: INTEGER); |
BEGIN |
IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN |
WINAPI.SetConsoleTextAttribute(hConsoleOutput, LSL(BColor, 4) + FColor) |
END |
END SetColor; |
PROCEDURE GetCursorX* (): INTEGER; |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) |
RETURN ORD(ScrBufInfo.dwCursorPosition.X) |
END GetCursorX; |
PROCEDURE GetCursorY* (): INTEGER; |
VAR |
ScrBufInfo: WINAPI.TConsoleScreenBufferInfo; |
BEGIN |
WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo) |
RETURN ORD(ScrBufInfo.dwCursorPosition.Y) |
END GetCursorY; |
PROCEDURE open*; |
BEGIN |
WINAPI.AllocConsole; |
hConsoleOutput := WINAPI.GetStdHandle(-11); |
In.Open; |
Out.Open |
END open; |
PROCEDURE exit* (b: BOOLEAN); |
BEGIN |
WINAPI.FreeConsole |
END exit; |
END Console. |
/programs/develop/oberon07/Lib/Windows64/DateTime.ob07 |
---|
0,0 → 1,174 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE DateTime; |
IMPORT WINAPI; |
CONST |
ERR* = -7.0E5; |
VAR |
DateTable: ARRAY 120000, 3 OF INTEGER; |
MonthsTable: ARRAY 13, 4 OF INTEGER; |
PROCEDURE Encode* (Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): REAL; |
VAR |
d, bis: INTEGER; |
res: REAL; |
BEGIN |
res := ERR; |
IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) & |
(Day >= 1) & (Day <= 31) & (Hour >= 0) & (Hour <= 23) & |
(Min >= 0) & (Min <= 59) & (Sec >= 0) & (Sec <= 59) & |
(MSec >= 0) & (MSec <= 999) THEN |
bis := ORD((Year MOD 4 = 0) & (Year MOD 100 # 0) OR (Year MOD 400 = 0)); |
IF Day <= MonthsTable[Month][2 + bis] THEN |
DEC(Year); |
d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + |
MonthsTable[Month][bis] + Day - 693594; |
res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / 86400000.0 |
END |
END |
RETURN res |
END Encode; |
PROCEDURE Decode* (Date: REAL; VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
d, t: INTEGER; |
L, R, M: INTEGER; |
BEGIN |
res := (Date >= -693593.0) & (Date < 2958466.0); |
IF res THEN |
d := FLOOR(Date); |
t := FLOOR((Date - FLT(d)) * 86400000.0); |
INC(d, 693593); |
L := 0; |
R := LEN(DateTable) - 1; |
M := (L + R) DIV 2; |
WHILE R - L > 1 DO |
IF d > DateTable[M][0] THEN |
L := M; |
M := (L + R) DIV 2 |
ELSIF d < DateTable[M][0] THEN |
R := M; |
M := (L + R) DIV 2 |
ELSE |
L := M; |
R := M |
END |
END; |
Year := DateTable[L][1]; |
Month := DateTable[L][2]; |
Day := d - DateTable[L][0] + 1; |
Hour := t DIV 3600000; t := t MOD 3600000; |
Min := t DIV 60000; t := t MOD 60000; |
Sec := t DIV 1000; |
MSec := t MOD 1000 |
END |
RETURN res |
END Decode; |
PROCEDURE Now* (VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER); |
VAR |
T: WINAPI.TSystemTime; |
BEGIN |
WINAPI.GetLocalTime(T); |
Year := ORD(T.Year); |
Month := ORD(T.Month); |
Day := ORD(T.Day); |
Hour := ORD(T.Hour); |
Min := ORD(T.Min); |
Sec := ORD(T.Sec); |
MSec := ORD(T.MSec) |
END Now; |
PROCEDURE NowEncode* (): REAL; |
VAR |
Year, Month, Day, Hour, Min, Sec, MSec: INTEGER; |
BEGIN |
Now(Year, Month, Day, Hour, Min, Sec, MSec) |
RETURN Encode(Year, Month, Day, Hour, Min, Sec, MSec) |
END NowEncode; |
PROCEDURE init; |
VAR |
day, year, month, i: INTEGER; |
Months: ARRAY 13 OF INTEGER; |
BEGIN |
Months[1] := 31; Months[2] := 28; Months[3] := 31; Months[4] := 30; |
Months[5] := 31; Months[6] := 30; Months[7] := 31; Months[8] := 31; |
Months[9] := 30; Months[10] := 31; Months[11] := 30; Months[12] := 31; |
day := 0; |
year := 1; |
month := 1; |
i := 0; |
WHILE year <= 10000 DO |
DateTable[i][0] := day; |
DateTable[i][1] := year; |
DateTable[i][2] := month; |
INC(day, Months[month]); |
IF (month = 2) & ((year MOD 4 = 0) & (year MOD 100 # 0) OR (year MOD 400 = 0)) THEN |
INC(day) |
END; |
INC(month); |
IF month > 12 THEN |
month := 1; |
INC(year) |
END; |
INC(i) |
END; |
MonthsTable[1][0] := 0; |
FOR i := 2 TO 12 DO |
MonthsTable[i][0] := MonthsTable[i - 1][0] + Months[i - 1] |
END; |
FOR i := 1 TO 12 DO |
MonthsTable[i][2] := Months[i] |
END; |
Months[2] := 29; |
MonthsTable[1][1] := 0; |
FOR i := 2 TO 12 DO |
MonthsTable[i][1] := MonthsTable[i - 1][1] + Months[i - 1] |
END; |
FOR i := 1 TO 12 DO |
MonthsTable[i][3] := Months[i] |
END |
END init; |
BEGIN |
init |
END DateTime. |
/programs/develop/oberon07/Lib/Windows64/HOST.ob07 |
---|
0,0 → 1,371 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE HOST; |
IMPORT SYSTEM, RTL; |
CONST |
slash* = "\"; |
OS* = "WINDOWS"; |
bit_depth* = RTL.bit_depth; |
maxint* = RTL.maxint; |
minint* = RTL.minint; |
MAX_PARAM = 1024; |
OFS_MAXPATHNAME = 128; |
TYPE |
POverlapped = POINTER TO OVERLAPPED; |
OVERLAPPED = RECORD |
Internal: INTEGER; |
InternalHigh: INTEGER; |
Offset: INTEGER; |
OffsetHigh: INTEGER; |
hEvent: INTEGER |
END; |
OFSTRUCT = RECORD |
cBytes: CHAR; |
fFixedDisk: CHAR; |
nErrCode: WCHAR; |
Reserved1: WCHAR; |
Reserved2: WCHAR; |
szPathName: ARRAY OFS_MAXPATHNAME OF CHAR |
END; |
PSecurityAttributes = POINTER TO TSecurityAttributes; |
TSecurityAttributes = RECORD |
nLength: INTEGER; |
lpSecurityDescriptor: INTEGER; |
bInheritHandle: INTEGER |
END; |
TSystemTime = RECORD |
Year, |
Month, |
DayOfWeek, |
Day, |
Hour, |
Min, |
Sec, |
MSec: WCHAR |
END; |
VAR |
hConsoleOutput: INTEGER; |
Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
argc: INTEGER; |
eol*: ARRAY 3 OF CHAR; |
maxreal*: REAL; |
PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
_GetTickCount (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
_GetStdHandle (nStdHandle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
_GetCommandLine (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
_ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
_WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
_CloseHandle (hObject: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] |
_CreateFile ( |
lpFileName, dwDesiredAccess, dwShareMode: INTEGER; |
lpSecurityAttributes: PSecurityAttributes; |
dwCreationDisposition, dwFlagsAndAttributes, |
hTemplateFile: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "OpenFile"] |
_OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] |
_GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] |
_GetSystemTime (T: TSystemTime); |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
_ExitProcess (code: INTEGER); |
PROCEDURE ExitProcess* (code: INTEGER); |
BEGIN |
_ExitProcess(code) |
END ExitProcess; |
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
VAR |
n: INTEGER; |
BEGIN |
n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0])); |
path[n] := slash; |
path[n + 1] := 0X |
END GetCurrentDirectory; |
PROCEDURE GetChar (adr: INTEGER): CHAR; |
VAR |
res: CHAR; |
BEGIN |
SYSTEM.GET(adr, res) |
RETURN res |
END GetChar; |
PROCEDURE ParamParse; |
VAR |
p, count, cond: INTEGER; |
c: CHAR; |
PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR); |
BEGIN |
IF (c <= 20X) & (c # 0X) THEN |
cond := A |
ELSIF c = 22X THEN |
cond := B |
ELSIF c = 0X THEN |
cond := 6 |
ELSE |
cond := C |
END |
END ChangeCond; |
BEGIN |
p := _GetCommandLine(); |
cond := 0; |
count := 0; |
WHILE (count < MAX_PARAM) & (cond # 6) DO |
c := GetChar(p); |
CASE cond OF |
|0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END |
|1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END |
|3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
|4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END |
|5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
|6: |
END; |
INC(p) |
END; |
argc := count |
END ParamParse; |
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
VAR |
i, j, len: INTEGER; |
c: CHAR; |
BEGIN |
j := 0; |
IF n < argc THEN |
len := LEN(s) - 1; |
i := Params[n, 0]; |
WHILE (j < len) & (i <= Params[n, 1]) DO |
c := GetChar(i); |
IF c # 22X THEN |
s[j] := c; |
INC(j) |
END; |
INC(i) |
END |
END; |
s[j] := 0X |
END GetArg; |
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
VAR |
res, n: INTEGER; |
BEGIN |
IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
res := -1 |
ELSE |
res := n |
END |
RETURN res |
END FileRead; |
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
VAR |
res, n: INTEGER; |
BEGIN |
IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
res := -1 |
ELSE |
res := n |
END |
RETURN res |
END FileWrite; |
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) |
END FileCreate; |
PROCEDURE FileClose* (F: INTEGER); |
BEGIN |
_CloseHandle(F) |
END FileClose; |
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
VAR |
ofstr: OFSTRUCT; |
res: INTEGER; |
BEGIN |
res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0); |
IF res = 0FFFFFFFFH THEN |
res := -1 |
END |
RETURN res |
END FileOpen; |
PROCEDURE OutChar* (c: CHAR); |
VAR |
count: INTEGER; |
BEGIN |
_WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL) |
END OutChar; |
PROCEDURE GetTickCount* (): INTEGER; |
RETURN _GetTickCount() DIV 10 |
END GetTickCount; |
PROCEDURE letter (c: CHAR): BOOLEAN; |
RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") |
END letter; |
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; |
RETURN ~(letter(path[0]) & (path[1] = ":")) |
END isRelative; |
PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
VAR |
T: TSystemTime; |
BEGIN |
_GetSystemTime(T); |
year := ORD(T.Year); |
month := ORD(T.Month); |
day := ORD(T.Day); |
hour := ORD(T.Hour); |
min := ORD(T.Min); |
sec := ORD(T.Sec) |
END now; |
PROCEDURE UnixTime* (): INTEGER; |
RETURN 0 |
END UnixTime; |
PROCEDURE d2s* (x: REAL): INTEGER; |
VAR |
h, l, s, e: INTEGER; |
BEGIN |
SYSTEM.GET(SYSTEM.ADR(x), l); |
SYSTEM.GET(SYSTEM.ADR(x) + 4, 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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
a := 0; |
b := 0; |
SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
SYSTEM.GET(SYSTEM.ADR(x), res) |
RETURN res |
END splitf; |
BEGIN |
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
maxreal := 1.9; |
PACK(maxreal, 1023); |
hConsoleOutput := _GetStdHandle(-11); |
ParamParse |
END HOST. |
/programs/develop/oberon07/Lib/Windows64/In.ob07 |
---|
0,0 → 1,295 |
(* |
Copyright 2013, 2017, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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; |
TYPE |
STRING = ARRAY 260 OF CHAR; |
VAR |
Done*: BOOLEAN; |
hConsoleInput: INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
GetStdHandle (nStdHandle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] |
ReadConsole (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
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(VAR res, d: REAL; VAR i: INTEGER; str: STRING): 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(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): 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 scale: INTEGER; VAR res, m: REAL); |
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(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN |
part3(err, minus, scale, res, m) |
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 count, i: INTEGER; str: STRING; |
BEGIN |
ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); |
IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN |
DEC(count, 2) |
END; |
str[256] := 0X; |
str[count] := 0X; |
i := 0; |
WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO |
s[i] := str[i]; |
INC(i) |
END; |
s[i] := 0X; |
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 |
hConsoleInput := GetStdHandle(-10); |
Done := TRUE |
END Open; |
END In. |
/programs/develop/oberon07/Lib/Windows64/Math.ob07 |
---|
0,0 → 1,311 |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
All rights reserved. |
*) |
MODULE Math; |
IMPORT SYSTEM; |
CONST |
e *= 2.71828182845904523; |
pi *= 3.14159265358979324; |
ln2 *= 0.693147180559945309; |
eps = 1.0E-16; |
MaxCosArg = 1000000.0 * pi; |
VAR |
Exp: ARRAY 710 OF REAL; |
PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; |
BEGIN |
ASSERT(x >= 0.0); |
SYSTEM.CODE( |
0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) |
05DH, (* pop rbp *) |
0C2H, 08H, 00H (* ret 8 *) |
) |
RETURN 0.0 |
END sqrt; |
PROCEDURE exp* (x: REAL): REAL; |
CONST |
e25 = 1.284025416687741484; (* exp(0.25) *) |
VAR |
a, s, res: REAL; |
neg: BOOLEAN; |
n: INTEGER; |
BEGIN |
neg := x < 0.0; |
IF neg THEN |
x := -x |
END; |
IF x < FLT(LEN(Exp)) THEN |
res := Exp[FLOOR(x)]; |
x := x - FLT(FLOOR(x)); |
WHILE x >= 0.25 DO |
res := res * e25; |
x := x - 0.25 |
END |
ELSE |
res := SYSTEM.INF(); |
x := 0.0 |
END; |
n := 0; |
a := 1.0; |
s := 1.0; |
REPEAT |
INC(n); |
a := a * x / FLT(n); |
s := s + a |
UNTIL a < eps; |
IF neg THEN |
res := 1.0 / (res * s) |
ELSE |
res := res * s |
END |
RETURN res |
END exp; |
PROCEDURE ln* (x: REAL): REAL; |
VAR |
a, x2, res: REAL; |
n: INTEGER; |
BEGIN |
ASSERT(x > 0.0); |
UNPK(x, n); |
x := (x - 1.0) / (x + 1.0); |
x2 := x * x; |
res := x + FLT(n) * (ln2 * 0.5); |
n := 1; |
REPEAT |
INC(n, 2); |
x := x * x2; |
a := x / FLT(n); |
res := res + a |
UNTIL a < eps |
RETURN res * 2.0 |
END ln; |
PROCEDURE power* (base, exponent: REAL): REAL; |
BEGIN |
ASSERT(base > 0.0) |
RETURN exp(exponent * ln(base)) |
END power; |
PROCEDURE log* (base, x: REAL): REAL; |
BEGIN |
ASSERT(base > 0.0); |
ASSERT(x > 0.0) |
RETURN ln(x) / ln(base) |
END log; |
PROCEDURE cos* (x: REAL): REAL; |
VAR |
a, res: REAL; |
n: INTEGER; |
BEGIN |
x := ABS(x); |
ASSERT(x <= MaxCosArg); |
x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); |
x := x * x; |
res := 0.0; |
a := 1.0; |
n := -1; |
REPEAT |
INC(n, 2); |
res := res + a; |
a := -a * x / FLT(n*n + n) |
UNTIL ABS(a) < eps |
RETURN res |
END cos; |
PROCEDURE sin* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= MaxCosArg); |
x := cos(x) |
RETURN sqrt(1.0 - x * x) |
END sin; |
PROCEDURE tan* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= MaxCosArg); |
x := cos(x) |
RETURN sqrt(1.0 - x * x) / x |
END tan; |
PROCEDURE arcsin* (x: REAL): REAL; |
PROCEDURE arctan (x: REAL): REAL; |
VAR |
z, p, k: REAL; |
BEGIN |
p := x / (x * x + 1.0); |
z := p * x; |
x := 0.0; |
k := 0.0; |
REPEAT |
k := k + 2.0; |
x := x + p; |
p := p * k * z / (k + 1.0) |
UNTIL p < eps |
RETURN x |
END arctan; |
BEGIN |
ASSERT(ABS(x) <= 1.0); |
IF ABS(x) >= 0.707 THEN |
x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) |
ELSE |
x := arctan(x / sqrt(1.0 - x * x)) |
END |
RETURN x |
END arcsin; |
PROCEDURE arccos* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) <= 1.0) |
RETURN 0.5 * pi - arcsin(x) |
END arccos; |
PROCEDURE arctan* (x: REAL): REAL; |
RETURN arcsin(x / sqrt(1.0 + x * x)) |
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 := exp(2.0 * x); |
x := (x - 1.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; |
BEGIN |
ASSERT(x >= 1.0) |
RETURN ln(x + sqrt(x * x - 1.0)) |
END arcosh; |
PROCEDURE artanh* (x: REAL): REAL; |
BEGIN |
ASSERT(ABS(x) < 1.0) |
RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) |
END artanh; |
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 init; |
VAR |
i: INTEGER; |
BEGIN |
Exp[0] := 1.0; |
FOR i := 1 TO LEN(Exp) - 1 DO |
Exp[i] := Exp[i - 1] * e |
END |
END init; |
BEGIN |
init |
END Math. |
/programs/develop/oberon07/Lib/Windows64/Out.ob07 |
---|
0,0 → 1,308 |
(* |
Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
This program is free software: you can redistribute it and/or modify |
it under the terms of the GNU Lesser General Public License as published by |
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 sys := SYSTEM; |
CONST |
d = 1.0 - 5.0E-12; |
TYPE |
POverlapped* = POINTER TO OVERLAPPED; |
OVERLAPPED* = RECORD |
Internal*: INTEGER; |
InternalHigh*: INTEGER; |
Offset*: INTEGER; |
OffsetHigh*: INTEGER; |
hEvent*: INTEGER |
END; |
VAR |
hConsoleOutput: INTEGER; |
Realp: PROCEDURE (x: REAL; width: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
GetStdHandle (nStdHandle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
WriteFile (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] |
WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
PROCEDURE Char*(x: CHAR); |
VAR count: INTEGER; |
BEGIN |
WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) |
END Char; |
PROCEDURE StringW*(s: ARRAY OF WCHAR); |
VAR count: INTEGER; |
BEGIN |
WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) |
END StringW; |
PROCEDURE String*(s: ARRAY OF CHAR); |
VAR len, i: INTEGER; |
BEGIN |
len := LENGTH(s); |
FOR i := 0 TO len - 1 DO |
Char(s[i]) |
END |
END String; |
PROCEDURE WriteInt(x, n: INTEGER); |
VAR i: INTEGER; a: ARRAY 32 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 s: SET; |
BEGIN |
sys.GET(sys.ADR(AValue), s) |
RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {})) |
END IsNan; |
PROCEDURE IsInf(x: REAL): BOOLEAN; |
RETURN ABS(x) = sys.INF() |
END IsInf; |
PROCEDURE Int*(x, width: INTEGER); |
VAR i, minInt: INTEGER; |
BEGIN |
minInt := 1; |
minInt := ROR(minInt, 1); |
IF x # minInt THEN |
WriteInt(x, width) |
ELSE |
FOR i := 21 TO width DO |
Char(20X) |
END; |
String("-9223372036854775808") |
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 |
Realp := Real; |
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; |
_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*; |
BEGIN |
hConsoleOutput := GetStdHandle(-11) |
END Open; |
END Out. |
/programs/develop/oberon07/Lib/Windows64/RTL.ob07 |
---|
0,0 → 1,516 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE RTL; |
IMPORT SYSTEM, API; |
CONST |
bit_depth* = 64; |
maxint* = 7FFFFFFFFFFFFFFFH; |
minint* = 8000000000000000H; |
WORD = bit_depth DIV 8; |
MAX_SET = bit_depth - 1; |
VAR |
name: INTEGER; |
types: INTEGER; |
sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; |
PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) |
048H, 085H, 0C0H, (* test rax, rax *) |
07EH, 020H, (* jle L *) |
0FCH, (* cld *) |
057H, (* push rdi *) |
056H, (* push rsi *) |
048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) |
048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) |
048H, 089H, 0C1H, (* mov rcx, rax *) |
048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *) |
0F3H, 048H, 0A5H, (* rep movsd *) |
048H, 089H, 0C1H, (* mov rcx, rax *) |
048H, 083H, 0E1H, 007H, (* and rcx, 7 *) |
0F3H, 0A4H, (* rep movsb *) |
05EH, (* pop rsi *) |
05FH (* pop rdi *) |
(* L: *) |
) |
END _move; |
PROCEDURE [stdcall64] _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 [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
BEGIN |
_move(MIN(len_dst, len_src) * chr_size, dst, src) |
END _strcpy; |
PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER); |
VAR |
i, n, k: INTEGER; |
BEGIN |
k := LEN(A) - 1; |
n := A[0]; |
i := 0; |
WHILE i < k DO |
A[i] := A[i + 1]; |
INC(i) |
END; |
A[k] := n |
END _rot; |
PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER; |
BEGIN |
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a) |
ELSE |
a := 0 |
END |
RETURN a |
END _set; |
PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *) |
BEGIN |
SYSTEM.CODE( |
048H, 031H, 0C0H, (* xor rax, rax *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *) |
048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *) |
077H, 004H, (* ja L *) |
048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *) |
(* L: *) |
) |
END _set1; |
PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *) |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *) |
048H, 031H, 0D2H, (* xor rdx, rdx *) |
048H, 085H, 0C0H, (* test rax, rax *) |
074H, 022H, (* je L2 *) |
07FH, 003H, (* jg L1 *) |
048H, 0F7H, 0D2H, (* not rdx *) |
(* L1: *) |
049H, 089H, 0C0H, (* mov r8, rax *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *) |
048H, 0F7H, 0F9H, (* idiv rcx *) |
048H, 085H, 0D2H, (* test rdx, rdx *) |
074H, 00EH, (* je L2 *) |
049H, 031H, 0C8H, (* xor r8, rcx *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07DH, 006H, (* jge L2 *) |
048H, 0FFH, 0C8H, (* dec rax *) |
048H, 001H, 0CAH (* add rdx, rcx *) |
(* L2: *) |
) |
END _divmod; |
PROCEDURE [stdcall64] _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 [stdcall64] _dispose* (VAR ptr: INTEGER); |
BEGIN |
IF ptr # 0 THEN |
ptr := API._DISPOSE(ptr - WORD) |
END |
END _dispose; |
PROCEDURE [stdcall64] _length* (len, str: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
048H, 0FFH, 0C8H, (* dec rax *) |
(* L1: *) |
048H, 0FFH, 0C0H, (* inc rax *) |
080H, 038H, 000H, (* cmp byte [rax], 0 *) |
074H, 005H, (* jz L2 *) |
0E2H, 0F6H, (* loop L1 *) |
048H, 0FFH, 0C0H, (* inc rax *) |
(* L2: *) |
048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *) |
) |
END _length; |
PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER); |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
048H, 083H, 0E8H, 002H, (* sub rax, 2 *) |
(* L1: *) |
048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
066H, 083H, 038H, 000H, (* cmp word [rax], 0 *) |
074H, 006H, (* jz L2 *) |
0E2H, 0F4H, (* loop L1 *) |
048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
(* L2: *) |
048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *) |
048H, 0D1H, 0E8H (* shr rax, 1 *) |
) |
END _lengthw; |
PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
04DH, 031H, 0C9H, (* xor r9, r9 *) |
04DH, 031H, 0D2H, (* xor r10, r10 *) |
048H, 0B8H, 000H, 000H, |
000H, 000H, 000H, 000H, |
000H, 080H, (* movabs rax, minint *) |
(* L1: *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07EH, 024H, (* jle L3 *) |
044H, 08AH, 009H, (* mov r9b, byte[rcx] *) |
044H, 08AH, 012H, (* mov r10b, byte[rdx] *) |
048H, 0FFH, 0C1H, (* inc rcx *) |
048H, 0FFH, 0C2H, (* inc rdx *) |
049H, 0FFH, 0C8H, (* dec r8 *) |
04DH, 039H, 0D1H, (* cmp r9, r10 *) |
074H, 008H, (* je L2 *) |
04CH, 089H, 0C8H, (* mov rax, r9 *) |
04CH, 029H, 0D0H, (* sub rax, r10 *) |
0EBH, 008H, (* jmp L3 *) |
(* L2: *) |
04DH, 085H, 0C9H, (* test r9, r9 *) |
075H, 0DAH, (* jne L1 *) |
048H, 031H, 0C0H, (* xor rax, rax *) |
(* L3: *) |
05DH, (* pop rbp *) |
0C2H, 018H, 000H (* ret 24 *) |
) |
RETURN 0 |
END strncmp; |
PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
04DH, 031H, 0C9H, (* xor r9, r9 *) |
04DH, 031H, 0D2H, (* xor r10, r10 *) |
048H, 0B8H, 000H, 000H, |
000H, 000H, 000H, 000H, |
000H, 080H, (* movabs rax, minint *) |
(* L1: *) |
04DH, 085H, 0C0H, (* test r8, r8 *) |
07EH, 028H, (* jle L3 *) |
066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *) |
066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *) |
048H, 083H, 0C1H, 002H, (* add rcx, 2 *) |
048H, 083H, 0C2H, 002H, (* add rdx, 2 *) |
049H, 0FFH, 0C8H, (* dec r8 *) |
04DH, 039H, 0D1H, (* cmp r9, r10 *) |
074H, 008H, (* je L2 *) |
04CH, 089H, 0C8H, (* mov rax, r9 *) |
04CH, 029H, 0D0H, (* sub rax, r10 *) |
0EBH, 008H, (* jmp L3 *) |
(* L2: *) |
04DH, 085H, 0C9H, (* test r9, r9 *) |
075H, 0D6H, (* jne L1 *) |
048H, 031H, 0C0H, (* xor rax, rax *) |
(* L3: *) |
05DH, (* pop rbp *) |
0C2H, 018H, 000H (* ret 24 *) |
) |
RETURN 0 |
END strncmpw; |
PROCEDURE [stdcall64] _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 [stdcall64] _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, b: INTEGER; |
c: CHAR; |
BEGIN |
i := 0; |
REPEAT |
str[i] := CHR(x MOD 10 + ORD("0")); |
x := x DIV 10; |
INC(i) |
UNTIL x = 0; |
a := 0; |
b := i - 1; |
WHILE a < b DO |
c := str[a]; |
str[a] := str[b]; |
str[b] := c; |
INC(a); |
DEC(b) |
END; |
str[i] := 0X |
END IntToStr; |
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
ASSERT(n1 + n2 < LEN(s1)); |
i := 0; |
j := n1; |
WHILE i < n2 DO |
s1[j] := s2[i]; |
INC(i); |
INC(j) |
END; |
s1[j] := 0X |
END append; |
PROCEDURE [stdcall64] _error* (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); |
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
append(s, "line: "); IntToStr(line, temp); append(s, temp); |
API.DebugMsg(SYSTEM.ADR(s[0]), name); |
API.exit_thread(0) |
END _error; |
PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER; |
BEGIN |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _isrec; |
PROCEDURE [stdcall64] _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 [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER; |
BEGIN |
SYSTEM.GET(t0 + t1 + types, t0) |
RETURN t0 MOD 2 |
END _guardrec; |
PROCEDURE [stdcall64] _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 [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
PROCEDURE [stdcall64] _sofinit*; |
BEGIN |
API.sofinit |
END _sofinit; |
PROCEDURE [stdcall64] _exit* (code: INTEGER); |
BEGIN |
API.exit(code) |
END _exit; |
PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
VAR |
t0, t1, i, j: INTEGER; |
BEGIN |
API.init(param, code); |
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
ASSERT(types # 0); |
FOR i := 0 TO tcount - 1 DO |
FOR j := 0 TO tcount - 1 DO |
t0 := i; t1 := j; |
WHILE (t1 # 0) & (t1 # t0) DO |
SYSTEM.GET(_types + t1 * WORD, t1) |
END; |
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
FOR i := 0 TO MAX_SET DO |
FOR j := 0 TO i DO |
sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i) |
END |
END; |
name := modname |
END _init; |
END RTL. |
/programs/develop/oberon07/Lib/Windows64/UnixTime.ob07 |
---|
0,0 → 1,64 |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
All rights reserved. |
*) |
MODULE UnixTime; |
VAR |
days: ARRAY 12, 31, 2 OF INTEGER; |
PROCEDURE init; |
VAR |
i, j, k, n0, n1: INTEGER; |
BEGIN |
FOR i := 0 TO 11 DO |
FOR j := 0 TO 30 DO |
days[i, j, 0] := 0; |
days[i, j, 1] := 0; |
END |
END; |
days[ 1, 28, 0] := -1; |
FOR k := 0 TO 1 DO |
days[ 1, 29, k] := -1; |
days[ 1, 30, k] := -1; |
days[ 3, 30, k] := -1; |
days[ 5, 30, k] := -1; |
days[ 8, 30, k] := -1; |
days[10, 30, k] := -1; |
END; |
n0 := 0; |
n1 := 0; |
FOR i := 0 TO 11 DO |
FOR j := 0 TO 30 DO |
IF days[i, j, 0] = 0 THEN |
days[i, j, 0] := n0; |
INC(n0) |
END; |
IF days[i, j, 1] = 0 THEN |
days[i, j, 1] := n1; |
INC(n1) |
END |
END |
END |
END init; |
PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; |
RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
END time; |
BEGIN |
init |
END UnixTime. |
/programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 |
---|
0,0 → 1,170 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE WINAPI; |
IMPORT SYSTEM, API; |
CONST |
OFS_MAXPATHNAME* = 128; |
TYPE |
DLL_ENTRY* = API.DLL_ENTRY; |
STRING = ARRAY 260 OF CHAR; |
TCoord* = RECORD |
X*, Y*: WCHAR |
END; |
TSmallRect* = RECORD |
Left*, Top*, Right*, Bottom*: WCHAR |
END; |
TConsoleScreenBufferInfo* = RECORD |
dwSize*: TCoord; |
dwCursorPosition*: TCoord; |
wAttributes*: WCHAR; |
srWindow*: TSmallRect; |
dwMaximumWindowSize*: TCoord |
END; |
TSystemTime* = RECORD |
Year*, |
Month*, |
DayOfWeek*, |
Day*, |
Hour*, |
Min*, |
Sec*, |
MSec*: WCHAR |
END; |
PSecurityAttributes* = POINTER TO TSecurityAttributes; |
TSecurityAttributes* = RECORD |
nLength*: INTEGER; |
lpSecurityDescriptor*: INTEGER; |
bInheritHandle*: INTEGER |
END; |
TFileTime* = RECORD |
dwLowDateTime*, |
dwHighDateTime*: INTEGER |
END; |
OFSTRUCT* = RECORD |
cBytes*: CHAR; |
fFixedDisk*: CHAR; |
nErrCode*: WCHAR; |
Reserved1*: WCHAR; |
Reserved2*: WCHAR; |
szPathName*: ARRAY OFS_MAXPATHNAME OF CHAR |
END; |
POverlapped* = POINTER TO OVERLAPPED; |
OVERLAPPED* = RECORD |
Internal*: INTEGER; |
InternalHigh*: INTEGER; |
Offset*: INTEGER; |
OffsetHigh*: INTEGER; |
hEvent*: INTEGER |
END; |
PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] |
SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] |
GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] |
FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] |
FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] |
SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
CloseHandle* (hObject: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
GetCommandLine* (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] |
GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] |
GlobalFree* (hMem: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
ExitProcess* (code: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
GetTickCount* (): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "Sleep"] |
Sleep* (dwMilliseconds: INTEGER); |
PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] |
FreeLibrary* (hLibModule: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] |
GetProcAddress* (hModule, name: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] |
LoadLibraryA* (name: INTEGER): INTEGER; |
PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] |
AllocConsole* (): BOOLEAN; |
PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] |
FreeConsole* (): BOOLEAN; |
PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] |
GetLocalTime* (T: TSystemTime); |
PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
BEGIN |
API.SetDll(process_detach, thread_detach, thread_attach) |
END SetDllEntry; |
END WINAPI. |
/programs/develop/oberon07/Samples/Dialogs.ob07 |
---|
1,4 → 1,4 |
MODULE Dialogs; |
MODULE Dialogs; |
IMPORT KOSAPI, sys := SYSTEM, OpenDlg, ColorDlg; |
/programs/develop/oberon07/Samples/HW.ob07 |
---|
1,4 → 1,4 |
MODULE HW; |
MODULE HW; |
IMPORT sys := SYSTEM, KOSAPI; |
/programs/develop/oberon07/Samples/HW_con.ob07 |
---|
1,4 → 1,4 |
MODULE HW_con; |
MODULE HW_con; |
IMPORT Out, In, Console, DateTime; |
/programs/develop/oberon07/Source/CONSTANTS.ob07 |
---|
File deleted |
/programs/develop/oberon07/Source/AMD64.ob07 |
---|
1,14 → 1,14 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE AMD64; |
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, |
REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86; |
IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, TARGETS, |
REG, C := CONSOLE, UTILS, S := STRINGS, PE32, ELF, X86; |
CONST |
74,25 → 74,25 |
PROCEDURE OutByte2 (a, b: BYTE); |
BEGIN |
OutByte(a); |
OutByte(b) |
X86.OutByte(a); |
X86.OutByte(b) |
END OutByte2; |
PROCEDURE OutByte3 (a, b, c: BYTE); |
BEGIN |
OutByte(a); |
OutByte(b); |
OutByte(c) |
X86.OutByte(a); |
X86.OutByte(b); |
X86.OutByte(c) |
END OutByte3; |
PROCEDURE OutInt (n: INTEGER); |
BEGIN |
OutByte(UTILS.Byte(n, 0)); |
OutByte(UTILS.Byte(n, 1)); |
OutByte(UTILS.Byte(n, 2)); |
OutByte(UTILS.Byte(n, 3)) |
X86.OutByte(n MOD 256); |
X86.OutByte(UTILS.Byte(n, 1)); |
X86.OutByte(UTILS.Byte(n, 2)); |
X86.OutByte(UTILS.Byte(n, 3)) |
END OutInt; |
114,7 → 114,7 |
PROCEDURE OutIntByte (n: INTEGER); |
BEGIN |
IF isByte(n) THEN |
OutByte(UTILS.Byte(n, 0)) |
OutByte(n MOD 256) |
ELSE |
OutInt(n) |
END |
154,12 → 154,12 |
PROCEDURE lea (reg, offset, section: INTEGER); |
BEGIN |
Rex(0, reg); |
OutByte2(8DH, 05H + 8 * (reg MOD 8)); // lea reg, [rip + offset] |
OutByte2(8DH, 05H + 8 * (reg MOD 8)); (* lea reg, [rip + offset] *) |
X86.Reloc(section, offset) |
END lea; |
PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 |
PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *) |
BEGIN |
Rex(reg1, reg2); |
OutByte2(op, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) |
166,7 → 166,7 |
END oprr; |
PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 |
PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *) |
BEGIN |
Rex(reg1, reg2); |
OutByte3(op1, op2, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) |
173,55 → 173,55 |
END oprr2; |
PROCEDURE mov (reg1, reg2: INTEGER); // mov reg1, reg2 |
PROCEDURE mov (reg1, reg2: INTEGER); (* mov reg1, reg2 *) |
BEGIN |
oprr(89H, reg1, reg2) |
END mov; |
PROCEDURE xor (reg1, reg2: INTEGER); // xor reg1, reg2 |
PROCEDURE xor (reg1, reg2: INTEGER); (* xor reg1, reg2 *) |
BEGIN |
oprr(31H, reg1, reg2) |
END xor; |
PROCEDURE and (reg1, reg2: INTEGER); // and reg1, reg2 |
PROCEDURE and (reg1, reg2: INTEGER); (* and reg1, reg2 *) |
BEGIN |
oprr(21H, reg1, reg2) |
END and; |
PROCEDURE or (reg1, reg2: INTEGER); // and reg1, reg2 |
PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *) |
BEGIN |
oprr(09H, reg1, reg2) |
END or; |
PROCEDURE add (reg1, reg2: INTEGER); // add reg1, reg2 |
PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *) |
BEGIN |
oprr(01H, reg1, reg2) |
END add; |
PROCEDURE sub (reg1, reg2: INTEGER); // sub reg1, reg2 |
PROCEDURE sub (reg1, reg2: INTEGER); (* sub reg1, reg2 *) |
BEGIN |
oprr(29H, reg1, reg2) |
END sub; |
PROCEDURE xchg (reg1, reg2: INTEGER); // xchg reg1, reg2 |
PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *) |
BEGIN |
oprr(87H, reg1, reg2) |
END xchg; |
PROCEDURE cmprr (reg1, reg2: INTEGER); // cmp reg1, reg2 |
PROCEDURE cmprr (reg1, reg2: INTEGER); (* cmp reg1, reg2 *) |
BEGIN |
oprr(39H, reg1, reg2) |
END cmprr; |
PROCEDURE pop (reg: INTEGER); // pop reg |
PROCEDURE pop (reg: INTEGER); (* pop reg *) |
BEGIN |
IF reg >= 8 THEN |
OutByte(41H) |
230,7 → 230,7 |
END pop; |
PROCEDURE push (reg: INTEGER); // push reg |
PROCEDURE push (reg: INTEGER); (* push reg *) |
BEGIN |
IF reg >= 8 THEN |
OutByte(41H) |
242,7 → 242,7 |
PROCEDURE decr (reg: INTEGER); |
BEGIN |
Rex(reg, 0); |
OutByte2(0FFH, 0C8H + reg MOD 8) // dec reg1 |
OutByte2(0FFH, 0C8H + reg MOD 8) (* dec reg1 *) |
END decr; |
249,7 → 249,7 |
PROCEDURE incr (reg: INTEGER); |
BEGIN |
Rex(reg, 0); |
OutByte2(0FFH, 0C0H + reg MOD 8) // inc reg1 |
OutByte2(0FFH, 0C0H + reg MOD 8) (* inc reg1 *) |
END incr; |
276,7 → 276,7 |
BEGIN |
reg := GetAnyReg(); |
lea(reg, label, sIMP); |
IF reg >= 8 THEN // call qword[reg] |
IF reg >= 8 THEN (* call qword[reg] *) |
OutByte(41H) |
END; |
OutByte2(0FFH, 10H + reg MOD 8); |
337,7 → 337,7 |
BEGIN |
Rex(reg, 0); |
OutByte(0B8H + reg MOD 8); // movabs reg, n |
OutByte(0B8H + reg MOD 8); (* movabs reg, n *) |
FOR i := 0 TO 7 DO |
OutByte(UTILS.Byte(n, i)) |
END |
344,7 → 344,7 |
END movabs; |
PROCEDURE movrc (reg, n: INTEGER); // mov reg, n |
PROCEDURE movrc (reg, n: INTEGER); (* mov reg, n *) |
BEGIN |
IF isLong(n) THEN |
movabs(reg, n) |
358,7 → 358,7 |
END movrc; |
PROCEDURE test (reg: INTEGER); // test reg, reg |
PROCEDURE test (reg: INTEGER); (* test reg, reg *) |
BEGIN |
oprr(85H, reg, reg) |
END test; |
370,6 → 370,7 |
BEGIN |
reg2 := GetAnyReg(); |
ASSERT(reg2 # reg); |
movabs(reg2, n); |
oprr(reg, reg2); |
drop |
388,30 → 389,46 |
END oprc; |
PROCEDURE cmprc (reg, n: INTEGER); // cmp reg, n |
PROCEDURE cmprc (reg, n: INTEGER); (* cmp reg, n *) |
BEGIN |
IF n = 0 THEN |
test(reg) |
ELSE |
oprc(0F8H, reg, n, cmprr) |
END |
END cmprc; |
PROCEDURE addrc (reg, n: INTEGER); // add reg, n |
PROCEDURE addrc (reg, n: INTEGER); (* add reg, n *) |
BEGIN |
oprc(0C0H, reg, n, add) |
END addrc; |
PROCEDURE subrc (reg, n: INTEGER); // sub reg, n |
PROCEDURE subrc (reg, n: INTEGER); (* sub reg, n *) |
BEGIN |
oprc(0E8H, reg, n, sub) |
END subrc; |
PROCEDURE andrc (reg, n: INTEGER); // and reg, n |
PROCEDURE andrc (reg, n: INTEGER); (* and reg, n *) |
BEGIN |
oprc(0E0H, reg, n, and) |
END andrc; |
PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *) |
BEGIN |
oprc(0C8H, reg, n, or) |
END orrc; |
PROCEDURE xorrc (reg, n: INTEGER); (* xor reg, n *) |
BEGIN |
oprc(0F0H, reg, n, xor) |
END xorrc; |
PROCEDURE pushc (n: INTEGER); |
VAR |
reg2: INTEGER; |
423,12 → 440,12 |
push(reg2); |
drop |
ELSE |
OutByte(68H + short(n)); OutIntByte(n) // push n |
OutByte(68H + short(n)); OutIntByte(n) (* push n *) |
END |
END pushc; |
PROCEDURE not (reg: INTEGER); // not reg |
PROCEDURE not (reg: INTEGER); (* not reg *) |
BEGIN |
Rex(reg, 0); |
OutByte2(0F7H, 0D0H + reg MOD 8) |
435,7 → 452,7 |
END not; |
PROCEDURE neg (reg: INTEGER); // neg reg |
PROCEDURE neg (reg: INTEGER); (* neg reg *) |
BEGIN |
Rex(reg, 0); |
OutByte2(0F7H, 0D8H + reg MOD 8) |
442,129 → 459,39 |
END neg; |
PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); // movzx reg1, byte/word[reg2 + offs] |
VAR |
b: BYTE; |
PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *) |
BEGIN |
Rex(reg2, reg1); |
OutByte2(0FH, 0B6H + ORD(word)); |
IF (offs = 0) & (reg2 # rbp) THEN |
b := 0 |
ELSE |
b := 40H + long(offs) |
END; |
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); |
IF reg2 = rsp THEN |
OutByte(24H) |
END; |
IF b # 0 THEN |
OutIntByte(offs) |
END |
X86.movzx(reg1, reg2, offs, word) |
END movzx; |
PROCEDURE _movrm (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN); |
VAR |
b: BYTE; |
PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_32 *) |
BEGIN |
IF size = 16 THEN |
OutByte(66H) |
END; |
IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN |
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64)) |
END; |
OutByte(8BH - 2 * ORD(mr) - ORD(size = 8)); |
IF (offs = 0) & (reg2 # rbp) THEN |
b := 0 |
ELSE |
b := 40H + long(offs) |
END; |
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); |
IF reg2 = rsp THEN |
OutByte(24H) |
END; |
IF b # 0 THEN |
OutIntByte(offs) |
END |
END _movrm; |
PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); // mov dword[reg1+offs], reg2_32 |
BEGIN |
_movrm(reg2, reg1, offs, 32, TRUE) |
X86._movrm(reg2, reg1, offs, 32, TRUE) |
END movmr32; |
PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); // mov reg1_32, dword[reg2+offs] |
PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); (* mov reg1_32, dword[reg2+offs] *) |
BEGIN |
_movrm(reg1, reg2, offs, 32, FALSE) |
X86._movrm(reg1, reg2, offs, 32, FALSE) |
END movrm32; |
PROCEDURE movmr8 (reg1, offs, reg2: INTEGER); // mov byte[reg1+offs], reg2_8 |
PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov qword[reg1+offs], reg2 *) |
BEGIN |
_movrm(reg2, reg1, offs, 8, TRUE) |
END movmr8; |
PROCEDURE movrm8 (reg1, reg2, offs: INTEGER); // mov reg1_8, byte[reg2+offs] |
BEGIN |
_movrm(reg1, reg2, offs, 8, FALSE) |
END movrm8; |
PROCEDURE movmr16 (reg1, offs, reg2: INTEGER); // mov word[reg1+offs], reg2_16 |
BEGIN |
_movrm(reg2, reg1, offs, 16, TRUE) |
END movmr16; |
PROCEDURE movrm16 (reg1, reg2, offs: INTEGER); // mov reg1_16, word[reg2+offs] |
BEGIN |
_movrm(reg1, reg2, offs, 16, FALSE) |
END movrm16; |
PROCEDURE movmr (reg1, offs, reg2: INTEGER); // mov qword[reg1+offs], reg2 |
BEGIN |
_movrm(reg2, reg1, offs, 64, TRUE) |
X86._movrm(reg2, reg1, offs, 64, TRUE) |
END movmr; |
PROCEDURE movrm (reg1, reg2, offs: INTEGER); // mov reg1, qword[reg2+offs] |
PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, qword[reg2+offs] *) |
BEGIN |
_movrm(reg1, reg2, offs, 64, FALSE) |
X86._movrm(reg1, reg2, offs, 64, FALSE) |
END movrm; |
PROCEDURE pushm (reg, offs: INTEGER); // push qword[reg+offs] |
VAR |
b: BYTE; |
PROCEDURE comisd (xmm1, xmm2: INTEGER); (* comisd xmm1, xmm2 *) |
BEGIN |
IF reg >= 8 THEN |
OutByte(41H) |
END; |
OutByte(0FFH); |
IF (offs = 0) & (reg # rbp) THEN |
b := 30H |
ELSE |
b := 70H + long(offs) |
END; |
OutByte(b + reg MOD 8); |
IF reg = rsp THEN |
OutByte(24H) |
END; |
IF b # 30H THEN |
OutIntByte(offs) |
END |
END pushm; |
PROCEDURE comisd (xmm1, xmm2: INTEGER); // comisd xmm1, xmm2 |
BEGIN |
OutByte(66H); |
IF (xmm1 >= 8) OR (xmm2 >= 8) THEN |
OutByte(40H + (xmm1 DIV 8) * 4 + xmm2 DIV 8) |
598,13 → 525,13 |
END _movsdrm; |
PROCEDURE movsdrm (xmm, reg, offs: INTEGER); // movsd xmm, qword[reg+offs] |
PROCEDURE movsdrm (xmm, reg, offs: INTEGER); (* movsd xmm, qword[reg+offs] *) |
BEGIN |
_movsdrm(xmm, reg, offs, FALSE) |
END movsdrm; |
PROCEDURE movsdmr (reg, offs, xmm: INTEGER); // movsd qword[reg+offs], xmm |
PROCEDURE movsdmr (reg, offs, xmm: INTEGER); (* movsd qword[reg+offs], xmm *) |
BEGIN |
_movsdrm(xmm, reg, offs, TRUE) |
END movsdmr; |
620,19 → 547,19 |
END opxx; |
PROCEDURE jcc (cc, label: INTEGER); // jcc label |
PROCEDURE jcc (cc, label: INTEGER); (* jcc label *) |
BEGIN |
X86.jcc(cc, label) |
END jcc; |
PROCEDURE jmp (label: INTEGER); // jmp label |
PROCEDURE jmp (label: INTEGER); (* jmp label *) |
BEGIN |
X86.jmp(label) |
END jmp; |
PROCEDURE setcc (cc, reg: INTEGER); //setcc reg8 |
PROCEDURE setcc (cc, reg: INTEGER); (* setcc reg8 *) |
BEGIN |
IF reg >= 8 THEN |
OutByte(41H) |
680,7 → 607,6 |
reg: INTEGER; |
max: INTEGER; |
loop: INTEGER; |
param2: INTEGER; |
BEGIN |
loop := 1; |
756,17 → 682,7 |
leaf := FALSE |
|IL.opDIVR, IL.opMODR: |
param2 := cur.param2; |
IF param2 >= 1 THEN |
param2 := UTILS.Log2(param2) |
ELSIF param2 <= -1 THEN |
param2 := UTILS.Log2(-param2) |
ELSE |
param2 := -1 |
END; |
IF param2 < 0 THEN |
leaf := FALSE |
END |
leaf := UTILS.Log2(cur.param2) >= 0 |
ELSE |
912,9 → 828,9 |
comisd(xmm - 1, xmm); |
cc := setnc |
END; |
OutByte2(7AH, 3 + reg DIV 8); // jp L |
OutByte2(7AH, 3 + reg DIV 8); (* jp L *) |
setcc(cc, reg); |
//L: |
(* L: *) |
END fcmp; |
969,7 → 885,7 |
|IL.opWIN64CALLP: Win64Passing(param2) |
|IL.opSYSVCALLP: SysVPassing(param2) |
END; |
OutByte2(0FFH, 0D0H); // call rax |
OutByte2(0FFH, 0D0H); (* call rax *) |
REG.Restore(R); |
ASSERT(R.top = -1) |
989,6 → 905,10 |
|IL.opERR: |
CallRTL(IL._error) |
|IL.opONERR: |
pushc(param2); |
jmp(param1) |
|IL.opPUSHC: |
pushc(param2) |
1117,9 → 1037,9 |
n := param2; |
IF n > 4 THEN |
movrc(rcx, n); |
// L: |
(* L: *) |
pushc(0); |
OutByte2(0E2H, 0FCH) // loop L |
OutByte2(0E2H, 0FCH) (* loop L *) |
ELSE |
WHILE n > 0 DO |
pushc(0); |
1156,9 → 1076,9 |
pop(rbp); |
IF param2 > 0 THEN |
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2 |
OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) (* ret param2 *) |
ELSE |
OutByte(0C3H) // ret |
X86.ret |
END; |
REG.Reset(R) |
1265,7 → 1185,7 |
|IL.opLADR: |
n := param2 * 8; |
next := cmd.next(COMMAND); |
IF next.opcode = IL.opSAVEF THEN |
IF (next.opcode = IL.opSAVEF) OR (next.opcode = IL.opSAVEFI) THEN |
movsdmr(rbp, n, xmm); |
DEC(xmm); |
cmd := next |
1276,7 → 1196,7 |
ELSE |
reg1 := GetAnyReg(); |
Rex(0, reg1); |
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n] |
OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); (* lea reg1, qword[rbp+n] *) |
OutIntByte(n) |
END |
1291,7 → 1211,7 |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2 |
OutByte3(0C6H, reg1 MOD 8, param2); (* mov byte[reg1], param2 *) |
drop |
|IL.opSAVE16C: |
1301,7 → 1221,7 |
OutByte(41H) |
END; |
OutByte2(0C7H, reg1 MOD 8); |
OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2 |
OutByte2(param2 MOD 256, param2 DIV 256); (* mov word[reg1], param2 *) |
drop |
|IL.opSAVEC: |
1313,7 → 1233,7 |
drop |
ELSE |
Rex(reg1, 0); |
OutByte2(0C7H, reg1 MOD 8); // mov qword[reg1], param2 |
OutByte2(0C7H, reg1 MOD 8); (* mov qword[reg1], param2 *) |
OutInt(param2) |
END; |
drop |
1346,10 → 1266,10 |
|IL.opINCL, IL.opEXCL: |
BinOp(reg1, reg2); |
cmprc(reg1, 64); |
OutByte2(73H, 04H); // jnb L |
OutByte2(73H, 04H); (* jnb L *) |
Rex(reg2, reg1); |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 |
// L: |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); (* bts/btr qword[reg2], reg1 *) |
(* L: *) |
drop; |
drop |
1356,7 → 1276,7 |
|IL.opINCLC, IL.opEXCLC: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2 |
OutByte2(0FH, 0BAH); (* bts/btr qword[reg1], param2 *) |
OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2); |
drop |
1384,26 → 1304,19 |
drop |
ELSE |
UnOp(reg1); |
IF param2 = 0 THEN |
test(reg1) |
ELSE |
cmprc(reg1, param2) |
END |
END; |
drop; |
cc := X86.cond(opcode); |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(X86.inv0(cc), label); |
cmd := cmd.next(COMMAND) |
next := cmd.next(COMMAND); |
IF next.opcode = IL.opJE THEN |
jcc(cc, next.param1); |
cmd := next |
ELSIF next.opcode = IL.opJNE THEN |
jcc(X86.inv0(cc), next.param1); |
cmd := next |
ELSE |
reg1 := GetAnyReg(); |
setcc(cc + 16, reg1); |
1447,6 → 1360,11 |
test(reg1); |
jcc(je, param1) |
|IL.opJG: |
UnOp(reg1); |
test(reg1); |
jcc(jg, param1) |
|IL.opJE: |
UnOp(reg1); |
test(reg1); |
1459,7 → 1377,11 |
jcc(je, param1); |
drop |
|IL.opIN: |
|IL.opIN, IL.opINR: |
IF opcode = IL.opINR THEN |
reg2 := GetAnyReg(); |
movrc(reg2, param2) |
END; |
label := NewLabel(); |
L := NewLabel(); |
BinOp(reg1, reg2); |
1469,34 → 1391,16 |
jmp(label); |
X86.SetLabel(L); |
Rex(reg2, reg1); |
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 |
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); (* bt reg2, reg1 *) |
setcc(setc, reg1); |
andrc(reg1, 1); |
X86.SetLabel(label); |
drop |
|IL.opINR: |
label := NewLabel(); |
L := NewLabel(); |
UnOp(reg1); |
reg2 := GetAnyReg(); |
cmprc(reg1, 64); |
jcc(jb, L); |
xor(reg1, reg1); |
jmp(label); |
X86.SetLabel(L); |
movrc(reg2, param2); |
Rex(reg2, reg1); |
OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 |
setcc(setc, reg1); |
andrc(reg1, 1); |
X86.SetLabel(label); |
drop |
|IL.opINL: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(0FH, 0BAH); // bt reg1, param2 |
OutByte2(0FH, 0BAH); (* bt reg1, param2 *) |
OutByte2(0E0H + reg1 MOD 8, param2); |
setcc(setc, reg1); |
andrc(reg1, 1) |
1516,9 → 1420,9 |
|IL.opABS: |
UnOp(reg1); |
test(reg1); |
OutByte2(7DH, 03H); // jge L |
OutByte2(7DH, 03H); (* jge L *) |
neg(reg1) |
// L: |
(* L: *) |
|IL.opEQB, IL.opNEB: |
BinOp(reg1, reg2); |
1545,12 → 1449,14 |
UnOp(reg1); |
andrc(reg1, param2) |
|IL.opDIVSC, IL.opADDSL, IL.opADDSR: |
|IL.opDIVSC: |
UnOp(reg1); |
Rex(reg1, 0); |
OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 |
OutIntByte(param2) |
xorrc(reg1, param2) |
|IL.opADDSL, IL.opADDSR: |
UnOp(reg1); |
orrc(reg1, param2) |
|IL.opSUBSL: |
UnOp(reg1); |
not(reg1); |
1646,7 → 1552,7 |
|IL.opTYPEGD: |
UnOp(reg1); |
PushAll(0); |
pushm(reg1, -8); |
X86.pushm(reg1, -8); |
pushc(param2 * tcount); |
CallRTL(IL._guardrec); |
GetRegA |
1673,7 → 1579,7 |
|IL.opINC, IL.opDEC: |
BinOp(reg1, reg2); |
// add/sub qword[reg2], reg1 |
(* add/sub qword[reg2], reg1 *) |
Rex(reg2, reg1); |
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); |
drop; |
1684,15 → 1590,15 |
IF isLong(param2) THEN |
reg2 := GetAnyReg(); |
movrc(reg2, param2); |
// add qword[reg1], reg2 |
(* add qword[reg1], reg2 *) |
Rex(reg1, reg2); |
OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8); |
drop |
ELSIF ABS(param2) = 1 THEN |
Rex(reg1, 0); |
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1] |
OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) (* inc/dec qword[reg1] *) |
ELSE |
// add qword[reg1], param2 |
(* add qword[reg1], param2 *) |
Rex(reg1, 0); |
OutByte2(81H + short(param2), reg1 MOD 8); |
OutIntByte(param2) |
1711,13 → 1617,13 |
|IL.opSAVE8: |
BinOp(reg2, reg1); |
movmr8(reg1, 0, reg2); |
X86.movmr8(reg1, 0, reg2); |
drop; |
drop |
|IL.opSAVE16: |
BinOp(reg2, reg1); |
movmr16(reg1, 0, reg2); |
X86.movmr16(reg1, 0, reg2); |
drop; |
drop |
1727,38 → 1633,27 |
drop; |
drop |
|IL.opMIN: |
|IL.opMAX, IL.opMIN: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(7EH, 3); // jle L |
OutByte2(7DH + ORD(opcode = IL.opMIN), 3); (* jge/jle L *) |
mov(reg1, reg2); |
// L: |
(* L: *) |
drop |
|IL.opMAX: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(7DH, 3); // jge L |
mov(reg1, reg2); |
// L: |
drop |
|IL.opMINC: |
|IL.opMAXC, IL.opMINC: |
UnOp(reg1); |
cmprc(reg1, param2); |
label := NewLabel(); |
jcc(jle, label); |
IF opcode = IL.opMINC THEN |
cc := jle |
ELSE |
cc := jge |
END; |
jcc(cc, label); |
movrc(reg1, param2); |
X86.SetLabel(label) |
|IL.opMAXC: |
UnOp(reg1); |
cmprc(reg1, param2); |
label := NewLabel(); |
jcc(jge, label); |
movrc(reg1, param2); |
X86.SetLabel(label) |
|IL.opSBOOL: |
BinOp(reg2, reg1); |
test(reg2); |
1765,7 → 1660,7 |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1] |
OutByte3(0FH, 95H, reg1 MOD 8); (* setne byte[reg1] *) |
drop; |
drop |
1774,13 → 1669,9 |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1 |
OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *) |
drop |
|IL.opODD: |
UnOp(reg1); |
andrc(reg1, 1) |
|IL.opUMINUS: |
UnOp(reg1); |
neg(reg1) |
1810,8 → 1701,29 |
END |
|IL.opADDL, IL.opADDR: |
IF param2 # 0 THEN |
IF (param2 # 0) & ~isLong(param2) THEN |
UnOp(reg1); |
next := cmd.next(COMMAND); |
CASE next.opcode OF |
|IL.opLOAD64: |
movrm(reg1, reg1, param2); |
cmd := next |
|IL.opLOAD32: |
movrm32(reg1, reg1, param2); |
shiftrc(shl, reg1, 32); |
shiftrc(shr, reg1, 32); |
cmd := next |
|IL.opLOAD16: |
movzx(reg1, reg1, param2, TRUE); |
cmd := next |
|IL.opLOAD8: |
movzx(reg1, reg1, param2, FALSE); |
cmd := next |
|IL.opLOAD64_PARAM: |
X86.pushm(reg1, param2); |
drop; |
cmd := next |
ELSE |
IF param2 = 1 THEN |
incr(reg1) |
ELSIF param2 = -1 THEN |
1820,6 → 1732,9 |
addrc(reg1, param2) |
END |
END |
ELSIF isLong(param2) THEN |
addrc(reg1, param2) |
END |
|IL.opDIV: |
PushAll(2); |
1827,41 → 1742,16 |
GetRegA |
|IL.opDIVR: |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF a = 1 THEN |
ELSIF a = -1 THEN |
UnOp(reg1); |
neg(reg1) |
ELSE |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(reg1); |
IF a < 0 THEN |
reg2 := GetAnyReg(); |
mov(reg2, reg1); |
shiftrc(sar, reg1, n); |
sub(reg1, reg2); |
drop |
ELSE |
shiftrc(sar, reg1, n) |
END |
ELSE |
ELSIF n < 0 THEN |
PushAll(1); |
pushc(param2); |
CallRTL(IL._divmod); |
GetRegA |
END |
END |
|IL.opDIVL: |
UnOp(reg1); |
1879,39 → 1769,20 |
GetRegA |
|IL.opMODR: |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF ABS(a) = 1 THEN |
UnOp(reg1); |
xor(reg1, reg1) |
ELSE |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(reg1); |
andrc(reg1, ABS(a) - 1); |
IF a < 0 THEN |
test(reg1); |
label := NewLabel(); |
jcc(je, label); |
addrc(reg1, a); |
X86.SetLabel(label) |
END |
ELSE |
andrc(reg1, param2 - 1); |
ELSIF n < 0 THEN |
PushAll(1); |
pushc(param2); |
CallRTL(IL._divmod); |
mov(rax, rdx); |
GetRegA |
ELSE |
UnOp(reg1); |
xor(reg1, reg1) |
END |
END |
|IL.opMODL: |
UnOp(reg1); |
1925,10 → 1796,19 |
|IL.opMUL: |
BinOp(reg1, reg2); |
oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2 |
oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *) |
drop |
|IL.opMULC: |
IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN |
BinOp(reg1, reg2); |
OutByte2(48H + 5 * (reg1 DIV 8) + 2 * (reg2 DIV 8), 8DH); (* lea reg1, [reg1 + reg2 * param2] *) |
reg1 := reg1 MOD 8; |
reg2 := reg2 MOD 8; |
OutByte2(04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2)); |
drop; |
cmd := cmd.next(COMMAND) |
ELSE |
UnOp(reg1); |
a := param2; |
1953,12 → 1833,21 |
END; |
shiftrc(shl, reg1, n) |
ELSE |
// imul reg1, a |
IF isLong(a) THEN |
reg2 := GetAnyReg(); |
movabs(reg2, a); |
ASSERT(reg1 # reg2); |
oprr2(0FH, 0AFH, reg2, reg1); (* imul reg1, reg2 *) |
drop |
ELSE |
(* imul reg1, a *) |
Rex(reg1, reg1); |
OutByte2(69H + short(a), 0C0H + (reg1 MOD 8) * 9); |
OutIntByte(a) |
END |
END |
END |
END |
|IL.opADDS: |
BinOp(reg1, reg2); |
1990,17 → 1879,23 |
|IL.opENDSW: |
|IL.opCASEL: |
GetRegA; |
cmprc(rax, param1); |
jcc(jl, param2) |
jcc(jl, param2); |
drop |
|IL.opCASER: |
GetRegA; |
cmprc(rax, param1); |
jcc(jg, param2) |
jcc(jg, param2); |
drop |
|IL.opCASELR: |
GetRegA; |
cmprc(rax, param1); |
jcc(jl, param2); |
jcc(jg, cmd.param3) |
jcc(jg, cmd.param3); |
drop |
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: |
BinOp(reg1, reg2); |
2007,7 → 1902,7 |
xchg(reg2, rcx); |
Rex(reg1, 0); |
OutByte(0D3H); |
X86.shift(opcode, reg1 MOD 8); // shift reg1, cl |
X86.shift(opcode, reg1 MOD 8); (* shift reg1, cl *) |
xchg(reg2, rcx); |
drop |
2018,7 → 1913,7 |
xchg(reg1, rcx); |
Rex(reg2, 0); |
OutByte(0D3H); |
X86.shift(opcode, reg2 MOD 8); // shift reg2, cl |
X86.shift(opcode, reg2 MOD 8); (* shift reg2, cl *) |
xchg(reg1, rcx); |
drop; |
drop; |
2038,8 → 1933,8 |
END; |
drop; |
drop; |
_movrm(reg1, reg1, 0, param2 * 8, FALSE); |
_movrm(reg1, reg2, 0, param2 * 8, TRUE) |
X86._movrm(reg1, reg1, 0, param2 * 8, FALSE); |
X86._movrm(reg1, reg2, 0, param2 * 8, TRUE) |
|IL.opCHKBYTE: |
BinOp(reg1, reg2); |
2055,14 → 1950,11 |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
cmprr(reg2, reg1); |
mov(reg1, reg2); |
drop; |
jcc(jb, param1) |
ELSE |
jcc(jb, param1); |
END; |
INCL(R.regs, reg1); |
DEC(R.top); |
R.stk[R.top] := reg2 |
END |
|IL.opLENGTH: |
PushAll(2); |
2127,7 → 2019,7 |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); (* add/sub byte[reg1], param2 MOD 256 *) |
drop |
|IL.opINCB, IL.opDECB: |
2135,7 → 2027,7 |
IF (reg1 >= 8) OR (reg2 >= 8) THEN |
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8)) |
END; |
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 |
OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); (* add/sub byte[reg2], reg1_8 *) |
drop; |
drop |
2149,7 → 2041,7 |
IF reg1 >= 8 THEN |
OutByte(41H) |
END; |
OutByte2(8FH, reg1 MOD 8); // pop qword[reg1] |
OutByte2(8FH, reg1 MOD 8); (* pop qword[reg1] *) |
drop |
|IL.opCLEANUP: |
2181,7 → 2073,7 |
drop; |
NewNumber(UTILS.splitf(float, a, b)) |
|IL.opSAVEF: |
|IL.opSAVEF, IL.opSAVEFI: |
UnOp(reg1); |
movsdmr(reg1, 0, xmm); |
DEC(xmm); |
2216,7 → 2108,7 |
|IL.opUMINF: |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs, sDATA); |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1] |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* xorpd xmm, xmmword[reg1] *) |
OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8); |
drop |
2223,7 → 2115,7 |
|IL.opFABS: |
reg1 := GetAnyReg(); |
lea(reg1, Numbers_Offs + 16, sDATA); |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1] |
OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* andpd xmm, xmmword[reg1] *) |
OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8); |
drop |
2230,7 → 2122,7 |
|IL.opFLT: |
UnOp(reg1); |
INC(xmm); |
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1 |
OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); (* cvtsi2sd xmm, reg1 *) |
OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); |
drop |
2237,14 → 2129,14 |
|IL.opFLOOR: |
reg1 := GetAnyReg(); |
subrc(rsp, 8); |
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4]; |
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp]; |
OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); // and dword[rsp],11111111111111111001111111111111b; |
OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); // or dword[rsp],00000000000000000010000000000000b; |
OutByte2(00FH, 0AEH); OutByte2(014H, 024H); // ldmxcsr dword[rsp]; |
OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); // cvtsd2si reg1, xmm |
OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); (* stmxcsr dword[rsp+4]; *) |
OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); (* stmxcsr dword[rsp]; *) |
OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); (* and dword[rsp],11111111111111111001111111111111b; *) |
OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); (* or dword[rsp],00000000000000000010000000000000b; *) |
OutByte2(00FH, 0AEH); OutByte2(014H, 024H); (* ldmxcsr dword[rsp]; *) |
OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); (* cvtsd2si reg1, xmm *) |
OutByte2(2DH, 0C0H + xmm MOD 8 + (reg1 MOD 8) * 8); |
OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); // ldmxcsr dword[rsp+4]; |
OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); (* ldmxcsr dword[rsp+4]; *) |
addrc(rsp, 8); |
DEC(xmm) |
2278,7 → 2170,7 |
movrm(reg2, reg2, 0); |
push(reg1); |
lea(reg1, Numbers_Offs + 40, sDATA); // {0..51, 63} |
lea(reg1, Numbers_Offs + 40, sDATA); (* {0..51, 63} *) |
movrm(reg1, reg1, 0); |
and(reg2, reg1); |
pop(reg1); |
2299,7 → 2191,7 |
IF ~regVar THEN |
reg2 := GetAnyReg(); |
Rex(0, reg2); |
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n] |
OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); (* lea reg2, qword[rbp+n] *) |
OutIntByte(n) |
END |
ELSE |
2324,7 → 2216,7 |
movrm(reg1, reg2, 0); |
push(reg2); |
lea(reg2, Numbers_Offs + 48, sDATA); // {52..61} |
lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *) |
movrm(reg2, reg2, 0); |
or(reg1, reg2); |
pop(reg2); |
2331,7 → 2223,7 |
Rex(reg1, 0); |
OutByte2(0FH, 0BAH); |
OutByte2(0F0H + reg1 MOD 8, 3EH); // btr reg1, 62 |
OutByte2(0F0H + reg1 MOD 8, 3EH); (* btr reg1, 62 *) |
movmr(reg2, 0, reg1); |
drop; |
drop |
2340,11 → 2232,11 |
pushDA(stroffs + param2) |
|IL.opVADR_PARAM: |
pushm(rbp, param2 * 8) |
X86.pushm(rbp, param2 * 8) |
|IL.opLOAD64_PARAM: |
UnOp(reg1); |
pushm(reg1, 0); |
X86.pushm(reg1, 0); |
drop |
|IL.opLLOAD64_PARAM: |
2352,7 → 2244,7 |
IF reg1 # -1 THEN |
push(reg1) |
ELSE |
pushm(rbp, param2 * 8) |
X86.pushm(rbp, param2 * 8) |
END |
|IL.opGLOAD64_PARAM: |
2405,7 → 2297,7 |
movmr(rbp, n, reg2); |
drop |
ELSE |
OutByte3(48H, 0C7H, 45H + long(n)); // mov qword[rbp+n],param2 |
OutByte3(48H, 0C7H, 45H + long(n)); (* mov qword[rbp+n], param2 *) |
OutIntByte(n); |
OutInt(param2) |
END |
2424,7 → 2316,7 |
reg2 := GetAnyReg(); |
lea(reg2, param1, sBSS); |
Rex(reg2, 0); |
OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2 |
OutByte2(0C7H, reg2 MOD 8); (* mov qword[reg2], param2 *) |
OutInt(param2); |
drop |
END |
2450,7 → 2342,7 |
n := param1 * 8; |
Rex(0, reg2); |
OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8); |
OutIntByte(n) // add qword[rbp+n],reg2 |
OutIntByte(n) (* add qword[rbp+n], reg2 *) |
END; |
drop |
ELSIF ABS(param2) = 1 THEN |
2462,7 → 2354,7 |
END |
ELSE |
n := param1 * 8; |
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n] |
OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec qword[rbp+n] *) |
OutIntByte(n) |
END |
ELSE |
2472,7 → 2364,7 |
n := param1 * 8; |
OutByte3(48H, 81H + short(param2), 45H + long(n)); |
OutIntByte(n); |
OutIntByte(param2) // add qword[rbp+n],param2 |
OutIntByte(param2) (* add qword[rbp+n], param2 *) |
END |
END |
2490,7 → 2382,7 |
n := param1 * 8; |
OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB)); |
OutIntByte(n); |
OutByte(param2) // add/sub byte[rbp+n],param2 |
OutByte(param2) (* add/sub byte[rbp+n], param2 *) |
END |
|IL.opLADR_INC, IL.opLADR_DEC: |
2506,7 → 2398,7 |
n := param2 * 8; |
Rex(0, reg1); |
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); |
OutIntByte(n) // add/sub qword[rbp+n],reg1 |
OutIntByte(n) (* add/sub qword[rbp+n], reg1 *) |
END; |
drop |
2526,7 → 2418,7 |
OutByte(44H) |
END; |
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutIntByte(n) // add/sub byte[rbp+n], reg1_8 |
OutIntByte(n) (* add/sub byte[rbp+n], reg1_8 *) |
END; |
drop |
2535,16 → 2427,16 |
cmprc(reg1, 64); |
reg2 := GetVarReg(param2); |
IF reg2 # -1 THEN |
OutByte2(73H, 4); // jnb L |
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 |
OutByte2(73H, 4); (* jnb L *) |
oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *) |
ELSE |
n := param2 * 8; |
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L |
OutByte2(73H, 5 + 3 * ORD(~isByte(n))); (* jnb L *) |
Rex(0, reg1); |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); |
OutIntByte(n) // bts/btr qword[rbp+n], reg1 |
OutIntByte(n) (* bts/btr qword[rbp+n], reg1 *) |
END; |
// L: |
(* L: *) |
drop |
|IL.opLADR_INCLC, IL.opLADR_EXCLC: |
2551,11 → 2443,11 |
reg1 := GetVarReg(param1); |
IF reg1 # -1 THEN |
Rex(reg1, 0); |
OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2 |
OutByte3(0FH, 0BAH, 0E8H); (* bts/btr reg1, param2 *) |
OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2) |
ELSE |
n := param1 * 8; |
OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2 |
OutByte3(48H, 0FH, 0BAH); (* bts/btr qword[rbp+n], param2 *) |
OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); |
OutIntByte(n); |
OutByte(param2) |
2586,7 → 2478,7 |
entry := NewLabel(); |
X86.SetLabel(entry); |
IF target = mConst.Target_iDLL64 THEN |
IF target = TARGETS.Win64DLL THEN |
dllret := NewLabel(); |
push(r8); |
push(rdx); |
2596,7 → 2488,7 |
jcc(je, dllret) |
END; |
IF target = mConst.Target_iELF64 THEN |
IF target = TARGETS.Linux64 THEN |
push(rsp) |
ELSE |
pushc(0) |
2604,12 → 2496,12 |
lea(rax, entry, sCODE); |
push(rax); |
pushDA(0); //TYPES |
pushDA(0); (* TYPES *) |
pushc(tcount); |
pushDA(ModName_Offs); //MODNAME |
pushDA(ModName_Offs); (* MODNAME *) |
CallRTL(IL._init); |
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iELF64} THEN |
IF target IN {TARGETS.Win64C, TARGETS.Win64GUI, TARGETS.Linux64} THEN |
L := NewLabel(); |
pushc(0); |
push(rsp); |
2619,7 → 2511,9 |
pop(rax); |
test(rax); |
jcc(je, L); |
GetRegA; |
addrc(rax, 1024 * 1024 * stack_size - 8); |
drop; |
mov(rsp, rax); |
X86.SetLabel(L) |
END |
2655,15 → 2549,15 |
BEGIN |
IF target = mConst.Target_iDLL64 THEN |
IF target = TARGETS.Win64DLL THEN |
X86.SetLabel(dllret); |
OutByte(0C3H) // ret |
ELSIF target = mConst.Target_iELFSO64 THEN |
X86.ret |
ELSIF target = TARGETS.Linux64SO THEN |
sofinit := NewLabel(); |
OutByte(0C3H); // ret |
X86.ret; |
X86.SetLabel(sofinit); |
CallRTL(IL._sofinit); |
OutByte(0C3H) // ret |
X86.ret |
ELSE |
pushc(0); |
CallRTL(IL._exit) |
2724,8 → 2618,8 |
BEGIN |
offs := offs * 8; |
CASE size OF |
|1: movmr8(rbp, offs, reg) |
|2: movmr16(rbp, offs, reg) |
|1: X86.movmr8(rbp, offs, reg) |
|2: X86.movmr16(rbp, offs, reg) |
|4: movmr32(rbp, offs, reg) |
|8: movmr(rbp, offs, reg) |
END |
2778,12 → 2672,12 |
epilog(modname, target); |
BIN.fixup(prog); |
IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |
PE32.write(prog, outname, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) |
ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN |
ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE) |
IF TARGETS.OS = TARGETS.osWIN64 THEN |
PE32.write(prog, outname, target = TARGETS.Win64C, target = TARGETS.Win64DLL, TRUE) |
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN |
ELF.write(prog, outname, sofinit, target = TARGETS.Linux64SO, TRUE) |
END |
END CodeGen; |
END AMD64. |
END AMD64. |
/programs/develop/oberon07/Source/ARITH.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
75,6 → 75,11 |
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; |
81,9 → 86,9 |
BEGIN |
CASE v.typ OF |
|tINTEGER: res := (UTILS.target.minInt <= v.int) & (v.int <= UTILS.target.maxInt) |
|tCHAR: res := (0 <= v.int) & (v.int <= 255) |
|tWCHAR: res := (0 <= v.int) & (v.int <= 65535) |
|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 |
196,61 → 201,15 |
PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN; |
VAR |
max: REAL; |
res: BOOLEAN; |
BEGIN |
max := UTILS.maxreal; |
CASE op OF |
|"+": |
IF (a < 0.0) & (b < 0.0) THEN |
res := a > -max - b |
ELSIF (a > 0.0) & (b > 0.0) THEN |
res := a < max - b |
ELSE |
res := TRUE |
END; |
IF res THEN |
a := a + b |
|"+": a := a + b |
|"-": a := a - b |
|"*": a := a * b |
|"/": a := a / b |
END |
|"-": |
IF (a < 0.0) & (b > 0.0) THEN |
res := a > b - max |
ELSIF (a > 0.0) & (b < 0.0) THEN |
res := a < b + max |
ELSE |
res := TRUE |
END; |
IF res THEN |
a := a - b |
END |
|"*": |
IF (ABS(a) > 1.0) & (ABS(b) > 1.0) THEN |
res := ABS(a) < max / ABS(b) |
ELSE |
res := TRUE |
END; |
IF res THEN |
a := a * b |
END |
|"/": |
IF ABS(b) < 1.0 THEN |
res := ABS(a) < max * ABS(b) |
ELSE |
res := TRUE |
END; |
IF res THEN |
a := a / b |
END |
END |
RETURN res |
RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *) |
END opFloat2; |
407,13 → 366,8 |
BEGIN |
ASSERT(x > 0); |
n := 0; |
WHILE ~ODD(x) DO |
x := x DIV 2; |
INC(n) |
END; |
IF x # 1 THEN |
n := UTILS.Log2(x); |
IF n = -1 THEN |
n := 255 |
END |
521,7 → 475,7 |
|"-": success := subInt(a.int, b.int) |
|"*": success := mulInt(a.int, b.int) |
|"/": success := FALSE |
|"D": IF (b.int # -1) OR (a.int # UTILS.minint) THEN a.int := a.int DIV b.int ELSE success := FALSE END |
|"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) |
670,11 → 624,6 |
END opBoolean; |
PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN; |
RETURN (a <= i.int) & (i.int <= b) |
END range; |
PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
/programs/develop/oberon07/Source/AVLTREES.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/BIN.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
12,19 → 12,14 |
CONST |
RCODE* = 1; |
RDATA* = 2; |
RBSS* = 3; |
RIMP* = 4; |
RCODE* = 0; PICCODE* = RCODE + 1; |
RDATA* = 2; PICDATA* = RDATA + 1; |
RBSS* = 4; PICBSS* = RBSS + 1; |
RIMP* = 6; PICIMP* = RIMP + 1; |
PICCODE* = 5; |
PICDATA* = 6; |
PICBSS* = 7; |
PICIMP* = 8; |
IMPTAB* = 8; |
IMPTAB* = 9; |
TYPE |
RELOC* = POINTER TO RECORD (LISTS.ITEM) |
211,6 → 206,13 |
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) |
/programs/develop/oberon07/Source/CHUNKLISTS.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
12,8 → 12,8 |
CONST |
LENOFBYTECHUNK = 64000; |
LENOFINTCHUNK = 16000; |
LENOFBYTECHUNK = 65536; |
LENOFINTCHUNK = 16384; |
TYPE |
/programs/develop/oberon07/Source/COLLECTIONS.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/CONSOLE.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/Compiler.ob07 |
---|
1,54 → 1,16 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE Compiler; |
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430; |
IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, |
ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS; |
PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
IF s = mConst.Target_sConsole THEN |
res := mConst.Target_iConsole |
ELSIF s = mConst.Target_sGUI THEN |
res := mConst.Target_iGUI |
ELSIF s = mConst.Target_sDLL THEN |
res := mConst.Target_iDLL |
ELSIF s = mConst.Target_sKolibri THEN |
res := mConst.Target_iKolibri |
ELSIF s = mConst.Target_sObject THEN |
res := mConst.Target_iObject |
ELSIF s = mConst.Target_sConsole64 THEN |
res := mConst.Target_iConsole64 |
ELSIF s = mConst.Target_sGUI64 THEN |
res := mConst.Target_iGUI64 |
ELSIF s = mConst.Target_sDLL64 THEN |
res := mConst.Target_iDLL64 |
ELSIF s = mConst.Target_sELF32 THEN |
res := mConst.Target_iELF32 |
ELSIF s = mConst.Target_sELFSO32 THEN |
res := mConst.Target_iELFSO32 |
ELSIF s = mConst.Target_sELF64 THEN |
res := mConst.Target_iELF64 |
ELSIF s = mConst.Target_sELFSO64 THEN |
res := mConst.Target_iELFSO64 |
ELSIF s = mConst.Target_sMSP430 THEN |
res := mConst.Target_iMSP430 |
ELSE |
res := 0 |
END |
RETURN res |
END Target; |
PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH); |
VAR |
param: PARS.PATH; |
168,6 → 130,22 |
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; |
180,7 → 158,6 |
param: PARS.PATH; |
temp: PARS.PATH; |
target: INTEGER; |
bit_depth: INTEGER; |
time: INTEGER; |
options: PROG.OPTIONS; |
196,32 → 173,46 |
UTILS.GetArg(1, inname); |
C.Ln; |
C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); |
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)"); |
C.StringLn("Copyright (c) 2018-2019, Anton Krotov"); |
C.StringLn("Copyright (c) 2018-2020, 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 |
C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln; |
ELSIF UTILS.bit_depth = 32 THEN |
C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln; |
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 megabytes"); C.Ln; |
C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); |
C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; |
C.StringLn(" -ver <major.minor> set version of program ('obj' target)"); C.Ln; |
C.StringLn(" -ram <size> set size of RAM in bytes ('msp430' target)"); C.Ln; |
C.StringLn(" -rom <size> set size of ROM in bytes ('msp430' target)"); 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(" -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; |
UTILS.Exit(0) |
END; |
C.StringLn("--------------------------------------------"); |
PATHS.split(inname, path, modname, ext); |
IF ext # mConst.FILE_EXT THEN |
IF ext # UTILS.FILE_EXT THEN |
ERRORS.Error(207) |
END; |
235,52 → 226,29 |
ERRORS.Error(205) |
END; |
target := Target(param); |
IF target = 0 THEN |
IF TARGETS.Select(param) THEN |
target := TARGETS.target |
ELSE |
ERRORS.Error(206) |
END; |
CASE target OF |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: |
bit_depth := 64 |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, |
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32: |
bit_depth := 32 |
|mConst.Target_iMSP430: |
bit_depth := 16; |
IF target = TARGETS.MSP430 THEN |
options.ram := MSP430.minRAM; |
options.rom := MSP430.minROM |
END; |
IF UTILS.bit_depth < bit_depth THEN |
IF target = TARGETS.STM32CM3 THEN |
options.ram := THUMB.STM32_minRAM; |
options.rom := THUMB.STM32_minROM |
END; |
IF UTILS.bit_depth < TARGETS.BitDepth THEN |
ERRORS.Error(206) |
END; |
STRINGS.append(lib_path, "lib"); |
STRINGS.append(lib_path, UTILS.slash); |
CASE target OF |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL: |
STRINGS.append(lib_path, "Windows32") |
|mConst.Target_iKolibri, mConst.Target_iObject: |
STRINGS.append(lib_path, "KolibriOS") |
|mConst.Target_iELF32, mConst.Target_iELFSO32: |
STRINGS.append(lib_path, "Linux32") |
|mConst.Target_iELF64, mConst.Target_iELFSO64: |
STRINGS.append(lib_path, "Linux64") |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64: |
STRINGS.append(lib_path, "Windows64") |
|mConst.Target_iMSP430: |
STRINGS.append(lib_path, "MSP430") |
END; |
STRINGS.append(lib_path, TARGETS.LibDir); |
STRINGS.append(lib_path, UTILS.slash); |
keys(options, outname); |
287,24 → 255,7 |
IF outname = "" THEN |
outname := path; |
STRINGS.append(outname, modname); |
CASE target OF |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iConsole64, mConst.Target_iGUI64: |
STRINGS.append(outname, ".exe") |
|mConst.Target_iObject: |
STRINGS.append(outname, ".obj") |
|mConst.Target_iKolibri, mConst.Target_iELF32, mConst.Target_iELF64: |
|mConst.Target_iELFSO32, mConst.Target_iELFSO64: |
STRINGS.append(outname, ".so") |
|mConst.Target_iDLL, mConst.Target_iDLL64: |
STRINGS.append(outname, ".dll") |
|mConst.Target_iMSP430: |
STRINGS.append(outname, ".hex") |
END |
STRINGS.append(outname, TARGETS.FileExt) |
ELSE |
IF PATHS.isRelative(outname) THEN |
PATHS.RelPath(app_path, outname, temp); |
312,15 → 263,12 |
END |
END; |
PARS.init(bit_depth, target, options); |
PARS.init(options); |
PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject}; |
PARS.program.obj := target = mConst.Target_iObject; |
ST.compile(path, lib_path, modname, outname, target, options); |
time := UTILS.GetTickCount() - UTILS.time; |
C.StringLn("--------------------------------------------"); |
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"); |
/programs/develop/oberon07/Source/ELF.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
142,23 → 142,27 |
PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN); |
VAR |
reloc: BIN.RELOC; |
L, delta: INTEGER; |
code: CHL.BYTELIST; |
L, delta, delta0: INTEGER; |
BEGIN |
code := program.code; |
delta0 := 3 - 7 * ORD(amd64); |
reloc := program.rel_list.first(BIN.RELOC); |
WHILE reloc # NIL DO |
L := BIN.get32le(program.code, reloc.offset); |
delta := 3 - reloc.offset - text - 7 * ORD(amd64); |
L := BIN.get32le(code, reloc.offset); |
delta := delta0 - reloc.offset - text; |
CASE reloc.opcode OF |
|BIN.PICDATA: BIN.put32le(program.code, reloc.offset, L + data + delta) |
|BIN.PICCODE: BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
|BIN.PICBSS: BIN.put32le(program.code, reloc.offset, L + bss + delta) |
|BIN.PICDATA: BIN.put32le(code, reloc.offset, L + data + delta) |
|BIN.PICCODE: BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
|BIN.PICBSS: BIN.put32le(code, reloc.offset, L + bss + delta) |
END; |
reloc := reloc.next(BIN.RELOC) |
END; |
END |
END fixup; |
/programs/develop/oberon07/Source/ERRORS.ob07 |
---|
1,13 → 1,13 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE ERRORS; |
IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS; |
IMPORT C := CONSOLE, UTILS; |
PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); |
73,7 → 73,7 |
| 43: str := "expression is not an integer" |
| 44: str := "out of range 0..MAXSET" |
| 45: str := "division by zero" |
| 46: str := "integer division by zero" |
| 46: str := "IV out of range" |
| 47: str := "'OF' or ',' expected" |
| 48: str := "undeclared identifier" |
| 49: str := "type expected" |
137,7 → 137,7 |
|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" |
146,8 → 146,8 |
|116: str := "procedure too deep nested" |
|120: str := "too many formal parameters" |
|122: str := "negative divisor" |
|121: str := "multiply defined handler" |
|122: str := "bad divisor" |
|123: str := "illegal flag" |
|124: str := "unknown flag" |
|125: str := "flag not supported" |
184,7 → 184,7 |
PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR); |
BEGIN |
Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found") |
Error5("procedure ", UTILS.RTL_NAME, ".", ProcName, " not found") |
END WrongRTL; |
209,9 → 209,9 |
|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 "', mConst.FILE_EXT, '"') |
|207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"') |
END |
END Error; |
END ERRORS. |
END ERRORS. |
/programs/develop/oberon07/Source/FILES.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
17,8 → 17,10 |
ptr: INTEGER; |
buffer: ARRAY 64*1024 OF BYTE; |
count: INTEGER |
count: INTEGER; |
chksum*: INTEGER |
END; |
VAR |
83,7 → 85,8 |
IF ptr > 0 THEN |
file := NewFile(); |
file.ptr := ptr; |
file.count := 0 |
file.count := 0; |
file.chksum := 0 |
ELSE |
file := NIL |
END |
190,30 → 193,14 |
PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN; |
VAR |
res: BOOLEAN; |
arr: ARRAY 1 OF BYTE; |
BEGIN |
res := TRUE; |
IF (file # NIL) & (file.count >= 0) THEN |
IF file.count = LEN(file.buffer) THEN |
IF flush(file) # LEN(file.buffer) THEN |
res := FALSE |
ELSE |
file.buffer[0] := byte; |
file.count := 1 |
END |
ELSE |
file.buffer[file.count] := byte; |
INC(file.count) |
END |
ELSE |
res := FALSE |
END |
RETURN res |
arr[0] := byte |
RETURN write(file, arr, 1) = 1 |
END WriteByte; |
BEGIN |
files := C.create() |
END FILES. |
END FILES. |
/programs/develop/oberon07/Source/HEX.ob07 |
---|
0,0 → 1,127 |
(* |
BSD 2-Clause License |
Copyright (c) 2020, Anton Krotov |
All rights reserved. |
*) |
MODULE HEX; |
IMPORT FILES, WRITER, CHL := CHUNKLISTS; |
PROCEDURE hexdgt (n: BYTE): BYTE; |
BEGIN |
IF n < 10 THEN |
n := n + ORD("0") |
ELSE |
n := n - 10 + ORD("A") |
END |
RETURN n |
END hexdgt; |
PROCEDURE Byte (file: FILES.FILE; byte: BYTE); |
BEGIN |
WRITER.WriteByte(file, hexdgt(byte DIV 16)); |
WRITER.WriteByte(file, hexdgt(byte MOD 16)); |
INC(file.chksum, byte); |
END Byte; |
PROCEDURE NewLine (file: FILES.FILE); |
BEGIN |
Byte(file, (-file.chksum) MOD 256); |
file.chksum := 0; |
WRITER.WriteByte(file, 0DH); |
WRITER.WriteByte(file, 0AH) |
END NewLine; |
PROCEDURE StartCode (file: FILES.FILE); |
BEGIN |
WRITER.WriteByte(file, ORD(":")); |
file.chksum := 0 |
END StartCode; |
PROCEDURE Data* (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); |
VAR |
i, len: INTEGER; |
BEGIN |
WHILE cnt > 0 DO |
len := MIN(cnt, 16); |
StartCode(file); |
Byte(file, len); |
Byte(file, idx DIV 256); |
Byte(file, idx MOD 256); |
Byte(file, 0); |
FOR i := 1 TO len DO |
Byte(file, mem[idx]); |
INC(idx) |
END; |
DEC(cnt, len); |
NewLine(file) |
END |
END Data; |
PROCEDURE ExtLA* (file: FILES.FILE; LA: INTEGER); |
BEGIN |
ASSERT((0 <= LA) & (LA <= 0FFFFH)); |
StartCode(file); |
Byte(file, 2); |
Byte(file, 0); |
Byte(file, 0); |
Byte(file, 4); |
Byte(file, LA DIV 256); |
Byte(file, LA MOD 256); |
NewLine(file) |
END ExtLA; |
PROCEDURE Data2* (file: FILES.FILE; mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); |
VAR |
i, len, offset: INTEGER; |
BEGIN |
ExtLA(file, LA); |
offset := 0; |
WHILE cnt > 0 DO |
ASSERT(offset <= 65536); |
IF offset = 65536 THEN |
INC(LA); |
ExtLA(file, LA); |
offset := 0 |
END; |
len := MIN(cnt, 16); |
StartCode(file); |
Byte(file, len); |
Byte(file, offset DIV 256); |
Byte(file, offset MOD 256); |
Byte(file, 0); |
FOR i := 1 TO len DO |
Byte(file, CHL.GetByte(mem, idx)); |
INC(idx); |
INC(offset) |
END; |
DEC(cnt, len); |
NewLine(file) |
END |
END Data2; |
PROCEDURE End* (file: FILES.FILE); |
BEGIN |
StartCode(file); |
Byte(file, 0); |
Byte(file, 0); |
Byte(file, 0); |
Byte(file, 1); |
NewLine(file) |
END End; |
END HEX. |
/programs/develop/oberon07/Source/IL.ob07 |
---|
1,13 → 1,13 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE IL; |
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS; |
IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS; |
CONST |
65,7 → 65,7 |
opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; |
opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; |
opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; |
opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; |
opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; |
opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; |
opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; |
opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; |
83,7 → 83,9 |
opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; |
opONERR* = 222; opSAVEFI* = 223; opHANDLER* = 224; |
opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4; |
opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8; |
opLOAD32_PARAM* = -9; |
119,7 → 121,19 |
_guard *= 20; |
_guardrec *= 21; |
_fmul *= 22; |
_fdiv *= 23; |
_fdivi *= 24; |
_fadd *= 25; |
_fsub *= 26; |
_fsubi *= 27; |
_fcmp *= 28; |
_floor *= 29; |
_flt *= 30; |
_pack *= 31; |
_unpk *= 32; |
TYPE |
LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) |
184,7 → 198,7 |
dmin*: INTEGER; |
lcount*: INTEGER; |
bss*: INTEGER; |
rtl*: ARRAY 22 OF INTEGER; |
rtl*: ARRAY 33 OF INTEGER; |
errlabels*: ARRAY 12 OF INTEGER; |
charoffs: ARRAY 256 OF INTEGER; |
198,8 → 212,7 |
VAR |
codes*: CODES; |
endianness: INTEGER; |
numRegsFloat: INTEGER; |
endianness, numRegsFloat, CPU: INTEGER; |
commands, variables: C.COLLECTION; |
433,6 → 446,8 |
BEGIN |
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN |
old_opcode := cur.opcode; |
param2 := nov.param2; |
481,6 → 496,9 |
ELSE |
old_opcode := -1 |
END |
ELSE |
old_opcode := -1 |
END; |
IF old_opcode = -1 THEN |
633,8 → 651,7 |
PROCEDURE OnError* (line, error: INTEGER); |
BEGIN |
AddCmd(opPUSHC, line); |
AddJmpCmd(opJMP, codes.errlabels[error]) |
AddCmd2(opONERR, codes.errlabels[error], line) |
END OnError; |
877,9 → 894,13 |
END SysPut; |
PROCEDURE savef*; |
PROCEDURE savef* (inv: BOOLEAN); |
BEGIN |
AddCmd0(opSAVEF); |
IF inv THEN |
AddCmd0(opSAVEFI) |
ELSE |
AddCmd0(opSAVEF) |
END; |
DEC(codes.fregs); |
ASSERT(codes.fregs >= 0) |
END savef; |
1138,7 → 1159,7 |
END DelImport; |
PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER); |
PROCEDURE init* (pCPU: INTEGER); |
VAR |
cmd: COMMAND; |
i: INTEGER; |
1146,9 → 1167,16 |
BEGIN |
commands := C.create(); |
variables := C.create(); |
numRegsFloat := pNumRegsFloat; |
endianness := pEndianness; |
CPU := pCPU; |
endianness := little_endian; |
CASE CPU OF |
|TARGETS.cpuAMD64: numRegsFloat := 6 |
|TARGETS.cpuX86: numRegsFloat := 8 |
|TARGETS.cpuMSP430: numRegsFloat := 0 |
|TARGETS.cpuTHUMB: numRegsFloat := 256 |
END; |
NEW(codes.begcall); |
codes.begcall.top := -1; |
NEW(codes.endcall); |
/programs/develop/oberon07/Source/KOS.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
116,6 → 116,7 |
icount, dcount, ccount: INTEGER; |
code: CHL.BYTELIST; |
BEGIN |
base := 0; |
141,11 → 142,11 |
header.param := header.sp; |
header.path := header.param + PARAM_SIZE; |
code := program.code; |
reloc := program.rel_list.first(BIN.RELOC); |
WHILE reloc # NIL DO |
L := BIN.get32le(program.code, reloc.offset); |
L := BIN.get32le(code, reloc.offset); |
delta := 3 - reloc.offset - text; |
CASE reloc.opcode OF |
152,32 → 153,32 |
|BIN.RIMP: |
iproc := BIN.GetIProc(program, L); |
BIN.put32le(program.code, reloc.offset, idata + iproc.label) |
BIN.put32le(code, reloc.offset, idata + iproc.label) |
|BIN.RBSS: |
BIN.put32le(program.code, reloc.offset, L + bss) |
BIN.put32le(code, reloc.offset, L + bss) |
|BIN.RDATA: |
BIN.put32le(program.code, reloc.offset, L + data) |
BIN.put32le(code, reloc.offset, L + data) |
|BIN.RCODE: |
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text) |
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text) |
|BIN.PICDATA: |
BIN.put32le(program.code, reloc.offset, L + data + delta) |
BIN.put32le(code, reloc.offset, L + data + delta) |
|BIN.PICCODE: |
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
|BIN.PICBSS: |
BIN.put32le(program.code, reloc.offset, L + bss + delta) |
BIN.put32le(code, reloc.offset, L + bss + delta) |
|BIN.PICIMP: |
iproc := BIN.GetIProc(program, L); |
BIN.put32le(program.code, reloc.offset, idata + iproc.label + delta) |
BIN.put32le(code, reloc.offset, idata + iproc.label + delta) |
|BIN.IMPTAB: |
BIN.put32le(program.code, reloc.offset, idata + delta) |
BIN.put32le(code, reloc.offset, idata + delta) |
END; |
198,7 → 199,7 |
WR.Write32LE(File, header.param); |
WR.Write32LE(File, header.path); |
CHL.WriteToFile(File, program.code); |
CHL.WriteToFile(File, code); |
WR.Padding(File, FileAlignment); |
CHL.WriteToFile(File, program.data); |
/programs/develop/oberon07/Source/LISTS.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/MSCOFF.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
45,19 → 45,11 |
WHILE reloc # NIL DO |
CASE reloc.opcode OF |
|BIN.RIMP, BIN.IMPTAB: |
WriteReloc(File, reloc.offset, 4, 6) |
|BIN.RBSS: |
WriteReloc(File, reloc.offset, 5, 6) |
|BIN.RDATA: |
WriteReloc(File, reloc.offset, 2, 6) |
|BIN.RCODE: |
WriteReloc(File, reloc.offset, 1, 6) |
|BIN.RIMP, |
BIN.IMPTAB: WriteReloc(File, reloc.offset, 4, 6) |
|BIN.RBSS: WriteReloc(File, reloc.offset, 5, 6) |
|BIN.RDATA: WriteReloc(File, reloc.offset, 2, 6) |
|BIN.RCODE: WriteReloc(File, reloc.offset, 1, 6) |
END; |
reloc := reloc.next(BIN.RELOC) |
70,9 → 62,11 |
reloc: BIN.RELOC; |
iproc: BIN.IMPRT; |
res, L: INTEGER; |
code: CHL.BYTELIST; |
BEGIN |
res := 0; |
code := program.code; |
reloc := program.rel_list.first(BIN.RELOC); |
WHILE reloc # NIL DO |
79,14 → 73,14 |
INC(res); |
IF reloc.opcode = BIN.RIMP THEN |
L := BIN.get32le(program.code, reloc.offset); |
L := BIN.get32le(code, reloc.offset); |
iproc := BIN.GetIProc(program, L); |
BIN.put32le(program.code, reloc.offset, iproc.label) |
BIN.put32le(code, reloc.offset, iproc.label) |
END; |
IF reloc.opcode = BIN.RCODE THEN |
L := BIN.get32le(program.code, reloc.offset); |
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L)) |
L := BIN.get32le(code, reloc.offset); |
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L)) |
END; |
reloc := reloc.next(BIN.RELOC) |
159,7 → 153,7 |
FileHeader.Machine := 014CX; |
FileHeader.NumberOfSections := 5X; |
FileHeader.TimeDateStamp := UTILS.UnixTime(); |
//FileHeader.PointerToSymbolTable := 0; |
(* FileHeader.PointerToSymbolTable := 0; *) |
FileHeader.NumberOfSymbols := 6; |
FileHeader.SizeOfOptionalHeader := 0X; |
FileHeader.Characteristics := 0184X; |
169,7 → 163,7 |
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.PointerToRelocations := 0; *) |
flat.PointerToLinenumbers := 0; |
SetNumberOfRelocations(flat, RelocCount(program)); |
flat.NumberOfLinenumbers := 0X; |
191,7 → 185,7 |
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.PointerToRelocations := 0; *) |
edata.PointerToLinenumbers := 0; |
SetNumberOfRelocations(edata, ExpCount * 2 + 1); |
edata.NumberOfLinenumbers := 0X; |
202,7 → 196,7 |
idata.VirtualAddress := 0; |
idata.SizeOfRawData := isize; |
idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData; |
//idata.PointerToRelocations := 0; |
(* idata.PointerToRelocations := 0; *) |
idata.PointerToLinenumbers := 0; |
SetNumberOfRelocations(idata, ICount(ImportTable, ILen)); |
idata.NumberOfLinenumbers := 0X; |
/programs/develop/oberon07/Source/MSP430.ob07 |
---|
1,20 → 1,20 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE MSP430; |
IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, FILES, WRITER, |
IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX, |
UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; |
CONST |
minRAM* = 128; maxRAM* = 10240; |
minROM* = 2048; maxROM* = 49152; |
minRAM* = 128; maxRAM* = 2048; |
minROM* = 2048; maxROM* = 24576; |
minStackSize = 64; |
24,7 → 24,7 |
R4 = 4; R5 = 5; R6 = 6; R7 = 7; |
IR = 13; HP = 14; BP = 15; |
HP = 14; IR = 15; |
ACC = R4; |
108,7 → 108,9 |
IdxWords: RECORD src, dst: INTEGER END; |
StkCnt: INTEGER; |
PROCEDURE EmitLabel (L: INTEGER); |
VAR |
label: LABEL; |
167,9 → 169,18 |
PROCEDURE src_x (x, Rn: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
IdxWords.src := x |
RETURN Rn * 256 + sIDX |
IF (x = 0) & ~(Rn IN {PC, SR, CG}) THEN |
res := Rn * 256 + sINDIR |
ELSE |
IdxWords.src := x; |
res := Rn * 256 + sIDX |
END |
RETURN res |
END src_x; |
197,7 → 208,7 |
BEGIN |
CASE x OF |
| 0: res := CG * 256 |
| 1: res := src_x(0, CG); IdxWords.src := NOWORD |
| 1: res := CG * 256 + sIDX |
| 2: res := indir(CG) |
| 4: res := indir(SR) |
| 8: res := incr(SR) |
213,9 → 224,9 |
PROCEDURE Op2 (op, src, dst: INTEGER); |
BEGIN |
ASSERT(BITS(op) + {6, 12..15} = {6, 12..15}); |
ASSERT(BITS(src) + {4, 5, 8..11} = {4, 5, 8..11}); |
ASSERT(BITS(dst) + {0..3, 7} = {0..3, 7}); |
ASSERT(BITS(op) - {6, 12..15} = {}); |
ASSERT(BITS(src) - {4, 5, 8..11} = {}); |
ASSERT(BITS(dst) - {0..3, 7} = {}); |
EmitWord(op + src + dst); |
254,7 → 265,8 |
ELSE |
Op1(opPUSH, PC, sINCR); |
EmitWord(imm) |
END |
END; |
INC(StkCnt) |
END PushImm; |
376,13 → 388,15 |
PROCEDURE Push (reg: INTEGER); |
BEGIN |
Op1(opPUSH, reg, sREG) |
Op1(opPUSH, reg, sREG); |
INC(StkCnt) |
END Push; |
PROCEDURE Pop (reg: INTEGER); |
BEGIN |
Op2(opMOV, incr(SP), reg) |
Op2(opMOV, incr(SP), reg); |
DEC(StkCnt) |
END Pop; |
430,7 → 444,8 |
EmitCall(RTL.rtl[proc].label); |
RTL.Used(proc); |
IF params > 0 THEN |
Op2(opADD, imm(params * 2), SP) |
Op2(opADD, imm(params * 2), SP); |
DEC(StkCnt, params) |
END |
END CallRTL; |
582,11 → 597,26 |
END Neg; |
PROCEDURE LocalOffset (offset: INTEGER): INTEGER; |
RETURN (offset + StkCnt - ORD(offset > 0)) * 2 |
END LocalOffset; |
PROCEDURE LocalDst (offset: INTEGER): INTEGER; |
RETURN dst_x(LocalOffset(offset), SP) |
END LocalDst; |
PROCEDURE LocalSrc (offset: INTEGER): INTEGER; |
RETURN src_x(LocalOffset(offset), SP) |
END LocalSrc; |
PROCEDURE translate; |
VAR |
cmd, next: COMMAND; |
opcode, param1, param2, label, L, a, n, c1, c2: INTEGER; |
opcode, param1, param2, L, a, n, c1, c2: INTEGER; |
reg1, reg2: INTEGER; |
623,6 → 653,7 |
|IL.opSADR_PARAM: |
Op1(opPUSH, PC, sINCR); |
INC(StkCnt); |
EmitWord(param2); |
Reloc(RDATA) |
632,17 → 663,18 |
|IL.opPUSHC: |
PushImm(param2) |
|IL.opONERR: |
PushImm(param2); |
DEC(StkCnt); |
EmitJmp(opJMP, param1) |
|IL.opLEAVEC: |
Pop(PC) |
|IL.opENTER: |
ASSERT(R.top = -1); |
StkCnt := 0; |
EmitLabel(param1); |
Push(BP); |
MovRR(SP, BP); |
IF param2 > 8 THEN |
Op2(opMOV, imm(param2), R4); |
L := NewLabel(); |
668,14 → 700,11 |
END; |
drop |
END; |
ASSERT(R.top = -1); |
ASSERT(StkCnt = param1); |
IF param1 > 0 THEN |
MovRR(BP, SP) |
Op2(opADD, imm(param1 * 2), SP) |
END; |
Pop(BP); |
Pop(PC) |
|IL.opRES: |
684,7 → 713,8 |
|IL.opCLEANUP: |
IF param2 # 0 THEN |
Op2(opADD, imm(param2 * 2), SP) |
Op2(opADD, imm(param2 * 2), SP); |
DEC(StkCnt, param2) |
END |
|IL.opCONST: |
720,14 → 750,17 |
|IL.opLADR: |
reg1 := GetAnyReg(); |
MovRR(BP, reg1); |
Op2(opADD, imm(param2 * 2), reg1) |
n := LocalOffset(param2); |
Op2(opMOV, SP * 256, reg1); |
IF n # 0 THEN |
Op2(opADD, imm(n), reg1) |
END |
|IL.opLLOAD8: |
Op2(opMOV + BW, src_x(param2 * 2, BP), GetAnyReg()) |
Op2(opMOV + BW, LocalSrc(param2), GetAnyReg()) |
|IL.opLLOAD16, IL.opVADR: |
Op2(opMOV, src_x(param2 * 2, BP), GetAnyReg()) |
Op2(opMOV, LocalSrc(param2), GetAnyReg()) |
|IL.opGLOAD8: |
Op2(opMOV + BW, src_x(param2, SR), GetAnyReg()); |
747,12 → 780,12 |
|IL.opVLOAD8: |
reg1 := GetAnyReg(); |
Op2(opMOV, src_x(param2 * 2, BP), reg1); |
Op2(opMOV, LocalSrc(param2), reg1); |
Op2(opMOV + BW, indir(reg1), reg1) |
|IL.opVLOAD16: |
reg1 := GetAnyReg(); |
Op2(opMOV, src_x(param2 * 2, BP), reg1); |
Op2(opMOV, LocalSrc(param2), reg1); |
Op2(opMOV, indir(reg1), reg1) |
|IL.opSAVE, IL.opSAVE16: |
803,20 → 836,15 |
Op2(opSUB, imm(param2), reg1) |
END; |
IF opcode = IL.opSUBL THEN |
reg2 := GetAnyReg(); |
Clear(reg2); |
Op2(opSUB, reg1 * 256, reg2); |
drop; |
drop; |
ASSERT(REG.GetReg(R, reg2)) |
Neg(reg1) |
END |
|IL.opLADR_SAVEC: |
Op2(opMOV, imm(param2), dst_x(param1 * 2, BP)) |
Op2(opMOV, imm(param2), LocalDst(param1)) |
|IL.opLADR_SAVE: |
UnOp(reg1); |
Op2(opMOV, reg1 * 256, dst_x(param2 * 2, BP)); |
Op2(opMOV, reg1 * 256, LocalDst(param2)); |
drop |
|IL.opGADR_SAVEC: |
850,17 → 878,14 |
drop; |
cc := cond(opcode); |
next := cmd.next(COMMAND); |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(ORD(BITS(cc) / {0}), label); |
cmd := cmd.next(COMMAND) |
IF next.opcode = IL.opJE THEN |
jcc(cc, next.param1); |
cmd := next |
ELSIF next.opcode = IL.opJNE THEN |
jcc(ORD(BITS(cc) / {0}), next.param1); |
cmd := next |
ELSE |
setcc(cc, GetAnyReg()) |
END |
942,14 → 967,11 |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
Op2(opCMP, reg1 * 256, reg2); |
MovRR(reg2, reg1); |
drop; |
jcc(jb, param1) |
ELSE |
END; |
INCL(R.regs, reg1); |
DEC(R.top); |
R.stk[R.top] := reg2 |
END |
|IL.opINCC, IL.opINCCB: |
UnOp(reg1); |
974,19 → 996,19 |
drop |
|IL.opLADR_INCC, IL.opLADR_INCCB: |
Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), dst_x(param1 * 2, BP)) |
Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), LocalDst(param1)) |
|IL.opLADR_DECCB: |
Op2(opSUB + BW, imm(param2), dst_x(param1 * 2, BP)) |
Op2(opSUB + BW, imm(param2), LocalDst(param1)) |
|IL.opLADR_INC, IL.opLADR_INCB: |
UnOp(reg1); |
Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, dst_x(param2 * 2, BP)); |
Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, LocalDst(param2)); |
drop |
|IL.opLADR_DEC, IL.opLADR_DECB: |
UnOp(reg1); |
Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, dst_x(param2 * 2, BP)); |
Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, LocalDst(param2)); |
drop |
|IL.opPUSHT: |
1023,6 → 1045,7 |
UnOp(reg1); |
PushAll(0); |
Op1(opPUSH, reg1, sIDX); |
INC(StkCnt); |
EmitWord(-2); |
PushImm(param2); |
CallRTL(RTL._guardrec, 2); |
1078,39 → 1101,32 |
CallRTL(RTL._length, 2); |
GetRegA |
|IL.opMIN: |
|IL.opMAX,IL.opMIN: |
BinOp(reg1, reg2); |
Op2(opCMP, reg2 * 256, reg1); |
EmitWord(opJL + 1); (* jl L *) |
IF opcode = IL.opMIN THEN |
cc := opJL + 1 |
ELSE |
cc := opJGE + 1 |
END; |
EmitWord(cc); (* jge/jl L *) |
MovRR(reg2, reg1); |
(* L: *) |
drop |
|IL.opMAX: |
BinOp(reg1, reg2); |
Op2(opCMP, reg2 * 256, reg1); |
EmitWord(opJGE + 1); (* jge L *) |
MovRR(reg2, reg1); |
(* L: *) |
drop |
|IL.opMINC: |
|IL.opMAXC, IL.opMINC: |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1); |
L := NewLabel(); |
jcc(jl, L); |
IF opcode = IL.opMINC THEN |
cc := jl |
ELSE |
cc := jge |
END; |
jcc(cc, L); |
Op2(opMOV, imm(param2), reg1); |
EmitLabel(L) |
|IL.opMAXC: |
UnOp(reg1); |
Op2(opCMP, imm(param2), reg1); |
L := NewLabel(); |
jcc(jge, L); |
Op2(opMOV, imm(param2), reg1); |
EmitLabel(L) |
|IL.opSWITCH: |
UnOp(reg1); |
IF param2 = 0 THEN |
1153,10 → 1169,6 |
Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); |
drop |
|IL.opODD: |
UnOp(reg1); |
Op2(opAND, imm(1), reg1) |
|IL.opEQS .. IL.opGES: |
PushAll(4); |
PushImm((opcode - IL.opEQS) * 12); |
1353,6 → 1365,7 |
UnOp(reg1); |
PushAll_1; |
Op1(opPUSH, PC, sINCR); |
INC(StkCnt); |
EmitWord(param2); |
Reloc(RDATA); |
Push(reg1); |
1432,8 → 1445,10 |
END |
|IL.opVADR_PARAM: |
Op1(opPUSH, BP, sIDX); |
EmitWord(param2 * 2) |
reg1 := GetAnyReg(); |
Op2(opMOV, LocalSrc(param2), reg1); |
Push(reg1); |
drop |
|IL.opNEW: |
PushAll(1); |
1505,8 → 1520,11 |
|IL.opLADR_INCL, IL.opLADR_EXCL: |
PushAll(1); |
MovRR(BP, ACC); |
Op2(opADD, imm(param2 * 2), ACC); |
MovRR(SP, ACC); |
n := LocalOffset(param2); |
IF n # 0 THEN |
Op2(opADD, imm(n), ACC) |
END; |
Push(ACC); |
IF opcode = IL.opLADR_INCL THEN |
CallRTL(RTL._incl, 2) |
1515,10 → 1533,10 |
END |
|IL.opLADR_INCLC: |
Op2(opBIS, imm(ORD({param2})), dst_x(param1 * 2, BP)) |
Op2(opBIS, imm(ORD({param2})), LocalDst(param1)) |
|IL.opLADR_EXCLC: |
Op2(opBIC, imm(ORD({param2})), dst_x(param1 * 2, BP)) |
Op2(opBIC, imm(ORD({param2})), LocalDst(param1)) |
END; |
1598,51 → 1616,6 |
END epilog; |
PROCEDURE hexdgt (n: BYTE): BYTE; |
BEGIN |
IF n < 10 THEN |
n := n + ORD("0") |
ELSE |
n := n - 10 + ORD("A") |
END |
RETURN n |
END hexdgt; |
PROCEDURE WriteHexByte (file: FILES.FILE; byte: BYTE); |
BEGIN |
WRITER.WriteByte(file, hexdgt(byte DIV 16)); |
WRITER.WriteByte(file, hexdgt(byte MOD 16)); |
END WriteHexByte; |
PROCEDURE WriteHex (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); |
VAR |
i, len, chksum: INTEGER; |
BEGIN |
WHILE cnt > 0 DO |
len := MIN(cnt, 16); |
chksum := len + idx DIV 256 + idx MOD 256; |
WRITER.WriteByte(file, ORD(":")); |
WriteHexByte(file, len); |
WriteHexByte(file, idx DIV 256); |
WriteHexByte(file, idx MOD 256); |
WriteHexByte(file, 0); |
FOR i := 1 TO len DO |
WriteHexByte(file, mem[idx]); |
INC(chksum, mem[idx]); |
INC(idx) |
END; |
WriteHexByte(file, (-chksum) MOD 256); |
DEC(cnt, len); |
WRITER.WriteByte(file, 0DH); |
WRITER.WriteByte(file, 0AH) |
END |
END WriteHex; |
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
VAR |
i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; |
1653,7 → 1626,7 |
reloc: RELOC; |
file: FILES.FILE; |
file: WR.FILE; |
BEGIN |
IdxWords.src := NOWORD; |
1694,7 → 1667,7 |
Code.size := Fixup(Code.address, IntVectorSize + TypesSize); |
Data.address := Code.address + Code.size; |
Data.size := CHL.Length(IL.codes.data); |
Data.size := Data.size + ORD(ODD(Data.size)); |
Data.size := Data.size + Data.size MOD 2; |
TextSize := Code.size + Data.size; |
IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN |
1702,7 → 1675,7 |
END; |
Bss.address := RTL.ram + RTL.VarSize; |
Bss.size := IL.codes.bss + ORD(ODD(IL.codes.bss)); |
Bss.size := IL.codes.bss + IL.codes.bss MOD 2; |
heap := Bss.address + Bss.size; |
stack := RTL.ram + ram; |
ASSERT(stack - heap >= minStackSize); |
1754,25 → 1727,19 |
PutWord(Free.size, adr); |
PutWord(4130H, adr); (* RET *) |
PutWord(stack, adr); |
PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *) |
FOR i := 0 TO LEN(IV) - 1 DO |
PutWord(LabelOffs(IV[i]) * 2, adr) |
END; |
file := FILES.create(outname); |
WriteHex(file, mem, Code.address, TextSize); |
WriteHex(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); |
file := WR.Create(outname); |
WRITER.WriteByte(file, ORD(":")); |
WriteHexByte(file, 0); |
WriteHexByte(file, 0); |
WriteHexByte(file, 0); |
WriteHexByte(file, 1); |
WriteHexByte(file, 255); |
WRITER.WriteByte(file, 0DH); |
WRITER.WriteByte(file, 0AH); |
HEX.Data(file, mem, Code.address, TextSize); |
HEX.Data(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); |
HEX.End(file); |
FILES.close(file); |
WR.Close(file); |
INC(TextSize, IntVectorSize + TypesSize); |
INC(Bss.size, minStackSize + RTL.VarSize); |
1784,10 → 1751,9 |
C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)") |
END; |
C.Ln; |
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)"); |
C.StringLn("--------------------------------------------") |
C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)") |
END CodeGen; |
END MSP430. |
END MSP430. |
/programs/develop/oberon07/Source/MSP430RTL.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2019, Anton Krotov |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
39,7 → 39,8 |
LenIV* = 32; |
iv = 10000H - LenIV * 2; |
sp = iv - 2; |
bsl = iv - 2; |
sp = bsl - 2; |
empty_proc* = sp - 2; |
free_size = empty_proc - 2; |
free_adr = free_size - 2; |
370,18 → 371,20 |
Word1(4130H) (* RET *) |
END; |
(* _error (module, err, line: INTEGER) *) |
(* _error (modNum, modName, err, line: INTEGER) *) |
IF rtl[_error].used THEN |
Label(rtl[_error].label); |
Word1(0C232H); (* BIC #8, SR; DINT *) |
Word1(4303H); (* MOV R3, R3; NOP *) |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *) |
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *) |
Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- modNum *) |
Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- modName *) |
Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- err *) |
Word2(4117H, 8); (* MOV 8(SP), 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 *) |
Word1(1205H); (* PUSH R5 *) |
Word2(4214H, trap); (* MOV trap(SR), R4 *) |
Word1(9304H); (* TST R4 *) |
Word1(2400H + 1); (* JZ L *) |
663,15 → 666,10 |
Label := pLabel; |
Word := pWord; |
Call := pCall; |
IF ramSize > 2048 THEN |
ram := 1100H |
ELSE |
ram := 200H |
END; |
ram := 200H; |
trap := ram; |
int := trap + 2 |
END Init; |
END MSP430RTL. |
END MSP430RTL. |
/programs/develop/oberon07/Source/PARS.ob07 |
---|
1,13 → 1,14 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE PARS; |
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS; |
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, |
C := COLLECTIONS, TARGETS, THUMB; |
CONST |
77,7 → 78,7 |
parsers: C.COLLECTION; |
lines*: INTEGER; |
lines*, modules: INTEGER; |
PROCEDURE destroy* (VAR parser: PARSER); |
132,7 → 133,7 |
BEGIN |
SCAN.Next(parser.scanner, parser.lex); |
errno := parser.lex.error; |
IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN |
IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN |
IF parser.lex.sym = SCAN.lxFLOAT THEN |
errno := -SCAN.lxERROR13 |
ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN |
508,7 → 509,7 |
check1(FALSE, parser, 124) |
END; |
check1(sf IN program.target.sysflags, parser, 125); |
check1(sf IN program.sysflags, parser, 125); |
IF proc THEN |
check1(sf IN PROG.proc_flags, parser, 123) |
532,15 → 533,15 |
|PROG.sf_code: |
res := PROG.code |
|PROG.sf_windows: |
IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN |
IF TARGETS.OS = TARGETS.osWIN32 THEN |
res := PROG.stdcall |
ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN |
ELSIF TARGETS.OS = TARGETS.osWIN64 THEN |
res := PROG.win64 |
END |
|PROG.sf_linux: |
IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
IF TARGETS.OS = TARGETS.osLINUX32 THEN |
res := PROG.ccall16 |
ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN |
ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN |
res := PROG.systemv |
END |
|PROG.sf_noalign: |
577,6 → 578,7 |
IF parser.sym = SCAN.lxCOMMA THEN |
ExpectSym(parser, SCAN.lxSTRING); |
dll := parser.lex.s; |
STRINGS.UpCase(dll); |
ExpectSym(parser, SCAN.lxCOMMA); |
ExpectSym(parser, SCAN.lxSTRING); |
proc := parser.lex.s; |
586,16 → 588,19 |
checklex(parser, SCAN.lxRSQUARE); |
Next(parser) |
ELSE |
CASE program.target.bit_depth OF |
CASE TARGETS.BitDepth OF |
|16: call := PROG.default16 |
|32: call := PROG.default32 |
|32: IF TARGETS.target = TARGETS.STM32CM3 THEN |
call := PROG.ccall |
ELSE |
call := PROG.default32 |
END |
|64: call := PROG.default64 |
END |
END; |
IF import # NIL THEN |
check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32, |
mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70) |
check(TARGETS.Import, pos, 70) |
END |
RETURN call |
751,8 → 756,8 |
ExpectSym(parser, SCAN.lxTO); |
Next(parser); |
t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); |
t.align := program.target.adr; |
t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit); |
t.align := TARGETS.AdrSize; |
getpos(parser, pos); |
770,8 → 775,8 |
ELSIF parser.sym = SCAN.lxPROCEDURE THEN |
NextPos(parser, pos); |
t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
t.align := program.target.adr; |
t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
t.align := TARGETS.AdrSize; |
t.call := procflag(parser, import, FALSE); |
FormalParameters(parser, t) |
ELSE |
897,11 → 902,13 |
variables: LISTS.LIST; |
int, flt: INTEGER; |
comma: BOOLEAN; |
code: ARITH.VALUE; |
codeProc: BOOLEAN; |
code, iv: ARITH.VALUE; |
codeProc, |
handler: BOOLEAN; |
BEGIN |
endmod := FALSE; |
handler := FALSE; |
unit := parser.unit; |
921,13 → 928,27 |
check(PROG.openScope(unit, proc.proc), pos, 116); |
proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); |
proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
t := proc.type; |
t.align := program.target.adr; |
t.align := TARGETS.AdrSize; |
t.call := call; |
FormalParameters(parser, t); |
IF parser.sym = SCAN.lxLSQUARE THEN |
getpos(parser, pos2); |
check(TARGETS.target = TARGETS.STM32CM3, pos2, 24); |
Next(parser); |
getpos(parser, pos2); |
ConstExpression(parser, iv); |
check(iv.typ = ARITH.tINTEGER, pos2, 43); |
check((0 <= ARITH.Int(iv)) & (ARITH.Int(iv) <= THUMB.maxIVT), pos2, 46); |
check(THUMB.SetIV(ARITH.Int(iv)), pos2, 121); |
checklex(parser, SCAN.lxRSQUARE); |
Next(parser); |
handler := TRUE |
END; |
codeProc := call IN {PROG.code, PROG._code}; |
IF call IN {PROG.systemv, PROG._systemv} THEN |
948,7 → 969,11 |
IF import = NIL THEN |
label := IL.NewLabel(); |
proc.proc.label := label |
proc.proc.label := label; |
proc.proc.used := handler; |
IF handler THEN |
IL.AddCmd2(IL.opHANDLER, label, ARITH.Int(iv)) |
END |
END; |
IF codeProc THEN |
958,8 → 983,10 |
getpos(parser, pos2); |
ConstExpression(parser, code); |
check(code.typ = ARITH.tINTEGER, pos2, 43); |
IF program.target.sys # mConst.Target_iMSP430 THEN |
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
check(ARITH.range(code, 0, 255), pos2, 42) |
ELSIF TARGETS.CPU = TARGETS.cpuTHUMB THEN |
check(ARITH.range(code, 0, 65535), pos2, 110) |
END; |
IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
comma := parser.sym = SCAN.lxCOMMA; |
976,8 → 1003,8 |
IF import = NIL THEN |
IF parser.main & proc.export & program.dll THEN |
IF program.obj THEN |
IF parser.main & proc.export & TARGETS.Dll THEN |
IF TARGETS.target = TARGETS.KolibriOSDLL THEN |
check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114) |
END; |
IL.AddExp(label, proc.name.s); |
1023,8 → 1050,8 |
proc.proc.leave := IL.LeaveC() |
END; |
IF program.target.sys = mConst.Target_iMSP430 THEN |
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63) |
IF TARGETS.CPU = TARGETS.cpuMSP430 THEN |
check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63) |
END |
END; |
1141,7 → 1168,13 |
ImportList(parser) |
END; |
CONSOLE.String("compiling "); CONSOLE.String(unit.name.s); |
INC(modules); |
CONSOLE.String("compiling "); |
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN |
CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ") |
END; |
CONSOLE.String(unit.name.s); |
IF parser.unit.sysimport THEN |
CONSOLE.String(" (SYSTEM)") |
END; |
1156,6 → 1189,9 |
IL.SetLabel(errlabel); |
IL.StrAdr(name); |
IL.Param1; |
IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN |
IL.AddCmd(IL.opPUSHC, modules) |
END; |
IL.AddCmd0(IL.opERR); |
FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO |
1227,7 → 1263,7 |
parser.path := path; |
parser.lib_path := lib_path; |
parser.ext := mConst.FILE_EXT; |
parser.ext := UTILS.FILE_EXT; |
parser.fname := path; |
parser.modname := ""; |
parser.scanner := NIL; |
1247,12 → 1283,13 |
END create; |
PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS); |
PROCEDURE init* (options: PROG.OPTIONS); |
BEGIN |
program := PROG.create(bit_depth, target, options); |
program := PROG.create(options); |
parsers := C.create(); |
lines := 0 |
lines := 0; |
modules := 0 |
END init; |
END PARS. |
END PARS. |
/programs/develop/oberon07/Source/PATHS.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/PE32.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
7,7 → 7,7 |
MODULE PE32; |
IMPORT BIN, LISTS, UTILS, WR := WRITER, mConst := CONSTANTS, CHL := CHUNKLISTS; |
IMPORT BIN, LISTS, UTILS, WR := WRITER, CHL := CHUNKLISTS; |
CONST |
165,13 → 165,9 |
Relocations: LISTS.LIST; |
bit64: BOOLEAN; |
libcnt: INTEGER; |
SizeOfWord: INTEGER; |
PROCEDURE SIZE (): INTEGER; |
RETURN SIZE_OF_DWORD * (ORD(bit64) + 1) |
END SIZE; |
PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER; |
BEGIN |
258,7 → 254,7 |
import := import.next(BIN.IMPRT) |
END |
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SIZE() |
RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord |
END GetImportSize; |
266,33 → 262,34 |
VAR |
reloc: BIN.RELOC; |
iproc: BIN.IMPRT; |
L: INTEGER; |
delta: INTEGER; |
AdrImp: INTEGER; |
code: CHL.BYTELIST; |
L, delta, delta0, AdrImp: 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(bit64); |
reloc := program.rel_list.first(BIN.RELOC); |
WHILE reloc # NIL DO |
L := BIN.get32le(program.code, reloc.offset); |
delta := 3 - reloc.offset - Address.Code - 7 * ORD(bit64); |
L := BIN.get32le(code, reloc.offset); |
delta := delta0 - reloc.offset - Address.Code; |
CASE reloc.opcode OF |
|BIN.PICDATA: |
BIN.put32le(program.code, reloc.offset, L + Address.Data + delta) |
BIN.put32le(code, reloc.offset, L + Address.Data + delta) |
|BIN.PICCODE: |
BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) |
BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) |
|BIN.PICBSS: |
BIN.put32le(program.code, reloc.offset, L + Address.Bss + delta) |
BIN.put32le(code, reloc.offset, L + Address.Bss + delta) |
|BIN.PICIMP: |
iproc := BIN.GetIProc(program, L); |
BIN.put32le(program.code, reloc.offset, iproc.FirstThunk * SIZE() + AdrImp + delta) |
BIN.put32le(code, reloc.offset, iproc.FirstThunk * SizeOfWord + AdrImp + delta) |
END; |
418,7 → 415,6 |
i: INTEGER; |
BEGIN |
WriteWord(file, h.Magic); |
WR.WriteByte(file, h.MajorLinkerVersion); |
499,6 → 495,7 |
BEGIN |
bit64 := amd64; |
SizeOfWord := SIZE_OF_DWORD * (ORD(bit64) + 1); |
Relocations := LISTS.create(NIL); |
Size.Code := CHL.Length(program.code); |
532,8 → 529,8 |
PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll)); |
PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64)); |
PEHeader.OptionalHeader.MajorLinkerVersion := mConst.vMajor; |
PEHeader.OptionalHeader.MinorLinkerVersion := mConst.vMinor; |
PEHeader.OptionalHeader.MajorLinkerVersion := UTILS.vMajor; |
PEHeader.OptionalHeader.MinorLinkerVersion := UTILS.vMinor; |
PEHeader.OptionalHeader.SizeOfCode := align(Size.Code, FileAlignment); |
PEHeader.OptionalHeader.SizeOfInitializedData := 0; |
PEHeader.OptionalHeader.SizeOfUninitializedData := 0; |
658,7 → 655,7 |
n := (libcnt + 1) * 5; |
ImportTable := CHL.CreateIntList(); |
FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SIZE() + n - 1 DO |
FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SizeOfWord + n - 1 DO |
CHL.PushInt(ImportTable, 0) |
END; |
666,11 → 663,11 |
import := program.imp_list.first(BIN.IMPRT); |
WHILE import # NIL DO |
IF import.label = 0 THEN |
CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
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 * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
i := i + 5 |
END; |
import := import.next(BIN.IMPRT) |
/programs/develop/oberon07/Source/PROG.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
7,7 → 7,7 |
MODULE PROG; |
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS; |
IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS; |
CONST |
199,25 → 199,15 |
locsize*: INTEGER; |
procs*: LISTS.LIST; |
dll*: BOOLEAN; |
obj*: BOOLEAN; |
sysflags*: SET; |
options*: OPTIONS; |
stTypes*: RECORD |
tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, |
tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_ |
END; |
target*: RECORD |
bit_depth*: INTEGER; |
word*: INTEGER; |
adr*: INTEGER; |
sys*: INTEGER; |
sysflags*: SET; |
options*: OPTIONS |
END |
END; |
249,7 → 239,6 |
PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER; |
VAR |
word: INTEGER; |
size: INTEGER; |
BEGIN |
263,9 → 252,8 |
END |
END |
ELSE |
word := program.target.word; |
IF UTILS.Align(size, word) THEN |
size := size DIV word; |
IF UTILS.Align(size, TARGETS.WordSize) THEN |
size := size DIV TARGETS.WordSize; |
IF UTILS.maxint - program.locsize >= size THEN |
INC(program.locsize, size); |
varIdent.offset := program.locsize |
682,10 → 670,12 |
ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); |
ident.type := program.stTypes.tBOOLEAN; |
IF program.target.sys # mConst.Target_iMSP430 THEN |
IF TARGETS.RealSize # 0 THEN |
ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE); |
ident.type := program.stTypes.tREAL; |
ident.type := program.stTypes.tREAL |
END; |
IF TARGETS.BitDepth >= 32 THEN |
ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE); |
ident.type := program.stTypes.tWCHAR |
END |
737,14 → 727,19 |
EnterFunc(unit, "MIN", stMIN); |
EnterFunc(unit, "MAX", stMAX); |
IF unit.program.target.sys # mConst.Target_iMSP430 THEN |
IF TARGETS.RealSize # 0 THEN |
EnterProc(unit, "PACK", stPACK); |
EnterProc(unit, "UNPK", stUNPK); |
EnterProc(unit, "DISPOSE", stDISPOSE); |
EnterFunc(unit, "WCHR", stWCHR); |
EnterFunc(unit, "FLOOR", stFLOOR); |
EnterFunc(unit, "FLT", stFLT) |
END; |
IF TARGETS.BitDepth >= 32 THEN |
EnterFunc(unit, "WCHR", stWCHR) |
END; |
IF TARGETS.Dispose THEN |
EnterProc(unit, "DISPOSE", stDISPOSE) |
END |
END enterStProcs; |
782,7 → 777,7 |
unit.sysimport := FALSE; |
IF unit.name.s = mConst.RTL_NAME THEN |
IF unit.name.s = UTILS.RTL_NAME THEN |
program.rtl := unit |
END |
1037,7 → 1032,7 |
t.unit := unit; |
t.num := 0; |
CASE program.target.bit_depth OF |
CASE TARGETS.BitDepth OF |
|16: t.call := default16 |
|32: t.call := default32 |
|64: t.call := default64 |
1119,12 → 1114,18 |
EnterProc(unit, "DINT", idSYSPROC, sysDINT) |
END; |
*) |
IF program.target.sys # mConst.Target_iMSP430 THEN |
IF TARGETS.RealSize # 0 THEN |
EnterProc(unit, "INF", idSYSFUNC, sysINF); |
END; |
IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
EnterProc(unit, "COPY", idSYSPROC, sysCOPY) |
END; |
IF TARGETS.BitDepth >= 32 THEN |
EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); |
EnterProc(unit, "INF", idSYSFUNC, sysINF); |
EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); |
EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); |
EnterProc(unit, "COPY", idSYSPROC, sysCOPY); |
ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); |
ident.type := program.stTypes.tCARD32; |
1191,7 → 1192,7 |
END DelUnused; |
PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM; |
PROCEDURE create* (options: OPTIONS): PROGRAM; |
VAR |
program: PROGRAM; |
1198,34 → 1199,18 |
BEGIN |
idents := C.create(); |
UTILS.SetBitDepth(bit_depth); |
UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8); |
NEW(program); |
program.target.bit_depth := bit_depth; |
program.target.word := bit_depth DIV 8; |
program.target.adr := bit_depth DIV 8; |
program.target.sys := target; |
program.target.options := options; |
program.options := options; |
CASE target OF |
|mConst.Target_iConsole, |
mConst.Target_iGUI, |
mConst.Target_iDLL: program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|mConst.Target_iELF32, |
mConst.Target_iELFSO32: program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|mConst.Target_iKolibri, |
mConst.Target_iObject: program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|mConst.Target_iConsole64, |
mConst.Target_iGUI64, |
mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|mConst.Target_iELF64, |
mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|mConst.Target_iMSP430: program.target.sysflags := {sf_code} |
CASE TARGETS.OS OF |
|TARGETS.osWIN32: program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|TARGETS.osLINUX32: program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|TARGETS.osKOS: program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
|TARGETS.osWIN64: program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|TARGETS.osLINUX64: program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
|TARGETS.osNONE: program.sysflags := {sf_code} |
END; |
program.recCount := -1; |
1235,39 → 1220,36 |
program.types := LISTS.create(NIL); |
program.procs := LISTS.create(NIL); |
program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL); |
program.stTypes.tINTEGER := enterType(program, tINTEGER, TARGETS.WordSize, 0, NIL); |
program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); |
program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); |
program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL); |
program.stTypes.tSET := enterType(program, tSET, TARGETS.WordSize, 0, NIL); |
program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); |
IF target # mConst.Target_iMSP430 THEN |
program.stTypes.tINTEGER.align := TARGETS.WordSize; |
program.stTypes.tBYTE.align := 1; |
program.stTypes.tCHAR.align := 1; |
program.stTypes.tSET.align := TARGETS.WordSize; |
program.stTypes.tBOOLEAN.align := 1; |
IF TARGETS.BitDepth >= 32 THEN |
program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); |
program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); |
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL) |
program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); |
program.stTypes.tWCHAR.align := 2; |
program.stTypes.tCARD32.align := 4 |
END; |
program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL); |
program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL); |
IF TARGETS.RealSize # 0 THEN |
program.stTypes.tREAL := enterType(program, tREAL, TARGETS.RealSize, 0, NIL); |
program.stTypes.tREAL.align := TARGETS.RealSize |
END; |
program.stTypes.tSTRING := enterType(program, tSTRING, TARGETS.WordSize, 0, NIL); |
program.stTypes.tNIL := enterType(program, tNIL, TARGETS.WordSize, 0, NIL); |
program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); |
program.stTypes.tANYREC.closed := TRUE; |
program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; |
program.stTypes.tBYTE.align := 1; |
program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; |
program.stTypes.tSET.align := program.stTypes.tSET.size; |
program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; |
IF target # mConst.Target_iMSP430 THEN |
program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; |
program.stTypes.tREAL.align := program.stTypes.tREAL.size; |
program.stTypes.tCARD32.align := program.stTypes.tCARD32.size |
END; |
program.dll := FALSE; |
program.obj := FALSE; |
createSysUnit(program) |
RETURN program |
/programs/develop/oberon07/Source/REG.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/SCAN.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/STATEMENTS.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
9,8 → 9,8 |
IMPORT |
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, |
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; |
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, |
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS; |
CONST |
29,9 → 29,7 |
chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; |
cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3; |
TYPE |
isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN; |
418,7 → 416,7 |
IF e.obj = eCONST THEN |
IL.Float(ARITH.Float(e.value)) |
END; |
IL.savef |
IL.savef(e.obj = eCONST) |
ELSIF isChar(e) & (VarType = tCHAR) THEN |
IF e.obj = eCONST THEN |
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) |
500,6 → 498,7 |
PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
REPEAT |
res := t.length; |
513,8 → 512,8 |
PROCEDURE OpenArray (t, t2: PROG.TYPE_); |
VAR |
n: INTEGER; |
d1, d2: INTEGER; |
n, d1, d2: INTEGER; |
BEGIN |
IF t.length # 0 THEN |
IL.Param1; |
606,7 → 605,7 |
IF p.type.base = tCHAR THEN |
stroffs := String(e); |
IL.StrAdr(stroffs); |
IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
ERRORS.WarningMsg(pos.line, pos.col, 0) |
END |
ELSE (* WCHAR *) |
648,17 → 647,16 |
PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
e2: PARS.EXPR; |
e1, e2: PARS.EXPR; |
pos: PARS.POSITION; |
proc: INTEGER; |
label: INTEGER; |
proc, |
label, |
n, i: INTEGER; |
code: ARITH.VALUE; |
e1: PARS.EXPR; |
wchar: BOOLEAN; |
wchar, |
comma: BOOLEAN; |
cmd1, |
cmd2: IL.COMMAND; |
comma: BOOLEAN; |
PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); |
675,6 → 673,7 |
PROCEDURE shift_minmax (proc: INTEGER): CHAR; |
VAR |
res: CHAR; |
BEGIN |
CASE proc OF |
|PROG.stASR: res := "A" |
777,7 → 776,7 |
|PROG.stNEW: |
varparam(parser, pos, isPtr, TRUE, e); |
IF CPU = cpuMSP430 THEN |
IF CPU = TARGETS.cpuMSP430 THEN |
PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) |
END; |
IL.New(e.type.base.size, e.type.base.num) |
885,9 → 884,9 |
PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
IF e2.obj = eCONST THEN |
IF e2.type = tREAL THEN |
IL.Float(ARITH.Float(e2.value)); |
IL.setlast(endcall.prev(IL.COMMAND)); |
IL.Float(ARITH.Float(e2.value)); |
IL.savef |
IL.savef(FALSE) |
ELSE |
LoadConst(e2); |
IL.setlast(endcall.prev(IL.COMMAND)); |
896,7 → 895,7 |
ELSE |
IL.setlast(endcall.prev(IL.COMMAND)); |
IF e2.type = tREAL THEN |
IL.savef |
IL.savef(FALSE) |
ELSIF e2.type = tBYTE THEN |
IL.SysPut(tINTEGER.size) |
ELSE |
962,8 → 961,10 |
getpos(parser, pos); |
PARS.ConstExpression(parser, code); |
PARS.check(code.typ = ARITH.tINTEGER, pos, 43); |
IF CPU # cpuMSP430 THEN |
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
PARS.check(ARITH.range(code, 0, 255), pos, 42) |
ELSIF CPU = TARGETS.cpuTHUMB THEN |
PARS.check(ARITH.range(code, 0, 65535), pos, 110) |
END; |
IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
comma := parser.sym = SCAN.lxCOMMA; |
1113,7 → 1114,7 |
IF e.obj = eCONST THEN |
ARITH.odd(e.value) |
ELSE |
IL.AddCmd0(IL.opODD) |
IL.AddCmd(IL.opMODR, 2) |
END |
|PROG.stORD: |
1409,9 → 1410,8 |
PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); |
VAR |
label: INTEGER; |
label, offset, n, k: INTEGER; |
type: PROG.TYPE_; |
n, offset, k: INTEGER; |
BEGIN |
1571,11 → 1571,11 |
PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); |
VAR |
cconv: INTEGER; |
parSize: INTEGER; |
callconv: INTEGER; |
fparSize: INTEGER; |
int, flt: INTEGER; |
cconv, |
parSize, |
callconv, |
fparSize, |
int, flt, |
stk_par: INTEGER; |
BEGIN |
1862,12 → 1862,9 |
PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); |
VAR |
pos: PARS.POSITION; |
op: INTEGER; |
e1: PARS.EXPR; |
op, label, label1: INTEGER; |
label: INTEGER; |
label1: INTEGER; |
BEGIN |
factor(parser, e); |
label := -1; |
1972,10 → 1969,7 |
|SCAN.lxDIV, SCAN.lxMOD: |
PARS.check(isInt(e) & isInt(e1), pos, 37); |
IF e1.obj = eCONST THEN |
PARS.check(~ARITH.isZero(e1.value), pos, 46); |
IF CPU = cpuMSP430 THEN |
PARS.check(ARITH.Int(e1.value) > 0, pos, 122) |
END |
END; |
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
1988,11 → 1982,7 |
ELSE |
IF e1.obj # eCONST THEN |
label1 := IL.NewLabel(); |
IF CPU = cpuMSP430 THEN |
IL.AddJmpCmd(IL.opJG, label1) |
ELSE |
IL.AddJmpCmd(IL.opJNZ, label1) |
END |
END; |
IF e.obj = eCONST THEN |
IL.OnError(pos.line, errDIV); |
2223,7 → 2213,6 |
res: BOOLEAN; |
BEGIN |
res := TRUE; |
IF isString(e) & isCharArray(e1) THEN |
3026,11 → 3015,11 |
ELSIF isRec(e) THEN |
IL.drop; |
IL.AddCmd(IL.opLADR, e.ident.offset - 1); |
IL.load(PARS.program.target.word) |
IL.load(TARGETS.WordSize) |
ELSIF isPtr(e) THEN |
deref(pos, e, FALSE, errPTR); |
IL.AddCmd(IL.opSUBR, PARS.program.target.word); |
IL.load(PARS.program.target.word) |
IL.AddCmd(IL.opSUBR, TARGETS.WordSize); |
IL.load(TARGETS.WordSize) |
END; |
PARS.checklex(parser, SCAN.lxOF); |
3243,7 → 3232,6 |
rtl := PARS.program.rtl; |
ASSERT(rtl # NIL); |
IF CPU IN {cpuX86, cpuAMD64} THEN |
getproc(rtl, "_strcmp", IL._strcmp); |
getproc(rtl, "_length", IL._length); |
getproc(rtl, "_arrcpy", IL._arrcpy); |
3250,22 → 3238,36 |
getproc(rtl, "_is", IL._is); |
getproc(rtl, "_guard", IL._guard); |
getproc(rtl, "_guardrec", IL._guardrec); |
getproc(rtl, "_error", IL._error); |
getproc(rtl, "_new", IL._new); |
getproc(rtl, "_rot", IL._rot); |
getproc(rtl, "_strcpy", IL._strcpy); |
getproc(rtl, "_move", IL._move); |
getproc(rtl, "_divmod", IL._divmod); |
getproc(rtl, "_set", IL._set); |
getproc(rtl, "_set1", IL._set1); |
getproc(rtl, "_isrec", IL._isrec); |
getproc(rtl, "_lengthw", IL._lengthw); |
getproc(rtl, "_strcmpw", IL._strcmpw); |
getproc(rtl, "_init", IL._init); |
IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
getproc(rtl, "_error", IL._error); |
getproc(rtl, "_divmod", IL._divmod); |
getproc(rtl, "_exit", IL._exit); |
getproc(rtl, "_dispose", IL._dispose); |
getproc(rtl, "_isrec", IL._isrec); |
getproc(rtl, "_dllentry", IL._dllentry); |
getproc(rtl, "_dispose", IL._dispose); |
getproc(rtl, "_exit", IL._exit); |
getproc(rtl, "_init", IL._init); |
getproc(rtl, "_sofinit", IL._sofinit) |
ELSIF CPU = TARGETS.cpuTHUMB THEN |
getproc(rtl, "_fmul", IL._fmul); |
getproc(rtl, "_fdiv", IL._fdiv); |
getproc(rtl, "_fdivi", IL._fdivi); |
getproc(rtl, "_fadd", IL._fadd); |
getproc(rtl, "_fsub", IL._fsub); |
getproc(rtl, "_fsubi", IL._fsubi); |
getproc(rtl, "_fcmp", IL._fcmp); |
getproc(rtl, "_floor", IL._floor); |
getproc(rtl, "_flt", IL._flt); |
getproc(rtl, "_pack", IL._pack); |
getproc(rtl, "_unpk", IL._unpk) |
END |
END setrtl; |
3286,19 → 3288,9 |
tREAL := PARS.program.stTypes.tREAL; |
Options := options; |
CPU := TARGETS.CPU; |
CASE target OF |
|mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: |
CPU := cpuAMD64 |
|mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, |
mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, |
mConst.Target_iELFSO32: |
CPU := cpuX86 |
|mConst.Target_iMSP430: |
CPU := cpuMSP430 |
END; |
ext := mConst.FILE_EXT; |
ext := UTILS.FILE_EXT; |
CaseLabels := C.create(); |
CaseVar := C.create(); |
3305,25 → 3297,21 |
CaseVariants := LISTS.create(NIL); |
LISTS.push(CaseVariants, NewVariant(0, NIL)); |
CASE CPU OF |
|cpuAMD64: IL.init(6, IL.little_endian) |
|cpuX86: IL.init(8, IL.little_endian) |
|cpuMSP430: IL.init(0, IL.little_endian) |
END; |
IL.init(CPU); |
IF CPU # cpuMSP430 THEN |
IF CPU # TARGETS.cpuMSP430 THEN |
parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
IF parser.open(parser, mConst.RTL_NAME) THEN |
IF parser.open(parser, UTILS.RTL_NAME) THEN |
parser.parse(parser); |
PARS.destroy(parser) |
ELSE |
PARS.destroy(parser); |
parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); |
IF parser.open(parser, mConst.RTL_NAME) THEN |
IF parser.open(parser, UTILS.RTL_NAME) THEN |
parser.parse(parser); |
PARS.destroy(parser) |
ELSE |
ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT) |
ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT) |
END |
END |
END; |
3334,16 → 3322,16 |
IF parser.open(parser, modname) THEN |
parser.parse(parser) |
ELSE |
ERRORS.FileNotFound(path, modname, mConst.FILE_EXT) |
ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT) |
END; |
PARS.destroy(parser); |
IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN |
IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN |
ERRORS.Error(204) |
END; |
IF CPU # cpuMSP430 THEN |
IF CPU # TARGETS.cpuMSP430 THEN |
setrtl |
END; |
3352,12 → 3340,13 |
IL.set_bss(PARS.program.bss); |
CASE CPU OF |
| cpuAMD64: AMD64.CodeGen(outname, target, options) |
| cpuX86: X86.CodeGen(outname, target, options) |
|cpuMSP430: MSP430.CodeGen(outname, target, options) |
|TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options) |
|TARGETS.cpuX86: X86.CodeGen(outname, target, options) |
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options) |
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options) |
END |
END compile; |
END STATEMENTS. |
END STATEMENTS. |
/programs/develop/oberon07/Source/STRINGS.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
13,6 → 13,7 |
PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2, i, j: INTEGER; |
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
32,13 → 33,12 |
END append; |
PROCEDURE reverse* (VAR s: ARRAY OF CHAR); |
PROCEDURE reverse (VAR s: ARRAY OF CHAR); |
VAR |
i, j: INTEGER; |
a, b: CHAR; |
BEGIN |
i := 0; |
j := LENGTH(s) - 1; |
172,6 → 172,27 |
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 := 0; |
WHILE (i < LEN(str)) & (str[i] # 0X) DO |
cap(str[i]); |
INC(i) |
END |
END UpCase; |
PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN; |
VAR |
i, k: INTEGER; |
276,21 → 297,21 |
u := ORD(c) |
|0C1X..0DFX: |
u := LSL(ORD(c) - 0C0H, 6); |
u := (ORD(c) - 0C0H) * 64; |
IF i + 1 < srclen THEN |
INC(i); |
INC(u, ORD(BITS(ORD(src[i])) * {0..5})) |
INC(u, ORD(src[i]) MOD 64) |
END |
|0E1X..0EFX: |
u := LSL(ORD(c) - 0E0H, 12); |
u := (ORD(c) - 0E0H) * 4096; |
IF i + 1 < srclen THEN |
INC(i); |
INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64) |
INC(u, (ORD(src[i]) MOD 64) * 64) |
END; |
IF i + 1 < srclen THEN |
INC(i); |
INC(u, ORD(BITS(ORD(src[i])) * {0..5})) |
INC(u, ORD(src[i]) MOD 64) |
END |
(* |
|0F1X..0F7X: |
/programs/develop/oberon07/Source/TARGETS.ob07 |
---|
0,0 → 1,116 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE TARGETS; |
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; |
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3; |
osNONE* = 0; osWIN32* = 1; osWIN64* = 2; |
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5; |
TYPE |
STRING = ARRAY 32 OF CHAR; |
TARGET = RECORD |
target, CPU, BitDepth, OS, RealSize: INTEGER; |
ComLinePar*, LibDir, FileExt: STRING |
END; |
VAR |
Targets*: ARRAY 14 OF TARGET; |
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*: INTEGER; |
ComLinePar*, LibDir*, FileExt*: STRING; |
Import*, Dispose*, Dll*: BOOLEAN; |
PROCEDURE Enter (idx, CPU, BitDepth, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); |
BEGIN |
Targets[idx].target := idx; |
Targets[idx].CPU := CPU; |
Targets[idx].BitDepth := BitDepth; |
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 := Targets[i].BitDepth; |
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 {MSP430, STM32CM3}); |
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; |
WordSize := BitDepth DIV 8; |
AdrSize := WordSize |
END |
RETURN res |
END Select; |
BEGIN |
Enter( MSP430, cpuMSP430, 16, 0, osNONE, "msp430", "MSP430", ".hex"); |
Enter( Win32C, cpuX86, 32, 8, osWIN32, "win32con", "Windows32", ".exe"); |
Enter( Win32GUI, cpuX86, 32, 8, osWIN32, "win32gui", "Windows32", ".exe"); |
Enter( Win32DLL, cpuX86, 32, 8, osWIN32, "win32dll", "Windows32", ".dll"); |
Enter( KolibriOS, cpuX86, 32, 8, osKOS, "kosexe", "KolibriOS", ""); |
Enter( KolibriOSDLL, cpuX86, 32, 8, osKOS, "kosdll", "KolibriOS", ".obj"); |
Enter( Win64C, cpuAMD64, 64, 8, osWIN64, "win64con", "Windows64", ".exe"); |
Enter( Win64GUI, cpuAMD64, 64, 8, osWIN64, "win64gui", "Windows64", ".exe"); |
Enter( Win64DLL, cpuAMD64, 64, 8, osWIN64, "win64dll", "Windows64", ".dll"); |
Enter( Linux32, cpuX86, 32, 8, osLINUX32, "linux32exe", "Linux32", ""); |
Enter( Linux32SO, cpuX86, 32, 8, osLINUX32, "linux32so", "Linux32", ".so"); |
Enter( Linux64, cpuAMD64, 64, 8, osLINUX64, "linux64exe", "Linux64", ""); |
Enter( Linux64SO, cpuAMD64, 64, 8, osLINUX64, "linux64so", "Linux64", ".so"); |
Enter( STM32CM3, cpuTHUMB, 32, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); |
END TARGETS. |
/programs/develop/oberon07/Source/TEXTDRV.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/THUMB.ob07 |
---|
0,0 → 1,2430 |
(* |
BSD 2-Clause License |
Copyright (c) 2019-2020, Anton Krotov |
All rights reserved. |
*) |
MODULE THUMB; |
IMPORT PROG, LISTS, CHL := CHUNKLISTS, BIN, REG, IL, C := CONSOLE, |
UTILS, WR := WRITER, HEX, ERRORS, TARGETS; |
CONST |
R0 = 0; R1 = 1; R2 = 2; R3 = 3; R4 = 4; |
SP = 13; LR = 14; PC = 15; |
ACC = R0; |
je = 0; jne = 1; jnb = 2; jb = 3; jge = 10; jl = 11; jg = 12; jle = 13; |
inf = 7F800000H; |
STM32_minROM* = 16; STM32_maxROM* = 65536; |
STM32_minRAM* = 4; STM32_maxRAM* = 65536; |
maxIVT* = 1023; |
TYPE |
COMMAND = IL.COMMAND; |
ANYCODE = POINTER TO RECORD (LISTS.ITEM) |
offset: INTEGER |
END; |
CODE = POINTER TO RECORD (ANYCODE) |
code: INTEGER |
END; |
LABEL = POINTER TO RECORD (ANYCODE) |
label: INTEGER |
END; |
JUMP = POINTER TO RECORD (ANYCODE) |
label, diff, len, cond: INTEGER; |
short: BOOLEAN |
END; |
JMP = POINTER TO RECORD (JUMP) |
END; |
JCC = POINTER TO RECORD (JUMP) |
END; |
CBXZ = POINTER TO RECORD (JUMP) |
reg: INTEGER |
END; |
CALL = POINTER TO RECORD (JUMP) |
END; |
RELOC = POINTER TO RECORD (ANYCODE) |
reg, rel, value: INTEGER |
END; |
RELOCCODE = ARRAY 7 OF INTEGER; |
VAR |
R: REG.REGS; |
tcount: INTEGER; |
CodeList: LISTS.LIST; |
program: BIN.PROGRAM; |
StkCount: INTEGER; |
Target: RECORD |
FlashAdr, |
SRAMAdr, |
IVTLen, |
MinStack, |
Reserved: INTEGER; |
InstrSet: RECORD thumb2, it, cbxz, sdiv: BOOLEAN END |
END; |
IVT: ARRAY maxIVT + 1 OF INTEGER; |
sdivProc, trap, genTrap, entry, emptyProc, int0, genInt: INTEGER; |
PROCEDURE Code (code: INTEGER); |
VAR |
c: CODE; |
BEGIN |
NEW(c); |
c.code := code; |
LISTS.push(CodeList, c) |
END Code; |
PROCEDURE Label (label: INTEGER); |
VAR |
L: LABEL; |
BEGIN |
NEW(L); |
L.label := label; |
LISTS.push(CodeList, L) |
END Label; |
PROCEDURE jcc (cond, label: INTEGER); |
VAR |
j: JCC; |
BEGIN |
NEW(j); |
j.label := label; |
j.cond := cond; |
j.short := FALSE; |
j.len := 3; |
LISTS.push(CodeList, j) |
END jcc; |
PROCEDURE cbxz (cond, reg, label: INTEGER); |
VAR |
j: CBXZ; |
BEGIN |
NEW(j); |
j.label := label; |
j.cond := cond; |
j.reg := reg; |
j.short := FALSE; |
j.len := 4; |
LISTS.push(CodeList, j) |
END cbxz; |
PROCEDURE jmp (label: INTEGER); |
VAR |
j: JMP; |
BEGIN |
NEW(j); |
j.label := label; |
j.short := FALSE; |
j.len := 2; |
LISTS.push(CodeList, j) |
END jmp; |
PROCEDURE call (label: INTEGER); |
VAR |
c: CALL; |
BEGIN |
NEW(c); |
c.label := label; |
c.short := FALSE; |
c.len := 2; |
LISTS.push(CodeList, c) |
END call; |
PROCEDURE reloc (reg, rel, value: INTEGER); |
VAR |
r: RELOC; |
BEGIN |
NEW(r); |
r.reg := reg; |
r.rel := rel; |
r.value := value; |
LISTS.push(CodeList, r) |
END reloc; |
PROCEDURE NewLabel (): INTEGER; |
BEGIN |
BIN.NewLabel(program) |
RETURN IL.NewLabel() |
END NewLabel; |
PROCEDURE range (x, n: INTEGER): BOOLEAN; |
RETURN (0 <= x) & (x < LSL(1, n)) |
END range; |
PROCEDURE srange (x, n: INTEGER): BOOLEAN; |
RETURN (-LSL(1, n - 1) <= x) & (x < LSL(1, n - 1)) |
END srange; |
PROCEDURE gen1 (op, imm, rs, rd: INTEGER); |
BEGIN |
ASSERT(op IN {0..2}); |
ASSERT(range(imm, 5)); |
ASSERT(range(rs, 3)); |
ASSERT(range(rd, 3)); |
Code(LSL(op, 11) + LSL(imm, 6) + LSL(rs, 3) + rd) |
END gen1; |
PROCEDURE gen2 (i, op: BOOLEAN; imm, rs, rd: INTEGER); |
BEGIN |
ASSERT(range(imm, 3)); |
ASSERT(range(rs, 3)); |
ASSERT(range(rd, 3)); |
Code(1800H + LSL(ORD(i), 10) + LSL(ORD(op), 9) + LSL(imm, 6) + LSL(rs, 3) + rd) |
END gen2; |
PROCEDURE gen3 (op, rd, imm: INTEGER); |
BEGIN |
ASSERT(range(op, 2)); |
ASSERT(range(rd, 3)); |
ASSERT(range(imm, 8)); |
Code(2000H + LSL(op, 11) + LSL(rd, 8) + imm) |
END gen3; |
PROCEDURE gen4 (op, rs, rd: INTEGER); |
BEGIN |
ASSERT(range(op, 4)); |
ASSERT(range(rs, 3)); |
ASSERT(range(rd, 3)); |
Code(4000H + LSL(op, 6) + LSL(rs, 3) + rd) |
END gen4; |
PROCEDURE gen5 (op: INTEGER; h1, h2: BOOLEAN; rs, rd: INTEGER); |
BEGIN |
ASSERT(range(op, 2)); |
ASSERT(range(rs, 3)); |
ASSERT(range(rd, 3)); |
Code(4400H + LSL(op, 8) + LSL(ORD(h1), 7) + LSL(ORD(h2), 6) + LSL(rs, 3) + rd) |
END gen5; |
PROCEDURE gen7 (l, b: BOOLEAN; ro, rb, rd: INTEGER); |
BEGIN |
ASSERT(range(ro, 3)); |
ASSERT(range(rb, 3)); |
ASSERT(range(rd, 3)); |
Code(5000H + LSL(ORD(l), 11) + LSL(ORD(b), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) |
END gen7; |
PROCEDURE gen8 (h, s: BOOLEAN; ro, rb, rd: INTEGER); |
BEGIN |
ASSERT(range(ro, 3)); |
ASSERT(range(rb, 3)); |
ASSERT(range(rd, 3)); |
Code(5200H + LSL(ORD(h), 11) + LSL(ORD(s), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) |
END gen8; |
PROCEDURE gen9 (b, l: BOOLEAN; imm, rb, rd: INTEGER); |
BEGIN |
ASSERT(range(imm, 5)); |
ASSERT(range(rb, 3)); |
ASSERT(range(rd, 3)); |
Code(6000H + LSL(ORD(b), 12) + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) |
END gen9; |
PROCEDURE gen10 (l: BOOLEAN; imm, rb, rd: INTEGER); |
BEGIN |
ASSERT(range(imm, 5)); |
ASSERT(range(rb, 3)); |
ASSERT(range(rd, 3)); |
Code(8000H + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) |
END gen10; |
PROCEDURE gen11 (l: BOOLEAN; rd, imm: INTEGER); |
BEGIN |
ASSERT(range(rd, 3)); |
ASSERT(range(imm, 8)); |
Code(9000H + LSL(ORD(l), 11) + LSL(rd, 8) + imm) |
END gen11; |
PROCEDURE gen12 (sp: BOOLEAN; rd, imm: INTEGER); |
BEGIN |
ASSERT(range(rd, 3)); |
ASSERT(range(imm, 8)); |
Code(0A000H + LSL(ORD(sp), 11) + LSL(rd, 8) + imm) |
END gen12; |
PROCEDURE gen14 (l, r: BOOLEAN; rlist: SET); |
VAR |
i, n: INTEGER; |
BEGIN |
ASSERT(range(ORD(rlist), 8)); |
n := ORD(r); |
FOR i := 0 TO 7 DO |
IF i IN rlist THEN |
INC(n) |
END |
END; |
IF l THEN |
n := -n |
END; |
INC(StkCount, n); |
Code(0B400H + LSL(ORD(l), 11) + LSL(ORD(r), 8) + ORD(rlist)) |
END gen14; |
PROCEDURE split16 (imm16: INTEGER; VAR imm4, imm1, imm3, imm8: INTEGER); |
BEGIN |
ASSERT(range(imm16, 16)); |
imm8 := imm16 MOD 256; |
imm4 := LSR(imm16, 12); |
imm3 := LSR(imm16, 8) MOD 8; |
imm1 := LSR(imm16, 11) MOD 2; |
END split16; |
PROCEDURE LslImm (r, imm5: INTEGER); |
BEGIN |
gen1(0, imm5, r, r) |
END LslImm; |
PROCEDURE LsrImm (r, imm5: INTEGER); |
BEGIN |
gen1(1, imm5, r, r) |
END LsrImm; |
PROCEDURE AsrImm (r, imm5: INTEGER); |
BEGIN |
gen1(2, imm5, r, r) |
END AsrImm; |
PROCEDURE AddReg (rd, rs, rn: INTEGER); |
BEGIN |
gen2(FALSE, FALSE, rn, rs, rd) |
END AddReg; |
PROCEDURE SubReg (rd, rs, rn: INTEGER); |
BEGIN |
gen2(FALSE, TRUE, rn, rs, rd) |
END SubReg; |
PROCEDURE AddImm8 (rd, imm8: INTEGER); |
BEGIN |
IF imm8 # 0 THEN |
gen3(2, rd, imm8) |
END |
END AddImm8; |
PROCEDURE SubImm8 (rd, imm8: INTEGER); |
BEGIN |
IF imm8 # 0 THEN |
gen3(3, rd, imm8) |
END |
END SubImm8; |
PROCEDURE AddSubImm12 (r, imm12: INTEGER; sub: BOOLEAN); |
VAR |
imm4, imm1, imm3, imm8: INTEGER; |
BEGIN |
split16(imm12, imm4, imm1, imm3, imm8); |
Code(0F200H + LSL(imm1, 10) + r + 0A0H * ORD(sub)); (* addw/subw r, r, imm12 *) |
Code(LSL(imm3, 12) + LSL(r, 8) + imm8) |
END AddSubImm12; |
PROCEDURE MovImm8 (rd, imm8: INTEGER); |
BEGIN |
gen3(0, rd, imm8) |
END MovImm8; |
PROCEDURE CmpImm8 (rd, imm8: INTEGER); |
BEGIN |
gen3(1, rd, imm8) |
END CmpImm8; |
PROCEDURE Neg (r: INTEGER); |
BEGIN |
gen4(9, r, r) |
END Neg; |
PROCEDURE Mul (rd, rs: INTEGER); |
BEGIN |
gen4(13, rs, rd) |
END Mul; |
PROCEDURE Str32 (rs, rb: INTEGER); |
BEGIN |
gen9(FALSE, FALSE, 0, rb, rs) |
END Str32; |
PROCEDURE Ldr32 (rd, rb: INTEGER); |
BEGIN |
gen9(FALSE, TRUE, 0, rb, rd) |
END Ldr32; |
PROCEDURE Str16 (rs, rb: INTEGER); |
BEGIN |
gen10(FALSE, 0, rb, rs) |
END Str16; |
PROCEDURE Ldr16 (rd, rb: INTEGER); |
BEGIN |
gen10(TRUE, 0, rb, rd) |
END Ldr16; |
PROCEDURE Str8 (rs, rb: INTEGER); |
BEGIN |
gen9(TRUE, FALSE, 0, rb, rs) |
END Str8; |
PROCEDURE Ldr8 (rd, rb: INTEGER); |
BEGIN |
gen9(TRUE, TRUE, 0, rb, rd) |
END Ldr8; |
PROCEDURE Cmp (r1, r2: INTEGER); |
BEGIN |
gen4(10, r2, r1) |
END Cmp; |
PROCEDURE Tst (r: INTEGER); |
BEGIN |
gen3(1, r, 0) (* cmp r, #0 *) |
END Tst; |
PROCEDURE LdrSp (r, offset: INTEGER); |
BEGIN |
gen11(TRUE, r, offset) |
END LdrSp; |
PROCEDURE MovImm32 (r, imm32: INTEGER); |
BEGIN |
MovImm8(r, LSR(imm32, 24) MOD 256); |
LslImm(r, 8); |
AddImm8(r, LSR(imm32, 16) MOD 256); |
LslImm(r, 8); |
AddImm8(r, LSR(imm32, 8) MOD 256); |
LslImm(r, 8); |
AddImm8(r, imm32 MOD 256) |
END MovImm32; |
PROCEDURE low (x: INTEGER): INTEGER; |
RETURN x MOD 65536 |
END low; |
PROCEDURE high (x: INTEGER): INTEGER; |
RETURN (x DIV 65536) MOD 65536 |
END high; |
PROCEDURE movwt (r, imm16, t: INTEGER); |
VAR |
imm1, imm3, imm4, imm8: INTEGER; |
BEGIN |
ASSERT(range(r, 3)); |
ASSERT(range(imm16, 16)); |
ASSERT(range(t, 1)); |
split16(imm16, imm4, imm1, imm3, imm8); |
Code(0F240H + imm1 * 1024 + t * 128 + imm4); |
Code(imm3 * 4096 + r * 256 + imm8); |
END movwt; |
PROCEDURE inv0 (cond: INTEGER): INTEGER; |
RETURN ORD(BITS(cond) / {0}) |
END inv0; |
PROCEDURE fixup (CodeAdr, DataAdr, BssAdr: INTEGER); |
VAR |
code: ANYCODE; |
count: INTEGER; |
shorted: BOOLEAN; |
jump: JUMP; |
first, second: INTEGER; |
reloc, i, diff, len: INTEGER; |
RelocCode: RELOCCODE; |
PROCEDURE genjcc (cond, offset: INTEGER): INTEGER; |
BEGIN |
ASSERT(range(cond, 4)); |
ASSERT(srange(offset, 8)) |
RETURN 0D000H + cond * 256 + offset MOD 256 |
END genjcc; |
PROCEDURE genjmp (offset: INTEGER): INTEGER; |
BEGIN |
ASSERT(srange(offset, 11)) |
RETURN 0E000H + offset MOD 2048 |
END genjmp; |
PROCEDURE genlongjmp (offset: INTEGER; VAR first, second: INTEGER); |
BEGIN |
ASSERT(srange(offset, 22)); |
first := 0F000H + ASR(offset, 11) MOD 2048; |
second := 0F800H + offset MOD 2048 |
END genlongjmp; |
PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE); |
VAR |
imm1, imm3, imm4, imm8: INTEGER; |
BEGIN |
split16(imm16, imm4, imm1, imm3, imm8); |
code[t * 2] := 0F240H + imm1 * 1024 + t * 128 + imm4; |
code[t * 2 + 1] := imm3 * 4096 + r * 256 + imm8 |
END movwt; |
PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE); |
BEGIN |
IF Target.InstrSet.thumb2 THEN |
movwt(r, low(value), 0, code); |
movwt(r, high(value), 1, code) |
ELSE |
code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* mov r, #imm8 *) |
code[1] := 0200H + r * 9; (* lsl r, r, #8 *) |
code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* add r, #imm8 *) |
code[3] := code[1]; (* lsl r, r, #8 *) |
code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* add r, #imm8 *) |
code[5] := code[1]; (* lsl r, r, #8 *) |
code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* add r, #imm8 *) |
END |
END genmovimm32; |
PROCEDURE PutCode (code: INTEGER); |
BEGIN |
BIN.PutCode16LE(program, code) |
END PutCode; |
PROCEDURE genbc (code: JUMP); |
VAR |
first, second: INTEGER; |
BEGIN |
CASE code.len OF |
|1: PutCode(genjcc(code.cond, code.diff)) |
|2: PutCode(genjcc(inv0(code.cond), 0)); |
PutCode(genjmp(code.diff)) |
|3: PutCode(genjcc(inv0(code.cond), 1)); |
genlongjmp(code.diff, first, second); |
PutCode(first); |
PutCode(second) |
END |
END genbc; |
PROCEDURE SetIV (idx, label, CodeAdr: INTEGER); |
VAR |
l, h: ANYCODE; |
BEGIN |
l := CodeList.first(ANYCODE); |
h := l.next(ANYCODE); |
WHILE idx > 0 DO |
l := h.next(ANYCODE); |
h := l.next(ANYCODE); |
DEC(idx) |
END; |
label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1; |
l(CODE).code := low(label); |
h(CODE).code := high(label) |
END SetIV; |
BEGIN |
REPEAT |
shorted := FALSE; |
count := 0; |
code := CodeList.first(ANYCODE); |
WHILE code # NIL DO |
code.offset := count; |
CASE code OF |
|CODE: INC(count) |
|LABEL: BIN.SetLabel(program, code.label, count) |
|JUMP: INC(count, code.len); code.offset := count + ORD(code.short) |
|RELOC: INC(count, 7 - ORD(Target.InstrSet.thumb2) * 3 + code.rel MOD 2) |
END; |
code := code.next(ANYCODE) |
END; |
code := CodeList.first(ANYCODE); |
WHILE code # NIL DO |
IF code IS JUMP THEN |
jump := code(JUMP); |
jump.diff := BIN.GetLabel(program, jump.label) - jump.offset; |
len := jump.len; |
diff := jump.diff; |
CASE jump OF |
|JMP: |
IF (len = 2) & srange(diff, 11) THEN |
len := 1 |
END |
|JCC: |
CASE len OF |
|1: |
|2: IF srange(diff, 8) THEN DEC(len) END |
|3: IF srange(diff, 11) THEN DEC(len) END |
END |
|CBXZ: |
CASE len OF |
|1: |
|2: IF range(diff, 6) THEN DEC(len) END |
|3: IF srange(diff, 8) THEN DEC(len) END |
|4: IF srange(diff, 11) THEN DEC(len) END |
END |
|CALL: |
END; |
IF len # jump.len THEN |
jump.len := len; |
jump.short := TRUE; |
shorted := TRUE |
END |
END; |
code := code.next(ANYCODE) |
END |
UNTIL ~shorted; |
FOR i := 1 TO Target.IVTLen - 1 DO |
SetIV(i, IVT[i], CodeAdr) |
END; |
code := CodeList.first(ANYCODE); |
WHILE code # NIL DO |
CASE code OF |
|CODE: BIN.PutCode16LE(program, code.code) |
|LABEL: |
|JMP: |
IF code.len = 1 THEN |
PutCode(genjmp(code.diff)) |
ELSE |
genlongjmp(code.diff, first, second); |
PutCode(first); |
PutCode(second) |
END |
|JCC: genbc(code) |
|CBXZ: |
IF code.len > 1 THEN |
PutCode(2800H + code.reg * 256); (* cmp code.reg, #0 *) |
DEC(code.len); |
genbc(code) |
ELSE |
(* cb(n)z code.reg, L *) |
PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * ORD(code.diff >= 32) + (code.diff MOD 32) * 8 + code.reg) |
END |
|CALL: |
genlongjmp(code.diff, first, second); |
PutCode(first); |
PutCode(second) |
|RELOC: |
CASE code.rel OF |
|BIN.RCODE, BIN.PICCODE: reloc := BIN.GetLabel(program, code.value) * 2 + CodeAdr |
|BIN.RDATA, BIN.PICDATA: reloc := code.value + DataAdr |
|BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr |
END; |
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN |
DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(Target.InstrSet.thumb2) + 9)) |
END; |
genmovimm32(code.reg, reloc, RelocCode); |
FOR i := 0 TO 6 - 3 * ORD(Target.InstrSet.thumb2) DO |
PutCode(RelocCode[i]) |
END; |
IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN |
PutCode(4478H + code.reg) (* add code.reg, PC *) |
END |
END; |
code := code.next(ANYCODE) |
END |
END fixup; |
PROCEDURE push (r: INTEGER); |
BEGIN |
gen14(FALSE, FALSE, {r}) |
END push; |
PROCEDURE pop (r: INTEGER); |
BEGIN |
gen14(TRUE, FALSE, {r}) |
END pop; |
PROCEDURE mov (r1, r2: INTEGER); |
BEGIN |
IF (r1 < 8) & (r2 < 8) THEN |
gen1(0, 0, r2, r1) |
ELSE |
gen5(2, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) |
END |
END mov; |
PROCEDURE xchg (r1, r2: INTEGER); |
BEGIN |
push(r1); push(r2); |
pop(r1); pop(r2) |
END xchg; |
PROCEDURE drop; |
BEGIN |
REG.Drop(R) |
END drop; |
PROCEDURE GetAnyReg (): INTEGER; |
RETURN REG.GetAnyReg(R) |
END GetAnyReg; |
PROCEDURE UnOp (VAR r: INTEGER); |
BEGIN |
REG.UnOp(R, r) |
END UnOp; |
PROCEDURE BinOp (VAR r1, r2: INTEGER); |
BEGIN |
REG.BinOp(R, r1, r2) |
END BinOp; |
PROCEDURE PushAll (NumberOfParameters: INTEGER); |
BEGIN |
REG.PushAll(R); |
DEC(R.pushed, NumberOfParameters) |
END PushAll; |
PROCEDURE cond (op: INTEGER): INTEGER; |
VAR |
res: INTEGER; |
BEGIN |
CASE op OF |
|IL.opGT, IL.opGTC: res := jg |
|IL.opGE, IL.opGEC: res := jge |
|IL.opLT, IL.opLTC: res := jl |
|IL.opLE, IL.opLEC: res := jle |
|IL.opEQ, IL.opEQC: res := je |
|IL.opNE, IL.opNEC: res := jne |
END |
RETURN res |
END cond; |
PROCEDURE GetRegA; |
BEGIN |
ASSERT(REG.GetReg(R, ACC)) |
END GetRegA; |
PROCEDURE MovConst (r, c: INTEGER); |
BEGIN |
IF (0 <= c) & (c <= 255) THEN |
MovImm8(r, c) |
ELSIF (-255 <= c) & (c < 0) THEN |
MovImm8(r, -c); |
Neg(r) |
ELSIF UTILS.Log2(c) >= 0 THEN |
MovImm8(r, 1); |
LslImm(r, UTILS.Log2(c)) |
ELSIF c = UTILS.min32 THEN |
MovImm8(r, 1); |
LslImm(r, 31) |
ELSE |
IF Target.InstrSet.thumb2 THEN |
movwt(r, low(c), 0); |
IF (c < 0) OR (c > 65535) THEN |
movwt(r, high(c), 1) |
END |
ELSE |
MovImm32(r, c) |
END |
END |
END MovConst; |
PROCEDURE CmpConst (r, c: INTEGER); |
VAR |
r2: INTEGER; |
BEGIN |
IF (0 <= c) & (c <= 255) THEN |
CmpImm8(r, c) |
ELSE |
r2 := GetAnyReg(); |
ASSERT(r2 # r); |
MovConst(r2, c); |
Cmp(r, r2); |
drop |
END |
END CmpConst; |
PROCEDURE LocalOffset (offset: INTEGER): INTEGER; |
RETURN offset + StkCount - ORD(offset > 0) |
END LocalOffset; |
PROCEDURE SetCC (cc, r: INTEGER); |
VAR |
L1, L2: INTEGER; |
BEGIN |
IF Target.InstrSet.it THEN |
Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *) |
MovConst(r, 1); |
MovConst(r, 0) |
ELSE |
L1 := NewLabel(); |
L2 := NewLabel(); |
jcc(cc, L1); |
MovConst(r, 0); |
jmp(L2); |
Label(L1); |
MovConst(r, 1); |
Label(L2) |
END |
END SetCC; |
PROCEDURE PushConst (n: INTEGER); |
VAR |
r: INTEGER; |
BEGIN |
r := GetAnyReg(); |
MovConst(r, n); |
push(r); |
drop |
END PushConst; |
PROCEDURE AddConst (r, n: INTEGER); |
VAR |
r2: INTEGER; |
BEGIN |
IF n # 0 THEN |
IF (-255 <= n) & (n <= 255) THEN |
IF n > 0 THEN |
AddImm8(r, n) |
ELSE |
SubImm8(r, -n) |
END |
ELSIF Target.InstrSet.thumb2 & (-4095 <= n) & (n <= 4095) THEN |
IF n > 0 THEN |
AddSubImm12(r, n, FALSE) |
ELSE |
AddSubImm12(r, -n, TRUE) |
END |
ELSE |
r2 := GetAnyReg(); |
ASSERT(r2 # r); |
IF n > 0 THEN |
MovConst(r2, n); |
AddReg(r, r, r2) |
ELSE |
MovConst(r2, -n); |
SubReg(r, r, r2) |
END; |
drop |
END |
END |
END AddConst; |
PROCEDURE AddHH (r1, r2: INTEGER); |
BEGIN |
ASSERT((r1 >= 8) OR (r2 >= 8)); |
gen5(0, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) |
END AddHH; |
PROCEDURE AddSP (n: INTEGER); |
BEGIN |
IF n > 0 THEN |
IF n < 127 THEN |
Code(0B000H + n) (* add sp, n*4 *) |
ELSE |
ASSERT(R2 IN R.regs); |
MovConst(R2, n * 4); |
AddHH(SP, R2) |
END; |
DEC(StkCount, n) |
END |
END AddSP; |
PROCEDURE cbz (r, label: INTEGER); |
BEGIN |
IF Target.InstrSet.cbxz THEN |
cbxz(je, r, label) |
ELSE |
Tst(r); |
jcc(je, label) |
END |
END cbz; |
PROCEDURE cbnz (r, label: INTEGER); |
BEGIN |
IF Target.InstrSet.cbxz THEN |
cbxz(jne, r, label) |
ELSE |
Tst(r); |
jcc(jne, label) |
END |
END cbnz; |
PROCEDURE Shift (op, r1, r2: INTEGER); |
VAR |
L: INTEGER; |
BEGIN |
LslImm(r2, 27); |
LsrImm(r2, 27); |
L := NewLabel(); |
cbz(r2, L); |
CASE op OF |
|IL.opLSL, IL.opLSL1: gen4(2, r2, r1) |
|IL.opLSR, IL.opLSR1: gen4(3, r2, r1) |
|IL.opASR, IL.opASR1: gen4(4, r2, r1) |
|IL.opROR, IL.opROR1: gen4(7, r2, r1) |
END; |
Label(L) |
END Shift; |
PROCEDURE LocAdr (offs: INTEGER); |
VAR |
r1, n: INTEGER; |
BEGIN |
r1 := GetAnyReg(); |
n := LocalOffset(offs); |
IF n <= 255 THEN |
gen12(TRUE, r1, n) |
ELSE |
MovConst(r1, n * 4); |
AddHH(r1, SP) |
END |
END LocAdr; |
PROCEDURE CallRTL (proc, par: INTEGER); |
BEGIN |
call(IL.codes.rtl[proc]); |
AddSP(par) |
END CallRTL; |
PROCEDURE divmod; |
BEGIN |
call(sdivProc); |
AddSP(2) |
END divmod; |
PROCEDURE translate (pic, stroffs: INTEGER); |
VAR |
cmd, next: COMMAND; |
opcode, param1, param2: INTEGER; |
r1, r2, r3: INTEGER; |
a, n, cc, L, L2: INTEGER; |
BEGIN |
cmd := IL.codes.commands.first(COMMAND); |
WHILE cmd # NIL DO |
param1 := cmd.param1; |
param2 := cmd.param2; |
opcode := cmd.opcode; |
CASE opcode OF |
|IL.opJMP: |
jmp(param1) |
|IL.opLABEL: |
Label(param1) |
|IL.opHANDLER: |
IF param2 = 0 THEN |
int0 := param1 |
ELSIF param2 = 1 THEN |
trap := param1 |
ELSE |
IVT[param2] := param1 |
END |
|IL.opCALL: |
call(param1) |
|IL.opCALLP: |
UnOp(r1); |
AddImm8(r1, 1); |
gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *) |
drop; |
ASSERT(R.top = -1) |
|IL.opENTER: |
ASSERT(R.top = -1); |
Label(param1); |
gen14(FALSE, TRUE, {}); (* push LR *) |
n := param2; |
IF n >= 5 THEN |
MovConst(ACC, 0); |
MovConst(R2, n); |
L := NewLabel(); |
Label(L); |
push(ACC); |
SubImm8(R2, 1); |
Tst(R2); |
jcc(jne, L) |
ELSIF n > 0 THEN |
MovConst(ACC, 0); |
WHILE n > 0 DO |
push(ACC); |
DEC(n) |
END |
END; |
StkCount := param2 |
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: |
IF opcode # IL.opLEAVE THEN |
UnOp(r1); |
IF r1 # ACC THEN |
GetRegA; |
ASSERT(REG.Exchange(R, r1, ACC)); |
drop |
END; |
drop |
END; |
ASSERT(R.top = -1); |
ASSERT(StkCount = param1); |
AddSP(param1); |
gen14(TRUE, TRUE, {}) (* pop PC *) |
|IL.opLEAVEC: |
gen5(3, FALSE, TRUE, 6, 0) (* bx LR *) |
|IL.opPRECALL: |
PushAll(0) |
|IL.opPARAM: |
n := param2; |
IF n = 1 THEN |
UnOp(r1); |
push(r1); |
drop |
ELSE |
ASSERT(R.top + 1 <= n); |
PushAll(n) |
END |
|IL.opCLEANUP: |
AddSP(param2) |
|IL.opRES, IL.opRESF: |
ASSERT(R.top = -1); |
GetRegA |
|IL.opPUSHC: |
PushConst(param2) |
|IL.opONERR: |
MovConst(R0, param2); |
push(R0); |
DEC(StkCount); |
jmp(param1) |
|IL.opERR: |
call(genTrap) |
|IL.opNOP: |
|IL.opSADR: |
reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2) |
|IL.opGADR: |
reloc(GetAnyReg(), BIN.RBSS + pic, param2) |
|IL.opLADR: |
LocAdr(param2) |
|IL.opGLOAD32: |
r1 := GetAnyReg(); |
reloc(r1, BIN.RBSS + pic, param2); |
Ldr32(r1, r1) |
|IL.opGLOAD16: |
r1 := GetAnyReg(); |
reloc(r1, BIN.RBSS + pic, param2); |
Ldr16(r1, r1) |
|IL.opGLOAD8: |
r1 := GetAnyReg(); |
reloc(r1, BIN.RBSS + pic, param2); |
Ldr8(r1, r1) |
|IL.opLLOAD32, IL.opVADR, IL.opVLOAD32: |
r1 := GetAnyReg(); |
n := LocalOffset(param2); |
IF n <= 255 THEN |
LdrSp(r1, n) |
ELSE |
drop; |
LocAdr(param2); |
UnOp(r1); |
Ldr32(r1, r1) |
END; |
IF opcode = IL.opVLOAD32 THEN |
Ldr32(r1, r1) |
END |
|IL.opLLOAD16: |
LocAdr(param2); |
UnOp(r1); |
Ldr16(r1, r1) |
|IL.opLLOAD8: |
LocAdr(param2); |
UnOp(r1); |
Ldr8(r1, r1) |
|IL.opLOAD32, IL.opLOADF: |
UnOp(r1); |
Ldr32(r1, r1) |
|IL.opLOAD16: |
UnOp(r1); |
Ldr16(r1, r1) |
|IL.opLOAD8: |
UnOp(r1); |
Ldr8(r1, r1) |
|IL.opVLOAD16: |
LocAdr(param2); |
UnOp(r1); |
Ldr32(r1, r1); |
Ldr16(r1, r1) |
|IL.opVLOAD8: |
LocAdr(param2); |
UnOp(r1); |
Ldr32(r1, r1); |
Ldr8(r1, r1) |
|IL.opSBOOL: |
BinOp(r2, r1); |
Tst(r2); |
SetCC(jne, r2); |
Str8(r2, r1); |
drop; |
drop |
|IL.opSBOOLC: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, ORD(param2 # 0)); |
Str8(r2, r1); |
drop; |
drop |
|IL.opSAVEC: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, param2); |
Str32(r2, r1); |
drop; |
drop |
|IL.opSAVE16C: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, low(param2)); |
Str16(r2, r1); |
drop; |
drop |
|IL.opSAVE8C: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, param2 MOD 256); |
Str8(r2, r1); |
drop; |
drop |
|IL.opSAVE, IL.opSAVE32, IL.opSAVEF: |
BinOp(r2, r1); |
Str32(r2, r1); |
drop; |
drop |
|IL.opSAVEFI: |
BinOp(r2, r1); |
Str32(r1, r2); |
drop; |
drop |
|IL.opSAVE16: |
BinOp(r2, r1); |
Str16(r2, r1); |
drop; |
drop |
|IL.opSAVE8: |
BinOp(r2, r1); |
Str8(r2, r1); |
drop; |
drop |
|IL.opSAVEP: |
UnOp(r1); |
r2 := GetAnyReg(); |
reloc(r2, BIN.RCODE + pic, param2); |
Str32(r2, r1); |
drop; |
drop |
|IL.opPUSHP: |
reloc(GetAnyReg(), BIN.RCODE + pic, param2) |
|IL.opEQB, IL.opNEB: |
BinOp(r1, r2); |
drop; |
L := NewLabel(); |
cbz(r1, L); |
MovConst(r1, 1); |
Label(L); |
L := NewLabel(); |
cbz(r2, L); |
MovConst(r2, 1); |
Label(L); |
Cmp(r1, r2); |
IF opcode = IL.opEQB THEN |
SetCC(je, r1) |
ELSE |
SetCC(jne, r1) |
END |
|IL.opACC: |
IF (R.top # 0) OR (R.stk[0] # ACC) THEN |
PushAll(0); |
GetRegA; |
pop(ACC); |
DEC(R.pushed) |
END |
|IL.opDROP: |
UnOp(r1); |
drop |
|IL.opJNZ: |
UnOp(r1); |
cbnz(r1, param1) |
|IL.opJZ: |
UnOp(r1); |
cbz(r1, param1) |
|IL.opJG: |
UnOp(r1); |
Tst(r1); |
jcc(jg, param1) |
|IL.opJE: |
UnOp(r1); |
cbnz(r1, param1); |
drop |
|IL.opJNE: |
UnOp(r1); |
cbz(r1, param1); |
drop |
|IL.opSWITCH: |
UnOp(r1); |
IF param2 = 0 THEN |
r2 := ACC |
ELSE |
r2 := R2 |
END; |
IF r1 # r2 THEN |
ASSERT(REG.GetReg(R, r2)); |
ASSERT(REG.Exchange(R, r1, r2)); |
drop |
END; |
drop |
|IL.opENDSW: |
|IL.opCASEL: |
GetRegA; |
CmpConst(ACC, param1); |
jcc(jl, param2); |
drop |
|IL.opCASER: |
GetRegA; |
CmpConst(ACC, param1); |
jcc(jg, param2); |
drop |
|IL.opCASELR: |
GetRegA; |
CmpConst(ACC, param1); |
jcc(jl, param2); |
jcc(jg, cmd.param3); |
drop |
|IL.opCODE: |
Code(param2) |
|IL.opEQ..IL.opGE, |
IL.opEQC..IL.opGEC: |
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN |
BinOp(r1, r2); |
Cmp(r1, r2); |
drop |
ELSE |
UnOp(r1); |
CmpConst(r1, param2) |
END; |
drop; |
cc := cond(opcode); |
next := cmd.next(COMMAND); |
IF next.opcode = IL.opJE THEN |
jcc(cc, next.param1); |
cmd := next |
ELSIF next.opcode = IL.opJNE THEN |
jcc(inv0(cc), next.param1); |
cmd := next |
ELSE |
SetCC(cc, GetAnyReg()) |
END |
|IL.opINCC: |
UnOp(r1); |
r2 := GetAnyReg(); |
Ldr32(r2, r1); |
AddConst(r2, param2); |
Str32(r2, r1); |
drop; |
drop |
|IL.opINCCB, IL.opDECCB: |
IF opcode = IL.opDECCB THEN |
param2 := -param2 |
END; |
UnOp(r1); |
r2 := GetAnyReg(); |
Ldr8(r2, r1); |
AddConst(r2, param2); |
Str8(r2, r1); |
drop; |
drop |
|IL.opUMINUS: |
UnOp(r1); |
Neg(r1) |
|IL.opADD: |
BinOp(r1, r2); |
CASE cmd.next(COMMAND).opcode OF |
|IL.opLOAD32, IL.opLOADF: |
gen7(TRUE, FALSE, r2, r1, r1); (* ldr r1, [r1, r2] *) |
cmd := cmd.next(COMMAND) |
|IL.opLOAD8: |
gen7(TRUE, TRUE, r2, r1, r1); (* ldrb r1, [r1, r2] *) |
cmd := cmd.next(COMMAND) |
|IL.opLOAD16: |
gen8(TRUE, FALSE, r2, r1, r1); (* ldrh r1, [r1, r2] *) |
cmd := cmd.next(COMMAND) |
ELSE |
AddReg(r1, r1, r2) |
END; |
drop |
|IL.opADDL, IL.opADDR: |
UnOp(r1); |
AddConst(r1, param2) |
|IL.opSUB: |
BinOp(r1, r2); |
SubReg(r1, r1, r2); |
drop |
|IL.opSUBL, IL.opSUBR: |
UnOp(r1); |
AddConst(r1, -param2); |
IF opcode = IL.opSUBL THEN |
Neg(r1) |
END |
|IL.opMUL: |
BinOp(r1, r2); |
Mul(r1, r2); |
drop |
|IL.opMULC: |
UnOp(r1); |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF a = 1 THEN |
ELSIF a = -1 THEN |
Neg(r1) |
ELSIF a = 0 THEN |
MovConst(r1, 0) |
ELSE |
IF n > 0 THEN |
IF a < 0 THEN |
Neg(r1) |
END; |
LslImm(r1, n) |
ELSE |
r2 := GetAnyReg(); |
MovConst(r2, a); |
Mul(r1, r2); |
drop |
END |
END |
|IL.opABS: |
UnOp(r1); |
Tst(r1); |
L := NewLabel(); |
jcc(jge, L); |
Neg(r1); |
Label(L) |
|IL.opNOT: |
UnOp(r1); |
Tst(r1); |
SetCC(je, r1) |
|IL.opORD: |
UnOp(r1); |
Tst(r1); |
SetCC(jne, r1) |
|IL.opCHR: |
UnOp(r1); |
Code(0B2C0H + r1 * 9) (* uxtb r1 *) |
|IL.opWCHR: |
UnOp(r1); |
Code(0B280H + r1 * 9) (* uxth r1 *) |
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: |
BinOp(r1, r2); |
Shift(opcode, r1, r2); |
drop |
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: |
MovConst(GetAnyReg(), param2); |
BinOp(r2, r1); |
Shift(opcode, r1, r2); |
INCL(R.regs, r2); |
DEC(R.top); |
R.stk[R.top] := r1 |
|IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: |
n := param2 MOD 32; |
IF n # 0 THEN |
UnOp(r1); |
CASE opcode OF |
|IL.opASR2: AsrImm(r1, n) |
|IL.opROR2: r2 := GetAnyReg(); MovConst(r2, n); Shift(IL.opROR, r1, r2); drop |
|IL.opLSL2: LslImm(r1, n) |
|IL.opLSR2: LsrImm(r1, n) |
END |
END |
|IL.opCHKBYTE: |
BinOp(r1, r2); |
CmpConst(r1, 256); |
jcc(jb, param1) |
|IL.opCHKIDX: |
UnOp(r1); |
CmpConst(r1, param2); |
jcc(jb, param1) |
|IL.opCHKIDX2: |
BinOp(r1, r2); |
IF param2 # -1 THEN |
Cmp(r2, r1); |
jcc(jb, param1) |
END; |
INCL(R.regs, r1); |
DEC(R.top); |
R.stk[R.top] := r2 |
|IL.opLEN: |
n := param2; |
UnOp(r1); |
drop; |
EXCL(R.regs, r1); |
WHILE n > 0 DO |
UnOp(r2); |
drop; |
DEC(n) |
END; |
INCL(R.regs, r1); |
ASSERT(REG.GetReg(R, r1)) |
|IL.opLOOP, IL.opENDLOOP: |
|IL.opINF: |
MovConst(GetAnyReg(), inf) |
|IL.opPUSHF: |
UnOp(r1); |
push(r1); |
drop |
|IL.opCONST: |
MovConst(GetAnyReg(), param2) |
|IL.opEQP, IL.opNEP: |
reloc(GetAnyReg(), BIN.RCODE + pic, param1); |
BinOp(r1, r2); |
Cmp(r1, r2); |
drop; |
IF opcode = IL.opEQP THEN |
SetCC(je, r1) |
ELSE |
SetCC(jne, r1) |
END |
|IL.opPUSHT: |
UnOp(r1); |
r2 := GetAnyReg(); |
mov(r2, r1); |
SubImm8(r2, 4); |
Ldr32(r2, r2) |
|IL.opGET, IL.opGETC: |
IF opcode = IL.opGET THEN |
BinOp(r1, r2) |
ELSIF opcode = IL.opGETC THEN |
UnOp(r2); |
r1 := GetAnyReg(); |
MovConst(r1, param1) |
END; |
drop; |
drop; |
CASE param2 OF |
|1: Ldr8(r1, r1); Str8(r1, r2) |
|2: Ldr16(r1, r1); Str16(r1, r2) |
|4: Ldr32(r1, r1); Str32(r1, r2) |
END |
|IL.opINC, IL.opDEC: |
BinOp(r2, r1); |
r3 := GetAnyReg(); |
Ldr32(r3, r1); |
IF opcode = IL.opINC THEN |
AddReg(r3, r3, r2) |
ELSE |
SubReg(r3, r3, r2) |
END; |
Str32(r3, r1); |
drop; |
drop; |
drop |
|IL.opINCB, IL.opDECB: |
BinOp(r2, r1); |
r3 := GetAnyReg(); |
Ldr8(r3, r1); |
IF opcode = IL.opINCB THEN |
AddReg(r3, r3, r2) |
ELSE |
SubReg(r3, r3, r2) |
END; |
Str8(r3, r1); |
drop; |
drop; |
drop |
|IL.opMIN, IL.opMAX: |
BinOp(r1, r2); |
Cmp(r1, r2); |
L := NewLabel(); |
IF opcode = IL.opMIN THEN |
cc := jle |
ELSE |
cc := jge |
END; |
jcc(cc, L); |
mov(r1, r2); |
Label(L); |
drop |
|IL.opMINC, IL.opMAXC: |
UnOp(r1); |
CmpConst(r1, param2); |
L := NewLabel(); |
IF opcode = IL.opMINC THEN |
cc := jle |
ELSE |
cc := jge |
END; |
jcc(cc, L); |
MovConst(r1, param2); |
Label(L) |
|IL.opMULS: |
BinOp(r1, r2); |
gen4(0, r2, r1); (* and r1, r2 *) |
drop |
|IL.opMULSC: |
MovConst(GetAnyReg(), param2); |
BinOp(r1, r2); |
gen4(0, r2, r1); (* and r1, r2 *) |
drop |
|IL.opDIVS: |
BinOp(r1, r2); |
gen4(1, r2, r1); (* eor r1, r2 *) |
drop |
|IL.opDIVSC: |
MovConst(GetAnyReg(), param2); |
BinOp(r1, r2); |
gen4(1, r2, r1); (* eor r1, r2 *) |
drop |
|IL.opADDS: |
BinOp(r1, r2); |
gen4(12, r2, r1); (* orr r1, r2 *) |
drop |
|IL.opSUBS: |
BinOp(r1, r2); |
gen4(14, r2, r1); (* bic r1, r2 *) |
drop |
|IL.opADDSL, IL.opADDSR: |
MovConst(GetAnyReg(), param2); |
BinOp(r1, r2); |
gen4(12, r2, r1); (* orr r1, r2 *) |
drop |
|IL.opSUBSL: |
MovConst(GetAnyReg(), param2); |
BinOp(r1, r2); |
gen4(14, r1, r2); (* bic r2, r1 *) |
INCL(R.regs, r1); |
DEC(R.top); |
R.stk[R.top] := r2 |
|IL.opSUBSR: |
MovConst(GetAnyReg(), param2); |
BinOp(r1, r2); |
gen4(14, r2, r1); (* bic r1, r2 *) |
drop |
|IL.opUMINS: |
UnOp(r1); |
gen4(15, r1, r1) (* mvn r1, r1 *) |
|IL.opINCL, IL.opEXCL: |
BinOp(r1, r2); |
r3 := GetAnyReg(); |
MovConst(r3, 1); |
CmpConst(r1, 32); |
L := NewLabel(); |
jcc(jnb, L); |
gen4(2, r1, r3); (* lsl r3, r1 *) |
Ldr32(r1, r2); |
IF opcode = IL.opINCL THEN |
gen4(12, r3, r1) (* orr r1, r3 *) |
ELSE |
gen4(14, r3, r1) (* bic r1, r3 *) |
END; |
Str32(r1, r2); |
Label(L); |
drop; |
drop; |
drop |
|IL.opINCLC, IL.opEXCLC: |
UnOp(r2); |
r1 := GetAnyReg(); |
r3 := GetAnyReg(); |
MovConst(r3, 1); |
LslImm(r3, param2); |
Ldr32(r1, r2); |
IF opcode = IL.opINCLC THEN |
gen4(12, r3, r1) (* orr r1, r3 *) |
ELSE |
gen4(14, r3, r1) (* bic r1, r3 *) |
END; |
Str32(r1, r2); |
drop; |
drop; |
drop |
|IL.opLENGTH: |
PushAll(2); |
CallRTL(IL._length, 2); |
GetRegA |
|IL.opLENGTHW: |
PushAll(2); |
CallRTL(IL._lengthw, 2); |
GetRegA |
|IL.opSAVES: |
UnOp(r2); |
REG.PushAll_1(R); |
r1 := GetAnyReg(); |
reloc(r1, BIN.RDATA + pic, stroffs + param2); |
push(r1); |
drop; |
push(r2); |
drop; |
PushConst(param1); |
CallRTL(IL._move, 3) |
|IL.opEQS .. IL.opGES: |
PushAll(4); |
PushConst(opcode - IL.opEQS); |
CallRTL(IL._strcmp, 5); |
GetRegA |
|IL.opEQSW .. IL.opGESW: |
PushAll(4); |
PushConst(opcode - IL.opEQSW); |
CallRTL(IL._strcmpw, 5); |
GetRegA |
|IL.opCOPY: |
PushAll(2); |
PushConst(param2); |
CallRTL(IL._move, 3) |
|IL.opMOVE: |
PushAll(3); |
CallRTL(IL._move, 3) |
|IL.opCOPYA: |
PushAll(4); |
PushConst(param2); |
CallRTL(IL._arrcpy, 5); |
GetRegA |
|IL.opCOPYS: |
PushAll(4); |
PushConst(param2); |
CallRTL(IL._strcpy, 5) |
|IL.opDIV: |
PushAll(2); |
divmod; |
GetRegA |
|IL.opDIVL: |
UnOp(r1); |
REG.PushAll_1(R); |
PushConst(param2); |
push(r1); |
drop; |
divmod; |
GetRegA |
|IL.opDIVR: |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(r1); |
AsrImm(r1, n) |
ELSIF n < 0 THEN |
PushAll(1); |
PushConst(param2); |
divmod; |
GetRegA |
END |
|IL.opMOD: |
PushAll(2); |
divmod; |
mov(R0, R1); |
GetRegA |
|IL.opMODR: |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(r1); |
IF n = 8 THEN |
Code(0B2C0H + r1 * 9) (* uxtb r1 *) |
ELSIF n = 16 THEN |
Code(0B280H + r1 * 9) (* uxth r1 *) |
ELSE |
LslImm(r1, 32 - n); |
LsrImm(r1, 32 - n) |
END |
ELSIF n < 0 THEN |
PushAll(1); |
PushConst(param2); |
divmod; |
mov(R0, R1); |
GetRegA |
ELSE |
UnOp(r1); |
MovConst(r1, 0) |
END |
|IL.opMODL: |
UnOp(r1); |
REG.PushAll_1(R); |
PushConst(param2); |
push(r1); |
drop; |
divmod; |
mov(R0, R1); |
GetRegA |
|IL.opIN, IL.opINR: |
IF opcode = IL.opINR THEN |
r2 := GetAnyReg(); |
MovConst(r2, param2) |
END; |
L := NewLabel(); |
L2 := NewLabel(); |
BinOp(r1, r2); |
r3 := GetAnyReg(); |
CmpConst(r1, 32); |
jcc(jb, L); |
MovConst(r1, 0); |
jmp(L2); |
Label(L); |
MovConst(r3, 1); |
Shift(IL.opLSL, r3, r1); |
gen4(0, r3, r2); (* and r2, r3 *) |
SetCC(jne, r1); |
Label(L2); |
drop; |
drop |
|IL.opINL: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, LSL(1, param2)); |
gen4(0, r2, r1); (* and r1, r2 *) |
SetCC(jne, r1); |
drop |
|IL.opRSET: |
PushAll(2); |
CallRTL(IL._set, 2); |
GetRegA |
|IL.opRSETR: |
PushAll(1); |
PushConst(param2); |
CallRTL(IL._set, 2); |
GetRegA |
|IL.opRSETL: |
UnOp(r1); |
REG.PushAll_1(R); |
PushConst(param2); |
push(r1); |
drop; |
CallRTL(IL._set, 2); |
GetRegA |
|IL.opRSET1: |
PushAll(1); |
CallRTL(IL._set1, 1); |
GetRegA |
|IL.opCONSTF: |
MovConst(GetAnyReg(), UTILS.d2s(cmd.float)) |
|IL.opMULF: |
PushAll(2); |
CallRTL(IL._fmul, 2); |
GetRegA |
|IL.opDIVF: |
PushAll(2); |
CallRTL(IL._fdiv, 2); |
GetRegA |
|IL.opDIVFI: |
PushAll(2); |
CallRTL(IL._fdivi, 2); |
GetRegA |
|IL.opADDF, IL.opADDFI: |
PushAll(2); |
CallRTL(IL._fadd, 2); |
GetRegA |
|IL.opSUBFI: |
PushAll(2); |
CallRTL(IL._fsubi, 2); |
GetRegA |
|IL.opSUBF: |
PushAll(2); |
CallRTL(IL._fsub, 2); |
GetRegA |
|IL.opEQF..IL.opGEF: |
PushAll(2); |
PushConst(opcode - IL.opEQF); |
CallRTL(IL._fcmp, 3); |
GetRegA |
|IL.opFLOOR: |
PushAll(1); |
CallRTL(IL._floor, 1); |
GetRegA |
|IL.opFLT: |
PushAll(1); |
CallRTL(IL._flt, 1); |
GetRegA |
|IL.opUMINF: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, 1); |
LslImm(r2, 31); |
gen4(1, r2, r1); (* eor r1, r2 *) |
drop |
|IL.opFABS: |
UnOp(r1); |
r2 := GetAnyReg(); |
MovConst(r2, 1); |
LslImm(r2, 31); |
gen4(14, r2, r1); (* bic r1, r2 *) |
drop |
|IL.opNEW: |
PushAll(1); |
n := param2 + 8; |
ASSERT(UTILS.Align(n, 32)); |
PushConst(n); |
PushConst(param1); |
CallRTL(IL._new, 3) |
|IL.opTYPEGP: |
UnOp(r1); |
PushAll(0); |
push(r1); |
PushConst(param2); |
CallRTL(IL._guard, 2); |
GetRegA |
|IL.opIS: |
PushAll(1); |
PushConst(param2); |
CallRTL(IL._is, 2); |
GetRegA |
|IL.opISREC: |
PushAll(2); |
PushConst(param2); |
CallRTL(IL._guardrec, 3); |
GetRegA |
|IL.opTYPEGR: |
PushAll(1); |
PushConst(param2); |
CallRTL(IL._guardrec, 2); |
GetRegA |
|IL.opTYPEGD: |
UnOp(r1); |
PushAll(0); |
SubImm8(r1, 4); |
Ldr32(r1, r1); |
push(r1); |
PushConst(param2); |
CallRTL(IL._guardrec, 2); |
GetRegA |
|IL.opCASET: |
push(R2); |
push(R2); |
PushConst(param2); |
CallRTL(IL._guardrec, 2); |
pop(R2); |
cbnz(ACC, param1) |
|IL.opROT: |
PushAll(0); |
mov(R2, SP); |
push(R2); |
PushConst(param2); |
CallRTL(IL._rot, 2) |
|IL.opPACK: |
PushAll(2); |
CallRTL(IL._pack, 2) |
|IL.opPACKC: |
PushAll(1); |
PushConst(param2); |
CallRTL(IL._pack, 2) |
|IL.opUNPK: |
PushAll(2); |
CallRTL(IL._unpk, 2) |
END; |
cmd := cmd.next(COMMAND) |
END; |
ASSERT(R.pushed = 0); |
ASSERT(R.top = -1) |
END translate; |
PROCEDURE prolog (GlobSize, tcount, pic, FlashAdr, sp, ivt_len: INTEGER); |
VAR |
r1, r2, i, dcount: INTEGER; |
BEGIN |
entry := NewLabel(); |
emptyProc := NewLabel(); |
genInt := NewLabel(); |
genTrap := NewLabel(); |
sdivProc := NewLabel(); |
trap := emptyProc; |
int0 := emptyProc; |
IVT[0] := sp; |
IVT[1] := entry; |
FOR i := 2 TO ivt_len - 1 DO |
IVT[i] := genInt |
END; |
FOR i := 0 TO ivt_len - 1 DO |
Code(low(IVT[i])); |
Code(high(IVT[i])) |
END; |
Label(entry); |
r1 := GetAnyReg(); |
r2 := GetAnyReg(); |
reloc(r1, BIN.RDATA + pic, 0); |
FOR i := 0 TO tcount - 1 DO |
MovConst(r2, CHL.GetInt(IL.codes.types, i)); |
Str32(r2, r1); |
AddImm8(r1, 4) |
END; |
dcount := CHL.Length(IL.codes.data); |
FOR i := 0 TO dcount - 1 BY 4 DO |
MovConst(r2, BIN.get32le(IL.codes.data, i)); |
Str32(r2, r1); |
AddImm8(r1, 4) |
END; |
drop; |
drop; |
r1 := GetAnyReg(); |
MovConst(r1, sp); |
mov(SP, r1); |
reloc(r1, BIN.RDATA + pic, 0); |
push(r1); |
reloc(r1, BIN.RBSS + pic, 0); |
r2 := GetAnyReg(); |
MovConst(r2, GlobSize); |
AddReg(r1, r1, r2); |
drop; |
push(r1); |
drop; |
PushConst(tcount); |
CallRTL(IL._init, 3) |
END prolog; |
PROCEDURE epilog; |
VAR |
L1, L2, L3, L4: INTEGER; |
BEGIN |
Code(0BF30H); (* L2: wfi *) |
Code(0E7FDH); (* b L2 *) |
Label(genInt); |
Code(0F3EFH); Code(08105H); (* mrs r1, ipsr *) |
gen14(FALSE, TRUE, {R1}); (* push {LR, R1} *) |
call(int0); |
gen14(TRUE, TRUE, {R1}); (* pop {PC, R1} *) |
Label(emptyProc); |
Code(04770H); (* bx lr *) |
Label(genTrap); |
call(trap); |
call(entry); |
Label(sdivProc); |
IF Target.InstrSet.sdiv THEN |
Code(09800H); (* ldr r0, [sp + #0] *) |
Code(09901H); (* ldr r1, [sp + #4] *) |
Code(0FB91H); (* sdiv r2, r1, r0 *) |
Code(0F2F0H); |
Code(00013H); (* mov r3, r2 *) |
Code(04343H); (* mul r3, r0 *) |
Code(01AC9H); (* sub r1, r3 *) |
Code(0DA01H); (* bge L *) |
Code(04401H); (* add r1, r0 *) |
Code(03A01H); (* sub r2, #1 *) |
(* L: *) |
Code(00010H); (* mov r0, r2 *) |
Code(04770H); (* bx lr *) |
ELSE |
(* a / b; a >= 0 *) |
L1 := NewLabel(); |
L2 := NewLabel(); |
L3 := NewLabel(); |
L4 := NewLabel(); |
LdrSp(R1, 1); |
LdrSp(R2, 0); |
MovConst(R0, 0); |
push(R4); |
Label(L4); |
Cmp(R1, R2); |
jcc(jl, L1); |
MovConst(R3, 2); |
mov(R4, R2); |
LslImm(R4, 1); |
Label(L3); |
Cmp(R1, R4); |
jcc(jl, L2); |
CmpConst(R4, 0); |
jcc(jle, L2); |
LslImm(R4, 1); |
LslImm(R3, 1); |
jmp(L3); |
Label(L2); |
LsrImm(R4, 1); |
LsrImm(R3, 1); |
SubReg(R1, R1, R4); |
AddReg(R0, R0, R3); |
jmp(L4); |
Label(L1); |
(* a / b; a < 0 *) |
L1 := NewLabel(); |
L2 := NewLabel(); |
L3 := NewLabel(); |
L4 := NewLabel(); |
Label(L4); |
CmpConst(R1, 0); |
jcc(jge, L1); |
MovConst(R3, 2); |
mov(R4, R2); |
LslImm(R4, 1); |
Neg(R1); |
Label(L3); |
Cmp(R1, R4); |
jcc(jl, L2); |
CmpConst(R4, 0); |
jcc(jle, L2); |
LslImm(R4, 1); |
LslImm(R3, 1); |
jmp(L3); |
Label(L2); |
Neg(R1); |
LsrImm(R4, 1); |
LsrImm(R3, 1); |
AddReg(R1, R1, R4); |
SubReg(R0, R0, R3); |
jmp(L4); |
Label(L1); |
pop(R4); |
Code(04770H); (* bx lr *) |
END |
END epilog; |
PROCEDURE CortexM3; |
BEGIN |
Target.FlashAdr := 08000000H; |
Target.SRAMAdr := 20000000H; |
Target.IVTLen := 256; |
Target.Reserved := 0; |
Target.MinStack := 512; |
Target.InstrSet.thumb2 := TRUE; |
Target.InstrSet.it := TRUE; |
Target.InstrSet.sdiv := TRUE; |
Target.InstrSet.cbxz := TRUE |
END CortexM3; |
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
VAR |
opt: PROG.OPTIONS; |
ram, rom: INTEGER; |
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER; |
File: WR.FILE; |
BEGIN |
IF target = TARGETS.STM32CM3 THEN |
CortexM3 |
END; |
ram := MIN(MAX(options.ram, STM32_minRAM), STM32_maxRAM) * 1024; |
rom := MIN(MAX(options.rom, STM32_minROM), STM32_maxROM) * 1024; |
tcount := CHL.Length(IL.codes.types); |
opt := options; |
CodeList := LISTS.create(NIL); |
program := BIN.create(IL.codes.lcount); |
REG.Init(R, push, pop, mov, xchg, NIL, NIL, {R0, R1, R2, R3}, {}); |
StkCount := 0; |
DataAdr := Target.SRAMAdr + Target.Reserved; |
DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved; |
WHILE DataSize MOD 4 # 0 DO |
CHL.PushByte(IL.codes.data, 0); |
INC(DataSize) |
END; |
BssAdr := DataAdr + DataSize - Target.Reserved; |
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); |
BssSize := IL.codes.bss; |
ASSERT(UTILS.Align(BssSize, 4)); |
prolog(BssSize, tcount, ORD(opt.pic), Target.FlashAdr, Target.SRAMAdr + ram, Target.IVTLen); |
translate(ORD(opt.pic), tcount * 4); |
epilog; |
fixup(Target.FlashAdr, DataAdr, BssAdr); |
INC(DataSize, BssSize); |
CodeSize := CHL.Length(program.code); |
IF CodeSize > rom THEN |
ERRORS.Error(203) |
END; |
IF DataSize > ram - Target.MinStack THEN |
ERRORS.Error(204) |
END; |
File := WR.Create(outname); |
HEX.Data2(File, program.code, 0, CodeSize, high(Target.FlashAdr)); |
HEX.End(File); |
WR.Close(File); |
C.StringLn("--------------------------------------------"); |
C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)"); |
C.Ln; |
C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)") |
END CodeGen; |
PROCEDURE SetIV* (idx: INTEGER): BOOLEAN; |
VAR |
res: BOOLEAN; |
BEGIN |
res := IVT[idx] = 0; |
IVT[idx] := 1 |
RETURN res |
END SetIV; |
PROCEDURE init; |
VAR |
i: INTEGER; |
BEGIN |
FOR i := 0 TO LEN(IVT) - 1 DO |
IVT[i] := 0 |
END |
END init; |
BEGIN |
init |
END THUMB. |
/programs/develop/oberon07/Source/UTILS.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
23,7 → 23,15 |
min32* = -2147483647-1; |
max32* = 2147483647; |
vMajor* = 1; |
vMinor* = 29; |
FILE_EXT* = ".ob07"; |
RTL_NAME* = "RTL"; |
MAX_GLOBAL_SIZE* = 1600000000; |
TYPE |
DAYS = ARRAY 12, 31, 2 OF INTEGER; |
110,6 → 118,11 |
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; |
143,7 → 156,7 |
END UnixTime; |
PROCEDURE SetBitDepth* (BitDepth: INTEGER); |
PROCEDURE SetBitDepth* (BitDepth: INTEGER; Double: BOOLEAN); |
BEGIN |
ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64)); |
bit_diff := bit_depth - BitDepth; |
154,8 → 167,13 |
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, 1023); |
PACK(target.maxReal, 127) |
END |
END SetBitDepth; |
197,8 → 215,6 |
n: INTEGER; |
BEGIN |
ASSERT(x > 0); |
n := 0; |
WHILE ~ODD(x) DO |
x := x DIV 2; |
258,7 → 274,6 |
BEGIN |
time := GetTickCount(); |
COPY(HOST.eol, eol); |
maxreal := 1.9; |
PACK(maxreal, 1023); |
maxreal := HOST.maxreal; |
init(days) |
END UTILS. |
END UTILS. |
/programs/develop/oberon07/Source/WRITER.ob07 |
---|
1,4 → 1,4 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
/programs/develop/oberon07/Source/X86.ob07 |
---|
1,7 → 1,7 |
(* |
(* |
BSD 2-Clause License |
Copyright (c) 2018-2019, Anton Krotov |
Copyright (c) 2018-2020, Anton Krotov |
All rights reserved. |
*) |
8,7 → 8,7 |
MODULE X86; |
IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG, |
mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS; |
CHL := CHUNKLISTS, PATHS, TARGETS; |
CONST |
93,16 → 93,6 |
tcount: INTEGER; |
PROCEDURE Byte (n: INTEGER): BYTE; |
RETURN UTILS.Byte(n, 0) |
END Byte; |
PROCEDURE Word (n: INTEGER): INTEGER; |
RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256 |
END Word; |
PROCEDURE OutByte* (n: BYTE); |
VAR |
c: CODE; |
127,7 → 117,7 |
PROCEDURE OutInt (n: INTEGER); |
BEGIN |
OutByte(UTILS.Byte(n, 0)); |
OutByte(n MOD 256); |
OutByte(UTILS.Byte(n, 1)); |
OutByte(UTILS.Byte(n, 2)); |
OutByte(UTILS.Byte(n, 3)) |
174,7 → 164,7 |
PROCEDURE OutIntByte (n: INTEGER); |
BEGIN |
IF isByte(n) THEN |
OutByte(Byte(n)) |
OutByte(n MOD 256) |
ELSE |
OutInt(n) |
END |
194,7 → 184,7 |
PROCEDURE mov (reg1, reg2: INTEGER); |
BEGIN |
OutByte2(89H, 0C0H + reg2 * 8 + reg1) // mov reg1, reg2 |
OutByte2(89H, 0C0H + reg2 * 8 + reg1) (* mov reg1, reg2 *) |
END mov; |
205,11 → 195,11 |
BEGIN |
regs := {reg1, reg2}; |
IF regs = {eax, ecx} THEN |
OutByte(91H) // xchg eax, ecx |
OutByte(91H) (* xchg eax, ecx *) |
ELSIF regs = {eax, edx} THEN |
OutByte(92H) // xchg eax, edx |
OutByte(92H) (* xchg eax, edx *) |
ELSIF regs = {ecx, edx} THEN |
OutByte2(87H, 0D1H) // xchg ecx, edx |
OutByte2(87H, 0D1H) (* xchg ecx, edx *) |
END |
END xchg; |
216,19 → 206,19 |
PROCEDURE pop (reg: INTEGER); |
BEGIN |
OutByte(58H + reg) // pop reg |
OutByte(58H + reg) (* pop reg *) |
END pop; |
PROCEDURE push (reg: INTEGER); |
BEGIN |
OutByte(50H + reg) // push reg |
OutByte(50H + reg) (* push reg *) |
END push; |
PROCEDURE movrc (reg, n: INTEGER); |
BEGIN |
OutByte(0B8H + reg); // mov reg, n |
OutByte(0B8H + reg); (* mov reg, n *) |
OutInt(n) |
END movrc; |
235,7 → 225,7 |
PROCEDURE pushc (n: INTEGER); |
BEGIN |
OutByte(68H + short(n)); // push n |
OutByte(68H + short(n)); (* push n *) |
OutIntByte(n) |
END pushc; |
242,31 → 232,31 |
PROCEDURE test (reg: INTEGER); |
BEGIN |
OutByte2(85H, 0C0H + reg * 9) // test reg, reg |
OutByte2(85H, 0C0H + reg * 9) (* test reg, reg *) |
END test; |
PROCEDURE neg (reg: INTEGER); |
BEGIN |
OutByte2(0F7H, 0D8H + reg) // neg reg |
OutByte2(0F7H, 0D8H + reg) (* neg reg *) |
END neg; |
PROCEDURE not (reg: INTEGER); |
BEGIN |
OutByte2(0F7H, 0D0H + reg) // not reg |
OutByte2(0F7H, 0D0H + reg) (* not reg *) |
END not; |
PROCEDURE add (reg1, reg2: INTEGER); |
BEGIN |
OutByte2(01H, 0C0H + reg2 * 8 + reg1) // add reg1, reg2 |
OutByte2(01H, 0C0H + reg2 * 8 + reg1) (* add reg1, reg2 *) |
END add; |
PROCEDURE andrc (reg, n: INTEGER); |
BEGIN |
OutByte2(81H + short(n), 0E0H + reg); // and reg, n |
OutByte2(81H + short(n), 0E0H + reg); (* and reg, n *) |
OutIntByte(n) |
END andrc; |
273,7 → 263,7 |
PROCEDURE orrc (reg, n: INTEGER); |
BEGIN |
OutByte2(81H + short(n), 0C8H + reg); // or reg, n |
OutByte2(81H + short(n), 0C8H + reg); (* or reg, n *) |
OutIntByte(n) |
END orrc; |
280,7 → 270,7 |
PROCEDURE addrc (reg, n: INTEGER); |
BEGIN |
OutByte2(81H + short(n), 0C0H + reg); // add reg, n |
OutByte2(81H + short(n), 0C0H + reg); (* add reg, n *) |
OutIntByte(n) |
END addrc; |
287,7 → 277,7 |
PROCEDURE subrc (reg, n: INTEGER); |
BEGIN |
OutByte2(81H + short(n), 0E8H + reg); // sub reg, n |
OutByte2(81H + short(n), 0E8H + reg); (* sub reg, n *) |
OutIntByte(n) |
END subrc; |
294,29 → 284,39 |
PROCEDURE cmprr (reg1, reg2: INTEGER); |
BEGIN |
OutByte2(39H, 0C0H + reg2 * 8 + reg1) // cmp reg1, reg2 |
OutByte2(39H, 0C0H + reg2 * 8 + reg1) (* cmp reg1, reg2 *) |
END cmprr; |
PROCEDURE cmprc (reg, n: INTEGER); |
BEGIN |
OutByte2(81H + short(n), 0F8H + reg); // cmp reg, n |
IF n = 0 THEN |
test(reg) |
ELSE |
OutByte2(81H + short(n), 0F8H + reg); (* cmp reg, n *) |
OutIntByte(n) |
END |
END cmprc; |
PROCEDURE setcc (cond, reg: INTEGER); |
BEGIN |
OutByte3(0FH, cond, 0C0H + reg) // setcc reg |
OutByte3(0FH, cond, 0C0H + reg) (* setcc reg *) |
END setcc; |
PROCEDURE xor (reg1, reg2: INTEGER); |
BEGIN |
OutByte2(31H, 0C0H + reg2 * 8 + reg1) // xor reg1, reg2 |
OutByte2(31H, 0C0H + reg2 * 8 + reg1) (* xor reg1, reg2 *) |
END xor; |
PROCEDURE ret*; |
BEGIN |
OutByte(0C3H) |
END ret; |
PROCEDURE drop; |
BEGIN |
REG.Drop(R) |
402,10 → 402,10 |
PROCEDURE Pic (reg, opcode, value: INTEGER); |
BEGIN |
OutByte(0E8H); OutInt(0); // call L |
// L: |
OutByte(0E8H); OutInt(0); (* call L |
L: *) |
pop(reg); |
OutByte2(081H, 0C0H + reg); // add reg, ... |
OutByte2(081H, 0C0H + reg); (* add reg, ... *) |
Reloc(opcode, value) |
END Pic; |
423,10 → 423,10 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICIMP, label); |
OutByte2(0FFH, 010H + reg1); // call dword[reg1] |
OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *) |
drop |
ELSE |
OutByte2(0FFH, 015H); // call dword[label] |
OutByte2(0FFH, 015H); (* call dword[label] *) |
Reloc(BIN.RIMP, label) |
END |
ELSE |
504,12 → 504,11 |
END |
|LABEL: |
BIN.SetLabel(program, code.label, code.offset) |
|JMP: |
IF code.short THEN |
BIN.PutCode(program, 0EBH); |
BIN.PutCode(program, Byte(code.diff)) |
BIN.PutCode(program, code.diff MOD 256) |
ELSE |
BIN.PutCode(program, 0E9H); |
BIN.PutCode32LE(program, code.diff) |
518,7 → 517,7 |
|JCC: |
IF code.short THEN |
BIN.PutCode(program, code.jmp - 16); |
BIN.PutCode(program, Byte(code.diff)) |
BIN.PutCode(program, code.diff MOD 256) |
ELSE |
BIN.PutCode(program, 0FH); |
BIN.PutCode(program, code.jmp); |
573,9 → 572,127 |
END GetRegA; |
PROCEDURE fcmp; |
BEGIN |
GetRegA; |
OutByte2(0DAH, 0E9H); (* fucompp *) |
OutByte3(09BH, 0DFH, 0E0H); (* fstsw ax *) |
OutByte(09EH); (* sahf *) |
movrc(eax, 0) |
END fcmp; |
PROCEDURE movzx* (reg1, reg2, offs: INTEGER; word: BOOLEAN); (* movzx reg1, byte/word[reg2 + offs] *) |
VAR |
b: BYTE; |
BEGIN |
OutByte2(0FH, 0B6H + ORD(word)); |
IF (offs = 0) & (reg2 # ebp) THEN |
b := 0 |
ELSE |
b := 40H + long(offs) |
END; |
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); |
IF reg2 = esp THEN |
OutByte(24H) |
END; |
IF b # 0 THEN |
OutIntByte(offs) |
END |
END movzx; |
PROCEDURE _movrm* (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN); |
VAR |
b: BYTE; |
BEGIN |
IF size = 16 THEN |
OutByte(66H) |
END; |
IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN |
OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64)) |
END; |
OutByte(8BH - 2 * ORD(mr) - ORD(size = 8)); |
IF (offs = 0) & (reg2 # ebp) THEN |
b := 0 |
ELSE |
b := 40H + long(offs) |
END; |
OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); |
IF reg2 = esp THEN |
OutByte(24H) |
END; |
IF b # 0 THEN |
OutIntByte(offs) |
END |
END _movrm; |
PROCEDURE movmr (reg1, offs, reg2: INTEGER); (* mov dword[reg1+offs], reg2_8 *) |
BEGIN |
_movrm(reg2, reg1, offs, 32, TRUE) |
END movmr; |
PROCEDURE movrm (reg1, reg2, offs: INTEGER); (* mov reg1, dword[reg2 + offs] *) |
BEGIN |
_movrm(reg1, reg2, offs, 32, FALSE) |
END movrm; |
PROCEDURE movmr8* (reg1, offs, reg2: INTEGER); (* mov byte[reg1+offs], reg2_8 *) |
BEGIN |
_movrm(reg2, reg1, offs, 8, TRUE) |
END movmr8; |
PROCEDURE movrm8* (reg1, reg2, offs: INTEGER); (* mov reg1_8, byte[reg2+offs] *) |
BEGIN |
_movrm(reg1, reg2, offs, 8, FALSE) |
END movrm8; |
PROCEDURE movmr16* (reg1, offs, reg2: INTEGER); (* mov word[reg1+offs], reg2_16 *) |
BEGIN |
_movrm(reg2, reg1, offs, 16, TRUE) |
END movmr16; |
PROCEDURE movrm16* (reg1, reg2, offs: INTEGER); (* mov reg1_16, word[reg2+offs] *) |
BEGIN |
_movrm(reg1, reg2, offs, 16, FALSE) |
END movrm16; |
PROCEDURE pushm* (reg, offs: INTEGER); (* push qword[reg+offs] *) |
VAR |
b: BYTE; |
BEGIN |
IF reg >= 8 THEN |
OutByte(41H) |
END; |
OutByte(0FFH); |
IF (offs = 0) & (reg # ebp) THEN |
b := 30H |
ELSE |
b := 70H + long(offs) |
END; |
OutByte(b + reg MOD 8); |
IF reg = esp THEN |
OutByte(24H) |
END; |
IF b # 30H THEN |
OutIntByte(offs) |
END |
END pushm; |
PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER); |
VAR |
cmd: COMMAND; |
cmd, next: COMMAND; |
reg1, reg2: INTEGER; |
607,16 → 724,16 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICIMP, param1); |
OutByte2(0FFH, 010H + reg1); // call dword[reg1] |
OutByte2(0FFH, 010H + reg1); (* call dword[reg1] *) |
drop |
ELSE |
OutByte2(0FFH, 015H); // call dword[L] |
OutByte2(0FFH, 015H); (* call dword[L] *) |
Reloc(BIN.RIMP, param1) |
END |
|IL.opCALLP: |
UnOp(reg1); |
OutByte2(0FFH, 0D0H + reg1); // call reg1 |
OutByte2(0FFH, 0D0H + reg1); (* call reg1 *) |
drop; |
ASSERT(R.top = -1) |
627,7 → 744,7 |
END; |
WHILE n > 0 DO |
subrc(esp, 8); |
OutByte3(0DDH, 01CH, 024H); // fstp qword[esp] |
OutByte3(0DDH, 01CH, 024H); (* fstp qword[esp] *) |
DEC(n) |
END; |
PushAll(0) |
647,7 → 764,7 |
GetRegA; |
n := param2; |
WHILE n > 0 DO |
OutByte3(0DDH, 004H, 024H); // fld qword[esp] |
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
addrc(esp, 8); |
DEC(n) |
END |
656,12 → 773,12 |
n := param2; |
IF n > 0 THEN |
OutByte3(0DDH, 5CH + long(n * 8), 24H); |
OutIntByte(n * 8); // fstp qword[esp + n*8] |
OutIntByte(n * 8); (* fstp qword[esp + n*8] *) |
INC(n) |
END; |
WHILE n > 0 DO |
OutByte3(0DDH, 004H, 024H); // fld qword[esp] |
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
addrc(esp, 8); |
DEC(n) |
END |
677,8 → 794,8 |
n := param2; |
IF n > 4 THEN |
movrc(ecx, n); |
pushc(0); // @@: push 0 |
OutByte2(0E2H, 0FCH) // loop @b |
pushc(0); (* L: push 0 *) |
OutByte2(0E2H, 0FCH) (* loop L *) |
ELSE |
WHILE n > 0 DO |
pushc(0); |
708,14 → 825,18 |
n := param2; |
IF n > 0 THEN |
n := n * 4; |
OutByte(0C2H); OutWord(Word(n)) // ret n |
OutByte(0C2H); OutWord(n MOD 65536) (* ret n *) |
ELSE |
OutByte(0C3H) // ret |
ret |
END |
|IL.opPUSHC: |
pushc(param2) |
|IL.opONERR: |
pushc(param2); |
jmp(param1) |
|IL.opPARAM: |
n := param2; |
IF n = 1 THEN |
740,7 → 861,7 |
movrc(GetAnyReg(), param2) |
|IL.opLABEL: |
SetLabel(param1) // L: |
SetLabel(param1) (* L: *) |
|IL.opNOP: |
749,19 → 870,17 |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2) |
ELSE |
OutByte(0B8H + reg1); // mov reg1, _bss + param2 |
OutByte(0B8H + reg1); (* mov reg1, _bss + param2 *) |
Reloc(BIN.RBSS, param2) |
END |
|IL.opLADR: |
n := param2 * 4; |
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n] |
OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); (* lea reg1, dword[ebp + n] *) |
OutIntByte(n) |
|IL.opVADR: |
n := param2 * 4; |
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n) |
|IL.opVADR, IL.opLLOAD32: |
movrm(GetAnyReg(), ebp, param2 * 4) |
|IL.opSADR: |
reg1 := GetAnyReg(); |
768,102 → 887,88 |
IF pic THEN |
Pic(reg1, BIN.PICDATA, stroffs + param2); |
ELSE |
OutByte(0B8H + reg1); // mov reg1, _data + stroffs + param2 |
OutByte(0B8H + reg1); (* mov reg1, _data + stroffs + param2 *) |
Reloc(BIN.RDATA, stroffs + param2) |
END |
|IL.opSAVEC: |
UnOp(reg1); |
OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2 |
OutByte2(0C7H, reg1); OutInt(param2); (* mov dword[reg1], param2 *) |
drop |
|IL.opSAVE8C: |
UnOp(reg1); |
OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2 |
OutByte3(0C6H, reg1, param2 MOD 256); (* mov byte[reg1], param2 *) |
drop |
|IL.opSAVE16C: |
UnOp(reg1); |
OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2 |
OutByte3(66H, 0C7H, reg1); OutWord(param2 MOD 65536); (* mov word[reg1], param2 *) |
drop |
|IL.opVLOAD32: |
n := param2 * 4; |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
movrm(reg1, ebp, param2 * 4); |
movrm(reg1, reg1, 0) |
|IL.opGLOAD32: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
movrm(reg1, reg1, 0) |
ELSE |
OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[_bss + param2] |
OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[_bss + param2] *) |
Reloc(BIN.RBSS, param2) |
END |
|IL.opLLOAD32: |
n := param2 * 4; |
OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n) |
|IL.opLOAD32: |
UnOp(reg1); |
OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] |
movrm(reg1, reg1, 0) |
|IL.opVLOAD8: |
n := param2 * 4; |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
movrm(reg1, ebp, param2 * 4); |
movzx(reg1, reg1, 0, FALSE) |
|IL.opGLOAD8: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
movzx(reg1, reg1, 0, FALSE) |
ELSE |
OutByte3(00FH, 0B6H, 05H + reg1 * 8); // movzx reg1, byte[_bss + param2] |
OutByte3(00FH, 0B6H, 05H + reg1 * 8); (* movzx reg1, byte[_bss + param2] *) |
Reloc(BIN.RBSS, param2) |
END |
|IL.opLLOAD8: |
n := param2 * 4; |
OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n] |
OutIntByte(n) |
movzx(GetAnyReg(), ebp, param2 * 4, FALSE) |
|IL.opLOAD8: |
UnOp(reg1); |
OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] |
movzx(reg1, reg1, 0, FALSE) |
|IL.opVLOAD16: |
n := param2 * 4; |
reg1 := GetAnyReg(); |
OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] |
OutIntByte(n); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
movrm(reg1, ebp, param2 * 4); |
movzx(reg1, reg1, 0, TRUE) |
|IL.opGLOAD16: |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICBSS, param2); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
movzx(reg1, reg1, 0, TRUE) |
ELSE |
OutByte3(00FH, 0B7H, 05H + reg1 * 8); // movzx reg1, word[_bss + param2] |
OutByte3(00FH, 0B7H, 05H + reg1 * 8); (* movzx reg1, word[_bss + param2] *) |
Reloc(BIN.RBSS, param2) |
END |
|IL.opLLOAD16: |
n := param2 * 4; |
OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n] |
OutIntByte(n) |
movzx(GetAnyReg(), ebp, param2 * 4, TRUE) |
|IL.opLOAD16: |
UnOp(reg1); |
OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] |
movzx(reg1, reg1, 0, TRUE) |
|IL.opUMINUS: |
UnOp(reg1); |
877,18 → 982,35 |
|IL.opADDL, IL.opADDR: |
IF param2 # 0 THEN |
UnOp(reg1); |
next := cmd.next(COMMAND); |
CASE next.opcode OF |
|IL.opLOAD32: |
movrm(reg1, reg1, param2); |
cmd := next |
|IL.opLOAD16: |
movzx(reg1, reg1, param2, TRUE); |
cmd := next |
|IL.opLOAD8: |
movzx(reg1, reg1, param2, FALSE); |
cmd := next |
|IL.opLOAD32_PARAM: |
pushm(reg1, param2); |
drop; |
cmd := next |
ELSE |
IF param2 = 1 THEN |
OutByte(40H + reg1) // inc reg1 |
OutByte(40H + reg1) (* inc reg1 *) |
ELSIF param2 = -1 THEN |
OutByte(48H + reg1) // dec reg1 |
OutByte(48H + reg1) (* dec reg1 *) |
ELSE |
addrc(reg1, param2) |
END |
END |
END |
|IL.opSUB: |
BinOp(reg1, reg2); |
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 |
OutByte2(29H, 0C0H + reg2 * 8 + reg1); (* sub reg1, reg2 *) |
drop |
|IL.opSUBR, IL.opSUBL: |
895,9 → 1017,9 |
UnOp(reg1); |
n := param2; |
IF n = 1 THEN |
OutByte(48H + reg1) // dec reg1 |
OutByte(48H + reg1) (* dec reg1 *) |
ELSIF n = -1 THEN |
OutByte(40H + reg1) // inc reg1 |
OutByte(40H + reg1) (* inc reg1 *) |
ELSIF n # 0 THEN |
subrc(reg1, n) |
END; |
906,6 → 1028,12 |
END |
|IL.opMULC: |
IF (cmd.next(COMMAND).opcode = IL.opADD) & ((param2 = 2) OR (param2 = 4) OR (param2 = 8)) THEN |
BinOp(reg1, reg2); |
OutByte3(8DH, 04H + reg1 * 8, reg1 + reg2 * 8 + 40H * UTILS.Log2(param2)); (* lea reg1, [reg1 + reg2 * param2] *) |
drop; |
cmd := cmd.next(COMMAND) |
ELSE |
UnOp(reg1); |
a := param2; |
930,36 → 1058,37 |
END; |
IF n # 1 THEN |
OutByte3(0C1H, 0E0H + reg1, n) // shl reg1, n |
OutByte3(0C1H, 0E0H + reg1, n) (* shl reg1, n *) |
ELSE |
OutByte2(0D1H, 0E0H + reg1) // shl reg1, 1 |
OutByte2(0D1H, 0E0H + reg1) (* shl reg1, 1 *) |
END |
ELSE |
OutByte2(69H + short(a), 0C0H + reg1 * 9); // imul reg1, a |
OutByte2(69H + short(a), 0C0H + reg1 * 9); (* imul reg1, a *) |
OutIntByte(a) |
END |
END |
END |
|IL.opMUL: |
BinOp(reg1, reg2); |
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2 |
OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); (* imul reg1, reg2 *) |
drop |
|IL.opSAVE, IL.opSAVE32: |
BinOp(reg2, reg1); |
OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2 |
movmr(reg1, 0, reg2); |
drop; |
drop |
|IL.opSAVE8: |
BinOp(reg2, reg1); |
OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 |
movmr8(reg1, 0, reg2); |
drop; |
drop |
|IL.opSAVE16: |
BinOp(reg2, reg1); |
OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2 |
movmr16(reg1, 0, reg2); |
drop; |
drop |
968,10 → 1097,10 |
IF pic THEN |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICCODE, param2); |
OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2 |
movmr(reg1, 0, reg2); |
drop |
ELSE |
OutByte2(0C7H, reg1); // mov dword[reg1], L |
OutByte2(0C7H, reg1); (* mov dword[reg1], L *) |
Reloc(BIN.RCODE, param2) |
END; |
drop |
981,13 → 1110,13 |
IF pic THEN |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICIMP, param2); |
OutByte2(0FFH, 30H + reg2); // push dword[reg2] |
OutByte2(08FH, reg1); // pop dword[reg1] |
pushm(reg2, 0); |
OutByte2(08FH, reg1); (* pop dword[reg1] *) |
drop |
ELSE |
OutByte2(0FFH, 035H); // push dword[L] |
OutByte2(0FFH, 035H); (* push dword[L] *) |
Reloc(BIN.RIMP, param2); |
OutByte2(08FH, reg1) // pop dword[reg1] |
OutByte2(08FH, reg1) (* pop dword[reg1] *) |
END; |
drop |
996,7 → 1125,7 |
IF pic THEN |
Pic(reg1, BIN.PICCODE, param2) |
ELSE |
OutByte(0B8H + reg1); // mov reg1, L |
OutByte(0B8H + reg1); (* mov reg1, L *) |
Reloc(BIN.RCODE, param2) |
END |
1004,9 → 1133,9 |
reg1 := GetAnyReg(); |
IF pic THEN |
Pic(reg1, BIN.PICIMP, param2); |
OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1] |
movrm(reg1, reg1, 0) |
ELSE |
OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[L] |
OutByte2(08BH, 05H + reg1 * 8); (* mov reg1, dword[L] *) |
Reloc(BIN.RIMP, param2) |
END |
1025,19 → 1154,15 |
|IL.opSBOOL: |
BinOp(reg2, reg1); |
test(reg2); |
OutByte3(0FH, 95H, reg1); // setne byte[reg1] |
OutByte3(0FH, 95H, reg1); (* setne byte[reg1] *) |
drop; |
drop |
|IL.opSBOOLC: |
UnOp(reg1); |
OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1 |
OutByte3(0C6H, reg1, ORD(param2 # 0)); (* mov byte[reg1], 0/1 *) |
drop |
|IL.opODD: |
UnOp(reg1); |
andrc(reg1, 1) |
|IL.opEQ..IL.opGE, |
IL.opEQC..IL.opGEC: |
1047,26 → 1172,19 |
drop |
ELSE |
UnOp(reg1); |
IF param2 = 0 THEN |
test(reg1) |
ELSE |
cmprc(reg1, param2) |
END |
END; |
drop; |
cc := cond(opcode); |
next := cmd.next(COMMAND); |
IF cmd.next(COMMAND).opcode = IL.opJE THEN |
label := cmd.next(COMMAND).param1; |
jcc(cc, label); |
cmd := cmd.next(COMMAND) |
ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN |
label := cmd.next(COMMAND).param1; |
jcc(inv0(cc), label); |
cmd := cmd.next(COMMAND) |
IF next.opcode = IL.opJE THEN |
jcc(cc, next.param1); |
cmd := next |
ELSIF next.opcode = IL.opJNE THEN |
jcc(inv0(cc), next.param1); |
cmd := next |
ELSE |
reg1 := GetAnyReg(); |
setcc(cc + 16, reg1); |
1078,13 → 1196,13 |
drop; |
test(reg1); |
OutByte2(74H, 5); // je @f |
movrc(reg1, 1); // mov reg1, 1 |
// @@: |
OutByte2(74H, 5); (* je @f *) |
movrc(reg1, 1); (* mov reg1, 1 |
@@: *) |
test(reg2); |
OutByte2(74H, 5); // je @f |
movrc(reg2, 1); // mov reg2, 1 |
// @@: |
OutByte2(74H, 5); (* je @f *) |
movrc(reg2, 1); (* mov reg2, 1 |
@@: *) |
cmprr(reg1, reg2); |
IF opcode = IL.opEQB THEN |
1116,6 → 1234,11 |
test(reg1); |
jcc(je, param1) |
|IL.opJG: |
UnOp(reg1); |
test(reg1); |
jcc(jg, param1) |
|IL.opJE: |
UnOp(reg1); |
test(reg1); |
1171,26 → 1294,15 |
drop; |
drop; |
CASE param2 OF |
|1: |
OutByte2(8AH, reg1 * 9); // mov reg1, byte[reg1] |
OutByte2(88H, reg1 * 8 + reg2) // mov byte[reg2], reg1 |
|2: |
OutByte3(66H, 8BH, reg1 * 9); // mov reg1, word[reg1] |
OutByte3(66H, 89H, reg1 * 8 + reg2) // mov word[reg2], reg1 |
|4: |
OutByte2(8BH, reg1 * 9); // mov reg1, dword[reg1] |
OutByte2(89H, reg1 * 8 + reg2) // mov dword[reg2], reg1 |
|8: |
IF param2 # 8 THEN |
_movrm(reg1, reg1, 0, param2 * 8, FALSE); |
_movrm(reg1, reg2, 0, param2 * 8, TRUE) |
ELSE |
PushAll(0); |
push(reg1); |
push(reg2); |
pushc(8); |
CallRTL(pic, IL._move) |
END |
|IL.opSAVES: |
1203,7 → 1315,7 |
push(reg1); |
drop |
ELSE |
OutByte(068H); // push _data + stroffs + param2 |
OutByte(068H); (* push _data + stroffs + param2 *) |
Reloc(BIN.RDATA, stroffs + param2); |
END; |
1226,14 → 1338,11 |
BinOp(reg1, reg2); |
IF param2 # -1 THEN |
cmprr(reg2, reg1); |
mov(reg1, reg2); |
drop; |
jcc(jb, param1) |
ELSE |
END; |
INCL(R.regs, reg1); |
DEC(R.top); |
R.stk[R.top] := reg2 |
END |
|IL.opLEN: |
n := param2; |
1252,29 → 1361,35 |
|IL.opINCC: |
UnOp(reg1); |
OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2 |
IF param2 = 1 THEN |
OutByte2(0FFH, reg1) (* inc dword[reg1] *) |
ELSIF param2 = -1 THEN |
OutByte2(0FFH, reg1 + 8) (* dec dword[reg1] *) |
ELSE |
OutByte2(81H + short(param2), reg1); OutIntByte(param2) (* add dword[reg1], param2 *) |
END; |
drop |
|IL.opINC, IL.opDEC: |
BinOp(reg1, reg2); |
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1 |
OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); (* add/sub dword[reg2], reg1 *) |
drop; |
drop |
|IL.opINCCB, IL.opDECCB: |
UnOp(reg1); |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n |
OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, param2 MOD 256); (* add/sub byte[reg1], n *) |
drop |
|IL.opINCB, IL.opDECB: |
BinOp(reg1, reg2); |
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1 |
OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); (* add/sub byte[reg2], reg1 *) |
drop; |
drop |
|IL.opMULS: |
BinOp(reg1, reg2); |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) |
drop |
|IL.opMULSC: |
1288,18 → 1403,18 |
|IL.opDIVSC: |
UnOp(reg1); |
OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n |
OutByte2(81H + short(param2), 0F0H + reg1); (* xor reg1, n *) |
OutIntByte(param2) |
|IL.opADDS: |
BinOp(reg1, reg2); |
OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2 |
OutByte2(9H, 0C0H + reg2 * 8 + reg1); (* or reg1, reg2 *) |
drop |
|IL.opSUBS: |
BinOp(reg1, reg2); |
not(reg2); |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 |
OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) |
drop |
|IL.opADDSL, IL.opADDSR: |
1348,7 → 1463,7 |
BinOp(reg1, reg2); |
ASSERT(reg2 = ecx); |
OutByte(0D3H); |
shift(opcode, reg1); // shift reg1, cl |
shift(opcode, reg1); (* shift reg1, cl *) |
drop |
|IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: |
1364,7 → 1479,7 |
BinOp(reg1, reg2); |
ASSERT(reg1 = ecx); |
OutByte(0D3H); |
shift(opcode, reg2); // shift reg2, cl |
shift(opcode, reg2); (* shift reg2, cl *) |
drop; |
drop; |
ASSERT(REG.GetReg(R, reg2)) |
1377,74 → 1492,47 |
ELSE |
OutByte(0D1H) |
END; |
shift(opcode, reg1); // shift reg1, n |
shift(opcode, reg1); (* shift reg1, n *) |
IF n # 1 THEN |
OutByte(n) |
END |
|IL.opMIN: |
|IL.opMAX, IL.opMIN: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(07EH, 002H); // jle @f |
mov(reg1, reg2); // mov reg1, reg2 |
// @@: |
OutByte2(07DH + ORD(opcode = IL.opMIN), 2); (* jge/jle L *) |
mov(reg1, reg2); |
(* L: *) |
drop |
|IL.opMAX: |
BinOp(reg1, reg2); |
cmprr(reg1, reg2); |
OutByte2(07DH, 002H); // jge @f |
mov(reg1, reg2); // mov reg1, reg2 |
// @@: |
drop |
|IL.opMINC: |
|IL.opMAXC, IL.opMINC: |
UnOp(reg1); |
cmprc(reg1, param2); |
OutByte2(07EH, 005H); // jle @f |
movrc(reg1, param2) // mov reg1, param2 |
// @@: |
OutByte2(07DH + ORD(opcode = IL.opMINC), 5); (* jge/jle L *) |
movrc(reg1, param2) |
(* L: *) |
|IL.opMAXC: |
UnOp(reg1); |
cmprc(reg1, param2); |
OutByte2(07DH, 005H); // jge @f |
movrc(reg1, param2) // mov reg1, param2 |
// @@: |
|IL.opIN: |
|IL.opIN, IL.opINR: |
IF opcode = IL.opINR THEN |
reg2 := GetAnyReg(); |
movrc(reg2, param2) |
END; |
label := NewLabel(); |
BinOp(reg1, reg2); |
cmprc(reg1, 32); |
OutByte2(72H, 4); // jb L |
OutByte2(72H, 4); (* jb L *) |
xor(reg1, reg1); |
jmp(label); |
//L: |
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 |
(* L: *) |
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); (* bt reg2, reg1 *) |
setcc(setc, reg1); |
andrc(reg1, 1); |
SetLabel(label); |
drop |
|IL.opINR: |
label := NewLabel(); |
UnOp(reg1); |
reg2 := GetAnyReg(); |
cmprc(reg1, 32); |
OutByte2(72H, 4); // jb L |
xor(reg1, reg1); |
jmp(label); |
//L: |
movrc(reg2, param2); |
OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 |
setcc(setc, reg1); |
andrc(reg1, 1); |
SetLabel(label); |
drop |
|IL.opINL: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2 |
OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); (* bt reg1, param2 *) |
setcc(setc, reg1); |
andrc(reg1, 1) |
1476,26 → 1564,26 |
|IL.opINCL, IL.opEXCL: |
BinOp(reg1, reg2); |
cmprc(reg1, 32); |
OutByte2(73H, 03H); // jnb L |
OutByte2(73H, 03H); (* jnb L *) |
OutByte(0FH); |
IF opcode = IL.opINCL THEN |
OutByte(0ABH) // bts dword[reg2], reg1 |
OutByte(0ABH) (* bts dword[reg2], reg1 *) |
ELSE |
OutByte(0B3H) // btr dword[reg2], reg1 |
OutByte(0B3H) (* btr dword[reg2], reg1 *) |
END; |
OutByte(reg2 + 8 * reg1); |
//L: |
(* L: *) |
drop; |
drop |
|IL.opINCLC: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2 |
OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); (* bts dword[reg1], param2 *) |
drop |
|IL.opEXCLC: |
UnOp(reg1); |
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2 |
OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); (* btr dword[reg1], param2 *) |
drop |
|IL.opDIV: |
1504,49 → 1592,20 |
GetRegA |
|IL.opDIVR: |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF a = 1 THEN |
ELSIF a = -1 THEN |
UnOp(reg1); |
neg(reg1) |
ELSE |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(reg1); |
IF a < 0 THEN |
reg2 := GetAnyReg(); |
mov(reg2, reg1); |
IF n # 1 THEN |
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n |
OutByte3(0C1H, 0F8H + reg1, n) (* sar reg1, n *) |
ELSE |
OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 |
END; |
OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 |
drop |
ELSE |
IF n # 1 THEN |
OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n |
ELSE |
OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 |
OutByte2(0D1H, 0F8H + reg1) (* sar reg1, 1 *) |
END |
END |
ELSE |
ELSIF n < 0 THEN |
PushAll(1); |
pushc(param2); |
CallRTL(pic, IL._divmod); |
GetRegA |
END |
END |
|IL.opDIVL: |
UnOp(reg1); |
1564,43 → 1623,20 |
GetRegA |
|IL.opMODR: |
a := param2; |
IF a > 1 THEN |
n := UTILS.Log2(a) |
ELSIF a < -1 THEN |
n := UTILS.Log2(-a) |
ELSE |
n := -1 |
END; |
IF ABS(a) = 1 THEN |
UnOp(reg1); |
xor(reg1, reg1) |
ELSE |
n := UTILS.Log2(param2); |
IF n > 0 THEN |
UnOp(reg1); |
andrc(reg1, ABS(a) - 1); |
IF a < 0 THEN |
test(reg1); |
OutByte(74H); // je @f |
IF isByte(a) THEN |
OutByte(3) |
ELSE |
OutByte(6) |
END; |
addrc(reg1, a) |
// @@: |
END |
ELSE |
andrc(reg1, param2 - 1); |
ELSIF n < 0 THEN |
PushAll(1); |
pushc(param2); |
CallRTL(pic, IL._divmod); |
mov(eax, edx); |
GetRegA |
ELSE |
UnOp(reg1); |
xor(reg1, reg1) |
END |
END |
|IL.opMODL: |
UnOp(reg1); |
1618,9 → 1654,9 |
|IL.opABS: |
UnOp(reg1); |
test(reg1); |
OutByte2(07DH, 002H); // jge @f |
neg(reg1) // neg reg1 |
// @@: |
OutByte2(07DH, 002H); (* jge L *) |
neg(reg1) (* neg reg1 |
L: *) |
|IL.opCOPY: |
PushAll(2); |
1682,7 → 1718,7 |
cmprr(reg1, reg2); |
drop |
ELSE |
OutByte2(081H, 0F8H + reg1); // cmp reg1, L |
OutByte2(081H, 0F8H + reg1); (* cmp reg1, L *) |
Reloc(BIN.RCODE, param1) |
END |
1690,10 → 1726,10 |
IF pic THEN |
reg2 := GetAnyReg(); |
Pic(reg2, BIN.PICIMP, param1); |
OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2] |
OutByte2(03BH, reg1 * 8 + reg2); (* cmp reg1, dword [reg2] *) |
drop |
ELSE |
OutByte2(3BH, 05H + reg1 * 8); // cmp reg1, dword[L] |
OutByte2(3BH, 05H + reg1 * 8); (* cmp reg1, dword[L] *) |
Reloc(BIN.RIMP, param1) |
END |
1710,8 → 1746,7 |
|IL.opPUSHT: |
UnOp(reg1); |
reg2 := GetAnyReg(); |
OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4] |
movrm(GetAnyReg(), reg1, -4) |
|IL.opISREC: |
PushAll(2); |
1742,7 → 1777,7 |
|IL.opTYPEGD: |
UnOp(reg1); |
PushAll(0); |
OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4] |
pushm(reg1, -4); |
pushc(param2 * tcount); |
CallRTL(pic, IL._guardrec); |
GetRegA |
1759,11 → 1794,11 |
|IL.opPACK: |
BinOp(reg1, reg2); |
push(reg2); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0D9H, 0FDH); // fscale |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] |
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) |
OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
OutByte2(0D9H, 0FDH); (* fscale *) |
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) |
pop(reg2); |
drop; |
drop |
1771,187 → 1806,163 |
|IL.opPACKC: |
UnOp(reg1); |
pushc(param2); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0D9H, 0FDH); // fscale |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] |
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) |
OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
OutByte2(0D9H, 0FDH); (* fscale *) |
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) |
pop(reg1); |
drop |
|IL.opUNPK: |
BinOp(reg1, reg2); |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0D9H, 0F4H); // fxtract |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] |
OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
OutByte2(0D9H, 0F4H); (* fxtract *) |
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *) |
drop; |
drop |
|IL.opPUSHF: |
subrc(esp, 8); |
OutByte3(0DDH, 01CH, 024H) // fstp qword[esp] |
OutByte3(0DDH, 01CH, 024H) (* fstp qword[esp] *) |
|IL.opLOADF: |
UnOp(reg1); |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
drop |
|IL.opCONSTF: |
float := cmd.float; |
IF float = 0.0 THEN |
OutByte2(0D9H, 0EEH) // fldz |
OutByte2(0D9H, 0EEH) (* fldz *) |
ELSIF float = 1.0 THEN |
OutByte2(0D9H, 0E8H) // fld1 |
OutByte2(0D9H, 0E8H) (* fld1 *) |
ELSIF float = -1.0 THEN |
OutByte2(0D9H, 0E8H); // fld1 |
OutByte2(0D9H, 0E0H) // fchs |
OutByte2(0D9H, 0E8H); (* fld1 *) |
OutByte2(0D9H, 0E0H) (* fchs *) |
ELSE |
n := UTILS.splitf(float, a, b); |
pushc(b); |
pushc(a); |
OutByte3(0DDH, 004H, 024H); // fld qword[esp] |
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
addrc(esp, 8) |
END |
|IL.opSAVEF: |
|IL.opSAVEF, IL.opSAVEFI: |
UnOp(reg1); |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
drop |
|IL.opADDF, IL.opADDFI: |
OutByte2(0DEH, 0C1H) // faddp st1, st |
OutByte2(0DEH, 0C1H) (* faddp st1, st *) |
|IL.opSUBF: |
OutByte2(0DEH, 0E9H) // fsubp st1, st |
OutByte2(0DEH, 0E9H) (* fsubp st1, st *) |
|IL.opSUBFI: |
OutByte2(0DEH, 0E1H) // fsubrp st1, st |
OutByte2(0DEH, 0E1H) (* fsubrp st1, st *) |
|IL.opMULF: |
OutByte2(0DEH, 0C9H) // fmulp st1, st |
OutByte2(0DEH, 0C9H) (* fmulp st1, st *) |
|IL.opDIVF: |
OutByte2(0DEH, 0F9H) // fdivp st1, st |
OutByte2(0DEH, 0F9H) (* fdivp st1, st *) |
|IL.opDIVFI: |
OutByte2(0DEH, 0F1H) // fdivrp st1, st |
OutByte2(0DEH, 0F1H) (* fdivrp st1, st *) |
|IL.opUMINF: |
OutByte2(0D9H, 0E0H) // fchs |
OutByte2(0D9H, 0E0H) (* fchs *) |
|IL.opFABS: |
OutByte2(0D9H, 0E1H) // fabs |
OutByte2(0D9H, 0E1H) (* fabs *) |
|IL.opFLT: |
UnOp(reg1); |
push(reg1); |
OutByte3(0DBH, 004H, 024H); // fild dword[esp] |
OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) |
pop(reg1); |
drop |
|IL.opFLOOR: |
subrc(esp, 8); |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4] |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6] |
OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); // and word[esp+4], 1111001111111111b |
OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); // or word[esp+4], 0000010000000000b |
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4] |
OutByte2(0D9H, 0FCH); // frndint |
OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); (* fstcw word[esp+4] *) |
OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); (* fstcw word[esp+6] *) |
OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); (* and word[esp+4], 1111001111111111b *) |
OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); (* or word[esp+4], 0000010000000000b *) |
OutByte2(0D9H, 06CH); OutByte2(024H, 004H); (* fldcw word[esp+4] *) |
OutByte2(0D9H, 0FCH); (* frndint *) |
OutByte3(0DBH, 01CH, 024H); (* fistp dword[esp] *) |
pop(GetAnyReg()); |
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2] |
OutByte2(0D9H, 06CH); OutByte2(024H, 002H); (* fldcw word[esp+2] *) |
addrc(esp, 4) |
|IL.opEQF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 003H); // jp L |
fcmp; |
OutByte2(07AH, 003H); (* jp L *) |
setcc(sete, al) |
// L: |
(* L: *) |
|IL.opNEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 003H); // jp L |
fcmp; |
OutByte2(07AH, 003H); (* jp L *) |
setcc(setne, al) |
// L: |
(* L: *) |
|IL.opLTF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 00EH); // jp L |
fcmp; |
OutByte2(07AH, 00EH); (* jp L *) |
setcc(setc, al); |
setcc(sete, ah); |
test(eax); |
setcc(sete, al); |
andrc(eax, 1) |
// L: |
(* L: *) |
|IL.opGTF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 00FH); // jp L |
fcmp; |
OutByte2(07AH, 00FH); (* jp L *) |
setcc(setc, al); |
setcc(sete, ah); |
cmprc(eax, 1); |
setcc(sete, al); |
andrc(eax, 1) |
// L: |
(* L: *) |
|IL.opLEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 003H); // jp L |
fcmp; |
OutByte2(07AH, 003H); (* jp L *) |
setcc(setnc, al) |
// L: |
(* L: *) |
|IL.opGEF: |
GetRegA; |
OutByte2(0DAH, 0E9H); // fucompp |
OutByte3(09BH, 0DFH, 0E0H); // fstsw ax |
OutByte(09EH); // sahf |
movrc(eax, 0); |
OutByte2(07AH, 010H); // jp L |
fcmp; |
OutByte2(07AH, 010H); (* jp L *) |
setcc(setc, al); |
setcc(sete, ah); |
OutByte2(000H, 0E0H); // add al,ah |
OutByte2(03CH, 001H); // cmp al,1 |
OutByte2(000H, 0E0H); (* add al, ah *) |
OutByte2(03CH, 001H); (* cmp al, 1 *) |
setcc(sete, al); |
andrc(eax, 1) |
// L: |
(* L: *) |
|IL.opINF: |
pushc(7FF00000H); |
pushc(0); |
OutByte3(0DDH, 004H, 024H); // fld qword[esp] |
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
addrc(esp, 8) |
|IL.opLADR_UNPK: |
n := param2 * 4; |
reg1 := GetAnyReg(); |
OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] |
OutByte2(8DH, 45H + reg1 * 8 + long(n)); (* lea reg1, dword[ebp + n] *) |
OutIntByte(n); |
BinOp(reg1, reg2); |
OutByte2(0DDH, reg1); // fld qword[reg1] |
OutByte2(0D9H, 0F4H); // fxtract |
OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] |
OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] |
OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
OutByte2(0D9H, 0F4H); (* fxtract *) |
OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
OutByte2(0DBH, 018H + reg2); (* fistp dword[reg2] *) |
drop; |
drop |
1962,14 → 1973,12 |
push(reg1); |
drop |
ELSE |
OutByte(068H); // push _data + stroffs + param2 |
OutByte(068H); (* push _data + stroffs + param2 *) |
Reloc(BIN.RDATA, stroffs + param2) |
END |
|IL.opVADR_PARAM: |
n := param2 * 4; |
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] |
OutIntByte(n) |
|IL.opVADR_PARAM, IL.opLLOAD32_PARAM: |
pushm(ebp, param2 * 4) |
|IL.opCONST_PARAM: |
pushc(param2) |
1978,21 → 1987,16 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICBSS, param2); |
OutByte2(0FFH, 30H + reg1); // push dword[reg1] |
pushm(reg1, 0); |
drop |
ELSE |
OutByte2(0FFH, 035H); // push dword[_bss + param2] |
OutByte2(0FFH, 035H); (* push dword[_bss + param2] *) |
Reloc(BIN.RBSS, param2) |
END |
|IL.opLLOAD32_PARAM: |
n := param2 * 4; |
OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] |
OutIntByte(n) |
|IL.opLOAD32_PARAM: |
UnOp(reg1); |
OutByte2(0FFH, 30H + reg1); // push dword[reg1] |
pushm(reg1, 0); |
drop |
|IL.opGADR_SAVEC: |
1999,11 → 2003,11 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICBSS, param1); |
OutByte2(0C7H, reg1); // mov dword[reg1], param2 |
OutByte2(0C7H, reg1); (* mov dword[reg1], param2 *) |
OutInt(param2); |
drop |
ELSE |
OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2 |
OutByte2(0C7H, 05H); (* mov dword[_bss + param1], param2 *) |
Reloc(BIN.RBSS, param1); |
OutInt(param2) |
END |
2010,24 → 2014,22 |
|IL.opLADR_SAVEC: |
n := param1 * 4; |
OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2 |
OutByte2(0C7H, 45H + long(n)); (* mov dword[ebp + n], param2 *) |
OutIntByte(n); |
OutInt(param2) |
|IL.opLADR_SAVE: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1 |
OutIntByte(n); |
movmr(ebp, param2 * 4, reg1); |
drop |
|IL.opLADR_INCC: |
n := param1 * 4; |
IF ABS(param2) = 1 THEN |
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n] |
OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); (* inc/dec dword[ebp + n] *) |
OutIntByte(n) |
ELSE |
OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 |
OutByte2(81H + short(param2), 45H + long(n)); (* add dword[ebp + n], param2 *) |
OutIntByte(n); |
OutIntByte(param2) |
END |
2035,10 → 2037,10 |
|IL.opLADR_INCCB, IL.opLADR_DECCB: |
n := param1 * 4; |
IF param2 = 1 THEN |
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n] |
OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* inc/dec byte[ebp + n] *) |
OutIntByte(n) |
ELSE |
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2 |
OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); (* add/sub byte[ebp + n], param2 *) |
OutIntByte(n); |
OutByte(param2 MOD 256) |
END |
2046,7 → 2048,7 |
|IL.opLADR_INC, IL.opLADR_DEC: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1 |
OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); (* add/sub dword[ebp + n], reg1 *) |
OutIntByte(n); |
drop |
2053,7 → 2055,7 |
|IL.opLADR_INCB, IL.opLADR_DECB: |
n := param2 * 4; |
UnOp(reg1); |
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1 |
OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); (* add/sub byte[ebp + n], reg1 *) |
OutIntByte(n); |
drop |
2063,7 → 2065,7 |
cmprc(reg1, 32); |
label := NewLabel(); |
jcc(jnb, label); |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 |
OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); (* bts(r) dword[ebp + n], reg1 *) |
OutIntByte(n); |
SetLabel(label); |
drop |
2070,7 → 2072,7 |
|IL.opLADR_INCLC, IL.opLADR_EXCLC: |
n := param1 * 4; |
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 |
OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); (* bts(r) dword[ebp + n], param2 *) |
OutIntByte(n); |
OutByte(param2) |
2096,28 → 2098,28 |
entry := NewLabel(); |
SetLabel(entry); |
IF target = mConst.Target_iDLL THEN |
IF target = TARGETS.Win32DLL THEN |
push(ebp); |
mov(ebp, esp); |
OutByte3(0FFH, 75H, 16); // push dword[ebp+16] |
OutByte3(0FFH, 75H, 12); // push dword[ebp+12] |
OutByte3(0FFH, 75H, 8); // push dword[ebp+8] |
pushm(ebp, 16); |
pushm(ebp, 12); |
pushm(ebp, 8); |
CallRTL(pic, IL._dllentry); |
test(eax); |
jcc(je, dllret) |
ELSIF target = mConst.Target_iObject THEN |
ELSIF target = TARGETS.KolibriOSDLL THEN |
SetLabel(dllinit) |
END; |
IF target = mConst.Target_iKolibri THEN |
IF target = TARGETS.KolibriOS THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.IMPTAB, 0); |
push(reg1); // push IMPORT |
push(reg1); (* push IMPORT *) |
drop |
ELSIF target = mConst.Target_iObject THEN |
OutByte(68H); // push IMPORT |
ELSIF target = TARGETS.KolibriOSDLL THEN |
OutByte(68H); (* push IMPORT *) |
Reloc(BIN.IMPTAB, 0) |
ELSIF target = mConst.Target_iELF32 THEN |
ELSIF target = TARGETS.Linux32 THEN |
push(esp) |
ELSE |
pushc(0) |
2126,10 → 2128,10 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICCODE, entry); |
push(reg1); // push CODE |
push(reg1); (* push CODE *) |
drop |
ELSE |
OutByte(68H); // push CODE |
OutByte(68H); (* push CODE *) |
Reloc(BIN.RCODE, entry) |
END; |
2136,10 → 2138,10 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICDATA, 0); |
push(reg1); // push _data |
push(reg1); (* push _data *) |
drop |
ELSE |
OutByte(68H); // push _data |
OutByte(68H); (* push _data *) |
Reloc(BIN.RDATA, 0) |
END; |
2150,16 → 2152,16 |
IF pic THEN |
reg1 := GetAnyReg(); |
Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); |
push(reg1); // push _data + tcount * 4 + dcount |
push(reg1); (* push _data + tcount * 4 + dcount *) |
drop |
ELSE |
OutByte(68H); // push _data |
OutByte(68H); (* push _data *) |
Reloc(BIN.RDATA, tcount * 4 + dcount) |
END; |
CallRTL(pic, IL._init); |
IF target = mConst.Target_iELF32 THEN |
IF target = TARGETS.Linux32 THEN |
L := NewLabel(); |
pushc(0); |
push(esp); |
2207,22 → 2209,22 |
BEGIN |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN |
IF target IN {TARGETS.Win32C, TARGETS.Win32GUI, TARGETS.KolibriOS, TARGETS.Linux32} THEN |
pushc(0); |
CallRTL(pic, IL._exit); |
ELSIF target = mConst.Target_iDLL THEN |
ELSIF target = TARGETS.Win32DLL THEN |
SetLabel(dllret); |
movrc(eax, 1); |
OutByte(0C9H); // leave |
OutByte3(0C2H, 0CH, 0) // ret 12 |
ELSIF target = mConst.Target_iObject THEN |
OutByte(0C9H); (* leave *) |
OutByte3(0C2H, 0CH, 0) (* ret 12 *) |
ELSIF target = TARGETS.KolibriOSDLL THEN |
movrc(eax, 1); |
OutByte(0C3H) // ret |
ELSIF target = mConst.Target_iELFSO32 THEN |
OutByte(0C3H); // ret |
ret |
ELSIF target = TARGETS.Linux32SO THEN |
ret; |
SetLabel(sofinit); |
CallRTL(pic, IL._sofinit); |
OutByte(0C3H) // ret |
ret |
END; |
fixup; |
2244,7 → 2246,7 |
BIN.PutDataStr(program, ext); |
BIN.PutData(program, 0); |
IF target = mConst.Target_iObject THEN |
IF target = TARGETS.KolibriOSDLL THEN |
BIN.Export(program, "lib_init", dllinit); |
END; |
2280,11 → 2282,11 |
dllret := NewLabel(); |
sofinit := NewLabel(); |
IF target = mConst.Target_iObject THEN |
IF target = TARGETS.KolibriOSDLL THEN |
opt.pic := FALSE |
END; |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32} THEN |
opt.pic := TRUE |
END; |
2296,14 → 2298,14 |
BIN.fixup(program); |
IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN |
PE32.write(program, outname, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) |
ELSIF target = mConst.Target_iKolibri THEN |
IF TARGETS.OS = TARGETS.osWIN32 THEN |
PE32.write(program, outname, target = TARGETS.Win32C, target = TARGETS.Win32DLL, FALSE) |
ELSIF target = TARGETS.KolibriOS THEN |
KOS.write(program, outname) |
ELSIF target = mConst.Target_iObject THEN |
ELSIF target = TARGETS.KolibriOSDLL THEN |
MSCOFF.write(program, outname, opt.version) |
ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN |
ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE) |
ELSIF TARGETS.OS = TARGETS.osLINUX32 THEN |
ELF.write(program, outname, sofinit, target = TARGETS.Linux32SO, FALSE) |
END |
END CodeGen; |