diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index 4eaf1f48f..2720d5973 100644 Binary files a/programs/develop/oberon07/Compiler.kex and b/programs/develop/oberon07/Compiler.kex differ diff --git a/programs/develop/oberon07/Docs/About1251.txt b/programs/develop/oberon07/Docs/About1251.txt index 33172eaa3..3fe358fe0 100644 --- a/programs/develop/oberon07/Docs/About1251.txt +++ b/programs/develop/oberon07/Docs/About1251.txt @@ -9,8 +9,7 @@ UTF-8 Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF. Параметры: 1) имя главного модуля - 2) имя результирующего файла - 3) тип приложения и платформа + 2) тип приложения "console" - Windows console "gui" - Windows GUI "dll" - Windows DLL @@ -18,11 +17,14 @@ UTF-8 "obj" - KolibriOS DLL "elfexe" - Linux ELF-EXEC "elfso" - Linux ELF-SO - 4) необязательные параметры-ключи - -stk размер стэка в мегабайтах (по умолчанию 2 Мб) - -base
адрес загрузки исполняемого файла в килобайтах - -ver версия программы (только для obj) + 3) необязательные параметры-ключи + -out имя результирующего файла; по умолчанию, + совпадает с именем главного модуля, но с другим расширением + (соответствует типу исполняемого файла) + -stk размер стэка в мегабайтах (по умолчанию 2 Мб, + допустимо от 1 до 32 Мб) -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) + -ver версия программы (только для obj) параметр -nochk задается в виде строки из символов: "p" - указатели @@ -42,13 +44,13 @@ UTF-8 Например: - Compiler.exe "C:\example.ob07" "C:\example.exe" console -stk 1 - Compiler.exe "C:\example.ob07" "C:\example.dll" dll - Compiler.exe "C:\example.ob07" "C:\example.exe" gui -stk 4 - Compiler.exe "C:\example.ob07" "C:\example.exe" console -nochk pti - Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.kex" kos -stk 2 - Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.obj" obj -ver 2.7 - Compiler.exe "C:\example.ob07" "C:\example" elfexe + Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" dll -out "C:\example.dll" + Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4 + Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti + Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4 + Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7 + Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. При работе компилятора в KolibriOS, код завершения не передается. @@ -166,24 +168,6 @@ UTF-8 например: SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) - Также в модуле SYSTEM определен тип CARD16 (2 байта). Для типа CARD16 не -допускаются никакие явные операции, за исключением присваивания. -Преобразования CARD16 -> INTEGER и INTEGER -> CARD16 могут быть реализованы -так: - - PROCEDURE Card16ToInt (w: SYSTEM.CARD16): INTEGER; - VAR i: INTEGER; - BEGIN - SYSTEM.PUT(SYSTEM.ADR(i), w) - RETURN i - END Card16ToInt; - - PROCEDURE IntToCard16 (i: INTEGER): SYSTEM.CARD16; - VAR w: SYSTEM.CARD16; - BEGIN - SYSTEM.GET(SYSTEM.ADR(i), w) - RETURN w - END IntToCard16; Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. diff --git a/programs/develop/oberon07/Docs/About866.txt b/programs/develop/oberon07/Docs/About866.txt index b0147dc78..55dc8f9e0 100644 --- a/programs/develop/oberon07/Docs/About866.txt +++ b/programs/develop/oberon07/Docs/About866.txt @@ -9,8 +9,7 @@ UTF-8 ‚л室 - ЁбЇ®­пҐ¬л© д ©« д®а¬ в  PE32, ELF Ё«Ё MENUET01/MSCOFF. Џ а ¬Ґвал: 1) Ё¬п Ј« ў­®Ј® ¬®¤г«п - 2) Ё¬п १г«мвЁаго饣® д ©«  - 3) вЁЇ ЇаЁ«®¦Ґ­Ёп Ё Ї« вд®а¬  + 2) вЁЇ ЇаЁ«®¦Ґ­Ёп "console" - Windows console "gui" - Windows GUI "dll" - Windows DLL @@ -18,11 +17,14 @@ UTF-8 "obj" - KolibriOS DLL "elfexe" - Linux ELF-EXEC "elfso" - Linux ELF-SO - 4) ­Ґ®Ўп§ вҐ«м­лҐ Ї а ¬Ґвал-Є«озЁ - -stk а §¬Ґа бвнЄ  ў ¬ҐЈ Ў ©в е (Ї® 㬮«з ­Ёо 2 ЊЎ) - -base
 ¤аҐб § Јаг§ЄЁ ЁбЇ®«­пҐ¬®Ј® д ©«  ў ЄЁ«®Ў ©в е - -ver ўҐабЁп Їа®Ја ¬¬л (в®«мЄ® ¤«п obj) + 3) ­Ґ®Ўп§ вҐ«м­лҐ Ї а ¬Ґвал-Є«озЁ + -out Ё¬п १г«мвЁаго饣® д ©« ; Ї® 㬮«з ­Ёо, + б®ўЇ ¤ Ґв б Ё¬Ґ­Ґ¬ Ј« ў­®Ј® ¬®¤г«п, ­® б ¤агЈЁ¬ а биЁаҐ­ЁҐ¬ + (ᮮ⢥вбвўгҐв вЁЇг ЁбЇ®«­пҐ¬®Ј® д ©« ) + -stk а §¬Ґа бвнЄ  ў ¬ҐЈ Ў ©в е (Ї® 㬮«з ­Ёо 2 ЊЎ, + ¤®ЇгбвЁ¬® ®в 1 ¤® 32 ЊЎ) -nochk <"ptibcwra"> ®вЄ«озЁвм Їа®ўҐаЄЁ ЇаЁ ўлЇ®«­Ґ­ЁЁ (б¬. ­Ё¦Ґ) + -ver ўҐабЁп Їа®Ја ¬¬л (в®«мЄ® ¤«п obj) Ї а ¬Ґва -nochk § ¤ Ґвбп ў ўЁ¤Ґ бва®ЄЁ Ё§ бЁ¬ў®«®ў: "p" - гЄ § вҐ«Ё @@ -42,13 +44,13 @@ UTF-8 Ќ ЇаЁ¬Ґа: - Compiler.exe "C:\example.ob07" "C:\example.exe" console -stk 1 - Compiler.exe "C:\example.ob07" "C:\example.dll" dll - Compiler.exe "C:\example.ob07" "C:\example.exe" gui -stk 4 - Compiler.exe "C:\example.ob07" "C:\example.exe" console -nochk pti - Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.kex" kos -stk 2 - Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.obj" obj -ver 2.7 - Compiler.exe "C:\example.ob07" "C:\example" elfexe + Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" dll -out "C:\example.dll" + Compiler.exe "C:\example.ob07" gui -out "C:\example.exe" -stk 4 + Compiler.exe "C:\example.ob07" console -out "C:\example.exe" -nochk pti + Compiler.kex "/tmp0/1/example.ob07" kos -out "/tmp0/1/example.kex" -stk 4 + Compiler.kex "/tmp0/1/example.ob07" obj -out "/tmp0/1/example.obj" -ver 2.7 + Compiler.exe "C:\example.ob07" elfexe -out "C:\example" -stk 1 -nochk a ‚ б«гз Ґ гбЇҐи­®© Є®¬ЇЁ«пжЁЁ, Є®¬ЇЁ«пв®а ЇҐаҐ¤ Ґв Є®¤ § ўҐа襭Ёп 0, Ё­ зҐ 1. ЏаЁ а Ў®вҐ Є®¬ЇЁ«пв®а  ў KolibriOS, Є®¤ § ўҐа襭Ёп ­Ґ ЇҐаҐ¤ Ґвбп. @@ -166,24 +168,6 @@ UTF-8 ­ ЇаЁ¬Ґа: SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) - ’ Є¦Ґ ў ¬®¤г«Ґ SYSTEM ®ЇаҐ¤Ґ«Ґ­ вЁЇ CARD16 (2 Ў ©в ). „«п вЁЇ  CARD16 ­Ґ -¤®ЇгбЄ овбп ­ЁЄ ЄЁҐ пў­лҐ ®ЇҐа жЁЁ, §  ЁбЄ«о祭ЁҐ¬ ЇаЁбў Ёў ­Ёп. -ЏаҐ®Ўа §®ў ­Ёп CARD16 -> INTEGER Ё INTEGER -> CARD16 ¬®Јгв Ўлвм ॠ«Ё§®ў ­л -в Є: - - PROCEDURE Card16ToInt (w: SYSTEM.CARD16): INTEGER; - VAR i: INTEGER; - BEGIN - SYSTEM.PUT(SYSTEM.ADR(i), w) - RETURN i - END Card16ToInt; - - PROCEDURE IntToCard16 (i: INTEGER): SYSTEM.CARD16; - VAR w: SYSTEM.CARD16; - BEGIN - SYSTEM.GET(SYSTEM.ADR(i), w) - RETURN w - END IntToCard16; ”г­ЄжЁЁ ЇбҐў¤®¬®¤г«п SYSTEM ­Ґ«м§п ЁбЇ®«м§®ў вм ў Є®­бв ­в­ле ўла ¦Ґ­Ёпе. diff --git a/programs/develop/oberon07/Docs/KOSLib1251.txt b/programs/develop/oberon07/Docs/KOSLib1251.txt index ea757d300..985b4d0cc 100644 --- a/programs/develop/oberon07/Docs/KOSLib1251.txt +++ b/programs/develop/oberon07/Docs/KOSLib1251.txt @@ -1,94 +1,94 @@ ============================================================================== - Библиотека (KolibriOS) + Библиотека (KolibriOS) ------------------------------------------------------------------------------ MODULE Out - консольный вывод - PROCEDURE Open - формально открывает консольный вывод + PROCEDURE Open + формально открывает консольный вывод - PROCEDURE Int(x, width: INTEGER) - вывод целого числа x; - width - количество знакомест, используемых для вывода + PROCEDURE Int(x, width: INTEGER) + вывод целого числа x; + width - количество знакомест, используемых для вывода - PROCEDURE Real(x: REAL; width: INTEGER) - вывод вещественного числа x в плавающем формате; - width - количество знакомест, используемых для вывода + PROCEDURE Real(x: REAL; width: INTEGER) + вывод вещественного числа x в плавающем формате; + width - количество знакомест, используемых для вывода - PROCEDURE Char(x: CHAR) - вывод символа x + PROCEDURE Char(x: CHAR) + вывод символа x - PROCEDURE FixReal(x: REAL; width, p: INTEGER) - вывод вещественного числа x в фиксированном формате; - width - количество знакомест, используемых для вывода; - p - количество знаков после десятичной точки + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + вывод вещественного числа x в фиксированном формате; + width - количество знакомест, используемых для вывода; + p - количество знаков после десятичной точки - PROCEDURE Ln - переход на следующую строку + PROCEDURE Ln + переход на следующую строку - PROCEDURE String(s: ARRAY OF CHAR) - вывод строки s + PROCEDURE String(s: ARRAY OF CHAR) + вывод строки s ------------------------------------------------------------------------------ MODULE In - консольный ввод - VAR Done: BOOLEAN - принимает значение TRUE в случае успешного выполнения - операции ввода, иначе FALSE + VAR Done: BOOLEAN + принимает значение TRUE в случае успешного выполнения + операции ввода, иначе FALSE - PROCEDURE Open - формально открывает консольный ввод, - также присваивает переменной Done значение TRUE + PROCEDURE Open + формально открывает консольный ввод, + также присваивает переменной Done значение TRUE - PROCEDURE Int(VAR x: INTEGER) - ввод числа типа INTEGER + PROCEDURE Int(VAR x: INTEGER) + ввод числа типа INTEGER - PROCEDURE Char(VAR x: CHAR) - ввод символа + PROCEDURE Char(VAR x: CHAR) + ввод символа - PROCEDURE Real(VAR x: REAL) - ввод числа типа REAL + PROCEDURE Real(VAR x: REAL) + ввод числа типа REAL - PROCEDURE String(VAR s: ARRAY OF CHAR) - ввод строки + PROCEDURE String(VAR s: ARRAY OF CHAR) + ввод строки - PROCEDURE Ln - ожидание нажатия ENTER + PROCEDURE Ln + ожидание нажатия ENTER ------------------------------------------------------------------------------ MODULE Console - дополнительные процедуры консольного вывода - CONST + 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 + 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 Cls + очистка окна консоли - PROCEDURE SetColor(FColor, BColor: INTEGER) - установка цвета консольного вывода: FColor - цвет текста, - BColor - цвет фона, возможные значения - вышеперечисленные - константы + PROCEDURE SetColor(FColor, BColor: INTEGER) + установка цвета консольного вывода: FColor - цвет текста, + BColor - цвет фона, возможные значения - вышеперечисленные + константы - PROCEDURE SetCursor(x, y: INTEGER) - установка курсора консоли в позицию (x, y) + PROCEDURE SetCursor(x, y: INTEGER) + установка курсора консоли в позицию (x, y) - PROCEDURE GetCursor(VAR x, y: INTEGER) - записывает в параметры текущие координаты курсора консоли + PROCEDURE GetCursor(VAR x, y: INTEGER) + записывает в параметры текущие координаты курсора консоли - PROCEDURE GetCursorX(): INTEGER - возвращает текущую x-координату курсора консоли + PROCEDURE GetCursorX(): INTEGER + возвращает текущую x-координату курсора консоли - PROCEDURE GetCursorY(): INTEGER - возвращает текущую y-координату курсора консоли + PROCEDURE GetCursorY(): INTEGER + возвращает текущую y-координату курсора консоли ------------------------------------------------------------------------------ MODULE ConsoleLib - обертка библиотеки console.obj @@ -96,469 +96,469 @@ MODULE ConsoleLib - ------------------------------------------------------------------------------ MODULE Math - математические функции - CONST + CONST - pi = 3.141592653589793E+00 - e = 2.718281828459045E+00 + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 - PROCEDURE IsNan(x: REAL): BOOLEAN - возвращает TRUE, если x - не число + PROCEDURE IsNan(x: REAL): BOOLEAN + возвращает TRUE, если x - не число - PROCEDURE IsInf(x: REAL): BOOLEAN - возвращает TRUE, если x - бесконечность + PROCEDURE IsInf(x: REAL): BOOLEAN + возвращает TRUE, если x - бесконечность - PROCEDURE sqrt(x: REAL): REAL - квадратный корень x + PROCEDURE sqrt(x: REAL): REAL + квадратный корень x - PROCEDURE exp(x: REAL): REAL - экспонента x + PROCEDURE exp(x: REAL): REAL + экспонента x - PROCEDURE ln(x: REAL): REAL - натуральный логарифм x + PROCEDURE ln(x: REAL): REAL + натуральный логарифм x - PROCEDURE sin(x: REAL): REAL - синус x + PROCEDURE sin(x: REAL): REAL + синус x - PROCEDURE cos(x: REAL): REAL - косинус x + PROCEDURE cos(x: REAL): REAL + косинус x - PROCEDURE tan(x: REAL): REAL - тангенс x + PROCEDURE tan(x: REAL): REAL + тангенс x - PROCEDURE arcsin(x: REAL): REAL - арксинус x + PROCEDURE arcsin(x: REAL): REAL + арксинус x - PROCEDURE arccos(x: REAL): REAL - арккосинус x + PROCEDURE arccos(x: REAL): REAL + арккосинус x - PROCEDURE arctan(x: REAL): REAL - арктангенс x + PROCEDURE arctan(x: REAL): REAL + арктангенс x - PROCEDURE arctan2(y, x: REAL): REAL - арктангенс y/x + PROCEDURE arctan2(y, x: REAL): REAL + арктангенс y/x - PROCEDURE power(base, exponent: REAL): REAL - возведение числа base в степень exponent + PROCEDURE power(base, exponent: REAL): REAL + возведение числа base в степень exponent - PROCEDURE log(base, x: REAL): REAL - логарифм x по основанию base + PROCEDURE log(base, x: REAL): REAL + логарифм x по основанию base - PROCEDURE sinh(x: REAL): REAL - гиперболический синус x + PROCEDURE sinh(x: REAL): REAL + гиперболический синус x - PROCEDURE cosh(x: REAL): REAL - гиперболический косинус x + PROCEDURE cosh(x: REAL): REAL + гиперболический косинус x - PROCEDURE tanh(x: REAL): REAL - гиперболический тангенс x + PROCEDURE tanh(x: REAL): REAL + гиперболический тангенс x - PROCEDURE arsinh(x: REAL): REAL - обратный гиперболический синус x + PROCEDURE arsinh(x: REAL): REAL + обратный гиперболический синус x - PROCEDURE arcosh(x: REAL): REAL - обратный гиперболический косинус x + PROCEDURE arcosh(x: REAL): REAL + обратный гиперболический косинус x - PROCEDURE artanh(x: REAL): REAL - обратный гиперболический тангенс x + PROCEDURE artanh(x: REAL): REAL + обратный гиперболический тангенс x - PROCEDURE round(x: REAL): REAL - округление x до ближайшего целого + PROCEDURE round(x: REAL): REAL + округление x до ближайшего целого - PROCEDURE frac(x: REAL): REAL; - дробная часть числа x + PROCEDURE frac(x: REAL): REAL; + дробная часть числа x - PROCEDURE floor(x: REAL): REAL - наибольшее целое число (представление как REAL), - не больше x: floor(1.2) = 1.0 + 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 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 sgn(x: REAL): INTEGER + если x > 0 возвращает 1 + если x < 0 возвращает -1 + если x = 0 возвращает 0 - PROCEDURE fact(n: INTEGER): REAL - факториал n + PROCEDURE fact(n: INTEGER): REAL + факториал n ------------------------------------------------------------------------------ MODULE Debug - вывод на доску отладки - Интерфейс как модуль Out + Интерфейс как модуль Out - PROCEDURE Open - открывает доску отладки + PROCEDURE Open + открывает доску отладки ------------------------------------------------------------------------------ MODULE File - работа с файловой системой - TYPE + TYPE - FNAME = ARRAY 520 OF CHAR + FNAME = ARRAY 520 OF CHAR - FS = POINTER TO rFS + FS = POINTER TO rFS - rFS = RECORD (* информационная структура файла *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END + rFS = RECORD (* информационная структура файла *) + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END - FD = POINTER TO rFD + 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 + 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 + CONST - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - Загружает в память файл с именем FName, записывает в параметр - size размер файла, возвращает адрес загруженного файла - или 0 (ошибка). При необходимости, распаковывает - файл (kunpack). + 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 GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN + Записывает структуру блока данных входа каталога для файла + или папки с именем FName в параметр Info. + При ошибке возвращает FALSE. - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - возвращает TRUE, если файл с именем FName существует + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если файл с именем FName существует - PROCEDURE Close(VAR F: FS) - освобождает память, выделенную для информационной структуры - файла F и присваивает F значение NIL + PROCEDURE Close(VAR F: FS) + освобождает память, выделенную для информационной структуры + файла F и присваивает F значение NIL - PROCEDURE Open(FName: ARRAY OF CHAR): FS - возвращает указатель на информационную структуру файла с - именем FName, при ошибке возвращает NIL + PROCEDURE Open(FName: ARRAY OF CHAR): FS + возвращает указатель на информационную структуру файла с + именем FName, при ошибке возвращает NIL - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - удаляет файл с именем FName, при ошибке возвращает FALSE + 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 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 Read(F: FS; Buffer, Count: INTEGER): INTEGER + Читает данные из файла в память. F - указатель на + информационную структуру файла, Buffer - адрес области + памяти, Count - количество байт, которое требуется прочитать + из файла; возвращает количество байт, которое было прочитано + и соответствующим образом изменяет позицию чтения/записи в + информационной структуре F. - PROCEDURE Write(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 Create(FName: ARRAY OF CHAR): FS + создает новый файл с именем FName (полное имя), возвращает + указатель на информационную структуру файла, + при ошибке возвращает NIL - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - создает папку с именем DirName, все промежуточные папки - должны существовать, при ошибке возвращает FALSE + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + создает папку с именем DirName, все промежуточные папки + должны существовать, при ошибке возвращает FALSE - PROCEDURE DeleteDir(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 существует + PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если папка с именем DirName существует ------------------------------------------------------------------------------ MODULE Read - чтение основных типов данных из файла F - Процедуры возвращают TRUE в случае успешной операции чтения и - соответствующим образом изменяют позицию чтения/записи в - информационной структуре F + Процедуры возвращают TRUE в случае успешной операции чтения и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN + PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN ------------------------------------------------------------------------------ MODULE Write - запись основных типов данных в файл F - Процедуры возвращают TRUE в случае успешной операции записи и - соответствующим образом изменяют позицию чтения/записи в - информационной структуре F + Процедуры возвращают TRUE в случае успешной операции записи и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN + PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN ------------------------------------------------------------------------------ MODULE DateTime - дата, время - CONST ERR = -7.0E5 + CONST ERR = -7.0E5 - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - записывает в параметры компоненты текущей системной даты и - времени + 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 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 + 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 - количество параметров программы, включая имя - исполняемого файла + VAR argc: INTEGER + количество параметров программы, включая имя + исполняемого файла - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - записывает в строку s n-й параметр программы, - нумерация параметров от 0 до argc - 1, - нулевой параметр -- имя исполняемого файла + 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 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 sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER + Обертка для функций API ядра KolibriOS. + arg1 - регистр eax, arg2 - регистр ebx, + res2 - значение регистра ebx после системного вызова; + возвращает значение регистра eax после системного вызова. - PROCEDURE malloc(size: INTEGER): INTEGER - Выделяет блок памяти. - size - размер блока в байтах, - возвращает адрес выделенного блока + PROCEDURE malloc(size: INTEGER): INTEGER + Выделяет блок памяти. + size - размер блока в байтах, + возвращает адрес выделенного блока - PROCEDURE free(ptr: INTEGER): INTEGER - Освобождает ранее выделенный блок памяти с адресом ptr, - возвращает 0 + PROCEDURE free(ptr: INTEGER): INTEGER + Освобождает ранее выделенный блок памяти с адресом ptr, + возвращает 0 - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - Перераспределяет блок памяти, - ptr - адрес ранее выделенного блока, - size - новый размер, - возвращает указатель на перераспределенный блок, - 0 при ошибке + PROCEDURE realloc(ptr, size: INTEGER): INTEGER + Перераспределяет блок памяти, + ptr - адрес ранее выделенного блока, + size - новый размер, + возвращает указатель на перераспределенный блок, + 0 при ошибке - PROCEDURE GetCommandLine(): INTEGER - Возвращает адрес строки параметров + PROCEDURE GetCommandLine(): INTEGER + Возвращает адрес строки параметров - PROCEDURE GetName(): INTEGER - Возвращает адрес строки с именем программы + PROCEDURE GetName(): INTEGER + Возвращает адрес строки с именем программы - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - Загружает DLL с полным именем name. Возвращает адрес таблицы - экспорта. При ошибке возвращает 0. + PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER + Загружает DLL с полным именем name. Возвращает адрес таблицы + экспорта. При ошибке возвращает 0. - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - имя процедуры - lib - адрес таблицы экспорта DLL - Возвращает адрес процедуры. При ошибке возвращает 0. + PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER + name - имя процедуры + lib - адрес таблицы экспорта DLL + Возвращает адрес процедуры. При ошибке возвращает 0. ------------------------------------------------------------------------------ MODULE ColorDlg - работа с диалогом "Color Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* структура диалога *) - status: INTEGER (* состояние диалога: - 0 - пользователь нажал Cancel - 1 - пользователь нажал OK - 2 - диалог открыт *) + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) - color: INTEGER (* выбранный цвет *) - END + color: INTEGER (* выбранный цвет *) + END - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - создать диалог - draw_window - процедура перерисовки основного окна - (TYPE DRAW_WINDOW = PROCEDURE); - процедура возвращает указатель на структуру диалога + PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog + создать диалог + draw_window - процедура перерисовки основного окна + (TYPE DRAW_WINDOW = PROCEDURE); + процедура возвращает указатель на структуру диалога - PROCEDURE Show(cd: Dialog) - показать диалог - cd - указатель на структуру диалога, который был создан ранее - процедурой Create + PROCEDURE Show(cd: Dialog) + показать диалог + cd - указатель на структуру диалога, который был создан ранее + процедурой Create - PROCEDURE Destroy(VAR cd: Dialog) - уничтожить диалог - cd - указатель на структуру диалога + PROCEDURE Destroy(VAR cd: Dialog) + уничтожить диалог + cd - указатель на структуру диалога ------------------------------------------------------------------------------ MODULE OpenDlg - работа с диалогом "Open Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* структура диалога *) - status: INTEGER (* состояние диалога: - 0 - пользователь нажал Cancel - 1 - пользователь нажал OK - 2 - диалог открыт *) + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) - FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) - FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного - файла *) - END + 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 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 Show(od: Dialog; Width, Height: INTEGER) + показать диалог + od - указатель на структуру диалога, который был создан ранее + процедурой Create + Width и Height - ширина и высота диалогового окна - PROCEDURE Destroy(VAR od: Dialog) - уничтожить диалог - od - указатель на структуру диалога + PROCEDURE Destroy(VAR od: Dialog) + уничтожить диалог + od - указатель на структуру диалога ------------------------------------------------------------------------------ MODULE kfonts - работа с kf-шрифтами - CONST + CONST - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 + bold = 1 + italic = 2 + underline = 4 + strike_through = 8 + smoothing = 16 + bpp32 = 32 - TYPE + TYPE - TFont = POINTER TO TFont_desc (* указатель на шрифт *) + TFont = POINTER TO TFont_desc (* указатель на шрифт *) - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - загрузить шрифт из файла - file_name имя kf-файла - рез-т: указатель на шрифт/NIL (ошибка) + 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 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 Enabled(Font: TFont; font_size: INTEGER): BOOLEAN + проверить, есть ли шрифт, заданного размера + Font указатель на шрифт + font_size размер шрифта + рез-т: TRUE/FALSE (шрифта нет) - PROCEDURE Destroy(VAR Font: TFont) - выгрузить шрифт, освободить динамическую память - Font указатель на шрифт - Присваивает переменной Font значение NIL + PROCEDURE Destroy(VAR Font: TFont) + выгрузить шрифт, освободить динамическую память + Font указатель на шрифт + Присваивает переменной Font значение NIL - PROCEDURE TextHeight(Font: TFont): INTEGER - получить высоту строки текста - Font указатель на шрифт - рез-т: высота строки текста в пикселях + PROCEDURE TextHeight(Font: TFont): INTEGER + получить высоту строки текста + Font указатель на шрифт + рез-т: высота строки текста в пикселях - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - получить ширину строки текста - Font указатель на шрифт - str адрес строки текста в кодировке Win-1251 - length количество символов в строке или -1, если строка - завершается нулем - params параметры-флаги см. ниже - рез-т: ширина строки текста в пикселях + 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-битный буфер - возможно использование флагов в любых сочетаниях + 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 ------------------------------------------------------------------------------ diff --git a/programs/develop/oberon07/Docs/KOSLib866.txt b/programs/develop/oberon07/Docs/KOSLib866.txt index a163da19e..7b501634a 100644 --- a/programs/develop/oberon07/Docs/KOSLib866.txt +++ b/programs/develop/oberon07/Docs/KOSLib866.txt @@ -1,94 +1,94 @@ ============================================================================== - ЃЁЎ«Ё®вҐЄ  (KolibriOS) + ЃЁЎ«Ё®вҐЄ  (KolibriOS) ------------------------------------------------------------------------------ MODULE Out - Є®­б®«м­л© ўлў®¤ - PROCEDURE Open - д®а¬ «м­® ®вЄалў Ґв Є®­б®«м­л© ўлў®¤ + PROCEDURE Open + д®а¬ «м­® ®вЄалў Ґв Є®­б®«м­л© ўлў®¤ - PROCEDURE Int(x, width: INTEGER) - ўлў®¤ 楫®Ј® зЁб«  x; - width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤  + PROCEDURE Int(x, width: INTEGER) + ўлў®¤ 楫®Ј® зЁб«  x; + width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤  - PROCEDURE Real(x: REAL; width: INTEGER) - ўлў®¤ ўҐйҐб⢥­­®Ј® зЁб«  x ў Ї« ў о饬 д®а¬ вҐ; - width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤  + PROCEDURE Real(x: REAL; width: INTEGER) + ўлў®¤ ўҐйҐб⢥­­®Ј® зЁб«  x ў Ї« ў о饬 д®а¬ вҐ; + width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤  - PROCEDURE Char(x: CHAR) - ўлў®¤ бЁ¬ў®«  x + PROCEDURE Char(x: CHAR) + ўлў®¤ бЁ¬ў®«  x - PROCEDURE FixReal(x: REAL; width, p: INTEGER) - ўлў®¤ ўҐйҐб⢥­­®Ј® зЁб«  x ў дЁЄбЁа®ў ­­®¬ д®а¬ вҐ; - width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤ ; - p - Є®«ЁзҐбвў® §­ Є®ў Ї®б«Ґ ¤ҐбпвЁз­®© в®зЄЁ + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + ўлў®¤ ўҐйҐб⢥­­®Ј® зЁб«  x ў дЁЄбЁа®ў ­­®¬ д®а¬ вҐ; + width - Є®«ЁзҐбвў® §­ Є®¬Ґбв, ЁбЇ®«м§гҐ¬ле ¤«п ўлў®¤ ; + p - Є®«ЁзҐбвў® §­ Є®ў Ї®б«Ґ ¤ҐбпвЁз­®© в®зЄЁ - PROCEDURE Ln - ЇҐаҐе®¤ ­  б«Ґ¤гойго бва®Єг + PROCEDURE Ln + ЇҐаҐе®¤ ­  б«Ґ¤гойго бва®Єг - PROCEDURE String(s: ARRAY OF CHAR) - ўлў®¤ бва®ЄЁ s + PROCEDURE String(s: ARRAY OF CHAR) + ўлў®¤ бва®ЄЁ s ------------------------------------------------------------------------------ MODULE In - Є®­б®«м­л© ўў®¤ - VAR Done: BOOLEAN - ЇаЁ­Ё¬ Ґв §­ зҐ­ЁҐ TRUE ў б«гз Ґ гбЇҐи­®Ј® ўлЇ®«­Ґ­Ёп - ®ЇҐа жЁЁ ўў®¤ , Ё­ зҐ FALSE + VAR Done: BOOLEAN + ЇаЁ­Ё¬ Ґв §­ зҐ­ЁҐ TRUE ў б«гз Ґ гбЇҐи­®Ј® ўлЇ®«­Ґ­Ёп + ®ЇҐа жЁЁ ўў®¤ , Ё­ зҐ FALSE - PROCEDURE Open - д®а¬ «м­® ®вЄалў Ґв Є®­б®«м­л© ўў®¤, - в Є¦Ґ ЇаЁбў Ёў Ґв ЇҐаҐ¬Ґ­­®© Done §­ зҐ­ЁҐ TRUE + PROCEDURE Open + д®а¬ «м­® ®вЄалў Ґв Є®­б®«м­л© ўў®¤, + в Є¦Ґ ЇаЁбў Ёў Ґв ЇҐаҐ¬Ґ­­®© Done §­ зҐ­ЁҐ TRUE - PROCEDURE Int(VAR x: INTEGER) - ўў®¤ зЁб«  вЁЇ  INTEGER + PROCEDURE Int(VAR x: INTEGER) + ўў®¤ зЁб«  вЁЇ  INTEGER - PROCEDURE Char(VAR x: CHAR) - ўў®¤ бЁ¬ў®«  + PROCEDURE Char(VAR x: CHAR) + ўў®¤ бЁ¬ў®«  - PROCEDURE Real(VAR x: REAL) - ўў®¤ зЁб«  вЁЇ  REAL + PROCEDURE Real(VAR x: REAL) + ўў®¤ зЁб«  вЁЇ  REAL - PROCEDURE String(VAR s: ARRAY OF CHAR) - ўў®¤ бва®ЄЁ + PROCEDURE String(VAR s: ARRAY OF CHAR) + ўў®¤ бва®ЄЁ - PROCEDURE Ln - ®¦Ё¤ ­ЁҐ ­ ¦ вЁп ENTER + PROCEDURE Ln + ®¦Ё¤ ­ЁҐ ­ ¦ вЁп ENTER ------------------------------------------------------------------------------ MODULE Console - ¤®Ї®«­ЁвҐ«м­лҐ Їа®жҐ¤гал Є®­б®«м­®Ј® ўлў®¤  - CONST + 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 + 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 Cls + ®зЁбвЄ  ®Є­  Є®­б®«Ё - PROCEDURE SetColor(FColor, BColor: INTEGER) - гбв ­®ўЄ  жўҐв  Є®­б®«м­®Ј® ўлў®¤ : FColor - 梥в ⥪бв , - BColor - 梥в д®­ , ў®§¬®¦­лҐ §­ зҐ­Ёп - ўл襯ҐаҐзЁб«Ґ­­лҐ - Є®­бв ­вл + PROCEDURE SetColor(FColor, BColor: INTEGER) + гбв ­®ўЄ  жўҐв  Є®­б®«м­®Ј® ўлў®¤ : FColor - 梥в ⥪бв , + BColor - 梥в д®­ , ў®§¬®¦­лҐ §­ зҐ­Ёп - ўл襯ҐаҐзЁб«Ґ­­лҐ + Є®­бв ­вл - PROCEDURE SetCursor(x, y: INTEGER) - гбв ­®ўЄ  Єгаб®а  Є®­б®«Ё ў Ї®§ЁжЁо (x, y) + PROCEDURE SetCursor(x, y: INTEGER) + гбв ­®ўЄ  Єгаб®а  Є®­б®«Ё ў Ї®§ЁжЁо (x, y) - PROCEDURE GetCursor(VAR x, y: INTEGER) - § ЇЁблў Ґв ў Ї а ¬Ґвал ⥪гйЁҐ Є®®а¤Ё­ вл Єгаб®а  Є®­б®«Ё + PROCEDURE GetCursor(VAR x, y: INTEGER) + § ЇЁблў Ґв ў Ї а ¬Ґвал ⥪гйЁҐ Є®®а¤Ё­ вл Єгаб®а  Є®­б®«Ё - PROCEDURE GetCursorX(): INTEGER - ў®§ўа й Ґв ⥪гйго x-Є®®а¤Ё­ вг Єгаб®а  Є®­б®«Ё + PROCEDURE GetCursorX(): INTEGER + ў®§ўа й Ґв ⥪гйго x-Є®®а¤Ё­ вг Єгаб®а  Є®­б®«Ё - PROCEDURE GetCursorY(): INTEGER - ў®§ўа й Ґв ⥪гйго y-Є®®а¤Ё­ вг Єгаб®а  Є®­б®«Ё + PROCEDURE GetCursorY(): INTEGER + ў®§ўа й Ґв ⥪гйго y-Є®®а¤Ё­ вг Єгаб®а  Є®­б®«Ё ------------------------------------------------------------------------------ MODULE ConsoleLib - ®ЎҐавЄ  ЎЁЎ«Ё®вҐЄЁ console.obj @@ -96,469 +96,469 @@ MODULE ConsoleLib - ------------------------------------------------------------------------------ MODULE Math - ¬ вҐ¬ вЁзҐбЄЁҐ дг­ЄжЁЁ - CONST + CONST - pi = 3.141592653589793E+00 - e = 2.718281828459045E+00 + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 - PROCEDURE IsNan(x: REAL): BOOLEAN - ў®§ўа й Ґв TRUE, Ґб«Ё x - ­Ґ зЁб«® + PROCEDURE IsNan(x: REAL): BOOLEAN + ў®§ўа й Ґв TRUE, Ґб«Ё x - ­Ґ зЁб«® - PROCEDURE IsInf(x: REAL): BOOLEAN - ў®§ўа й Ґв TRUE, Ґб«Ё x - ЎҐбЄ®­Ґз­®бвм + PROCEDURE IsInf(x: REAL): BOOLEAN + ў®§ўа й Ґв TRUE, Ґб«Ё x - ЎҐбЄ®­Ґз­®бвм - PROCEDURE sqrt(x: REAL): REAL - Єў ¤а в­л© Є®аҐ­м x + PROCEDURE sqrt(x: REAL): REAL + Єў ¤а в­л© Є®аҐ­м x - PROCEDURE exp(x: REAL): REAL - нЄбЇ®­Ґ­в  x + PROCEDURE exp(x: REAL): REAL + нЄбЇ®­Ґ­в  x - PROCEDURE ln(x: REAL): REAL - ­ вга «м­л© «®Ј аЁд¬ x + PROCEDURE ln(x: REAL): REAL + ­ вга «м­л© «®Ј аЁд¬ x - PROCEDURE sin(x: REAL): REAL - бЁ­гб x + PROCEDURE sin(x: REAL): REAL + бЁ­гб x - PROCEDURE cos(x: REAL): REAL - Є®бЁ­гб x + PROCEDURE cos(x: REAL): REAL + Є®бЁ­гб x - PROCEDURE tan(x: REAL): REAL - в ­ЈҐ­б x + PROCEDURE tan(x: REAL): REAL + в ­ЈҐ­б x - PROCEDURE arcsin(x: REAL): REAL -  аЄбЁ­гб x + PROCEDURE arcsin(x: REAL): REAL +  аЄбЁ­гб x - PROCEDURE arccos(x: REAL): REAL -  аЄЄ®бЁ­гб x + PROCEDURE arccos(x: REAL): REAL +  аЄЄ®бЁ­гб x - PROCEDURE arctan(x: REAL): REAL -  аЄв ­ЈҐ­б x + PROCEDURE arctan(x: REAL): REAL +  аЄв ­ЈҐ­б x - PROCEDURE arctan2(y, x: REAL): REAL -  аЄв ­ЈҐ­б y/x + PROCEDURE arctan2(y, x: REAL): REAL +  аЄв ­ЈҐ­б y/x - PROCEDURE power(base, exponent: REAL): REAL - ў®§ўҐ¤Ґ­ЁҐ зЁб«  base ў б⥯Ґ­м exponent + PROCEDURE power(base, exponent: REAL): REAL + ў®§ўҐ¤Ґ­ЁҐ зЁб«  base ў б⥯Ґ­м exponent - PROCEDURE log(base, x: REAL): REAL - «®Ј аЁд¬ x Ї® ®б­®ў ­Ёо base + PROCEDURE log(base, x: REAL): REAL + «®Ј аЁд¬ x Ї® ®б­®ў ­Ёо base - PROCEDURE sinh(x: REAL): REAL - ЈЁЇҐаЎ®«ЁзҐбЄЁ© бЁ­гб x + PROCEDURE sinh(x: REAL): REAL + ЈЁЇҐаЎ®«ЁзҐбЄЁ© бЁ­гб x - PROCEDURE cosh(x: REAL): REAL - ЈЁЇҐаЎ®«ЁзҐбЄЁ© Є®бЁ­гб x + PROCEDURE cosh(x: REAL): REAL + ЈЁЇҐаЎ®«ЁзҐбЄЁ© Є®бЁ­гб x - PROCEDURE tanh(x: REAL): REAL - ЈЁЇҐаЎ®«ЁзҐбЄЁ© в ­ЈҐ­б x + PROCEDURE tanh(x: REAL): REAL + ЈЁЇҐаЎ®«ЁзҐбЄЁ© в ­ЈҐ­б x - PROCEDURE arsinh(x: REAL): REAL - ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© бЁ­гб x + PROCEDURE arsinh(x: REAL): REAL + ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© бЁ­гб x - PROCEDURE arcosh(x: REAL): REAL - ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© Є®бЁ­гб x + PROCEDURE arcosh(x: REAL): REAL + ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© Є®бЁ­гб x - PROCEDURE artanh(x: REAL): REAL - ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© в ­ЈҐ­б x + PROCEDURE artanh(x: REAL): REAL + ®Ўа в­л© ЈЁЇҐаЎ®«ЁзҐбЄЁ© в ­ЈҐ­б x - PROCEDURE round(x: REAL): REAL - ®ЄагЈ«Ґ­ЁҐ x ¤® Ў«Ё¦ ©иҐЈ® 楫®Ј® + PROCEDURE round(x: REAL): REAL + ®ЄагЈ«Ґ­ЁҐ x ¤® Ў«Ё¦ ©иҐЈ® 楫®Ј® - PROCEDURE frac(x: REAL): REAL; - ¤а®Ў­ п з бвм зЁб«  x + PROCEDURE frac(x: REAL): REAL; + ¤а®Ў­ п з бвм зЁб«  x - PROCEDURE floor(x: REAL): REAL - ­ ЁЎ®«м襥 楫®Ґ зЁб«® (ЇаҐ¤бв ў«Ґ­ЁҐ Є Є REAL), - ­Ґ Ў®«миҐ x: floor(1.2) = 1.0 + 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 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 sgn(x: REAL): INTEGER + Ґб«Ё x > 0 ў®§ўа й Ґв 1 + Ґб«Ё x < 0 ў®§ўа й Ґв -1 + Ґб«Ё x = 0 ў®§ўа й Ґв 0 - PROCEDURE fact(n: INTEGER): REAL - д Єв®аЁ « n + PROCEDURE fact(n: INTEGER): REAL + д Єв®аЁ « n ------------------------------------------------------------------------------ MODULE Debug - ўлў®¤ ­  ¤®бЄг ®в« ¤ЄЁ - €­вҐадҐ©б Є Є ¬®¤г«м Out + €­вҐадҐ©б Є Є ¬®¤г«м Out - PROCEDURE Open - ®вЄалў Ґв ¤®бЄг ®в« ¤ЄЁ + PROCEDURE Open + ®вЄалў Ґв ¤®бЄг ®в« ¤ЄЁ ------------------------------------------------------------------------------ MODULE File - а Ў®в  б д ©«®ў®© бЁб⥬®© - TYPE + TYPE - FNAME = ARRAY 520 OF CHAR + FNAME = ARRAY 520 OF CHAR - FS = POINTER TO rFS + FS = POINTER TO rFS - rFS = RECORD (* Ё­д®а¬ жЁ®­­ п бвагЄвга  д ©«  *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END + rFS = RECORD (* Ё­д®а¬ жЁ®­­ п бвагЄвга  д ©«  *) + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END - FD = POINTER TO rFD + 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 + 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 + CONST - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - ‡ Јаг¦ Ґв ў Ї ¬пвм д ©« б Ё¬Ґ­Ґ¬ FName, § ЇЁблў Ґв ў Ї а ¬Ґва - size а §¬Ґа д ©« , ў®§ўа й Ґв  ¤аҐб § Ја㦥­­®Ј® д ©«  - Ё«Ё 0 (®иЁЎЄ ). ЏаЁ ­Ґ®Ўе®¤Ё¬®бвЁ, а бЇ Є®ўлў Ґв - д ©« (kunpack). + 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 GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN + ‡ ЇЁблў Ґв бвагЄвгаг Ў«®Є  ¤ ­­ле ўе®¤  Є в «®Ј  ¤«п д ©«  + Ё«Ё Ї ЇЄЁ б Ё¬Ґ­Ґ¬ FName ў Ї а ¬Ґва Info. + ЏаЁ ®иЁЎЄҐ ў®§ўа й Ґв FALSE. - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - ў®§ўа й Ґв TRUE, Ґб«Ё д ©« б Ё¬Ґ­Ґ¬ FName бгйҐбвўгҐв + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + ў®§ўа й Ґв TRUE, Ґб«Ё д ©« б Ё¬Ґ­Ґ¬ FName бгйҐбвўгҐв - PROCEDURE Close(VAR F: FS) - ®бў®Ў®¦¤ Ґв Ї ¬пвм, ўл¤Ґ«Ґ­­го ¤«п Ё­д®а¬ жЁ®­­®© бвагЄвгал - д ©«  F Ё ЇаЁбў Ёў Ґв F §­ зҐ­ЁҐ NIL + PROCEDURE Close(VAR F: FS) + ®бў®Ў®¦¤ Ґв Ї ¬пвм, ўл¤Ґ«Ґ­­го ¤«п Ё­д®а¬ жЁ®­­®© бвагЄвгал + д ©«  F Ё ЇаЁбў Ёў Ґв F §­ зҐ­ЁҐ NIL - PROCEDURE Open(FName: ARRAY OF CHAR): FS - ў®§ўа й Ґв гЄ § вҐ«м ­  Ё­д®а¬ жЁ®­­го бвагЄвгаг д ©«  б - Ё¬Ґ­Ґ¬ FName, ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв NIL + PROCEDURE Open(FName: ARRAY OF CHAR): FS + ў®§ўа й Ґв гЄ § вҐ«м ­  Ё­д®а¬ жЁ®­­го бвагЄвгаг д ©«  б + Ё¬Ґ­Ґ¬ FName, ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв NIL - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - г¤ «пҐв д ©« б Ё¬Ґ­Ґ¬ FName, ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв FALSE + 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 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 Read(F: FS; Buffer, Count: INTEGER): INTEGER + —Ёв Ґв ¤ ­­лҐ Ё§ д ©«  ў Ї ¬пвм. F - гЄ § вҐ«м ­  + Ё­д®а¬ жЁ®­­го бвагЄвгаг д ©« , Buffer -  ¤аҐб ®Ў« бвЁ + Ї ¬пвЁ, Count - Є®«ЁзҐбвў® Ў ©в, Є®в®а®Ґ вॡгҐвбп Їа®зЁв вм + Ё§ д ©« ; ў®§ўа й Ґв Є®«ЁзҐбвў® Ў ©в, Є®в®а®Ґ Ўл«® Їа®зЁв ­® + Ё ᮮ⢥вбвўгойЁ¬ ®Ўа §®¬ Ё§¬Ґ­пҐв Ї®§ЁжЁо з⥭Ёп/§ ЇЁбЁ ў + Ё­д®а¬ жЁ®­­®© бвагЄвгॠF. - PROCEDURE Write(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 Create(FName: ARRAY OF CHAR): FS + ᮧ¤ Ґв ­®ўл© д ©« б Ё¬Ґ­Ґ¬ FName (Ї®«­®Ґ Ё¬п), ў®§ўа й Ґв + гЄ § вҐ«м ­  Ё­д®а¬ жЁ®­­го бвагЄвгаг д ©« , + ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв NIL - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - ᮧ¤ Ґв Ї ЇЄг б Ё¬Ґ­Ґ¬ DirName, ўбҐ Їа®¬Ґ¦гв®з­лҐ Ї ЇЄЁ - ¤®«¦­л бгйҐбвў®ў вм, ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв FALSE + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + ᮧ¤ Ґв Ї ЇЄг б Ё¬Ґ­Ґ¬ DirName, ўбҐ Їа®¬Ґ¦гв®з­лҐ Ї ЇЄЁ + ¤®«¦­л бгйҐбвў®ў вм, ЇаЁ ®иЁЎЄҐ ў®§ўа й Ґв FALSE - PROCEDURE DeleteDir(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 бгйҐбвўгҐв + PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN + ў®§ўа й Ґв TRUE, Ґб«Ё Ї ЇЄ  б Ё¬Ґ­Ґ¬ DirName бгйҐбвўгҐв ------------------------------------------------------------------------------ MODULE Read - з⥭ЁҐ ®б­®ў­ле вЁЇ®ў ¤ ­­ле Ё§ д ©«  F - Џа®жҐ¤гал ў®§ўа й ов TRUE ў б«гз Ґ гбЇҐи­®© ®ЇҐа жЁЁ з⥭Ёп Ё - ᮮ⢥вбвўгойЁ¬ ®Ўа §®¬ Ё§¬Ґ­пов Ї®§ЁжЁо з⥭Ёп/§ ЇЁбЁ ў - Ё­д®а¬ жЁ®­­®© бвагЄвгॠF + Џа®жҐ¤гал ў®§ўа й ов TRUE ў б«гз Ґ гбЇҐи­®© ®ЇҐа жЁЁ з⥭Ёп Ё + ᮮ⢥вбвўгойЁ¬ ®Ўа §®¬ Ё§¬Ґ­пов Ї®§ЁжЁо з⥭Ёп/§ ЇЁбЁ ў + Ё­д®а¬ жЁ®­­®© бвагЄвгॠF - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN + PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN ------------------------------------------------------------------------------ MODULE Write - § ЇЁбм ®б­®ў­ле вЁЇ®ў ¤ ­­ле ў д ©« F - Џа®жҐ¤гал ў®§ўа й ов TRUE ў б«гз Ґ гбЇҐи­®© ®ЇҐа жЁЁ § ЇЁбЁ Ё - ᮮ⢥вбвўгойЁ¬ ®Ўа §®¬ Ё§¬Ґ­пов Ї®§ЁжЁо з⥭Ёп/§ ЇЁбЁ ў - Ё­д®а¬ жЁ®­­®© бвагЄвгॠF + Џа®жҐ¤гал ў®§ўа й ов TRUE ў б«гз Ґ гбЇҐи­®© ®ЇҐа жЁЁ § ЇЁбЁ Ё + ᮮ⢥вбвўгойЁ¬ ®Ўа §®¬ Ё§¬Ґ­пов Ї®§ЁжЁо з⥭Ёп/§ ЇЁбЁ ў + Ё­д®а¬ жЁ®­­®© бвагЄвгॠF - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN + PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN ------------------------------------------------------------------------------ MODULE DateTime - ¤ в , ўаҐ¬п - CONST ERR = -7.0E5 + CONST ERR = -7.0E5 - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - § ЇЁблў Ґв ў Ї а ¬Ґвал Є®¬Ї®­Ґ­вл ⥪г饩 бЁб⥬­®© ¤ вл Ё - ўаҐ¬Ґ­Ё + 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 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 + 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 - Є®«ЁзҐбвў® Ї а ¬Ґва®ў Їа®Ја ¬¬л, ўЄ«оз п Ё¬п - ЁбЇ®«­пҐ¬®Ј® д ©«  + VAR argc: INTEGER + Є®«ЁзҐбвў® Ї а ¬Ґва®ў Їа®Ја ¬¬л, ўЄ«оз п Ё¬п + ЁбЇ®«­пҐ¬®Ј® д ©«  - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - § ЇЁблў Ґв ў бва®Єг s n-© Ї а ¬Ґва Їа®Ја ¬¬л, - ­г¬Ґа жЁп Ї а ¬Ґва®ў ®в 0 ¤® argc - 1, - ­г«Ґў®© Ї а ¬Ґва -- Ё¬п ЁбЇ®«­пҐ¬®Ј® д ©«  + 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 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 sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER + ЋЎҐавЄ  ¤«п дг­ЄжЁ© API п¤а  KolibriOS. + arg1 - ॣЁбва eax, arg2 - ॣЁбва ebx, + res2 - §­ зҐ­ЁҐ ॣЁбва  ebx Ї®б«Ґ бЁб⥬­®Ј® ўл§®ў ; + ў®§ўа й Ґв §­ зҐ­ЁҐ ॣЁбва  eax Ї®б«Ґ бЁб⥬­®Ј® ўл§®ў . - PROCEDURE malloc(size: INTEGER): INTEGER - ‚뤥«пҐв Ў«®Є Ї ¬пвЁ. - size - а §¬Ґа Ў«®Є  ў Ў ©в е, - ў®§ўа й Ґв  ¤аҐб ўл¤Ґ«Ґ­­®Ј® Ў«®Є  + PROCEDURE malloc(size: INTEGER): INTEGER + ‚뤥«пҐв Ў«®Є Ї ¬пвЁ. + size - а §¬Ґа Ў«®Є  ў Ў ©в е, + ў®§ўа й Ґв  ¤аҐб ўл¤Ґ«Ґ­­®Ј® Ў«®Є  - PROCEDURE free(ptr: INTEGER): INTEGER - Ћбў®Ў®¦¤ Ґв а ­ҐҐ ўл¤Ґ«Ґ­­л© Ў«®Є Ї ¬пвЁ б  ¤аҐб®¬ ptr, - ў®§ўа й Ґв 0 + PROCEDURE free(ptr: INTEGER): INTEGER + Ћбў®Ў®¦¤ Ґв а ­ҐҐ ўл¤Ґ«Ґ­­л© Ў«®Є Ї ¬пвЁ б  ¤аҐб®¬ ptr, + ў®§ўа й Ґв 0 - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - ЏҐаҐа бЇаҐ¤Ґ«пҐв Ў«®Є Ї ¬пвЁ, - ptr -  ¤аҐб а ­ҐҐ ўл¤Ґ«Ґ­­®Ј® Ў«®Є , - size - ­®ўл© а §¬Ґа, - ў®§ўа й Ґв гЄ § вҐ«м ­  ЇҐаҐа бЇаҐ¤Ґ«Ґ­­л© Ў«®Є, - 0 ЇаЁ ®иЁЎЄҐ + PROCEDURE realloc(ptr, size: INTEGER): INTEGER + ЏҐаҐа бЇаҐ¤Ґ«пҐв Ў«®Є Ї ¬пвЁ, + ptr -  ¤аҐб а ­ҐҐ ўл¤Ґ«Ґ­­®Ј® Ў«®Є , + size - ­®ўл© а §¬Ґа, + ў®§ўа й Ґв гЄ § вҐ«м ­  ЇҐаҐа бЇаҐ¤Ґ«Ґ­­л© Ў«®Є, + 0 ЇаЁ ®иЁЎЄҐ - PROCEDURE GetCommandLine(): INTEGER - ‚®§ўа й Ґв  ¤аҐб бва®ЄЁ Ї а ¬Ґва®ў + PROCEDURE GetCommandLine(): INTEGER + ‚®§ўа й Ґв  ¤аҐб бва®ЄЁ Ї а ¬Ґва®ў - PROCEDURE GetName(): INTEGER - ‚®§ўа й Ґв  ¤аҐб бва®ЄЁ б Ё¬Ґ­Ґ¬ Їа®Ја ¬¬л + PROCEDURE GetName(): INTEGER + ‚®§ўа й Ґв  ¤аҐб бва®ЄЁ б Ё¬Ґ­Ґ¬ Їа®Ја ¬¬л - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - ‡ Јаг¦ Ґв DLL б Ї®«­л¬ Ё¬Ґ­Ґ¬ name. ‚®§ўа й Ґв  ¤аҐб в Ў«Ёжл - нЄбЇ®ав . ЏаЁ ®иЁЎЄҐ ў®§ўа й Ґв 0. + PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER + ‡ Јаг¦ Ґв DLL б Ї®«­л¬ Ё¬Ґ­Ґ¬ name. ‚®§ўа й Ґв  ¤аҐб в Ў«Ёжл + нЄбЇ®ав . ЏаЁ ®иЁЎЄҐ ў®§ўа й Ґв 0. - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - Ё¬п Їа®жҐ¤гал - lib -  ¤аҐб в Ў«Ёжл нЄбЇ®ав  DLL - ‚®§ўа й Ґв  ¤аҐб Їа®жҐ¤гал. ЏаЁ ®иЁЎЄҐ ў®§ўа й Ґв 0. + PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER + name - Ё¬п Їа®жҐ¤гал + lib -  ¤аҐб в Ў«Ёжл нЄбЇ®ав  DLL + ‚®§ўа й Ґв  ¤аҐб Їа®жҐ¤гал. ЏаЁ ®иЁЎЄҐ ў®§ўа й Ґв 0. ------------------------------------------------------------------------------ MODULE ColorDlg - а Ў®в  б ¤Ё «®Ј®¬ "Color Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* бвагЄвга  ¤Ё «®Ј  *) - status: INTEGER (* б®бв®п­ЁҐ ¤Ё «®Ј : - 0 - Ї®«м§®ў вҐ«м ­ ¦ « Cancel - 1 - Ї®«м§®ў вҐ«м ­ ¦ « OK - 2 - ¤Ё «®Ј ®вЄалв *) + Dialog = POINTER TO RECORD (* бвагЄвга  ¤Ё «®Ј  *) + status: INTEGER (* б®бв®п­ЁҐ ¤Ё «®Ј : + 0 - Ї®«м§®ў вҐ«м ­ ¦ « Cancel + 1 - Ї®«м§®ў вҐ«м ­ ¦ « OK + 2 - ¤Ё «®Ј ®вЄалв *) - color: INTEGER (* ўлЎа ­­л© 梥в *) - END + color: INTEGER (* ўлЎа ­­л© 梥в *) + END - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - ᮧ¤ вм ¤Ё «®Ј - draw_window - Їа®жҐ¤га  ЇҐаҐаЁб®ўЄЁ ®б­®ў­®Ј® ®Є­  - (TYPE DRAW_WINDOW = PROCEDURE); - Їа®жҐ¤га  ў®§ўа й Ґв гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  + PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog + ᮧ¤ вм ¤Ё «®Ј + draw_window - Їа®жҐ¤га  ЇҐаҐаЁб®ўЄЁ ®б­®ў­®Ј® ®Є­  + (TYPE DRAW_WINDOW = PROCEDURE); + Їа®жҐ¤га  ў®§ўа й Ґв гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  - PROCEDURE Show(cd: Dialog) - Ї®Є § вм ¤Ё «®Ј - cd - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј , Є®в®ал© Ўл« ᮧ¤ ­ а ­ҐҐ - Їа®жҐ¤га®© Create + PROCEDURE Show(cd: Dialog) + Ї®Є § вм ¤Ё «®Ј + cd - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј , Є®в®ал© Ўл« ᮧ¤ ­ а ­ҐҐ + Їа®жҐ¤га®© Create - PROCEDURE Destroy(VAR cd: Dialog) - г­Ёз⮦Ёвм ¤Ё «®Ј - cd - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  + PROCEDURE Destroy(VAR cd: Dialog) + г­Ёз⮦Ёвм ¤Ё «®Ј + cd - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  ------------------------------------------------------------------------------ MODULE OpenDlg - а Ў®в  б ¤Ё «®Ј®¬ "Open Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* бвагЄвга  ¤Ё «®Ј  *) - status: INTEGER (* б®бв®п­ЁҐ ¤Ё «®Ј : - 0 - Ї®«м§®ў вҐ«м ­ ¦ « Cancel - 1 - Ї®«м§®ў вҐ«м ­ ¦ « OK - 2 - ¤Ё «®Ј ®вЄалв *) + Dialog = POINTER TO RECORD (* бвагЄвга  ¤Ё «®Ј  *) + status: INTEGER (* б®бв®п­ЁҐ ¤Ё «®Ј : + 0 - Ї®«м§®ў вҐ«м ­ ¦ « Cancel + 1 - Ї®«м§®ў вҐ«м ­ ¦ « OK + 2 - ¤Ё «®Ј ®вЄалв *) - FileName: ARRAY 4096 OF CHAR (* Ё¬п ўлЎа ­­®Ј® д ©«  *) - FilePath: ARRAY 4096 OF CHAR (* Ї®«­®Ґ Ё¬п ўлЎа ­­®Ј® - д ©«  *) - END + 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 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 Show(od: Dialog; Width, Height: INTEGER) + Ї®Є § вм ¤Ё «®Ј + od - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј , Є®в®ал© Ўл« ᮧ¤ ­ а ­ҐҐ + Їа®жҐ¤га®© Create + Width Ё Height - иЁаЁ­  Ё ўлб®в  ¤Ё «®Ј®ў®Ј® ®Є­  - PROCEDURE Destroy(VAR od: Dialog) - г­Ёз⮦Ёвм ¤Ё «®Ј - od - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  + PROCEDURE Destroy(VAR od: Dialog) + г­Ёз⮦Ёвм ¤Ё «®Ј + od - гЄ § вҐ«м ­  бвагЄвгаг ¤Ё «®Ј  ------------------------------------------------------------------------------ MODULE kfonts - а Ў®в  б kf-иаЁдв ¬Ё - CONST + CONST - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 + bold = 1 + italic = 2 + underline = 4 + strike_through = 8 + smoothing = 16 + bpp32 = 32 - TYPE + TYPE - TFont = POINTER TO TFont_desc (* гЄ § вҐ«м ­  иаЁдв *) + TFont = POINTER TO TFont_desc (* гЄ § вҐ«м ­  иаЁдв *) - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - § Јаг§Ёвм иаЁдв Ё§ д ©«  - file_name Ё¬п kf-д ©«  - १-в: гЄ § вҐ«м ­  иаЁдв/NIL (®иЁЎЄ ) + 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 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 Enabled(Font: TFont; font_size: INTEGER): BOOLEAN + Їа®ўҐаЁвм, Ґбвм «Ё иаЁдв, § ¤ ­­®Ј® а §¬Ґа  + Font гЄ § вҐ«м ­  иаЁдв + font_size а §¬Ґа иаЁдв  + १-в: TRUE/FALSE (иаЁдв  ­Ґв) - PROCEDURE Destroy(VAR Font: TFont) - ўлЈаг§Ёвм иаЁдв, ®бў®Ў®¤Ёвм ¤Ё­ ¬ЁзҐбЄго Ї ¬пвм - Font гЄ § вҐ«м ­  иаЁдв - ЏаЁбў Ёў Ґв ЇҐаҐ¬Ґ­­®© Font §­ зҐ­ЁҐ NIL + PROCEDURE Destroy(VAR Font: TFont) + ўлЈаг§Ёвм иаЁдв, ®бў®Ў®¤Ёвм ¤Ё­ ¬ЁзҐбЄго Ї ¬пвм + Font гЄ § вҐ«м ­  иаЁдв + ЏаЁбў Ёў Ґв ЇҐаҐ¬Ґ­­®© Font §­ зҐ­ЁҐ NIL - PROCEDURE TextHeight(Font: TFont): INTEGER - Ї®«гзЁвм ўлб®вг бва®ЄЁ ⥪бв  - Font гЄ § вҐ«м ­  иаЁдв - १-в: ўлб®в  бва®ЄЁ ⥪бв  ў ЇЁЄбҐ«пе + PROCEDURE TextHeight(Font: TFont): INTEGER + Ї®«гзЁвм ўлб®вг бва®ЄЁ ⥪бв  + Font гЄ § вҐ«м ­  иаЁдв + १-в: ўлб®в  бва®ЄЁ ⥪бв  ў ЇЁЄбҐ«пе - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - Ї®«гзЁвм иЁаЁ­г бва®ЄЁ ⥪бв  - Font гЄ § вҐ«м ­  иаЁдв - str  ¤аҐб бва®ЄЁ ⥪бв  ў Є®¤Ёа®ўЄҐ Win-1251 - length Є®«ЁзҐбвў® бЁ¬ў®«®ў ў бва®ЄҐ Ё«Ё -1, Ґб«Ё бва®Є  - § ўҐаи Ґвбп ­г«Ґ¬ - params Ї а ¬Ґвал-д« ЈЁ б¬. ­Ё¦Ґ - १-в: иЁаЁ­  бва®ЄЁ ⥪бв  ў ЇЁЄбҐ«пе + 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-ЎЁв­л© ЎгдҐа - ў®§¬®¦­® ЁбЇ®«м§®ў ­ЁҐ д« Ј®ў ў «оЎле б®зҐв ­Ёпе + 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 ------------------------------------------------------------------------------ diff --git a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 index 1c4d680f7..1786326c4 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2018, Anton Krotov @@ -18,6 +18,8 @@ CONST _new = 1; _dispose = 2; + SizeOfHeader = 36; + TYPE @@ -294,7 +296,7 @@ PROCEDURE init* (_import, code: INTEGER); BEGIN multi := FALSE; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; - base := code - 36; + base := code - SizeOfHeader; K.sysfunc2(68, 11); InitializeCriticalSection(CriticalSection); K._init; @@ -316,4 +318,4 @@ PROCEDURE GetTickCount* (): INTEGER; END GetTickCount; -END API. \ No newline at end of file +END API. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 index 889059d0a..20856c87a 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 +++ b/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 @@ -97,4 +97,4 @@ END GetArg; BEGIN ParamParse -END Args. \ No newline at end of file +END Args. diff --git a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 index e993d375c..5cf255ce9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 +++ b/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 @@ -102,4 +102,4 @@ END Load; BEGIN Load -END ColorDlg. \ No newline at end of file +END ColorDlg. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 index 7d80c4fb0..ee5c5d1f9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 +++ b/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 diff --git a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 index 74346a692..74ee3f3d4 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 +++ b/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 @@ -100,4 +100,4 @@ END main; BEGIN main -END ConsoleLib. \ No newline at end of file +END ConsoleLib. diff --git a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 b/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 index 12291065f..e44bde151 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 +++ b/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 @@ -138,4 +138,4 @@ BEGIN Msec := 0 END Now; -END DateTime. \ No newline at end of file +END DateTime. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 index daaf40ece..b341b83fc 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 +++ b/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 @@ -289,4 +289,4 @@ BEGIN res := KOSAPI.sysfunc2(70, sys.ADR(info)) END Open; -END Debug. \ No newline at end of file +END Debug. diff --git a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 index d25a8d693..ff61c5863 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 +++ b/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 @@ -313,4 +313,4 @@ BEGIN END DeleteDir; -END File. \ No newline at end of file +END File. diff --git a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 index 3a43347bc..10a9def86 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -205,7 +205,7 @@ BEGIN END Create; -PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; VAR n: INTEGER; fs: FS; @@ -468,4 +468,4 @@ BEGIN con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) END; ParamParse -END HOST. \ No newline at end of file +END HOST. diff --git a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 b/programs/develop/oberon07/Lib/KolibriOS/In.ob07 index 50af0cb95..6401c6dc1 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 +++ b/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 diff --git a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 index 4cf92fc86..de4a9d9b9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -427,4 +427,4 @@ BEGIN END _init; -END KOSAPI. \ No newline at end of file +END KOSAPI. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 index b1fe62acc..b49668351 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 +++ b/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 @@ -381,4 +381,4 @@ BEGIN END fact; -END Math. \ No newline at end of file +END Math. diff --git a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 b/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 index c0ed629f9..93d0dbc7b 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 +++ b/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 @@ -104,4 +104,4 @@ PROCEDURE LinkStatus* (num: INTEGER): INTEGER; END LinkStatus; -END NetDevices. \ No newline at end of file +END NetDevices. diff --git a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 index 9bffd20f2..6240eb2b2 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 +++ b/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 @@ -150,4 +150,4 @@ END Load; BEGIN Load -END OpenDlg. \ No newline at end of file +END OpenDlg. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 index 02cc14e01..04de78c75 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 +++ b/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 @@ -264,4 +264,4 @@ END FixReal; PROCEDURE Open*; END Open; -END Out. \ No newline at end of file +END Out. diff --git a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 index 0a33a3269..3aa6c454e 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -16,13 +16,13 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; - SIZE_OF_DWORD = 4; - MAX_SET = 31; + WORD = bit_depth DIV 8; + MAX_SET = bit_depth - 1; TYPE @@ -35,6 +35,7 @@ VAR name: INTEGER; types: INTEGER; + bits: ARRAY MAX_SET + 1 OF INTEGER; dll: RECORD process_detach, @@ -45,35 +46,9 @@ VAR fini: PROC; -PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); +PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 085H, 0C0H, (* test eax, eax *) - 07EH, 019H, (* jle L *) - 0FCH, (* cld *) - 057H, (* push edi *) - 056H, (* push esi *) - 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) - 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) - 089H, 0C1H, (* mov ecx, eax *) - 0C1H, 0E9H, 002H, (* shr ecx, 2 *) - 0F3H, 0A5H, (* rep movsd *) - 089H, 0C1H, (* mov ecx, eax *) - 083H, 0E1H, 003H, (* and ecx, 3 *) - 0F3H, 0A4H, (* rep movsb *) - 05EH, (* pop esi *) - 05FH (* pop edi *) - (* L: *) - ) -END _move; - - -PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); -BEGIN - SYSTEM.CODE( - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) 085H, 0C0H, (* test eax, eax *) 07EH, 019H, (* jle L *) @@ -92,7 +67,7 @@ BEGIN 05FH (* pop edi *) (* L: *) ) -END _move2; +END _move; PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; @@ -103,7 +78,7 @@ BEGIN IF len_src > len_dst THEN res := FALSE ELSE - _move(len_src * base_size, src, dst); + _move(len_src * base_size, dst, src); res := TRUE END @@ -113,7 +88,7 @@ END _arrcpy; PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) + _move(MIN(len_dst, len_src) * chr_size, dst, src) END _strcpy; @@ -144,7 +119,7 @@ BEGIN IF a < 0 THEN a := 0 END; - a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) + a := LSR(ASR(minint, b - a), MAX_SET - b) ELSE a := 0 END @@ -153,69 +128,42 @@ BEGIN END _set; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; - RETURN _set(b, a) -END _set2; +PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +BEGIN + IF ASR(a, 5) = 0 THEN + SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) + ELSE + a := 0 + END + RETURN a +END _set1; -PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *) BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 053H, (* push ebx *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *) 031H, 0D2H, (* xor edx, edx *) 085H, 0C0H, (* test eax, eax *) - 07DH, 002H, (* jge L1 *) + 074H, 018H, (* je L2 *) + 07FH, 002H, (* jg L1 *) 0F7H, 0D2H, (* not edx *) (* L1: *) + 089H, 0C3H, (* mov ebx, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *) 0F7H, 0F9H, (* idiv ecx *) - 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) - 089H, 011H, (* mov dword [ecx], edx *) - 0C9H, (* leave *) - 0C2H, 00CH, 000H (* ret 12 *) + 085H, 0D2H, (* test edx, edx *) + 074H, 009H, (* je L2 *) + 031H, 0CBH, (* xor ebx, ecx *) + 085H, 0DBH, (* test ebx, ebx *) + 07DH, 003H, (* jge L2 *) + 048H, (* dec eax *) + 001H, 0CAH, (* add edx, ecx *) + (* L2: *) + 05BH (* pop ebx *) ) - - RETURN 0 -END divmod; - - -PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - DEC(div) - END - - RETURN div -END _div2; - - -PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - INC(mod, y) - END - - RETURN mod -END _mod2; - - -PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN _div2(a, b) -END _div; - - -PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN _mod2(a, b) -END _mod; +END _divmod; PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); @@ -223,7 +171,7 @@ BEGIN ptr := API._NEW(size); IF ptr # 0 THEN SYSTEM.PUT(ptr, t); - INC(ptr, SIZE_OF_DWORD) + INC(ptr, WORD) END END _new; @@ -231,15 +179,14 @@ END _new; PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); BEGIN IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + ptr := API._DISPOSE(ptr - WORD) END END _dispose; -PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _length* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -250,19 +197,14 @@ BEGIN 0E2H, 0F8H, (* loop L1 *) 040H, (* inc eax *) (* L2: *) - 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *) ) - - RETURN 0 END _length; -PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -277,58 +219,92 @@ BEGIN 040H, (* inc eax *) (* L2: *) 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0D1H, 0E8H, (* shr eax, 1 *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 0D1H, 0E8H (* shr eax, 1 *) ) - - RETURN 0 END _lengthw; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 017H, (* jle L3 *) + 08AH, 00EH, (* mov cl, byte[esi] *) + 08AH, 017H, (* mov dl, byte[edi] *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E7H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmp; -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 01BH, (* jle L3 *) + 066H, 08BH, 00EH, (* mov cx, word[esi] *) + 066H, 08BH, 017H, (* mov dx, word[edi] *) + 046H, (* inc esi *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E3H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmpw; @@ -507,7 +483,7 @@ END _isrec; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) END @@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN SYSTEM.GET(p, p); IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) ELSE p := 1 @@ -567,14 +543,6 @@ BEGIN END _dllentry; -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 [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -596,14 +564,20 @@ BEGIN t0 := i; t1 := j; WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + SYSTEM.GET(_types + t1 * WORD, t1) END; SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) END END; - name := modname; + 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; @@ -621,10 +595,18 @@ BEGIN 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. \ No newline at end of file +END RTL. diff --git a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 index 5c804aa18..dc814845c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 +++ b/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 @@ -121,4 +121,4 @@ END main; BEGIN main -END RasterWorks. \ No newline at end of file +END RasterWorks. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 index c9df9d2c4..85bb58d80 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 +++ b/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 @@ -39,8 +39,8 @@ PROCEDURE Set*(F: File.FS; VAR x: SET): BOOLEAN; RETURN File.Read(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET) END Set; -PROCEDURE Card16*(F: File.FS; VAR x: sys.CARD16): BOOLEAN; - RETURN File.Read(F, sys.ADR(x), sys.SIZE(sys.CARD16)) = sys.SIZE(sys.CARD16) -END Card16; +PROCEDURE WChar*(F: File.FS; VAR x: WCHAR): BOOLEAN; + RETURN File.Read(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR) +END WChar; -END Read. \ No newline at end of file +END Read. diff --git a/programs/develop/oberon07/Source/UNIXTIME.ob07 b/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 similarity index 88% rename from programs/develop/oberon07/Source/UNIXTIME.ob07 rename to programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 index e5f6ce39d..138e4297f 100644 --- a/programs/develop/oberon07/Source/UNIXTIME.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/UnixTime.ob07 @@ -1,11 +1,11 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) -MODULE UNIXTIME; +MODULE UnixTime; VAR @@ -61,4 +61,4 @@ END time; BEGIN init -END UNIXTIME. \ No newline at end of file +END UnixTime. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 index 46de391cc..0792204a9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 +++ b/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 @@ -118,4 +118,4 @@ BEGIN END destroy; -END Vector. \ No newline at end of file +END Vector. diff --git a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 index 153b2bb93..7a9823f25 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 +++ b/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 @@ -39,8 +39,8 @@ PROCEDURE Set*(F: File.FS; x: SET): BOOLEAN; RETURN File.Write(F, sys.ADR(x), sys.SIZE(SET)) = sys.SIZE(SET) END Set; -PROCEDURE Card16*(F: File.FS; x: sys.CARD16): BOOLEAN; - RETURN File.Write(F, sys.ADR(x), sys.SIZE(sys.CARD16)) = sys.SIZE(sys.CARD16) -END Card16; +PROCEDURE WChar*(F: File.FS; x: WCHAR): BOOLEAN; + RETURN File.Write(F, sys.ADR(x), sys.SIZE(WCHAR)) = sys.SIZE(WCHAR) +END WChar; -END Write. \ No newline at end of file +END Write. diff --git a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 index 8ef267a00..67c108040 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 +++ b/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 @@ -489,4 +489,4 @@ BEGIN RETURN Font END LoadFont; -END kfonts. \ No newline at end of file +END kfonts. diff --git a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 index 425f74034..9c5a516a9 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 +++ b/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 @@ -432,4 +432,4 @@ END main; BEGIN main -END libimg. \ No newline at end of file +END libimg. diff --git a/programs/develop/oberon07/Lib/Linux32/API.ob07 b/programs/develop/oberon07/Lib/Linux32/API.ob07 index b461216a6..42a337fd0 100644 --- a/programs/develop/oberon07/Lib/Linux32/API.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/API.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -12,7 +12,7 @@ IMPORT SYSTEM; CONST - BASE_ADR = 08048000H; + RTLD_LAZY* = 1; TYPE @@ -22,8 +22,8 @@ TYPE VAR - eol*: ARRAY 2 OF CHAR; - base*, MainParam*: INTEGER; + eol*: ARRAY 2 OF CHAR; + MainParam*: INTEGER; libc*, librt*: INTEGER; @@ -93,6 +93,7 @@ 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); @@ -105,10 +106,9 @@ BEGIN SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); MainParam := sp; - base := BASE_ADR; eol := 0AX; - libc := dlopen(SYSTEM.SADR("libc.so.6"), 1); + 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)); @@ -125,7 +125,7 @@ BEGIN GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); GetProcAdr(libc, "time", SYSTEM.ADR(time)); - librt := dlopen(SYSTEM.SADR("librt.so.1"), 1); + librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) END init; @@ -142,4 +142,4 @@ BEGIN END exit_thread; -END API. \ No newline at end of file +END API. diff --git a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 index 967e2657b..a2f43bc83 100644 --- a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -68,22 +68,12 @@ BEGIN END GetCurrentDirectory; -PROCEDURE ReadFile (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; - RETURN API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F) -END ReadFile; - - -PROCEDURE WriteFile (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; - RETURN API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F) -END WriteFile; - - -PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; VAR res: INTEGER; BEGIN - res := ReadFile(F, Buffer, bytes); + res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); IF res <= 0 THEN res := -1 END @@ -97,7 +87,7 @@ VAR res: INTEGER; BEGIN - res := WriteFile(F, Buffer, bytes); + res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); IF res <= 0 THEN res := -1 END @@ -175,4 +165,4 @@ END splitf; BEGIN eol := 0AX; SYSTEM.GET(API.MainParam, argc) -END HOST. \ No newline at end of file +END HOST. diff --git a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 index 9506a4410..d38c8b3f4 100644 --- a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -74,12 +74,18 @@ VAR ptr: INTEGER; BEGIN - envc := -1; - SYSTEM.GET(API.MainParam, argc); - REPEAT - SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr); - INC(envc) - UNTIL ptr = 0; + + 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; @@ -128,4 +134,4 @@ END syscall; BEGIN init -END LINAPI. \ No newline at end of file +END LINAPI. diff --git a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 index 0a33a3269..3aa6c454e 100644 --- a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -16,13 +16,13 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; - SIZE_OF_DWORD = 4; - MAX_SET = 31; + WORD = bit_depth DIV 8; + MAX_SET = bit_depth - 1; TYPE @@ -35,6 +35,7 @@ VAR name: INTEGER; types: INTEGER; + bits: ARRAY MAX_SET + 1 OF INTEGER; dll: RECORD process_detach, @@ -45,35 +46,9 @@ VAR fini: PROC; -PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); +PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 085H, 0C0H, (* test eax, eax *) - 07EH, 019H, (* jle L *) - 0FCH, (* cld *) - 057H, (* push edi *) - 056H, (* push esi *) - 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) - 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) - 089H, 0C1H, (* mov ecx, eax *) - 0C1H, 0E9H, 002H, (* shr ecx, 2 *) - 0F3H, 0A5H, (* rep movsd *) - 089H, 0C1H, (* mov ecx, eax *) - 083H, 0E1H, 003H, (* and ecx, 3 *) - 0F3H, 0A4H, (* rep movsb *) - 05EH, (* pop esi *) - 05FH (* pop edi *) - (* L: *) - ) -END _move; - - -PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); -BEGIN - SYSTEM.CODE( - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) 085H, 0C0H, (* test eax, eax *) 07EH, 019H, (* jle L *) @@ -92,7 +67,7 @@ BEGIN 05FH (* pop edi *) (* L: *) ) -END _move2; +END _move; PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; @@ -103,7 +78,7 @@ BEGIN IF len_src > len_dst THEN res := FALSE ELSE - _move(len_src * base_size, src, dst); + _move(len_src * base_size, dst, src); res := TRUE END @@ -113,7 +88,7 @@ END _arrcpy; PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) + _move(MIN(len_dst, len_src) * chr_size, dst, src) END _strcpy; @@ -144,7 +119,7 @@ BEGIN IF a < 0 THEN a := 0 END; - a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) + a := LSR(ASR(minint, b - a), MAX_SET - b) ELSE a := 0 END @@ -153,69 +128,42 @@ BEGIN END _set; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; - RETURN _set(b, a) -END _set2; +PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +BEGIN + IF ASR(a, 5) = 0 THEN + SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) + ELSE + a := 0 + END + RETURN a +END _set1; -PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *) BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 053H, (* push ebx *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *) 031H, 0D2H, (* xor edx, edx *) 085H, 0C0H, (* test eax, eax *) - 07DH, 002H, (* jge L1 *) + 074H, 018H, (* je L2 *) + 07FH, 002H, (* jg L1 *) 0F7H, 0D2H, (* not edx *) (* L1: *) + 089H, 0C3H, (* mov ebx, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *) 0F7H, 0F9H, (* idiv ecx *) - 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) - 089H, 011H, (* mov dword [ecx], edx *) - 0C9H, (* leave *) - 0C2H, 00CH, 000H (* ret 12 *) + 085H, 0D2H, (* test edx, edx *) + 074H, 009H, (* je L2 *) + 031H, 0CBH, (* xor ebx, ecx *) + 085H, 0DBH, (* test ebx, ebx *) + 07DH, 003H, (* jge L2 *) + 048H, (* dec eax *) + 001H, 0CAH, (* add edx, ecx *) + (* L2: *) + 05BH (* pop ebx *) ) - - RETURN 0 -END divmod; - - -PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - DEC(div) - END - - RETURN div -END _div2; - - -PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - INC(mod, y) - END - - RETURN mod -END _mod2; - - -PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN _div2(a, b) -END _div; - - -PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN _mod2(a, b) -END _mod; +END _divmod; PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); @@ -223,7 +171,7 @@ BEGIN ptr := API._NEW(size); IF ptr # 0 THEN SYSTEM.PUT(ptr, t); - INC(ptr, SIZE_OF_DWORD) + INC(ptr, WORD) END END _new; @@ -231,15 +179,14 @@ END _new; PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); BEGIN IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + ptr := API._DISPOSE(ptr - WORD) END END _dispose; -PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _length* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -250,19 +197,14 @@ BEGIN 0E2H, 0F8H, (* loop L1 *) 040H, (* inc eax *) (* L2: *) - 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *) ) - - RETURN 0 END _length; -PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -277,58 +219,92 @@ BEGIN 040H, (* inc eax *) (* L2: *) 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0D1H, 0E8H, (* shr eax, 1 *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 0D1H, 0E8H (* shr eax, 1 *) ) - - RETURN 0 END _lengthw; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 017H, (* jle L3 *) + 08AH, 00EH, (* mov cl, byte[esi] *) + 08AH, 017H, (* mov dl, byte[edi] *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E7H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmp; -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 01BH, (* jle L3 *) + 066H, 08BH, 00EH, (* mov cx, word[esi] *) + 066H, 08BH, 017H, (* mov dx, word[edi] *) + 046H, (* inc esi *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E3H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmpw; @@ -507,7 +483,7 @@ END _isrec; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) END @@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN SYSTEM.GET(p, p); IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) ELSE p := 1 @@ -567,14 +543,6 @@ BEGIN END _dllentry; -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 [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -596,14 +564,20 @@ BEGIN t0 := i; t1 := j; WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + SYSTEM.GET(_types + t1 * WORD, t1) END; SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) END END; - name := modname; + 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; @@ -621,10 +595,18 @@ BEGIN 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. \ No newline at end of file +END RTL. diff --git a/programs/develop/oberon07/Lib/Windows32/API.ob07 b/programs/develop/oberon07/Lib/Windows32/API.ob07 index 588669fa7..ec9ce7a93 100644 --- a/programs/develop/oberon07/Lib/Windows32/API.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/API.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -9,6 +9,12 @@ MODULE API; IMPORT SYSTEM; + +CONST + + SectionAlignment = 1000H; + + VAR eol*: ARRAY 3 OF CHAR; @@ -46,7 +52,7 @@ END _DISPOSE; PROCEDURE init* (reserved, code: INTEGER); BEGIN eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; - base := code - 4096; + base := code - SectionAlignment; heap := GetProcessHeap() END init; diff --git a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 index 78c531b72..8e5568d8f 100644 --- a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -42,9 +42,9 @@ TYPE cBytes: CHAR; fFixedDisk: CHAR; - nErrCode: SYSTEM.CARD16; - Reserved1: SYSTEM.CARD16; - Reserved2: SYSTEM.CARD16; + nErrCode: WCHAR; + Reserved1: WCHAR; + Reserved2: WCHAR; szPathName: ARRAY OFS_MAXPATHNAME OF CHAR END; @@ -211,7 +211,7 @@ BEGIN END GetArg; -PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; VAR res, n: INTEGER; @@ -328,4 +328,4 @@ BEGIN eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; hConsoleOutput := _GetStdHandle(-11); ParamParse -END HOST. \ No newline at end of file +END HOST. diff --git a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 index 0a33a3269..3aa6c454e 100644 --- a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -16,13 +16,13 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; - SIZE_OF_DWORD = 4; - MAX_SET = 31; + WORD = bit_depth DIV 8; + MAX_SET = bit_depth - 1; TYPE @@ -35,6 +35,7 @@ VAR name: INTEGER; types: INTEGER; + bits: ARRAY MAX_SET + 1 OF INTEGER; dll: RECORD process_detach, @@ -45,35 +46,9 @@ VAR fini: PROC; -PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); +PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 085H, 0C0H, (* test eax, eax *) - 07EH, 019H, (* jle L *) - 0FCH, (* cld *) - 057H, (* push edi *) - 056H, (* push esi *) - 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) - 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) - 089H, 0C1H, (* mov ecx, eax *) - 0C1H, 0E9H, 002H, (* shr ecx, 2 *) - 0F3H, 0A5H, (* rep movsd *) - 089H, 0C1H, (* mov ecx, eax *) - 083H, 0E1H, 003H, (* and ecx, 3 *) - 0F3H, 0A4H, (* rep movsb *) - 05EH, (* pop esi *) - 05FH (* pop edi *) - (* L: *) - ) -END _move; - - -PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); -BEGIN - SYSTEM.CODE( - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) 085H, 0C0H, (* test eax, eax *) 07EH, 019H, (* jle L *) @@ -92,7 +67,7 @@ BEGIN 05FH (* pop edi *) (* L: *) ) -END _move2; +END _move; PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; @@ -103,7 +78,7 @@ BEGIN IF len_src > len_dst THEN res := FALSE ELSE - _move(len_src * base_size, src, dst); + _move(len_src * base_size, dst, src); res := TRUE END @@ -113,7 +88,7 @@ END _arrcpy; PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) + _move(MIN(len_dst, len_src) * chr_size, dst, src) END _strcpy; @@ -144,7 +119,7 @@ BEGIN IF a < 0 THEN a := 0 END; - a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) + a := LSR(ASR(minint, b - a), MAX_SET - b) ELSE a := 0 END @@ -153,69 +128,42 @@ BEGIN END _set; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; - RETURN _set(b, a) -END _set2; +PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER; +BEGIN + IF ASR(a, 5) = 0 THEN + SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a) + ELSE + a := 0 + END + RETURN a +END _set1; -PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *) BEGIN SYSTEM.CODE( - - 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) - 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 053H, (* push ebx *) + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *) 031H, 0D2H, (* xor edx, edx *) 085H, 0C0H, (* test eax, eax *) - 07DH, 002H, (* jge L1 *) + 074H, 018H, (* je L2 *) + 07FH, 002H, (* jg L1 *) 0F7H, 0D2H, (* not edx *) (* L1: *) + 089H, 0C3H, (* mov ebx, eax *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *) 0F7H, 0F9H, (* idiv ecx *) - 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) - 089H, 011H, (* mov dword [ecx], edx *) - 0C9H, (* leave *) - 0C2H, 00CH, 000H (* ret 12 *) + 085H, 0D2H, (* test edx, edx *) + 074H, 009H, (* je L2 *) + 031H, 0CBH, (* xor ebx, ecx *) + 085H, 0DBH, (* test ebx, ebx *) + 07DH, 003H, (* jge L2 *) + 048H, (* dec eax *) + 001H, 0CAH, (* add edx, ecx *) + (* L2: *) + 05BH (* pop ebx *) ) - - RETURN 0 -END divmod; - - -PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - DEC(div) - END - - RETURN div -END _div2; - - -PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; -VAR - div, mod: INTEGER; - -BEGIN - div := divmod(x, y, mod); - IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN - INC(mod, y) - END - - RETURN mod -END _mod2; - - -PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN _div2(a, b) -END _div; - - -PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN _mod2(a, b) -END _mod; +END _divmod; PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); @@ -223,7 +171,7 @@ BEGIN ptr := API._NEW(size); IF ptr # 0 THEN SYSTEM.PUT(ptr, t); - INC(ptr, SIZE_OF_DWORD) + INC(ptr, WORD) END END _new; @@ -231,15 +179,14 @@ END _new; PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); BEGIN IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + ptr := API._DISPOSE(ptr - WORD) END END _dispose; -PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _length* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -250,19 +197,14 @@ BEGIN 0E2H, 0F8H, (* loop L1 *) 040H, (* inc eax *) (* L2: *) - 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *) ) - - RETURN 0 END _length; -PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER); BEGIN SYSTEM.CODE( - 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) 048H, (* dec eax *) @@ -277,58 +219,92 @@ BEGIN 040H, (* inc eax *) (* L2: *) 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) - 0D1H, 0E8H, (* shr eax, 1 *) - 0C9H, (* leave *) - 0C2H, 008H, 000H (* ret 08h *) + 0D1H, 0E8H (* shr eax, 1 *) ) - - RETURN 0 END _lengthw; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 017H, (* jle L3 *) + 08AH, 00EH, (* mov cl, byte[esi] *) + 08AH, 017H, (* mov dl, byte[edi] *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E7H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmp; -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - +PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER; BEGIN - res := minint; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - res := 0; - n := 0 - END - END - RETURN res + SYSTEM.CODE( + 056H, (* push esi *) + 057H, (* push edi *) + 053H, (* push ebx *) + 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) + 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) + 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) + 031H, 0C9H, (* xor ecx, ecx *) + 031H, 0D2H, (* xor edx, edx *) + 0B8H, + 000H, 000H, 000H, 080H, (* mov eax, minint *) + (* L1: *) + 085H, 0DBH, (* test ebx, ebx *) + 07EH, 01BH, (* jle L3 *) + 066H, 08BH, 00EH, (* mov cx, word[esi] *) + 066H, 08BH, 017H, (* mov dx, word[edi] *) + 046H, (* inc esi *) + 046H, (* inc esi *) + 047H, (* inc edi *) + 047H, (* inc edi *) + 04BH, (* dec ebx *) + 039H, 0D1H, (* cmp ecx, edx *) + 074H, 006H, (* je L2 *) + 089H, 0C8H, (* mov eax, ecx *) + 029H, 0D0H, (* sub eax, edx *) + 0EBH, 006H, (* jmp L3 *) + (* L2: *) + 085H, 0C9H, (* test ecx, ecx *) + 075H, 0E3H, (* jne L1 *) + 031H, 0C0H, (* xor eax, eax *) + (* L3: *) + 05BH, (* pop ebx *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05DH, (* pop ebp *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END strncmpw; @@ -507,7 +483,7 @@ END _isrec; PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) END @@ -526,7 +502,7 @@ PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN SYSTEM.GET(p, p); IF p # 0 THEN - SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(p - WORD, p); SYSTEM.GET(t0 + p + types, p) ELSE p := 1 @@ -567,14 +543,6 @@ BEGIN END _dllentry; -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 [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -596,14 +564,20 @@ BEGIN t0 := i; t1 := j; WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + SYSTEM.GET(_types + t1 * WORD, t1) END; SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) END END; - name := modname; + 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; @@ -621,10 +595,18 @@ BEGIN 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. \ No newline at end of file +END RTL. diff --git a/programs/develop/oberon07/Samples/Dialogs.ob07 b/programs/develop/oberon07/Samples/Dialogs.ob07 index a0630c7d5..d680c3ffd 100644 --- a/programs/develop/oberon07/Samples/Dialogs.ob07 +++ b/programs/develop/oberon07/Samples/Dialogs.ob07 @@ -107,4 +107,4 @@ END main; BEGIN main -END Dialogs. \ No newline at end of file +END Dialogs. diff --git a/programs/develop/oberon07/Samples/HW.ob07 b/programs/develop/oberon07/Samples/HW.ob07 index dd3d0ffe2..707071da1 100644 --- a/programs/develop/oberon07/Samples/HW.ob07 +++ b/programs/develop/oberon07/Samples/HW.ob07 @@ -47,4 +47,4 @@ END Main; BEGIN Main("HW", "Hello, world!") -END HW. \ No newline at end of file +END HW. diff --git a/programs/develop/oberon07/Samples/HW_con.ob07 b/programs/develop/oberon07/Samples/HW_con.ob07 index 6cab57e15..e32bec396 100644 --- a/programs/develop/oberon07/Samples/HW_con.ob07 +++ b/programs/develop/oberon07/Samples/HW_con.ob07 @@ -1,4 +1,4 @@ -п»їMODULE HW_con; +MODULE HW_con; IMPORT Out, In, Console, DateTime; @@ -10,14 +10,14 @@ BEGIN Out.Char("0") END; Out.Int(n, 0) -END OutInt2; +END OutInt2; PROCEDURE OutMonth(n: INTEGER); VAR str: ARRAY 4 OF CHAR; -BEGIN +BEGIN CASE n OF | 1: str := "jan" @@ -32,10 +32,10 @@ BEGIN |10: str := "oct" |11: str := "nov" |12: str := "dec" - END; + END; Out.String(str) -END OutMonth; +END OutMonth; PROCEDURE main; @@ -52,7 +52,7 @@ BEGIN OutInt2(Hour); Out.Char(":"); OutInt2(Min); Out.Char(":"); OutInt2(Sec) -END main; +END main; BEGIN @@ -60,4 +60,4 @@ BEGIN main; In.Ln; Console.exit(TRUE) -END HW_con. \ No newline at end of file +END HW_con. diff --git a/programs/develop/oberon07/Source/AMD64.ob07 b/programs/develop/oberon07/Source/AMD64.ob07 index fb34e0754..b93712817 100644 --- a/programs/develop/oberon07/Source/AMD64.ob07 +++ b/programs/develop/oberon07/Source/AMD64.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -750,7 +750,7 @@ BEGIN IL.opCOPYS, IL.opROT, IL.opNEW, IL.opDISP, IL.opISREC, IL.opIS, IL.opTYPEGR, IL.opTYPEGP, - IL.opCASET, IL.opDIV, + IL.opTYPEGD, IL.opCASET, IL.opDIV, IL.opDIVL, IL.opMOD, IL.opMODL, IL.opLENGTH, IL.opLENGTHW: leaf := FALSE @@ -1163,8 +1163,11 @@ BEGIN REG.Reset(R) |IL.opSAVES: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushDA(stroffs + param2); + push(reg1); + drop; pushc(param1); CallRTL(IL._move) @@ -1327,16 +1330,17 @@ BEGIN GetRegA |IL.opRSETL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(IL._set2); + push(reg1); + drop; + CallRTL(IL._set); GetRegA |IL.opRSET1: - UnOp(reg1); PushAll(1); - push(reg1); - CallRTL(IL._set); + CallRTL(IL._set1); GetRegA |IL.opINCL, IL.opEXCL: @@ -1573,11 +1577,11 @@ BEGIN |IL.opCOPY: PushAll(2); pushc(param2); - CallRTL(IL._move2) + CallRTL(IL._move) |IL.opMOVE: PushAll(3); - CallRTL(IL._move2) + CallRTL(IL._move) |IL.opCOPYA: PushAll(4); @@ -1819,7 +1823,7 @@ BEGIN |IL.opDIV: PushAll(2); - CallRTL(IL._div); + CallRTL(IL._divmod); GetRegA |IL.opDIVR: @@ -1854,20 +1858,24 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(IL._div); + CallRTL(IL._divmod); GetRegA END END |IL.opDIVL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(IL._div2); + push(reg1); + drop; + CallRTL(IL._divmod); GetRegA |IL.opMOD: PushAll(2); - CallRTL(IL._mod); + CallRTL(IL._divmod); + mov(rax, rdx); GetRegA |IL.opMODR: @@ -1899,15 +1907,20 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(IL._mod); + CallRTL(IL._divmod); + mov(rax, rdx); GetRegA END END |IL.opMODL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(IL._mod2); + push(reg1); + drop; + CallRTL(IL._divmod); + mov(rax, rdx); GetRegA |IL.opMUL: @@ -2561,12 +2574,12 @@ BEGIN END translate; -PROCEDURE prolog (code: IL.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); +PROCEDURE prolog (modname: ARRAY OF CHAR; target, stack_size: INTEGER); VAR ModName_Offs, entry, L: INTEGER; BEGIN - ModName_Offs := tcount * 8 + CHL.Length(code.data); + ModName_Offs := tcount * 8 + CHL.Length(IL.codes.data); Numbers_Offs := ModName_Offs + LENGTH(modname) + 1; ASSERT(UTILS.Align(Numbers_Offs, 16)); @@ -2596,7 +2609,7 @@ BEGIN pushDA(ModName_Offs); //MODNAME CallRTL(IL._init); - IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64} THEN + IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iELF64} THEN L := NewLabel(); pushc(0); push(rsp); @@ -2613,7 +2626,7 @@ BEGIN END prolog; -PROCEDURE epilog (code: IL.CODES; modname: ARRAY OF CHAR; target: INTEGER); +PROCEDURE epilog (modname: ARRAY OF CHAR; target: INTEGER); VAR i, n: INTEGER; number: Number; @@ -2660,13 +2673,13 @@ BEGIN i := 0; WHILE i < tcount DO - BIN.PutData64LE(prog, CHL.GetInt(code.types, i)); + BIN.PutData64LE(prog, CHL.GetInt(IL.codes.types, i)); INC(i) END; i := 0; - WHILE i < CHL.Length(code.data) DO - BIN.PutData(prog, CHL.GetByte(code.data, i)); + WHILE i < CHL.Length(IL.codes.data) DO + BIN.PutData(prog, CHL.GetByte(IL.codes.data, i)); INC(i) END; @@ -2685,13 +2698,13 @@ BEGIN number := number.next(Number) END; - exp := code.export.first(IL.EXPORT_PROC); + exp := IL.codes.export.first(IL.EXPORT_PROC); WHILE exp # NIL DO BIN.Export(prog, exp.name, exp.label); exp := exp.next(IL.EXPORT_PROC) END; - import(code.import) + import(IL.codes.import) END epilog; @@ -2719,12 +2732,12 @@ BEGIN END rsave; -PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); VAR path, modname, ext: PATHS.PATH; BEGIN - tcount := CHL.Length(code.types); + tcount := CHL.Length(IL.codes.types); Win64RegPar[0] := rcx; Win64RegPar[1] := rdx; @@ -2743,7 +2756,7 @@ BEGIN REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); - code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 8)); + IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 8))); Numbers := LISTS.create(NIL); Numbers_Count := 0; @@ -2755,22 +2768,22 @@ BEGIN NewNumber(ORD(-BITS(LSR(ASR(ROR(1, 1), 10), 1)))); (* {0..51, 63} *) NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *) - prog := BIN.create(code.lcount); - BIN.SetParams(prog, code.bss, 1, WCHR(1), WCHR(0)); + prog := BIN.create(IL.codes.lcount); + BIN.SetParams(prog, IL.codes.bss, 1, WCHR(1), WCHR(0)); X86.SetProgram(prog); - prolog(code, modname, target, options.stack); - translate(code.commands, tcount * 8); - epilog(code, modname, target); + prolog(modname, target, options.stack); + translate(IL.codes.commands, tcount * 8); + epilog(modname, target); BIN.fixup(prog); IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN - PE32.write(prog, outname, options.base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) + 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) END END CodeGen; -END AMD64. \ No newline at end of file +END AMD64. diff --git a/programs/develop/oberon07/Source/ARITH.ob07 b/programs/develop/oberon07/Source/ARITH.ob07 index 7a5734ab4..452e2b7b8 100644 --- a/programs/develop/oberon07/Source/ARITH.ob07 +++ b/programs/develop/oberon07/Source/ARITH.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -46,15 +46,12 @@ VAR BEGIN - IF v.typ = tINTEGER THEN + CASE v.typ OF + |tINTEGER, tCHAR, tWCHAR: res := v.int - ELSIF v.typ = tCHAR THEN - res := v.int - ELSIF v.typ = tWCHAR THEN - res := v.int - ELSIF v.typ = tSET THEN + |tSET: res := UTILS.Long(ORD(v.set)) - ELSIF v.typ = tBOOLEAN THEN + |tBOOLEAN: res := ORD(v.bool) END @@ -80,35 +77,28 @@ END Float; PROCEDURE check* (v: VALUE): BOOLEAN; VAR - error: BOOLEAN; + res: BOOLEAN; BEGIN - error := FALSE; - - IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN - error := TRUE - ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN - error := TRUE - ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN - error := TRUE - ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN - error := TRUE + 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) + |tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal) END - RETURN ~error + RETURN res END check; PROCEDURE isZero* (v: VALUE): BOOLEAN; VAR res: BOOLEAN; -BEGIN - ASSERT(v.typ IN {tINTEGER, tREAL}); - IF v.typ = tINTEGER THEN - res := v.int = 0 - ELSIF v.typ = tREAL THEN - res := v.float = 0.0 +BEGIN + CASE v.typ OF + |tINTEGER: res := v.int = 0 + |tREAL: res := v.float = 0.0 END RETURN res @@ -844,4 +834,4 @@ END init; BEGIN init -END ARITH. \ No newline at end of file +END ARITH. diff --git a/programs/develop/oberon07/Source/AVLTREES.ob07 b/programs/develop/oberon07/Source/AVLTREES.ob07 index 84053be03..bb0cf0bfb 100644 --- a/programs/develop/oberon07/Source/AVLTREES.ob07 +++ b/programs/develop/oberon07/Source/AVLTREES.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -194,4 +194,4 @@ END destroy; BEGIN nodes := C.create() -END AVLTREES. \ No newline at end of file +END AVLTREES. diff --git a/programs/develop/oberon07/Source/BIN.ob07 b/programs/develop/oberon07/Source/BIN.ob07 index a3f7db643..554624c4d 100644 --- a/programs/develop/oberon07/Source/BIN.ob07 +++ b/programs/develop/oberon07/Source/BIN.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -380,4 +380,4 @@ BEGIN END InitArray; -END BIN. \ No newline at end of file +END BIN. diff --git a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 index b604c2d6c..d020a3a71 100644 --- a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 +++ b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -283,4 +283,4 @@ PROCEDURE Length* (list: ANYLIST): INTEGER; END Length; -END CHUNKLISTS. \ No newline at end of file +END CHUNKLISTS. diff --git a/programs/develop/oberon07/Source/COLLECTIONS.ob07 b/programs/develop/oberon07/Source/COLLECTIONS.ob07 index 311d6dfac..21b97ea33 100644 --- a/programs/develop/oberon07/Source/COLLECTIONS.ob07 +++ b/programs/develop/oberon07/Source/COLLECTIONS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -56,4 +56,4 @@ BEGIN END create; -END COLLECTIONS. \ No newline at end of file +END COLLECTIONS. diff --git a/programs/develop/oberon07/Source/CONSOLE.ob07 b/programs/develop/oberon07/Source/CONSOLE.ob07 index 7b4072faa..372b190da 100644 --- a/programs/develop/oberon07/Source/CONSOLE.ob07 +++ b/programs/develop/oberon07/Source/CONSOLE.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -79,4 +79,4 @@ BEGIN END Int2Ln; -END CONSOLE. \ No newline at end of file +END CONSOLE. diff --git a/programs/develop/oberon07/Source/CONSTANTS.ob07 b/programs/develop/oberon07/Source/CONSTANTS.ob07 index a3b2b2de2..f7006b5ab 100644 --- a/programs/develop/oberon07/Source/CONSTANTS.ob07 +++ b/programs/develop/oberon07/Source/CONSTANTS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -10,7 +10,7 @@ MODULE CONSTANTS; CONST vMajor* = 1; - vMinor* = 0; + vMinor* = 13; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL"; @@ -46,4 +46,4 @@ CONST Target_sMSP430* = "msp430"; -END CONSTANTS. \ No newline at end of file +END CONSTANTS. diff --git a/programs/develop/oberon07/Source/Compiler.ob07 b/programs/develop/oberon07/Source/Compiler.ob07 index 015618288..ed4945902 100644 --- a/programs/develop/oberon07/Source/Compiler.ob07 +++ b/programs/develop/oberon07/Source/Compiler.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -49,7 +49,7 @@ BEGIN END Target; -PROCEDURE keys (VAR options: PROG.OPTIONS); +PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH); VAR param: PARS.PATH; i, j: INTEGER; @@ -60,9 +60,10 @@ VAR checking: SET; BEGIN + out := ""; checking := options.checking; end := FALSE; - i := 4; + i := 3; REPEAT UTILS.GetArg(i, param); @@ -76,14 +77,13 @@ BEGIN DEC(i) END - ELSIF param = "-base" THEN + ELSIF param = "-out" THEN INC(i); UTILS.GetArg(i, param); - IF STRINGS.StrToInt(param, value) THEN - options.base := ((value DIV 64) * 64) * 1024 - END; IF param[0] = "-" THEN DEC(i) + ELSE + out := param END ELSIF param = "-ram" THEN @@ -202,20 +202,20 @@ BEGIN IF inname = "" THEN C.Ln; - C.StringLn("Usage: Compiler
[optional settings]"); C.Ln; + C.StringLn("Usage: Compiler
[optional settings]"); C.Ln; 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; END; C.StringLn("optional settings:"); C.Ln; + C.StringLn(" -out output"); C.Ln; C.StringLn(" -stk set size of stack in megabytes"); C.Ln; - C.StringLn(" -base
set base address of image in kilobytes"); C.Ln; - C.StringLn(' -ver set version of program'); C.Ln; C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; - C.StringLn(" -ram set size of RAM in bytes (MSP430)"); C.Ln; - C.StringLn(" -rom set size of ROM in bytes (MSP430)"); C.Ln; + C.StringLn(" -ver set version of program ('obj' target)"); C.Ln; + C.StringLn(" -ram set size of RAM in bytes ('msp430' target)"); C.Ln; + C.StringLn(" -rom set size of ROM in bytes ('msp430' target)"); C.Ln; UTILS.Exit(0) END; @@ -230,16 +230,7 @@ BEGIN path := temp END; - UTILS.GetArg(2, outname); - IF outname = "" THEN - ERRORS.Error(205) - END; - IF PATHS.isRelative(outname) THEN - PATHS.RelPath(app_path, outname, temp); - outname := temp - END; - - UTILS.GetArg(3, param); + UTILS.GetArg(2, param); IF param = "" THEN ERRORS.Error(205) END; @@ -271,11 +262,6 @@ BEGIN CASE target OF |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL: - IF target = mConst.Target_iDLL THEN - options.base := 10000000H - ELSE - options.base := 400000H - END; STRINGS.append(lib_path, "Windows32") |mConst.Target_iKolibri, mConst.Target_iObject: @@ -297,7 +283,34 @@ BEGIN STRINGS.append(lib_path, UTILS.slash); - keys(options); + keys(options, outname); + 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 + ELSE + IF PATHS.isRelative(outname) THEN + PATHS.RelPath(app_path, outname, temp); + outname := temp + END + END; PARS.init(bit_depth, target, options); @@ -308,6 +321,7 @@ BEGIN time := UTILS.GetTickCount() - UTILS.time; + 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"); @@ -317,4 +331,4 @@ END main; BEGIN main -END Compiler. \ No newline at end of file +END Compiler. diff --git a/programs/develop/oberon07/Source/ELF.ob07 b/programs/develop/oberon07/Source/ELF.ob07 index 2c74d467f..d502af91a 100644 --- a/programs/develop/oberon07/Source/ELF.ob07 +++ b/programs/develop/oberon07/Source/ELF.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -648,4 +648,4 @@ BEGIN END write; -END ELF. \ No newline at end of file +END ELF. diff --git a/programs/develop/oberon07/Source/ERRORS.ob07 b/programs/develop/oberon07/Source/ERRORS.ob07 index 6738d047b..0121f39d0 100644 --- a/programs/develop/oberon07/Source/ERRORS.ob07 +++ b/programs/develop/oberon07/Source/ERRORS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -206,7 +206,7 @@ BEGIN |201: Error1("writing file error") |202: Error1("too many relocations") |203: Error1("size of program is too large") - |204: Error1("size of global variables is too large") + |204: Error1("size of variables is too large") |205: Error1("not enough parameters") |206: Error1("bad parameter ") |207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"') @@ -214,4 +214,4 @@ BEGIN END Error; -END ERRORS. \ No newline at end of file +END ERRORS. diff --git a/programs/develop/oberon07/Source/FILES.ob07 b/programs/develop/oberon07/Source/FILES.ob07 index fc67c1fec..7aa5b0be4 100644 --- a/programs/develop/oberon07/Source/FILES.ob07 +++ b/programs/develop/oberon07/Source/FILES.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -134,7 +134,7 @@ BEGIN END close; -PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF CHAR; bytes: INTEGER): INTEGER; VAR res: INTEGER; @@ -216,4 +216,4 @@ END WriteByte; BEGIN files := C.create() -END FILES. \ No newline at end of file +END FILES. diff --git a/programs/develop/oberon07/Source/IL.ob07 b/programs/develop/oberon07/Source/IL.ob07 index 89278d5bc..9ca222672 100644 --- a/programs/develop/oberon07/Source/IL.ob07 +++ b/programs/develop/oberon07/Source/IL.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -96,18 +96,18 @@ CONST opLADR_UNPK* = -24; - _move *= 0; - _move2 *= 1; + _init *= 0; + _move *= 1; _strcmpw *= 2; _exit *= 3; _set *= 4; - _set2 *= 5; + _set1 *= 5; _lengthw *= 6; _strcpy *= 7; - _div *= 8; - _mod *= 9; - _div2 *= 10; - _mod2 *= 11; + _length *= 8; + _divmod *= 9; + _dllentry *= 10; + _sofinit *= 11; _arrcpy *= 12; _rot *= 13; _new *= 14; @@ -118,10 +118,6 @@ CONST _isrec *= 19; _guard *= 20; _guardrec *= 21; - _length *= 22; - _init *= 23; - _dllentry *= 24; - _sofinit *= 25; TYPE @@ -175,7 +171,7 @@ TYPE END; - CODES* = POINTER TO RECORD + CODES = RECORD last: COMMAND; begcall: CMDSTACK; @@ -188,7 +184,7 @@ TYPE dmin*: INTEGER; lcount*: INTEGER; bss*: INTEGER; - rtl*: ARRAY 26 OF INTEGER; + rtl*: ARRAY 22 OF INTEGER; errlabels*: ARRAY 12 OF INTEGER; charoffs: ARRAY 256 OF INTEGER; @@ -208,6 +204,24 @@ VAR commands, variables: C.COLLECTION; +PROCEDURE set_dmin* (value: INTEGER); +BEGIN + codes.dmin := value +END set_dmin; + + +PROCEDURE set_bss* (value: INTEGER); +BEGIN + codes.bss := value +END set_bss; + + +PROCEDURE set_rtl* (idx, label: INTEGER); +BEGIN + codes.rtl[idx] := label +END set_rtl; + + PROCEDURE NewCmd (): COMMAND; VAR cmd: COMMAND; @@ -257,7 +271,7 @@ PROCEDURE getlast* (): COMMAND; END getlast; -PROCEDURE PutByte (codes: CODES; b: BYTE); +PROCEDURE PutByte (b: BYTE); BEGIN CHL.PushByte(codes.data, b) END PutByte; @@ -272,11 +286,11 @@ BEGIN i := 0; n := LENGTH(s); WHILE i < n DO - PutByte(codes, ORD(s[i])); + PutByte(ORD(s[i])); INC(i) END; - PutByte(codes, 0) + PutByte(0) RETURN res END putstr; @@ -289,8 +303,8 @@ VAR BEGIN IF codes.charoffs[c] = -1 THEN res := CHL.Length(codes.data); - PutByte(codes, c); - PutByte(codes, 0); + PutByte(c); + PutByte(0); codes.charoffs[c] := res ELSE res := codes.charoffs[c] @@ -308,7 +322,7 @@ BEGIN res := CHL.Length(codes.data); IF ODD(res) THEN - PutByte(codes, 0); + PutByte(0); INC(res) END; @@ -317,17 +331,17 @@ BEGIN i := 0; WHILE i < n DO IF endianness = little_endian THEN - PutByte(codes, ORD(codes.wstr[i]) MOD 256); - PutByte(codes, ORD(codes.wstr[i]) DIV 256) + PutByte(ORD(codes.wstr[i]) MOD 256); + PutByte(ORD(codes.wstr[i]) DIV 256) ELSIF endianness = big_endian THEN - PutByte(codes, ORD(codes.wstr[i]) DIV 256); - PutByte(codes, ORD(codes.wstr[i]) MOD 256) + PutByte(ORD(codes.wstr[i]) DIV 256); + PutByte(ORD(codes.wstr[i]) MOD 256) END; INC(i) END; - PutByte(codes, 0); - PutByte(codes, 0) + PutByte(0); + PutByte(0) RETURN res END putstrW; @@ -342,20 +356,20 @@ BEGIN res := CHL.Length(codes.data); IF ODD(res) THEN - PutByte(codes, 0); + PutByte(0); INC(res) END; IF endianness = little_endian THEN - PutByte(codes, c MOD 256); - PutByte(codes, c DIV 256) + PutByte(c MOD 256); + PutByte(c DIV 256) ELSIF endianness = big_endian THEN - PutByte(codes, c DIV 256); - PutByte(codes, c MOD 256) + PutByte(c DIV 256); + PutByte(c MOD 256) END; - PutByte(codes, 0); - PutByte(codes, 0); + PutByte(0); + PutByte(0); codes.wcharoffs[c] := res ELSE @@ -935,18 +949,6 @@ BEGIN END flt; -PROCEDURE odd*; -BEGIN - AddCmd0(opODD) -END odd; - - -PROCEDURE ord*; -BEGIN - AddCmd0(opORD) -END ord; - - PROCEDURE shift_minmax* (op: CHAR); BEGIN CASE op OF @@ -1147,7 +1149,6 @@ BEGIN numRegsFloat := pNumRegsFloat; endianness := pEndianness; - NEW(codes); NEW(codes.begcall); codes.begcall.top := -1; NEW(codes.endcall); @@ -1179,4 +1180,4 @@ BEGIN END init; -END IL. \ No newline at end of file +END IL. diff --git a/programs/develop/oberon07/Source/KOS.ob07 b/programs/develop/oberon07/Source/KOS.ob07 index fe44eed0a..0e5e551ec 100644 --- a/programs/develop/oberon07/Source/KOS.ob07 +++ b/programs/develop/oberon07/Source/KOS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -215,4 +215,4 @@ BEGIN END write; -END KOS. \ No newline at end of file +END KOS. diff --git a/programs/develop/oberon07/Source/LISTS.ob07 b/programs/develop/oberon07/Source/LISTS.ob07 index 59b1342ca..34cfdebce 100644 --- a/programs/develop/oberon07/Source/LISTS.ob07 +++ b/programs/develop/oberon07/Source/LISTS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -199,4 +199,4 @@ BEGIN END create; -END LISTS. \ No newline at end of file +END LISTS. diff --git a/programs/develop/oberon07/Source/MSCOFF.ob07 b/programs/develop/oberon07/Source/MSCOFF.ob07 index 5abc8310d..0907a22b1 100644 --- a/programs/develop/oberon07/Source/MSCOFF.ob07 +++ b/programs/develop/oberon07/Source/MSCOFF.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -313,4 +313,4 @@ BEGIN END write; -END MSCOFF. \ No newline at end of file +END MSCOFF. diff --git a/programs/develop/oberon07/Source/MSP430.ob07 b/programs/develop/oberon07/Source/MSP430.ob07 index a2edaffab..b0ce4a052 100644 --- a/programs/develop/oberon07/Source/MSP430.ob07 +++ b/programs/develop/oberon07/Source/MSP430.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -582,7 +582,7 @@ BEGIN END Neg; -PROCEDURE translate (code: IL.CODES); +PROCEDURE translate; VAR cmd, next: COMMAND; @@ -593,7 +593,7 @@ VAR cc: INTEGER; BEGIN - cmd := code.commands.first(COMMAND); + cmd := IL.codes.commands.first(COMMAND); WHILE cmd # NIL DO @@ -1643,7 +1643,7 @@ BEGIN END WriteHex; -PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); VAR i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; @@ -1668,12 +1668,12 @@ BEGIN ram := MIN(MAX(ram, minRAM), maxRAM); rom := MIN(MAX(rom, minROM), maxROM); - IF code.bss > ram - minStackSize - RTL.VarSize THEN + IF IL.codes.bss > ram - minStackSize - RTL.VarSize THEN ERRORS.Error(204) END; Labels := CHL.CreateIntList(); - FOR i := 1 TO code.lcount DO + FOR i := 1 TO IL.codes.lcount DO CHL.PushInt(Labels, 0) END; @@ -1681,28 +1681,28 @@ BEGIN mem[i] := 0 END; - TypesSize := CHL.Length(code.types) * 2; + TypesSize := CHL.Length(IL.codes.types) * 2; CodeList := LISTS.create(NIL); RelList := LISTS.create(NIL); REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); prolog(ram); - translate(code); + translate; epilog; Code.address := 10000H - rom; Code.size := Fixup(Code.address, IntVectorSize + TypesSize); Data.address := Code.address + Code.size; - Data.size := CHL.Length(code.data); + Data.size := CHL.Length(IL.codes.data); Data.size := Data.size + ORD(ODD(Data.size)); TextSize := Code.size + Data.size; - IF Code.address + TextSize + MAX(code.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN + IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN ERRORS.Error(203) END; Bss.address := RTL.ram + RTL.VarSize; - Bss.size := code.bss + ORD(ODD(code.bss)); + Bss.size := IL.codes.bss + ORD(ODD(IL.codes.bss)); heap := Bss.address + Bss.size; stack := RTL.ram + ram; ASSERT(stack - heap >= minStackSize); @@ -1724,15 +1724,15 @@ BEGIN adr := Data.address; - FOR i := 0 TO CHL.Length(code.data) - 1 DO - mem[adr] := CHL.GetByte(code.data, i); + FOR i := 0 TO CHL.Length(IL.codes.data) - 1 DO + mem[adr] := CHL.GetByte(IL.codes.data, i); INC(adr) END; adr := 10000H - IntVectorSize - TypesSize; FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO - PutWord(CHL.GetInt(code.types, i), adr) + PutWord(CHL.GetInt(IL.codes.types, i), adr) END; FOR i := 0 TO 15 DO @@ -1790,4 +1790,4 @@ BEGIN END CodeGen; -END MSP430. \ No newline at end of file +END MSP430. diff --git a/programs/develop/oberon07/Source/MSP430RTL.ob07 b/programs/develop/oberon07/Source/MSP430RTL.ob07 index 86e4278c2..17c858b86 100644 --- a/programs/develop/oberon07/Source/MSP430RTL.ob07 +++ b/programs/develop/oberon07/Source/MSP430RTL.ob07 @@ -1,4 +1,4 @@ -п»ї(* +(* BSD 2-Clause License Copyright (c) 2019, Anton Krotov @@ -674,4 +674,4 @@ BEGIN END Init; -END MSP430RTL. \ No newline at end of file +END MSP430RTL. diff --git a/programs/develop/oberon07/Source/PARS.ob07 b/programs/develop/oberon07/Source/PARS.ob07 index 3f183a2c1..6694d6566 100644 --- a/programs/develop/oberon07/Source/PARS.ob07 +++ b/programs/develop/oberon07/Source/PARS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -77,6 +77,8 @@ VAR parsers: C.COLLECTION; + lines*: INTEGER; + PROCEDURE destroy* (VAR parser: PARSER); BEGIN @@ -1178,9 +1180,9 @@ BEGIN ExpectSym(parser, SCAN.lxIDENT); check1(parser.lex.s = unit.name.s, parser, 25); ExpectSym(parser, SCAN.lxPOINT) - END; + INC(lines, parser.lex.pos.line); PROG.closeUnit(unit) END parse; @@ -1248,8 +1250,9 @@ END create; PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS); BEGIN program := PROG.create(bit_depth, target, options); - parsers := C.create() + parsers := C.create(); + lines := 0 END init; -END PARS. \ No newline at end of file +END PARS. diff --git a/programs/develop/oberon07/Source/PATHS.ob07 b/programs/develop/oberon07/Source/PATHS.ob07 index e6ea79255..441051415 100644 --- a/programs/develop/oberon07/Source/PATHS.ob07 +++ b/programs/develop/oberon07/Source/PATHS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -106,4 +106,4 @@ BEGIN END GetCurrentDirectory; -END PATHS. \ No newline at end of file +END PATHS. diff --git a/programs/develop/oberon07/Source/PE32.ob07 b/programs/develop/oberon07/Source/PE32.ob07 index 18a77bb66..6dc88d8b7 100644 --- a/programs/develop/oberon07/Source/PE32.ob07 +++ b/programs/develop/oberon07/Source/PE32.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -28,8 +28,8 @@ CONST (* SectionHeader.Characteristics *) SHC_text = 060000020H; - SHC_data = 0C0000040H; - SHC_bss = 0C00000C0H; + SHC_data = 040000040H; + SHC_bss = 0C0000080H; SectionAlignment = 1000H; FileAlignment = 200H; @@ -372,7 +372,7 @@ BEGIN END WriteFileHeader; -PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; BaseAddress: INTEGER; console, dll, amd64: BOOLEAN); +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN); VAR i, n: INTEGER; @@ -382,6 +382,8 @@ VAR END; + BaseAddress: INTEGER; + Address: VIRTUAL_ADDR; File: FILE; @@ -504,6 +506,12 @@ BEGIN Size.Bss := program.bss; Size.Stack := program.stack; + IF dll THEN + BaseAddress := 10000000H + ELSE + BaseAddress := 400000H + END; + PEHeader.Signature[0] := 50H; PEHeader.Signature[1] := 45H; PEHeader.Signature[2] := 0; @@ -556,7 +564,7 @@ BEGIN InitSection(SectionHeaders[0], ".text", SHC_text); SectionHeaders[0].VirtualSize := Size.Code; - SectionHeaders[0].VirtualAddress := 1000H; + SectionHeaders[0].VirtualAddress := SectionAlignment; SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment); SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders; @@ -730,4 +738,4 @@ BEGIN END write; -END PE32. \ No newline at end of file +END PE32. diff --git a/programs/develop/oberon07/Source/PROG.ob07 b/programs/develop/oberon07/Source/PROG.ob07 index a5e090126..cb9804b19 100644 --- a/programs/develop/oberon07/Source/PROG.ob07 +++ b/programs/develop/oberon07/Source/PROG.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -24,9 +24,9 @@ CONST tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4; tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8; tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12; - tCARD16* = 13; tCARD32* = 14; tANYREC* = 15; tWCHAR* = 16; + tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; - BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD16, tCARD32, tWCHAR}; + BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR}; stABS* = 1; stASR* = 2; stCHR* = 3; stFLOOR* = 4; stFLT* = 5; stLEN* = 6; stLSL* = 7; stODD* = 8; @@ -72,7 +72,7 @@ TYPE OPTIONS* = RECORD - version*, stack*, base*, ram*, rom*: INTEGER; + version*, stack*, ram*, rom*: INTEGER; pic*: BOOLEAN; checking*: SET @@ -205,7 +205,7 @@ TYPE stTypes*: RECORD tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, - tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_ + tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_ END; @@ -254,23 +254,27 @@ VAR BEGIN IF varIdent.offset = -1 THEN + size := varIdent.type.size; IF varIdent.global THEN IF UTILS.Align(program.bss, varIdent.type.align) THEN - IF UTILS.maxint - program.bss >= varIdent.type.size THEN + IF UTILS.maxint - program.bss >= size THEN varIdent.offset := program.bss; - INC(program.bss, varIdent.type.size) + INC(program.bss, size) END END ELSE word := program.target.word; - size := varIdent.type.size; IF UTILS.Align(size, word) THEN size := size DIV word; IF UTILS.maxint - program.locsize >= size THEN INC(program.locsize, size); - varIdent.offset := program.locsize; + varIdent.offset := program.locsize END END + END; + + IF varIdent.offset = -1 THEN + ERRORS.Error(204) END END @@ -509,7 +513,6 @@ BEGIN END; DEC(unit.scopeLvl) - END closeScope; @@ -631,6 +634,13 @@ PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN; END isOpenArray; +PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN; + RETURN (dst.typ = tARRAY) & isOpenArray(src) & + ~isOpenArray(src.base) & ~isOpenArray(dst.base) & + isTypeEq(src.base, dst.base) +END arrcomp; + + PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; VAR item: UNIT; @@ -1059,25 +1069,15 @@ VAR BEGIN - IF typ = ARITH.tINTEGER THEN - res := program.stTypes.tINTEGER - ELSIF typ = ARITH.tREAL THEN - res := program.stTypes.tREAL - ELSIF typ = ARITH.tSET THEN - res := program.stTypes.tSET - ELSIF typ = ARITH.tBOOLEAN THEN - res := program.stTypes.tBOOLEAN - ELSIF typ = ARITH.tCHAR THEN - res := program.stTypes.tCHAR - ELSIF typ = ARITH.tWCHAR THEN - res := program.stTypes.tWCHAR - ELSIF typ = ARITH.tSTRING THEN - res := program.stTypes.tSTRING - ELSE - res := NIL - END; - - ASSERT(res # NIL) + CASE typ OF + |ARITH.tINTEGER: res := program.stTypes.tINTEGER + |ARITH.tREAL: res := program.stTypes.tREAL + |ARITH.tSET: res := program.stTypes.tSET + |ARITH.tBOOLEAN: res := program.stTypes.tBOOLEAN + |ARITH.tCHAR: res := program.stTypes.tCHAR + |ARITH.tWCHAR: res := program.stTypes.tWCHAR + |ARITH.tSTRING: res := program.stTypes.tSTRING + END RETURN res END getType; @@ -1126,10 +1126,6 @@ BEGIN EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); EnterProc(unit, "COPY", idSYSPROC, sysCOPY); - ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE); - ident.type := program.stTypes.tCARD16; - ident.export := TRUE; - ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); ident.type := program.stTypes.tCARD32; ident.export := TRUE @@ -1248,7 +1244,6 @@ BEGIN IF target # mConst.Target_iMSP430 THEN program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); - program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL); program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL) END; @@ -1267,7 +1262,6 @@ BEGIN IF target # mConst.Target_iMSP430 THEN program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; program.stTypes.tREAL.align := program.stTypes.tREAL.size; - program.stTypes.tCARD16.align := program.stTypes.tCARD16.size; program.stTypes.tCARD32.align := program.stTypes.tCARD32.size END; @@ -1280,4 +1274,4 @@ BEGIN END create; -END PROG. \ No newline at end of file +END PROG. diff --git a/programs/develop/oberon07/Source/REG.ob07 b/programs/develop/oberon07/Source/REG.ob07 index b77aebf4e..f5abb0f2c 100644 --- a/programs/develop/oberon07/Source/REG.ob07 +++ b/programs/develop/oberon07/Source/REG.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -293,10 +293,8 @@ PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER); BEGIN ASSERT(reg IN R.vregs); ASSERT(offs # 0); + ASSERT(size IN {1, 2, 4, 8}); R.offs[reg] := offs; - IF size = 0 THEN - size := 8 - END; R.size[reg] := size END Lock; @@ -437,4 +435,4 @@ BEGIN END Init; -END REG. \ No newline at end of file +END REG. diff --git a/programs/develop/oberon07/Source/SCAN.ob07 b/programs/develop/oberon07/Source/SCAN.ob07 index 91de0575a..e6c0aef06 100644 --- a/programs/develop/oberon07/Source/SCAN.ob07 +++ b/programs/develop/oberon07/Source/SCAN.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -51,7 +51,8 @@ TYPE IDENT* = POINTER TO RECORD (AVL.DATA) s*: LEXSTR; - offset*, offsetW*: INTEGER + offset*, offsetW*: INTEGER; + key: INTEGER END; @@ -78,19 +79,14 @@ TYPE SCANNER* = TXT.TEXT; - KEYWORD = ARRAY 10 OF CHAR; - VAR - vocabulary: RECORD + idents: AVL.NODE; - KW: ARRAY 33 OF KEYWORD; - delimiters: ARRAY 256 OF BOOLEAN; - idents: AVL.NODE; - ident: IDENT + delimiters: ARRAY 256 OF BOOLEAN; - END; + NewIdent: IDENT; upto: BOOLEAN; @@ -100,46 +96,20 @@ PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; END nodecmp; -PROCEDURE key (VAR lex: LEX); -VAR - L, R, M: INTEGER; - found: BOOLEAN; - -BEGIN - L := 0; - R := LEN(vocabulary.KW) - 1; - found := FALSE; - - REPEAT - M := (L + R) DIV 2; - - IF lex.s # vocabulary.KW[M] THEN - IF lex.s > vocabulary.KW[M] THEN - L := M + 1 - ELSE - R := M - 1 - END - ELSE - found := TRUE; - lex.sym := lxKW + M - END - UNTIL found OR (L > R) -END key; - - PROCEDURE enterid* (s: LEXSTR): IDENT; VAR newnode: BOOLEAN; node: AVL.NODE; BEGIN - vocabulary.ident.s := s; - vocabulary.idents := AVL.insert(vocabulary.idents, vocabulary.ident, nodecmp, newnode, node); + NewIdent.s := s; + idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node); IF newnode THEN - NEW(vocabulary.ident); - vocabulary.ident.offset := -1; - vocabulary.ident.offsetW := -1 + NEW(NewIdent); + NewIdent.offset := -1; + NewIdent.offsetW := -1; + NewIdent.key := 0 END RETURN node.data(IDENT) @@ -181,12 +151,12 @@ BEGIN IF lex.over THEN lex.sym := lxERROR06 ELSE - lex.sym := lxIDENT; - key(lex) - END; - - IF lex.sym = lxIDENT THEN - lex.ident := enterid(lex.s) + lex.ident := enterid(lex.s); + IF lex.ident.key # 0 THEN + lex.sym := lex.ident.key + ELSE + lex.sym := lxIDENT + END END END ident; @@ -518,7 +488,7 @@ BEGIN number(text, lex) ELSIF (c = '"') OR (c = "'") THEN string(text, lex, c) - ELSIF vocabulary.delimiters[ORD(c)] THEN + ELSIF delimiters[ORD(c)] THEN delimiter(text, lex, c) ELSIF c = 0X THEN lex.sym := lxEOF; @@ -566,10 +536,13 @@ VAR delim: ARRAY 23 OF CHAR; - PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD); + PROCEDURE enterkw (key: INTEGER; kw: LEXSTR); + VAR + id: IDENT; + BEGIN - vocabulary.KW[i] := kw; - INC(i) + id := enterid(kw); + id.key := key END enterkw; @@ -577,58 +550,60 @@ BEGIN upto := FALSE; FOR i := 0 TO 255 DO - vocabulary.delimiters[i] := FALSE + delimiters[i] := FALSE END; delim := "+-*/~&.,;|([{^=#<>:)]}"; FOR i := 0 TO LEN(delim) - 2 DO - vocabulary.delimiters[ORD(delim[i])] := TRUE + delimiters[ORD(delim[i])] := TRUE END; - i := 0; - enterkw(i, "ARRAY"); - enterkw(i, "BEGIN"); - enterkw(i, "BY"); - enterkw(i, "CASE"); - enterkw(i, "CONST"); - enterkw(i, "DIV"); - enterkw(i, "DO"); - enterkw(i, "ELSE"); - enterkw(i, "ELSIF"); - enterkw(i, "END"); - enterkw(i, "FALSE"); - enterkw(i, "FOR"); - enterkw(i, "IF"); - enterkw(i, "IMPORT"); - enterkw(i, "IN"); - enterkw(i, "IS"); - enterkw(i, "MOD"); - enterkw(i, "MODULE"); - enterkw(i, "NIL"); - enterkw(i, "OF"); - enterkw(i, "OR"); - enterkw(i, "POINTER"); - enterkw(i, "PROCEDURE"); - enterkw(i, "RECORD"); - enterkw(i, "REPEAT"); - enterkw(i, "RETURN"); - enterkw(i, "THEN"); - enterkw(i, "TO"); - enterkw(i, "TRUE"); - enterkw(i, "TYPE"); - enterkw(i, "UNTIL"); - enterkw(i, "VAR"); - enterkw(i, "WHILE"); + NEW(NewIdent); + NewIdent.s := ""; + NewIdent.offset := -1; + NewIdent.offsetW := -1; + NewIdent.key := 0; + + idents := NIL; + + enterkw(lxARRAY, "ARRAY"); + enterkw(lxBEGIN, "BEGIN"); + enterkw(lxBY, "BY"); + enterkw(lxCASE, "CASE"); + enterkw(lxCONST, "CONST"); + enterkw(lxDIV, "DIV"); + enterkw(lxDO, "DO"); + enterkw(lxELSE, "ELSE"); + enterkw(lxELSIF, "ELSIF"); + enterkw(lxEND, "END"); + enterkw(lxFALSE, "FALSE"); + enterkw(lxFOR, "FOR"); + enterkw(lxIF, "IF"); + enterkw(lxIMPORT, "IMPORT"); + enterkw(lxIN, "IN"); + enterkw(lxIS, "IS"); + enterkw(lxMOD, "MOD"); + enterkw(lxMODULE, "MODULE"); + enterkw(lxNIL, "NIL"); + enterkw(lxOF, "OF"); + enterkw(lxOR, "OR"); + enterkw(lxPOINTER, "POINTER"); + enterkw(lxPROCEDURE, "PROCEDURE"); + enterkw(lxRECORD, "RECORD"); + enterkw(lxREPEAT, "REPEAT"); + enterkw(lxRETURN, "RETURN"); + enterkw(lxTHEN, "THEN"); + enterkw(lxTO, "TO"); + enterkw(lxTRUE, "TRUE"); + enterkw(lxTYPE, "TYPE"); + enterkw(lxUNTIL, "UNTIL"); + enterkw(lxVAR, "VAR"); + enterkw(lxWHILE, "WHILE") - NEW(vocabulary.ident); - vocabulary.ident.s := ""; - vocabulary.ident.offset := -1; - vocabulary.ident.offsetW := -1; - vocabulary.idents := NIL END init; BEGIN init -END SCAN. \ No newline at end of file +END SCAN. diff --git a/programs/develop/oberon07/Source/STATEMENTS.ob07 b/programs/develop/oberon07/Source/STATEMENTS.ob07 index 8f53dd80c..c263d4f49 100644 --- a/programs/develop/oberon07/Source/STATEMENTS.ob07 +++ b/programs/develop/oberon07/Source/STATEMENTS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -267,17 +267,10 @@ PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN; VAR res: BOOLEAN; - - PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; - RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & - ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & - PROG.isTypeEq(src.base, dst.base) - END arrcomp; - - BEGIN IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN - IF arrcomp(e.type, t) THEN + + IF t = e.type THEN res := TRUE ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN IF (e.obj = eCONST) & (t = tBYTE) THEN @@ -285,29 +278,16 @@ BEGIN ELSE res := TRUE END - ELSIF isSet(e) & (t = tSET) THEN - res := TRUE - ELSIF isBoolean(e) & (t = tBOOLEAN) THEN - res := TRUE - ELSIF isReal(e) & (t = tREAL) THEN - res := TRUE - ELSIF isChar(e) & (t = tCHAR) THEN - res := TRUE - ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) THEN - res := TRUE - ELSIF isStringW1(e) & (t = tWCHAR) THEN - res := TRUE - ELSIF isCharW(e) & (t = tWCHAR) THEN - res := TRUE - ELSIF PROG.isBaseOf(t, e.type) THEN - res := TRUE - ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN - res := TRUE - ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN - res := TRUE - ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))) THEN - res := TRUE - ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))) THEN + ELSIF + (e.obj = eCONST) & isChar(e) & (t = tWCHAR) + OR isStringW1(e) & (t = tWCHAR) + OR PROG.isBaseOf(t, e.type) + OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) + OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) + OR PROG.arrcomp(e.type, t) + OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e)) + OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e)) + THEN res := TRUE ELSE res := FALSE @@ -315,6 +295,7 @@ BEGIN ELSE res := FALSE END + RETURN res END assigncomp; @@ -384,18 +365,10 @@ VAR res: BOOLEAN; label: INTEGER; - - PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; - RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & - ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & - PROG.isTypeEq(src.base, dst.base) - END arrcomp; - - BEGIN IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN res := TRUE; - IF arrcomp(e.type, VarType) THEN + IF PROG.arrcomp(e.type, VarType) THEN IF ~PROG.isOpenArray(VarType) THEN IL.Const(VarType.length) @@ -470,8 +443,6 @@ BEGIN END ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN IL.AddCmd0(IL.opSAVE32) - ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN - IL.AddCmd0(IL.opSAVE16) ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN IF e.obj = ePROC THEN IL.AssignProc(e.ident.proc.label) @@ -642,7 +613,7 @@ BEGIN stroffs := StringW(e); IL.StrAdr(stroffs) END; - IL.codes.dmin := stroffs + p.type.size; + IL.set_dmin(stroffs + p.type.size); IL.Param1 ELSE LoadConst(e); @@ -934,7 +905,7 @@ BEGIN END ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN - PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, pos, 66); + PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66); IF e2.obj = eCONST THEN LoadConst(e2) END; @@ -1142,7 +1113,7 @@ BEGIN IF e.obj = eCONST THEN ARITH.odd(e.value) ELSE - IL.odd + IL.AddCmd0(IL.opODD) END |PROG.stORD: @@ -1156,7 +1127,7 @@ BEGIN END ELSE IF isBoolean(e) THEN - IL.ord + IL.AddCmd0(IL.opORD) END END; e.type := tINTEGER @@ -3257,10 +3228,10 @@ VAR id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); IF (id # NIL) & (id.import # NIL) THEN - IL.codes.rtl[idx] := -id.import(IL.IMPORT_PROC).label; + IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label); id.proc.used := TRUE ELSIF (id # NIL) & (id.proc # NIL) THEN - IL.codes.rtl[idx] := id.proc.label; + IL.set_rtl(idx, id.proc.label); id.proc.used := TRUE ELSE ERRORS.WrongRTL(name) @@ -3276,7 +3247,6 @@ BEGIN getproc(rtl, "_strcmp", IL._strcmp); getproc(rtl, "_length", IL._length); getproc(rtl, "_arrcpy", IL._arrcpy); - getproc(rtl, "_move", IL._move); getproc(rtl, "_is", IL._is); getproc(rtl, "_guard", IL._guard); getproc(rtl, "_guardrec", IL._guardrec); @@ -3284,13 +3254,10 @@ BEGIN getproc(rtl, "_new", IL._new); getproc(rtl, "_rot", IL._rot); getproc(rtl, "_strcpy", IL._strcpy); - getproc(rtl, "_move2", IL._move2); - getproc(rtl, "_div2", IL._div2); - getproc(rtl, "_mod2", IL._mod2); - getproc(rtl, "_div", IL._div); - getproc(rtl, "_mod", IL._mod); + getproc(rtl, "_move", IL._move); + getproc(rtl, "_divmod", IL._divmod); getproc(rtl, "_set", IL._set); - getproc(rtl, "_set2", IL._set2); + getproc(rtl, "_set1", IL._set1); getproc(rtl, "_isrec", IL._isrec); getproc(rtl, "_lengthw", IL._lengthw); getproc(rtl, "_strcmpw", IL._strcmpw); @@ -3339,9 +3306,9 @@ BEGIN 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) + |cpuAMD64: IL.init(6, IL.little_endian) + |cpuX86: IL.init(8, IL.little_endian) + |cpuMSP430: IL.init(0, IL.little_endian) END; IF CPU # cpuMSP430 THEN @@ -3382,15 +3349,15 @@ BEGIN PROG.DelUnused(PARS.program, IL.DelImport); - IL.codes.bss := PARS.program.bss; + IL.set_bss(PARS.program.bss); CASE CPU OF - | cpuAMD64: AMD64.CodeGen(IL.codes, outname, target, options) - | cpuX86: X86.CodeGen(IL.codes, outname, target, options) - |cpuMSP430: MSP430.CodeGen(IL.codes, outname, target, options) + | cpuAMD64: AMD64.CodeGen(outname, target, options) + | cpuX86: X86.CodeGen(outname, target, options) + |cpuMSP430: MSP430.CodeGen(outname, target, options) END END compile; -END STATEMENTS. \ No newline at end of file +END STATEMENTS. diff --git a/programs/develop/oberon07/Source/STRINGS.ob07 b/programs/develop/oberon07/Source/STRINGS.ob07 index 2905c08b8..2ab48c5e7 100644 --- a/programs/develop/oberon07/Source/STRINGS.ob07 +++ b/programs/develop/oberon07/Source/STRINGS.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -311,4 +311,4 @@ BEGIN END Utf8To16; -END STRINGS. \ No newline at end of file +END STRINGS. diff --git a/programs/develop/oberon07/Source/TEXTDRV.ob07 b/programs/develop/oberon07/Source/TEXTDRV.ob07 index 583878239..4e75c78db 100644 --- a/programs/develop/oberon07/Source/TEXTDRV.ob07 +++ b/programs/develop/oberon07/Source/TEXTDRV.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -21,7 +21,7 @@ TYPE TEXT* = POINTER TO RECORD (C.ITEM) - chunk: ARRAY CHUNK OF BYTE; + chunk: ARRAY CHUNK OF CHAR; pos, size: INTEGER; file: FILES.FILE; utf8: BOOLEAN; @@ -47,9 +47,9 @@ BEGIN text.pos := 0; IF text.size = 0 THEN text.eof := TRUE; - text.chunk[0] := 0 + text.chunk[0] := 0X END; - text.peak := CHR(text.chunk[0]) + text.peak := text.chunk[0] END END load; @@ -61,7 +61,7 @@ VAR BEGIN IF text.pos < text.size - 1 THEN INC(text.pos); - text.peak := CHR(text.chunk[text.pos]) + text.peak := text.chunk[text.pos] ELSE load(text) END; @@ -87,7 +87,7 @@ BEGIN ELSE text.eol := FALSE; IF text.utf8 THEN - IF (c < 80X) OR (c > 0BFX) THEN + IF ORD(c) DIV 64 # 2 THEN INC(text.col) END ELSE @@ -104,16 +104,16 @@ END next; PROCEDURE init (text: TEXT); BEGIN IF (text.pos = 0) & (text.size >= 3) THEN - IF (text.chunk[0] = 0EFH) & - (text.chunk[1] = 0BBH) & - (text.chunk[2] = 0BFH) THEN + IF (text.chunk[0] = 0EFX) & + (text.chunk[1] = 0BBX) & + (text.chunk[2] = 0BFX) THEN text.pos := 3; text.utf8 := TRUE END END; IF text.size = 0 THEN - text.chunk[0] := 0; + text.chunk[0] := 0X; text.size := 1; text.eof := FALSE END; @@ -121,7 +121,7 @@ BEGIN text.line := 1; text.col := 1; - text.peak := CHR(text.chunk[text.pos]) + text.peak := text.chunk[text.pos] END init; @@ -152,7 +152,7 @@ BEGIN END; IF text # NIL THEN - text.chunk[0] := 0; + text.chunk[0] := 0X; text.pos := 0; text.size := 0; text.utf8 := FALSE; @@ -177,4 +177,4 @@ END open; BEGIN texts := C.create() -END TEXTDRV. \ No newline at end of file +END TEXTDRV. diff --git a/programs/develop/oberon07/Source/UTILS.ob07 b/programs/develop/oberon07/Source/UTILS.ob07 index c31ac8189..e64b440ec 100644 --- a/programs/develop/oberon07/Source/UTILS.ob07 +++ b/programs/develop/oberon07/Source/UTILS.ob07 @@ -1,13 +1,13 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) MODULE UTILS; -IMPORT HOST, UNIXTIME; +IMPORT HOST; CONST @@ -24,6 +24,11 @@ CONST max32* = 2147483647; +TYPE + + DAYS = ARRAY 12, 31, 2 OF INTEGER; + + VAR time*: INTEGER; @@ -48,8 +53,10 @@ VAR bit_diff*: INTEGER; + days: DAYS; -PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; RETURN HOST.FileRead(F, Buffer, bytes) END FileRead; @@ -114,6 +121,11 @@ BEGIN END GetCurrentDirectory; +PROCEDURE GetUnixTime* (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 GetUnixTime; + + PROCEDURE UnixTime* (): INTEGER; VAR year, month, day, hour, min, sec: INTEGER; @@ -124,7 +136,7 @@ BEGIN res := HOST.UnixTime() ELSE HOST.now(year, month, day, hour, min, sec); - res := UNIXTIME.time(year, month, day, hour, min, sec) + res := GetUnixTime(year, month, day, hour, min, sec) END RETURN res @@ -201,9 +213,52 @@ BEGIN END Log2; +PROCEDURE init (VAR days: DAYS); +VAR + i, j, n0, n1: INTEGER; + +BEGIN + + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + days[i, j, 0] := 0; + days[i, j, 1] := 0; + END + END; + + days[ 1, 28, 0] := -1; + + FOR i := 0 TO 1 DO + days[ 1, 29, i] := -1; + days[ 1, 30, i] := -1; + days[ 3, 30, i] := -1; + days[ 5, 30, i] := -1; + days[ 8, 30, i] := -1; + days[10, 30, i] := -1; + END; + + n0 := 0; + n1 := 0; + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + IF days[i, j, 0] = 0 THEN + days[i, j, 0] := n0; + INC(n0) + END; + IF days[i, j, 1] = 0 THEN + days[i, j, 1] := n1; + INC(n1) + END + END + END + +END init; + + BEGIN time := GetTickCount(); COPY(HOST.eol, eol); maxreal := 1.9; - PACK(maxreal, 1023) -END UTILS. \ No newline at end of file + PACK(maxreal, 1023); + init(days) +END UTILS. diff --git a/programs/develop/oberon07/Source/WRITER.ob07 b/programs/develop/oberon07/Source/WRITER.ob07 index 4781013bd..985f9ddaa 100644 --- a/programs/develop/oberon07/Source/WRITER.ob07 +++ b/programs/develop/oberon07/Source/WRITER.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -108,4 +108,4 @@ BEGIN END Close; -END WRITER. \ No newline at end of file +END WRITER. diff --git a/programs/develop/oberon07/Source/X86.ob07 b/programs/develop/oberon07/Source/X86.ob07 index fde3b94b4..af8fa4220 100644 --- a/programs/develop/oberon07/Source/X86.ob07 +++ b/programs/develop/oberon07/Source/X86.ob07 @@ -1,7 +1,7 @@ -п»ї(* +(* BSD 2-Clause License - Copyright (c) 2018, 2019, Anton Krotov + Copyright (c) 2018-2019, Anton Krotov All rights reserved. *) @@ -573,7 +573,7 @@ BEGIN END GetRegA; -PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER); +PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER); VAR cmd: COMMAND; @@ -586,7 +586,7 @@ VAR float: REAL; BEGIN - cmd := code.commands.first(COMMAND); + cmd := IL.codes.commands.first(COMMAND); WHILE cmd # NIL DO @@ -1186,27 +1186,29 @@ BEGIN |8: PushAll(0); - push(reg2); push(reg1); + push(reg2); pushc(8); CallRTL(pic, IL._move) END |IL.opSAVES: - UnOp(reg1); - drop; - PushAll(0); - push(reg1); + UnOp(reg2); + REG.PushAll_1(R); IF pic THEN + reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, stroffs + param2); - push(reg1) + push(reg1); + drop ELSE OutByte(068H); // push _data + stroffs + param2 Reloc(BIN.RDATA, stroffs + param2); END; + push(reg2); + drop; pushc(param1); CallRTL(pic, IL._move) @@ -1458,16 +1460,17 @@ BEGIN GetRegA |IL.opRSETL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(pic, IL._set2); + push(reg1); + drop; + CallRTL(pic, IL._set); GetRegA |IL.opRSET1: - UnOp(reg1); PushAll(1); - push(reg1); - CallRTL(pic, IL._set); + CallRTL(pic, IL._set1); GetRegA |IL.opINCL, IL.opEXCL: @@ -1497,7 +1500,7 @@ BEGIN |IL.opDIV: PushAll(2); - CallRTL(pic, IL._div); + CallRTL(pic, IL._divmod); GetRegA |IL.opDIVR: @@ -1540,20 +1543,24 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(pic, IL._div); + CallRTL(pic, IL._divmod); GetRegA END END |IL.opDIVL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(pic, IL._div2); + push(reg1); + drop; + CallRTL(pic, IL._divmod); GetRegA |IL.opMOD: PushAll(2); - CallRTL(pic, IL._mod); + CallRTL(pic, IL._divmod); + mov(eax, edx); GetRegA |IL.opMODR: @@ -1589,15 +1596,20 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(pic, IL._mod); + CallRTL(pic, IL._divmod); + mov(eax, edx); GetRegA END END |IL.opMODL: - PushAll(1); + UnOp(reg1); + REG.PushAll_1(R); pushc(param2); - CallRTL(pic, IL._mod2); + push(reg1); + drop; + CallRTL(pic, IL._divmod); + mov(eax, edx); GetRegA |IL.opERR: @@ -1613,11 +1625,11 @@ BEGIN |IL.opCOPY: PushAll(2); pushc(param2); - CallRTL(pic, IL._move2) + CallRTL(pic, IL._move) |IL.opMOVE: PushAll(3); - CallRTL(pic, IL._move2) + CallRTL(pic, IL._move) |IL.opCOPYA: PushAll(4); @@ -2075,9 +2087,9 @@ BEGIN END translate; -PROCEDURE prolog (code: IL.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); +PROCEDURE prolog (pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); VAR - reg1, entry, dcount: INTEGER; + reg1, entry, L, dcount: INTEGER; BEGIN @@ -2131,7 +2143,7 @@ BEGIN Reloc(BIN.RDATA, 0) END; - dcount := CHL.Length(code.data); + dcount := CHL.Length(IL.codes.data); pushc(tcount); @@ -2145,11 +2157,26 @@ BEGIN Reloc(BIN.RDATA, tcount * 4 + dcount) END; - CallRTL(pic, IL._init) + CallRTL(pic, IL._init); + + IF target = mConst.Target_iELF32 THEN + L := NewLabel(); + pushc(0); + push(esp); + pushc(1024 * 1024 * stack); + pushc(0); + CallRTL(pic, IL._new); + pop(eax); + test(eax); + jcc(je, L); + addrc(eax, 1024 * 1024 * stack - 4); + mov(esp, eax); + SetLabel(L) + END END prolog; -PROCEDURE epilog (code: IL.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER); +PROCEDURE epilog (pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER); VAR exp: IL.EXPORT_PROC; path, name, ext: PATHS.PATH; @@ -2200,14 +2227,14 @@ BEGIN fixup; - dcount := CHL.Length(code.data); + dcount := CHL.Length(IL.codes.data); FOR i := 0 TO tcount - 1 DO - BIN.PutData32LE(program, CHL.GetInt(code.types, i)) + BIN.PutData32LE(program, CHL.GetInt(IL.codes.types, i)) END; FOR i := 0 TO dcount - 1 DO - BIN.PutData(program, CHL.GetByte(code.data, i)) + BIN.PutData(program, CHL.GetByte(IL.codes.data, i)) END; program.modname := CHL.Length(program.data); @@ -2221,33 +2248,33 @@ BEGIN BIN.Export(program, "lib_init", dllinit); END; - exp := code.export.first(IL.EXPORT_PROC); + exp := IL.codes.export.first(IL.EXPORT_PROC); WHILE exp # NIL DO BIN.Export(program, exp.name, exp.label); exp := exp.next(IL.EXPORT_PROC) END; - import(code.import); + import(IL.codes.import); - code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 4)); + IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); - BIN.SetParams(program, code.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); + BIN.SetParams(program, IL.codes.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); END epilog; -PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); VAR dllret, dllinit, sofinit: INTEGER; opt: PROG.OPTIONS; BEGIN - tcount := CHL.Length(code.types); + tcount := CHL.Length(IL.codes.types); opt := options; CodeList := LISTS.create(NIL); - program := BIN.create(code.lcount); + program := BIN.create(IL.codes.lcount); dllinit := NewLabel(); dllret := NewLabel(); @@ -2263,14 +2290,14 @@ BEGIN REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); - prolog(code, opt.pic, target, opt.stack, dllinit, dllret); - translate(code, opt.pic, tcount * 4); - epilog(code, opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); + prolog(opt.pic, target, opt.stack, dllinit, dllret); + translate(opt.pic, tcount * 4); + epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); BIN.fixup(program); IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN - PE32.write(program, outname, opt.base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) + PE32.write(program, outname, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) ELSIF target = mConst.Target_iKolibri THEN KOS.write(program, outname) ELSIF target = mConst.Target_iObject THEN @@ -2289,4 +2316,4 @@ BEGIN END SetProgram; -END X86. \ No newline at end of file +END X86.