| /programs/develop/oberon07/doc/Oberon07.Report_2016_05_03.pdf |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Deleted: svn:mime-type |
| -application/octet-stream |
| \ No newline at end of property |
| /programs/develop/oberon07/doc/x86_64.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/doc/KOSLib.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/doc/WinLib.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/doc/x86.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/doc/CC.txt |
|---|
| File deleted |
| /programs/develop/oberon07/doc/MSP430.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/doc/STM32.txt |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/tools/RVM32I.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Compiler |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| /programs/develop/oberon07/Compiler.exe |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| /programs/develop/oberon07/Compiler.kex |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| /programs/develop/oberon07/Docs/KOSLib.txt |
|---|
| 0,0 → 1,566 |
| ============================================================================== |
| Библиотека (KolibriOS) |
| ------------------------------------------------------------------------------ |
| MODULE Out - консольный вывод |
| PROCEDURE Open |
| формально открывает консольный вывод |
| PROCEDURE Int(x, width: INTEGER) |
| вывод целого числа x; |
| width - количество знакомест, используемых для вывода |
| PROCEDURE Real(x: REAL; width: INTEGER) |
| вывод вещественного числа x в плавающем формате; |
| width - количество знакомест, используемых для вывода |
| PROCEDURE Char(x: CHAR) |
| вывод символа x |
| PROCEDURE FixReal(x: REAL; width, p: INTEGER) |
| вывод вещественного числа x в фиксированном формате; |
| width - количество знакомест, используемых для вывода; |
| p - количество знаков после десятичной точки |
| PROCEDURE Ln |
| переход на следующую строку |
| PROCEDURE String(s: ARRAY OF CHAR) |
| вывод строки s |
| ------------------------------------------------------------------------------ |
| MODULE In - консольный ввод |
| VAR Done: BOOLEAN |
| принимает значение TRUE в случае успешного выполнения |
| операции ввода, иначе FALSE |
| PROCEDURE Open |
| формально открывает консольный ввод, |
| также присваивает переменной Done значение TRUE |
| PROCEDURE Int(VAR x: INTEGER) |
| ввод числа типа INTEGER |
| PROCEDURE Char(VAR x: CHAR) |
| ввод символа |
| PROCEDURE Real(VAR x: REAL) |
| ввод числа типа REAL |
| PROCEDURE String(VAR s: ARRAY OF CHAR) |
| ввод строки |
| PROCEDURE Ln |
| ожидание нажатия ENTER |
| ------------------------------------------------------------------------------ |
| MODULE Console - дополнительные процедуры консольного вывода |
| CONST |
| Следующие константы определяют цвет консольного вывода |
| Black = 0 Blue = 1 Green = 2 |
| Cyan = 3 Red = 4 Magenta = 5 |
| Brown = 6 LightGray = 7 DarkGray = 8 |
| LightBlue = 9 LightGreen = 10 LightCyan = 11 |
| LightRed = 12 LightMagenta = 13 Yellow = 14 |
| White = 15 |
| PROCEDURE Cls |
| очистка окна консоли |
| PROCEDURE SetColor(FColor, BColor: INTEGER) |
| установка цвета консольного вывода: FColor - цвет текста, |
| BColor - цвет фона, возможные значения - вышеперечисленные |
| константы |
| PROCEDURE SetCursor(x, y: INTEGER) |
| установка курсора консоли в позицию (x, y) |
| PROCEDURE GetCursor(VAR x, y: INTEGER) |
| записывает в параметры текущие координаты курсора консоли |
| PROCEDURE GetCursorX(): INTEGER |
| возвращает текущую x-координату курсора консоли |
| PROCEDURE GetCursorY(): INTEGER |
| возвращает текущую y-координату курсора консоли |
| ------------------------------------------------------------------------------ |
| MODULE ConsoleLib - обертка библиотеки console.obj |
| ------------------------------------------------------------------------------ |
| MODULE Math - математические функции |
| CONST |
| pi = 3.141592653589793E+00 |
| e = 2.718281828459045E+00 |
| PROCEDURE IsNan(x: REAL): BOOLEAN |
| возвращает TRUE, если x - не число |
| PROCEDURE IsInf(x: REAL): BOOLEAN |
| возвращает TRUE, если x - бесконечность |
| PROCEDURE sqrt(x: REAL): REAL |
| квадратный корень x |
| PROCEDURE exp(x: REAL): REAL |
| экспонента x |
| PROCEDURE ln(x: REAL): REAL |
| натуральный логарифм x |
| PROCEDURE sin(x: REAL): REAL |
| синус x |
| PROCEDURE cos(x: REAL): REAL |
| косинус x |
| PROCEDURE tan(x: REAL): REAL |
| тангенс x |
| PROCEDURE arcsin(x: REAL): REAL |
| арксинус x |
| PROCEDURE arccos(x: REAL): REAL |
| арккосинус x |
| PROCEDURE arctan(x: REAL): REAL |
| арктангенс x |
| PROCEDURE arctan2(y, x: REAL): REAL |
| арктангенс y/x |
| PROCEDURE power(base, exponent: REAL): REAL |
| возведение числа base в степень exponent |
| PROCEDURE log(base, x: REAL): REAL |
| логарифм x по основанию base |
| PROCEDURE sinh(x: REAL): REAL |
| гиперболический синус x |
| PROCEDURE cosh(x: REAL): REAL |
| гиперболический косинус x |
| PROCEDURE tanh(x: REAL): REAL |
| гиперболический тангенс x |
| PROCEDURE arsinh(x: REAL): REAL |
| обратный гиперболический синус x |
| PROCEDURE arcosh(x: REAL): REAL |
| обратный гиперболический косинус x |
| PROCEDURE artanh(x: REAL): REAL |
| обратный гиперболический тангенс x |
| PROCEDURE round(x: REAL): REAL |
| округление x до ближайшего целого |
| PROCEDURE frac(x: REAL): REAL; |
| дробная часть числа x |
| PROCEDURE floor(x: REAL): REAL |
| наибольшее целое число (представление как REAL), |
| не больше x: floor(1.2) = 1.0 |
| PROCEDURE ceil(x: REAL): REAL |
| наименьшее целое число (представление как REAL), |
| не меньше x: ceil(1.2) = 2.0 |
| PROCEDURE sgn(x: REAL): INTEGER |
| если x > 0 возвращает 1 |
| если x < 0 возвращает -1 |
| если x = 0 возвращает 0 |
| PROCEDURE fact(n: INTEGER): REAL |
| факториал n |
| ------------------------------------------------------------------------------ |
| MODULE Debug - вывод на доску отладки |
| Интерфейс как модуль Out |
| PROCEDURE Open |
| открывает доску отладки |
| ------------------------------------------------------------------------------ |
| MODULE File - работа с файловой системой |
| TYPE |
| FNAME = ARRAY 520 OF CHAR |
| FS = POINTER TO rFS |
| rFS = RECORD (* информационная структура файла *) |
| subfunc, pos, hpos, bytes, buffer: INTEGER; |
| name: FNAME |
| END |
| FD = POINTER TO rFD |
| rFD = RECORD (* структура блока данных входа каталога *) |
| attr: INTEGER; |
| ntyp: CHAR; |
| reserved: ARRAY 3 OF CHAR; |
| time_create, date_create, |
| time_access, date_access, |
| time_modif, date_modif, |
| size, hsize: INTEGER; |
| name: FNAME |
| END |
| CONST |
| SEEK_BEG = 0 |
| SEEK_CUR = 1 |
| SEEK_END = 2 |
| PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; |
| Загружает в память файл с именем FName, записывает в параметр |
| size размер файла, возвращает адрес загруженного файла |
| или 0 (ошибка). При необходимости, распаковывает |
| файл (kunpack). |
| PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN |
| Записывает структуру блока данных входа каталога для файла |
| или папки с именем FName в параметр Info. |
| При ошибке возвращает FALSE. |
| PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN |
| возвращает TRUE, если файл с именем FName существует |
| PROCEDURE Close(VAR F: FS) |
| освобождает память, выделенную для информационной структуры |
| файла F и присваивает F значение NIL |
| PROCEDURE Open(FName: ARRAY OF CHAR): FS |
| возвращает указатель на информационную структуру файла с |
| именем FName, при ошибке возвращает NIL |
| PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN |
| удаляет файл с именем FName, при ошибке возвращает FALSE |
| PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER |
| устанавливает позицию чтения-записи файла F на Offset, |
| относительно Origin = (SEEK_BEG - начало файла, |
| SEEK_CUR - текущая позиция, SEEK_END - конец файла), |
| возвращает позицию относительно начала файла, например: |
| Seek(F, 0, SEEK_END) |
| устанавливает позицию на конец файла и возвращает длину |
| файла; при ошибке возвращает -1 |
| PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER |
| Читает данные из файла в память. F - указатель на |
| информационную структуру файла, Buffer - адрес области |
| памяти, Count - количество байт, которое требуется прочитать |
| из файла; возвращает количество байт, которое было прочитано |
| и соответствующим образом изменяет позицию чтения/записи в |
| информационной структуре F. |
| PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER |
| Записывает данные из памяти в файл. F - указатель на |
| информационную структуру файла, Buffer - адрес области |
| памяти, Count - количество байт, которое требуется записать |
| в файл; возвращает количество байт, которое было записано и |
| соответствующим образом изменяет позицию чтения/записи в |
| информационной структуре F. |
| PROCEDURE Create(FName: ARRAY OF CHAR): FS |
| создает новый файл с именем FName (полное имя), возвращает |
| указатель на информационную структуру файла, |
| при ошибке возвращает NIL |
| PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN |
| создает папку с именем DirName, все промежуточные папки |
| должны существовать, при ошибке возвращает FALSE |
| PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN |
| удаляет пустую папку с именем DirName, |
| при ошибке возвращает FALSE |
| PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN |
| возвращает TRUE, если папка с именем DirName существует |
| ------------------------------------------------------------------------------ |
| MODULE Read - чтение основных типов данных из файла F |
| Процедуры возвращают TRUE в случае успешной операции чтения и |
| соответствующим образом изменяют позицию чтения/записи в |
| информационной структуре F |
| PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN |
| PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN |
| PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN |
| PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN |
| PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN |
| PROCEDURE WChar(F: File.FS; VAR x: WCHAR): BOOLEAN |
| ------------------------------------------------------------------------------ |
| MODULE Write - запись основных типов данных в файл F |
| Процедуры возвращают TRUE в случае успешной операции записи и |
| соответствующим образом изменяют позицию чтения/записи в |
| информационной структуре F |
| PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN |
| PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN |
| PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN |
| PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN |
| PROCEDURE Set(F: File.FS; x: SET): BOOLEAN |
| PROCEDURE WChar(F: File.FS; x: WCHAR): BOOLEAN |
| ------------------------------------------------------------------------------ |
| MODULE DateTime - дата, время |
| CONST ERR = -7.0E5 |
| PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) |
| записывает в параметры компоненты текущей системной даты и |
| времени |
| PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL |
| возвращает дату, полученную из компонентов |
| Year, Month, Day, Hour, Min, Sec; |
| при ошибке возвращает константу ERR = -7.0E5 |
| PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
| Hour, Min, Sec: INTEGER): BOOLEAN |
| извлекает компоненты |
| Year, Month, Day, Hour, Min, Sec из даты Date; |
| при ошибке возвращает FALSE |
| ------------------------------------------------------------------------------ |
| MODULE Args - параметры программы |
| VAR argc: INTEGER |
| количество параметров программы, включая имя |
| исполняемого файла |
| PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) |
| записывает в строку s n-й параметр программы, |
| нумерация параметров от 0 до argc - 1, |
| нулевой параметр -- имя исполняемого файла |
| ------------------------------------------------------------------------------ |
| MODULE KOSAPI |
| PROCEDURE sysfunc1(arg1: INTEGER): INTEGER |
| PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER |
| ... |
| PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER |
| Обертки для функций API ядра KolibriOS. |
| arg1 .. arg7 соответствуют регистрам |
| eax, ebx, ecx, edx, esi, edi, ebp; |
| возвращают значение регистра eax после системного вызова. |
| PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER |
| Обертка для функций API ядра KolibriOS. |
| arg1 - регистр eax, arg2 - регистр ebx, |
| res2 - значение регистра ebx после системного вызова; |
| возвращает значение регистра eax после системного вызова. |
| PROCEDURE malloc(size: INTEGER): INTEGER |
| Выделяет блок памяти. |
| size - размер блока в байтах, |
| возвращает адрес выделенного блока |
| PROCEDURE free(ptr: INTEGER): INTEGER |
| Освобождает ранее выделенный блок памяти с адресом ptr, |
| возвращает 0 |
| PROCEDURE realloc(ptr, size: INTEGER): INTEGER |
| Перераспределяет блок памяти, |
| ptr - адрес ранее выделенного блока, |
| size - новый размер, |
| возвращает указатель на перераспределенный блок, |
| 0 при ошибке |
| PROCEDURE GetCommandLine(): INTEGER |
| Возвращает адрес строки параметров |
| PROCEDURE GetName(): INTEGER |
| Возвращает адрес строки с именем программы |
| PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER |
| Загружает DLL с полным именем name. Возвращает адрес таблицы |
| экспорта. При ошибке возвращает 0. |
| PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER |
| name - имя процедуры |
| lib - адрес таблицы экспорта DLL |
| Возвращает адрес процедуры. При ошибке возвращает 0. |
| ------------------------------------------------------------------------------ |
| MODULE ColorDlg - работа с диалогом "Color Dialog" |
| TYPE |
| Dialog = POINTER TO RECORD (* структура диалога *) |
| status: INTEGER (* состояние диалога: |
| 0 - пользователь нажал Cancel |
| 1 - пользователь нажал OK |
| 2 - диалог открыт *) |
| color: INTEGER (* выбранный цвет *) |
| END |
| PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog |
| создать диалог |
| draw_window - процедура перерисовки основного окна |
| (TYPE DRAW_WINDOW = PROCEDURE); |
| процедура возвращает указатель на структуру диалога |
| PROCEDURE Show(cd: Dialog) |
| показать диалог |
| cd - указатель на структуру диалога, который был создан ранее |
| процедурой Create |
| PROCEDURE Destroy(VAR cd: Dialog) |
| уничтожить диалог |
| cd - указатель на структуру диалога |
| ------------------------------------------------------------------------------ |
| MODULE OpenDlg - работа с диалогом "Open Dialog" |
| TYPE |
| Dialog = POINTER TO RECORD (* структура диалога *) |
| status: INTEGER (* состояние диалога: |
| 0 - пользователь нажал Cancel |
| 1 - пользователь нажал OK |
| 2 - диалог открыт *) |
| FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) |
| FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного |
| файла *) |
| END |
| PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, |
| filter: ARRAY OF CHAR): Dialog |
| создать диалог |
| draw_window - процедура перерисовки основного окна |
| (TYPE DRAW_WINDOW = PROCEDURE) |
| type - тип диалога |
| 0 - открыть |
| 1 - сохранить |
| 2 - выбрать папку |
| def_path - путь по умолчанию, папка def_path будет открыта |
| при первом запуске диалога |
| filter - в строке записано перечисление расширений файлов, |
| которые будут показаны в диалоговом окне, расширения |
| разделяются символом "|", например: "ASM|TXT|INI" |
| процедура возвращает указатель на структуру диалога |
| PROCEDURE Show(od: Dialog; Width, Height: INTEGER) |
| показать диалог |
| od - указатель на структуру диалога, который был создан ранее |
| процедурой Create |
| Width и Height - ширина и высота диалогового окна |
| PROCEDURE Destroy(VAR od: Dialog) |
| уничтожить диалог |
| od - указатель на структуру диалога |
| ------------------------------------------------------------------------------ |
| MODULE kfonts - работа с kf-шрифтами |
| CONST |
| bold = 1 |
| italic = 2 |
| underline = 4 |
| strike_through = 8 |
| smoothing = 16 |
| bpp32 = 32 |
| TYPE |
| TFont = POINTER TO TFont_desc (* указатель на шрифт *) |
| PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont |
| загрузить шрифт из файла |
| file_name имя kf-файла |
| рез-т: указатель на шрифт/NIL (ошибка) |
| PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN |
| установить размер шрифта |
| Font указатель на шрифт |
| font_size размер шрифта |
| рез-т: TRUE/FALSE (ошибка) |
| PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN |
| проверить, есть ли шрифт, заданного размера |
| Font указатель на шрифт |
| font_size размер шрифта |
| рез-т: TRUE/FALSE (шрифта нет) |
| PROCEDURE Destroy(VAR Font: TFont) |
| выгрузить шрифт, освободить динамическую память |
| Font указатель на шрифт |
| Присваивает переменной Font значение NIL |
| PROCEDURE TextHeight(Font: TFont): INTEGER |
| получить высоту строки текста |
| Font указатель на шрифт |
| рез-т: высота строки текста в пикселях |
| PROCEDURE TextWidth(Font: TFont; |
| str, length, params: INTEGER): INTEGER |
| получить ширину строки текста |
| Font указатель на шрифт |
| str адрес строки текста в кодировке Win-1251 |
| length количество символов в строке или -1, если строка |
| завершается нулем |
| params параметры-флаги см. ниже |
| рез-т: ширина строки текста в пикселях |
| PROCEDURE TextOut(Font: TFont; |
| canvas, x, y, str, length, color, params: INTEGER) |
| вывести текст в буфер |
| для вывода буфера в окно, использовать ф.65 или |
| ф.7 (если буфер 24-битный) |
| Font указатель на шрифт |
| canvas адрес графического буфера |
| структура буфера: |
| Xsize dd |
| Ysize dd |
| picture rb Xsize * Ysize * 4 (32 бита) |
| или Xsize * Ysize * 3 (24 бита) |
| x, y координаты текста относительно левого верхнего |
| угла буфера |
| str адрес строки текста в кодировке Win-1251 |
| length количество символов в строке или -1, если строка |
| завершается нулем |
| color цвет текста 0x00RRGGBB |
| params параметры-флаги: |
| 1 жирный |
| 2 курсив |
| 4 подчеркнутый |
| 8 перечеркнутый |
| 16 применить сглаживание |
| 32 вывод в 32-битный буфер |
| возможно использование флагов в любых сочетаниях |
| ------------------------------------------------------------------------------ |
| MODULE RasterWorks - обертка библиотеки Rasterworks.obj |
| ------------------------------------------------------------------------------ |
| MODULE libimg - обертка библиотеки libimg.obj |
| ------------------------------------------------------------------------------ |
| /programs/develop/oberon07/Docs/WinLib.txt |
|---|
| 0,0 → 1,312 |
| ============================================================================== |
| Библиотека (Windows) |
| ------------------------------------------------------------------------------ |
| MODULE Out - консольный вывод |
| PROCEDURE Open |
| открывает консольный вывод |
| PROCEDURE Int(x, width: INTEGER) |
| вывод целого числа x; |
| width - количество знакомест, используемых для вывода |
| PROCEDURE Real(x: REAL; width: INTEGER) |
| вывод вещественного числа x в плавающем формате; |
| width - количество знакомест, используемых для вывода |
| PROCEDURE Char(x: CHAR) |
| вывод символа x |
| PROCEDURE FixReal(x: REAL; width, p: INTEGER) |
| вывод вещественного числа x в фиксированном формате; |
| width - количество знакомест, используемых для вывода; |
| p - количество знаков после десятичной точки |
| PROCEDURE Ln |
| переход на следующую строку |
| PROCEDURE String(s: ARRAY OF CHAR) |
| вывод строки s (ASCII) |
| PROCEDURE StringW(s: ARRAY OF WCHAR) |
| вывод строки s (UTF-16) |
| ------------------------------------------------------------------------------ |
| MODULE In - консольный ввод |
| VAR Done: BOOLEAN |
| принимает значение TRUE в случае успешного выполнения |
| операции ввода и FALSE в противном случае |
| PROCEDURE Open |
| открывает консольный ввод, |
| также присваивает переменной Done значение TRUE |
| PROCEDURE Int(VAR x: INTEGER) |
| ввод числа типа INTEGER |
| PROCEDURE Char(VAR x: CHAR) |
| ввод символа |
| PROCEDURE Real(VAR x: REAL) |
| ввод числа типа REAL |
| PROCEDURE String(VAR s: ARRAY OF CHAR) |
| ввод строки |
| PROCEDURE Ln |
| ожидание нажатия ENTER |
| ------------------------------------------------------------------------------ |
| MODULE Console - дополнительные процедуры консольного вывода |
| CONST |
| Следующие константы определяют цвет консольного вывода |
| Black = 0 Blue = 1 Green = 2 |
| Cyan = 3 Red = 4 Magenta = 5 |
| Brown = 6 LightGray = 7 DarkGray = 8 |
| LightBlue = 9 LightGreen = 10 LightCyan = 11 |
| LightRed = 12 LightMagenta = 13 Yellow = 14 |
| White = 15 |
| PROCEDURE Cls |
| очистка окна консоли |
| PROCEDURE SetColor(FColor, BColor: INTEGER) |
| установка цвета консольного вывода: FColor - цвет текста, |
| BColor - цвет фона, возможные значения - вышеперечисленные |
| константы |
| PROCEDURE SetCursor(x, y: INTEGER) |
| установка курсора консоли в позицию (x, y) |
| PROCEDURE GetCursor(VAR x, y: INTEGER) |
| записывает в параметры текущие координаты курсора консоли |
| PROCEDURE GetCursorX(): INTEGER |
| возвращает текущую x-координату курсора консоли |
| PROCEDURE GetCursorY(): INTEGER |
| возвращает текущую y-координату курсора консоли |
| ------------------------------------------------------------------------------ |
| MODULE Math - математические функции |
| CONST |
| pi = 3.141592653589793E+00 |
| e = 2.718281828459045E+00 |
| PROCEDURE IsNan(x: REAL): BOOLEAN |
| возвращает TRUE, если x - не число |
| PROCEDURE IsInf(x: REAL): BOOLEAN |
| возвращает TRUE, если x - бесконечность |
| PROCEDURE sqrt(x: REAL): REAL |
| квадратный корень x |
| PROCEDURE exp(x: REAL): REAL |
| экспонента x |
| PROCEDURE ln(x: REAL): REAL |
| натуральный логарифм x |
| PROCEDURE sin(x: REAL): REAL |
| синус x |
| PROCEDURE cos(x: REAL): REAL |
| косинус x |
| PROCEDURE tan(x: REAL): REAL |
| тангенс x |
| PROCEDURE arcsin(x: REAL): REAL |
| арксинус x |
| PROCEDURE arccos(x: REAL): REAL |
| арккосинус x |
| PROCEDURE arctan(x: REAL): REAL |
| арктангенс x |
| PROCEDURE arctan2(y, x: REAL): REAL |
| арктангенс y/x |
| PROCEDURE power(base, exponent: REAL): REAL |
| возведение числа base в степень exponent |
| PROCEDURE log(base, x: REAL): REAL |
| логарифм x по основанию base |
| PROCEDURE sinh(x: REAL): REAL |
| гиперболический синус x |
| PROCEDURE cosh(x: REAL): REAL |
| гиперболический косинус x |
| PROCEDURE tanh(x: REAL): REAL |
| гиперболический тангенс x |
| PROCEDURE arsinh(x: REAL): REAL |
| обратный гиперболический синус x |
| PROCEDURE arcosh(x: REAL): REAL |
| обратный гиперболический косинус x |
| PROCEDURE artanh(x: REAL): REAL |
| обратный гиперболический тангенс x |
| PROCEDURE round(x: REAL): REAL |
| округление x до ближайшего целого |
| PROCEDURE frac(x: REAL): REAL; |
| дробная часть числа x |
| PROCEDURE floor(x: REAL): REAL |
| наибольшее целое число (представление как REAL), |
| не больше x: floor(1.2) = 1.0 |
| PROCEDURE ceil(x: REAL): REAL |
| наименьшее целое число (представление как REAL), |
| не меньше x: ceil(1.2) = 2.0 |
| PROCEDURE sgn(x: REAL): INTEGER |
| если x > 0 возвращает 1 |
| если x < 0 возвращает -1 |
| если x = 0 возвращает 0 |
| PROCEDURE fact(n: INTEGER): REAL |
| факториал n |
| ------------------------------------------------------------------------------ |
| MODULE File - работа с файловой системой |
| CONST |
| OPEN_R = 0 |
| OPEN_W = 1 |
| OPEN_RW = 2 |
| SEEK_BEG = 0 |
| SEEK_CUR = 1 |
| SEEK_END = 2 |
| PROCEDURE Create(FName: ARRAY OF CHAR): INTEGER |
| создает новый файл с именем FName (полное имя с путем), |
| открывет файл для записи и возвращает идентификатор файла |
| (целое число), в случае ошибки, возвращает -1 |
| PROCEDURE Open(FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER |
| открывает существующий файл с именем FName (полное имя с |
| путем) в режиме Mode = (OPEN_R (только чтение), OPEN_W |
| (только запись), OPEN_RW (чтение и запись)), возвращает |
| идентификатор файла (целое число), в случае ошибки, |
| возвращает -1 |
| PROCEDURE Read(F, Buffer, Count: INTEGER): INTEGER |
| Читает данные из файла в память. F - числовой идентификатор |
| файла, Buffer - адрес области памяти, Count - количество байт, |
| которое требуется прочитать из файла; возвращает количество |
| байт, которое было прочитано из файла |
| PROCEDURE Write(F, Buffer, Count: INTEGER): INTEGER |
| Записывает данные из памяти в файл. F - числовой идентификатор |
| файла, Buffer - адрес области памяти, Count - количество байт, |
| которое требуется записать в файл; возвращает количество байт, |
| которое было записано в файл |
| PROCEDURE Seek(F, Offset, Origin: INTEGER): INTEGER |
| устанавливает позицию чтения-записи файла с идентификатором F |
| на Offset, относительно Origin = (SEEK_BEG - начало файла, |
| SEEK_CUR - текущая позиция, SEEK_END - конец файла), |
| возвращает позицию относительно начала файла, например: |
| Seek(F, 0, 2) - устанавливает позицию на конец файла и |
| возвращает длину файла; при ошибке возвращает -1 |
| PROCEDURE Close(F: INTEGER) |
| закрывает ранее открытый файл с идентификатором F |
| PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN |
| удаляет файл с именем FName (полное имя с путем), |
| возвращает TRUE, если файл успешно удален |
| PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN |
| возвращает TRUE, если файл с именем FName (полное имя) |
| существует |
| PROCEDURE Load(FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER |
| загружает в память существующий файл с именем FName (полное имя с |
| путем), возвращает адрес памяти, куда был загружен файл, |
| записывает размер файла в параметр Size; |
| при ошибке возвращает 0 |
| PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN |
| создает папку с именем DirName, все промежуточные папки |
| должны существовать. В случае ошибки, возвращает FALSE |
| PROCEDURE RemoveDir(DirName: ARRAY OF CHAR): BOOLEAN |
| удаляет пустую папку с именем DirName. В случае ошибки, |
| возвращает FALSE |
| PROCEDURE ExistsDir(DirName: ARRAY OF CHAR): BOOLEAN |
| возвращает TRUE, если папка с именем DirName существует |
| ------------------------------------------------------------------------------ |
| MODULE DateTime - дата, время |
| CONST ERR = -7.0E5 |
| PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER) |
| возвращает в параметрах компоненты текущей системной даты и |
| времени |
| PROCEDURE NowEncode(): REAL; |
| возвращает текущую системную дату и |
| время (представление REAL) |
| PROCEDURE Encode(Year, Month, Day, |
| Hour, Min, Sec, MSec: INTEGER): REAL |
| возвращает дату, полученную из компонентов |
| Year, Month, Day, Hour, Min, Sec, MSec; |
| при ошибке возвращает константу ERR = -7.0E5 |
| PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, |
| Hour, Min, Sec, MSec: INTEGER): BOOLEAN |
| извлекает компоненты |
| Year, Month, Day, Hour, Min, Sec, MSec из даты Date; |
| при ошибке возвращает FALSE |
| ------------------------------------------------------------------------------ |
| MODULE Args - параметры программы |
| VAR argc: INTEGER |
| количество параметров программы, включая имя |
| исполняемого файла |
| PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) |
| записывает в строку s n-й параметр программы, |
| нумерация параметров от 0 до argc - 1, |
| нулевой параметр -- имя исполняемого файла |
| ------------------------------------------------------------------------------ |
| MODULE Utils - разное |
| PROCEDURE Utf8To16(source: ARRAY OF CHAR; |
| VAR dest: ARRAY OF CHAR): INTEGER; |
| преобразует символы строки source из кодировки UTF-8 в |
| кодировку UTF-16, результат записывает в строку dest, |
| возвращает количество 16-битных символов, записанных в dest |
| PROCEDURE PutSeed(seed: INTEGER) |
| Инициализация генератора случайных чисел целым числом seed |
| PROCEDURE Rnd(range: INTEGER): INTEGER |
| Целые случайные числа в диапазоне 0 <= x < range |
| ------------------------------------------------------------------------------ |
| MODULE WINAPI - привязки к некоторым API-функциям Windows |
| /programs/develop/oberon07/Docs/x86.txt |
|---|
| 0,0 → 1,358 |
| Компилятор языка программирования Oberon-07/16 для i486 |
| Windows/Linux/KolibriOS. |
| ------------------------------------------------------------------------------ |
| Параметры командной строки |
| Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или |
| UTF-8 с BOM-сигнатурой. |
| Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF. |
| Параметры: |
| 1) имя главного модуля |
| 2) тип приложения |
| "win32con" - Windows console |
| "win32gui" - Windows GUI |
| "win32dll" - Windows DLL |
| "linux32exe" - Linux ELF-EXEC |
| "linux32so" - Linux ELF-SO |
| "kosexe" - KolibriOS |
| "kosdll" - KolibriOS DLL |
| 3) необязательные параметры-ключи |
| -out <file_name> имя результирующего файла; по умолчанию, |
| совпадает с именем главного модуля, но с другим расширением |
| (соответствует типу исполняемого файла) |
| -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб, |
| допустимо от 1 до 32 Мб) |
| -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) |
| -ver <major.minor> версия программы (только для kosdll) |
| параметр -nochk задается в виде строки из символов: |
| "p" - указатели |
| "t" - типы |
| "i" - индексы |
| "b" - неявное приведение INTEGER к BYTE |
| "c" - диапазон аргумента функции CHR |
| "w" - диапазон аргумента функции WCHR |
| "r" - эквивалентно "bcw" |
| "a" - все проверки |
| Порядок символов может быть любым. Наличие в строке того или иного |
| символа отключает соответствующую проверку. |
| Например: -nochk it - отключить проверку индексов и охрану типа. |
| -nochk a - отключить все отключаемые проверки. |
| Например: |
| Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1 |
| Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll" |
| Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4 |
| Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti |
| Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4 |
| Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7 |
| Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a |
| В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. |
| При работе компилятора в KolibriOS, код завершения не передается. |
| ------------------------------------------------------------------------------ |
| Отличия от оригинала |
| 1. Расширен псевдомодуль SYSTEM |
| 2. В идентификаторах допускается символ "_" |
| 3. Добавлены системные флаги |
| 4. Усовершенствован оператор CASE (добавлены константные выражения в |
| метках вариантов и необязательная ветка ELSE) |
| 5. Расширен набор стандартных процедур |
| 6. Семантика охраны/проверки типа уточнена для нулевого указателя |
| 7. Добавлены однострочные комментарии (начинаются с пары символов "//") |
| 8. Разрешено наследование от типа-указателя |
| 9. Добавлен синтаксис для импорта процедур из внешних библиотек |
| 10. "Строки" можно заключать также в одиночные кавычки: 'строка' |
| 11. Добавлен тип WCHAR |
| ------------------------------------------------------------------------------ |
| Особенности реализации |
| 1. Основные типы |
| Тип Диапазон значений Размер, байт |
| INTEGER -2147483648 .. 2147483647 4 |
| REAL 4.94E-324 .. 1.70E+308 8 |
| CHAR символ ASCII (0X .. 0FFX) 1 |
| BOOLEAN FALSE, TRUE 1 |
| SET множество из целых чисел {0 .. 31} 4 |
| BYTE 0 .. 255 1 |
| WCHAR символ юникода (0X .. 0FFFFX) 2 |
| 2. Максимальная длина идентификаторов - 1024 символов |
| 3. Максимальная длина строковых констант - 1024 символов (UTF-8) |
| 4. Максимальная размерность открытых массивов - 5 |
| 5. Процедура NEW заполняет нулями выделенный блок памяти |
| 6. Глобальные и локальные переменные инициализируются нулями |
| 7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая |
| модульность отсутствуют |
| 8. Тип BYTE в выражениях всегда приводится к INTEGER |
| 9. Контроль переполнения значений выражений не производится |
| 10. Ошибки времени выполнения: |
| 1 ASSERT(x), при x = FALSE |
| 2 разыменование нулевого указателя |
| 3 целочисленное деление на неположительное число |
| 4 вызов процедуры через процедурную переменную с нулевым значением |
| 5 ошибка охраны типа |
| 6 нарушение границ массива |
| 7 непредусмотренное значение выражения в операторе CASE |
| 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) |
| 9 CHR(x), если (x < 0) OR (x > 255) |
| 10 WCHR(x), если (x < 0) OR (x > 65535) |
| 11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) |
| ------------------------------------------------------------------------------ |
| Псевдомодуль SYSTEM |
| Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, |
| ошибки при использовании процедур псевдомодуля SYSTEM могут привести к |
| повреждению данных времени выполнения и аварийному завершению программы. |
| PROCEDURE ADR(v: любой тип): INTEGER |
| v - переменная или процедура; |
| возвращает адрес v |
| PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER |
| возвращает адрес x |
| PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER |
| возвращает адрес x |
| PROCEDURE SIZE(T): INTEGER |
| возвращает размер типа T |
| PROCEDURE TYPEID(T): INTEGER |
| T - тип-запись или тип-указатель, |
| возвращает номер типа в таблице типов-записей |
| PROCEDURE INF(): REAL |
| возвращает специальное вещественное значение "бесконечность" |
| PROCEDURE GET(a: INTEGER; |
| VAR v: любой основной тип, PROCEDURE, POINTER) |
| v := Память[a] |
| PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) |
| Память[a] := x; |
| Если x: BYTE или x: WCHAR, то значение x будет расширено |
| до 32 бит, для записи байтов использовать SYSTEM.PUT8, |
| для WCHAR -- SYSTEM.PUT16 |
| PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
| Память[a] := младшие 8 бит (x) |
| PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
| Память[a] := младшие 16 бит (x) |
| PROCEDURE MOVE(Source, Dest, n: INTEGER) |
| Копирует n байт памяти из Source в Dest, |
| области Source и Dest не могут перекрываться |
| PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) |
| Копирует n байт памяти из Source в Dest. |
| Эквивалентно |
| SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) |
| PROCEDURE CODE(byte1, byte2,... : INTEGER) |
| Вставка машинного кода, |
| byte1, byte2 ... - константы в диапазоне 0..255, |
| например: |
| SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) |
| Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. |
| ------------------------------------------------------------------------------ |
| Системные флаги |
| При объявлении процедурных типов и глобальных процедур, после ключевого |
| слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall], |
| [ccall], [ccall16], [windows], [linux]. Например: |
| PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; |
| Если указан флаг [ccall16], то принимается соглашение ccall, но перед |
| вызовом указатель стэка будет выравнен по границе 16 байт. |
| Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall16]. |
| Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что |
| результат процедуры можно игнорировать (не допускается для типа REAL). |
| При объявлении типов-записей, после ключевого слова RECORD может быть |
| указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей |
| записи. Записи с системным флагом не могут иметь базовый тип и не могут быть |
| базовыми типами для других записей. |
| Для использования системных флагов, требуется импортировать SYSTEM. |
| ------------------------------------------------------------------------------ |
| Оператор CASE |
| Синтаксис оператора CASE: |
| CaseStatement = |
| CASE Expression OF Сase {"|" Сase} |
| [ELSE StatementSequence] END. |
| Case = [CaseLabelList ":" StatementSequence]. |
| CaseLabelList = CaseLabels {"," CaseLabels}. |
| CaseLabels = ConstExpression [".." ConstExpression]. |
| Например: |
| CASE x OF |
| |-1: DoSomething1 |
| | 1: DoSomething2 |
| | 0: DoSomething3 |
| ELSE |
| DoSomething4 |
| END |
| В метках вариантов можно использовать константные выражения, ветка ELSE |
| необязательна. Если значение x не соответствует ни одному варианту и ELSE |
| отсутствует, то программа прерывается с ошибкой времени выполнения. |
| ------------------------------------------------------------------------------ |
| Тип WCHAR |
| Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и |
| ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и |
| ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает |
| только тип CHAR. Для получения значения типа WCHAR, следует использовать |
| процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять |
| исходный код в кодировке UTF-8 c BOM. |
| ------------------------------------------------------------------------------ |
| Проверка и охрана типа нулевого указателя |
| Оригинальное сообщение о языке не определяет поведение программы при |
| выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих |
| Oberon-реализациях выполнение такой операции приводит к ошибке времени |
| выполнения. В данной реализации охрана типа нулевого указателя не приводит к |
| ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет |
| значительно сократить частоту применения охраны типа. |
| ------------------------------------------------------------------------------ |
| Дополнительные стандартные процедуры |
| DISPOSE (VAR v: любой_указатель) |
| Освобождает память, выделенную процедурой NEW для |
| динамической переменной v^, и присваивает переменной v |
| значение NIL. |
| COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); |
| v := x; |
| Если LEN(v) < LEN(x), то строка x будет скопирована |
| не полностью |
| LSR (x, n: INTEGER): INTEGER |
| Логический сдвиг x на n бит вправо. |
| MIN (a, b: INTEGER): INTEGER |
| Минимум из двух значений. |
| MAX (a, b: INTEGER): INTEGER |
| Максимум из двух значений. |
| BITS (x: INTEGER): SET |
| Интерпретирует x как значение типа SET. |
| Выполняется на этапе компиляции. |
| LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER |
| Длина 0X-завершенной строки s, без учета символа 0X. |
| Если символ 0X отсутствует, функция возвращает длину |
| массива s. s не может быть константой. |
| WCHR (n: INTEGER): WCHAR |
| Преобразование типа, аналогично CHR(n: INTEGER): CHAR |
| ------------------------------------------------------------------------------ |
| Импортированные процедуры |
| Синтаксис импорта: |
| PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; |
| - callconv -- соглашение о вызове |
| - "library" -- имя файла динамической библиотеки |
| - "function" -- имя импортируемой процедуры |
| например: |
| PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); |
| PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); |
| В конце объявления может быть добавлено (необязательно) "END proc_name;" |
| Объявления импортированных процедур должны располагаться в глобальной |
| области видимости модуля после объявления переменных, вместе с объявлением |
| "обычных" процедур, от которых импортированные отличаются только отсутствием |
| тела процедуры. В остальном, к таким процедурам применимы те же правила: |
| их можно вызвать, присвоить процедурной переменной или получить адрес. |
| Так как импортированная процедура всегда имеет явное указание соглашения о |
| вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием |
| соглашения о вызове: |
| VAR |
| ExitProcess: PROCEDURE [windows] (code: INTEGER); |
| con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); |
| В KolibriOS импортировать процедуры можно только из библиотек, размещенных |
| в /rd/1/lib. Импортировать и вызывать функции инициализации библиотек |
| (lib_init, START) при этом не нужно. |
| Для Linux, импортированные процедуры не реализованы. |
| ------------------------------------------------------------------------------ |
| Скрытые параметры процедур |
| Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке |
| формальных параметров, но учитываются компилятором при трансляции вызовов. |
| Это возможно в следующих случаях: |
| 1. Процедура имеет формальный параметр открытый массив: |
| PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); |
| Вызов транслируется так: |
| Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) |
| 2. Процедура имеет формальный параметр-переменную типа RECORD: |
| PROCEDURE Proc (VAR x: Rec); |
| Вызов транслируется так: |
| Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) |
| ------------------------------------------------------------------------------ |
| Модуль RTL |
| Все программы неявно используют модуль RTL. Компилятор транслирует |
| некоторые операции (проверка и охрана типа, сравнение строк, сообщения об |
| ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не |
| следует вызывать эти процедуры явно. |
| Сообщения об ошибках времени выполнения выводятся в диалоговых окнах |
| (Windows), в терминал (Linux), на доску отладки (KolibriOS). |
| ------------------------------------------------------------------------------ |
| Модуль API |
| Существуют несколько реализаций модуля API (для различных ОС). |
| Как и модуль RTL, модуль API не предназначен для прямого использования. |
| Он обеспечивает связь RTL с ОС. |
| ------------------------------------------------------------------------------ |
| Генерация исполняемых файлов DLL |
| Разрешается экспортировать только процедуры. Для этого, процедура должна |
| находиться в главном модуле программы, и ее имя должно быть отмечено символом |
| экспорта ("*"). KolibriOS DLL всегда экспортируют идентификаторы "version" |
| (версия программы) и "lib_init" - адрес процедуры инициализации DLL: |
| PROCEDURE [stdcall] lib_init (): INTEGER |
| Эта процедура должна быть вызвана перед использованием DLL. |
| Процедура всегда возвращает 1. |
| /programs/develop/oberon07/Docs/x86_64.txt |
|---|
| 0,0 → 1,346 |
| Компилятор языка программирования Oberon-07/16 для x86_64 |
| Windows/Linux |
| ------------------------------------------------------------------------------ |
| Параметры командной строки |
| Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или |
| UTF-8 с BOM-сигнатурой. |
| Выход - испоняемый файл формата PE32+ или ELF64. |
| Параметры: |
| 1) имя главного модуля |
| 2) тип приложения |
| "win64con" - Windows64 console |
| "win64gui" - Windows64 GUI |
| "win64dll" - Windows64 DLL |
| "linux64exe" - Linux ELF64-EXEC |
| "linux64so" - Linux ELF64-SO |
| 3) необязательные параметры-ключи |
| -out <file_name> имя результирующего файла; по умолчанию, |
| совпадает с именем главного модуля, но с другим расширением |
| (соответствует типу исполняемого файла) |
| -stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб, |
| допустимо от 1 до 32 Мб) |
| -nochk <"ptibcwra"> отключить проверки при выполнении |
| параметр -nochk задается в виде строки из символов: |
| "p" - указатели |
| "t" - типы |
| "i" - индексы |
| "b" - неявное приведение INTEGER к BYTE |
| "c" - диапазон аргумента функции CHR |
| "w" - диапазон аргумента функции WCHR |
| "r" - эквивалентно "bcw" |
| "a" - все проверки |
| Порядок символов может быть любым. Наличие в строке того или иного |
| символа отключает соответствующую проверку. |
| Например: -nochk it - отключить проверку индексов и охрану типа. |
| -nochk a - отключить все отключаемые проверки. |
| Например: |
| Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1 |
| Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti |
| Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a |
| В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. |
| ------------------------------------------------------------------------------ |
| Отличия от оригинала |
| 1. Расширен псевдомодуль SYSTEM |
| 2. В идентификаторах допускается символ "_" |
| 3. Добавлены системные флаги |
| 4. Усовершенствован оператор CASE (добавлены константные выражения в |
| метках вариантов и необязательная ветка ELSE) |
| 5. Расширен набор стандартных процедур |
| 6. Семантика охраны/проверки типа уточнена для нулевого указателя |
| 7. Добавлены однострочные комментарии (начинаются с пары символов "//") |
| 8. Разрешено наследование от типа-указателя |
| 9. Добавлен синтаксис для импорта процедур из внешних библиотек |
| 10. "Строки" можно заключать также в одиночные кавычки: 'строка' |
| 11. Добавлен тип WCHAR |
| ------------------------------------------------------------------------------ |
| Особенности реализации |
| 1. Основные типы |
| Тип Диапазон значений Размер, байт |
| INTEGER -9223372036854775808 .. 9223372036854775807 8 |
| REAL 4.94E-324 .. 1.70E+308 8 |
| CHAR символ ASCII (0X .. 0FFX) 1 |
| BOOLEAN FALSE, TRUE 1 |
| SET множество из целых чисел {0 .. 63} 8 |
| BYTE 0 .. 255 1 |
| WCHAR символ юникода (0X .. 0FFFFX) 2 |
| 2. Максимальная длина идентификаторов - 1024 символов |
| 3. Максимальная длина строковых констант - 1024 символов (UTF-8) |
| 4. Максимальная размерность открытых массивов - 5 |
| 5. Процедура NEW заполняет нулями выделенный блок памяти |
| 6. Глобальные и локальные переменные инициализируются нулями |
| 7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая |
| модульность отсутствуют |
| 8. Тип BYTE в выражениях всегда приводится к INTEGER |
| 9. Контроль переполнения значений выражений не производится |
| 10. Ошибки времени выполнения: |
| 1 ASSERT(x), при x = FALSE |
| 2 разыменование нулевого указателя |
| 3 целочисленное деление на неположительное число |
| 4 вызов процедуры через процедурную переменную с нулевым значением |
| 5 ошибка охраны типа |
| 6 нарушение границ массива |
| 7 непредусмотренное значение выражения в операторе CASE |
| 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) |
| 9 CHR(x), если (x < 0) OR (x > 255) |
| 10 WCHR(x), если (x < 0) OR (x > 65535) |
| 11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) |
| ------------------------------------------------------------------------------ |
| Псевдомодуль SYSTEM |
| Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, |
| ошибки при использовании процедур псевдомодуля SYSTEM могут привести к |
| повреждению данных времени выполнения и аварийному завершению программы. |
| PROCEDURE ADR(v: любой тип): INTEGER |
| v - переменная или процедура; |
| возвращает адрес v |
| PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER |
| возвращает адрес x |
| PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER |
| возвращает адрес x |
| PROCEDURE SIZE(T): INTEGER |
| возвращает размер типа T |
| PROCEDURE TYPEID(T): INTEGER |
| T - тип-запись или тип-указатель, |
| возвращает номер типа в таблице типов-записей |
| PROCEDURE INF(): REAL |
| возвращает специальное вещественное значение "бесконечность" |
| PROCEDURE GET(a: INTEGER; |
| VAR v: любой основной тип, PROCEDURE, POINTER) |
| v := Память[a] |
| PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) |
| Память[a] := x; |
| Если x: BYTE или x: WCHAR, то значение x будет расширено |
| до 64 бит, для записи байтов использовать SYSTEM.PUT8, |
| для WCHAR -- SYSTEM.PUT16 |
| PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
| Память[a] := младшие 8 бит (x) |
| PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
| Память[a] := младшие 16 бит (x) |
| PROCEDURE PUT32(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) |
| Память[a] := младшие 32 бит (x) |
| PROCEDURE MOVE(Source, Dest, n: INTEGER) |
| Копирует n байт памяти из Source в Dest, |
| области Source и Dest не могут перекрываться |
| PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) |
| Копирует n байт памяти из Source в Dest. |
| Эквивалентно |
| SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) |
| PROCEDURE CODE(byte1, byte2,... : BYTE) |
| Вставка машинного кода, |
| byte1, byte2 ... - константы в диапазоне 0..255, |
| например: |
| SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *) |
| Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не |
| допускаются никакие явные операции, за исключением присваивания. |
| Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. |
| ------------------------------------------------------------------------------ |
| Системные флаги |
| При объявлении процедурных типов и глобальных процедур, после ключевого |
| слова PROCEDURE может быть указан флаг соглашения о вызове: [win64], [systemv], |
| [windows], [linux]. |
| Например: |
| PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER; |
| Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv]. |
| Знак "-" после имени флага ([win64-], [linux-], ...) означает, что |
| результат процедуры можно игнорировать (не допускается для типа REAL). |
| Если флаг не указан, то принимается внутреннее соглашение о вызове. |
| [win64] и [systemv] используются для связи с операционной системой и внешними |
| приложениями. |
| При объявлении типов-записей, после ключевого слова RECORD может быть |
| указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей |
| записи. Записи с системным флагом не могут иметь базовый тип и не могут быть |
| базовыми типами для других записей. |
| Для использования системных флагов, требуется импортировать SYSTEM. |
| ------------------------------------------------------------------------------ |
| Оператор CASE |
| Синтаксис оператора CASE: |
| CaseStatement = |
| CASE Expression OF Сase {"|" Сase} |
| [ELSE StatementSequence] END. |
| Case = [CaseLabelList ":" StatementSequence]. |
| CaseLabelList = CaseLabels {"," CaseLabels}. |
| CaseLabels = ConstExpression [".." ConstExpression]. |
| Например: |
| CASE x OF |
| |-1: DoSomething1 |
| | 1: DoSomething2 |
| | 0: DoSomething3 |
| ELSE |
| DoSomething4 |
| END |
| В метках вариантов можно использовать константные выражения, ветка ELSE |
| необязательна. Если значение x не соответствует ни одному варианту и ELSE |
| отсутствует, то программа прерывается с ошибкой времени выполнения. |
| ------------------------------------------------------------------------------ |
| Тип WCHAR |
| Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и |
| ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и |
| ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает |
| только тип CHAR. Для получения значения типа WCHAR, следует использовать |
| процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять |
| исходный код в кодировке UTF-8 c BOM. |
| ------------------------------------------------------------------------------ |
| Проверка и охрана типа нулевого указателя |
| Оригинальное сообщение о языке не определяет поведение программы при |
| выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих |
| Oberon-реализациях выполнение такой операции приводит к ошибке времени |
| выполнения. В данной реализации охрана типа нулевого указателя не приводит к |
| ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет |
| значительно сократить частоту применения охраны типа. |
| ------------------------------------------------------------------------------ |
| Дополнительные стандартные процедуры |
| DISPOSE (VAR v: любой_указатель) |
| Освобождает память, выделенную процедурой NEW для |
| динамической переменной v^, и присваивает переменной v |
| значение NIL. |
| COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); |
| v := x; |
| Если LEN(v) < LEN(x), то строка x будет скопирована |
| не полностью |
| LSR (x, n: INTEGER): INTEGER |
| Логический сдвиг x на n бит вправо. |
| MIN (a, b: INTEGER): INTEGER |
| Минимум из двух значений. |
| MAX (a, b: INTEGER): INTEGER |
| Максимум из двух значений. |
| BITS (x: INTEGER): SET |
| Интерпретирует x как значение типа SET. |
| Выполняется на этапе компиляции. |
| LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER |
| Длина 0X-завершенной строки s, без учета символа 0X. |
| Если символ 0X отсутствует, функция возвращает длину |
| массива s. s не может быть константой. |
| WCHR (n: INTEGER): WCHAR |
| Преобразование типа, аналогично CHR(n: INTEGER): CHAR |
| ------------------------------------------------------------------------------ |
| Импортированные процедуры |
| Синтаксис импорта: |
| PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; |
| - callconv -- соглашение о вызове |
| - "library" -- имя файла динамической библиотеки |
| - "function" -- имя импортируемой процедуры |
| например: |
| PROCEDURE [win64, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); |
| В конце объявления может быть добавлено (необязательно) "END proc_name;" |
| Объявления импортированных процедур должны располагаться в глобальной |
| области видимости модуля после объявления переменных, вместе с объявлением |
| "обычных" процедур, от которых импортированные отличаются только отсутствием |
| тела процедуры. В остальном, к таким процедурам применимы те же правила: |
| их можно вызвать, присвоить процедурной переменной или получить адрес. |
| Так как импортированная процедура всегда имеет явное указание соглашения о |
| вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием |
| соглашения о вызове: |
| VAR |
| ExitProcess: PROCEDURE [win64] (code: INTEGER); |
| Для Linux, импортированные процедуры не реализованы. |
| ------------------------------------------------------------------------------ |
| Скрытые параметры процедур |
| Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке |
| формальных параметров, но учитываются компилятором при трансляции вызовов. |
| Это возможно в следующих случаях: |
| 1. Процедура имеет формальный параметр открытый массив: |
| PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); |
| Вызов транслируется так: |
| Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) |
| 2. Процедура имеет формальный параметр-переменную типа RECORD: |
| PROCEDURE Proc (VAR x: Rec); |
| Вызов транслируется так: |
| Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) |
| ------------------------------------------------------------------------------ |
| Модуль RTL |
| Все программы неявно используют модуль RTL. Компилятор транслирует |
| некоторые операции (проверка и охрана типа, сравнение строк, сообщения об |
| ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не |
| следует вызывать эти процедуры явно. |
| Сообщения об ошибках времени выполнения выводятся в диалоговых окнах |
| (Windows), в терминал (Linux). |
| ------------------------------------------------------------------------------ |
| Модуль API |
| Существуют несколько реализаций модуля API (для различных ОС). |
| Как и модуль RTL, модуль API не предназначен для прямого использования. |
| Он обеспечивает связь RTL с ОС. |
| ------------------------------------------------------------------------------ |
| Генерация исполняемых файлов DLL |
| Разрешается экспортировать только процедуры. Для этого, процедура должна |
| находиться в главном модуле программы, ее имя должно быть отмечено символом |
| экспорта ("*") и должно быть указано соглашение о вызове. |
| /programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /programs/develop/oberon07/GitHub.url |
|---|
| 0,0 → 1,2 |
| [InternetShortcut] |
| URL=https://github.com/AntKrotov/oberon-07-compiler |
| /programs/develop/oberon07/Lib/STM32CM3/FPU.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/STM32CM3/RTL.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/RVM32I/FPU.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/RVM32I/HOST.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/RVM32I/RTL.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/RVM32I/Trap.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/RVM32I/Out.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Math/MathRound.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Math/Rand.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Math/MathStat.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Math/RandExt.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Lib/Math/MathBits.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Lib/Math/CMath.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Lib/MSP430/MSP430.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/KolibriOS/API.ob07 |
|---|
| 12,8 → 12,6 |
| CONST |
| eol* = 0DX + 0AX; |
| MAX_SIZE = 16 * 400H; |
| HEAP_SIZE = 1 * 100000H; |
| 35,8 → 33,9 |
| CriticalSection: CRITICAL_SECTION; |
| _import*, multi: BOOLEAN; |
| import*, multi: BOOLEAN; |
| eol*: ARRAY 3 OF CHAR; |
| base*: INTEGER; |
| 285,24 → 284,24 |
| BEGIN |
| OutString("import error: "); |
| IF K.imp_error.error = 1 THEN |
| OutString("can't load '"); OutString(K.imp_error.lib) |
| OutString("can't load "); OutString(K.imp_error.lib) |
| ELSIF K.imp_error.error = 2 THEN |
| OutString("not found '"); OutString(K.imp_error.proc); OutString("' in '"); OutString(K.imp_error.lib) |
| OutString("not found "); OutString(K.imp_error.proc); OutString(" in "); OutString(K.imp_error.lib) |
| END; |
| OutString("'"); |
| OutLn |
| END imp_error; |
| PROCEDURE init* (import_, code: INTEGER); |
| PROCEDURE init* (_import, code: INTEGER); |
| BEGIN |
| multi := FALSE; |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| base := code - SizeOfHeader; |
| K.sysfunc2(68, 11); |
| InitializeCriticalSection(CriticalSection); |
| K._init; |
| _import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0); |
| IF ~_import THEN |
| import := (K.dll_Load(_import) = 0) & (K.imp_error.error = 0); |
| IF ~import THEN |
| imp_error |
| END |
| END init; |
| /programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016, 2018, 2020 Anton Krotov |
| Copyright 2016, 2018 Anton Krotov |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| 24,7 → 24,7 |
| DRAW_WINDOW = PROCEDURE; |
| TDialog = RECORD |
| _type, |
| type, |
| procinfo, |
| com_area_name, |
| com_area, |
| 61,7 → 61,7 |
| IF res # NIL THEN |
| res.s_com_area_name := "FFFFFFFF_color_dlg"; |
| res.com_area := 0; |
| res._type := 0; |
| res.type := 0; |
| res.color_type := 0; |
| res.procinfo := sys.ADR(res.procinf[0]); |
| res.com_area_name := sys.ADR(res.s_com_area_name[0]); |
| /programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 |
|---|
| 13,7 → 13,7 |
| CONST |
| slash* = "/"; |
| eol* = 0DX + 0AX; |
| OS* = "KOS"; |
| bit_depth* = RTL.bit_depth; |
| maxint* = RTL.maxint; |
| 24,8 → 24,6 |
| TYPE |
| DAYS = ARRAY 12, 31, 2 OF INTEGER; |
| FNAME = ARRAY 520 OF CHAR; |
| FS = POINTER TO rFS; |
| 54,11 → 52,11 |
| Console: BOOLEAN; |
| days: DAYS; |
| Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
| argc*: INTEGER; |
| eol*: ARRAY 3 OF CHAR; |
| maxreal*: REAL; |
| 275,10 → 273,6 |
| END FileOpen; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| END chmod; |
| PROCEDURE GetTickCount* (): INTEGER; |
| RETURN K.sysfunc2(26, 9) |
| END GetTickCount; |
| 388,9 → 382,9 |
| s[j] := c; |
| INC(j) |
| END; |
| INC(i) |
| END |
| INC(i); |
| END; |
| END; |
| s[j] := 0X |
| END GetArg; |
| 414,9 → 408,9 |
| END isRelative; |
| PROCEDURE UnixTime* (): INTEGER; |
| PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
| VAR |
| date, time, year, month, day, hour, min, sec: INTEGER; |
| date, time: INTEGER; |
| BEGIN |
| date := K.sysfunc1(29); |
| 452,26 → 446,22 |
| sec := (time MOD 16) * 10 + sec; |
| time := time DIV 16; |
| INC(year, 2000) |
| year := year + 2000 |
| END now; |
| RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN 0 |
| END UnixTime; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| BEGIN |
| SYSTEM.GET32(SYSTEM.ADR(x), a); |
| SYSTEM.GET32(SYSTEM.ADR(x) + 4, b) |
| RETURN a |
| END splitf; |
| PROCEDURE d2s* (x: REAL): INTEGER; |
| VAR |
| h, l, s, e: INTEGER; |
| BEGIN |
| e := splitf(x, l, h); |
| SYSTEM.GET(SYSTEM.ADR(x), l); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, h); |
| s := ASR(h, 31) MOD 2; |
| e := (h DIV 100000H) MOD 2048; |
| 490,7 → 480,7 |
| l := 0 |
| ELSIF e = 2047 THEN |
| e := 1151; |
| IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN |
| IF (h MOD 100000H # 0) OR (l # 0) THEN |
| h := 80000H; |
| l := 0 |
| END |
| 501,55 → 491,21 |
| END d2s; |
| PROCEDURE init (VAR days: DAYS); |
| VAR |
| i, j, n0, n1: INTEGER; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| BEGIN |
| SYSTEM.GET(SYSTEM.ADR(x), a); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, b) |
| RETURN a |
| END splitf; |
| 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; |
| BEGIN |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| maxreal := 1.9; |
| PACK(maxreal, 1023); |
| Console := API._import; |
| Console := API.import; |
| IF Console THEN |
| con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) |
| END; |
| ParamParse |
| END init; |
| BEGIN |
| init(days) |
| END HOST. |
| /programs/develop/oberon07/Lib/KolibriOS/Math.ob07 |
|---|
| 1,8 → 1,18 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2018, 2019 Anton Krotov |
| Copyright (c) 2013-2014, 2018-2020 Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Math; |
| 225,16 → 235,6 |
| END frac; |
| PROCEDURE sqri* (x: INTEGER): INTEGER; |
| RETURN x * x |
| END sqri; |
| PROCEDURE sqrr* (x: REAL): REAL; |
| RETURN x * x |
| END sqrr; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| RETURN arctan2(x, sqrt(1.0 - x * x)) |
| END arcsin; |
| 349,40 → 349,6 |
| END power; |
| PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| VAR |
| i: INTEGER; |
| a: REAL; |
| BEGIN |
| a := 1.0; |
| IF base # 0.0 THEN |
| IF exponent # 0 THEN |
| IF exponent < 0 THEN |
| base := 1.0 / base |
| END; |
| i := ABS(exponent); |
| WHILE i > 0 DO |
| WHILE ~ODD(i) DO |
| i := LSR(i, 1); |
| base := sqrr(base) |
| END; |
| DEC(i); |
| a := a * base |
| END |
| ELSE |
| a := 1.0 |
| END |
| ELSE |
| ASSERT(exponent > 0); |
| a := 0.0 |
| END |
| RETURN a |
| END ipower; |
| PROCEDURE sgn* (x: REAL): INTEGER; |
| VAR |
| res: INTEGER; |
| 415,36 → 381,4 |
| END fact; |
| PROCEDURE DegToRad* (x: REAL): REAL; |
| RETURN x * (pi / 180.0) |
| END DegToRad; |
| PROCEDURE RadToDeg* (x: REAL): REAL; |
| RETURN x * (180.0 / pi) |
| END RadToDeg; |
| (* Return hypotenuse of triangle *) |
| PROCEDURE hypot* (x, y: REAL): REAL; |
| VAR |
| a: REAL; |
| BEGIN |
| x := ABS(x); |
| y := ABS(y); |
| IF x > y THEN |
| a := x * sqrt(1.0 + sqrr(y / x)) |
| ELSE |
| IF x > 0.0 THEN |
| a := y * sqrt(1.0 + sqrr(x / y)) |
| ELSE |
| a := y |
| END |
| END |
| RETURN a |
| END hypot; |
| END Math. |
| /programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016, 2018, 2020 Anton Krotov |
| Copyright 2016, 2018 Anton Krotov |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| 24,7 → 24,7 |
| DRAW_WINDOW = PROCEDURE; |
| TDialog = RECORD |
| _type, |
| type, |
| procinfo, |
| com_area_name, |
| com_area, |
| 66,7 → 66,7 |
| END |
| END Show; |
| PROCEDURE Create*(draw_window: DRAW_WINDOW; _type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog; |
| PROCEDURE Create*(draw_window: DRAW_WINDOW; type: INTEGER; def_path, filter: ARRAY OF CHAR): Dialog; |
| VAR res: Dialog; n, i: INTEGER; |
| PROCEDURE replace(VAR str: ARRAY OF CHAR; c1, c2: CHAR); |
| 88,7 → 88,7 |
| IF res.filter_area # NIL THEN |
| res.s_com_area_name := "FFFFFFFF_open_dialog"; |
| res.com_area := 0; |
| res._type := _type; |
| res.type := type; |
| res.draw_window := draw_window; |
| COPY(def_path, res.s_dir_default_path); |
| COPY(filter, res.filter_area.filter); |
| /programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 |
|---|
| 372,29 → 372,33 |
| PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| i, a, b: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| str[i] := 0X; |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| a := 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END IntToStr; |
| PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 402,12 → 406,19 |
| ASSERT(n1 + n2 < LEN(s1)); |
| SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER); |
| PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
| VAR |
| s, temp: ARRAY 1024 OF CHAR; |
| 426,9 → 437,11 |
| |11: s := "BYTE out of range" |
| END; |
| append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
| append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
| append(s, API.eol); |
| append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
| append(s, "line: "); IntToStr(line, temp); append(s, temp); |
| API.DebugMsg(SYSTEM.ADR(s[0]), name); |
| API.exit_thread(0) |
| /programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 |
|---|
| 1,5 → 1,5 |
| (* |
| Copyright 2016, 2018, 2020 KolibriOS team |
| Copyright 2016, 2018 KolibriOS team |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| 203,7 → 203,7 |
| img_create *: PROCEDURE (width, height, _type: INTEGER): INTEGER; |
| img_create *: PROCEDURE (width, height, type: INTEGER): INTEGER; |
| (* |
| ;;------------------------------------------------------------------------------------------------;; |
| ;? creates an Image structure and initializes some its fields ;; |
| /programs/develop/oberon07/Lib/Linux32/File.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux32/In.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux32/Args.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux32/API.ob07 |
|---|
| 12,34 → 12,54 |
| CONST |
| eol* = 0AX; |
| RTLD_LAZY* = 1; |
| BIT_DEPTH* = 32; |
| RTLD_LAZY = 1; |
| TYPE |
| SOFINI = PROCEDURE; |
| TP* = ARRAY 2 OF INTEGER; |
| SOFINI* = PROCEDURE; |
| VAR |
| MainParam*, libc*: INTEGER; |
| eol*: ARRAY 2 OF CHAR; |
| MainParam*: INTEGER; |
| libc*, librt*: INTEGER; |
| dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER; |
| dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER; |
| exit*, |
| exit_thread* : PROCEDURE [linux] (code: INTEGER); |
| puts : PROCEDURE [linux] (pStr: INTEGER); |
| malloc : PROCEDURE [linux] (size: INTEGER): INTEGER; |
| free : PROCEDURE [linux] (ptr: INTEGER); |
| stdout*, |
| stdin*, |
| stderr* : INTEGER; |
| malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; |
| free* : PROCEDURE [linux] (ptr: INTEGER); |
| _exit* : PROCEDURE [linux] (code: INTEGER); |
| puts* : PROCEDURE [linux] (pStr: INTEGER); |
| fwrite*, |
| fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
| fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; |
| clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
| fini: SOFINI; |
| PROCEDURE putc* (c: CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) |
| END putc; |
| PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| BEGIN |
| puts(lpCaption); |
| 74,7 → 94,7 |
| END _DISPOSE; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| VAR |
| sym: INTEGER; |
| 82,7 → 102,7 |
| sym := dlsym(lib, SYSTEM.ADR(name[0])); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| END GetProcAdr; |
| PROCEDURE init* (sp, code: INTEGER); |
| 91,16 → 111,42 |
| SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); |
| SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); |
| MainParam := sp; |
| eol := 0AX; |
| libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY); |
| GetSym(libc, "exit", SYSTEM.ADR(exit_thread)); |
| exit := exit_thread; |
| GetSym(libc, "puts", SYSTEM.ADR(puts)); |
| GetSym(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetSym(libc, "free", SYSTEM.ADR(free)); |
| GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetProcAdr(libc, "free", SYSTEM.ADR(free)); |
| GetProcAdr(libc, "exit", SYSTEM.ADR(_exit)); |
| GetProcAdr(libc, "stdout", SYSTEM.ADR(stdout)); |
| GetProcAdr(libc, "stdin", SYSTEM.ADR(stdin)); |
| GetProcAdr(libc, "stderr", SYSTEM.ADR(stderr)); |
| SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); |
| SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); |
| GetProcAdr(libc, "puts", SYSTEM.ADR(puts)); |
| GetProcAdr(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetProcAdr(libc, "fread", SYSTEM.ADR(fread)); |
| GetProcAdr(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetProcAdr(libc, "time", SYSTEM.ADR(time)); |
| librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); |
| GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| END init; |
| PROCEDURE exit* (code: INTEGER); |
| BEGIN |
| _exit(code) |
| END exit; |
| PROCEDURE exit_thread* (code: INTEGER); |
| BEGIN |
| _exit(code) |
| END exit_thread; |
| PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
| RETURN 0 |
| END dllentry; |
| /programs/develop/oberon07/Lib/Linux32/HOST.ob07 |
|---|
| 13,42 → 13,25 |
| CONST |
| slash* = "/"; |
| eol* = 0AX; |
| OS* = "LINUX"; |
| bit_depth* = RTL.bit_depth; |
| maxint* = RTL.maxint; |
| minint* = RTL.minint; |
| RTLD_LAZY = 1; |
| TYPE |
| TP = ARRAY 2 OF INTEGER; |
| VAR |
| maxreal*: REAL; |
| argc: INTEGER; |
| libc, librt: INTEGER; |
| eol*: ARRAY 2 OF CHAR; |
| stdout: INTEGER; |
| maxreal*: REAL; |
| fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
| fclose : PROCEDURE [linux] (file: INTEGER): INTEGER; |
| _chmod : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER; |
| time : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
| clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| exit : PROCEDURE [linux] (code: INTEGER); |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| exit(code) |
| API.exit(code) |
| END ExitProcess; |
| 92,7 → 75,7 |
| res: INTEGER; |
| BEGIN |
| res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| IF res <= 0 THEN |
| res := -1 |
| END |
| 106,7 → 89,7 |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| IF res <= 0 THEN |
| res := -1 |
| END |
| 116,45 → 99,34 |
| PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) |
| RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) |
| END FileCreate; |
| PROCEDURE FileClose* (File: INTEGER); |
| BEGIN |
| File := fclose(File) |
| File := API.fclose(File) |
| END FileClose; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *) |
| END chmod; |
| PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) |
| RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) |
| END FileOpen; |
| PROCEDURE OutChar* (c: CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) |
| API.putc(c) |
| END OutChar; |
| PROCEDURE GetTickCount* (): INTEGER; |
| VAR |
| tp: TP; |
| tp: API.TP; |
| res: INTEGER; |
| BEGIN |
| IF clock_gettime(0, tp) = 0 THEN |
| IF API.clock_gettime(0, tp) = 0 THEN |
| res := tp[0] * 100 + tp[1] DIV 10000000 |
| ELSE |
| res := 0 |
| 169,25 → 141,22 |
| END isRelative; |
| PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
| END now; |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN time(0) |
| RETURN API.time(0) |
| END UnixTime; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| BEGIN |
| SYSTEM.GET32(SYSTEM.ADR(x), a); |
| SYSTEM.GET32(SYSTEM.ADR(x) + 4, b) |
| RETURN a |
| END splitf; |
| PROCEDURE d2s* (x: REAL): INTEGER; |
| VAR |
| h, l, s, e: INTEGER; |
| BEGIN |
| e := splitf(x, l, h); |
| SYSTEM.GET(SYSTEM.ADR(x), l); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, h); |
| s := ASR(h, 31) MOD 2; |
| e := (h DIV 100000H) MOD 2048; |
| 206,7 → 175,7 |
| l := 0 |
| ELSIF e = 2047 THEN |
| e := 1151; |
| IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN |
| IF (h MOD 100000H # 0) OR (l # 0) THEN |
| h := 80000H; |
| l := 0 |
| END |
| 217,32 → 186,23 |
| END d2s; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| VAR |
| sym: INTEGER; |
| res: INTEGER; |
| BEGIN |
| sym := API.dlsym(lib, SYSTEM.ADR(name[0])); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| a := 0; |
| b := 0; |
| SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
| SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| BEGIN |
| eol := 0AX; |
| maxreal := 1.9; |
| PACK(maxreal, 1023); |
| SYSTEM.GET(API.MainParam, argc); |
| libc := API.libc; |
| GetSym(libc, "fread", SYSTEM.ADR(fread)); |
| GetSym(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetSym(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetSym(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetSym(libc, "chmod", SYSTEM.ADR(_chmod)); |
| GetSym(libc, "time", SYSTEM.ADR(time)); |
| GetSym(libc, "exit", SYSTEM.ADR(exit)); |
| GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); |
| GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| SYSTEM.GET(API.MainParam, argc) |
| END HOST. |
| /programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 |
|---|
| 7,17 → 7,19 |
| MODULE LINAPI; |
| IMPORT SYSTEM, API, Libdl; |
| IMPORT SYSTEM, API; |
| TYPE |
| TP* = ARRAY 2 OF INTEGER; |
| SOFINI* = PROCEDURE; |
| TP* = API.TP; |
| SOFINI* = API.SOFINI; |
| VAR |
| argc*, envc*: INTEGER; |
| libc*, librt*: INTEGER; |
| stdout*, |
| 37,6 → 39,37 |
| clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
| VAR |
| i, len, ptr: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| len := LEN(s) - 1; |
| IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN |
| SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); |
| REPEAT |
| SYSTEM.GET(ptr, c); |
| s[i] := c; |
| INC(i); |
| INC(ptr) |
| UNTIL (c = 0X) OR (i = len) |
| END; |
| s[i] := 0X |
| END GetArg; |
| PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR); |
| BEGIN |
| IF (0 <= n) & (n < envc) THEN |
| GetArg(n + argc + 1, s) |
| ELSE |
| s[0] := 0X |
| END |
| END GetEnv; |
| PROCEDURE SetFini* (ProcFini: SOFINI); |
| BEGIN |
| API.SetFini(ProcFini) |
| 43,38 → 76,42 |
| END SetFini; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE init; |
| VAR |
| sym: INTEGER; |
| ptr: INTEGER; |
| BEGIN |
| sym := Libdl.sym(lib, name); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| 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; |
| PROCEDURE init; |
| BEGIN |
| libc := API.libc; |
| GetSym(libc, "exit", SYSTEM.ADR(exit)); |
| GetSym(libc, "puts", SYSTEM.ADR(puts)); |
| GetSym(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetSym(libc, "free", SYSTEM.ADR(free)); |
| GetSym(libc, "fread", SYSTEM.ADR(fread)); |
| GetSym(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetSym(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetSym(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetSym(libc, "time", SYSTEM.ADR(time)); |
| stdout := API.stdout; |
| stdin := API.stdin; |
| stderr := API.stderr; |
| GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| GetSym(libc, "stdin", SYSTEM.ADR(stdin)); SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); |
| GetSym(libc, "stderr", SYSTEM.ADR(stderr)); SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); |
| malloc := API.malloc; |
| free := API.free; |
| exit := API._exit; |
| puts := API.puts; |
| fwrite := API.fwrite; |
| fread := API.fread; |
| fopen := API.fopen; |
| fclose := API.fclose; |
| time := API.time; |
| librt := Libdl.open("librt.so.1", Libdl.LAZY); |
| librt := API.librt; |
| GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| clock_gettime := API.clock_gettime |
| END init; |
| /programs/develop/oberon07/Lib/Linux32/Math.ob07 |
|---|
| 1,8 → 1,18 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2018, 2019 Anton Krotov |
| Copyright (c) 2013-2014, 2018-2020 Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Math; |
| 225,16 → 235,6 |
| END frac; |
| PROCEDURE sqri* (x: INTEGER): INTEGER; |
| RETURN x * x |
| END sqri; |
| PROCEDURE sqrr* (x: REAL): REAL; |
| RETURN x * x |
| END sqrr; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| RETURN arctan2(x, sqrt(1.0 - x * x)) |
| END arcsin; |
| 349,40 → 349,6 |
| END power; |
| PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| VAR |
| i: INTEGER; |
| a: REAL; |
| BEGIN |
| a := 1.0; |
| IF base # 0.0 THEN |
| IF exponent # 0 THEN |
| IF exponent < 0 THEN |
| base := 1.0 / base |
| END; |
| i := ABS(exponent); |
| WHILE i > 0 DO |
| WHILE ~ODD(i) DO |
| i := LSR(i, 1); |
| base := sqrr(base) |
| END; |
| DEC(i); |
| a := a * base |
| END |
| ELSE |
| a := 1.0 |
| END |
| ELSE |
| ASSERT(exponent > 0); |
| a := 0.0 |
| END |
| RETURN a |
| END ipower; |
| PROCEDURE sgn* (x: REAL): INTEGER; |
| VAR |
| res: INTEGER; |
| 415,36 → 381,4 |
| END fact; |
| PROCEDURE DegToRad* (x: REAL): REAL; |
| RETURN x * (pi / 180.0) |
| END DegToRad; |
| PROCEDURE RadToDeg* (x: REAL): REAL; |
| RETURN x * (180.0 / pi) |
| END RadToDeg; |
| (* Return hypotenuse of triangle *) |
| PROCEDURE hypot* (x, y: REAL): REAL; |
| VAR |
| a: REAL; |
| BEGIN |
| x := ABS(x); |
| y := ABS(y); |
| IF x > y THEN |
| a := x * sqrt(1.0 + sqrr(y / x)) |
| ELSE |
| IF x > 0.0 THEN |
| a := y * sqrt(1.0 + sqrr(x / y)) |
| ELSE |
| a := y |
| END |
| END |
| RETURN a |
| END hypot; |
| END Math. |
| /programs/develop/oberon07/Lib/Linux32/Out.ob07 |
|---|
| 1,77 → 1,277 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Out; |
| IMPORT SYSTEM, Libdl; |
| IMPORT sys := SYSTEM, API; |
| CONST |
| d = 1.0 - 5.0E-12; |
| VAR |
| printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER); |
| printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER); |
| printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision: INTEGER; x: REAL); |
| Realp: PROCEDURE (x: REAL; width: INTEGER); |
| PROCEDURE Char* (x: CHAR); |
| BEGIN |
| printf1(SYSTEM.SADR("%c"), ORD(x)) |
| API.putc(x) |
| END Char; |
| PROCEDURE String* (s: ARRAY OF CHAR); |
| VAR |
| i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0])) |
| i := 0; |
| WHILE (i < LEN(s)) & (s[i] # 0X) DO |
| Char(s[i]); |
| INC(i) |
| END |
| END String; |
| PROCEDURE Ln*; |
| PROCEDURE WriteInt(x, n: INTEGER); |
| VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN; |
| BEGIN |
| printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX)) |
| END Ln; |
| i := 0; |
| IF n < 1 THEN |
| n := 1 |
| END; |
| IF x < 0 THEN |
| x := -x; |
| DEC(n); |
| neg := TRUE |
| END; |
| REPEAT |
| a[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| WHILE n > i DO |
| Char(" "); |
| DEC(n) |
| END; |
| IF neg THEN |
| Char("-") |
| END; |
| REPEAT |
| DEC(i); |
| Char(a[i]) |
| UNTIL i = 0 |
| END WriteInt; |
| PROCEDURE IsNan(AValue: REAL): BOOLEAN; |
| VAR h, l: SET; |
| BEGIN |
| sys.GET(sys.ADR(AValue), l); |
| sys.GET(sys.ADR(AValue) + 4, h) |
| RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) |
| END IsNan; |
| PROCEDURE IsInf(x: REAL): BOOLEAN; |
| RETURN ABS(x) = sys.INF() |
| END IsInf; |
| PROCEDURE Int* (x, width: INTEGER); |
| VAR i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%*d"), width, x) |
| IF x # 80000000H THEN |
| WriteInt(x, width) |
| ELSE |
| FOR i := 12 TO width DO |
| Char(20X) |
| END; |
| String("-2147483648") |
| END |
| END Int; |
| PROCEDURE OutInf(x: REAL; width: INTEGER); |
| VAR s: ARRAY 5 OF CHAR; i: INTEGER; |
| BEGIN |
| IF IsNan(x) THEN |
| s := "Nan"; |
| INC(width) |
| ELSIF IsInf(x) & (x > 0.0) THEN |
| s := "+Inf" |
| ELSIF IsInf(x) & (x < 0.0) THEN |
| s := "-Inf" |
| END; |
| FOR i := 1 TO width - 4 DO |
| Char(" ") |
| END; |
| String(s) |
| END OutInf; |
| PROCEDURE Ln*; |
| BEGIN |
| Char(0AX) |
| END Ln; |
| PROCEDURE _FixReal(x: REAL; width, p: INTEGER); |
| VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; |
| BEGIN |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSIF p < 0 THEN |
| Realp(x, width) |
| ELSE |
| len := 0; |
| minus := FALSE; |
| IF x < 0.0 THEN |
| minus := TRUE; |
| INC(len); |
| x := ABS(x) |
| END; |
| e := 0; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| IF e >= 0 THEN |
| len := len + e + p + 1; |
| IF x > 9.0 + d THEN |
| INC(len) |
| END; |
| IF p > 0 THEN |
| INC(len) |
| END; |
| ELSE |
| len := len + p + 2 |
| END; |
| FOR i := 1 TO width - len DO |
| Char(" ") |
| END; |
| IF minus THEN |
| Char("-") |
| END; |
| y := x; |
| WHILE (y < 1.0) & (y # 0.0) DO |
| y := y * 10.0; |
| DEC(e) |
| END; |
| IF e < 0 THEN |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char("1"); |
| x := 0.0 |
| ELSE |
| Char("0"); |
| x := x * 10.0 |
| END |
| ELSE |
| WHILE e >= 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| IF x > 9.0 THEN |
| String("10") |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0") + 1)) |
| END; |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(e) |
| END |
| END; |
| IF p > 0 THEN |
| Char(".") |
| END; |
| WHILE p > 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char(CHR(FLOOR(x) + ORD("0") + 1)); |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(p) |
| END |
| END |
| END _FixReal; |
| PROCEDURE Real* (x: REAL; width: INTEGER); |
| VAR e, n, i: INTEGER; minus: BOOLEAN; |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x) |
| Realp := Real; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSE |
| e := 0; |
| n := 0; |
| IF width > 23 THEN |
| n := width - 23; |
| width := 23 |
| ELSIF width < 9 THEN |
| width := 9 |
| END; |
| width := width - 5; |
| IF x < 0.0 THEN |
| x := -x; |
| minus := TRUE |
| ELSE |
| minus := FALSE |
| END; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| WHILE (x < 1.0) & (x # 0.0) DO |
| x := x * 10.0; |
| DEC(e) |
| END; |
| IF x > 9.0 + d THEN |
| x := 1.0; |
| INC(e) |
| END; |
| FOR i := 1 TO n DO |
| Char(" ") |
| END; |
| IF minus THEN |
| x := -x |
| END; |
| _FixReal(x, width, width - 3); |
| Char("E"); |
| IF e >= 0 THEN |
| Char("+") |
| ELSE |
| Char("-"); |
| e := ABS(e) |
| END; |
| IF e < 100 THEN |
| Char("0") |
| END; |
| IF e < 10 THEN |
| Char("0") |
| END; |
| Int(e, 0) |
| END |
| END Real; |
| PROCEDURE FixReal* (x: REAL; width, precision: INTEGER); |
| PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*f"), width, precision, x) |
| Realp := Real; |
| _FixReal(x, width, p) |
| END FixReal; |
| PROCEDURE Open*; |
| END Open; |
| PROCEDURE init; |
| VAR |
| libc, printf: INTEGER; |
| BEGIN |
| libc := Libdl.open("libc.so.6", Libdl.LAZY); |
| ASSERT(libc # 0); |
| printf := Libdl.sym(libc, "printf"); |
| ASSERT(printf # 0); |
| SYSTEM.PUT(SYSTEM.ADR(printf1), printf); |
| SYSTEM.PUT(SYSTEM.ADR(printf2), printf); |
| SYSTEM.PUT(SYSTEM.ADR(printf3), printf); |
| END init; |
| BEGIN |
| init |
| END Out. |
| /programs/develop/oberon07/Lib/Linux32/RTL.ob07 |
|---|
| 372,29 → 372,33 |
| PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| i, a, b: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| str[i] := 0X; |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| a := 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END IntToStr; |
| PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 402,12 → 406,19 |
| ASSERT(n1 + n2 < LEN(s1)); |
| SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER); |
| PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
| VAR |
| s, temp: ARRAY 1024 OF CHAR; |
| 426,9 → 437,11 |
| |11: s := "BYTE out of range" |
| END; |
| append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
| append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
| append(s, API.eol); |
| append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
| append(s, "line: "); IntToStr(line, temp); append(s, temp); |
| API.DebugMsg(SYSTEM.ADR(s[0]), name); |
| API.exit_thread(0) |
| /programs/develop/oberon07/Lib/Linux64/File.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux64/In.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux64/Args.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Linux64/API.ob07 |
|---|
| 12,34 → 12,54 |
| CONST |
| eol* = 0AX; |
| RTLD_LAZY* = 1; |
| BIT_DEPTH* = 64; |
| RTLD_LAZY = 1; |
| TYPE |
| SOFINI = PROCEDURE; |
| TP* = ARRAY 2 OF INTEGER; |
| SOFINI* = PROCEDURE; |
| VAR |
| MainParam*, libc*: INTEGER; |
| eol*: ARRAY 2 OF CHAR; |
| MainParam*: INTEGER; |
| libc*, librt*: INTEGER; |
| dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER; |
| dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER; |
| exit*, |
| exit_thread* : PROCEDURE [linux] (code: INTEGER); |
| puts : PROCEDURE [linux] (pStr: INTEGER); |
| malloc : PROCEDURE [linux] (size: INTEGER): INTEGER; |
| free : PROCEDURE [linux] (ptr: INTEGER); |
| stdout*, |
| stdin*, |
| stderr* : INTEGER; |
| malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; |
| free* : PROCEDURE [linux] (ptr: INTEGER); |
| _exit* : PROCEDURE [linux] (code: INTEGER); |
| puts* : PROCEDURE [linux] (pStr: INTEGER); |
| fwrite*, |
| fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
| fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; |
| clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
| fini: SOFINI; |
| PROCEDURE putc* (c: CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) |
| END putc; |
| PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| BEGIN |
| puts(lpCaption); |
| 74,7 → 94,7 |
| END _DISPOSE; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| VAR |
| sym: INTEGER; |
| 82,7 → 102,7 |
| sym := dlsym(lib, SYSTEM.ADR(name[0])); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| END GetProcAdr; |
| PROCEDURE init* (sp, code: INTEGER); |
| 91,16 → 111,42 |
| SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); |
| SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); |
| MainParam := sp; |
| eol := 0AX; |
| libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY); |
| GetSym(libc, "exit", SYSTEM.ADR(exit_thread)); |
| exit := exit_thread; |
| GetSym(libc, "puts", SYSTEM.ADR(puts)); |
| GetSym(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetSym(libc, "free", SYSTEM.ADR(free)); |
| GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetProcAdr(libc, "free", SYSTEM.ADR(free)); |
| GetProcAdr(libc, "exit", SYSTEM.ADR(_exit)); |
| GetProcAdr(libc, "stdout", SYSTEM.ADR(stdout)); |
| GetProcAdr(libc, "stdin", SYSTEM.ADR(stdin)); |
| GetProcAdr(libc, "stderr", SYSTEM.ADR(stderr)); |
| SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); |
| SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); |
| GetProcAdr(libc, "puts", SYSTEM.ADR(puts)); |
| GetProcAdr(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetProcAdr(libc, "fread", SYSTEM.ADR(fread)); |
| GetProcAdr(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetProcAdr(libc, "time", SYSTEM.ADR(time)); |
| librt := dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); |
| GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| END init; |
| PROCEDURE exit* (code: INTEGER); |
| BEGIN |
| _exit(code) |
| END exit; |
| PROCEDURE exit_thread* (code: INTEGER); |
| BEGIN |
| _exit(code) |
| END exit_thread; |
| PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
| RETURN 0 |
| END dllentry; |
| /programs/develop/oberon07/Lib/Linux64/HOST.ob07 |
|---|
| 13,42 → 13,25 |
| CONST |
| slash* = "/"; |
| eol* = 0AX; |
| OS* = "LINUX"; |
| bit_depth* = RTL.bit_depth; |
| maxint* = RTL.maxint; |
| minint* = RTL.minint; |
| RTLD_LAZY = 1; |
| TYPE |
| TP = ARRAY 2 OF INTEGER; |
| VAR |
| maxreal*: REAL; |
| argc: INTEGER; |
| libc, librt: INTEGER; |
| eol*: ARRAY 2 OF CHAR; |
| stdout: INTEGER; |
| maxreal*: REAL; |
| fread, fwrite : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; |
| fopen : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; |
| fclose : PROCEDURE [linux] (file: INTEGER): INTEGER; |
| _chmod : PROCEDURE [linux] (fname: INTEGER; mode: SET): INTEGER; |
| time : PROCEDURE [linux] (ptr: INTEGER): INTEGER; |
| clock_gettime : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| exit : PROCEDURE [linux] (code: INTEGER); |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| exit(code) |
| API.exit(code) |
| END ExitProcess; |
| 92,7 → 75,7 |
| res: INTEGER; |
| BEGIN |
| res := fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| res := API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| IF res <= 0 THEN |
| res := -1 |
| END |
| 106,7 → 89,7 |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| res := API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F); |
| IF res <= 0 THEN |
| res := -1 |
| END |
| 116,45 → 99,34 |
| PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) |
| RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) |
| END FileCreate; |
| PROCEDURE FileClose* (File: INTEGER); |
| BEGIN |
| File := fclose(File) |
| File := API.fclose(File) |
| END FileClose; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := _chmod(SYSTEM.ADR(FName[0]), {0, 2..8}) (* rwxrwxr-x *) |
| END chmod; |
| PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) |
| RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) |
| END FileOpen; |
| PROCEDURE OutChar* (c: CHAR); |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) |
| API.putc(c) |
| END OutChar; |
| PROCEDURE GetTickCount* (): INTEGER; |
| VAR |
| tp: TP; |
| tp: API.TP; |
| res: INTEGER; |
| BEGIN |
| IF clock_gettime(0, tp) = 0 THEN |
| IF API.clock_gettime(0, tp) = 0 THEN |
| res := tp[0] * 100 + tp[1] DIV 10000000 |
| ELSE |
| res := 0 |
| 169,31 → 141,22 |
| END isRelative; |
| PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
| END now; |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN time(0) |
| RETURN API.time(0) |
| END UnixTime; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| BEGIN |
| a := 0; |
| b := 0; |
| SYSTEM.GET32(SYSTEM.ADR(x), a); |
| SYSTEM.GET32(SYSTEM.ADR(x) + 4, b); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| PROCEDURE d2s* (x: REAL): INTEGER; |
| VAR |
| h, l, s, e: INTEGER; |
| BEGIN |
| e := splitf(x, l, h); |
| SYSTEM.GET(SYSTEM.ADR(x), l); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, h); |
| s := ASR(h, 31) MOD 2; |
| e := (h DIV 100000H) MOD 2048; |
| 223,32 → 186,23 |
| END d2s; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| VAR |
| sym: INTEGER; |
| res: INTEGER; |
| BEGIN |
| sym := API.dlsym(lib, SYSTEM.ADR(name[0])); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| a := 0; |
| b := 0; |
| SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
| SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| BEGIN |
| eol := 0AX; |
| maxreal := 1.9; |
| PACK(maxreal, 1023); |
| SYSTEM.GET(API.MainParam, argc); |
| libc := API.libc; |
| GetSym(libc, "fread", SYSTEM.ADR(fread)); |
| GetSym(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetSym(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetSym(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetSym(libc, "chmod", SYSTEM.ADR(_chmod)); |
| GetSym(libc, "time", SYSTEM.ADR(time)); |
| GetSym(libc, "exit", SYSTEM.ADR(exit)); |
| GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| librt := API.dlopen(SYSTEM.SADR("librt.so.1"), RTLD_LAZY); |
| GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| SYSTEM.GET(API.MainParam, argc) |
| END HOST. |
| /programs/develop/oberon07/Lib/Linux64/LINAPI.ob07 |
|---|
| 7,17 → 7,19 |
| MODULE LINAPI; |
| IMPORT SYSTEM, API, Libdl; |
| IMPORT SYSTEM, API; |
| TYPE |
| TP* = ARRAY 2 OF INTEGER; |
| SOFINI* = PROCEDURE; |
| TP* = API.TP; |
| SOFINI* = API.SOFINI; |
| VAR |
| argc*, envc*: INTEGER; |
| libc*, librt*: INTEGER; |
| stdout*, |
| 37,6 → 39,37 |
| clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; |
| PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
| VAR |
| i, len, ptr: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| len := LEN(s) - 1; |
| IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN |
| SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); |
| REPEAT |
| SYSTEM.GET(ptr, c); |
| s[i] := c; |
| INC(i); |
| INC(ptr) |
| UNTIL (c = 0X) OR (i = len) |
| END; |
| s[i] := 0X |
| END GetArg; |
| PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR); |
| BEGIN |
| IF (0 <= n) & (n < envc) THEN |
| GetArg(n + argc + 1, s) |
| ELSE |
| s[0] := 0X |
| END |
| END GetEnv; |
| PROCEDURE SetFini* (ProcFini: SOFINI); |
| BEGIN |
| API.SetFini(ProcFini) |
| 43,38 → 76,42 |
| END SetFini; |
| PROCEDURE GetSym (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); |
| PROCEDURE init; |
| VAR |
| sym: INTEGER; |
| ptr: INTEGER; |
| BEGIN |
| sym := Libdl.sym(lib, name); |
| ASSERT(sym # 0); |
| SYSTEM.PUT(VarAdr, sym) |
| END GetSym; |
| 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; |
| PROCEDURE init; |
| BEGIN |
| libc := API.libc; |
| GetSym(libc, "exit", SYSTEM.ADR(exit)); |
| GetSym(libc, "puts", SYSTEM.ADR(puts)); |
| GetSym(libc, "malloc", SYSTEM.ADR(malloc)); |
| GetSym(libc, "free", SYSTEM.ADR(free)); |
| GetSym(libc, "fread", SYSTEM.ADR(fread)); |
| GetSym(libc, "fwrite", SYSTEM.ADR(fwrite)); |
| GetSym(libc, "fopen", SYSTEM.ADR(fopen)); |
| GetSym(libc, "fclose", SYSTEM.ADR(fclose)); |
| GetSym(libc, "time", SYSTEM.ADR(time)); |
| stdout := API.stdout; |
| stdin := API.stdin; |
| stderr := API.stderr; |
| GetSym(libc, "stdout", SYSTEM.ADR(stdout)); SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); |
| GetSym(libc, "stdin", SYSTEM.ADR(stdin)); SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); |
| GetSym(libc, "stderr", SYSTEM.ADR(stderr)); SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); |
| malloc := API.malloc; |
| free := API.free; |
| exit := API._exit; |
| puts := API.puts; |
| fwrite := API.fwrite; |
| fread := API.fread; |
| fopen := API.fopen; |
| fclose := API.fclose; |
| time := API.time; |
| librt := Libdl.open("librt.so.1", Libdl.LAZY); |
| librt := API.librt; |
| GetSym(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) |
| clock_gettime := API.clock_gettime |
| END init; |
| /programs/develop/oberon07/Lib/Linux64/Math.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| 12,32 → 12,22 |
| CONST |
| pi* = 3.1415926535897932384626433832795028841972E0; |
| e* = 2.7182818284590452353602874713526624977572E0; |
| e *= 2.71828182845904523; |
| pi *= 3.14159265358979324; |
| ln2 *= 0.693147180559945309; |
| ZERO = 0.0E0; |
| ONE = 1.0E0; |
| HALF = 0.5E0; |
| TWO = 2.0E0; |
| sqrtHalf = 0.70710678118654752440E0; |
| eps = 5.5511151E-17; |
| ln2Inv = 1.44269504088896340735992468100189213E0; |
| piInv = ONE / pi; |
| Limit = 1.0536712E-8; |
| piByTwo = pi / TWO; |
| eps = 1.0E-16; |
| MaxCosArg = 1000000.0 * pi; |
| expoMax = 1023; |
| expoMin = 1 - expoMax; |
| VAR |
| LnInfinity, LnSmall, large, miny: REAL; |
| Exp: ARRAY 710 OF REAL; |
| PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; |
| BEGIN |
| ASSERT(x >= ZERO); |
| ASSERT(x >= 0.0); |
| SYSTEM.CODE( |
| 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) |
| 05DH, (* pop rbp *) |
| 48,314 → 38,179 |
| END sqrt; |
| PROCEDURE sqri* (x: INTEGER): INTEGER; |
| RETURN x * x |
| END sqri; |
| PROCEDURE sqrr* (x: REAL): REAL; |
| RETURN x * x |
| END sqrr; |
| PROCEDURE exp* (x: REAL): REAL; |
| CONST |
| c1 = 0.693359375E0; |
| c2 = -2.1219444005469058277E-4; |
| P0 = 0.249999999999999993E+0; |
| P1 = 0.694360001511792852E-2; |
| P2 = 0.165203300268279130E-4; |
| Q1 = 0.555538666969001188E-1; |
| Q2 = 0.495862884905441294E-3; |
| e25 = 1.284025416687741484; (* exp(0.25) *) |
| VAR |
| xn, g, p, q, z: REAL; |
| a, s, res: REAL; |
| neg: BOOLEAN; |
| n: INTEGER; |
| BEGIN |
| IF x > LnInfinity THEN |
| x := SYSTEM.INF() |
| ELSIF x < LnSmall THEN |
| x := ZERO |
| ELSIF ABS(x) < eps THEN |
| x := ONE |
| neg := x < 0.0; |
| IF neg THEN |
| x := -x |
| END; |
| IF x < FLT(LEN(Exp)) THEN |
| res := Exp[FLOOR(x)]; |
| x := x - FLT(FLOOR(x)); |
| WHILE x >= 0.25 DO |
| res := res * e25; |
| x := x - 0.25 |
| END |
| ELSE |
| IF x >= ZERO THEN |
| n := FLOOR(ln2Inv * x + HALF) |
| ELSE |
| n := FLOOR(ln2Inv * x - HALF) |
| res := SYSTEM.INF(); |
| x := 0.0 |
| END; |
| xn := FLT(n); |
| g := (x - xn * c1) - xn * c2; |
| z := g * g; |
| p := ((P2 * z + P1) * z + P0) * g; |
| q := (Q2 * z + Q1) * z + HALF; |
| x := HALF + p / (q - p); |
| PACK(x, n + 1) |
| n := 0; |
| a := 1.0; |
| s := 1.0; |
| REPEAT |
| INC(n); |
| a := a * x / FLT(n); |
| s := s + a |
| UNTIL a < eps; |
| IF neg THEN |
| res := 1.0 / (res * s) |
| ELSE |
| res := res * s |
| END |
| RETURN x |
| RETURN res |
| END exp; |
| PROCEDURE ln* (x: REAL): REAL; |
| CONST |
| c1 = 355.0E0 / 512.0E0; |
| c2 = -2.121944400546905827679E-4; |
| P0 = -0.64124943423745581147E+2; |
| P1 = 0.16383943563021534222E+2; |
| P2 = -0.78956112887491257267E+0; |
| Q0 = -0.76949932108494879777E+3; |
| Q1 = 0.31203222091924532844E+3; |
| Q2 = -0.35667977739034646171E+2; |
| VAR |
| zn, zd, r, z, w, p, q, xn: REAL; |
| a, x2, res: REAL; |
| n: INTEGER; |
| BEGIN |
| ASSERT(x > ZERO); |
| ASSERT(x > 0.0); |
| UNPK(x, n); |
| x := x * HALF; |
| IF x > sqrtHalf THEN |
| zn := x - ONE; |
| zd := x * HALF + HALF; |
| INC(n) |
| ELSE |
| zn := x - HALF; |
| zd := zn * HALF + HALF |
| END; |
| x := (x - 1.0) / (x + 1.0); |
| x2 := x * x; |
| res := x + FLT(n) * (ln2 * 0.5); |
| n := 1; |
| z := zn / zd; |
| w := z * z; |
| q := ((w + Q2) * w + Q1) * w + Q0; |
| p := w * ((P2 * w + P1) * w + P0); |
| r := z + z * (p / q); |
| xn := FLT(n) |
| REPEAT |
| INC(n, 2); |
| x := x * x2; |
| a := x / FLT(n); |
| res := res + a |
| UNTIL a < eps |
| RETURN (xn * c2 + r) + xn * c1 |
| RETURN res * 2.0 |
| END ln; |
| PROCEDURE power* (base, exponent: REAL): REAL; |
| BEGIN |
| ASSERT(base > ZERO) |
| ASSERT(base > 0.0) |
| RETURN exp(exponent * ln(base)) |
| END power; |
| PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| VAR |
| i: INTEGER; |
| a: REAL; |
| BEGIN |
| a := 1.0; |
| IF base # 0.0 THEN |
| IF exponent # 0 THEN |
| IF exponent < 0 THEN |
| base := 1.0 / base |
| END; |
| i := ABS(exponent); |
| WHILE i > 0 DO |
| WHILE ~ODD(i) DO |
| i := LSR(i, 1); |
| base := sqrr(base) |
| END; |
| DEC(i); |
| a := a * base |
| END |
| ELSE |
| a := 1.0 |
| END |
| ELSE |
| ASSERT(exponent > 0); |
| a := 0.0 |
| END |
| RETURN a |
| END ipower; |
| PROCEDURE log* (base, x: REAL): REAL; |
| BEGIN |
| ASSERT(base > ZERO); |
| ASSERT(x > ZERO) |
| ASSERT(base > 0.0); |
| ASSERT(x > 0.0) |
| RETURN ln(x) / ln(base) |
| END log; |
| PROCEDURE SinCos (x, y, sign: REAL): REAL; |
| CONST |
| ymax = 210828714; |
| c1 = 3.1416015625E0; |
| c2 = -8.908910206761537356617E-6; |
| r1 = -0.16666666666666665052E+0; |
| r2 = 0.83333333333331650314E-2; |
| r3 = -0.19841269841201840457E-3; |
| r4 = 0.27557319210152756119E-5; |
| r5 = -0.25052106798274584544E-7; |
| r6 = 0.16058936490371589114E-9; |
| r7 = -0.76429178068910467734E-12; |
| r8 = 0.27204790957888846175E-14; |
| PROCEDURE cos* (x: REAL): REAL; |
| VAR |
| a, res: REAL; |
| n: INTEGER; |
| xn, f, x1, g: REAL; |
| BEGIN |
| ASSERT(y < FLT(ymax)); |
| n := FLOOR(y * piInv + HALF); |
| xn := FLT(n); |
| IF ODD(n) THEN |
| sign := -sign |
| END; |
| x := ABS(x); |
| IF x # y THEN |
| xn := xn - HALF |
| END; |
| ASSERT(x <= MaxCosArg); |
| x1 := FLT(FLOOR(x)); |
| f := ((x1 - xn * c1) + (x - x1)) - xn * c2; |
| x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); |
| x := x * x; |
| res := 0.0; |
| a := 1.0; |
| n := -1; |
| IF ABS(f) < Limit THEN |
| x := sign * f |
| ELSE |
| g := f * f; |
| g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g; |
| g := f + f * g; |
| x := sign * g |
| END |
| REPEAT |
| INC(n, 2); |
| res := res + a; |
| a := -a * x / FLT(n*n + n) |
| UNTIL ABS(a) < eps |
| RETURN x |
| END SinCos; |
| RETURN res |
| END cos; |
| PROCEDURE sin* (x: REAL): REAL; |
| BEGIN |
| IF x < ZERO THEN |
| x := SinCos(x, -x, -ONE) |
| ELSE |
| x := SinCos(x, x, ONE) |
| END |
| RETURN x |
| ASSERT(ABS(x) <= MaxCosArg); |
| x := cos(x) |
| RETURN sqrt(1.0 - x * x) |
| END sin; |
| PROCEDURE cos* (x: REAL): REAL; |
| RETURN SinCos(x, ABS(x) + piByTwo, ONE) |
| END cos; |
| PROCEDURE tan* (x: REAL): REAL; |
| VAR |
| s, c: REAL; |
| BEGIN |
| s := sin(x); |
| c := sqrt(ONE - s * s); |
| x := ABS(x) / (TWO * pi); |
| x := x - FLT(FLOOR(x)); |
| IF (0.25 < x) & (x < 0.75) THEN |
| c := -c |
| END |
| RETURN s / c |
| ASSERT(ABS(x) <= MaxCosArg); |
| x := cos(x) |
| RETURN sqrt(1.0 - x * x) / x |
| END tan; |
| PROCEDURE arctan2* (y, x: REAL): REAL; |
| CONST |
| P0 = 0.216062307897242551884E+3; P1 = 0.3226620700132512059245E+3; |
| P2 = 0.13270239816397674701E+3; P3 = 0.1288838303415727934E+2; |
| Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3; |
| Q2 = 0.221050883028417680623E+3; Q3 = 0.3850148650835119501E+2; |
| Sqrt3 = 1.7320508075688772935E0; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| PROCEDURE arctan (x: REAL): REAL; |
| VAR |
| atan, z, z2, p, q: REAL; |
| yExp, xExp, Quadrant: INTEGER; |
| z, p, k: REAL; |
| BEGIN |
| IF ABS(x) < miny THEN |
| ASSERT(ABS(y) >= miny); |
| atan := piByTwo |
| ELSE |
| z := y; |
| UNPK(z, yExp); |
| z := x; |
| UNPK(z, xExp); |
| p := x / (x * x + 1.0); |
| z := p * x; |
| x := 0.0; |
| k := 0.0; |
| IF yExp - xExp >= expoMax - 3 THEN |
| atan := piByTwo |
| ELSIF yExp - xExp < expoMin + 3 THEN |
| atan := ZERO |
| ELSE |
| IF ABS(y) > ABS(x) THEN |
| z := ABS(x / y); |
| Quadrant := 2 |
| ELSE |
| z := ABS(y / x); |
| Quadrant := 0 |
| END; |
| REPEAT |
| k := k + 2.0; |
| x := x + p; |
| p := p * k * z / (k + 1.0) |
| UNTIL p < eps |
| IF z > TWO - Sqrt3 THEN |
| z := (z * Sqrt3 - ONE) / (Sqrt3 + z); |
| INC(Quadrant) |
| END; |
| RETURN x |
| END arctan; |
| IF ABS(z) < Limit THEN |
| atan := z |
| ELSE |
| z2 := z * z; |
| p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z; |
| q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0; |
| atan := p / q |
| END; |
| CASE Quadrant OF |
| |0: |
| |1: atan := atan + pi / 6.0 |
| |2: atan := piByTwo - atan |
| |3: atan := pi / 3.0 - atan |
| END |
| END; |
| BEGIN |
| ASSERT(ABS(x) <= 1.0); |
| IF x < ZERO THEN |
| atan := pi - atan |
| IF ABS(x) >= 0.707 THEN |
| x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) |
| ELSE |
| x := arctan(x / sqrt(1.0 - x * x)) |
| END |
| END; |
| IF y < ZERO THEN |
| atan := -atan |
| END |
| RETURN atan |
| END arctan2; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) <= ONE) |
| RETURN arctan2(x, sqrt(ONE - x * x)) |
| RETURN x |
| END arcsin; |
| PROCEDURE arccos* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) <= ONE) |
| RETURN arctan2(sqrt(ONE - x * x), x) |
| ASSERT(ABS(x) <= 1.0) |
| RETURN 0.5 * pi - arcsin(x) |
| END arccos; |
| PROCEDURE arctan* (x: REAL): REAL; |
| RETURN arctan2(x, ONE) |
| RETURN arcsin(x / sqrt(1.0 + x * x)) |
| END arctan; |
| 362,7 → 217,7 |
| PROCEDURE sinh* (x: REAL): REAL; |
| BEGIN |
| x := exp(x) |
| RETURN (x - ONE / x) * HALF |
| RETURN (x - 1.0 / x) * 0.5 |
| END sinh; |
| 369,7 → 224,7 |
| PROCEDURE cosh* (x: REAL): REAL; |
| BEGIN |
| x := exp(x) |
| RETURN (x + ONE / x) * HALF |
| RETURN (x + 1.0 / x) * 0.5 |
| END cosh; |
| 376,12 → 231,12 |
| PROCEDURE tanh* (x: REAL): REAL; |
| BEGIN |
| IF x > 15.0 THEN |
| x := ONE |
| x := 1.0 |
| ELSIF x < -15.0 THEN |
| x := -ONE |
| x := -1.0 |
| ELSE |
| x := exp(TWO * x); |
| x := (x - ONE) / (x + ONE) |
| x := exp(2.0 * x); |
| x := (x - 1.0) / (x + 1.0) |
| END |
| RETURN x |
| 389,21 → 244,21 |
| PROCEDURE arsinh* (x: REAL): REAL; |
| RETURN ln(x + sqrt(x * x + ONE)) |
| RETURN ln(x + sqrt(x * x + 1.0)) |
| END arsinh; |
| PROCEDURE arcosh* (x: REAL): REAL; |
| BEGIN |
| ASSERT(x >= ONE) |
| RETURN ln(x + sqrt(x * x - ONE)) |
| ASSERT(x >= 1.0) |
| RETURN ln(x + sqrt(x * x - 1.0)) |
| END arcosh; |
| PROCEDURE artanh* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) < ONE) |
| RETURN HALF * ln((ONE + x) / (ONE - x)) |
| ASSERT(ABS(x) < 1.0) |
| RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) |
| END artanh; |
| 412,9 → 267,9 |
| res: INTEGER; |
| BEGIN |
| IF x > ZERO THEN |
| IF x > 0.0 THEN |
| res := 1 |
| ELSIF x < ZERO THEN |
| ELSIF x < 0.0 THEN |
| res := -1 |
| ELSE |
| res := 0 |
| 429,7 → 284,7 |
| res: REAL; |
| BEGIN |
| res := ONE; |
| res := 1.0; |
| WHILE n > 1 DO |
| res := res * FLT(n); |
| DEC(n) |
| 439,42 → 294,18 |
| END fact; |
| PROCEDURE DegToRad* (x: REAL): REAL; |
| RETURN x * (pi / 180.0) |
| END DegToRad; |
| PROCEDURE RadToDeg* (x: REAL): REAL; |
| RETURN x * (180.0 / pi) |
| END RadToDeg; |
| (* Return hypotenuse of triangle *) |
| PROCEDURE hypot* (x, y: REAL): REAL; |
| PROCEDURE init; |
| VAR |
| a: REAL; |
| i: INTEGER; |
| BEGIN |
| x := ABS(x); |
| y := ABS(y); |
| IF x > y THEN |
| a := x * sqrt(1.0 + sqrr(y / x)) |
| ELSE |
| IF x > 0.0 THEN |
| a := y * sqrt(1.0 + sqrr(x / y)) |
| ELSE |
| a := y |
| Exp[0] := 1.0; |
| FOR i := 1 TO LEN(Exp) - 1 DO |
| Exp[i] := Exp[i - 1] * e |
| END |
| END |
| END init; |
| RETURN a |
| END hypot; |
| BEGIN |
| large := 1.9; |
| PACK(large, expoMax); |
| miny := ONE / large; |
| LnInfinity := ln(large); |
| LnSmall := ln(miny); |
| init |
| END Math. |
| /programs/develop/oberon07/Lib/Linux64/Out.ob07 |
|---|
| 1,87 → 1,276 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Out; |
| IMPORT SYSTEM, Libdl; |
| IMPORT sys := SYSTEM, API; |
| CONST |
| d = 1.0 - 5.0E-12; |
| VAR |
| printf1: PROCEDURE [linux] (fmt: INTEGER; x: INTEGER); |
| printf2: PROCEDURE [linux] (fmt: INTEGER; width, x: INTEGER); |
| printf3: PROCEDURE [linux] (fmt: INTEGER; width, precision, x: INTEGER); |
| Realp: PROCEDURE (x: REAL; width: INTEGER); |
| PROCEDURE Char* (x: CHAR); |
| BEGIN |
| printf1(SYSTEM.SADR("%c"), ORD(x)) |
| API.putc(x) |
| END Char; |
| PROCEDURE String* (s: ARRAY OF CHAR); |
| VAR |
| i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0])) |
| i := 0; |
| WHILE (i < LEN(s)) & (s[i] # 0X) DO |
| Char(s[i]); |
| INC(i) |
| END |
| END String; |
| PROCEDURE Ln*; |
| PROCEDURE WriteInt(x, n: INTEGER); |
| VAR i: INTEGER; a: ARRAY 24 OF CHAR; neg: BOOLEAN; |
| BEGIN |
| printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(0AX)) |
| END Ln; |
| i := 0; |
| IF n < 1 THEN |
| n := 1 |
| END; |
| IF x < 0 THEN |
| x := -x; |
| DEC(n); |
| neg := TRUE |
| END; |
| REPEAT |
| a[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| WHILE n > i DO |
| Char(" "); |
| DEC(n) |
| END; |
| IF neg THEN |
| Char("-") |
| END; |
| REPEAT |
| DEC(i); |
| Char(a[i]) |
| UNTIL i = 0 |
| END WriteInt; |
| PROCEDURE IsNan(AValue: REAL): BOOLEAN; |
| VAR s: SET; |
| BEGIN |
| sys.GET(sys.ADR(AValue), s) |
| RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {})) |
| END IsNan; |
| PROCEDURE IsInf(x: REAL): BOOLEAN; |
| RETURN ABS(x) = sys.INF() |
| END IsInf; |
| PROCEDURE Int* (x, width: INTEGER); |
| VAR i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%*lld"), width, x) |
| IF x # 80000000H THEN |
| WriteInt(x, width) |
| ELSE |
| FOR i := 12 TO width DO |
| Char(20X) |
| END; |
| String("-2147483648") |
| END |
| END Int; |
| PROCEDURE OutInf(x: REAL; width: INTEGER); |
| VAR s: ARRAY 5 OF CHAR; i: INTEGER; |
| BEGIN |
| IF IsNan(x) THEN |
| s := "Nan"; |
| INC(width) |
| ELSIF IsInf(x) & (x > 0.0) THEN |
| s := "+Inf" |
| ELSIF IsInf(x) & (x < 0.0) THEN |
| s := "-Inf" |
| END; |
| FOR i := 1 TO width - 4 DO |
| Char(" ") |
| END; |
| String(s) |
| END OutInf; |
| PROCEDURE intval (x: REAL): INTEGER; |
| VAR |
| i: INTEGER; |
| PROCEDURE Ln*; |
| BEGIN |
| Char(0AX) |
| END Ln; |
| PROCEDURE _FixReal(x: REAL; width, p: INTEGER); |
| VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; |
| BEGIN |
| SYSTEM.GET(SYSTEM.ADR(x), i) |
| RETURN i |
| END intval; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSIF p < 0 THEN |
| Realp(x, width) |
| ELSE |
| len := 0; |
| minus := FALSE; |
| IF x < 0.0 THEN |
| minus := TRUE; |
| INC(len); |
| x := ABS(x) |
| END; |
| e := 0; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| IF e >= 0 THEN |
| len := len + e + p + 1; |
| IF x > 9.0 + d THEN |
| INC(len) |
| END; |
| IF p > 0 THEN |
| INC(len) |
| END; |
| ELSE |
| len := len + p + 2 |
| END; |
| FOR i := 1 TO width - len DO |
| Char(" ") |
| END; |
| IF minus THEN |
| Char("-") |
| END; |
| y := x; |
| WHILE (y < 1.0) & (y # 0.0) DO |
| y := y * 10.0; |
| DEC(e) |
| END; |
| IF e < 0 THEN |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char("1"); |
| x := 0.0 |
| ELSE |
| Char("0"); |
| x := x * 10.0 |
| END |
| ELSE |
| WHILE e >= 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| IF x > 9.0 THEN |
| String("10") |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0") + 1)) |
| END; |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(e) |
| END |
| END; |
| IF p > 0 THEN |
| Char(".") |
| END; |
| WHILE p > 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char(CHR(FLOOR(x) + ORD("0") + 1)); |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(p) |
| END |
| END |
| END _FixReal; |
| PROCEDURE Real* (x: REAL; width: INTEGER); |
| VAR e, n, i: INTEGER; minus: BOOLEAN; |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), intval(x)) |
| Realp := Real; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSE |
| e := 0; |
| n := 0; |
| IF width > 23 THEN |
| n := width - 23; |
| width := 23 |
| ELSIF width < 9 THEN |
| width := 9 |
| END; |
| width := width - 5; |
| IF x < 0.0 THEN |
| x := -x; |
| minus := TRUE |
| ELSE |
| minus := FALSE |
| END; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| WHILE (x < 1.0) & (x # 0.0) DO |
| x := x * 10.0; |
| DEC(e) |
| END; |
| IF x > 9.0 + d THEN |
| x := 1.0; |
| INC(e) |
| END; |
| FOR i := 1 TO n DO |
| Char(" ") |
| END; |
| IF minus THEN |
| x := -x |
| END; |
| _FixReal(x, width, width - 3); |
| Char("E"); |
| IF e >= 0 THEN |
| Char("+") |
| ELSE |
| Char("-"); |
| e := ABS(e) |
| END; |
| IF e < 100 THEN |
| Char("0") |
| END; |
| IF e < 10 THEN |
| Char("0") |
| END; |
| Int(e, 0) |
| END |
| END Real; |
| PROCEDURE FixReal* (x: REAL; width, precision: INTEGER); |
| PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*f"), width, precision, intval(x)) |
| Realp := Real; |
| _FixReal(x, width, p) |
| END FixReal; |
| PROCEDURE Open*; |
| END Open; |
| PROCEDURE init; |
| VAR |
| libc, printf: INTEGER; |
| BEGIN |
| libc := Libdl.open("libc.so.6", Libdl.LAZY); |
| ASSERT(libc # 0); |
| printf := Libdl.sym(libc, "printf"); |
| ASSERT(printf # 0); |
| SYSTEM.PUT(SYSTEM.ADR(printf1), printf); |
| SYSTEM.PUT(SYSTEM.ADR(printf2), printf); |
| SYSTEM.PUT(SYSTEM.ADR(printf3), printf); |
| END init; |
| BEGIN |
| init |
| END Out. |
| /programs/develop/oberon07/Lib/Linux64/RTL.ob07 |
|---|
| 350,29 → 350,33 |
| PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| i, a, b: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| str[i] := 0X; |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| a := 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END IntToStr; |
| PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 380,12 → 384,19 |
| ASSERT(n1 + n2 < LEN(s1)); |
| SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER); |
| PROCEDURE [stdcall64] _error* (module, err, line: INTEGER); |
| VAR |
| s, temp: ARRAY 1024 OF CHAR; |
| 404,9 → 415,11 |
| |11: s := "BYTE out of range" |
| END; |
| append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
| append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
| append(s, API.eol); |
| append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
| append(s, "line: "); IntToStr(line, temp); append(s, temp); |
| API.DebugMsg(SYSTEM.ADR(s[0]), name); |
| API.exit_thread(0) |
| /programs/develop/oberon07/Lib/Windows32/API.ob07 |
|---|
| 12,8 → 12,6 |
| CONST |
| eol* = 0DX + 0AX; |
| SectionAlignment = 1000H; |
| DLL_PROCESS_ATTACH = 1; |
| 21,10 → 19,7 |
| DLL_THREAD_DETACH = 3; |
| DLL_PROCESS_DETACH = 0; |
| KERNEL = "kernel32.dll"; |
| USER = "user32.dll"; |
| TYPE |
| DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
| 32,6 → 27,7 |
| VAR |
| eol*: ARRAY 3 OF CHAR; |
| base*: INTEGER; |
| heap: INTEGER; |
| 40,14 → 36,15 |
| thread_attach: DLL_ENTRY; |
| PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER); |
| PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER); |
| PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| BEGIN |
| MessageBoxA(0, lpText, lpCaption, 16) |
| 71,6 → 68,7 |
| process_detach := NIL; |
| thread_detach := NIL; |
| thread_attach := NIL; |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| base := code - SectionAlignment; |
| heap := GetProcessHeap() |
| END init; |
| /programs/develop/oberon07/Lib/Windows32/Args.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| 54,7 → 54,7 |
| BEGIN |
| p := WINAPI.GetCommandLineA(); |
| p := WINAPI.GetCommandLine(); |
| cond := 0; |
| count := 0; |
| WHILE (count < MAX_PARAM) & (cond # 6) DO |
| /programs/develop/oberon07/Lib/Windows32/Console.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| 48,7 → 48,7 |
| BEGIN |
| WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
| fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); |
| WINAPI.FillConsoleOutputCharacterA(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
| WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
| WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); |
| SetCursor(0, 0) |
| END Cls; |
| /programs/develop/oberon07/Lib/Windows32/DateTime.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE DateTime; |
| IMPORT WINAPI, SYSTEM; |
| IMPORT WINAPI; |
| CONST |
| 116,29 → 116,6 |
| END NowEncode; |
| PROCEDURE NowUnixTime* (): INTEGER; |
| RETURN WINAPI.time(0) |
| END NowUnixTime; |
| PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER; |
| VAR |
| t: WINAPI.tm; |
| BEGIN |
| DEC(Year, 1900); |
| DEC(Month); |
| SYSTEM.GET(SYSTEM.ADR(Sec), t.sec); |
| SYSTEM.GET(SYSTEM.ADR(Min), t.min); |
| SYSTEM.GET(SYSTEM.ADR(Hour), t.hour); |
| SYSTEM.GET(SYSTEM.ADR(Day), t.mday); |
| SYSTEM.GET(SYSTEM.ADR(Month), t.mon); |
| SYSTEM.GET(SYSTEM.ADR(Year), t.year); |
| RETURN WINAPI.mktime(t) |
| END UnixTime; |
| PROCEDURE init; |
| VAR |
| day, year, month, i: INTEGER; |
| /programs/develop/oberon07/Lib/Windows32/File.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE File; |
| IMPORT SYSTEM, WINAPI, API; |
| IMPORT SYSTEM, WINAPI; |
| CONST |
| 20,14 → 20,12 |
| VAR |
| FindData: WINAPI.TWin32FindData; |
| Handle: INTEGER; |
| attr: SET; |
| BEGIN |
| Handle := WINAPI.FindFirstFileA(SYSTEM.ADR(FName[0]), FindData); |
| Handle := WINAPI.FindFirstFile(SYSTEM.ADR(FName[0]), FindData); |
| IF Handle # -1 THEN |
| WINAPI.FindClose(Handle); |
| SYSTEM.GET32(SYSTEM.ADR(FindData.dwFileAttributes), attr); |
| IF 4 IN attr THEN |
| IF 4 IN FindData.dwFileAttributes THEN |
| Handle := -1 |
| END |
| END |
| 37,12 → 35,12 |
| PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; |
| RETURN WINAPI.DeleteFileA(SYSTEM.ADR(FName[0])) # 0 |
| RETURN WINAPI.DeleteFile(SYSTEM.ADR(FName[0])) # 0 |
| END Delete; |
| PROCEDURE Create* (FName: ARRAY OF CHAR): INTEGER; |
| RETURN WINAPI.CreateFileA(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) |
| RETURN WINAPI.CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) |
| END Create; |
| 67,11 → 65,13 |
| PROCEDURE Read* (F, Buffer, Count: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN |
| IF WINAPI.ReadFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 80,11 → 80,13 |
| PROCEDURE Write* (F, Buffer, Count: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(res), NIL) = 0 THEN |
| IF WINAPI.WriteFile(F, Buffer, Count, SYSTEM.ADR(n), NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 102,10 → 104,11 |
| IF F # -1 THEN |
| Size := Seek(F, 0, SEEK_END); |
| n := Seek(F, 0, SEEK_BEG); |
| res := API._NEW(Size); |
| res := WINAPI.GlobalAlloc(64, Size); |
| IF (res = 0) OR (Read(F, res, Size) # Size) THEN |
| IF res # 0 THEN |
| res := API._DISPOSE(res); |
| WINAPI.GlobalFree(Size); |
| res := 0; |
| Size := 0 |
| END |
| END; |
| 117,7 → 120,7 |
| PROCEDURE RemoveDir* (DirName: ARRAY OF CHAR): BOOLEAN; |
| RETURN WINAPI.RemoveDirectoryA(SYSTEM.ADR(DirName[0])) # 0 |
| RETURN WINAPI.RemoveDirectory(SYSTEM.ADR(DirName[0])) # 0 |
| END RemoveDir; |
| 126,13 → 129,13 |
| Code: SET; |
| BEGIN |
| Code := WINAPI.GetFileAttributesA(SYSTEM.ADR(DirName[0])) |
| Code := WINAPI.GetFileAttributes(SYSTEM.ADR(DirName[0])) |
| RETURN (Code # {0..31}) & (4 IN Code) |
| END ExistsDir; |
| PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; |
| RETURN WINAPI.CreateDirectoryA(SYSTEM.ADR(DirName[0]), NIL) # 0 |
| RETURN WINAPI.CreateDirectory(SYSTEM.ADR(DirName[0]), NIL) # 0 |
| END CreateDir; |
| /programs/develop/oberon07/Lib/Windows32/HOST.ob07 |
|---|
| 13,7 → 13,7 |
| CONST |
| slash* = "\"; |
| eol* = 0DX + 0AX; |
| OS* = "WINDOWS"; |
| bit_depth* = RTL.bit_depth; |
| maxint* = RTL.maxint; |
| 59,7 → 59,20 |
| END; |
| TSystemTime = RECORD |
| Year, |
| Month, |
| DayOfWeek, |
| Day, |
| Hour, |
| Min, |
| Sec, |
| MSec: WCHAR |
| END; |
| VAR |
| hConsoleOutput: INTEGER; |
| 67,6 → 80,8 |
| Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
| argc: INTEGER; |
| eol*: ARRAY 3 OF CHAR; |
| maxreal*: REAL; |
| 101,13 → 116,13 |
| PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] |
| _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] |
| _GetSystemTime (T: TSystemTime); |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
| _ExitProcess (code: INTEGER); |
| PROCEDURE [ccall, "msvcrt.dll", "time"] |
| _time (ptr: INTEGER): INTEGER; |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| _ExitProcess(code) |
| 200,11 → 215,13 |
| PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN |
| IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 213,11 → 230,13 |
| PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN |
| IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 250,10 → 269,6 |
| END FileOpen; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| END chmod; |
| PROCEDURE OutChar* (c: CHAR); |
| VAR |
| count: INTEGER; |
| 277,25 → 292,33 |
| END isRelative; |
| PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
| VAR |
| T: TSystemTime; |
| BEGIN |
| _GetSystemTime(T); |
| year := ORD(T.Year); |
| month := ORD(T.Month); |
| day := ORD(T.Day); |
| hour := ORD(T.Hour); |
| min := ORD(T.Min); |
| sec := ORD(T.Sec) |
| END now; |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN _time(0) |
| RETURN 0 |
| END UnixTime; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| BEGIN |
| SYSTEM.GET32(SYSTEM.ADR(x), a); |
| SYSTEM.GET32(SYSTEM.ADR(x) + 4, b) |
| RETURN a |
| END splitf; |
| PROCEDURE d2s* (x: REAL): INTEGER; |
| VAR |
| h, l, s, e: INTEGER; |
| BEGIN |
| e := splitf(x, l, h); |
| SYSTEM.GET(SYSTEM.ADR(x), l); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, h); |
| s := ASR(h, 31) MOD 2; |
| e := (h DIV 100000H) MOD 2048; |
| 314,7 → 337,7 |
| l := 0 |
| ELSIF e = 2047 THEN |
| e := 1151; |
| IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN |
| IF (h MOD 100000H # 0) OR (l # 0) THEN |
| h := 80000H; |
| l := 0 |
| END |
| 325,7 → 348,22 |
| END d2s; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| BEGIN |
| a := 0; |
| b := 0; |
| SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
| SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| BEGIN |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| maxreal := 1.9; |
| PACK(maxreal, 1023); |
| hConsoleOutput := _GetStdHandle(-11); |
| /programs/develop/oberon07/Lib/Windows32/In.ob07 |
|---|
| 1,80 → 1,289 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2017, 2018 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE In; |
| IMPORT SYSTEM; |
| IMPORT sys := SYSTEM, WINAPI; |
| TYPE |
| CONST |
| STRING = ARRAY 260 OF CHAR; |
| MAX_LEN = 1024; |
| VAR |
| Done*: BOOLEAN; |
| hConsoleInput: INTEGER; |
| s: ARRAY MAX_LEN + 4 OF CHAR; |
| PROCEDURE digit(ch: CHAR): BOOLEAN; |
| RETURN (ch >= "0") & (ch <= "9") |
| END digit; |
| PROCEDURE [ccall, "msvcrt.dll", ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER; |
| PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER); |
| PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN; |
| VAR i: INTEGER; |
| BEGIN |
| i := 0; |
| neg := FALSE; |
| WHILE (s[i] <= 20X) & (s[i] # 0X) DO |
| INC(i) |
| END; |
| IF s[i] = "-" THEN |
| neg := TRUE; |
| INC(i) |
| ELSIF s[i] = "+" THEN |
| INC(i) |
| END; |
| first := i; |
| WHILE digit(s[i]) DO |
| INC(i) |
| END; |
| last := i |
| RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first]) |
| END CheckInt; |
| PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN; |
| VAR i: INTEGER; min: STRING; |
| BEGIN |
| i := 0; |
| min := "2147483648"; |
| WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO |
| INC(i) |
| END |
| RETURN i = 10 |
| END IsMinInt; |
| PROCEDURE String* (VAR str: ARRAY OF CHAR); |
| VAR |
| count: INTEGER; |
| PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER; |
| CONST maxINT = 7FFFFFFFH; |
| VAR i, n, res: INTEGER; flag, neg: BOOLEAN; |
| BEGIN |
| res := 0; |
| flag := CheckInt(str, i, n, neg, FALSE); |
| err := ~flag; |
| IF flag & neg & IsMinInt(str, i) THEN |
| flag := FALSE; |
| neg := FALSE; |
| res := 80000000H |
| END; |
| WHILE flag & digit(str[i]) DO |
| IF res > maxINT DIV 10 THEN |
| err := TRUE; |
| flag := FALSE; |
| res := 0 |
| ELSE |
| res := res * 10; |
| IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN |
| err := TRUE; |
| flag := FALSE; |
| res := 0 |
| ELSE |
| res := res + (ORD(str[i]) - ORD("0")); |
| INC(i) |
| END |
| END |
| END; |
| IF neg THEN |
| res := -res |
| END |
| RETURN res |
| END StrToInt; |
| PROCEDURE Space(s: STRING): BOOLEAN; |
| VAR i: INTEGER; |
| BEGIN |
| ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0); |
| IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN |
| DEC(count, 2) |
| i := 0; |
| WHILE (s[i] # 0X) & (s[i] <= 20X) DO |
| INC(i) |
| END |
| RETURN s[i] = 0X |
| END Space; |
| PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| Res := CheckInt(s, n, i, neg, TRUE); |
| IF Res THEN |
| IF s[i] = "." THEN |
| INC(i); |
| WHILE digit(s[i]) DO |
| INC(i) |
| END; |
| s[count] := 0X; |
| COPY(s, str); |
| str[LEN(str) - 1] := 0X; |
| Done := TRUE |
| END String; |
| IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN |
| INC(i); |
| IF (s[i] = "+") OR (s[i] = "-") THEN |
| INC(i) |
| END; |
| Res := digit(s[i]); |
| WHILE digit(s[i]) DO |
| INC(i) |
| END |
| END |
| END |
| END |
| RETURN Res & (s[i] <= 20X) |
| END CheckReal; |
| PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL; |
| CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH; |
| VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN; |
| PROCEDURE Int* (VAR x: INTEGER); |
| PROCEDURE part1(VAR res, d: REAL; VAR i: INTEGER; str: STRING): BOOLEAN; |
| BEGIN |
| String(s); |
| Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%d"), SYSTEM.ADR(x)) = 1 |
| END Int; |
| res := 0.0; |
| d := 1.0; |
| WHILE digit(str[i]) DO |
| res := res * 10.0 + FLT(ORD(str[i]) - ORD("0")); |
| INC(i) |
| END; |
| IF str[i] = "." THEN |
| INC(i); |
| WHILE digit(str[i]) DO |
| d := d / 10.0; |
| res := res + FLT(ORD(str[i]) - ORD("0")) * d; |
| INC(i) |
| END |
| END |
| RETURN str[i] # 0X |
| END part1; |
| PROCEDURE part2(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): BOOLEAN; |
| BEGIN |
| INC(i); |
| m := 10.0; |
| minus := FALSE; |
| IF str[i] = "+" THEN |
| INC(i) |
| ELSIF str[i] = "-" THEN |
| minus := TRUE; |
| INC(i); |
| m := 0.1 |
| END; |
| scale := 0; |
| err := FALSE; |
| WHILE ~err & digit(str[i]) DO |
| IF scale > maxINT DIV 10 THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| scale := scale * 10; |
| IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| scale := scale + (ORD(str[i]) - ORD("0")); |
| INC(i) |
| END |
| END |
| END |
| RETURN ~err |
| END part2; |
| PROCEDURE Real* (VAR x: REAL); |
| PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR scale: INTEGER; VAR res, m: REAL); |
| VAR i: INTEGER; |
| BEGIN |
| String(s); |
| Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1 |
| END Real; |
| err := FALSE; |
| IF scale = maxINT THEN |
| err := TRUE; |
| res := 0.0 |
| END; |
| i := 1; |
| WHILE ~err & (i <= scale) DO |
| IF ~minus & (res > maxDBL / m) THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| res := res * m; |
| INC(i) |
| END |
| END |
| END part3; |
| BEGIN |
| IF CheckReal(str, i, neg) THEN |
| IF part1(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN |
| part3(err, minus, scale, res, m) |
| END; |
| IF neg THEN |
| res := -res |
| END |
| ELSE |
| res := 0.0; |
| err := TRUE |
| END |
| RETURN res |
| END StrToFloat; |
| PROCEDURE String*(VAR s: ARRAY OF CHAR); |
| VAR count, i: INTEGER; str: STRING; |
| BEGIN |
| WINAPI.ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); |
| IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN |
| DEC(count, 2) |
| END; |
| str[256] := 0X; |
| str[count] := 0X; |
| i := 0; |
| WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO |
| s[i] := str[i]; |
| INC(i) |
| END; |
| s[i] := 0X; |
| Done := TRUE |
| END String; |
| PROCEDURE Char* (VAR x: CHAR); |
| VAR str: STRING; |
| BEGIN |
| String(s); |
| x := s[0] |
| String(str); |
| x := str[0]; |
| Done := TRUE |
| END Char; |
| PROCEDURE Ln*; |
| VAR str: STRING; |
| BEGIN |
| String(s) |
| String(str); |
| Done := TRUE |
| END Ln; |
| PROCEDURE Real*(VAR x: REAL); |
| VAR str: STRING; err: BOOLEAN; |
| BEGIN |
| err := FALSE; |
| REPEAT |
| String(str) |
| UNTIL ~Space(str); |
| x := StrToFloat(str, err); |
| Done := ~err |
| END Real; |
| PROCEDURE Int*(VAR x: INTEGER); |
| VAR str: STRING; err: BOOLEAN; |
| BEGIN |
| err := FALSE; |
| REPEAT |
| String(str) |
| UNTIL ~Space(str); |
| x := StrToInt(str, err); |
| Done := ~err |
| END Int; |
| PROCEDURE Open*; |
| BEGIN |
| hConsoleInput := GetStdHandle(-10); |
| hConsoleInput := WINAPI.GetStdHandle(-10); |
| Done := TRUE |
| END Open; |
| END In. |
| /programs/develop/oberon07/Lib/Windows32/Math.ob07 |
|---|
| 1,8 → 1,18 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2018, 2019 Anton Krotov |
| Copyright (c) 2013-2014, 2018-2020 Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Math; |
| 225,16 → 235,6 |
| END frac; |
| PROCEDURE sqri* (x: INTEGER): INTEGER; |
| RETURN x * x |
| END sqri; |
| PROCEDURE sqrr* (x: REAL): REAL; |
| RETURN x * x |
| END sqrr; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| RETURN arctan2(x, sqrt(1.0 - x * x)) |
| END arcsin; |
| 349,40 → 349,6 |
| END power; |
| PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| VAR |
| i: INTEGER; |
| a: REAL; |
| BEGIN |
| a := 1.0; |
| IF base # 0.0 THEN |
| IF exponent # 0 THEN |
| IF exponent < 0 THEN |
| base := 1.0 / base |
| END; |
| i := ABS(exponent); |
| WHILE i > 0 DO |
| WHILE ~ODD(i) DO |
| i := LSR(i, 1); |
| base := sqrr(base) |
| END; |
| DEC(i); |
| a := a * base |
| END |
| ELSE |
| a := 1.0 |
| END |
| ELSE |
| ASSERT(exponent > 0); |
| a := 0.0 |
| END |
| RETURN a |
| END ipower; |
| PROCEDURE sgn* (x: REAL): INTEGER; |
| VAR |
| res: INTEGER; |
| 415,36 → 381,4 |
| END fact; |
| PROCEDURE DegToRad* (x: REAL): REAL; |
| RETURN x * (pi / 180.0) |
| END DegToRad; |
| PROCEDURE RadToDeg* (x: REAL): REAL; |
| RETURN x * (180.0 / pi) |
| END RadToDeg; |
| (* Return hypotenuse of triangle *) |
| PROCEDURE hypot* (x, y: REAL): REAL; |
| VAR |
| a: REAL; |
| BEGIN |
| x := ABS(x); |
| y := ABS(y); |
| IF x > y THEN |
| a := x * sqrt(1.0 + sqrr(y / x)) |
| ELSE |
| IF x > 0.0 THEN |
| a := y * sqrt(1.0 + sqrr(x / y)) |
| ELSE |
| a := y |
| END |
| END |
| RETURN a |
| END hypot; |
| END Math. |
| /programs/develop/oberon07/Lib/Windows32/Out.ob07 |
|---|
| 1,77 → 1,280 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2017, 2018 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Out; |
| IMPORT SYSTEM; |
| IMPORT sys := SYSTEM, WINAPI; |
| CONST |
| d = 1.0 - 5.0E-12; |
| VAR |
| hConsoleOutput: INTEGER; |
| Realp: PROCEDURE (x: REAL; width: INTEGER); |
| PROCEDURE [ccall, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER); |
| PROCEDURE [ccall, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER); |
| PROCEDURE [ccall, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision: INTEGER; x: REAL); |
| PROCEDURE String*(s: ARRAY OF CHAR); |
| VAR count: INTEGER; |
| BEGIN |
| WINAPI.WriteFile(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), NIL) |
| END String; |
| PROCEDURE [windows, "kernel32.dll", ""] |
| WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER); |
| PROCEDURE StringW*(s: ARRAY OF WCHAR); |
| VAR count: INTEGER; |
| BEGIN |
| WINAPI.WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) |
| END StringW; |
| PROCEDURE [windows, "kernel32.dll", ""] |
| GetStdHandle (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE Char* (x: CHAR); |
| VAR count: INTEGER; |
| BEGIN |
| printf1(SYSTEM.SADR("%c"), ORD(x)) |
| WINAPI.WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) |
| END Char; |
| PROCEDURE WriteInt(x, n: INTEGER); |
| VAR i: INTEGER; a: ARRAY 16 OF CHAR; neg: BOOLEAN; |
| BEGIN |
| i := 0; |
| IF n < 1 THEN |
| n := 1 |
| END; |
| IF x < 0 THEN |
| x := -x; |
| DEC(n); |
| neg := TRUE |
| END; |
| REPEAT |
| a[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| WHILE n > i DO |
| Char(" "); |
| DEC(n) |
| END; |
| IF neg THEN |
| Char("-") |
| END; |
| REPEAT |
| DEC(i); |
| Char(a[i]) |
| UNTIL i = 0 |
| END WriteInt; |
| PROCEDURE StringW* (s: ARRAY OF WCHAR); |
| PROCEDURE IsNan(AValue: REAL): BOOLEAN; |
| VAR h, l: SET; |
| BEGIN |
| WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0) |
| END StringW; |
| sys.GET(sys.ADR(AValue), l); |
| sys.GET(sys.ADR(AValue) + 4, h) |
| RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) |
| END IsNan; |
| PROCEDURE IsInf(x: REAL): BOOLEAN; |
| RETURN ABS(x) = sys.INF() |
| END IsInf; |
| PROCEDURE String* (s: ARRAY OF CHAR); |
| PROCEDURE Int*(x, width: INTEGER); |
| VAR i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0])) |
| END String; |
| IF x # 80000000H THEN |
| WriteInt(x, width) |
| ELSE |
| FOR i := 12 TO width DO |
| Char(20X) |
| END; |
| String("-2147483648") |
| END |
| END Int; |
| PROCEDURE OutInf(x: REAL; width: INTEGER); |
| VAR s: ARRAY 5 OF CHAR; i: INTEGER; |
| BEGIN |
| IF IsNan(x) THEN |
| s := "Nan"; |
| INC(width) |
| ELSIF IsInf(x) & (x > 0.0) THEN |
| s := "+Inf" |
| ELSIF IsInf(x) & (x < 0.0) THEN |
| s := "-Inf" |
| END; |
| FOR i := 1 TO width - 4 DO |
| Char(" ") |
| END; |
| String(s) |
| END OutInf; |
| PROCEDURE Ln*; |
| BEGIN |
| printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10))) |
| Char(0DX); |
| Char(0AX) |
| END Ln; |
| PROCEDURE Int* (x, width: INTEGER); |
| PROCEDURE _FixReal(x: REAL; width, p: INTEGER); |
| VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; |
| BEGIN |
| printf2(SYSTEM.SADR("%*d"), width, x) |
| END Int; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSIF p < 0 THEN |
| Realp(x, width) |
| ELSE |
| len := 0; |
| minus := FALSE; |
| IF x < 0.0 THEN |
| minus := TRUE; |
| INC(len); |
| x := ABS(x) |
| END; |
| e := 0; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| IF e >= 0 THEN |
| len := len + e + p + 1; |
| IF x > 9.0 + d THEN |
| INC(len) |
| END; |
| IF p > 0 THEN |
| INC(len) |
| END; |
| ELSE |
| len := len + p + 2 |
| END; |
| FOR i := 1 TO width - len DO |
| Char(" ") |
| END; |
| IF minus THEN |
| Char("-") |
| END; |
| y := x; |
| WHILE (y < 1.0) & (y # 0.0) DO |
| y := y * 10.0; |
| DEC(e) |
| END; |
| IF e < 0 THEN |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char("1"); |
| x := 0.0 |
| ELSE |
| Char("0"); |
| x := x * 10.0 |
| END |
| ELSE |
| WHILE e >= 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| IF x > 9.0 THEN |
| String("10") |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0") + 1)) |
| END; |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(e) |
| END |
| END; |
| IF p > 0 THEN |
| Char(".") |
| END; |
| WHILE p > 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char(CHR(FLOOR(x) + ORD("0") + 1)); |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(p) |
| END |
| END |
| END _FixReal; |
| PROCEDURE Real* (x: REAL; width: INTEGER); |
| VAR e, n, i: INTEGER; minus: BOOLEAN; |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), x) |
| Realp := Real; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSE |
| e := 0; |
| n := 0; |
| IF width > 23 THEN |
| n := width - 23; |
| width := 23 |
| ELSIF width < 9 THEN |
| width := 9 |
| END; |
| width := width - 5; |
| IF x < 0.0 THEN |
| x := -x; |
| minus := TRUE |
| ELSE |
| minus := FALSE |
| END; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| WHILE (x < 1.0) & (x # 0.0) DO |
| x := x * 10.0; |
| DEC(e) |
| END; |
| IF x > 9.0 + d THEN |
| x := 1.0; |
| INC(e) |
| END; |
| FOR i := 1 TO n DO |
| Char(" ") |
| END; |
| IF minus THEN |
| x := -x |
| END; |
| _FixReal(x, width, width - 3); |
| Char("E"); |
| IF e >= 0 THEN |
| Char("+") |
| ELSE |
| Char("-"); |
| e := ABS(e) |
| END; |
| IF e < 100 THEN |
| Char("0") |
| END; |
| IF e < 10 THEN |
| Char("0") |
| END; |
| Int(e, 0) |
| END |
| END Real; |
| PROCEDURE FixReal* (x: REAL; width, precision: INTEGER); |
| PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*f"), width, precision, x) |
| Realp := Real; |
| _FixReal(x, width, p) |
| END FixReal; |
| PROCEDURE Open*; |
| BEGIN |
| hConsoleOutput := GetStdHandle(-11) |
| hConsoleOutput := WINAPI.GetStdHandle(-11) |
| END Open; |
| END Out. |
| /programs/develop/oberon07/Lib/Windows32/RTL.ob07 |
|---|
| 372,29 → 372,33 |
| PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| i, a, b: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| str[i] := 0X; |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| a := 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END IntToStr; |
| PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 402,12 → 406,19 |
| ASSERT(n1 + n2 < LEN(s1)); |
| SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER); |
| PROCEDURE [stdcall] _error* (module, err, line: INTEGER); |
| VAR |
| s, temp: ARRAY 1024 OF CHAR; |
| 426,9 → 437,11 |
| |11: s := "BYTE out of range" |
| END; |
| append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
| append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
| append(s, API.eol); |
| append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
| append(s, "line: "); IntToStr(line, temp); append(s, temp); |
| API.DebugMsg(SYSTEM.ADR(s[0]), name); |
| API.exit_thread(0) |
| /programs/develop/oberon07/Lib/Windows32/UnixTime.ob07 |
|---|
| 0,0 → 1,64 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE UnixTime; |
| VAR |
| days: ARRAY 12, 31, 2 OF INTEGER; |
| PROCEDURE init; |
| VAR |
| i, j, k, n0, n1: INTEGER; |
| BEGIN |
| FOR i := 0 TO 11 DO |
| FOR j := 0 TO 30 DO |
| days[i, j, 0] := 0; |
| days[i, j, 1] := 0; |
| END |
| END; |
| days[ 1, 28, 0] := -1; |
| FOR k := 0 TO 1 DO |
| days[ 1, 29, k] := -1; |
| days[ 1, 30, k] := -1; |
| days[ 3, 30, k] := -1; |
| days[ 5, 30, k] := -1; |
| days[ 8, 30, k] := -1; |
| days[10, 30, k] := -1; |
| END; |
| n0 := 0; |
| n1 := 0; |
| FOR i := 0 TO 11 DO |
| FOR j := 0 TO 30 DO |
| IF days[i, j, 0] = 0 THEN |
| days[i, j, 0] := n0; |
| INC(n0) |
| END; |
| IF days[i, j, 1] = 0 THEN |
| days[i, j, 1] := n1; |
| INC(n1) |
| END |
| END |
| END |
| END init; |
| PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; |
| RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
| END time; |
| BEGIN |
| init |
| END UnixTime. |
| /programs/develop/oberon07/Lib/Windows32/Utils.ob07 |
|---|
| 0,0 → 1,76 |
| (* |
| Copyright 2013, 2017, 2018, 2020 Anton Krotov |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Utils; |
| IMPORT WINAPI; |
| PROCEDURE PutSeed*(seed: INTEGER); |
| BEGIN |
| WINAPI.srand(seed) |
| END PutSeed; |
| PROCEDURE Rnd*(range : INTEGER): INTEGER; |
| RETURN WINAPI.rand() MOD range |
| END Rnd; |
| PROCEDURE Utf8To16*(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR): INTEGER; |
| VAR i, j, L, u, N: INTEGER; |
| BEGIN |
| L := LEN(source); |
| N := LEN(dest); |
| N := N - N MOD 2 - 1; |
| i := 0; |
| j := 0; |
| WHILE (i < L) & (j < N) & (source[i] # 0X) DO |
| CASE source[i] OF |
| |00X..7FX: u := ORD(source[i]); |
| |0C1X..0DFX: |
| u := LSL(ORD(source[i]) - 0C0H, 6); |
| IF i + 1 < L THEN |
| u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); |
| INC(i) |
| END |
| |0E1X..0EFX: |
| u := LSL(ORD(source[i]) - 0E0H, 12); |
| IF i + 1 < L THEN |
| u := u + ROR(LSL(ORD(source[i + 1]), 26), 20); |
| INC(i) |
| END; |
| IF i + 1 < L THEN |
| u := u + ROR(LSL(ORD(source[i + 1]), 26), 26); |
| INC(i) |
| END |
| (* |0F1X..0F7X: |
| |0F9X..0FBX: |
| |0FDX:*) |
| ELSE |
| END; |
| INC(i); |
| dest[j] := CHR(u MOD 256); |
| INC(j); |
| dest[j] := CHR(u DIV 256); |
| INC(j); |
| END; |
| IF j < N THEN |
| dest[j] := 0X; |
| dest[j + 1] := 0X |
| END |
| RETURN j DIV 2 |
| END Utf8To16; |
| END Utils. |
| /programs/develop/oberon07/Lib/Windows32/WINAPI.ob07 |
|---|
| 14,11 → 14,7 |
| OFS_MAXPATHNAME* = 128; |
| KERNEL = "kernel32.dll"; |
| USER = "user32.dll"; |
| MSVCRT = "msvcrt.dll"; |
| TYPE |
| DLL_ENTRY* = API.DLL_ENTRY; |
| 60,27 → 56,13 |
| END; |
| tm* = RECORD |
| sec*, |
| min*, |
| hour*, |
| mday*, |
| mon*, |
| year*, |
| wday*, |
| yday*, |
| isdst*: SYSTEM.CARD32 |
| END; |
| PSecurityAttributes* = POINTER TO TSecurityAttributes; |
| TSecurityAttributes* = RECORD |
| nLength*: SYSTEM.CARD32; |
| nLength*: INTEGER; |
| lpSecurityDescriptor*: INTEGER; |
| bInheritHandle*: SYSTEM.CARD32 (* BOOL *) |
| bInheritHandle*: INTEGER |
| END; |
| 87,32 → 69,29 |
| TFileTime* = RECORD |
| dwLowDateTime*, |
| dwHighDateTime*: SYSTEM.CARD32 |
| dwHighDateTime*: INTEGER |
| END; |
| TWin32FindData* = RECORD |
| dwFileAttributes*: SYSTEM.CARD32; |
| dwFileAttributes*: SET; |
| ftCreationTime*: TFileTime; |
| ftLastAccessTime*: TFileTime; |
| ftLastWriteTime*: TFileTime; |
| nFileSizeHigh*: SYSTEM.CARD32; |
| nFileSizeLow*: SYSTEM.CARD32; |
| dwReserved0*: SYSTEM.CARD32; |
| dwReserved1*: SYSTEM.CARD32; |
| nFileSizeHigh*: INTEGER; |
| nFileSizeLow*: INTEGER; |
| dwReserved0*: INTEGER; |
| dwReserved1*: INTEGER; |
| cFileName*: STRING; |
| cAlternateFileName*: ARRAY 14 OF CHAR; |
| dwFileType*: SYSTEM.CARD32; |
| dwCreatorType*: SYSTEM.CARD32; |
| wFinderFlags*: WCHAR |
| cAlternateFileName*: ARRAY 14 OF CHAR |
| END; |
| OFSTRUCT* = RECORD |
| cBytes*: BYTE; |
| fFixedDisk*: BYTE; |
| cBytes*: CHAR; |
| fFixedDisk*: CHAR; |
| nErrCode*: WCHAR; |
| Reserved1*: WCHAR; |
| Reserved2*: WCHAR; |
| 126,95 → 105,133 |
| Internal*: INTEGER; |
| InternalHigh*: INTEGER; |
| Offset*: SYSTEM.CARD32; |
| OffsetHigh*: SYSTEM.CARD32; |
| Offset*: INTEGER; |
| OffsetHigh*: INTEGER; |
| hEvent*: INTEGER |
| END; |
| PROCEDURE [windows-, KERNEL, ""] SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] |
| SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] |
| GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputCharacterA* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] |
| FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] |
| FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] |
| SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
| GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetLocalTime* (T: TSystemTime); |
| PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] |
| GetLocalTime* (T: TSystemTime); |
| PROCEDURE [windows-, KERNEL, ""] RemoveDirectoryA* (lpPathName: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "RemoveDirectoryA"] |
| RemoveDirectory* (lpPathName: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetFileAttributesA* (lpPathName: INTEGER): SET; |
| PROCEDURE [windows-, "kernel32.dll", "GetFileAttributesA"] |
| GetFileAttributes* (lpPathName: INTEGER): SET; |
| PROCEDURE [windows-, KERNEL, ""] CreateDirectoryA* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "CreateDirectoryA"] |
| CreateDirectory* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FindFirstFileA* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FindFirstFileA"] |
| FindFirstFile* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] DeleteFileA* (lpFileName: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "DeleteFileA"] |
| DeleteFile* (lpFileName: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FindClose* (hFindFile: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FindClose"] |
| FindClose* (hFindFile: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] CloseHandle* (hObject: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
| CloseHandle* (hObject: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] CreateFileA* ( |
| PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] |
| CreateFile* ( |
| lpFileName, dwDesiredAccess, dwShareMode: INTEGER; |
| lpSecurityAttributes: PSecurityAttributes; |
| dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "OpenFile"] |
| OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "SetFilePointer"] |
| SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
| ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
| WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ReadConsoleA* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] |
| ReadConsole* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetCommandLineA* (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
| GetCommandLine* (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] |
| GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GlobalFree* (hMem: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] |
| GlobalFree* (hMem: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] |
| WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ExitProcess* (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
| ExitProcess* (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] WriteConsoleA* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteConsoleA"] |
| WriteConsole* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetTickCount* (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
| GetTickCount* (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] Sleep* (dwMilliseconds: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "Sleep"] |
| Sleep* (dwMilliseconds: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] FreeLibrary* (hLibModule: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] |
| FreeLibrary* (hLibModule: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetProcAddress* (hModule, name: INTEGER): INTEGER; |
| PROCEDURE [ccall, "msvcrt.dll", "rand"] |
| rand* (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] LoadLibraryA* (name: INTEGER): INTEGER; |
| PROCEDURE [ccall, "msvcrt.dll", "srand"] |
| srand* (seed: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] AllocConsole* (): BOOLEAN; |
| PROCEDURE [windows-, "user32.dll", "MessageBoxA"] |
| MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FreeConsole* (): BOOLEAN; |
| PROCEDURE [windows-, "user32.dll", "MessageBoxW"] |
| MessageBox* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] MessageBoxW* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] CreateWindowExA* ( |
| PROCEDURE [windows-, "user32.dll", "CreateWindowExA"] |
| CreateWindowEx* ( |
| dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, |
| nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER; |
| PROCEDURE [ccall-, MSVCRT, ""] time* (ptr: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] |
| GetProcAddress* (hModule, name: INTEGER): INTEGER; |
| PROCEDURE [ccall-, MSVCRT, ""] mktime* (time: tm): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] |
| LoadLibraryA* (name: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] |
| AllocConsole* (): BOOLEAN; |
| PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] |
| FreeConsole* (): BOOLEAN; |
| PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
| BEGIN |
| API.SetDll(process_detach, thread_detach, thread_attach) |
| /programs/develop/oberon07/Lib/Windows64/File.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Windows64/Args.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Lib/Windows64/API.ob07 |
|---|
| 12,8 → 12,6 |
| CONST |
| eol* = 0DX + 0AX; |
| SectionAlignment = 1000H; |
| DLL_PROCESS_ATTACH = 1; |
| 21,10 → 19,7 |
| DLL_THREAD_DETACH = 3; |
| DLL_PROCESS_DETACH = 0; |
| KERNEL = "kernel32.dll"; |
| USER = "user32.dll"; |
| TYPE |
| DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
| 32,6 → 27,7 |
| VAR |
| eol*: ARRAY 3 OF CHAR; |
| base*: INTEGER; |
| heap: INTEGER; |
| 40,14 → 36,15 |
| thread_attach: DLL_ENTRY; |
| PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] HeapFree (hHeap, dwFlags, lpMem: INTEGER); |
| PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER); |
| PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
| BEGIN |
| MessageBoxA(0, lpText, lpCaption, 16) |
| 71,6 → 68,7 |
| process_detach := NIL; |
| thread_detach := NIL; |
| thread_attach := NIL; |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| base := code - SectionAlignment; |
| heap := GetProcessHeap() |
| END init; |
| /programs/develop/oberon07/Lib/Windows64/Console.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| 48,7 → 48,7 |
| BEGIN |
| WINAPI.GetConsoleScreenBufferInfo(hConsoleOutput, ScrBufInfo); |
| fill := ORD(ScrBufInfo.dwSize.X) * ORD(ScrBufInfo.dwSize.Y); |
| WINAPI.FillConsoleOutputCharacterA(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
| WINAPI.FillConsoleOutputCharacter(hConsoleOutput, 20H, fill, 0, SYSTEM.ADR(fill)); |
| WINAPI.FillConsoleOutputAttribute(hConsoleOutput, ORD(ScrBufInfo.wAttributes), fill, 0, SYSTEM.ADR(fill)); |
| SetCursor(0, 0) |
| END Cls; |
| /programs/develop/oberon07/Lib/Windows64/DateTime.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE DateTime; |
| IMPORT WINAPI, SYSTEM; |
| IMPORT WINAPI; |
| CONST |
| 116,29 → 116,6 |
| END NowEncode; |
| PROCEDURE NowUnixTime* (): INTEGER; |
| RETURN WINAPI.time(0) |
| END NowUnixTime; |
| PROCEDURE UnixTime* (Year, Month, Day, Hour, Min, Sec: INTEGER): INTEGER; |
| VAR |
| t: WINAPI.tm; |
| BEGIN |
| DEC(Year, 1900); |
| DEC(Month); |
| SYSTEM.GET(SYSTEM.ADR(Sec), t.sec); |
| SYSTEM.GET(SYSTEM.ADR(Min), t.min); |
| SYSTEM.GET(SYSTEM.ADR(Hour), t.hour); |
| SYSTEM.GET(SYSTEM.ADR(Day), t.mday); |
| SYSTEM.GET(SYSTEM.ADR(Month), t.mon); |
| SYSTEM.GET(SYSTEM.ADR(Year), t.year); |
| RETURN WINAPI.mktime(t) |
| END UnixTime; |
| PROCEDURE init; |
| VAR |
| day, year, month, i: INTEGER; |
| /programs/develop/oberon07/Lib/Windows64/HOST.ob07 |
|---|
| 13,7 → 13,7 |
| CONST |
| slash* = "\"; |
| eol* = 0DX + 0AX; |
| OS* = "WINDOWS"; |
| bit_depth* = RTL.bit_depth; |
| maxint* = RTL.maxint; |
| 59,7 → 59,20 |
| END; |
| TSystemTime = RECORD |
| Year, |
| Month, |
| DayOfWeek, |
| Day, |
| Hour, |
| Min, |
| Sec, |
| MSec: WCHAR |
| END; |
| VAR |
| hConsoleOutput: INTEGER; |
| 67,6 → 80,8 |
| Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
| argc: INTEGER; |
| eol*: ARRAY 3 OF CHAR; |
| maxreal*: REAL; |
| 101,13 → 116,13 |
| PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] |
| _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; |
| PROCEDURE [windows, "kernel32.dll", "ExitProcess"] |
| PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] |
| _GetSystemTime (T: TSystemTime); |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
| _ExitProcess (code: INTEGER); |
| PROCEDURE [windows, "msvcrt.dll", "time"] |
| _time (ptr: INTEGER): INTEGER; |
| PROCEDURE ExitProcess* (code: INTEGER); |
| BEGIN |
| _ExitProcess(code) |
| 200,11 → 215,13 |
| PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN |
| IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 213,11 → 230,13 |
| PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| res, n: INTEGER; |
| BEGIN |
| IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, res, NIL) = 0 THEN |
| IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN |
| res := -1 |
| ELSE |
| res := n |
| END |
| RETURN res |
| 250,10 → 269,6 |
| END FileOpen; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| END chmod; |
| PROCEDURE OutChar* (c: CHAR); |
| VAR |
| count: INTEGER; |
| 277,31 → 292,33 |
| END isRelative; |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN _time(0) |
| END UnixTime; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); |
| VAR |
| res: INTEGER; |
| T: TSystemTime; |
| BEGIN |
| a := 0; |
| b := 0; |
| SYSTEM.GET32(SYSTEM.ADR(x), a); |
| SYSTEM.GET32(SYSTEM.ADR(x) + 4, b); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| _GetSystemTime(T); |
| year := ORD(T.Year); |
| month := ORD(T.Month); |
| day := ORD(T.Day); |
| hour := ORD(T.Hour); |
| min := ORD(T.Min); |
| sec := ORD(T.Sec) |
| END now; |
| PROCEDURE UnixTime* (): INTEGER; |
| RETURN 0 |
| END UnixTime; |
| PROCEDURE d2s* (x: REAL): INTEGER; |
| VAR |
| h, l, s, e: INTEGER; |
| BEGIN |
| e := splitf(x, l, h); |
| SYSTEM.GET(SYSTEM.ADR(x), l); |
| SYSTEM.GET(SYSTEM.ADR(x) + 4, h); |
| s := ASR(h, 31) MOD 2; |
| e := (h DIV 100000H) MOD 2048; |
| 331,7 → 348,22 |
| END d2s; |
| PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| BEGIN |
| a := 0; |
| b := 0; |
| SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); |
| SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); |
| SYSTEM.GET(SYSTEM.ADR(x), res) |
| RETURN res |
| END splitf; |
| BEGIN |
| eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; |
| maxreal := 1.9; |
| PACK(maxreal, 1023); |
| hConsoleOutput := _GetStdHandle(-11); |
| /programs/develop/oberon07/Lib/Windows64/In.ob07 |
|---|
| 1,75 → 1,291 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2017, 2018, 2019 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE In; |
| IMPORT SYSTEM; |
| IMPORT sys := SYSTEM; |
| TYPE |
| CONST |
| STRING = ARRAY 260 OF CHAR; |
| MAX_LEN = 1024; |
| VAR |
| Done*: BOOLEAN; |
| hConsoleInput: INTEGER; |
| s: ARRAY MAX_LEN + 4 OF CHAR; |
| PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
| GetStdHandle (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows, "msvcrt.dll", ""] sscanf (buf: INTEGER; fmt: INTEGER; adr: INTEGER): INTEGER; |
| PROCEDURE [windows, "kernel32.dll", ""] GetStdHandle (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows, "kernel32.dll", ""] ReadConsoleA (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "ReadConsoleA"] |
| ReadConsole (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
| PROCEDURE digit(ch: CHAR): BOOLEAN; |
| RETURN (ch >= "0") & (ch <= "9") |
| END digit; |
| PROCEDURE String* (VAR str: ARRAY OF CHAR); |
| VAR |
| count: INTEGER; |
| PROCEDURE CheckInt(s: STRING; VAR first, last: INTEGER; VAR neg: BOOLEAN; Point: BOOLEAN): BOOLEAN; |
| VAR i: INTEGER; |
| BEGIN |
| i := 0; |
| neg := FALSE; |
| WHILE (s[i] <= 20X) & (s[i] # 0X) DO |
| INC(i) |
| END; |
| IF s[i] = "-" THEN |
| neg := TRUE; |
| INC(i) |
| ELSIF s[i] = "+" THEN |
| INC(i) |
| END; |
| first := i; |
| WHILE digit(s[i]) DO |
| INC(i) |
| END; |
| last := i |
| RETURN ((s[i] <= 20X) OR (Point & (s[i] = "."))) & digit(s[first]) |
| END CheckInt; |
| PROCEDURE IsMinInt(str: STRING; pos: INTEGER): BOOLEAN; |
| VAR i: INTEGER; min: STRING; |
| BEGIN |
| ReadConsoleA(hConsoleInput, SYSTEM.ADR(s[0]), MAX_LEN, SYSTEM.ADR(count), 0); |
| IF (s[count - 1] = 0AX) & (s[count - 2] = 0DX) THEN |
| DEC(count, 2) |
| i := 0; |
| min := "2147483648"; |
| WHILE (min[i] # 0X) & (str[i] # 0X) & (min[i] = str[i + pos]) DO |
| INC(i) |
| END |
| RETURN i = 10 |
| END IsMinInt; |
| PROCEDURE StrToInt(str: STRING; VAR err: BOOLEAN): INTEGER; |
| CONST maxINT = 7FFFFFFFH; |
| VAR i, n, res: INTEGER; flag, neg: BOOLEAN; |
| BEGIN |
| res := 0; |
| flag := CheckInt(str, i, n, neg, FALSE); |
| err := ~flag; |
| IF flag & neg & IsMinInt(str, i) THEN |
| flag := FALSE; |
| neg := FALSE; |
| res := 80000000H |
| END; |
| s[count] := 0X; |
| COPY(s, str); |
| str[LEN(str) - 1] := 0X; |
| Done := TRUE |
| END String; |
| WHILE flag & digit(str[i]) DO |
| IF res > maxINT DIV 10 THEN |
| err := TRUE; |
| flag := FALSE; |
| res := 0 |
| ELSE |
| res := res * 10; |
| IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN |
| err := TRUE; |
| flag := FALSE; |
| res := 0 |
| ELSE |
| res := res + (ORD(str[i]) - ORD("0")); |
| INC(i) |
| END |
| END |
| END; |
| IF neg THEN |
| res := -res |
| END |
| RETURN res |
| END StrToInt; |
| PROCEDURE Space(s: STRING): BOOLEAN; |
| VAR i: INTEGER; |
| BEGIN |
| i := 0; |
| WHILE (s[i] # 0X) & (s[i] <= 20X) DO |
| INC(i) |
| END |
| RETURN s[i] = 0X |
| END Space; |
| PROCEDURE Int* (VAR x: INTEGER); |
| PROCEDURE CheckReal(s: STRING; VAR n: INTEGER; VAR neg: BOOLEAN): BOOLEAN; |
| VAR i: INTEGER; Res: BOOLEAN; |
| BEGIN |
| String(s); |
| Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lld"), SYSTEM.ADR(x)) = 1 |
| END Int; |
| Res := CheckInt(s, n, i, neg, TRUE); |
| IF Res THEN |
| IF s[i] = "." THEN |
| INC(i); |
| WHILE digit(s[i]) DO |
| INC(i) |
| END; |
| IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN |
| INC(i); |
| IF (s[i] = "+") OR (s[i] = "-") THEN |
| INC(i) |
| END; |
| Res := digit(s[i]); |
| WHILE digit(s[i]) DO |
| INC(i) |
| END |
| END |
| END |
| END |
| RETURN Res & (s[i] <= 20X) |
| END CheckReal; |
| PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL; |
| CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH; |
| VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN; |
| PROCEDURE Real* (VAR x: REAL); |
| PROCEDURE part1(VAR res, d: REAL; VAR i: INTEGER; str: STRING): BOOLEAN; |
| BEGIN |
| String(s); |
| Done := sscanf(SYSTEM.ADR(s[0]), SYSTEM.SADR("%lf"), SYSTEM.ADR(x)) = 1 |
| END Real; |
| res := 0.0; |
| d := 1.0; |
| WHILE digit(str[i]) DO |
| res := res * 10.0 + FLT(ORD(str[i]) - ORD("0")); |
| INC(i) |
| END; |
| IF str[i] = "." THEN |
| INC(i); |
| WHILE digit(str[i]) DO |
| d := d / 10.0; |
| res := res + FLT(ORD(str[i]) - ORD("0")) * d; |
| INC(i) |
| END |
| END |
| RETURN str[i] # 0X |
| END part1; |
| PROCEDURE part2(VAR i, scale: INTEGER; VAR m, res: REAL; VAR minus, err: BOOLEAN; str: STRING): BOOLEAN; |
| BEGIN |
| INC(i); |
| m := 10.0; |
| minus := FALSE; |
| IF str[i] = "+" THEN |
| INC(i) |
| ELSIF str[i] = "-" THEN |
| minus := TRUE; |
| INC(i); |
| m := 0.1 |
| END; |
| scale := 0; |
| err := FALSE; |
| WHILE ~err & digit(str[i]) DO |
| IF scale > maxINT DIV 10 THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| scale := scale * 10; |
| IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| scale := scale + (ORD(str[i]) - ORD("0")); |
| INC(i) |
| END |
| END |
| END |
| RETURN ~err |
| END part2; |
| PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR scale: INTEGER; VAR res, m: REAL); |
| VAR i: INTEGER; |
| BEGIN |
| err := FALSE; |
| IF scale = maxINT THEN |
| err := TRUE; |
| res := 0.0 |
| END; |
| i := 1; |
| WHILE ~err & (i <= scale) DO |
| IF ~minus & (res > maxDBL / m) THEN |
| err := TRUE; |
| res := 0.0 |
| ELSE |
| res := res * m; |
| INC(i) |
| END |
| END |
| END part3; |
| BEGIN |
| IF CheckReal(str, i, neg) THEN |
| IF part1(res, d, i, str) & part2(i, scale, m, res, minus, err, str) THEN |
| part3(err, minus, scale, res, m) |
| END; |
| IF neg THEN |
| res := -res |
| END |
| ELSE |
| res := 0.0; |
| err := TRUE |
| END |
| RETURN res |
| END StrToFloat; |
| PROCEDURE String*(VAR s: ARRAY OF CHAR); |
| VAR count, i: INTEGER; str: STRING; |
| BEGIN |
| ReadConsole(hConsoleInput, sys.ADR(str[0]), 256, sys.ADR(count), 0); |
| IF (str[count - 1] = 0AX) & (str[count - 2] = 0DX) THEN |
| DEC(count, 2) |
| END; |
| str[256] := 0X; |
| str[count] := 0X; |
| i := 0; |
| WHILE (i < LEN(s) - 1) & (i < LEN(str)) & (str[i] # 0X) DO |
| s[i] := str[i]; |
| INC(i) |
| END; |
| s[i] := 0X; |
| Done := TRUE |
| END String; |
| PROCEDURE Char* (VAR x: CHAR); |
| VAR str: STRING; |
| BEGIN |
| String(s); |
| x := s[0] |
| String(str); |
| x := str[0]; |
| Done := TRUE |
| END Char; |
| PROCEDURE Ln*; |
| VAR str: STRING; |
| BEGIN |
| String(s) |
| String(str); |
| Done := TRUE |
| END Ln; |
| PROCEDURE Real*(VAR x: REAL); |
| VAR str: STRING; err: BOOLEAN; |
| BEGIN |
| err := FALSE; |
| REPEAT |
| String(str) |
| UNTIL ~Space(str); |
| x := StrToFloat(str, err); |
| Done := ~err |
| END Real; |
| PROCEDURE Int*(VAR x: INTEGER); |
| VAR str: STRING; err: BOOLEAN; |
| BEGIN |
| err := FALSE; |
| REPEAT |
| String(str) |
| UNTIL ~Space(str); |
| x := StrToInt(str, err); |
| Done := ~err |
| END Int; |
| PROCEDURE Open*; |
| BEGIN |
| hConsoleInput := GetStdHandle(-10); |
| 76,5 → 292,4 |
| Done := TRUE |
| END Open; |
| END In. |
| /programs/develop/oberon07/Lib/Windows64/Math.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| 12,32 → 12,22 |
| CONST |
| pi* = 3.1415926535897932384626433832795028841972E0; |
| e* = 2.7182818284590452353602874713526624977572E0; |
| e *= 2.71828182845904523; |
| pi *= 3.14159265358979324; |
| ln2 *= 0.693147180559945309; |
| ZERO = 0.0E0; |
| ONE = 1.0E0; |
| HALF = 0.5E0; |
| TWO = 2.0E0; |
| sqrtHalf = 0.70710678118654752440E0; |
| eps = 5.5511151E-17; |
| ln2Inv = 1.44269504088896340735992468100189213E0; |
| piInv = ONE / pi; |
| Limit = 1.0536712E-8; |
| piByTwo = pi / TWO; |
| eps = 1.0E-16; |
| MaxCosArg = 1000000.0 * pi; |
| expoMax = 1023; |
| expoMin = 1 - expoMax; |
| VAR |
| LnInfinity, LnSmall, large, miny: REAL; |
| Exp: ARRAY 710 OF REAL; |
| PROCEDURE [stdcall64] sqrt* (x: REAL): REAL; |
| BEGIN |
| ASSERT(x >= ZERO); |
| ASSERT(x >= 0.0); |
| SYSTEM.CODE( |
| 0F2H, 0FH, 51H, 45H, 10H, (* sqrtsd xmm0, qword[rbp + 10h] *) |
| 05DH, (* pop rbp *) |
| 48,314 → 38,179 |
| END sqrt; |
| PROCEDURE sqri* (x: INTEGER): INTEGER; |
| RETURN x * x |
| END sqri; |
| PROCEDURE sqrr* (x: REAL): REAL; |
| RETURN x * x |
| END sqrr; |
| PROCEDURE exp* (x: REAL): REAL; |
| CONST |
| c1 = 0.693359375E0; |
| c2 = -2.1219444005469058277E-4; |
| P0 = 0.249999999999999993E+0; |
| P1 = 0.694360001511792852E-2; |
| P2 = 0.165203300268279130E-4; |
| Q1 = 0.555538666969001188E-1; |
| Q2 = 0.495862884905441294E-3; |
| e25 = 1.284025416687741484; (* exp(0.25) *) |
| VAR |
| xn, g, p, q, z: REAL; |
| a, s, res: REAL; |
| neg: BOOLEAN; |
| n: INTEGER; |
| BEGIN |
| IF x > LnInfinity THEN |
| x := SYSTEM.INF() |
| ELSIF x < LnSmall THEN |
| x := ZERO |
| ELSIF ABS(x) < eps THEN |
| x := ONE |
| neg := x < 0.0; |
| IF neg THEN |
| x := -x |
| END; |
| IF x < FLT(LEN(Exp)) THEN |
| res := Exp[FLOOR(x)]; |
| x := x - FLT(FLOOR(x)); |
| WHILE x >= 0.25 DO |
| res := res * e25; |
| x := x - 0.25 |
| END |
| ELSE |
| IF x >= ZERO THEN |
| n := FLOOR(ln2Inv * x + HALF) |
| ELSE |
| n := FLOOR(ln2Inv * x - HALF) |
| res := SYSTEM.INF(); |
| x := 0.0 |
| END; |
| xn := FLT(n); |
| g := (x - xn * c1) - xn * c2; |
| z := g * g; |
| p := ((P2 * z + P1) * z + P0) * g; |
| q := (Q2 * z + Q1) * z + HALF; |
| x := HALF + p / (q - p); |
| PACK(x, n + 1) |
| n := 0; |
| a := 1.0; |
| s := 1.0; |
| REPEAT |
| INC(n); |
| a := a * x / FLT(n); |
| s := s + a |
| UNTIL a < eps; |
| IF neg THEN |
| res := 1.0 / (res * s) |
| ELSE |
| res := res * s |
| END |
| RETURN x |
| RETURN res |
| END exp; |
| PROCEDURE ln* (x: REAL): REAL; |
| CONST |
| c1 = 355.0E0 / 512.0E0; |
| c2 = -2.121944400546905827679E-4; |
| P0 = -0.64124943423745581147E+2; |
| P1 = 0.16383943563021534222E+2; |
| P2 = -0.78956112887491257267E+0; |
| Q0 = -0.76949932108494879777E+3; |
| Q1 = 0.31203222091924532844E+3; |
| Q2 = -0.35667977739034646171E+2; |
| VAR |
| zn, zd, r, z, w, p, q, xn: REAL; |
| a, x2, res: REAL; |
| n: INTEGER; |
| BEGIN |
| ASSERT(x > ZERO); |
| ASSERT(x > 0.0); |
| UNPK(x, n); |
| x := x * HALF; |
| IF x > sqrtHalf THEN |
| zn := x - ONE; |
| zd := x * HALF + HALF; |
| INC(n) |
| ELSE |
| zn := x - HALF; |
| zd := zn * HALF + HALF |
| END; |
| x := (x - 1.0) / (x + 1.0); |
| x2 := x * x; |
| res := x + FLT(n) * (ln2 * 0.5); |
| n := 1; |
| z := zn / zd; |
| w := z * z; |
| q := ((w + Q2) * w + Q1) * w + Q0; |
| p := w * ((P2 * w + P1) * w + P0); |
| r := z + z * (p / q); |
| xn := FLT(n) |
| REPEAT |
| INC(n, 2); |
| x := x * x2; |
| a := x / FLT(n); |
| res := res + a |
| UNTIL a < eps |
| RETURN (xn * c2 + r) + xn * c1 |
| RETURN res * 2.0 |
| END ln; |
| PROCEDURE power* (base, exponent: REAL): REAL; |
| BEGIN |
| ASSERT(base > ZERO) |
| ASSERT(base > 0.0) |
| RETURN exp(exponent * ln(base)) |
| END power; |
| PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
| VAR |
| i: INTEGER; |
| a: REAL; |
| BEGIN |
| a := 1.0; |
| IF base # 0.0 THEN |
| IF exponent # 0 THEN |
| IF exponent < 0 THEN |
| base := 1.0 / base |
| END; |
| i := ABS(exponent); |
| WHILE i > 0 DO |
| WHILE ~ODD(i) DO |
| i := LSR(i, 1); |
| base := sqrr(base) |
| END; |
| DEC(i); |
| a := a * base |
| END |
| ELSE |
| a := 1.0 |
| END |
| ELSE |
| ASSERT(exponent > 0); |
| a := 0.0 |
| END |
| RETURN a |
| END ipower; |
| PROCEDURE log* (base, x: REAL): REAL; |
| BEGIN |
| ASSERT(base > ZERO); |
| ASSERT(x > ZERO) |
| ASSERT(base > 0.0); |
| ASSERT(x > 0.0) |
| RETURN ln(x) / ln(base) |
| END log; |
| PROCEDURE SinCos (x, y, sign: REAL): REAL; |
| CONST |
| ymax = 210828714; |
| c1 = 3.1416015625E0; |
| c2 = -8.908910206761537356617E-6; |
| r1 = -0.16666666666666665052E+0; |
| r2 = 0.83333333333331650314E-2; |
| r3 = -0.19841269841201840457E-3; |
| r4 = 0.27557319210152756119E-5; |
| r5 = -0.25052106798274584544E-7; |
| r6 = 0.16058936490371589114E-9; |
| r7 = -0.76429178068910467734E-12; |
| r8 = 0.27204790957888846175E-14; |
| PROCEDURE cos* (x: REAL): REAL; |
| VAR |
| a, res: REAL; |
| n: INTEGER; |
| xn, f, x1, g: REAL; |
| BEGIN |
| ASSERT(y < FLT(ymax)); |
| n := FLOOR(y * piInv + HALF); |
| xn := FLT(n); |
| IF ODD(n) THEN |
| sign := -sign |
| END; |
| x := ABS(x); |
| IF x # y THEN |
| xn := xn - HALF |
| END; |
| ASSERT(x <= MaxCosArg); |
| x1 := FLT(FLOOR(x)); |
| f := ((x1 - xn * c1) + (x - x1)) - xn * c2; |
| x := x - FLT( FLOOR(x / (2.0 * pi)) ) * (2.0 * pi); |
| x := x * x; |
| res := 0.0; |
| a := 1.0; |
| n := -1; |
| IF ABS(f) < Limit THEN |
| x := sign * f |
| ELSE |
| g := f * f; |
| g := (((((((r8 * g + r7) * g + r6) * g + r5) * g + r4) * g + r3) * g + r2) * g + r1) * g; |
| g := f + f * g; |
| x := sign * g |
| END |
| REPEAT |
| INC(n, 2); |
| res := res + a; |
| a := -a * x / FLT(n*n + n) |
| UNTIL ABS(a) < eps |
| RETURN x |
| END SinCos; |
| RETURN res |
| END cos; |
| PROCEDURE sin* (x: REAL): REAL; |
| BEGIN |
| IF x < ZERO THEN |
| x := SinCos(x, -x, -ONE) |
| ELSE |
| x := SinCos(x, x, ONE) |
| END |
| RETURN x |
| ASSERT(ABS(x) <= MaxCosArg); |
| x := cos(x) |
| RETURN sqrt(1.0 - x * x) |
| END sin; |
| PROCEDURE cos* (x: REAL): REAL; |
| RETURN SinCos(x, ABS(x) + piByTwo, ONE) |
| END cos; |
| PROCEDURE tan* (x: REAL): REAL; |
| VAR |
| s, c: REAL; |
| BEGIN |
| s := sin(x); |
| c := sqrt(ONE - s * s); |
| x := ABS(x) / (TWO * pi); |
| x := x - FLT(FLOOR(x)); |
| IF (0.25 < x) & (x < 0.75) THEN |
| c := -c |
| END |
| RETURN s / c |
| ASSERT(ABS(x) <= MaxCosArg); |
| x := cos(x) |
| RETURN sqrt(1.0 - x * x) / x |
| END tan; |
| PROCEDURE arctan2* (y, x: REAL): REAL; |
| CONST |
| P0 = 0.216062307897242551884E+3; P1 = 0.3226620700132512059245E+3; |
| P2 = 0.13270239816397674701E+3; P3 = 0.1288838303415727934E+2; |
| Q0 = 0.2160623078972426128957E+3; Q1 = 0.3946828393122829592162E+3; |
| Q2 = 0.221050883028417680623E+3; Q3 = 0.3850148650835119501E+2; |
| Sqrt3 = 1.7320508075688772935E0; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| PROCEDURE arctan (x: REAL): REAL; |
| VAR |
| atan, z, z2, p, q: REAL; |
| yExp, xExp, Quadrant: INTEGER; |
| z, p, k: REAL; |
| BEGIN |
| IF ABS(x) < miny THEN |
| ASSERT(ABS(y) >= miny); |
| atan := piByTwo |
| ELSE |
| z := y; |
| UNPK(z, yExp); |
| z := x; |
| UNPK(z, xExp); |
| p := x / (x * x + 1.0); |
| z := p * x; |
| x := 0.0; |
| k := 0.0; |
| IF yExp - xExp >= expoMax - 3 THEN |
| atan := piByTwo |
| ELSIF yExp - xExp < expoMin + 3 THEN |
| atan := ZERO |
| ELSE |
| IF ABS(y) > ABS(x) THEN |
| z := ABS(x / y); |
| Quadrant := 2 |
| ELSE |
| z := ABS(y / x); |
| Quadrant := 0 |
| END; |
| REPEAT |
| k := k + 2.0; |
| x := x + p; |
| p := p * k * z / (k + 1.0) |
| UNTIL p < eps |
| IF z > TWO - Sqrt3 THEN |
| z := (z * Sqrt3 - ONE) / (Sqrt3 + z); |
| INC(Quadrant) |
| END; |
| RETURN x |
| END arctan; |
| IF ABS(z) < Limit THEN |
| atan := z |
| ELSE |
| z2 := z * z; |
| p := (((P3 * z2 + P2) * z2 + P1) * z2 + P0) * z; |
| q := (((z2 + Q3) * z2 + Q2) * z2 + Q1) * z2 + Q0; |
| atan := p / q |
| END; |
| CASE Quadrant OF |
| |0: |
| |1: atan := atan + pi / 6.0 |
| |2: atan := piByTwo - atan |
| |3: atan := pi / 3.0 - atan |
| END |
| END; |
| BEGIN |
| ASSERT(ABS(x) <= 1.0); |
| IF x < ZERO THEN |
| atan := pi - atan |
| IF ABS(x) >= 0.707 THEN |
| x := 0.5 * pi - arctan(sqrt(1.0 - x * x) / x) |
| ELSE |
| x := arctan(x / sqrt(1.0 - x * x)) |
| END |
| END; |
| IF y < ZERO THEN |
| atan := -atan |
| END |
| RETURN atan |
| END arctan2; |
| PROCEDURE arcsin* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) <= ONE) |
| RETURN arctan2(x, sqrt(ONE - x * x)) |
| RETURN x |
| END arcsin; |
| PROCEDURE arccos* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) <= ONE) |
| RETURN arctan2(sqrt(ONE - x * x), x) |
| ASSERT(ABS(x) <= 1.0) |
| RETURN 0.5 * pi - arcsin(x) |
| END arccos; |
| PROCEDURE arctan* (x: REAL): REAL; |
| RETURN arctan2(x, ONE) |
| RETURN arcsin(x / sqrt(1.0 + x * x)) |
| END arctan; |
| 362,7 → 217,7 |
| PROCEDURE sinh* (x: REAL): REAL; |
| BEGIN |
| x := exp(x) |
| RETURN (x - ONE / x) * HALF |
| RETURN (x - 1.0 / x) * 0.5 |
| END sinh; |
| 369,7 → 224,7 |
| PROCEDURE cosh* (x: REAL): REAL; |
| BEGIN |
| x := exp(x) |
| RETURN (x + ONE / x) * HALF |
| RETURN (x + 1.0 / x) * 0.5 |
| END cosh; |
| 376,12 → 231,12 |
| PROCEDURE tanh* (x: REAL): REAL; |
| BEGIN |
| IF x > 15.0 THEN |
| x := ONE |
| x := 1.0 |
| ELSIF x < -15.0 THEN |
| x := -ONE |
| x := -1.0 |
| ELSE |
| x := exp(TWO * x); |
| x := (x - ONE) / (x + ONE) |
| x := exp(2.0 * x); |
| x := (x - 1.0) / (x + 1.0) |
| END |
| RETURN x |
| 389,21 → 244,21 |
| PROCEDURE arsinh* (x: REAL): REAL; |
| RETURN ln(x + sqrt(x * x + ONE)) |
| RETURN ln(x + sqrt(x * x + 1.0)) |
| END arsinh; |
| PROCEDURE arcosh* (x: REAL): REAL; |
| BEGIN |
| ASSERT(x >= ONE) |
| RETURN ln(x + sqrt(x * x - ONE)) |
| ASSERT(x >= 1.0) |
| RETURN ln(x + sqrt(x * x - 1.0)) |
| END arcosh; |
| PROCEDURE artanh* (x: REAL): REAL; |
| BEGIN |
| ASSERT(ABS(x) < ONE) |
| RETURN HALF * ln((ONE + x) / (ONE - x)) |
| ASSERT(ABS(x) < 1.0) |
| RETURN 0.5 * ln((1.0 + x) / (1.0 - x)) |
| END artanh; |
| 412,9 → 267,9 |
| res: INTEGER; |
| BEGIN |
| IF x > ZERO THEN |
| IF x > 0.0 THEN |
| res := 1 |
| ELSIF x < ZERO THEN |
| ELSIF x < 0.0 THEN |
| res := -1 |
| ELSE |
| res := 0 |
| 429,7 → 284,7 |
| res: REAL; |
| BEGIN |
| res := ONE; |
| res := 1.0; |
| WHILE n > 1 DO |
| res := res * FLT(n); |
| DEC(n) |
| 439,42 → 294,18 |
| END fact; |
| PROCEDURE DegToRad* (x: REAL): REAL; |
| RETURN x * (pi / 180.0) |
| END DegToRad; |
| PROCEDURE RadToDeg* (x: REAL): REAL; |
| RETURN x * (180.0 / pi) |
| END RadToDeg; |
| (* Return hypotenuse of triangle *) |
| PROCEDURE hypot* (x, y: REAL): REAL; |
| PROCEDURE init; |
| VAR |
| a: REAL; |
| i: INTEGER; |
| BEGIN |
| x := ABS(x); |
| y := ABS(y); |
| IF x > y THEN |
| a := x * sqrt(1.0 + sqrr(y / x)) |
| ELSE |
| IF x > 0.0 THEN |
| a := y * sqrt(1.0 + sqrr(x / y)) |
| ELSE |
| a := y |
| Exp[0] := 1.0; |
| FOR i := 1 TO LEN(Exp) - 1 DO |
| Exp[i] := Exp[i - 1] * e |
| END |
| END |
| END init; |
| RETURN a |
| END hypot; |
| BEGIN |
| large := 1.9; |
| PACK(large, expoMax); |
| miny := ONE / large; |
| LnInfinity := ln(large); |
| LnSmall := ln(miny); |
| init |
| END Math. |
| /programs/develop/oberon07/Lib/Windows64/Out.ob07 |
|---|
| 1,86 → 1,308 |
| (* |
| BSD 2-Clause License |
| Copyright 2013, 2014, 2017, 2018, 2019 Anton Krotov |
| Copyright (c) 2020, Anton Krotov |
| All rights reserved. |
| This program is free software: you can redistribute it and/or modify |
| it under the terms of the GNU Lesser General Public License as published by |
| the Free Software Foundation, either version 3 of the License, or |
| (at your option) any later version. |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU Lesser General Public License for more details. |
| You should have received a copy of the GNU Lesser General Public License |
| along with this program. If not, see <http://www.gnu.org/licenses/>. |
| *) |
| MODULE Out; |
| IMPORT SYSTEM; |
| IMPORT sys := SYSTEM; |
| CONST |
| d = 1.0 - 5.0E-12; |
| TYPE |
| POverlapped* = POINTER TO OVERLAPPED; |
| OVERLAPPED* = RECORD |
| Internal*: INTEGER; |
| InternalHigh*: INTEGER; |
| Offset*: INTEGER; |
| OffsetHigh*: INTEGER; |
| hEvent*: INTEGER |
| END; |
| VAR |
| hConsoleOutput: INTEGER; |
| Realp: PROCEDURE (x: REAL; width: INTEGER); |
| PROCEDURE [windows, "msvcrt.dll", "printf"] printf1 (fmt: INTEGER; x: INTEGER); |
| PROCEDURE [windows, "msvcrt.dll", "printf"] printf2 (fmt: INTEGER; width, x: INTEGER); |
| PROCEDURE [windows, "msvcrt.dll", "printf"] printf3 (fmt: INTEGER; width, precision, x: INTEGER); |
| PROCEDURE [windows, "kernel32.dll", ""] |
| WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER); |
| PROCEDURE [windows, "kernel32.dll", ""] |
| PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
| GetStdHandle (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
| WriteFile (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteConsoleW"] |
| WriteConsoleW (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE Char* (x: CHAR); |
| VAR count: INTEGER; |
| BEGIN |
| printf1(SYSTEM.SADR("%c"), ORD(x)) |
| WriteFile(hConsoleOutput, sys.ADR(x), 1, sys.ADR(count), NIL) |
| END Char; |
| PROCEDURE StringW* (s: ARRAY OF WCHAR); |
| VAR count: INTEGER; |
| BEGIN |
| WriteConsoleW(hConsoleOutput, SYSTEM.ADR(s[0]), LENGTH(s), 0, 0) |
| WriteConsoleW(hConsoleOutput, sys.ADR(s[0]), LENGTH(s), sys.ADR(count), 0) |
| END StringW; |
| PROCEDURE String* (s: ARRAY OF CHAR); |
| VAR len, i: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%.*s"), LENGTH(s), SYSTEM.ADR(s[0])) |
| len := LENGTH(s); |
| FOR i := 0 TO len - 1 DO |
| Char(s[i]) |
| END |
| END String; |
| PROCEDURE WriteInt(x, n: INTEGER); |
| VAR i: INTEGER; a: ARRAY 32 OF CHAR; neg: BOOLEAN; |
| BEGIN |
| i := 0; |
| IF n < 1 THEN |
| n := 1 |
| END; |
| IF x < 0 THEN |
| x := -x; |
| DEC(n); |
| neg := TRUE |
| END; |
| REPEAT |
| a[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| WHILE n > i DO |
| Char(" "); |
| DEC(n) |
| END; |
| IF neg THEN |
| Char("-") |
| END; |
| REPEAT |
| DEC(i); |
| Char(a[i]) |
| UNTIL i = 0 |
| END WriteInt; |
| PROCEDURE Ln*; |
| PROCEDURE IsNan(AValue: REAL): BOOLEAN; |
| VAR s: SET; |
| BEGIN |
| printf1(SYSTEM.SADR("%s"), SYSTEM.SADR(CHR(13) + CHR(10))) |
| END Ln; |
| sys.GET(sys.ADR(AValue), s) |
| RETURN (s * {52..62} = {52..62}) & ((s * {32..51} # {}) OR (s * {0..31} # {})) |
| END IsNan; |
| PROCEDURE IsInf(x: REAL): BOOLEAN; |
| RETURN ABS(x) = sys.INF() |
| END IsInf; |
| PROCEDURE Int* (x, width: INTEGER); |
| VAR i, minInt: INTEGER; |
| BEGIN |
| printf2(SYSTEM.SADR("%*lld"), width, x) |
| minInt := 1; |
| minInt := ROR(minInt, 1); |
| IF x # minInt THEN |
| WriteInt(x, width) |
| ELSE |
| FOR i := 21 TO width DO |
| Char(20X) |
| END; |
| String("-9223372036854775808") |
| END |
| END Int; |
| PROCEDURE OutInf(x: REAL; width: INTEGER); |
| VAR s: ARRAY 5 OF CHAR; i: INTEGER; |
| BEGIN |
| IF IsNan(x) THEN |
| s := "Nan"; |
| INC(width) |
| ELSIF IsInf(x) & (x > 0.0) THEN |
| s := "+Inf" |
| ELSIF IsInf(x) & (x < 0.0) THEN |
| s := "-Inf" |
| END; |
| FOR i := 1 TO width - 4 DO |
| Char(" ") |
| END; |
| String(s) |
| END OutInf; |
| PROCEDURE intval (x: REAL): INTEGER; |
| VAR |
| i: INTEGER; |
| PROCEDURE Ln*; |
| BEGIN |
| Char(0DX); |
| Char(0AX) |
| END Ln; |
| PROCEDURE _FixReal(x: REAL; width, p: INTEGER); |
| VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; |
| BEGIN |
| SYSTEM.GET(SYSTEM.ADR(x), i) |
| RETURN i |
| END intval; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSIF p < 0 THEN |
| Realp(x, width) |
| ELSE |
| len := 0; |
| minus := FALSE; |
| IF x < 0.0 THEN |
| minus := TRUE; |
| INC(len); |
| x := ABS(x) |
| END; |
| e := 0; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| IF e >= 0 THEN |
| len := len + e + p + 1; |
| IF x > 9.0 + d THEN |
| INC(len) |
| END; |
| IF p > 0 THEN |
| INC(len) |
| END; |
| ELSE |
| len := len + p + 2 |
| END; |
| FOR i := 1 TO width - len DO |
| Char(" ") |
| END; |
| IF minus THEN |
| Char("-") |
| END; |
| y := x; |
| WHILE (y < 1.0) & (y # 0.0) DO |
| y := y * 10.0; |
| DEC(e) |
| END; |
| IF e < 0 THEN |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char("1"); |
| x := 0.0 |
| ELSE |
| Char("0"); |
| x := x * 10.0 |
| END |
| ELSE |
| WHILE e >= 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| IF x > 9.0 THEN |
| String("10") |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0") + 1)) |
| END; |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(e) |
| END |
| END; |
| IF p > 0 THEN |
| Char(".") |
| END; |
| WHILE p > 0 DO |
| IF x - FLT(FLOOR(x)) > d THEN |
| Char(CHR(FLOOR(x) + ORD("0") + 1)); |
| x := 0.0 |
| ELSE |
| Char(CHR(FLOOR(x) + ORD("0"))); |
| x := (x - FLT(FLOOR(x))) * 10.0 |
| END; |
| DEC(p) |
| END |
| END |
| END _FixReal; |
| PROCEDURE Real* (x: REAL; width: INTEGER); |
| VAR e, n, i: INTEGER; minus: BOOLEAN; |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*E"), width, MAX(MIN(width - 8, 15), 1), intval(x)) |
| Realp := Real; |
| IF IsNan(x) OR IsInf(x) THEN |
| OutInf(x, width) |
| ELSE |
| e := 0; |
| n := 0; |
| IF width > 23 THEN |
| n := width - 23; |
| width := 23 |
| ELSIF width < 9 THEN |
| width := 9 |
| END; |
| width := width - 5; |
| IF x < 0.0 THEN |
| x := -x; |
| minus := TRUE |
| ELSE |
| minus := FALSE |
| END; |
| WHILE x >= 10.0 DO |
| x := x / 10.0; |
| INC(e) |
| END; |
| WHILE (x < 1.0) & (x # 0.0) DO |
| x := x * 10.0; |
| DEC(e) |
| END; |
| IF x > 9.0 + d THEN |
| x := 1.0; |
| INC(e) |
| END; |
| FOR i := 1 TO n DO |
| Char(" ") |
| END; |
| IF minus THEN |
| x := -x |
| END; |
| _FixReal(x, width, width - 3); |
| Char("E"); |
| IF e >= 0 THEN |
| Char("+") |
| ELSE |
| Char("-"); |
| e := ABS(e) |
| END; |
| IF e < 100 THEN |
| Char("0") |
| END; |
| IF e < 10 THEN |
| Char("0") |
| END; |
| Int(e, 0) |
| END |
| END Real; |
| PROCEDURE FixReal* (x: REAL; width, precision: INTEGER); |
| PROCEDURE FixReal*(x: REAL; width, p: INTEGER); |
| BEGIN |
| printf3(SYSTEM.SADR("%*.*f"), width, precision, intval(x)) |
| Realp := Real; |
| _FixReal(x, width, p) |
| END FixReal; |
| PROCEDURE Open*; |
| BEGIN |
| hConsoleOutput := GetStdHandle(-11) |
| END Open; |
| END Out. |
| /programs/develop/oberon07/Lib/Windows64/RTL.ob07 |
|---|
| 350,29 → 350,33 |
| PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| i, a, b: INTEGER; |
| c: CHAR; |
| BEGIN |
| i := 0; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| str[i] := 0X; |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| a := 0; |
| b := i - 1; |
| WHILE a < b DO |
| c := str[a]; |
| str[a] := str[b]; |
| str[b] := c; |
| INC(a); |
| DEC(b) |
| END; |
| str[i] := 0X |
| END IntToStr; |
| PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 380,12 → 384,19 |
| ASSERT(n1 + n2 < LEN(s1)); |
| SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER); |
| PROCEDURE [stdcall64] _error* (module, err, line: INTEGER); |
| VAR |
| s, temp: ARRAY 1024 OF CHAR; |
| 404,9 → 415,11 |
| |11: s := "BYTE out of range" |
| END; |
| append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
| append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
| append(s, API.eol); |
| append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
| append(s, "line: "); IntToStr(line, temp); append(s, temp); |
| API.DebugMsg(SYSTEM.ADR(s[0]), name); |
| API.exit_thread(0) |
| /programs/develop/oberon07/Lib/Windows64/UnixTime.ob07 |
|---|
| 0,0 → 1,64 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE UnixTime; |
| VAR |
| days: ARRAY 12, 31, 2 OF INTEGER; |
| PROCEDURE init; |
| VAR |
| i, j, k, n0, n1: INTEGER; |
| BEGIN |
| FOR i := 0 TO 11 DO |
| FOR j := 0 TO 30 DO |
| days[i, j, 0] := 0; |
| days[i, j, 1] := 0; |
| END |
| END; |
| days[ 1, 28, 0] := -1; |
| FOR k := 0 TO 1 DO |
| days[ 1, 29, k] := -1; |
| days[ 1, 30, k] := -1; |
| days[ 3, 30, k] := -1; |
| days[ 5, 30, k] := -1; |
| days[ 8, 30, k] := -1; |
| days[10, 30, k] := -1; |
| END; |
| n0 := 0; |
| n1 := 0; |
| FOR i := 0 TO 11 DO |
| FOR j := 0 TO 30 DO |
| IF days[i, j, 0] = 0 THEN |
| days[i, j, 0] := n0; |
| INC(n0) |
| END; |
| IF days[i, j, 1] = 0 THEN |
| days[i, j, 1] := n1; |
| INC(n1) |
| END |
| END |
| END |
| END init; |
| PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; |
| RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
| END time; |
| BEGIN |
| init |
| END UnixTime. |
| /programs/develop/oberon07/Lib/Windows64/WINAPI.ob07 |
|---|
| 14,11 → 14,7 |
| OFS_MAXPATHNAME* = 128; |
| KERNEL = "kernel32.dll"; |
| USER = "user32.dll"; |
| MSVCRT = "msvcrt.dll"; |
| TYPE |
| DLL_ENTRY* = API.DLL_ENTRY; |
| 60,27 → 56,13 |
| END; |
| tm* = RECORD |
| sec*, |
| min*, |
| hour*, |
| mday*, |
| mon*, |
| year*, |
| wday*, |
| yday*, |
| isdst*: SYSTEM.CARD32 |
| END; |
| PSecurityAttributes* = POINTER TO TSecurityAttributes; |
| TSecurityAttributes* = RECORD |
| nLength*: SYSTEM.CARD32; |
| nLength*: INTEGER; |
| lpSecurityDescriptor*: INTEGER; |
| bInheritHandle*: SYSTEM.CARD32 (* BOOL *) |
| bInheritHandle*: INTEGER |
| END; |
| 87,32 → 69,14 |
| TFileTime* = RECORD |
| dwLowDateTime*, |
| dwHighDateTime*: SYSTEM.CARD32 |
| dwHighDateTime*: INTEGER |
| END; |
| TWin32FindData* = RECORD |
| dwFileAttributes*: SYSTEM.CARD32; |
| ftCreationTime*: TFileTime; |
| ftLastAccessTime*: TFileTime; |
| ftLastWriteTime*: TFileTime; |
| nFileSizeHigh*: SYSTEM.CARD32; |
| nFileSizeLow*: SYSTEM.CARD32; |
| dwReserved0*: SYSTEM.CARD32; |
| dwReserved1*: SYSTEM.CARD32; |
| cFileName*: STRING; |
| cAlternateFileName*: ARRAY 14 OF CHAR; |
| dwFileType*: SYSTEM.CARD32; |
| dwCreatorType*: SYSTEM.CARD32; |
| wFinderFlags*: WCHAR |
| END; |
| OFSTRUCT* = RECORD |
| cBytes*: BYTE; |
| fFixedDisk*: BYTE; |
| cBytes*: CHAR; |
| fFixedDisk*: CHAR; |
| nErrCode*: WCHAR; |
| Reserved1*: WCHAR; |
| Reserved2*: WCHAR; |
| 126,95 → 90,77 |
| Internal*: INTEGER; |
| InternalHigh*: INTEGER; |
| Offset*: SYSTEM.CARD32; |
| OffsetHigh*: SYSTEM.CARD32; |
| Offset*: INTEGER; |
| OffsetHigh*: INTEGER; |
| hEvent*: INTEGER |
| END; |
| PROCEDURE [windows-, KERNEL, ""] SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "SetConsoleCursorPosition"] |
| SetConsoleCursorPosition* (hConsoleOutput, dwCursorPosition: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetConsoleScreenBufferInfo"] |
| GetConsoleScreenBufferInfo* (hConsoleOutput: INTEGER; ConsoleScreenBufferInfo: TConsoleScreenBufferInfo): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputCharacterA* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputCharacterA"] |
| FillConsoleOutputCharacter* (hConsoleOutput, cCaracter, nLength, dwWriteCoord, lpNumberOfCharsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FillConsoleOutputAttribute"] |
| FillConsoleOutputAttribute* (hConsoleOutput, wAttribute, nLength, dwWriteCoord, lpNumberOfAttrsWritten: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "SetConsoleTextAttribute"] |
| SetConsoleTextAttribute* (hConsoleOutput, wAttributes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] |
| GetStdHandle* (nStdHandle: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] CloseHandle* (hObject: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] |
| CloseHandle* (hObject: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "WriteFile"] |
| WriteFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "ReadFile"] |
| ReadFile* (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead: INTEGER; lpOverlapped: POverlapped): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetCommandLineA* (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] |
| GetCommandLine* (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] |
| GlobalAlloc* (uFlags, dwBytes: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GlobalFree* (hMem: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] |
| GlobalFree* (hMem: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ExitProcess* (code: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] |
| ExitProcess* (code: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] GetTickCount* (): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] |
| GetTickCount* (): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] Sleep* (dwMilliseconds: INTEGER); |
| PROCEDURE [windows-, "kernel32.dll", "Sleep"] |
| Sleep* (dwMilliseconds: INTEGER); |
| PROCEDURE [windows-, KERNEL, ""] FreeLibrary* (hLibModule: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "FreeLibrary"] |
| FreeLibrary* (hLibModule: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetProcAddress* (hModule, name: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "GetProcAddress"] |
| GetProcAddress* (hModule, name: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] LoadLibraryA* (name: INTEGER): INTEGER; |
| PROCEDURE [windows-, "kernel32.dll", "LoadLibraryA"] |
| LoadLibraryA* (name: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] AllocConsole* (): BOOLEAN; |
| PROCEDURE [windows-, "kernel32.dll", "AllocConsole"] |
| AllocConsole* (): BOOLEAN; |
| PROCEDURE [windows-, KERNEL, ""] FreeConsole* (): BOOLEAN; |
| PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] |
| FreeConsole* (): BOOLEAN; |
| PROCEDURE [windows-, KERNEL, ""] GetLocalTime* (T: TSystemTime); |
| PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] |
| GetLocalTime* (T: TSystemTime); |
| PROCEDURE [windows-, KERNEL, ""] RemoveDirectoryA* (lpPathName: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] GetFileAttributesA* (lpPathName: INTEGER): SET; |
| PROCEDURE [windows-, KERNEL, ""] CreateDirectoryA* (lpPathName: INTEGER; lpSecurityAttributes: PSecurityAttributes): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FindFirstFileA* (lpFileName: INTEGER; lpFindFileData: TWin32FindData): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] DeleteFileA* (lpFileName: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] FindClose* (hFindFile: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] CreateFileA* ( |
| lpFileName, dwDesiredAccess, dwShareMode: INTEGER; |
| lpSecurityAttributes: PSecurityAttributes; |
| dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] OpenFile* (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] SetFilePointer* (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] ReadConsoleA* (hConsoleInput, lpBuffer, nNumberOfCharsToRead, lpNumberOfCharsRead, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] WriteConsoleW* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, KERNEL, ""] WriteConsoleA* (hConsoleOutput, lpBuffer, nNumberOfCharsToWrite, lpNumberOfCharsWritten, lpReserved: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] MessageBoxA* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] MessageBoxW* (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; |
| PROCEDURE [windows-, USER, ""] CreateWindowExA* ( |
| dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, |
| nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam: INTEGER): INTEGER; |
| PROCEDURE [windows-, MSVCRT, ""] time* (ptr: INTEGER): INTEGER; |
| PROCEDURE [windows-, MSVCRT, ""] mktime* (time: tm): INTEGER; |
| PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
| BEGIN |
| API.SetDll(process_detach, thread_detach, thread_attach) |
| /programs/develop/oberon07/Samples/STM32CM3/LCD.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/STM32CM3/TIM67.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/STM32CM3/SysTick.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/STM32CM3/Button.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/STM32CM3/Blink.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/hailst.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/MagicSquares.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/HeapSort.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/Doors.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/MultiplicationTables.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/TempConv.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/sequence012.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/postfix.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/exp.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/HelloRus.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/Hello.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Windows/Console/SierpinskiTriangle.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/Sieve.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/fact.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/SierpinskiCarpet.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Windows/Console/SpiralMatrix.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/MSP430/Blink.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/MSP430/TimerA.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/MSP430/Restart.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/MSP430/Button.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/MSP430/TwoTimers.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/MSP430/Flash.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/KolibriOS/Dialogs.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/KolibriOS/HW_con.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/KolibriOS/HW.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Samples/Linux/HW.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/filler.txt |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/out.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/gr.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/_unix.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/filler/unix.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/animation/_unix.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/animation/unix.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/animation/out.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/animation/gr.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Linux/X11/animation/animation.ob07 |
|---|
| File deleted |
| /programs/develop/oberon07/Samples/Dialogs.ob07 |
|---|
| 0,0 → 1,110 |
| MODULE Dialogs; |
| IMPORT KOSAPI, sys := SYSTEM, OpenDlg, ColorDlg; |
| VAR header: ARRAY 1024 OF CHAR; back_color: INTEGER; |
| PROCEDURE WindowRedrawStatus(p: INTEGER); |
| BEGIN |
| KOSAPI.sysfunc2(12, p) |
| END WindowRedrawStatus; |
| PROCEDURE DefineAndDrawWindow(x, y, w, h, color, style, hcolor, hstyle, htext: INTEGER); |
| BEGIN |
| KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) |
| END DefineAndDrawWindow; |
| PROCEDURE WaitForEvent(): INTEGER; |
| RETURN KOSAPI.sysfunc1(10) |
| END WaitForEvent; |
| PROCEDURE ExitApp; |
| BEGIN |
| KOSAPI.sysfunc1(-1) |
| END ExitApp; |
| PROCEDURE pause(t: INTEGER); |
| BEGIN |
| KOSAPI.sysfunc2(5, t) |
| END pause; |
| PROCEDURE Buttons; |
| PROCEDURE Button(id, X, Y, W, H: INTEGER; Caption: ARRAY OF CHAR); |
| VAR n, aux: INTEGER; |
| BEGIN |
| n := LENGTH(Caption); |
| aux := KOSAPI.sysfunc5(8, X * 65536 + W, Y * 65536 + H, id, 00C0C0C0H); |
| X := X + (W - 8 * n) DIV 2; |
| Y := Y + (H - 14) DIV 2; |
| aux := KOSAPI.sysfunc6(4, X * 65536 + Y, LSL(48, 24), sys.ADR(Caption[0]), n, 0) |
| END Button; |
| BEGIN |
| Button(17, 5, 5, 70, 25, "open"); |
| Button(18, 85, 5, 70, 25, "color"); |
| END Buttons; |
| PROCEDURE draw_window; |
| BEGIN |
| WindowRedrawStatus(1); |
| DefineAndDrawWindow(200, 200, 500, 100, back_color, 51, 0, 0, sys.ADR(header[0])); |
| Buttons; |
| WindowRedrawStatus(2); |
| END draw_window; |
| PROCEDURE OpenFile(Open: OpenDlg.Dialog); |
| BEGIN |
| IF Open # NIL THEN |
| OpenDlg.Show(Open, 500, 450); |
| WHILE Open.status = 2 DO |
| pause(30) |
| END; |
| IF Open.status = 1 THEN |
| COPY(Open.FilePath, header) |
| END |
| END |
| END OpenFile; |
| PROCEDURE SelColor(Color: ColorDlg.Dialog); |
| BEGIN |
| IF Color # NIL THEN |
| ColorDlg.Show(Color); |
| WHILE Color.status = 2 DO |
| pause(30) |
| END; |
| IF Color.status = 1 THEN |
| back_color := Color.color |
| END |
| END |
| END SelColor; |
| PROCEDURE main; |
| VAR Open: OpenDlg.Dialog; Color: ColorDlg.Dialog; res, al: INTEGER; |
| BEGIN |
| back_color := 00FFFFFFH; |
| header := "Dialogs"; |
| draw_window; |
| Open := OpenDlg.Create(draw_window, 0, "/rd/1", "ASM|TXT|INI"); |
| Color := ColorDlg.Create(draw_window); |
| WHILE TRUE DO |
| CASE WaitForEvent() OF |
| |1: draw_window |
| |3: res := KOSAPI.sysfunc1(17); |
| al := LSR(LSL(res, 24), 24); |
| res := LSR(res, 8); |
| IF al = 0 THEN |
| CASE res OF |
| | 1: ExitApp |
| |17: OpenFile(Open) |
| |18: SelColor(Color) |
| END |
| END |
| ELSE |
| END |
| END |
| END main; |
| BEGIN |
| main |
| END Dialogs. |
| /programs/develop/oberon07/Samples/HW.ob07 |
|---|
| 0,0 → 1,50 |
| MODULE HW; |
| IMPORT sys := SYSTEM, KOSAPI; |
| PROCEDURE WindowRedrawStatus(p: INTEGER); |
| BEGIN |
| KOSAPI.sysfunc2(12, p) |
| END WindowRedrawStatus; |
| PROCEDURE DefineAndDrawWindow(x, y, w, h, color, style, hcolor, hstyle, htext: INTEGER); |
| BEGIN |
| KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) |
| END DefineAndDrawWindow; |
| PROCEDURE WriteTextToWindow(x, y, color: INTEGER; text: ARRAY OF CHAR); |
| BEGIN |
| KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(48, 24), sys.ADR(text[0]), LENGTH(text), 0) |
| END WriteTextToWindow; |
| PROCEDURE WaitForEvent(): INTEGER; |
| RETURN KOSAPI.sysfunc1(10) |
| END WaitForEvent; |
| PROCEDURE ExitApp; |
| BEGIN |
| KOSAPI.sysfunc1(-1) |
| END ExitApp; |
| PROCEDURE draw_window(header, text: ARRAY OF CHAR); |
| BEGIN |
| WindowRedrawStatus(1); |
| DefineAndDrawWindow(200, 200, 200, 100, 0FFFFFFH, 51, 0, 0, sys.ADR(header)); |
| WriteTextToWindow(10, 10, 0FF0000H, text); |
| WindowRedrawStatus(2); |
| END draw_window; |
| PROCEDURE Main(header, text: ARRAY OF CHAR); |
| BEGIN |
| WHILE TRUE DO |
| CASE WaitForEvent() OF |
| |1: draw_window(header, text) |
| |3: ExitApp |
| ELSE |
| END |
| END |
| END Main; |
| BEGIN |
| Main("HW", "Hello, world!") |
| END HW. |
| /programs/develop/oberon07/Samples/HW_con.ob07 |
|---|
| 0,0 → 1,63 |
| MODULE HW_con; |
| IMPORT Out, In, Console, DateTime; |
| PROCEDURE OutInt2(n: INTEGER); |
| BEGIN |
| ASSERT((0 <= n) & (n <= 99)); |
| IF n < 10 THEN |
| Out.Char("0") |
| END; |
| Out.Int(n, 0) |
| END OutInt2; |
| PROCEDURE OutMonth(n: INTEGER); |
| VAR |
| str: ARRAY 4 OF CHAR; |
| BEGIN |
| CASE n OF |
| | 1: str := "jan" |
| | 2: str := "feb" |
| | 3: str := "mar" |
| | 4: str := "apr" |
| | 5: str := "may" |
| | 6: str := "jun" |
| | 7: str := "jul" |
| | 8: str := "aug" |
| | 9: str := "sep" |
| |10: str := "oct" |
| |11: str := "nov" |
| |12: str := "dec" |
| END; |
| Out.String(str) |
| END OutMonth; |
| PROCEDURE main; |
| VAR |
| Year, Month, Day, Hour, Min, Sec, Msec: INTEGER; |
| BEGIN |
| Out.String("Hello, world!"); Out.Ln; |
| Console.SetColor(Console.White, Console.Red); |
| DateTime.Now(Year, Month, Day, Hour, Min, Sec, Msec); |
| Out.Int(Year, 0); Out.Char("-"); |
| OutMonth(Month); Out.Char("-"); |
| OutInt2(Day); Out.Char(" "); |
| OutInt2(Hour); Out.Char(":"); |
| OutInt2(Min); Out.Char(":"); |
| OutInt2(Sec) |
| END main; |
| BEGIN |
| Console.open; |
| main; |
| In.Ln; |
| Console.exit(TRUE) |
| END HW_con. |
| /programs/develop/oberon07/Source/RVM32I.ob07 |
|---|
| File deleted |
| \ No newline at end of file |
| /programs/develop/oberon07/Source/AMD64.ob07 |
|---|
| 8,7 → 8,7 |
| MODULE AMD64; |
| IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, TARGETS, |
| REG, UTILS, S := STRINGS, PE32, ELF, X86, ERRORS; |
| REG, C := CONSOLE, UTILS, S := STRINGS, PE32, ELF, X86; |
| CONST |
| 27,8 → 27,6 |
| rsi = 6; |
| rdi = 7; |
| MAX_XMM = 5; |
| je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H; |
| sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; |
| 40,9 → 38,7 |
| sBSS = BIN.PICBSS; |
| sIMP = BIN.PICIMP; |
| FPR_ERR = 41; |
| TYPE |
| COMMAND = IL.COMMAND; |
| 69,11 → 65,7 |
| Win64RegPar: ARRAY 4 OF INTEGER; |
| SystemVRegPar: ARRAY 6 OF INTEGER; |
| Xmm: ARRAY 1000 OF INTEGER; |
| fname: PATHS.PATH; |
| PROCEDURE OutByte (b: BYTE); |
| BEGIN |
| X86.OutByte(b) |
| 104,19 → 96,24 |
| END OutInt; |
| PROCEDURE isByte (n: INTEGER): BOOLEAN; |
| RETURN (-128 <= n) & (n <= 127) |
| END isByte; |
| PROCEDURE short (n: INTEGER): INTEGER; |
| RETURN 2 * ORD(X86.isByte(n)) |
| RETURN 2 * ORD(isByte(n)) |
| END short; |
| PROCEDURE long (n: INTEGER): INTEGER; |
| RETURN 40H * ORD(~X86.isByte(n)) |
| RETURN 40H * ORD(~isByte(n)) |
| END long; |
| PROCEDURE OutIntByte (n: INTEGER); |
| BEGIN |
| IF X86.isByte(n) THEN |
| IF isByte(n) THEN |
| OutByte(n MOD 256) |
| ELSE |
| OutInt(n) |
| 194,10 → 191,10 |
| END and; |
| PROCEDURE _or (reg1, reg2: INTEGER); (* or reg1, reg2 *) |
| PROCEDURE or (reg1, reg2: INTEGER); (* or reg1, reg2 *) |
| BEGIN |
| oprr(09H, reg1, reg2) |
| END _or; |
| END or; |
| PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *) |
| 214,12 → 211,7 |
| PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *) |
| BEGIN |
| IF rax IN {reg1, reg2} THEN |
| Rex(reg1 + reg2, 0); |
| OutByte(90H + (reg1 + reg2) MOD 8) |
| ELSE |
| oprr(87H, reg1, reg2) |
| END |
| END xchg; |
| 278,9 → 270,17 |
| PROCEDURE callimp (label: INTEGER); |
| VAR |
| reg: INTEGER; |
| BEGIN |
| OutByte2(0FFH, 15H); (* call qword[rip + label + IMP] *) |
| X86.Reloc(sIMP, label) |
| reg := GetAnyReg(); |
| lea(reg, label, sIMP); |
| IF reg >= 8 THEN (* call qword[reg] *) |
| OutByte(41H) |
| END; |
| OutByte2(0FFH, 10H + reg MOD 8); |
| drop |
| END callimp; |
| 383,7 → 383,8 |
| oprlongc(reg, n, oprr) |
| ELSE |
| Rex(reg, 0); |
| X86.oprc(op, reg, n) |
| OutByte2(81H + short(n), op + reg MOD 8); |
| OutIntByte(n) |
| END |
| END oprc; |
| 418,7 → 419,7 |
| PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *) |
| BEGIN |
| oprc(0C8H, reg, n, _or) |
| oprc(0C8H, reg, n, or) |
| END orrc; |
| 439,7 → 440,7 |
| push(reg2); |
| drop |
| ELSE |
| X86.pushc(n) |
| OutByte(68H + short(n)); OutIntByte(n) (* push n *) |
| END |
| END pushc; |
| 552,6 → 553,21 |
| END jcc; |
| PROCEDURE jmp (label: INTEGER); (* jmp label *) |
| BEGIN |
| X86.jmp(label) |
| END jmp; |
| PROCEDURE setcc (cc, reg: INTEGER); (* setcc reg8 *) |
| BEGIN |
| IF reg >= 8 THEN |
| OutByte(41H) |
| END; |
| OutByte3(0FH, cc, 0C0H + reg MOD 8) |
| END setcc; |
| PROCEDURE shiftrc (op, reg, n: INTEGER); |
| BEGIN |
| Rex(reg, 0); |
| 813,7 → 829,7 |
| cc := setnc |
| END; |
| OutByte2(7AH, 3 + reg DIV 8); (* jp L *) |
| X86.setcc(cc, reg) |
| setcc(cc, reg); |
| (* L: *) |
| END fcmp; |
| 843,7 → 859,7 |
| CASE opcode OF |
| |IL.opJMP: |
| X86.jmp(param1) |
| jmp(param1) |
| |IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL: |
| REG.Store(R); |
| 891,24 → 907,24 |
| |IL.opONERR: |
| pushc(param2); |
| X86.jmp(param1) |
| jmp(param1) |
| |IL.opPUSHC: |
| pushc(param2) |
| |IL.opPRECALL: |
| PushAll(0); |
| IF (param2 # 0) & (xmm >= 0) THEN |
| n := param2; |
| IF (param1 # 0) & (n # 0) THEN |
| subrc(rsp, 8) |
| END; |
| INC(Xmm[0]); |
| Xmm[Xmm[0]] := xmm + 1; |
| WHILE xmm >= 0 DO |
| WHILE n > 0 DO |
| subrc(rsp, 8); |
| movsdmr(rsp, 0, xmm); |
| DEC(xmm) |
| DEC(xmm); |
| DEC(n) |
| END; |
| ASSERT(xmm = -1) |
| ASSERT(xmm = -1); |
| PushAll(0) |
| |IL.opWIN64ALIGN16: |
| ASSERT(rax IN R.regs); |
| 926,26 → 942,27 |
| push(rax) |
| END |
| |IL.opRESF, IL.opRES: |
| ASSERT(R.top = -1); |
| |IL.opRESF: |
| ASSERT(xmm = -1); |
| n := Xmm[Xmm[0]]; DEC(Xmm[0]); |
| IF opcode = IL.opRESF THEN |
| INC(xmm); |
| n := param2; |
| IF n > 0 THEN |
| movsdmr(rsp, n * 8, 0); |
| movsdmr(rsp, n * 8, xmm); |
| DEC(xmm); |
| INC(n) |
| END; |
| IF xmm + n > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| WHILE n > 0 DO |
| INC(xmm); |
| movsdrm(xmm, rsp, 0); |
| addrc(rsp, 8); |
| DEC(n) |
| END |
| ELSE |
| GetRegA |
| END; |
| |IL.opRES: |
| ASSERT(R.top = -1); |
| GetRegA; |
| n := param2; |
| WHILE n > 0 DO |
| INC(xmm); |
| movsdrm(xmm, rsp, 0); |
| 1120,29 → 1137,31 |
| IF reg2 # -1 THEN |
| mov(reg1, reg2) |
| ELSE |
| movrm32(reg1, rbp, param2 * 8) |
| END; |
| shiftrc(shl, reg1, 32); |
| shiftrc(shr, reg1, 32) |
| n := param2 * 8; |
| xor(reg1, reg1); |
| movrm32(reg1, rbp, n) |
| END |
| |IL.opGLOAD64: |
| reg1 := GetAnyReg(); |
| Rex(0, reg1); (* mov reg1, qword[rip + param2 + BSS] *) |
| OutByte2(8BH, 05H + 8 * (reg1 MOD 8)); |
| X86.Reloc(sBSS, param2) |
| lea(reg1, param2, sBSS); |
| movrm(reg1, reg1, 0) |
| |IL.opGLOAD8, IL.opGLOAD16: |
| |IL.opGLOAD8: |
| reg1 := GetAnyReg(); |
| Rex(0, reg1); (* movzx reg1, byte/word[rip + param2 + BSS] *) |
| OutByte3(0FH, 0B6H + ORD(opcode = IL.opGLOAD16), 05H + 8 * (reg1 MOD 8)); |
| X86.Reloc(sBSS, param2) |
| lea(reg1, param2, sBSS); |
| movzx(reg1, reg1, 0, FALSE) |
| |IL.opGLOAD16: |
| reg1 := GetAnyReg(); |
| lea(reg1, param2, sBSS); |
| movzx(reg1, reg1, 0, TRUE) |
| |IL.opGLOAD32: |
| reg1 := GetAnyReg(); |
| xor(reg1, reg1); |
| lea(reg1, param2, sBSS); |
| movrm32(reg1, reg1, 0); |
| shiftrc(shl, reg1, 32); |
| shiftrc(shr, reg1, 32) |
| movrm32(reg1, reg1, 0) |
| |IL.opVLOAD64: |
| reg1 := GetAnyReg(); |
| 1158,10 → 1177,9 |
| |IL.opVLOAD32: |
| reg1 := GetAnyReg(); |
| reg2 := GetAnyReg(); |
| xor(reg1, reg1); |
| movrm(reg2, rbp, param2 * 8); |
| movrm32(reg1, reg2, 0); |
| shiftrc(shl, reg1, 32); |
| shiftrc(shr, reg1, 32); |
| drop |
| |IL.opLADR: |
| 1168,22 → 1186,14 |
| n := param2 * 8; |
| next := cmd.next(COMMAND); |
| IF (next.opcode = IL.opSAVEF) OR (next.opcode = IL.opSAVEFI) THEN |
| ASSERT(xmm >= 0); |
| movsdmr(rbp, n, xmm); |
| DEC(xmm); |
| cmd := next |
| ELSIF next.opcode = IL.opLOADF THEN |
| INC(xmm); |
| IF xmm > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, next.param1, next.param2, FPR_ERR) |
| END; |
| movsdrm(xmm, rbp, n); |
| cmd := next |
| ELSE |
| IF (next.opcode = IL.opADDC) & ~isLong(n + next.param2) THEN |
| INC(n, next.param2); |
| cmd := next |
| END; |
| reg1 := GetAnyReg(); |
| Rex(0, reg1); |
| OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); (* lea reg1, qword[rbp+n] *) |
| 1191,11 → 1201,6 |
| END |
| |IL.opGADR: |
| next := cmd.next(COMMAND); |
| IF (next.opcode = IL.opADDC) & ~isLong(param2 + next.param2) THEN |
| INC(param2, next.param2); |
| cmd := next |
| END; |
| lea(GetAnyReg(), param2, sBSS) |
| |IL.opVADR: |
| 1306,15 → 1311,15 |
| cc := X86.cond(opcode); |
| next := cmd.next(COMMAND); |
| IF next.opcode = IL.opJNZ THEN |
| IF next.opcode = IL.opJE THEN |
| jcc(cc, next.param1); |
| cmd := next |
| ELSIF next.opcode = IL.opJZ THEN |
| ELSIF next.opcode = IL.opJNE THEN |
| jcc(X86.inv0(cc), next.param1); |
| cmd := next |
| ELSE |
| reg1 := GetAnyReg(); |
| X86.setcc(cc + 16, reg1); |
| setcc(cc + 16, reg1); |
| andrc(reg1, 1) |
| END |
| 1337,23 → 1342,36 |
| PushAll(n) |
| END |
| |IL.opJNZ1: |
| |IL.opACC: |
| IF (R.top # 0) OR (R.stk[0] # rax) THEN |
| PushAll(0); |
| GetRegA; |
| pop(rax); |
| DEC(R.pushed) |
| END |
| |IL.opJNZ: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jne, param1) |
| |IL.opJZ: |
| UnOp(reg1); |
| test(reg1); |
| jcc(je, param1) |
| |IL.opJG: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jg, param1) |
| |IL.opJNZ: |
| |IL.opJE: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jne, param1); |
| drop |
| |IL.opJZ: |
| |IL.opJNE: |
| UnOp(reg1); |
| test(reg1); |
| jcc(je, param1); |
| 1370,11 → 1388,11 |
| cmprc(reg1, 64); |
| jcc(jb, L); |
| xor(reg1, reg1); |
| X86.jmp(label); |
| jmp(label); |
| X86.SetLabel(L); |
| Rex(reg2, reg1); |
| OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); (* bt reg2, reg1 *) |
| X86.setcc(setc, reg1); |
| setcc(setc, reg1); |
| andrc(reg1, 1); |
| X86.SetLabel(label); |
| drop |
| 1384,19 → 1402,19 |
| Rex(reg1, 0); |
| OutByte2(0FH, 0BAH); (* bt reg1, param2 *) |
| OutByte2(0E0H + reg1 MOD 8, param2); |
| X86.setcc(setc, reg1); |
| setcc(setc, reg1); |
| andrc(reg1, 1) |
| |IL.opNOT: |
| UnOp(reg1); |
| test(reg1); |
| X86.setcc(sete, reg1); |
| setcc(sete, reg1); |
| andrc(reg1, 1) |
| |IL.opORD: |
| UnOp(reg1); |
| test(reg1); |
| X86.setcc(setne, reg1); |
| setcc(setne, reg1); |
| andrc(reg1, 1) |
| |IL.opABS: |
| 1421,9 → 1439,9 |
| X86.SetLabel(label); |
| cmprr(reg1, reg2); |
| IF opcode = IL.opEQB THEN |
| X86.setcc(sete, reg1) |
| setcc(sete, reg1) |
| ELSE |
| X86.setcc(setne, reg1) |
| setcc(setne, reg1) |
| END; |
| andrc(reg1, 1) |
| 1435,7 → 1453,7 |
| UnOp(reg1); |
| xorrc(reg1, param2) |
| |IL.opADDSC: |
| |IL.opADDSL, IL.opADDSR: |
| UnOp(reg1); |
| orrc(reg1, param2) |
| 1670,18 → 1688,19 |
| |IL.opSUBR, IL.opSUBL: |
| UnOp(reg1); |
| IF param2 = 1 THEN |
| n := param2; |
| IF n = 1 THEN |
| decr(reg1) |
| ELSIF param2 = -1 THEN |
| ELSIF n = -1 THEN |
| incr(reg1) |
| ELSIF param2 # 0 THEN |
| subrc(reg1, param2) |
| ELSIF n # 0 THEN |
| subrc(reg1, n) |
| END; |
| IF opcode = IL.opSUBL THEN |
| neg(reg1) |
| END |
| |IL.opADDC: |
| |IL.opADDL, IL.opADDR: |
| IF (param2 # 0) & ~isLong(param2) THEN |
| UnOp(reg1); |
| next := cmd.next(COMMAND); |
| 1832,7 → 1851,7 |
| |IL.opADDS: |
| BinOp(reg1, reg2); |
| _or(reg1, reg2); |
| or(reg1, reg2); |
| drop |
| |IL.opSUBS: |
| 1841,7 → 1860,7 |
| and(reg1, reg2); |
| drop |
| |IL.opNOP, IL.opAND, IL.opOR: |
| |IL.opNOP: |
| |IL.opSWITCH: |
| UnOp(reg1); |
| 1989,8 → 2008,8 |
| reg1 := GetAnyReg(); |
| CASE opcode OF |
| |IL.opEQP, IL.opEQIP: X86.setcc(sete, reg1) |
| |IL.opNEP, IL.opNEIP: X86.setcc(setne, reg1) |
| |IL.opEQP, IL.opEQIP: setcc(sete, reg1) |
| |IL.opNEP, IL.opNEIP: setcc(setne, reg1) |
| END; |
| andrc(reg1, 1) |
| 2026,8 → 2045,9 |
| drop |
| |IL.opCLEANUP: |
| IF param2 # 0 THEN |
| addrc(rsp, param2 * 8) |
| n := param2 * 8; |
| IF n # 0 THEN |
| addrc(rsp, n) |
| END |
| |IL.opPOPSP: |
| 2036,14 → 2056,10 |
| |IL.opLOADF: |
| UnOp(reg1); |
| INC(xmm); |
| IF xmm > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| movsdrm(xmm, reg1, 0); |
| drop |
| |IL.opPUSHF: |
| ASSERT(xmm >= 0); |
| subrc(rsp, 8); |
| movsdmr(rsp, 0, xmm); |
| DEC(xmm) |
| 2051,78 → 2067,66 |
| |IL.opCONSTF: |
| float := cmd.float; |
| INC(xmm); |
| IF xmm > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| (* movsd xmm, qword ptr [rip + Numbers_Offs + Numbers_Count * 8 + DATA] *) |
| OutByte(0F2H); |
| IF xmm >= 8 THEN |
| OutByte(44H) |
| END; |
| OutByte3(0FH, 10H, 05H + 8 * (xmm MOD 8)); |
| X86.Reloc(sDATA, Numbers_Offs + Numbers_Count * 8); |
| reg1 := GetAnyReg(); |
| lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA); |
| movsdrm(xmm, reg1, 0); |
| drop; |
| NewNumber(UTILS.splitf(float, a, b)) |
| |IL.opSAVEF, IL.opSAVEFI: |
| ASSERT(xmm >= 0); |
| UnOp(reg1); |
| movsdmr(reg1, 0, xmm); |
| DEC(xmm); |
| drop |
| |IL.opADDF: |
| ASSERT(xmm >= 1); |
| |IL.opADDF, IL.opADDFI: |
| opxx(58H, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opSUBF: |
| ASSERT(xmm >= 1); |
| opxx(5CH, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opSUBFI: |
| ASSERT(xmm >= 1); |
| opxx(5CH, xmm, xmm - 1); |
| opxx(10H, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opMULF: |
| ASSERT(xmm >= 1); |
| opxx(59H, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opDIVF: |
| ASSERT(xmm >= 1); |
| opxx(5EH, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opDIVFI: |
| ASSERT(xmm >= 1); |
| opxx(5EH, xmm, xmm - 1); |
| opxx(10H, xmm - 1, xmm); |
| DEC(xmm) |
| |IL.opFABS, IL.opUMINF: (* andpd/xorpd xmm, xmmword[rip + Numbers_Offs + (16) + DATA] *) |
| ASSERT(xmm >= 0); |
| OutByte(66H); |
| IF xmm >= 8 THEN |
| OutByte(44H) |
| END; |
| OutByte3(0FH, 54H + 3 * ORD(opcode = IL.opUMINF), 05H + (xmm MOD 8) * 8); |
| X86.Reloc(sDATA, Numbers_Offs + 16 * ORD(opcode = IL.opFABS)) |
| |IL.opUMINF: |
| reg1 := GetAnyReg(); |
| lea(reg1, Numbers_Offs, sDATA); |
| OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* xorpd xmm, xmmword[reg1] *) |
| OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8); |
| drop |
| |IL.opFABS: |
| reg1 := GetAnyReg(); |
| lea(reg1, Numbers_Offs + 16, sDATA); |
| OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); (* andpd xmm, xmmword[reg1] *) |
| OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8); |
| drop |
| |IL.opFLT: |
| UnOp(reg1); |
| INC(xmm); |
| IF xmm > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); (* cvtsi2sd xmm, reg1 *) |
| OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); |
| drop |
| |IL.opFLOOR: |
| ASSERT(xmm >= 0); |
| reg1 := GetAnyReg(); |
| subrc(rsp, 8); |
| OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); (* stmxcsr dword[rsp+4]; *) |
| 2137,22 → 2141,15 |
| DEC(xmm) |
| |IL.opEQF .. IL.opGEF: |
| ASSERT(xmm >= 1); |
| fcmp(opcode, xmm); |
| DEC(xmm, 2) |
| |IL.opINF: |
| INC(xmm); |
| IF xmm > MAX_XMM THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| (* movsd xmm, qword ptr [rip + Numbers_Offs + 32 + DATA] *) |
| OutByte(0F2H); |
| IF xmm >= 8 THEN |
| OutByte(44H) |
| END; |
| OutByte3(0FH, 10H, 05H + 8 * (xmm MOD 8)); |
| X86.Reloc(sDATA, Numbers_Offs + 32) |
| reg1 := GetAnyReg(); |
| lea(reg1, Numbers_Offs + 32, sDATA); |
| movsdrm(xmm, reg1, 0); |
| drop |
| |IL.opPACK, IL.opPACKC: |
| IF opcode = IL.opPACK THEN |
| 2178,7 → 2175,7 |
| and(reg2, reg1); |
| pop(reg1); |
| _or(reg2, reg1); |
| or(reg2, reg1); |
| pop(reg1); |
| movmr(reg1, 0, reg2); |
| drop; |
| 2221,7 → 2218,7 |
| push(reg2); |
| lea(reg2, Numbers_Offs + 48, sDATA); (* {52..61} *) |
| movrm(reg2, reg2, 0); |
| _or(reg1, reg2); |
| or(reg1, reg2); |
| pop(reg2); |
| Rex(reg1, 0); |
| 2251,20 → 2248,26 |
| END |
| |IL.opGLOAD64_PARAM: |
| OutByte2(0FFH, 35H); (* push qword[rip + param2 + BSS] *) |
| X86.Reloc(sBSS, param2) |
| reg2 := GetAnyReg(); |
| lea(reg2, param2, sBSS); |
| movrm(reg2, reg2, 0); |
| push(reg2); |
| drop |
| |IL.opCONST_PARAM: |
| pushc(param2) |
| |IL.opGLOAD32_PARAM, IL.opLOAD32_PARAM: |
| IF opcode = IL.opGLOAD32_PARAM THEN |
| |IL.opGLOAD32_PARAM: |
| reg1 := GetAnyReg(); |
| lea(reg1, param2, sBSS) |
| ELSE |
| UnOp(reg1) |
| END; |
| xor(reg1, reg1); |
| lea(reg1, param2, sBSS); |
| movrm32(reg1, reg1, 0); |
| push(reg1); |
| drop |
| |IL.opLOAD32_PARAM: |
| UnOp(reg1); |
| movrm32(reg1, reg1, 0); |
| shiftrc(shl, reg1, 32); |
| shiftrc(shr, reg1, 32); |
| push(reg1); |
| 2272,6 → 2275,7 |
| |IL.opLLOAD32_PARAM: |
| reg1 := GetAnyReg(); |
| xor(reg1, reg1); |
| reg2 := GetVarReg(param2); |
| IF reg2 # -1 THEN |
| mov(reg1, reg2) |
| 2278,8 → 2282,6 |
| ELSE |
| movrm32(reg1, rbp, param2 * 8) |
| END; |
| shiftrc(shl, reg1, 32); |
| shiftrc(shr, reg1, 32); |
| push(reg1); |
| drop |
| 2311,10 → 2313,12 |
| drop; |
| drop |
| ELSE |
| (* mov qword[rip + param1 - 4 + BSS], param2 *) |
| OutByte3(48H, 0C7H, 05H); |
| X86.Reloc(sBSS, param1 - 4); |
| OutInt(param2) |
| reg2 := GetAnyReg(); |
| lea(reg2, param1, sBSS); |
| Rex(reg2, 0); |
| OutByte2(0C7H, reg2 MOD 8); (* mov qword[reg2], param2 *) |
| OutInt(param2); |
| drop |
| END |
| |IL.opLADR_SAVE: |
| 2427,7 → 2431,7 |
| oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) (* bts/btr reg2, reg1 *) |
| ELSE |
| n := param2 * 8; |
| OutByte2(73H, 5 + 3 * ORD(~X86.isByte(n))); (* jnb L *) |
| OutByte2(73H, 5 + 3 * ORD(~isByte(n))); (* jnb L *) |
| Rex(0, reg1); |
| OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); |
| OutIntByte(n) (* bts/btr qword[rbp+n], reg1 *) |
| 2449,9 → 2453,6 |
| OutByte(param2) |
| END |
| |IL.opFNAME: |
| fname := cmd(IL.FNAMECMD).fname |
| |IL.opLOOP, IL.opENDLOOP: |
| END; |
| 2484,9 → 2485,10 |
| push(rcx); |
| CallRTL(IL._dllentry); |
| test(rax); |
| jcc(je, dllret); |
| pushc(0) |
| ELSIF target = TARGETS.Linux64 THEN |
| jcc(je, dllret) |
| END; |
| IF target = TARGETS.Linux64 THEN |
| push(rsp) |
| ELSE |
| pushc(0) |
| 2525,7 → 2527,7 |
| exp: IL.EXPORT_PROC; |
| PROCEDURE _import (imp: LISTS.LIST); |
| PROCEDURE import (imp: LISTS.LIST); |
| VAR |
| lib: IL.IMPORT_LIB; |
| proc: IL.IMPORT_PROC; |
| 2543,7 → 2545,7 |
| lib := lib.next(IL.IMPORT_LIB) |
| END |
| END _import; |
| END import; |
| BEGIN |
| 2596,7 → 2598,7 |
| exp := exp.next(IL.EXPORT_PROC) |
| END; |
| _import(IL.codes._import) |
| import(IL.codes.import) |
| END epilog; |
| 2629,7 → 2631,6 |
| path, modname, ext: PATHS.PATH; |
| BEGIN |
| Xmm[0] := 0; |
| tcount := CHL.Length(IL.codes.types); |
| Win64RegPar[0] := rcx; |
| /programs/develop/oberon07/Source/ARITH.ob07 |
|---|
| 16,12 → 16,11 |
| tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6; |
| tSTRING* = 7; |
| opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5; |
| opIN* = 6; opIS* = 7; |
| TYPE |
| RELATION* = ARRAY 3 OF CHAR; |
| VALUE* = RECORD |
| typ*: INTEGER; |
| 673,7 → 672,7 |
| END equal; |
| PROCEDURE relation* (VAR v: VALUE; v2: VALUE; op: INTEGER; VAR error: INTEGER); |
| PROCEDURE relation* (VAR v: VALUE; v2: VALUE; operator: RELATION; VAR error: INTEGER); |
| VAR |
| res: BOOLEAN; |
| 682,34 → 681,36 |
| res := FALSE; |
| CASE op OF |
| CASE operator[0] OF |
| |opEQ: |
| |"=": |
| res := equal(v, v2, error) |
| |opNE: |
| |"#": |
| res := ~equal(v, v2, error) |
| |opLT: |
| res := less(v, v2, error) |
| |opLE: |
| |"<": |
| IF operator[1] = "=" THEN |
| res := less(v, v2, error); |
| IF error = 0 THEN |
| res := equal(v, v2, error) OR res |
| END |
| ELSE |
| res := less(v, v2, error) |
| END |
| |opGE: |
| |">": |
| IF operator[1] = "=" THEN |
| res := ~less(v, v2, error) |
| |opGT: |
| ELSE |
| res := less(v, v2, error); |
| IF error = 0 THEN |
| res := equal(v, v2, error) OR res |
| END; |
| res := ~res |
| END |
| |opIN: |
| |"I": |
| IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN |
| IF range(v, 0, UTILS.target.maxSet) THEN |
| res := v.int IN v2.set |
| 761,20 → 762,6 |
| END setInt; |
| PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| BEGIN |
| res := LENGTH(s) + LENGTH(s1) < LEN(s); |
| IF res THEN |
| STRINGS.append(s, s1) |
| END |
| RETURN res |
| END concat; |
| PROCEDURE init; |
| VAR |
| i: INTEGER; |
| /programs/develop/oberon07/Source/BIN.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 56,7 → 56,7 |
| vmajor*, |
| vminor*: WCHAR; |
| modname*: INTEGER; |
| _import*: CHL.BYTELIST; |
| import*: CHL.BYTELIST; |
| export*: CHL.BYTELIST; |
| rel_list*: LISTS.LIST; |
| imp_list*: LISTS.LIST; |
| 86,7 → 86,7 |
| program.data := CHL.CreateByteList(); |
| program.code := CHL.CreateByteList(); |
| program._import := CHL.CreateByteList(); |
| program.import := CHL.CreateByteList(); |
| program.export := CHL.CreateByteList() |
| RETURN program |
| 120,7 → 120,7 |
| END PutData; |
| PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER; |
| PROCEDURE get32le* (array: CHL.BYTELIST; idx: INTEGER): INTEGER; |
| VAR |
| i: INTEGER; |
| x: INTEGER; |
| 129,7 → 129,7 |
| x := 0; |
| FOR i := 3 TO 0 BY -1 DO |
| x := LSL(x, 8) + CHL.GetByte(_array, idx + i) |
| x := LSL(x, 8) + CHL.GetByte(array, idx + i) |
| END; |
| IF UTILS.bit_depth = 64 THEN |
| 143,13 → 143,13 |
| END get32le; |
| PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER); |
| PROCEDURE put32le* (array: CHL.BYTELIST; idx: INTEGER; x: INTEGER); |
| VAR |
| i: INTEGER; |
| BEGIN |
| FOR i := 0 TO 3 DO |
| CHL.SetByte(_array, idx + i, UTILS.Byte(x, i)) |
| CHL.SetByte(array, idx + i, UTILS.Byte(x, i)) |
| END |
| END put32le; |
| 224,15 → 224,15 |
| imp: IMPRT; |
| BEGIN |
| CHL.PushByte(program._import, 0); |
| CHL.PushByte(program._import, 0); |
| CHL.PushByte(program.import, 0); |
| CHL.PushByte(program.import, 0); |
| IF ODD(CHL.Length(program._import)) THEN |
| CHL.PushByte(program._import, 0) |
| IF ODD(CHL.Length(program.import)) THEN |
| CHL.PushByte(program.import, 0) |
| END; |
| NEW(imp); |
| imp.nameoffs := CHL.PushStr(program._import, name); |
| imp.nameoffs := CHL.PushStr(program.import, name); |
| imp.label := label; |
| LISTS.push(program.imp_list, imp) |
| END Import; |
| 285,18 → 285,19 |
| PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT; |
| VAR |
| _import, res: IMPRT; |
| import: IMPRT; |
| res: IMPRT; |
| BEGIN |
| _import := program.imp_list.first(IMPRT); |
| import := program.imp_list.first(IMPRT); |
| res := NIL; |
| WHILE (_import # NIL) & (n >= 0) DO |
| IF _import.label # 0 THEN |
| res := _import; |
| WHILE (import # NIL) & (n >= 0) DO |
| IF import.label # 0 THEN |
| res := import; |
| DEC(n) |
| END; |
| _import := _import.next(IMPRT) |
| import := import.next(IMPRT) |
| END; |
| ASSERT(n = -1) |
| 348,7 → 349,7 |
| END fixup; |
| PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR); |
| PROCEDURE InitArray* (VAR array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR); |
| VAR |
| i, k: INTEGER; |
| 374,7 → 375,7 |
| k := k DIV 2; |
| FOR i := 0 TO k - 1 DO |
| _array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) |
| array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) |
| END; |
| INC(idx, k) |
| /programs/develop/oberon07/Source/CHUNKLISTS.ob07 |
|---|
| 153,7 → 153,7 |
| END GetStr; |
| PROCEDURE WriteToFile* (list: BYTELIST); |
| PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST); |
| VAR |
| chunk: BYTECHUNK; |
| 160,7 → 160,7 |
| BEGIN |
| chunk := list.first(BYTECHUNK); |
| WHILE chunk # NIL DO |
| WR.Write(chunk.data, chunk.count); |
| WR.Write(file, chunk.data, chunk.count); |
| chunk := chunk.next(BYTECHUNK) |
| END |
| END WriteToFile; |
| /programs/develop/oberon07/Source/Compiler.ob07 |
|---|
| 8,7 → 8,7 |
| MODULE Compiler; |
| IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, |
| ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN; |
| ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS; |
| PROCEDURE keys (VAR options: PROG.OPTIONS; VAR out: PARS.PATH); |
| 15,7 → 15,7 |
| VAR |
| param: PARS.PATH; |
| i, j: INTEGER; |
| _end: BOOLEAN; |
| end: BOOLEAN; |
| value: INTEGER; |
| minor, |
| major: INTEGER; |
| 24,7 → 24,7 |
| BEGIN |
| out := ""; |
| checking := options.checking; |
| _end := FALSE; |
| end := FALSE; |
| i := 3; |
| REPEAT |
| UTILS.GetArg(i, param); |
| 113,19 → 113,11 |
| DEC(i) |
| END |
| ELSIF param = "-lower" THEN |
| options.lower := TRUE |
| ELSIF param = "-pic" THEN |
| options.pic := TRUE |
| ELSIF param = "-def" THEN |
| INC(i); |
| UTILS.GetArg(i, param); |
| SCAN.NewDef(param) |
| ELSIF param = "" THEN |
| _end := TRUE |
| end := TRUE |
| ELSE |
| ERRORS.BadParam(param) |
| 132,7 → 124,7 |
| END; |
| INC(i) |
| UNTIL _end; |
| UNTIL end; |
| options.checking := checking |
| END keys; |
| 173,7 → 165,6 |
| options.stack := 2; |
| options.version := 65536; |
| options.pic := FALSE; |
| options.lower := FALSE; |
| options.checking := ST.chkALL; |
| PATHS.GetCurrentDirectory(app_path); |
| 212,8 → 203,6 |
| C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln; |
| C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,"); |
| C.StringLn(" BYTE, CHR, WCHR)"); C.Ln; |
| C.StringLn(" -lower allow lower case for keywords"); C.Ln; |
| C.StringLn(" -def <identifier> define conditional compilation symbol"); C.Ln; |
| C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln; |
| C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; |
| C.StringLn(" -rom <size> set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; |
| 237,8 → 226,6 |
| ERRORS.Error(205) |
| END; |
| SCAN.NewDef(param); |
| IF TARGETS.Select(param) THEN |
| target := TARGETS.target |
| ELSE |
| /programs/develop/oberon07/Source/ELF.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2019-2020, Anton Krotov |
| Copyright (c) 2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE ELF; |
| IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PE32, UTILS; |
| IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS; |
| CONST |
| 85,6 → 85,9 |
| END; |
| FILE = WR.FILE; |
| VAR |
| dynamic: LISTS.LIST; |
| 94,38 → 97,75 |
| hashtab, bucket, chain: CHL.INTLIST; |
| PROCEDURE Write16 (w: WCHAR); |
| PROCEDURE align (n, _align: INTEGER): INTEGER; |
| BEGIN |
| WR.Write16LE(ORD(w)) |
| IF n MOD _align # 0 THEN |
| n := n + _align - (n MOD _align) |
| END |
| RETURN n |
| END align; |
| PROCEDURE Write16 (file: FILE; w: WCHAR); |
| BEGIN |
| WR.Write16LE(file, ORD(w)) |
| END Write16; |
| PROCEDURE WritePH (ph: Elf32_Phdr); |
| PROCEDURE WritePH (file: FILE; ph: Elf32_Phdr); |
| BEGIN |
| WR.Write32LE(ph.p_type); |
| WR.Write32LE(ph.p_offset); |
| WR.Write32LE(ph.p_vaddr); |
| WR.Write32LE(ph.p_paddr); |
| WR.Write32LE(ph.p_filesz); |
| WR.Write32LE(ph.p_memsz); |
| WR.Write32LE(ph.p_flags); |
| WR.Write32LE(ph.p_align) |
| WR.Write32LE(file, ph.p_type); |
| WR.Write32LE(file, ph.p_offset); |
| WR.Write32LE(file, ph.p_vaddr); |
| WR.Write32LE(file, ph.p_paddr); |
| WR.Write32LE(file, ph.p_filesz); |
| WR.Write32LE(file, ph.p_memsz); |
| WR.Write32LE(file, ph.p_flags); |
| WR.Write32LE(file, ph.p_align) |
| END WritePH; |
| PROCEDURE WritePH64 (ph: Elf32_Phdr); |
| PROCEDURE WritePH64 (file: FILE; ph: Elf32_Phdr); |
| BEGIN |
| WR.Write32LE(ph.p_type); |
| WR.Write32LE(ph.p_flags); |
| WR.Write64LE(ph.p_offset); |
| WR.Write64LE(ph.p_vaddr); |
| WR.Write64LE(ph.p_paddr); |
| WR.Write64LE(ph.p_filesz); |
| WR.Write64LE(ph.p_memsz); |
| WR.Write64LE(ph.p_align) |
| WR.Write32LE(file, ph.p_type); |
| WR.Write32LE(file, ph.p_flags); |
| WR.Write64LE(file, ph.p_offset); |
| WR.Write64LE(file, ph.p_vaddr); |
| WR.Write64LE(file, ph.p_paddr); |
| WR.Write64LE(file, ph.p_filesz); |
| WR.Write64LE(file, ph.p_memsz); |
| WR.Write64LE(file, ph.p_align) |
| END WritePH64; |
| PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN); |
| VAR |
| reloc: BIN.RELOC; |
| code: CHL.BYTELIST; |
| L, delta, delta0: INTEGER; |
| BEGIN |
| code := program.code; |
| delta0 := 3 - 7 * ORD(amd64); |
| reloc := program.rel_list.first(BIN.RELOC); |
| WHILE reloc # NIL DO |
| L := BIN.get32le(code, reloc.offset); |
| delta := delta0 - reloc.offset - text; |
| CASE reloc.opcode OF |
| |BIN.PICDATA: BIN.put32le(code, reloc.offset, L + data + delta) |
| |BIN.PICCODE: BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
| |BIN.PICBSS: BIN.put32le(code, reloc.offset, L + bss + delta) |
| END; |
| reloc := reloc.next(BIN.RELOC) |
| END |
| END fixup; |
| PROCEDURE NewDyn (tag, val: INTEGER); |
| VAR |
| dyn: Elf32_Dyn; |
| 231,12 → 271,14 |
| ehdr: Elf32_Ehdr; |
| phdr: ARRAY 16 OF Elf32_Phdr; |
| i, BaseAdr, DynAdr, offset, pad, VA, symCount: INTEGER; |
| i, BaseAdr, offset, pad, VA, symCount: INTEGER; |
| SizeOf: RECORD header, code, data, bss: INTEGER END; |
| Offset: RECORD symtab, reltab, hash, strtab: INTEGER END; |
| Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END; |
| File: FILE; |
| Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER; |
| item: LISTS.ITEM; |
| 243,8 → 285,6 |
| Name: ARRAY 2048 OF CHAR; |
| Address: PE32.VIRTUAL_ADDR; |
| BEGIN |
| dynamic := LISTS.create(NIL); |
| symtab := LISTS.create(NIL); |
| 391,12 → 431,12 |
| Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2; |
| Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4; |
| DynAdr := phdr[dyn].p_offset + BaseAdr; |
| Offset.dyn := phdr[dyn].p_offset; |
| item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + DynAdr; |
| item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + DynAdr; |
| item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + DynAdr; |
| item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + DynAdr; |
| item := LISTS.getidx(dynamic, 1); item(Elf32_Dyn).d_val := Offset.strtab + Offset.dyn + BaseAdr; |
| item := LISTS.getidx(dynamic, 3); item(Elf32_Dyn).d_val := Offset.symtab + Offset.dyn + BaseAdr; |
| item := LISTS.getidx(dynamic, 5); item(Elf32_Dyn).d_val := Offset.reltab + Offset.dyn + BaseAdr; |
| item := LISTS.getidx(dynamic, 8); item(Elf32_Dyn).d_val := Offset.hash + Offset.dyn + BaseAdr; |
| phdr[dyn].p_filesz := Offset.strtab + CHL.Length(strtab) + 8 + 8 * ORD(amd64); |
| phdr[dyn].p_memsz := phdr[dyn].p_filesz; |
| 410,12 → 450,12 |
| phdr[header].p_offset := offset; |
| phdr[header].p_vaddr := BaseAdr; |
| phdr[header].p_paddr := BaseAdr; |
| phdr[header].p_filesz := SizeOf.header + lenInterpreter + phdr[dyn].p_filesz; |
| phdr[header].p_filesz := 244 + 156 * ORD(amd64) + lenInterpreter + phdr[dyn].p_filesz; |
| phdr[header].p_memsz := phdr[header].p_filesz; |
| phdr[header].p_flags := PF_R + PF_W; |
| phdr[header].p_align := 1000H; |
| INC(offset, phdr[header].p_filesz); |
| offset := offset + phdr[header].p_filesz; |
| VA := BaseAdr + offset + 1000H; |
| phdr[text].p_type := 1; |
| 429,7 → 469,7 |
| ehdr.e_entry := phdr[text].p_vaddr; |
| INC(offset, phdr[text].p_filesz); |
| offset := offset + phdr[text].p_filesz; |
| VA := BaseAdr + offset + 2000H; |
| pad := (16 - VA MOD 16) MOD 16; |
| 442,7 → 482,7 |
| phdr[data].p_flags := PF_R + PF_W; |
| phdr[data].p_align := 1000H; |
| INC(offset, phdr[data].p_filesz); |
| offset := offset + phdr[data].p_filesz; |
| VA := BaseAdr + offset + 3000H; |
| phdr[bss].p_type := 1; |
| 454,13 → 494,8 |
| phdr[bss].p_flags := PF_R + PF_W; |
| phdr[bss].p_align := 1000H; |
| Address.Code := ehdr.e_entry; |
| Address.Data := phdr[data].p_vaddr + pad; |
| Address.Bss := WR.align(phdr[bss].p_vaddr, 16); |
| Address.Import := 0; |
| fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); |
| PE32.fixup(program, Address, amd64); |
| item := symtab.first; |
| WHILE item # NIL DO |
| IF item(Elf32_Sym).value # 0 THEN |
| 474,137 → 509,146 |
| item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry |
| END; |
| WR.Create(FileName); |
| File := WR.Create(FileName); |
| FOR i := 0 TO EI_NIDENT - 1 DO |
| WR.WriteByte(ehdr.e_ident[i]) |
| WR.WriteByte(File, ehdr.e_ident[i]) |
| END; |
| Write16(ehdr.e_type); |
| Write16(ehdr.e_machine); |
| Write16(File, ehdr.e_type); |
| Write16(File, ehdr.e_machine); |
| WR.Write32LE(ehdr.e_version); |
| WR.Write32LE(File, ehdr.e_version); |
| IF amd64 THEN |
| WR.Write64LE(ehdr.e_entry); |
| WR.Write64LE(ehdr.e_phoff); |
| WR.Write64LE(ehdr.e_shoff) |
| WR.Write64LE(File, ehdr.e_entry); |
| WR.Write64LE(File, ehdr.e_phoff); |
| WR.Write64LE(File, ehdr.e_shoff) |
| ELSE |
| WR.Write32LE(ehdr.e_entry); |
| WR.Write32LE(ehdr.e_phoff); |
| WR.Write32LE(ehdr.e_shoff) |
| WR.Write32LE(File, ehdr.e_entry); |
| WR.Write32LE(File, ehdr.e_phoff); |
| WR.Write32LE(File, ehdr.e_shoff) |
| END; |
| WR.Write32LE(ehdr.e_flags); |
| WR.Write32LE(File, ehdr.e_flags); |
| Write16(ehdr.e_ehsize); |
| Write16(ehdr.e_phentsize); |
| Write16(ehdr.e_phnum); |
| Write16(ehdr.e_shentsize); |
| Write16(ehdr.e_shnum); |
| Write16(ehdr.e_shstrndx); |
| Write16(File, ehdr.e_ehsize); |
| Write16(File, ehdr.e_phentsize); |
| Write16(File, ehdr.e_phnum); |
| Write16(File, ehdr.e_shentsize); |
| Write16(File, ehdr.e_shnum); |
| Write16(File, ehdr.e_shstrndx); |
| IF amd64 THEN |
| WritePH64(phdr[interp]); |
| WritePH64(phdr[dyn]); |
| WritePH64(phdr[header]); |
| WritePH64(phdr[text]); |
| WritePH64(phdr[data]); |
| WritePH64(phdr[bss]) |
| WritePH64(File, phdr[interp]); |
| WritePH64(File, phdr[dyn]); |
| WritePH64(File, phdr[header]); |
| WritePH64(File, phdr[text]); |
| WritePH64(File, phdr[data]); |
| WritePH64(File, phdr[bss]) |
| ELSE |
| WritePH(phdr[interp]); |
| WritePH(phdr[dyn]); |
| WritePH(phdr[header]); |
| WritePH(phdr[text]); |
| WritePH(phdr[data]); |
| WritePH(phdr[bss]) |
| WritePH(File, phdr[interp]); |
| WritePH(File, phdr[dyn]); |
| WritePH(File, phdr[header]); |
| WritePH(File, phdr[text]); |
| WritePH(File, phdr[data]); |
| WritePH(File, phdr[bss]) |
| END; |
| FOR i := 0 TO lenInterpreter - 1 DO |
| WR.WriteByte(ORD(Interpreter[i])) |
| WR.WriteByte(File, ORD(Interpreter[i])) |
| END; |
| i := 0; |
| IF amd64 THEN |
| item := dynamic.first; |
| WHILE item # NIL DO |
| WR.Write64LE(item(Elf32_Dyn).d_tag); |
| WR.Write64LE(item(Elf32_Dyn).d_val); |
| WR.Write64LE(File, item(Elf32_Dyn).d_tag); |
| WR.Write64LE(File, item(Elf32_Dyn).d_val); |
| item := item.next |
| END; |
| item := symtab.first; |
| WHILE item # NIL DO |
| WR.Write32LE(item(Elf32_Sym).name); |
| WR.WriteByte(ORD(item(Elf32_Sym).info)); |
| WR.WriteByte(ORD(item(Elf32_Sym).other)); |
| Write16(item(Elf32_Sym).shndx); |
| WR.Write64LE(item(Elf32_Sym).value); |
| WR.Write64LE(item(Elf32_Sym).size); |
| WR.Write32LE(File, item(Elf32_Sym).name); |
| WR.WriteByte(File, ORD(item(Elf32_Sym).info)); |
| WR.WriteByte(File, ORD(item(Elf32_Sym).other)); |
| Write16(File, item(Elf32_Sym).shndx); |
| WR.Write64LE(File, item(Elf32_Sym).value); |
| WR.Write64LE(File, item(Elf32_Sym).size); |
| item := item.next |
| END; |
| WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 16); |
| WR.Write32LE(1); |
| WR.Write32LE(1); |
| WR.Write64LE(0); |
| WR.Write64LE(phdr[dyn].p_filesz + DynAdr - 8); |
| WR.Write32LE(1); |
| WR.Write32LE(2); |
| WR.Write64LE(0) |
| WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 16); |
| WR.Write32LE(File, 1); |
| WR.Write32LE(File, 1); |
| WR.Write64LE(File, 0); |
| WR.Write64LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8); |
| WR.Write32LE(File, 1); |
| WR.Write32LE(File, 2); |
| WR.Write64LE(File, 0); |
| WR.Write32LE(File, symCount); |
| WR.Write32LE(File, symCount); |
| FOR i := 0 TO symCount - 1 DO |
| WR.Write32LE(File, CHL.GetInt(bucket, i)) |
| END; |
| FOR i := 0 TO symCount - 1 DO |
| WR.Write32LE(File, CHL.GetInt(chain, i)) |
| END; |
| CHL.WriteToFile(File, strtab); |
| WR.Write64LE(File, 0); |
| WR.Write64LE(File, 0) |
| ELSE |
| item := dynamic.first; |
| WHILE item # NIL DO |
| WR.Write32LE(item(Elf32_Dyn).d_tag); |
| WR.Write32LE(item(Elf32_Dyn).d_val); |
| WR.Write32LE(File, item(Elf32_Dyn).d_tag); |
| WR.Write32LE(File, item(Elf32_Dyn).d_val); |
| item := item.next |
| END; |
| item := symtab.first; |
| WHILE item # NIL DO |
| WR.Write32LE(item(Elf32_Sym).name); |
| WR.Write32LE(item(Elf32_Sym).value); |
| WR.Write32LE(item(Elf32_Sym).size); |
| WR.WriteByte(ORD(item(Elf32_Sym).info)); |
| WR.WriteByte(ORD(item(Elf32_Sym).other)); |
| Write16(item(Elf32_Sym).shndx); |
| WR.Write32LE(File, item(Elf32_Sym).name); |
| WR.Write32LE(File, item(Elf32_Sym).value); |
| WR.Write32LE(File, item(Elf32_Sym).size); |
| WR.WriteByte(File, ORD(item(Elf32_Sym).info)); |
| WR.WriteByte(File, ORD(item(Elf32_Sym).other)); |
| Write16(File, item(Elf32_Sym).shndx); |
| item := item.next |
| END; |
| WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 8); |
| WR.Write32LE(00000101H); |
| WR.Write32LE(phdr[dyn].p_filesz + DynAdr - 4); |
| WR.Write32LE(00000201H) |
| WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 8); |
| WR.Write32LE(File, 00000101H); |
| WR.Write32LE(File, phdr[dyn].p_filesz + Offset.dyn + BaseAdr - 4); |
| WR.Write32LE(File, 00000201H); |
| END; |
| WR.Write32LE(File, symCount); |
| WR.Write32LE(File, symCount); |
| WR.Write32LE(symCount); |
| WR.Write32LE(symCount); |
| FOR i := 0 TO symCount - 1 DO |
| WR.Write32LE(CHL.GetInt(bucket, i)) |
| WR.Write32LE(File, CHL.GetInt(bucket, i)) |
| END; |
| FOR i := 0 TO symCount - 1 DO |
| WR.Write32LE(CHL.GetInt(chain, i)) |
| WR.Write32LE(File, CHL.GetInt(chain, i)) |
| END; |
| CHL.WriteToFile(strtab); |
| CHL.WriteToFile(File, strtab); |
| WR.Write32LE(File, 0); |
| WR.Write32LE(File, 0) |
| IF amd64 THEN |
| WR.Write64LE(0); |
| WR.Write64LE(0) |
| ELSE |
| WR.Write32LE(0); |
| WR.Write32LE(0) |
| END; |
| CHL.WriteToFile(program.code); |
| CHL.WriteToFile(File, program.code); |
| WHILE pad > 0 DO |
| WR.WriteByte(0); |
| WR.WriteByte(File, 0); |
| DEC(pad) |
| END; |
| CHL.WriteToFile(program.data); |
| WR.Close; |
| UTILS.chmod(FileName) |
| CHL.WriteToFile(File, program.data); |
| WR.Close(File) |
| END write; |
| /programs/develop/oberon07/Source/ERRORS.ob07 |
|---|
| 144,9 → 144,7 |
| |114: str := "identifiers 'lib_init' and 'version' are reserved" |
| |115: str := "recursive constant definition" |
| |116: str := "procedure too deep nested" |
| |117: str := "string expected" |
| |118: str := "'$END', '$ELSE' or '$ELSIF' without '$IF'" |
| |119: str := "'$IF', '$ELSIF', '$ELSE' or '$END' expected" |
| |120: str := "too many formal parameters" |
| |121: str := "multiply defined handler" |
| |122: str := "bad divisor" |
| 212,7 → 210,6 |
| |205: Error1("not enough parameters") |
| |206: Error1("bad parameter <target>") |
| |207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"') |
| |208: Error1("not enough RAM") |
| END |
| END Error; |
| /programs/develop/oberon07/Source/FILES.ob07 |
|---|
| 17,8 → 17,10 |
| ptr: INTEGER; |
| buffer: ARRAY 64*1024 OF BYTE; |
| count: INTEGER |
| count: INTEGER; |
| chksum*: INTEGER |
| END; |
| VAR |
| 83,7 → 85,8 |
| IF ptr > 0 THEN |
| file := NewFile(); |
| file.ptr := ptr; |
| file.count := 0 |
| file.count := 0; |
| file.chksum := 0 |
| ELSE |
| file := NIL |
| END |
| /programs/develop/oberon07/Source/HEX.ob07 |
|---|
| 7,48 → 7,46 |
| MODULE HEX; |
| IMPORT WRITER, CHL := CHUNKLISTS, UTILS; |
| IMPORT FILES, WRITER, CHL := CHUNKLISTS; |
| VAR |
| PROCEDURE hexdgt (n: BYTE): BYTE; |
| BEGIN |
| IF n < 10 THEN |
| n := n + ORD("0") |
| ELSE |
| n := n - 10 + ORD("A") |
| END |
| chksum: INTEGER; |
| RETURN n |
| END hexdgt; |
| PROCEDURE Byte (byte: BYTE); |
| PROCEDURE Byte (file: FILES.FILE; byte: BYTE); |
| BEGIN |
| WRITER.WriteByte(UTILS.hexdgt(byte DIV 16)); |
| WRITER.WriteByte(UTILS.hexdgt(byte MOD 16)); |
| INC(chksum, byte) |
| WRITER.WriteByte(file, hexdgt(byte DIV 16)); |
| WRITER.WriteByte(file, hexdgt(byte MOD 16)); |
| INC(file.chksum, byte); |
| END Byte; |
| PROCEDURE Byte4 (a, b, c, d: BYTE); |
| PROCEDURE NewLine (file: FILES.FILE); |
| BEGIN |
| Byte(a); |
| Byte(b); |
| Byte(c); |
| Byte(d) |
| END Byte4; |
| PROCEDURE NewLine; |
| BEGIN |
| Byte((-chksum) MOD 256); |
| chksum := 0; |
| WRITER.WriteByte(0DH); |
| WRITER.WriteByte(0AH) |
| Byte(file, (-file.chksum) MOD 256); |
| file.chksum := 0; |
| WRITER.WriteByte(file, 0DH); |
| WRITER.WriteByte(file, 0AH) |
| END NewLine; |
| PROCEDURE StartCode; |
| PROCEDURE StartCode (file: FILES.FILE); |
| BEGIN |
| WRITER.WriteByte(ORD(":")); |
| chksum := 0 |
| WRITER.WriteByte(file, ORD(":")); |
| file.chksum := 0 |
| END StartCode; |
| PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER); |
| PROCEDURE Data* (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); |
| VAR |
| i, len: INTEGER; |
| 55,62 → 53,74 |
| BEGIN |
| WHILE cnt > 0 DO |
| len := MIN(cnt, 16); |
| StartCode; |
| Byte4(len, idx DIV 256, idx MOD 256, 0); |
| StartCode(file); |
| Byte(file, len); |
| Byte(file, idx DIV 256); |
| Byte(file, idx MOD 256); |
| Byte(file, 0); |
| FOR i := 1 TO len DO |
| Byte(mem[idx]); |
| Byte(file, mem[idx]); |
| INC(idx) |
| END; |
| DEC(cnt, len); |
| NewLine |
| NewLine(file) |
| END |
| END Data; |
| PROCEDURE ExtLA* (LA: INTEGER); |
| PROCEDURE ExtLA* (file: FILES.FILE; LA: INTEGER); |
| BEGIN |
| ASSERT((0 <= LA) & (LA <= 0FFFFH)); |
| StartCode; |
| Byte4(2, 0, 0, 4); |
| Byte(LA DIV 256); |
| Byte(LA MOD 256); |
| NewLine |
| StartCode(file); |
| Byte(file, 2); |
| Byte(file, 0); |
| Byte(file, 0); |
| Byte(file, 4); |
| Byte(file, LA DIV 256); |
| Byte(file, LA MOD 256); |
| NewLine(file) |
| END ExtLA; |
| PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); |
| PROCEDURE Data2* (file: FILES.FILE; mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); |
| VAR |
| i, len, offset: INTEGER; |
| BEGIN |
| ExtLA(LA); |
| ExtLA(file, LA); |
| offset := 0; |
| WHILE cnt > 0 DO |
| ASSERT(offset <= 65536); |
| IF offset = 65536 THEN |
| INC(LA); |
| ExtLA(LA); |
| ExtLA(file, LA); |
| offset := 0 |
| END; |
| len := MIN(cnt, 16); |
| StartCode; |
| Byte4(len, offset DIV 256, offset MOD 256, 0); |
| StartCode(file); |
| Byte(file, len); |
| Byte(file, offset DIV 256); |
| Byte(file, offset MOD 256); |
| Byte(file, 0); |
| FOR i := 1 TO len DO |
| Byte(CHL.GetByte(mem, idx)); |
| Byte(file, CHL.GetByte(mem, idx)); |
| INC(idx); |
| INC(offset) |
| END; |
| DEC(cnt, len); |
| NewLine |
| NewLine(file) |
| END |
| END Data2; |
| PROCEDURE End*; |
| PROCEDURE End* (file: FILES.FILE); |
| BEGIN |
| StartCode; |
| Byte4(0, 0, 0, 1); |
| NewLine |
| StartCode(file); |
| Byte(file, 0); |
| Byte(file, 0); |
| Byte(file, 0); |
| Byte(file, 1); |
| NewLine(file) |
| END End; |
| /programs/develop/oberon07/Source/IL.ob07 |
|---|
| 7,11 → 7,14 |
| MODULE IL; |
| IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS; |
| IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS; |
| CONST |
| little_endian* = 0; |
| big_endian* = 1; |
| call_stack* = 0; |
| call_win64* = 1; |
| call_sysv* = 2; |
| 19,7 → 22,7 |
| opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; |
| opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; |
| opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; |
| opADD* = 17; opSUB* = 18; opONERR* = 19; opSUBL* = 20; opADDC* = 21; opSUBR* = 22; |
| opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; |
| opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; |
| opNOT* = 29; |
| 31,14 → 34,14 |
| opVLOAD32* = 60; opGLOAD32* = 61; |
| opJZ* = 62; opJNZ* = 63; |
| opJNE* = 62; opJE* = 63; |
| opSAVE32* = 64; opLLOAD8* = 65; |
| opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; |
| opUMINF* = 72; opSAVEFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; |
| opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; |
| opJNZ1* = 77; opJG* = 78; |
| opACC* = 77; opJG* = 78; |
| opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; |
| opCASEL* = 83; opCASER* = 84; opCASELR* = 85; |
| 52,7 → 55,7 |
| opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; |
| opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; |
| opADDS* = 107; opSUBS* = 108; opERR* = 109; opSUBSL* = 110; opADDSC* = 111; opSUBSR* = 112; |
| opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112; |
| opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116; |
| opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121; |
| 62,26 → 65,27 |
| opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; |
| opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; |
| opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; |
| opGETC* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; |
| opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; |
| opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; |
| opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; |
| opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; |
| opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opLENGTHW* = 179; |
| opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179; |
| opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; |
| opLSR* = 185; opLSR1* = 186; opLSR2* = 187; |
| opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192; |
| opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198; |
| opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192; |
| opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198; |
| opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; |
| opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; |
| opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; |
| opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; |
| opSAVE16C* = 213; opWCHR* = 214; opGETC* = 215; opLENGTHW* = 216; |
| opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; |
| opAND* = 220; opOR* = 221; |
| opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; |
| opONERR* = 222; opSAVEFI* = 223; opHANDLER* = 224; |
| opSADR_PARAM* = -1; opLOAD64_PARAM* = -2; opLLOAD64_PARAM* = -3; opGLOAD64_PARAM* = -4; |
| opVADR_PARAM* = -5; opCONST_PARAM* = -6; opGLOAD32_PARAM* = -7; opLLOAD32_PARAM* = -8; |
| opLOAD32_PARAM* = -9; |
| 150,12 → 154,6 |
| END; |
| FNAMECMD* = POINTER TO RECORD (COMMAND) |
| fname*: PATHS.PATH |
| END; |
| CMDSTACK = POINTER TO RECORD |
| data: ARRAY 1000 OF COMMAND; |
| 194,7 → 192,7 |
| endcall: CMDSTACK; |
| commands*: LISTS.LIST; |
| export*: LISTS.LIST; |
| _import*: LISTS.LIST; |
| import*: LISTS.LIST; |
| types*: CHL.INTLIST; |
| data*: CHL.BYTELIST; |
| dmin*: INTEGER; |
| 206,6 → 204,7 |
| charoffs: ARRAY 256 OF INTEGER; |
| wcharoffs: ARRAY 65536 OF INTEGER; |
| fregs: INTEGER; |
| wstr: ARRAY 4*1024 OF WCHAR |
| END; |
| 213,7 → 212,7 |
| VAR |
| codes*: CODES; |
| CPU: INTEGER; |
| endianness, numRegsFloat, CPU: INTEGER; |
| commands, variables: C.COLLECTION; |
| 344,10 → 343,10 |
| i := 0; |
| WHILE i < n DO |
| IF TARGETS.LittleEndian THEN |
| IF endianness = little_endian THEN |
| PutByte(ORD(codes.wstr[i]) MOD 256); |
| PutByte(ORD(codes.wstr[i]) DIV 256) |
| ELSE |
| ELSIF endianness = big_endian THEN |
| PutByte(ORD(codes.wstr[i]) DIV 256); |
| PutByte(ORD(codes.wstr[i]) MOD 256) |
| END; |
| 374,10 → 373,10 |
| INC(res) |
| END; |
| IF TARGETS.LittleEndian THEN |
| IF endianness = little_endian THEN |
| PutByte(c MOD 256); |
| PutByte(c DIV 256) |
| ELSE |
| ELSIF endianness = big_endian THEN |
| PutByte(c DIV 256); |
| PutByte(c MOD 256) |
| END; |
| 411,19 → 410,19 |
| END pop; |
| PROCEDURE pushBegEnd* (VAR beg, _end: COMMAND); |
| PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); |
| BEGIN |
| push(codes.begcall, beg); |
| push(codes.endcall, _end); |
| push(codes.endcall, end); |
| beg := codes.last; |
| _end := beg.next(COMMAND) |
| end := beg.next(COMMAND) |
| END pushBegEnd; |
| PROCEDURE popBegEnd* (VAR beg, _end: COMMAND); |
| PROCEDURE popBegEnd* (VAR beg, end: COMMAND); |
| BEGIN |
| beg := pop(codes.begcall); |
| _end := pop(codes.endcall) |
| end := pop(codes.endcall) |
| END popBegEnd; |
| 495,9 → 494,6 |
| ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN |
| cur.param2 := param2 * cur.param2 |
| ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN |
| cur.param2 := param2 + cur.param2 |
| ELSE |
| old_opcode := -1 |
| END |
| 635,10 → 631,10 |
| prev := codes.last; |
| not := prev.opcode = opNOT; |
| IF not THEN |
| IF opcode = opJNZ THEN |
| opcode := opJZ |
| ELSIF opcode = opJZ THEN |
| opcode := opJNZ |
| IF opcode = opJE THEN |
| opcode := opJNE |
| ELSIF opcode = opJNE THEN |
| opcode := opJE |
| ELSE |
| not := FALSE |
| END |
| 649,79 → 645,10 |
| IF not THEN |
| delete(prev) |
| END |
| END AddJmpCmd; |
| PROCEDURE AndOrOpt* (VAR label: INTEGER); |
| VAR |
| cur, prev: COMMAND; |
| i, op, l: INTEGER; |
| jz, not: BOOLEAN; |
| BEGIN |
| cur := codes.last; |
| not := cur.opcode = opNOT; |
| IF not THEN |
| cur := cur.prev(COMMAND) |
| END; |
| IF cur.opcode = opAND THEN |
| op := opAND |
| ELSIF cur.opcode = opOR THEN |
| op := opOR |
| ELSE |
| op := -1 |
| END; |
| cur := codes.last; |
| IF op # -1 THEN |
| IF not THEN |
| IF op = opAND THEN |
| op := opOR |
| ELSE (* op = opOR *) |
| op := opAND |
| END; |
| prev := cur.prev(COMMAND); |
| delete(cur); |
| cur := prev |
| END; |
| FOR i := 1 TO 9 DO |
| IF i = 8 THEN |
| l := cur.param1 |
| ELSIF i = 9 THEN |
| jz := cur.opcode = opJZ |
| END; |
| prev := cur.prev(COMMAND); |
| delete(cur); |
| cur := prev |
| END; |
| setlast(cur); |
| IF op = opAND THEN |
| label := l; |
| jz := ~jz |
| END; |
| IF jz THEN |
| AddJmpCmd(opJZ, label) |
| ELSE |
| AddJmpCmd(opJNZ, label) |
| END; |
| IF op = opOR THEN |
| SetLabel(l) |
| END |
| ELSE |
| AddJmpCmd(opJZ, label) |
| END; |
| setlast(codes.last) |
| END AndOrOpt; |
| PROCEDURE OnError* (line, error: INTEGER); |
| BEGIN |
| AddCmd2(opONERR, codes.errlabels[error], line) |
| 734,7 → 661,7 |
| BEGIN |
| AddCmd(op, t); |
| label := NewLabel(); |
| AddJmpCmd(opJNZ, label); |
| AddJmpCmd(opJE, label); |
| OnError(line, error); |
| SetLabel(label) |
| END TypeGuard; |
| 758,6 → 685,14 |
| END New; |
| PROCEDURE fcmp* (opcode: INTEGER); |
| BEGIN |
| AddCmd(opcode, 0); |
| DEC(codes.fregs, 2); |
| ASSERT(codes.fregs >= 0) |
| END fcmp; |
| PROCEDURE not*; |
| VAR |
| prev: COMMAND; |
| 772,14 → 707,6 |
| END not; |
| PROCEDURE _ord*; |
| BEGIN |
| IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN |
| AddCmd0(opORD) |
| END |
| END _ord; |
| PROCEDURE Enter* (label, params: INTEGER): COMMAND; |
| VAR |
| cmd: COMMAND; |
| 973,10 → 900,44 |
| AddCmd0(opSAVEFI) |
| ELSE |
| AddCmd0(opSAVEF) |
| END |
| END; |
| DEC(codes.fregs); |
| ASSERT(codes.fregs >= 0) |
| END savef; |
| PROCEDURE pushf*; |
| BEGIN |
| AddCmd0(opPUSHF); |
| DEC(codes.fregs); |
| ASSERT(codes.fregs >= 0) |
| END pushf; |
| PROCEDURE loadf* (): BOOLEAN; |
| BEGIN |
| AddCmd0(opLOADF); |
| INC(codes.fregs) |
| RETURN codes.fregs < numRegsFloat |
| END loadf; |
| PROCEDURE inf* (): BOOLEAN; |
| BEGIN |
| AddCmd0(opINF); |
| INC(codes.fregs) |
| RETURN codes.fregs < numRegsFloat |
| END inf; |
| PROCEDURE fbinop* (opcode: INTEGER); |
| BEGIN |
| AddCmd0(opcode); |
| DEC(codes.fregs); |
| ASSERT(codes.fregs > 0) |
| END fbinop; |
| PROCEDURE saves* (offset, length: INTEGER); |
| BEGIN |
| AddCmd2(opSAVES, length, offset) |
| 993,6 → 954,22 |
| END abs; |
| PROCEDURE floor*; |
| BEGIN |
| AddCmd0(opFLOOR); |
| DEC(codes.fregs); |
| ASSERT(codes.fregs >= 0) |
| END floor; |
| PROCEDURE flt* (): BOOLEAN; |
| BEGIN |
| AddCmd0(opFLT); |
| INC(codes.fregs) |
| RETURN codes.fregs < numRegsFloat |
| END flt; |
| PROCEDURE shift_minmax* (op: CHAR); |
| BEGIN |
| CASE op OF |
| 1038,7 → 1015,7 |
| END len; |
| PROCEDURE Float* (r: REAL; line, col: INTEGER); |
| PROCEDURE Float* (r: REAL); |
| VAR |
| cmd: COMMAND; |
| 1046,12 → 1023,45 |
| cmd := NewCmd(); |
| cmd.opcode := opCONSTF; |
| cmd.float := r; |
| cmd.param1 := line; |
| cmd.param2 := col; |
| insert(codes.last, cmd) |
| insert(codes.last, cmd); |
| INC(codes.fregs); |
| ASSERT(codes.fregs <= numRegsFloat) |
| END Float; |
| PROCEDURE precall* (flt: BOOLEAN): INTEGER; |
| VAR |
| res: INTEGER; |
| BEGIN |
| res := codes.fregs; |
| AddCmd2(opPRECALL, ORD(flt), res); |
| codes.fregs := 0 |
| RETURN res |
| END precall; |
| PROCEDURE resf* (fregs: INTEGER): BOOLEAN; |
| BEGIN |
| AddCmd(opRESF, fregs); |
| codes.fregs := fregs + 1 |
| RETURN codes.fregs < numRegsFloat |
| END resf; |
| PROCEDURE res* (fregs: INTEGER); |
| BEGIN |
| AddCmd(opRES, fregs); |
| codes.fregs := fregs |
| END res; |
| PROCEDURE retf*; |
| BEGIN |
| DEC(codes.fregs); |
| ASSERT(codes.fregs = 0) |
| END retf; |
| PROCEDURE drop*; |
| BEGIN |
| AddCmd0(opDROP) |
| 1058,7 → 1068,7 |
| END drop; |
| PROCEDURE _case* (a, b, L, R: INTEGER); |
| PROCEDURE case* (a, b, L, R: INTEGER); |
| VAR |
| cmd: COMMAND; |
| 1074,19 → 1084,13 |
| AddCmd2(opCASEL, a, L); |
| AddCmd2(opCASER, b, R) |
| END |
| END _case; |
| END case; |
| PROCEDURE fname* (name: PATHS.PATH); |
| VAR |
| cmd: FNAMECMD; |
| PROCEDURE caset* (a, label: INTEGER); |
| BEGIN |
| NEW(cmd); |
| cmd.opcode := opFNAME; |
| cmd.fname := name; |
| insert(codes.last, cmd) |
| END fname; |
| AddCmd2(opCASET, label, a) |
| END caset; |
| PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); |
| 1107,7 → 1111,7 |
| p: IMPORT_PROC; |
| BEGIN |
| lib := codes._import.first(IMPORT_LIB); |
| lib := codes.import.first(IMPORT_LIB); |
| WHILE (lib # NIL) & (lib.name # dll) DO |
| lib := lib.next(IMPORT_LIB) |
| END; |
| 1116,7 → 1120,7 |
| NEW(lib); |
| lib.name := dll; |
| lib.procs := LISTS.create(NIL); |
| LISTS.push(codes._import, lib) |
| LISTS.push(codes.import, lib) |
| END; |
| p := lib.procs.first(IMPORT_PROC); |
| 1149,7 → 1153,7 |
| lib := imp(IMPORT_PROC).lib; |
| LISTS.delete(lib.procs, imp); |
| IF lib.procs.first = NIL THEN |
| LISTS.delete(codes._import, lib) |
| LISTS.delete(codes.import, lib) |
| END |
| END |
| END DelImport; |
| 1165,6 → 1169,13 |
| variables := C.create(); |
| CPU := pCPU; |
| endianness := little_endian; |
| CASE CPU OF |
| |TARGETS.cpuAMD64: numRegsFloat := 6 |
| |TARGETS.cpuX86: numRegsFloat := 8 |
| |TARGETS.cpuMSP430: numRegsFloat := 0 |
| |TARGETS.cpuTHUMB: numRegsFloat := 256 |
| END; |
| NEW(codes.begcall); |
| codes.begcall.top := -1; |
| 1172,7 → 1183,7 |
| codes.endcall.top := -1; |
| codes.commands := LISTS.create(NIL); |
| codes.export := LISTS.create(NIL); |
| codes._import := LISTS.create(NIL); |
| codes.import := LISTS.create(NIL); |
| codes.types := CHL.CreateIntList(); |
| codes.data := CHL.CreateByteList(); |
| 1184,6 → 1195,8 |
| codes.lcount := 0; |
| codes.fregs := 0; |
| FOR i := 0 TO LEN(codes.charoffs) - 1 DO |
| codes.charoffs[i] := -1 |
| END; |
| /programs/develop/oberon07/Source/KOS.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 19,6 → 19,8 |
| TYPE |
| FILE = WR.FILE; |
| HEADER = RECORD |
| menuet01: ARRAY 9 OF CHAR; |
| 27,19 → 29,29 |
| END; |
| PROCEDURE align (n, _align: INTEGER): INTEGER; |
| BEGIN |
| IF n MOD _align # 0 THEN |
| n := n + _align - (n MOD _align) |
| END |
| RETURN n |
| END align; |
| PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER); |
| VAR |
| i: INTEGER; |
| imp: BIN.IMPRT; |
| import: BIN.IMPRT; |
| BEGIN |
| libcount := 0; |
| imp := program.imp_list.first(BIN.IMPRT); |
| WHILE imp # NIL DO |
| IF imp.label = 0 THEN |
| import := program.imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF import.label = 0 THEN |
| INC(libcount) |
| END; |
| imp := imp.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END; |
| len := libcount * 2 + 2; |
| 51,29 → 63,29 |
| END; |
| i := 0; |
| imp := program.imp_list.first(BIN.IMPRT); |
| WHILE imp # NIL DO |
| import := program.imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF imp.label = 0 THEN |
| IF import.label = 0 THEN |
| CHL.SetInt(ImportTable, len, 0); |
| INC(len); |
| CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD); |
| INC(i); |
| CHL.SetInt(ImportTable, i, imp.nameoffs + size + idata); |
| CHL.SetInt(ImportTable, i, import.nameoffs + size + idata); |
| INC(i) |
| ELSE |
| CHL.SetInt(ImportTable, len, imp.nameoffs + size + idata); |
| imp.label := len * SIZE_OF_DWORD; |
| CHL.SetInt(ImportTable, len, import.nameoffs + size + idata); |
| import.label := len * SIZE_OF_DWORD; |
| INC(len) |
| END; |
| imp := imp.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END; |
| CHL.SetInt(ImportTable, len, 0); |
| CHL.SetInt(ImportTable, i, 0); |
| CHL.SetInt(ImportTable, i + 1, 0); |
| INC(len); |
| INC(size, CHL.Length(program._import)) |
| size := size + CHL.Length(program.import) |
| END Import; |
| 88,7 → 100,7 |
| VAR |
| header: HEADER; |
| base, text, data, idata, bss, offset: INTEGER; |
| base, text, data, idata, bss: INTEGER; |
| reloc: BIN.RELOC; |
| iproc: BIN.IMPRT; |
| 97,6 → 109,8 |
| i: INTEGER; |
| File: FILE; |
| ImportTable: CHL.INTLIST; |
| ILen, libcount, isize: INTEGER; |
| 107,23 → 121,23 |
| BEGIN |
| base := 0; |
| icount := CHL.Length(program._import); |
| icount := CHL.Length(program.import); |
| dcount := CHL.Length(program.data); |
| ccount := CHL.Length(program.code); |
| text := base + HEADER_SIZE; |
| data := WR.align(text + ccount, FileAlignment); |
| idata := WR.align(data + dcount, FileAlignment); |
| data := align(text + ccount, FileAlignment); |
| idata := align(data + dcount, FileAlignment); |
| Import(program, idata, ImportTable, ILen, libcount, isize); |
| bss := WR.align(idata + isize, FileAlignment); |
| bss := align(idata + isize, FileAlignment); |
| header.menuet01 := "MENUET01"; |
| header.ver := 1; |
| header.start := text; |
| header.size := idata + isize - base; |
| header.mem := WR.align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment); |
| header.mem := align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment); |
| header.sp := base + header.mem - PARAM_SIZE * 2; |
| header.param := header.sp; |
| header.path := header.param + PARAM_SIZE; |
| 132,74 → 146,73 |
| reloc := program.rel_list.first(BIN.RELOC); |
| WHILE reloc # NIL DO |
| offset := reloc.offset; |
| L := BIN.get32le(code, offset); |
| delta := 3 - offset - text; |
| L := BIN.get32le(code, reloc.offset); |
| delta := 3 - reloc.offset - text; |
| CASE reloc.opcode OF |
| |BIN.RIMP: |
| iproc := BIN.GetIProc(program, L); |
| delta := idata + iproc.label |
| BIN.put32le(code, reloc.offset, idata + iproc.label) |
| |BIN.RBSS: |
| delta := L + bss |
| BIN.put32le(code, reloc.offset, L + bss) |
| |BIN.RDATA: |
| delta := L + data |
| BIN.put32le(code, reloc.offset, L + data) |
| |BIN.RCODE: |
| delta := BIN.GetLabel(program, L) + text |
| BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text) |
| |BIN.PICDATA: |
| INC(delta, L + data) |
| BIN.put32le(code, reloc.offset, L + data + delta) |
| |BIN.PICCODE: |
| INC(delta, BIN.GetLabel(program, L) + text) |
| BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + text + delta) |
| |BIN.PICBSS: |
| INC(delta, L + bss) |
| BIN.put32le(code, reloc.offset, L + bss + delta) |
| |BIN.PICIMP: |
| iproc := BIN.GetIProc(program, L); |
| INC(delta, idata + iproc.label) |
| BIN.put32le(code, reloc.offset, idata + iproc.label + delta) |
| |BIN.IMPTAB: |
| INC(delta, idata) |
| BIN.put32le(code, reloc.offset, idata + delta) |
| END; |
| BIN.put32le(code, offset, delta); |
| reloc := reloc.next(BIN.RELOC) |
| END; |
| WR.Create(FileName); |
| File := WR.Create(FileName); |
| FOR i := 0 TO 7 DO |
| WR.WriteByte(ORD(header.menuet01[i])) |
| WR.WriteByte(File, ORD(header.menuet01[i])) |
| END; |
| WR.Write32LE(header.ver); |
| WR.Write32LE(header.start); |
| WR.Write32LE(header.size); |
| WR.Write32LE(header.mem); |
| WR.Write32LE(header.sp); |
| WR.Write32LE(header.param); |
| WR.Write32LE(header.path); |
| WR.Write32LE(File, header.ver); |
| WR.Write32LE(File, header.start); |
| WR.Write32LE(File, header.size); |
| WR.Write32LE(File, header.mem); |
| WR.Write32LE(File, header.sp); |
| WR.Write32LE(File, header.param); |
| WR.Write32LE(File, header.path); |
| CHL.WriteToFile(code); |
| WR.Padding(FileAlignment); |
| CHL.WriteToFile(File, code); |
| WR.Padding(File, FileAlignment); |
| CHL.WriteToFile(program.data); |
| WR.Padding(FileAlignment); |
| CHL.WriteToFile(File, program.data); |
| WR.Padding(File, FileAlignment); |
| FOR i := 0 TO ILen - 1 DO |
| WR.Write32LE(CHL.GetInt(ImportTable, i)) |
| WR.Write32LE(File, CHL.GetInt(ImportTable, i)) |
| END; |
| CHL.WriteToFile(program._import); |
| CHL.WriteToFile(File, program.import); |
| WR.Close |
| WR.Close(File) |
| END write; |
| /programs/develop/oberon07/Source/LISTS.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 32,14 → 32,17 |
| IF list.first = NIL THEN |
| list.first := item; |
| item.prev := NIL |
| list.last := item; |
| item.prev := NIL; |
| item.next := NIL |
| ELSE |
| ASSERT(list.last # NIL); |
| item.prev := list.last; |
| list.last.next := item |
| END; |
| list.last := item; |
| item.next := NIL |
| list.last.next := item; |
| item.next := NIL; |
| list.last := item |
| END |
| END push; |
| 105,13 → 108,16 |
| IF prev # NIL THEN |
| prev.next := nov; |
| nov.prev := prev |
| nov.prev := prev; |
| cur.prev := nov; |
| nov.next := cur |
| ELSE |
| nov.prev := NIL; |
| cur.prev := nov; |
| nov.next := cur; |
| list.first := nov |
| END; |
| cur.prev := nov; |
| nov.next := cur |
| END |
| END insertL; |
| /programs/develop/oberon07/Source/MSCOFF.ob07 |
|---|
| 28,30 → 28,28 |
| SH = PE32.IMAGE_SECTION_HEADER; |
| PROCEDURE WriteReloc (VirtualAddress, SymbolTableIndex, Type: INTEGER); |
| PROCEDURE WriteReloc (File: WR.FILE; VirtualAddress, SymbolTableIndex, Type: INTEGER); |
| BEGIN |
| WR.Write32LE(VirtualAddress); |
| WR.Write32LE(SymbolTableIndex); |
| WR.Write16LE(Type) |
| WR.Write32LE(File, VirtualAddress); |
| WR.Write32LE(File, SymbolTableIndex); |
| WR.Write16LE(File, Type) |
| END WriteReloc; |
| PROCEDURE Reloc (program: BIN.PROGRAM); |
| PROCEDURE Reloc (program: BIN.PROGRAM; File: WR.FILE); |
| VAR |
| reloc: BIN.RELOC; |
| offset: INTEGER; |
| BEGIN |
| reloc := program.rel_list.first(BIN.RELOC); |
| WHILE reloc # NIL DO |
| offset := reloc.offset; |
| CASE reloc.opcode OF |
| |BIN.RIMP, |
| BIN.IMPTAB: WriteReloc(offset, 4, 6) |
| |BIN.RBSS: WriteReloc(offset, 5, 6) |
| |BIN.RDATA: WriteReloc(offset, 2, 6) |
| |BIN.RCODE: WriteReloc(offset, 1, 6) |
| BIN.IMPTAB: WriteReloc(File, reloc.offset, 4, 6) |
| |BIN.RBSS: WriteReloc(File, reloc.offset, 5, 6) |
| |BIN.RDATA: WriteReloc(File, reloc.offset, 2, 6) |
| |BIN.RCODE: WriteReloc(File, reloc.offset, 1, 6) |
| END; |
| reloc := reloc.next(BIN.RELOC) |
| 64,7 → 62,6 |
| reloc: BIN.RELOC; |
| iproc: BIN.IMPRT; |
| res, L: INTEGER; |
| offset: INTEGER; |
| code: CHL.BYTELIST; |
| BEGIN |
| 74,17 → 71,16 |
| WHILE reloc # NIL DO |
| INC(res); |
| offset := reloc.offset; |
| IF reloc.opcode = BIN.RIMP THEN |
| L := BIN.get32le(code, offset); |
| L := BIN.get32le(code, reloc.offset); |
| iproc := BIN.GetIProc(program, L); |
| BIN.put32le(code, offset, iproc.label) |
| BIN.put32le(code, reloc.offset, iproc.label) |
| END; |
| IF reloc.opcode = BIN.RCODE THEN |
| L := BIN.get32le(code, offset); |
| BIN.put32le(code, offset, BIN.GetLabel(program, L)) |
| L := BIN.get32le(code, reloc.offset); |
| BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L)) |
| END; |
| reloc := reloc.next(BIN.RELOC) |
| 96,6 → 92,7 |
| PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER); |
| VAR |
| File: WR.FILE; |
| exp: BIN.EXPRT; |
| n, i: INTEGER; |
| 148,7 → 145,7 |
| KOS.Import(program, 0, ImportTable, ILen, LibCount, isize); |
| ExpCount := LISTS.count(program.exp_list); |
| icount := CHL.Length(program._import); |
| icount := CHL.Length(program.import); |
| dcount := CHL.Length(program.data); |
| ccount := CHL.Length(program.code); |
| ecount := CHL.Length(program.export); |
| 222,87 → 219,91 |
| FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10; |
| WR.Create(FileName); |
| File := WR.Create(FileName); |
| PE32.WriteFileHeader(FileHeader); |
| PE32.WriteFileHeader(File, FileHeader); |
| PE32.WriteSectionHeader(flat); |
| PE32.WriteSectionHeader(data); |
| PE32.WriteSectionHeader(edata); |
| PE32.WriteSectionHeader(idata); |
| PE32.WriteSectionHeader(bss); |
| PE32.WriteSectionHeader(File, flat); |
| PE32.WriteSectionHeader(File, data); |
| PE32.WriteSectionHeader(File, edata); |
| PE32.WriteSectionHeader(File, idata); |
| PE32.WriteSectionHeader(File, bss); |
| CHL.WriteToFile(program.code); |
| CHL.WriteToFile(program.data); |
| CHL.WriteToFile(File, program.code); |
| CHL.WriteToFile(File, program.data); |
| exp := program.exp_list.first(BIN.EXPRT); |
| WHILE exp # NIL DO |
| WR.Write32LE(exp.nameoffs + edata.SizeOfRawData - ecount); |
| WR.Write32LE(exp.label); |
| WR.Write32LE(File, exp.nameoffs + edata.SizeOfRawData - ecount); |
| WR.Write32LE(File, exp.label); |
| exp := exp.next(BIN.EXPRT) |
| END; |
| WR.Write32LE(((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD); |
| WR.Write32LE(ver); |
| WR.Write32LE(File, ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD); |
| WR.Write32LE(File, ver); |
| WR.Write32LE(0); |
| WR.Write32LE(File, 0); |
| PE32.WriteName(szversion); |
| CHL.WriteToFile(program.export); |
| PE32.WriteName(File, szversion); |
| CHL.WriteToFile(File, program.export); |
| FOR i := 0 TO ILen - 1 DO |
| WR.Write32LE(CHL.GetInt(ImportTable, i)) |
| WR.Write32LE(File, CHL.GetInt(ImportTable, i)) |
| END; |
| CHL.WriteToFile(program._import); |
| CHL.WriteToFile(File, program.import); |
| Reloc(program); |
| Reloc(program, File); |
| n := 0; |
| exp := program.exp_list.first(BIN.EXPRT); |
| WHILE exp # NIL DO |
| WriteReloc(n, 3, 6); |
| WriteReloc(File, n, 3, 6); |
| INC(n, 4); |
| WriteReloc(n, 1, 6); |
| WriteReloc(File, n, 1, 6); |
| INC(n, 4); |
| exp := exp.next(BIN.EXPRT) |
| END; |
| WriteReloc(n, 3, 6); |
| WriteReloc(File, n, 3, 6); |
| FOR i := 0 TO LibCount * 2 - 1 DO |
| WriteReloc(i * SIZE_OF_DWORD, 4, 6) |
| i := 0; |
| WHILE i < LibCount * 2 DO |
| WriteReloc(File, i * SIZE_OF_DWORD, 4, 6); |
| INC(i); |
| WriteReloc(File, i * SIZE_OF_DWORD, 4, 6); |
| INC(i) |
| END; |
| FOR i := LibCount * 2 TO ILen - 1 DO |
| IF CHL.GetInt(ImportTable, i) # 0 THEN |
| WriteReloc(i * SIZE_OF_DWORD, 4, 6) |
| WriteReloc(File, i * SIZE_OF_DWORD, 4, 6) |
| END |
| END; |
| PE32.WriteName("EXPORTS"); |
| WriteReloc(0, 3, 2); |
| PE32.WriteName(File, "EXPORTS"); |
| WriteReloc(File, 0, 3, 2); |
| PE32.WriteName(".flat"); |
| WriteReloc(0, 1, 3); |
| PE32.WriteName(File, ".flat"); |
| WriteReloc(File, 0, 1, 3); |
| PE32.WriteName(".data"); |
| WriteReloc(0, 2, 3); |
| PE32.WriteName(File, ".data"); |
| WriteReloc(File, 0, 2, 3); |
| PE32.WriteName(".edata"); |
| WriteReloc(0, 3, 3); |
| PE32.WriteName(File, ".edata"); |
| WriteReloc(File, 0, 3, 3); |
| PE32.WriteName(".idata"); |
| WriteReloc(0, 4, 3); |
| PE32.WriteName(File, ".idata"); |
| WriteReloc(File, 0, 4, 3); |
| PE32.WriteName(".bss"); |
| WriteReloc(0, 5, 3); |
| PE32.WriteName(File, ".bss"); |
| WriteReloc(File, 0, 5, 3); |
| WR.Write32LE(4); |
| WR.Write32LE(File, 4); |
| WR.Close |
| WR.Close(File) |
| END write; |
| /programs/develop/oberon07/Source/MSP430.ob07 |
|---|
| 421,7 → 421,8 |
| PROCEDURE xchg (reg1, reg2: INTEGER); |
| BEGIN |
| Push(reg1); |
| mov(reg1, reg2); |
| Push(reg2); |
| Pop(reg1); |
| Pop(reg2) |
| END xchg; |
| 818,7 → 819,7 |
| Op2(opADD, reg2 * 256, reg1); |
| drop |
| |IL.opADDC: |
| |IL.opADDL, IL.opADDR: |
| IF param2 # 0 THEN |
| UnOp(reg1); |
| Op2(opADD, imm(param2), reg1) |
| 879,10 → 880,10 |
| cc := cond(opcode); |
| next := cmd.next(COMMAND); |
| IF next.opcode = IL.opJNZ THEN |
| IF next.opcode = IL.opJE THEN |
| jcc(cc, next.param1); |
| cmd := next |
| ELSIF next.opcode = IL.opJZ THEN |
| ELSIF next.opcode = IL.opJNE THEN |
| jcc(ORD(BITS(cc) / {0}), next.param1); |
| cmd := next |
| ELSE |
| 889,32 → 890,45 |
| setcc(cc, GetAnyReg()) |
| END |
| |IL.opNOP, IL.opAND, IL.opOR: |
| |IL.opNOP: |
| |IL.opCODE: |
| EmitWord(param2) |
| |IL.opACC: |
| IF (R.top # 0) OR (R.stk[0] # ACC) THEN |
| PushAll(0); |
| GetRegA; |
| Pop(ACC); |
| DEC(R.pushed) |
| END |
| |IL.opDROP: |
| UnOp(reg1); |
| drop |
| |IL.opJNZ1: |
| |IL.opJNZ: |
| UnOp(reg1); |
| Test(reg1); |
| jcc(jne, param1) |
| |IL.opJZ: |
| UnOp(reg1); |
| Test(reg1); |
| jcc(je, param1) |
| |IL.opJG: |
| UnOp(reg1); |
| Test(reg1); |
| jcc(jg, param1) |
| |IL.opJNZ: |
| |IL.opJE: |
| UnOp(reg1); |
| Test(reg1); |
| jcc(jne, param1); |
| drop |
| |IL.opJZ: |
| |IL.opJNE: |
| UnOp(reg1); |
| Test(reg1); |
| jcc(je, param1); |
| 944,11 → 958,6 |
| drop; |
| Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) |
| |IL.opCHKBYTE: |
| BinOp(reg1, reg2); |
| Op2(opCMP, imm(256), reg1); |
| jcc(jb, param1) |
| |IL.opCHKIDX: |
| UnOp(reg1); |
| Op2(opCMP, imm(param2), reg1); |
| 1070,7 → 1079,7 |
| Op2(opBIC, reg2 * 256, reg1); |
| drop |
| |IL.opADDSC: |
| |IL.opADDSL, IL.opADDSR: |
| UnOp(reg1); |
| Op2(opBIS, imm(param2), reg1) |
| 1180,6 → 1189,11 |
| INCL(R.regs, reg1); |
| ASSERT(REG.GetReg(R, reg1)) |
| |IL.opCHKBYTE: |
| BinOp(reg1, reg2); |
| Op2(opCMP, imm(256), reg1); |
| jcc(jb, param1) |
| |IL.opLSL, IL.opASR, IL.opROR, IL.opLSR: |
| PushAll(2); |
| CASE opcode OF |
| 1604,7 → 1618,7 |
| PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); |
| VAR |
| i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER; |
| i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; |
| Code, Data, Bss, Free: RECORD address, size: INTEGER END; |
| 1612,6 → 1626,8 |
| reloc: RELOC; |
| file: WR.FILE; |
| BEGIN |
| IdxWords.src := NOWORD; |
| IdxWords.dst := NOWORD; |
| 1671,11 → 1687,10 |
| reloc := RelList.first(RELOC); |
| WHILE reloc # NIL DO |
| adr := reloc.WordPtr.offset * 2; |
| val := reloc.WordPtr.val; |
| CASE reloc.section OF |
| |RCODE: PutWord(LabelOffs(val) * 2, adr) |
| |RDATA: PutWord(val + Data.address, adr) |
| |RBSS: PutWord(val + Bss.address, adr) |
| |RCODE: PutWord(LabelOffs(reloc.WordPtr.val) * 2, adr) |
| |RDATA: PutWord(reloc.WordPtr.val + Data.address, adr) |
| |RBSS: PutWord(reloc.WordPtr.val + Bss.address, adr) |
| END; |
| reloc := reloc.next(RELOC) |
| END; |
| 1718,13 → 1733,13 |
| PutWord(LabelOffs(IV[i]) * 2, adr) |
| END; |
| WR.Create(outname); |
| file := WR.Create(outname); |
| HEX.Data(mem, Code.address, TextSize); |
| HEX.Data(mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); |
| HEX.End; |
| HEX.Data(file, mem, Code.address, TextSize); |
| HEX.Data(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); |
| HEX.End(file); |
| WR.Close; |
| WR.Close(file); |
| INC(TextSize, IntVectorSize + TypesSize); |
| INC(Bss.size, minStackSize + RTL.VarSize); |
| /programs/develop/oberon07/Source/PARS.ob07 |
|---|
| 34,7 → 34,7 |
| EXPR* = RECORD |
| obj*: INTEGER; |
| _type*: PROG._TYPE; |
| type*: PROG.TYPE_; |
| value*: ARITH.VALUE; |
| stproc*: INTEGER; |
| readOnly*: BOOLEAN; |
| 44,7 → 44,7 |
| STATPROC = PROCEDURE (parser: PARSER); |
| EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR); |
| RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG._TYPE; pos: POSITION): BOOLEAN; |
| RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN; |
| rPARSER = RECORD (C.ITEM) |
| 74,6 → 74,8 |
| VAR |
| program*: PROG.PROGRAM; |
| parsers: C.COLLECTION; |
| lines*, modules: INTEGER; |
| 131,10 → 133,10 |
| BEGIN |
| SCAN.Next(parser.scanner, parser.lex); |
| errno := parser.lex.error; |
| IF errno = 0 THEN |
| IF (TARGETS.RealSize = 0) & (parser.lex.sym = SCAN.lxFLOAT) THEN |
| IF (errno = 0) & (TARGETS.CPU = TARGETS.cpuMSP430) THEN |
| IF parser.lex.sym = SCAN.lxFLOAT THEN |
| errno := -SCAN.lxERROR13 |
| ELSIF (TARGETS.BitDepth = 16) & (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN |
| ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN |
| errno := -SCAN.lxERROR10 |
| END |
| END; |
| 182,6 → 184,7 |
| |SCAN.lxSEMI: err := 24 |
| |SCAN.lxRETURN: err := 38 |
| |SCAN.lxMODULE: err := 21 |
| |SCAN.lxSTRING: err := 66 |
| END; |
| check1(FALSE, parser, err) |
| 224,7 → 227,7 |
| IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN |
| alias := FALSE; |
| unit := PROG.getUnit(name); |
| unit := PROG.getUnit(program, name); |
| IF unit # NIL THEN |
| check(unit.closed, pos, 31) |
| 247,7 → 250,7 |
| unit := parser2.unit; |
| destroy(parser2) |
| END; |
| IF unit = PROG.program.sysunit THEN |
| IF unit = program.sysunit THEN |
| parser.unit.sysimport := TRUE |
| END; |
| ident.unit := unit |
| 347,7 → 350,7 |
| END ConstExpression; |
| PROCEDURE FieldList (parser: PARSER; rec: PROG._TYPE); |
| PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_); |
| VAR |
| name: SCAN.IDENT; |
| export: BOOLEAN; |
| 384,18 → 387,18 |
| END FieldList; |
| PROCEDURE FormalParameters (parser: PARSER; _type: PROG._TYPE); |
| PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_); |
| VAR |
| ident: PROG.IDENT; |
| PROCEDURE FPSection (parser: PARSER; _type: PROG._TYPE); |
| PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_); |
| VAR |
| ident: PROG.IDENT; |
| exit: BOOLEAN; |
| vPar: BOOLEAN; |
| dim: INTEGER; |
| t0, t1: PROG._TYPE; |
| t0, t1: PROG.TYPE_; |
| BEGIN |
| vPar := parser.sym = SCAN.lxVAR; |
| 407,7 → 410,7 |
| exit := FALSE; |
| WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO |
| check1(PROG.addParam(_type, parser.lex.ident, vPar), parser, 30); |
| check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30); |
| Next(parser); |
| IF parser.sym = SCAN.lxCOMMA THEN |
| ExpectSym(parser, SCAN.lxIDENT) |
| 424,17 → 427,17 |
| ident := QIdent(parser, FALSE); |
| check1(ident.typ = PROG.idTYPE, parser, 68); |
| t0 := ident._type; |
| t0 := ident.type; |
| t1 := t0; |
| WHILE dim > 0 DO |
| t1 := PROG.enterType(PROG.tARRAY, -1, 0, parser.unit); |
| t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit); |
| t1.base := t0; |
| t0 := t1; |
| DEC(dim) |
| END; |
| PROG.setParams(_type, t1); |
| PROG.setParams(type, t1); |
| Next(parser); |
| exit := TRUE |
| ELSE |
| 451,10 → 454,10 |
| Next(parser); |
| IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN |
| FPSection(parser, _type); |
| FPSection(parser, type); |
| WHILE parser.sym = SCAN.lxSEMI DO |
| Next(parser); |
| FPSection(parser, _type) |
| FPSection(parser, type) |
| END |
| END; |
| 465,12 → 468,12 |
| ExpectSym(parser, SCAN.lxIDENT); |
| ident := QIdent(parser, FALSE); |
| check1(ident.typ = PROG.idTYPE, parser, 68); |
| check1(~(ident._type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69); |
| check1( ~(ODD(_type.call) & (ident._type.typ = PROG.tREAL)), parser, 113); |
| _type.base := ident._type; |
| check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69); |
| check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113); |
| type.base := ident.type; |
| Next(parser) |
| ELSE |
| _type.base := NIL |
| type.base := NIL |
| END |
| END |
| 500,8 → 503,6 |
| sf := PROG.sf_linux |
| ELSIF parser.lex.s = "code" THEN |
| sf := PROG.sf_code |
| ELSIF parser.lex.s = "oberon" THEN |
| sf := PROG.sf_oberon |
| ELSIF parser.lex.s = "noalign" THEN |
| sf := PROG.sf_noalign |
| ELSE |
| 508,7 → 509,7 |
| check1(FALSE, parser, 124) |
| END; |
| check1(sf IN PROG.program.sysflags, parser, 125); |
| check1(sf IN program.sysflags, parser, 125); |
| IF proc THEN |
| check1(sf IN PROG.proc_flags, parser, 123) |
| 531,12 → 532,6 |
| res := PROG.systemv |
| |PROG.sf_code: |
| res := PROG.code |
| |PROG.sf_oberon: |
| IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN |
| res := PROG.default32 |
| ELSIF TARGETS.OS IN {TARGETS.osWIN64, TARGETS.osLINUX64} THEN |
| res := PROG.default64 |
| END |
| |PROG.sf_windows: |
| IF TARGETS.OS = TARGETS.osWIN32 THEN |
| res := PROG.stdcall |
| 557,34 → 552,16 |
| END sysflag; |
| PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER; |
| PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER; |
| VAR |
| call: INTEGER; |
| dll, proc: SCAN.LEXSTR; |
| pos: POSITION; |
| PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR); |
| VAR |
| pos: POSITION; |
| str: ARITH.VALUE; |
| BEGIN |
| getpos(parser, pos); |
| ConstExpression(parser, str); |
| IF str.typ = ARITH.tSTRING THEN |
| name := str.string(SCAN.IDENT).s |
| ELSIF str.typ = ARITH.tCHAR THEN |
| ARITH.charToStr(str, name) |
| ELSE |
| check(FALSE, pos, 117) |
| END |
| END getStr; |
| import := NIL; |
| BEGIN |
| _import := NIL; |
| IF parser.sym = SCAN.lxLSQUARE THEN |
| getpos(parser, pos); |
| check1(parser.unit.sysimport, parser, 54); |
| 595,32 → 572,34 |
| Next(parser); |
| INC(call) |
| END; |
| IF isProc & (parser.sym = SCAN.lxCOMMA) THEN |
| Next(parser); |
| getStr(parser, dll); |
| IF ~isProc THEN |
| checklex(parser, SCAN.lxRSQUARE) |
| END; |
| IF parser.sym = SCAN.lxCOMMA THEN |
| ExpectSym(parser, SCAN.lxSTRING); |
| dll := parser.lex.s; |
| STRINGS.UpCase(dll); |
| checklex(parser, SCAN.lxCOMMA); |
| ExpectSym(parser, SCAN.lxCOMMA); |
| ExpectSym(parser, SCAN.lxSTRING); |
| proc := parser.lex.s; |
| Next(parser); |
| getStr(parser, proc); |
| _import := IL.AddImp(dll, proc) |
| import := IL.AddImp(dll, proc) |
| END; |
| checklex(parser, SCAN.lxRSQUARE); |
| Next(parser) |
| ELSE |
| CASE TARGETS.BitDepth OF |
| |16: call := PROG.default16 |
| |32: IF TARGETS.CPU = TARGETS.cpuX86 THEN |
| |32: IF TARGETS.target = TARGETS.STM32CM3 THEN |
| call := PROG.ccall |
| ELSE |
| call := PROG.default32 |
| ELSE |
| call := PROG.ccall |
| END |
| |64: call := PROG.default64 |
| END |
| END; |
| IF _import # NIL THEN |
| IF import # NIL THEN |
| check(TARGETS.Import, pos, 70) |
| END |
| 628,7 → 607,7 |
| END procflag; |
| PROCEDURE _type (parser: PARSER; VAR t: PROG._TYPE; flags: SET); |
| PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET); |
| CONST |
| comma = 0; |
| closed = 1; |
| 640,11 → 619,11 |
| ident: PROG.IDENT; |
| unit: PROG.UNIT; |
| pos, pos2: POSITION; |
| fieldType: PROG._TYPE; |
| fieldType: PROG.TYPE_; |
| baseIdent: SCAN.IDENT; |
| a, b: INTEGER; |
| RecFlag: INTEGER; |
| _import: IL.IMPORT_PROC; |
| import: IL.IMPORT_PROC; |
| BEGIN |
| unit := parser.unit; |
| 655,7 → 634,7 |
| IF ident # NIL THEN |
| check1(ident.typ = PROG.idTYPE, parser, 49); |
| t := ident._type; |
| t := ident.type; |
| check1(t # NIL, parser, 50); |
| IF closed IN flags THEN |
| check1(t.closed, parser, 50) |
| 677,13 → 656,13 |
| check(ARITH.check(arrLen), pos, 39); |
| check(ARITH.getInt(arrLen) > 0, pos, 51); |
| t := PROG.enterType(PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); |
| t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); |
| IF parser.sym = SCAN.lxCOMMA THEN |
| _type(parser, t.base, {comma, closed}) |
| type(parser, t.base, {comma, closed}) |
| ELSIF parser.sym = SCAN.lxOF THEN |
| Next(parser); |
| _type(parser, t.base, {closed}) |
| type(parser, t.base, {closed}) |
| ELSE |
| check1(FALSE, parser, 47) |
| END; |
| 702,7 → 681,7 |
| getpos(parser, pos2); |
| Next(parser); |
| t := PROG.enterType(PROG.tRECORD, 0, 0, unit); |
| t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit); |
| t.align := 1; |
| IF parser.sym = SCAN.lxLSQUARE THEN |
| 719,7 → 698,7 |
| ExpectSym(parser, SCAN.lxIDENT); |
| getpos(parser, pos); |
| _type(parser, t.base, {closed}); |
| type(parser, t.base, {closed}); |
| check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52); |
| 738,7 → 717,7 |
| t.align := t.base.align |
| END |
| ELSE |
| t.base := PROG.program.stTypes.tANYREC |
| t.base := program.stTypes.tANYREC |
| END; |
| WHILE parser.sym = SCAN.lxIDENT DO |
| 747,7 → 726,7 |
| ASSERT(parser.sym = SCAN.lxCOLON); |
| Next(parser); |
| _type(parser, fieldType, {closed}); |
| type(parser, fieldType, {closed}); |
| check(PROG.setFields(t, fieldType), pos2, 104); |
| IF (fieldType.align > t.align) & ~t.noalign THEN |
| 777,7 → 756,7 |
| ExpectSym(parser, SCAN.lxTO); |
| Next(parser); |
| t := PROG.enterType(PROG.tPOINTER, TARGETS.AdrSize, 0, unit); |
| t := PROG.enterType(program, PROG.tPOINTER, TARGETS.AdrSize, 0, unit); |
| t.align := TARGETS.AdrSize; |
| getpos(parser, pos); |
| 786,7 → 765,7 |
| baseIdent := parser.lex.ident |
| END; |
| _type(parser, t.base, {forward}); |
| type(parser, t.base, {forward}); |
| IF t.base # NIL THEN |
| check(t.base.typ = PROG.tRECORD, pos, 58) |
| 796,15 → 775,15 |
| ELSIF parser.sym = SCAN.lxPROCEDURE THEN |
| NextPos(parser, pos); |
| t := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
| t := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
| t.align := TARGETS.AdrSize; |
| t.call := procflag(parser, _import, FALSE); |
| t.call := procflag(parser, import, FALSE); |
| FormalParameters(parser, t) |
| ELSE |
| check1(FALSE, parser, 49) |
| END |
| END _type; |
| END type; |
| PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT; |
| 832,7 → 811,7 |
| END IdentDef; |
| PROCEDURE ConstTypeDeclaration (parser: PARSER; _const: BOOLEAN); |
| PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN); |
| VAR |
| ident: PROG.IDENT; |
| name: SCAN.IDENT; |
| 839,7 → 818,7 |
| pos: POSITION; |
| BEGIN |
| IF _const THEN |
| IF const THEN |
| ident := IdentDef(parser, PROG.idNONE, name) |
| ELSE |
| ident := IdentDef(parser, PROG.idTYPE, name) |
| 848,7 → 827,7 |
| checklex(parser, SCAN.lxEQ); |
| NextPos(parser, pos); |
| IF _const THEN |
| IF const THEN |
| ConstExpression(parser, ident.value); |
| IF ident.value.typ = ARITH.tINTEGER THEN |
| check(ARITH.check(ident.value), pos, 39) |
| 856,9 → 835,9 |
| check(ARITH.check(ident.value), pos, 40) |
| END; |
| ident.typ := PROG.idCONST; |
| ident._type := PROG.getType(ident.value.typ) |
| ident.type := PROG.getType(program, ident.value.typ) |
| ELSE |
| _type(parser, ident._type, {}) |
| type(parser, ident.type, {}) |
| END; |
| checklex(parser, SCAN.lxSEMI); |
| 871,7 → 850,7 |
| VAR |
| ident: PROG.IDENT; |
| name: SCAN.IDENT; |
| t: PROG._TYPE; |
| t: PROG.TYPE_; |
| BEGIN |
| 882,7 → 861,7 |
| ExpectSym(parser, SCAN.lxIDENT) |
| ELSIF parser.sym = SCAN.lxCOLON THEN |
| Next(parser); |
| _type(parser, t, {}); |
| type(parser, t, {}); |
| PROG.setVarsType(parser.unit, t); |
| checklex(parser, SCAN.lxSEMI); |
| Next(parser) |
| 916,8 → 895,8 |
| label: INTEGER; |
| enter: IL.COMMAND; |
| call: INTEGER; |
| t: PROG._TYPE; |
| _import: IL.IMPORT_PROC; |
| t: PROG.TYPE_; |
| import: IL.IMPORT_PROC; |
| endmod, b: BOOLEAN; |
| fparams: SET; |
| variables: LISTS.LIST; |
| 933,19 → 912,16 |
| unit := parser.unit; |
| call := procflag(parser, _import, TRUE); |
| call := procflag(parser, import, TRUE); |
| getpos(parser, pos); |
| pos1 := pos; |
| checklex(parser, SCAN.lxIDENT); |
| IF _import # NIL THEN |
| IF import # NIL THEN |
| proc := IdentDef(parser, PROG.idIMP, name); |
| proc._import := _import; |
| IF _import.name = "" THEN |
| _import.name := name.s |
| END; |
| PROG.program.procs.last(PROG.PROC)._import := _import |
| proc.import := import; |
| program.procs.last(PROG.PROC).import := import |
| ELSE |
| proc := IdentDef(parser, PROG.idPROC, name) |
| END; |
| 952,8 → 928,8 |
| check(PROG.openScope(unit, proc.proc), pos, 116); |
| proc._type := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
| t := proc._type; |
| proc.type := PROG.enterType(program, PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit); |
| t := proc.type; |
| t.align := TARGETS.AdrSize; |
| t.call := call; |
| 983,7 → 959,7 |
| WHILE param # NIL DO |
| ident := PROG.addIdent(unit, param.name, PROG.idPARAM); |
| ASSERT(ident # NIL); |
| ident._type := param._type; |
| ident.type := param.type; |
| ident.offset := param.offset; |
| IF param.vPar THEN |
| ident.typ := PROG.idVPAR |
| 991,7 → 967,7 |
| param := param.next(PROG.PARAM) |
| END; |
| IF _import = NIL THEN |
| IF import = NIL THEN |
| label := IL.NewLabel(); |
| proc.proc.label := label; |
| proc.proc.used := handler; |
| 1007,11 → 983,10 |
| getpos(parser, pos2); |
| ConstExpression(parser, code); |
| check(code.typ = ARITH.tINTEGER, pos2, 43); |
| IF TARGETS.WordSize > TARGETS.InstrSize THEN |
| CASE TARGETS.InstrSize OF |
| |1: check(ARITH.range(code, 0, 255), pos, 42) |
| |2: check(ARITH.range(code, 0, 65535), pos, 110) |
| END |
| IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
| check(ARITH.range(code, 0, 255), pos2, 42) |
| ELSIF TARGETS.CPU = TARGETS.cpuTHUMB THEN |
| check(ARITH.range(code, 0, 65535), pos2, 110) |
| END; |
| IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
| comma := parser.sym = SCAN.lxCOMMA; |
| 1026,7 → 1001,7 |
| checklex(parser, SCAN.lxSEMI); |
| Next(parser); |
| IF _import = NIL THEN |
| IF import = NIL THEN |
| IF parser.main & proc.export & TARGETS.Dll THEN |
| IF TARGETS.target = TARGETS.KolibriOSDLL THEN |
| 1040,13 → 1015,13 |
| b := DeclarationSequence(parser) |
| END; |
| PROG.ResetLocSize; |
| program.locsize := 0; |
| IF call IN {PROG._win64, PROG.win64} THEN |
| fparams := PROG.getFloatParamsPos(proc._type, 3, int, flt); |
| enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc._type.parSize, 4)) |
| fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt); |
| enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4)) |
| ELSIF call IN {PROG._systemv, PROG.systemv} THEN |
| fparams := PROG.getFloatParamsPos(proc._type, PROG.MAXSYSVPARAM - 1, int, flt); |
| enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc._type.parSize)) |
| fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); |
| enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize)) |
| ELSIF codeProc THEN |
| ELSE |
| 1067,9 → 1042,9 |
| END; |
| IF ~codeProc THEN |
| proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), PROG.program.locsize, |
| proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize, |
| t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); |
| enter.param2 := PROG.program.locsize; |
| enter.param2 := program.locsize; |
| checklex(parser, SCAN.lxEND) |
| ELSE |
| proc.proc.leave := IL.LeaveC() |
| 1076,16 → 1051,15 |
| END; |
| IF TARGETS.CPU = TARGETS.cpuMSP430 THEN |
| check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63) |
| check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.options.ram, pos1, 63) |
| END |
| END; |
| IF parser.sym = SCAN.lxEND THEN |
| Next(parser); |
| IF parser.sym = SCAN.lxIDENT THEN |
| ExpectSym(parser, SCAN.lxIDENT); |
| getpos(parser, pos); |
| endname := parser.lex.ident; |
| IF ~codeProc & (_import = NIL) THEN |
| IF ~codeProc & (import = NIL) THEN |
| check(endname = name, pos, 60); |
| ExpectSym(parser, SCAN.lxSEMI); |
| Next(parser) |
| 1101,14 → 1075,9 |
| error(pos, 60) |
| END |
| END |
| ELSIF parser.sym = SCAN.lxSEMI THEN |
| Next(parser) |
| ELSE |
| checklex(parser, SCAN.lxIDENT) |
| END |
| END; |
| IF ~codeProc & (_import = NIL) THEN |
| IF ~codeProc & (import = NIL) THEN |
| variables := LISTS.create(NIL); |
| ELSE |
| variables := NIL |
| 1116,7 → 1085,7 |
| PROG.closeScope(unit, variables); |
| IF ~codeProc & (_import = NIL) THEN |
| IF ~codeProc & (import = NIL) THEN |
| enter.variables := variables |
| END |
| 1188,7 → 1157,7 |
| check1(parser.lex.s = parser.modname, parser, 23) |
| END; |
| unit := PROG.newUnit(parser.lex.ident); |
| unit := PROG.newUnit(program, parser.lex.ident); |
| parser.unit := unit; |
| 1202,7 → 1171,9 |
| INC(modules); |
| CONSOLE.String("compiling "); |
| CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") "); |
| IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN |
| CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ") |
| END; |
| CONSOLE.String(unit.name.s); |
| IF parser.unit.sysimport THEN |
| CONSOLE.String(" (SYSTEM)") |
| 1209,10 → 1180,6 |
| END; |
| CONSOLE.Ln; |
| IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
| IL.fname(parser.fname) |
| END; |
| label := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJMP, label); |
| 1222,7 → 1189,9 |
| IL.SetLabel(errlabel); |
| IL.StrAdr(name); |
| IL.Param1; |
| IL.AddCmd(IL.opPUSHC, modules); |
| IF TARGETS.CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuMSP430} THEN |
| IL.AddCmd(IL.opPUSHC, modules) |
| END; |
| IL.AddCmd0(IL.opERR); |
| FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO |
| 1316,7 → 1285,7 |
| PROCEDURE init* (options: PROG.OPTIONS); |
| BEGIN |
| PROG.create(options); |
| program := PROG.create(options); |
| parsers := C.create(); |
| lines := 0; |
| modules := 0 |
| /programs/develop/oberon07/Source/PE32.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 102,6 → 102,15 |
| END; |
| IMAGE_NT_HEADERS = RECORD |
| Signature: ARRAY 4 OF BYTE; |
| FileHeader: IMAGE_FILE_HEADER; |
| OptionalHeader: IMAGE_OPTIONAL_HEADER |
| END; |
| IMAGE_SECTION_HEADER* = RECORD |
| Name*: NAME; |
| 138,33 → 147,35 |
| END; |
| VIRTUAL_ADDR* = RECORD |
| VIRTUAL_ADDR = RECORD |
| Code*, Data*, Bss*, Import*: INTEGER |
| Code, Data, Bss, Import: INTEGER |
| END; |
| FILE = WR.FILE; |
| VAR |
| Signature: ARRAY 4 OF BYTE; |
| FileHeader: IMAGE_FILE_HEADER; |
| OptionalHeader: IMAGE_OPTIONAL_HEADER; |
| msdos: ARRAY 128 OF BYTE; |
| PEHeader: IMAGE_NT_HEADERS; |
| SectionHeaders: ARRAY 16 OF IMAGE_SECTION_HEADER; |
| Relocations: LISTS.LIST; |
| bit64: BOOLEAN; |
| libcnt: INTEGER; |
| SizeOfWord: INTEGER; |
| PROCEDURE Export (program: BIN.PROGRAM; name: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER; |
| PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER; |
| BEGIN |
| ExportDir.Characteristics := 0; |
| ExportDir.TimeDateStamp := FileHeader.TimeDateStamp; |
| ExportDir.TimeDateStamp := PEHeader.FileHeader.TimeDateStamp; |
| ExportDir.MajorVersion := 0X; |
| ExportDir.MinorVersion := 0X; |
| ExportDir.Name := name; |
| ExportDir.Name := program.modname + DataRVA; |
| ExportDir.Base := 0; |
| ExportDir.NumberOfFunctions := LISTS.count(program.exp_list); |
| ExportDir.NumberOfNames := ExportDir.NumberOfFunctions; |
| 176,17 → 187,27 |
| END Export; |
| PROCEDURE align (n, _align: INTEGER): INTEGER; |
| BEGIN |
| IF n MOD _align # 0 THEN |
| n := n + _align - (n MOD _align) |
| END |
| RETURN n |
| END align; |
| PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER; |
| VAR |
| imp: BIN.IMPRT; |
| import: BIN.IMPRT; |
| res: INTEGER; |
| BEGIN |
| res := 0; |
| imp := lib.next(BIN.IMPRT); |
| WHILE (imp # NIL) & (imp.label # 0) DO |
| import := lib.next(BIN.IMPRT); |
| WHILE (import # NIL) & (import.label # 0) DO |
| INC(res); |
| imp := imp.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END |
| RETURN res |
| 195,7 → 216,7 |
| PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER; |
| VAR |
| imp: BIN.IMPRT; |
| import: BIN.IMPRT; |
| proccnt: INTEGER; |
| procoffs: INTEGER; |
| OriginalCurrentThunk, |
| 204,33 → 225,33 |
| BEGIN |
| libcnt := 0; |
| proccnt := 0; |
| imp := imp_list.first(BIN.IMPRT); |
| WHILE imp # NIL DO |
| IF imp.label = 0 THEN |
| import := imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF import.label = 0 THEN |
| INC(libcnt) |
| ELSE |
| INC(proccnt) |
| END; |
| imp := imp.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END; |
| procoffs := 0; |
| imp := imp_list.first(BIN.IMPRT); |
| WHILE imp # NIL DO |
| IF imp.label = 0 THEN |
| imp.OriginalFirstThunk := procoffs; |
| imp.FirstThunk := procoffs + (GetProcCount(imp) + 1); |
| OriginalCurrentThunk := imp.OriginalFirstThunk; |
| CurrentThunk := imp.FirstThunk; |
| INC(procoffs, (GetProcCount(imp) + 1) * 2) |
| import := imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF import.label = 0 THEN |
| import.OriginalFirstThunk := procoffs; |
| import.FirstThunk := procoffs + (GetProcCount(import) + 1); |
| OriginalCurrentThunk := import.OriginalFirstThunk; |
| CurrentThunk := import.FirstThunk; |
| procoffs := procoffs + (GetProcCount(import) + 1) * 2 |
| ELSE |
| imp.OriginalFirstThunk := OriginalCurrentThunk; |
| imp.FirstThunk := CurrentThunk; |
| import.OriginalFirstThunk := OriginalCurrentThunk; |
| import.FirstThunk := CurrentThunk; |
| INC(OriginalCurrentThunk); |
| INC(CurrentThunk) |
| END; |
| imp := imp.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END |
| RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SizeOfWord |
| 237,40 → 258,40 |
| END GetImportSize; |
| PROCEDURE fixup* (program: BIN.PROGRAM; Address: VIRTUAL_ADDR; amd64: BOOLEAN); |
| PROCEDURE fixup (program: BIN.PROGRAM; Address: VIRTUAL_ADDR); |
| VAR |
| reloc: BIN.RELOC; |
| iproc: BIN.IMPRT; |
| code: CHL.BYTELIST; |
| L, delta, delta0, AdrImp, offset: INTEGER; |
| L, delta, delta0, AdrImp: INTEGER; |
| BEGIN |
| AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD; |
| code := program.code; |
| reloc := program.rel_list.first(BIN.RELOC); |
| delta0 := 3 - 7 * ORD(amd64) - Address.Code; |
| delta0 := 3 - 7 * ORD(bit64); |
| WHILE reloc # NIL DO |
| offset := reloc.offset; |
| L := BIN.get32le(code, offset); |
| delta := delta0 - offset; |
| L := BIN.get32le(code, reloc.offset); |
| delta := delta0 - reloc.offset - Address.Code; |
| CASE reloc.opcode OF |
| |BIN.PICDATA: |
| INC(delta, L + Address.Data) |
| BIN.put32le(code, reloc.offset, L + Address.Data + delta) |
| |BIN.PICCODE: |
| INC(delta, BIN.GetLabel(program, L) + Address.Code) |
| BIN.put32le(code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) |
| |BIN.PICBSS: |
| INC(delta, L + Address.Bss) |
| BIN.put32le(code, reloc.offset, L + Address.Bss + delta) |
| |BIN.PICIMP: |
| iproc := BIN.GetIProc(program, L); |
| INC(delta, iproc.FirstThunk * SizeOfWord + AdrImp) |
| BIN.put32le(code, reloc.offset, iproc.FirstThunk * SizeOfWord + AdrImp + delta) |
| END; |
| BIN.put32le(code, offset, delta); |
| reloc := reloc.next(BIN.RELOC) |
| END |
| 277,13 → 298,13 |
| END fixup; |
| PROCEDURE WriteWord (w: WORD); |
| PROCEDURE WriteWord (file: FILE; w: WORD); |
| BEGIN |
| WR.Write16LE(ORD(w)) |
| WR.Write16LE(file, ORD(w)) |
| END WriteWord; |
| PROCEDURE WriteName* (name: NAME); |
| PROCEDURE WriteName* (File: FILE; name: NAME); |
| VAR |
| i, nameLen: INTEGER; |
| 291,12 → 312,12 |
| nameLen := LENGTH(name); |
| FOR i := 0 TO nameLen - 1 DO |
| WR.WriteByte(ORD(name[i])) |
| WR.WriteByte(File, ORD(name[i])) |
| END; |
| i := LEN(name) - nameLen; |
| WHILE i > 0 DO |
| WR.WriteByte(0); |
| WR.WriteByte(File, 0); |
| DEC(i) |
| END |
| 303,7 → 324,7 |
| END WriteName; |
| PROCEDURE WriteSectionHeader* (h: IMAGE_SECTION_HEADER); |
| PROCEDURE WriteSectionHeader* (file: FILE; h: IMAGE_SECTION_HEADER); |
| VAR |
| i, nameLen: INTEGER; |
| 311,50 → 332,50 |
| nameLen := LENGTH(h.Name); |
| FOR i := 0 TO nameLen - 1 DO |
| WR.WriteByte(ORD(h.Name[i])) |
| WR.WriteByte(file, ORD(h.Name[i])) |
| END; |
| i := LEN(h.Name) - nameLen; |
| WHILE i > 0 DO |
| WR.WriteByte(0); |
| WR.WriteByte(file, 0); |
| DEC(i) |
| END; |
| WR.Write32LE(h.VirtualSize); |
| WR.Write32LE(h.VirtualAddress); |
| WR.Write32LE(h.SizeOfRawData); |
| WR.Write32LE(h.PointerToRawData); |
| WR.Write32LE(h.PointerToRelocations); |
| WR.Write32LE(h.PointerToLinenumbers); |
| WR.Write32LE(file, h.VirtualSize); |
| WR.Write32LE(file, h.VirtualAddress); |
| WR.Write32LE(file, h.SizeOfRawData); |
| WR.Write32LE(file, h.PointerToRawData); |
| WR.Write32LE(file, h.PointerToRelocations); |
| WR.Write32LE(file, h.PointerToLinenumbers); |
| WriteWord(h.NumberOfRelocations); |
| WriteWord(h.NumberOfLinenumbers); |
| WriteWord(file, h.NumberOfRelocations); |
| WriteWord(file, h.NumberOfLinenumbers); |
| WR.Write32LE(h.Characteristics) |
| WR.Write32LE(file, h.Characteristics) |
| END WriteSectionHeader; |
| PROCEDURE WriteFileHeader* (h: IMAGE_FILE_HEADER); |
| PROCEDURE WriteFileHeader* (file: FILE; h: IMAGE_FILE_HEADER); |
| BEGIN |
| WriteWord(h.Machine); |
| WriteWord(h.NumberOfSections); |
| WriteWord(file, h.Machine); |
| WriteWord(file, h.NumberOfSections); |
| WR.Write32LE(h.TimeDateStamp); |
| WR.Write32LE(h.PointerToSymbolTable); |
| WR.Write32LE(h.NumberOfSymbols); |
| WR.Write32LE(file, h.TimeDateStamp); |
| WR.Write32LE(file, h.PointerToSymbolTable); |
| WR.Write32LE(file, h.NumberOfSymbols); |
| WriteWord(h.SizeOfOptionalHeader); |
| WriteWord(h.Characteristics) |
| WriteWord(file, h.SizeOfOptionalHeader); |
| WriteWord(file, h.Characteristics) |
| END WriteFileHeader; |
| PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; console, dll, amd64: BOOLEAN); |
| VAR |
| i, n, temp: INTEGER; |
| i, n: INTEGER; |
| Size: RECORD |
| Code, Data, Bss, Import, Reloc, Export: INTEGER |
| Code, Data, Bss, Stack, Import, Reloc, Export: INTEGER |
| END; |
| 362,7 → 383,9 |
| Address: VIRTUAL_ADDR; |
| _import: BIN.IMPRT; |
| File: FILE; |
| import: BIN.IMPRT; |
| ImportTable: CHL.INTLIST; |
| ExportDir: IMAGE_EXPORT_DIRECTORY; |
| 369,93 → 392,99 |
| export: BIN.EXPRT; |
| PROCEDURE WriteExportDir (e: IMAGE_EXPORT_DIRECTORY); |
| PROCEDURE WriteExportDir (file: FILE; e: IMAGE_EXPORT_DIRECTORY); |
| BEGIN |
| WR.Write32LE(e.Characteristics); |
| WR.Write32LE(e.TimeDateStamp); |
| WR.Write32LE(file, e.Characteristics); |
| WR.Write32LE(file, e.TimeDateStamp); |
| WriteWord(e.MajorVersion); |
| WriteWord(e.MinorVersion); |
| WriteWord(file, e.MajorVersion); |
| WriteWord(file, e.MinorVersion); |
| WR.Write32LE(e.Name); |
| WR.Write32LE(e.Base); |
| WR.Write32LE(e.NumberOfFunctions); |
| WR.Write32LE(e.NumberOfNames); |
| WR.Write32LE(e.AddressOfFunctions); |
| WR.Write32LE(e.AddressOfNames); |
| WR.Write32LE(e.AddressOfNameOrdinals) |
| WR.Write32LE(file, e.Name); |
| WR.Write32LE(file, e.Base); |
| WR.Write32LE(file, e.NumberOfFunctions); |
| WR.Write32LE(file, e.NumberOfNames); |
| WR.Write32LE(file, e.AddressOfFunctions); |
| WR.Write32LE(file, e.AddressOfNames); |
| WR.Write32LE(file, e.AddressOfNameOrdinals) |
| END WriteExportDir; |
| PROCEDURE WriteOptHeader (h: IMAGE_OPTIONAL_HEADER; amd64: BOOLEAN); |
| PROCEDURE WriteOptHeader (file: FILE; h: IMAGE_OPTIONAL_HEADER); |
| VAR |
| i: INTEGER; |
| BEGIN |
| WriteWord(h.Magic); |
| WriteWord(file, h.Magic); |
| WR.WriteByte(h.MajorLinkerVersion); |
| WR.WriteByte(h.MinorLinkerVersion); |
| WR.WriteByte(file, h.MajorLinkerVersion); |
| WR.WriteByte(file, h.MinorLinkerVersion); |
| WR.Write32LE(h.SizeOfCode); |
| WR.Write32LE(h.SizeOfInitializedData); |
| WR.Write32LE(h.SizeOfUninitializedData); |
| WR.Write32LE(h.AddressOfEntryPoint); |
| WR.Write32LE(h.BaseOfCode); |
| WR.Write32LE(file, h.SizeOfCode); |
| WR.Write32LE(file, h.SizeOfInitializedData); |
| WR.Write32LE(file, h.SizeOfUninitializedData); |
| WR.Write32LE(file, h.AddressOfEntryPoint); |
| WR.Write32LE(file, h.BaseOfCode); |
| IF amd64 THEN |
| WR.Write64LE(h.ImageBase) |
| IF bit64 THEN |
| WR.Write64LE(file, h.ImageBase) |
| ELSE |
| WR.Write32LE(h.BaseOfData); |
| WR.Write32LE(h.ImageBase) |
| WR.Write32LE(file, h.BaseOfData); |
| WR.Write32LE(file, h.ImageBase) |
| END; |
| WR.Write32LE(h.SectionAlignment); |
| WR.Write32LE(h.FileAlignment); |
| WR.Write32LE(file, h.SectionAlignment); |
| WR.Write32LE(file, h.FileAlignment); |
| WriteWord(h.MajorOperatingSystemVersion); |
| WriteWord(h.MinorOperatingSystemVersion); |
| WriteWord(h.MajorImageVersion); |
| WriteWord(h.MinorImageVersion); |
| WriteWord(h.MajorSubsystemVersion); |
| WriteWord(h.MinorSubsystemVersion); |
| WriteWord(file, h.MajorOperatingSystemVersion); |
| WriteWord(file, h.MinorOperatingSystemVersion); |
| WriteWord(file, h.MajorImageVersion); |
| WriteWord(file, h.MinorImageVersion); |
| WriteWord(file, h.MajorSubsystemVersion); |
| WriteWord(file, h.MinorSubsystemVersion); |
| WR.Write32LE(h.Win32VersionValue); |
| WR.Write32LE(h.SizeOfImage); |
| WR.Write32LE(h.SizeOfHeaders); |
| WR.Write32LE(h.CheckSum); |
| WR.Write32LE(file, h.Win32VersionValue); |
| WR.Write32LE(file, h.SizeOfImage); |
| WR.Write32LE(file, h.SizeOfHeaders); |
| WR.Write32LE(file, h.CheckSum); |
| WriteWord(h.Subsystem); |
| WriteWord(h.DllCharacteristics); |
| WriteWord(file, h.Subsystem); |
| WriteWord(file, h.DllCharacteristics); |
| IF amd64 THEN |
| WR.Write64LE(h.SizeOfStackReserve); |
| WR.Write64LE(h.SizeOfStackCommit); |
| WR.Write64LE(h.SizeOfHeapReserve); |
| WR.Write64LE(h.SizeOfHeapCommit) |
| IF bit64 THEN |
| WR.Write64LE(file, h.SizeOfStackReserve); |
| WR.Write64LE(file, h.SizeOfStackCommit); |
| WR.Write64LE(file, h.SizeOfHeapReserve); |
| WR.Write64LE(file, h.SizeOfHeapCommit) |
| ELSE |
| WR.Write32LE(h.SizeOfStackReserve); |
| WR.Write32LE(h.SizeOfStackCommit); |
| WR.Write32LE(h.SizeOfHeapReserve); |
| WR.Write32LE(h.SizeOfHeapCommit) |
| WR.Write32LE(file, h.SizeOfStackReserve); |
| WR.Write32LE(file, h.SizeOfStackCommit); |
| WR.Write32LE(file, h.SizeOfHeapReserve); |
| WR.Write32LE(file, h.SizeOfHeapCommit) |
| END; |
| WR.Write32LE(h.LoaderFlags); |
| WR.Write32LE(h.NumberOfRvaAndSizes); |
| WR.Write32LE(file, h.LoaderFlags); |
| WR.Write32LE(file, h.NumberOfRvaAndSizes); |
| FOR i := 0 TO LEN(h.DataDirectory) - 1 DO |
| WR.Write32LE(h.DataDirectory[i].VirtualAddress); |
| WR.Write32LE(h.DataDirectory[i].Size) |
| WR.Write32LE(file, h.DataDirectory[i].VirtualAddress); |
| WR.Write32LE(file, h.DataDirectory[i].Size) |
| END |
| END WriteOptHeader; |
| PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; VirtualSize: INTEGER; Characteristics: DWORD); |
| PROCEDURE WritePEHeader (file: FILE; h: IMAGE_NT_HEADERS); |
| BEGIN |
| WR.Write(file, h.Signature, LEN(h.Signature)); |
| WriteFileHeader(file, h.FileHeader); |
| WriteOptHeader(file, h.OptionalHeader) |
| END WritePEHeader; |
| PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; Characteristics: DWORD); |
| BEGIN |
| section.Name := Name; |
| section.VirtualSize := VirtualSize; |
| section.SizeOfRawData := WR.align(VirtualSize, FileAlignment); |
| section.PointerToRelocations := 0; |
| section.PointerToLinenumbers := 0; |
| section.NumberOfRelocations := 0X; |
| 465,11 → 494,14 |
| BEGIN |
| SizeOfWord := SIZE_OF_DWORD * (ORD(amd64) + 1); |
| bit64 := amd64; |
| SizeOfWord := SIZE_OF_DWORD * (ORD(bit64) + 1); |
| Relocations := LISTS.create(NIL); |
| Size.Code := CHL.Length(program.code); |
| Size.Data := CHL.Length(program.data); |
| Size.Bss := program.bss; |
| Size.Stack := program.stack; |
| IF dll THEN |
| BaseAddress := 10000000H |
| 477,109 → 509,123 |
| BaseAddress := 400000H |
| END; |
| Signature[0] := 50H; |
| Signature[1] := 45H; |
| Signature[2] := 0; |
| Signature[3] := 0; |
| PEHeader.Signature[0] := 50H; |
| PEHeader.Signature[1] := 45H; |
| PEHeader.Signature[2] := 0; |
| PEHeader.Signature[3] := 0; |
| IF amd64 THEN |
| FileHeader.Machine := 08664X |
| PEHeader.FileHeader.Machine := 08664X |
| ELSE |
| FileHeader.Machine := 014CX |
| PEHeader.FileHeader.Machine := 014CX |
| END; |
| FileHeader.NumberOfSections := WCHR(4 + ORD(dll)); |
| PEHeader.FileHeader.NumberOfSections := WCHR(4 + ORD(dll)); |
| FileHeader.TimeDateStamp := UTILS.UnixTime(); |
| FileHeader.PointerToSymbolTable := 0H; |
| FileHeader.NumberOfSymbols := 0H; |
| FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64)); |
| FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll)); |
| PEHeader.FileHeader.TimeDateStamp := UTILS.UnixTime(); |
| PEHeader.FileHeader.PointerToSymbolTable := 0H; |
| PEHeader.FileHeader.NumberOfSymbols := 0H; |
| PEHeader.FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64)); |
| PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll)); |
| OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64)); |
| OptionalHeader.MajorLinkerVersion := UTILS.vMajor; |
| OptionalHeader.MinorLinkerVersion := UTILS.vMinor; |
| OptionalHeader.SizeOfCode := WR.align(Size.Code, FileAlignment); |
| OptionalHeader.SizeOfInitializedData := 0; |
| OptionalHeader.SizeOfUninitializedData := 0; |
| OptionalHeader.AddressOfEntryPoint := SectionAlignment; |
| OptionalHeader.BaseOfCode := SectionAlignment; |
| OptionalHeader.BaseOfData := OptionalHeader.BaseOfCode + WR.align(Size.Code, SectionAlignment); |
| OptionalHeader.ImageBase := BaseAddress; |
| OptionalHeader.SectionAlignment := SectionAlignment; |
| OptionalHeader.FileAlignment := FileAlignment; |
| OptionalHeader.MajorOperatingSystemVersion := 1X; |
| OptionalHeader.MinorOperatingSystemVersion := 0X; |
| OptionalHeader.MajorImageVersion := 0X; |
| OptionalHeader.MinorImageVersion := 0X; |
| OptionalHeader.MajorSubsystemVersion := 4X; |
| OptionalHeader.MinorSubsystemVersion := 0X; |
| OptionalHeader.Win32VersionValue := 0H; |
| OptionalHeader.SizeOfImage := SectionAlignment; |
| OptionalHeader.SizeOfHeaders := 400H; |
| OptionalHeader.CheckSum := 0; |
| OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll)); |
| OptionalHeader.DllCharacteristics := 0040X; |
| OptionalHeader.SizeOfStackReserve := 100000H; |
| OptionalHeader.SizeOfStackCommit := 10000H; |
| OptionalHeader.SizeOfHeapReserve := 100000H; |
| OptionalHeader.SizeOfHeapCommit := 10000H; |
| OptionalHeader.LoaderFlags := 0; |
| OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES; |
| PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64)); |
| PEHeader.OptionalHeader.MajorLinkerVersion := UTILS.vMajor; |
| PEHeader.OptionalHeader.MinorLinkerVersion := UTILS.vMinor; |
| PEHeader.OptionalHeader.SizeOfCode := align(Size.Code, FileAlignment); |
| PEHeader.OptionalHeader.SizeOfInitializedData := 0; |
| PEHeader.OptionalHeader.SizeOfUninitializedData := 0; |
| PEHeader.OptionalHeader.AddressOfEntryPoint := SectionAlignment; |
| PEHeader.OptionalHeader.BaseOfCode := SectionAlignment; |
| PEHeader.OptionalHeader.BaseOfData := PEHeader.OptionalHeader.BaseOfCode + align(Size.Code, SectionAlignment); |
| PEHeader.OptionalHeader.ImageBase := BaseAddress; |
| PEHeader.OptionalHeader.SectionAlignment := SectionAlignment; |
| PEHeader.OptionalHeader.FileAlignment := FileAlignment; |
| PEHeader.OptionalHeader.MajorOperatingSystemVersion := 1X; |
| PEHeader.OptionalHeader.MinorOperatingSystemVersion := 0X; |
| PEHeader.OptionalHeader.MajorImageVersion := 0X; |
| PEHeader.OptionalHeader.MinorImageVersion := 0X; |
| PEHeader.OptionalHeader.MajorSubsystemVersion := 4X; |
| PEHeader.OptionalHeader.MinorSubsystemVersion := 0X; |
| PEHeader.OptionalHeader.Win32VersionValue := 0H; |
| PEHeader.OptionalHeader.SizeOfImage := SectionAlignment; |
| PEHeader.OptionalHeader.SizeOfHeaders := 400H; |
| PEHeader.OptionalHeader.CheckSum := 0; |
| PEHeader.OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll)); |
| PEHeader.OptionalHeader.DllCharacteristics := 0040X; |
| PEHeader.OptionalHeader.SizeOfStackReserve := Size.Stack; |
| PEHeader.OptionalHeader.SizeOfStackCommit := Size.Stack DIV 16; |
| PEHeader.OptionalHeader.SizeOfHeapReserve := 100000H; |
| PEHeader.OptionalHeader.SizeOfHeapCommit := 10000H; |
| PEHeader.OptionalHeader.LoaderFlags := 0; |
| PEHeader.OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES; |
| FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO |
| OptionalHeader.DataDirectory[i].VirtualAddress := 0; |
| OptionalHeader.DataDirectory[i].Size := 0 |
| END; |
| InitSection(SectionHeaders[0], ".text", Size.Code, SHC_text); |
| InitSection(SectionHeaders[0], ".text", SHC_text); |
| SectionHeaders[0].VirtualSize := Size.Code; |
| SectionHeaders[0].VirtualAddress := SectionAlignment; |
| SectionHeaders[0].PointerToRawData := OptionalHeader.SizeOfHeaders; |
| SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment); |
| SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders; |
| InitSection(SectionHeaders[1], ".data", Size.Data, SHC_data); |
| SectionHeaders[1].VirtualAddress := WR.align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment); |
| InitSection(SectionHeaders[1], ".data", SHC_data); |
| SectionHeaders[1].VirtualSize := Size.Data; |
| SectionHeaders[1].VirtualAddress := align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment); |
| SectionHeaders[1].SizeOfRawData := align(Size.Data, FileAlignment); |
| SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData; |
| InitSection(SectionHeaders[2], ".bss", Size.Bss, SHC_bss); |
| SectionHeaders[2].VirtualAddress := WR.align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment); |
| InitSection(SectionHeaders[2], ".bss", SHC_bss); |
| SectionHeaders[2].VirtualSize := Size.Bss; |
| SectionHeaders[2].VirtualAddress := align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment); |
| SectionHeaders[2].SizeOfRawData := 0; |
| SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData; |
| SectionHeaders[2].SizeOfRawData := 0; |
| Size.Import := GetImportSize(program.imp_list); |
| InitSection(SectionHeaders[3], ".idata", Size.Import + CHL.Length(program._import), SHC_data); |
| SectionHeaders[3].VirtualAddress := WR.align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment); |
| InitSection(SectionHeaders[3], ".idata", SHC_data); |
| SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import); |
| SectionHeaders[3].VirtualAddress := align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment); |
| SectionHeaders[3].SizeOfRawData := align(SectionHeaders[3].VirtualSize, FileAlignment); |
| SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData; |
| Address.Code := SectionHeaders[0].VirtualAddress + OptionalHeader.ImageBase; |
| Address.Data := SectionHeaders[1].VirtualAddress + OptionalHeader.ImageBase; |
| Address.Bss := SectionHeaders[2].VirtualAddress + OptionalHeader.ImageBase; |
| Address.Import := SectionHeaders[3].VirtualAddress + OptionalHeader.ImageBase; |
| Address.Code := SectionHeaders[0].VirtualAddress + PEHeader.OptionalHeader.ImageBase; |
| Address.Data := SectionHeaders[1].VirtualAddress + PEHeader.OptionalHeader.ImageBase; |
| Address.Bss := SectionHeaders[2].VirtualAddress + PEHeader.OptionalHeader.ImageBase; |
| Address.Import := SectionHeaders[3].VirtualAddress + PEHeader.OptionalHeader.ImageBase; |
| fixup(program, Address, amd64); |
| fixup(program, Address); |
| IF dll THEN |
| Size.Export := Export(program, SectionHeaders[1].VirtualAddress + program.modname, ExportDir); |
| Size.Export := Export(program, SectionHeaders[1].VirtualAddress, ExportDir); |
| InitSection(SectionHeaders[4], ".edata", Size.Export + CHL.Length(program.export), SHC_data); |
| SectionHeaders[4].VirtualAddress := WR.align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment); |
| InitSection(SectionHeaders[4], ".edata", SHC_data); |
| SectionHeaders[4].VirtualSize := Size.Export + CHL.Length(program.export); |
| SectionHeaders[4].VirtualAddress := align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment); |
| SectionHeaders[4].SizeOfRawData := align(SectionHeaders[4].VirtualSize, FileAlignment); |
| SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData; |
| END; |
| OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress; |
| OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize |
| FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO |
| PEHeader.OptionalHeader.DataDirectory[i].VirtualAddress := 0; |
| PEHeader.OptionalHeader.DataDirectory[i].Size := 0 |
| END; |
| OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress; |
| OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize; |
| IF dll THEN |
| PEHeader.OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress; |
| PEHeader.OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize |
| END; |
| FOR i := 1 TO ORD(FileHeader.NumberOfSections) - 1 DO |
| INC(OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData) |
| PEHeader.OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress; |
| PEHeader.OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize; |
| FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO |
| INC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData) |
| END; |
| OptionalHeader.SizeOfUninitializedData := WR.align(SectionHeaders[2].VirtualSize, FileAlignment); |
| DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[0].SizeOfRawData); |
| DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[2].SizeOfRawData); |
| FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO |
| INC(OptionalHeader.SizeOfImage, WR.align(SectionHeaders[i].VirtualSize, SectionAlignment)) |
| PEHeader.OptionalHeader.SizeOfUninitializedData := align(SectionHeaders[2].VirtualSize, FileAlignment); |
| FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO |
| INC(PEHeader.OptionalHeader.SizeOfImage, align(SectionHeaders[i].VirtualSize, SectionAlignment)) |
| END; |
| n := 0; |
| 588,25 → 634,23 |
| BIN.InitArray(msdos, n, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F"); |
| BIN.InitArray(msdos, n, "742062652072756E20696E20444F53206D6F64652E0D0A240000000000000000"); |
| WR.Create(FileName); |
| File := WR.Create(FileName); |
| WR.Write(msdos, LEN(msdos)); |
| WR.Write(File, msdos, LEN(msdos)); |
| WR.Write(Signature, LEN(Signature)); |
| WriteFileHeader(FileHeader); |
| WriteOptHeader(OptionalHeader, amd64); |
| WritePEHeader(File, PEHeader); |
| FOR i := 0 TO ORD(FileHeader.NumberOfSections) - 1 DO |
| WriteSectionHeader(SectionHeaders[i]) |
| FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO |
| WriteSectionHeader(File, SectionHeaders[i]) |
| END; |
| WR.Padding(FileAlignment); |
| WR.Padding(File, FileAlignment); |
| CHL.WriteToFile(program.code); |
| WR.Padding(FileAlignment); |
| CHL.WriteToFile(File, program.code); |
| WR.Padding(File, FileAlignment); |
| CHL.WriteToFile(program.data); |
| WR.Padding(FileAlignment); |
| CHL.WriteToFile(File, program.data); |
| WR.Padding(File, FileAlignment); |
| n := (libcnt + 1) * 5; |
| ImportTable := CHL.CreateIntList(); |
| 616,17 → 660,17 |
| END; |
| i := 0; |
| _import := program.imp_list.first(BIN.IMPRT); |
| WHILE _import # NIL DO |
| IF _import.label = 0 THEN |
| CHL.SetInt(ImportTable, i + 0, _import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
| import := program.imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF import.label = 0 THEN |
| CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
| CHL.SetInt(ImportTable, i + 1, 0); |
| CHL.SetInt(ImportTable, i + 2, 0); |
| CHL.SetInt(ImportTable, i + 3, _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress); |
| CHL.SetInt(ImportTable, i + 4, _import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
| INC(i, 5) |
| CHL.SetInt(ImportTable, i + 3, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress); |
| CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SizeOfWord + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); |
| i := i + 5 |
| END; |
| _import := _import.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END; |
| CHL.SetInt(ImportTable, i + 0, 0); |
| 635,30 → 679,29 |
| CHL.SetInt(ImportTable, i + 3, 0); |
| CHL.SetInt(ImportTable, i + 4, 0); |
| _import := program.imp_list.first(BIN.IMPRT); |
| WHILE _import # NIL DO |
| IF _import.label # 0 THEN |
| temp := _import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2; |
| CHL.SetInt(ImportTable, _import.OriginalFirstThunk + n, temp); |
| CHL.SetInt(ImportTable, _import.FirstThunk + n, temp) |
| import := program.imp_list.first(BIN.IMPRT); |
| WHILE import # NIL DO |
| IF import.label # 0 THEN |
| CHL.SetInt(ImportTable, import.OriginalFirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2); |
| CHL.SetInt(ImportTable, import.FirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2) |
| END; |
| _import := _import.next(BIN.IMPRT) |
| import := import.next(BIN.IMPRT) |
| END; |
| FOR i := 0 TO n - 1 DO |
| WR.Write32LE(CHL.GetInt(ImportTable, i)) |
| WR.Write32LE(File, CHL.GetInt(ImportTable, i)) |
| END; |
| FOR i := n TO CHL.Length(ImportTable) - 1 DO |
| IF amd64 THEN |
| WR.Write64LE(CHL.GetInt(ImportTable, i)) |
| WR.Write64LE(File, CHL.GetInt(ImportTable, i)) |
| ELSE |
| WR.Write32LE(CHL.GetInt(ImportTable, i)) |
| WR.Write32LE(File, CHL.GetInt(ImportTable, i)) |
| END |
| END; |
| CHL.WriteToFile(program._import); |
| WR.Padding(FileAlignment); |
| CHL.WriteToFile(File, program.import); |
| WR.Padding(File, FileAlignment); |
| IF dll THEN |
| 666,29 → 709,29 |
| INC(ExportDir.AddressOfNames, SectionHeaders[4].VirtualAddress); |
| INC(ExportDir.AddressOfNameOrdinals, SectionHeaders[4].VirtualAddress); |
| WriteExportDir(ExportDir); |
| WriteExportDir(File, ExportDir); |
| export := program.exp_list.first(BIN.EXPRT); |
| WHILE export # NIL DO |
| WR.Write32LE(export.label + SectionHeaders[0].VirtualAddress); |
| WR.Write32LE(File, export.label + SectionHeaders[0].VirtualAddress); |
| export := export.next(BIN.EXPRT) |
| END; |
| export := program.exp_list.first(BIN.EXPRT); |
| WHILE export # NIL DO |
| WR.Write32LE(export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress); |
| WR.Write32LE(File, export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress); |
| export := export.next(BIN.EXPRT) |
| END; |
| FOR i := 0 TO ExportDir.NumberOfFunctions - 1 DO |
| WriteWord(WCHR(i)) |
| WriteWord(File, WCHR(i)) |
| END; |
| CHL.WriteToFile(program.export); |
| WR.Padding(FileAlignment) |
| CHL.WriteToFile(File, program.export); |
| WR.Padding(File, FileAlignment) |
| END; |
| WR.Close |
| WR.Close(File) |
| END write; |
| /programs/develop/oberon07/Source/PROG.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE PROG; |
| IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS, STRINGS; |
| IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, IL, UTILS, TARGETS; |
| CONST |
| 24,7 → 24,7 |
| tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4; |
| tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8; |
| tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12; |
| tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; tNONE* = 16; |
| tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; |
| BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR}; |
| 40,15 → 40,15 |
| sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34; |
| sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38; |
| sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42; |
| sysDINT* = 43;*)sysGET8* = 44; sysGET16* = 45; sysGET32* = 46; |
| sysDINT* = 43;*) |
| default32* = 2; _default32* = default32 + 1; |
| default32* = 2; |
| stdcall* = 4; _stdcall* = stdcall + 1; |
| ccall* = 6; _ccall* = ccall + 1; |
| ccall16* = 8; _ccall16* = ccall16 + 1; |
| win64* = 10; _win64* = win64 + 1; |
| stdcall64* = 12; _stdcall64* = stdcall64 + 1; |
| default64* = 14; _default64* = default64 + 1; |
| default64* = 14; |
| systemv* = 16; _systemv* = systemv + 1; |
| default16* = 18; |
| code* = 20; _code* = code + 1; |
| 59,10 → 59,10 |
| sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3; |
| sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7; |
| sf_code* = 8; sf_oberon* = 9; |
| sf_noalign* = 10; |
| sf_code* = 8; |
| sf_noalign* = 9; |
| proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon}; |
| proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code}; |
| rec_flags* = {sf_noalign}; |
| STACK_FRAME = 2; |
| 73,7 → 73,7 |
| OPTIONS* = RECORD |
| version*, stack*, ram*, rom*: INTEGER; |
| pic*, lower*: BOOLEAN; |
| pic*: BOOLEAN; |
| checking*: SET |
| END; |
| 82,11 → 82,13 |
| UNIT* = POINTER TO rUNIT; |
| _TYPE* = POINTER TO rTYPE; |
| PROGRAM* = POINTER TO rPROGRAM; |
| TYPE_* = POINTER TO rTYPE_; |
| FRWPTR* = POINTER TO RECORD (LISTS.ITEM) |
| _type: _TYPE; |
| type: TYPE_; |
| baseIdent: SCAN.IDENT; |
| linked: BOOLEAN; |
| 100,7 → 102,7 |
| label*: INTEGER; |
| used*: BOOLEAN; |
| processed*: BOOLEAN; |
| _import*: LISTS.ITEM; |
| import*: LISTS.ITEM; |
| using*: LISTS.LIST; |
| enter*, |
| leave*: LISTS.ITEM |
| 115,6 → 117,7 |
| rUNIT = RECORD (LISTS.ITEM) |
| program*: PROGRAM; |
| name*: SCAN.IDENT; |
| idents*: LISTS.LIST; |
| frwPointers: LISTS.LIST; |
| 130,7 → 133,7 |
| PARAM* = POINTER TO rPARAM; |
| rTYPE = RECORD (LISTS.ITEM) |
| rTYPE_ = RECORD (LISTS.ITEM) |
| typ*: INTEGER; |
| size*: INTEGER; |
| 137,7 → 140,7 |
| parSize*: INTEGER; |
| length*: INTEGER; |
| align*: INTEGER; |
| base*: _TYPE; |
| base*: TYPE_; |
| fields*: LISTS.LIST; |
| params*: LISTS.LIST; |
| unit*: UNIT; |
| 144,7 → 147,7 |
| closed*: BOOLEAN; |
| num*: INTEGER; |
| call*: INTEGER; |
| _import*: BOOLEAN; |
| import*: BOOLEAN; |
| noalign*: BOOLEAN |
| END; |
| 151,7 → 154,7 |
| rFIELD = RECORD (LISTS.ITEM) |
| _type*: _TYPE; |
| type*: TYPE_; |
| name*: SCAN.IDENT; |
| export*: BOOLEAN; |
| offset*: INTEGER |
| 161,7 → 164,7 |
| rPARAM = RECORD (LISTS.ITEM) |
| name*: SCAN.IDENT; |
| _type*: _TYPE; |
| type*: TYPE_; |
| vPar*: BOOLEAN; |
| offset*: INTEGER |
| 172,10 → 175,10 |
| name*: SCAN.IDENT; |
| typ*: INTEGER; |
| export*: BOOLEAN; |
| _import*: LISTS.ITEM; |
| import*: LISTS.ITEM; |
| unit*: UNIT; |
| value*: ARITH.VALUE; |
| _type*: _TYPE; |
| type*: TYPE_; |
| stproc*: INTEGER; |
| global*: BOOLEAN; |
| scopeLvl*: INTEGER; |
| 185,7 → 188,7 |
| END; |
| PROGRAM = RECORD |
| rPROGRAM = RECORD |
| recCount: INTEGER; |
| units*: LISTS.LIST; |
| 203,20 → 206,18 |
| stTypes*: RECORD |
| tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, |
| tSTRING*, tNIL*, tCARD32*, tANYREC*, tNONE*: _TYPE |
| tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_ |
| END |
| END; |
| DELIMPORT = PROCEDURE (_import: LISTS.ITEM); |
| DELIMPORT = PROCEDURE (import: LISTS.ITEM); |
| VAR |
| LowerCase: BOOLEAN; |
| idents: C.COLLECTION; |
| program*: PROGRAM; |
| PROCEDURE NewIdent (): IDENT; |
| 236,15 → 237,15 |
| END NewIdent; |
| PROCEDURE getOffset* (varIdent: IDENT): INTEGER; |
| PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER; |
| VAR |
| size: INTEGER; |
| BEGIN |
| IF varIdent.offset = -1 THEN |
| size := varIdent._type.size; |
| size := varIdent.type.size; |
| IF varIdent.global THEN |
| IF UTILS.Align(program.bss, varIdent._type.align) THEN |
| IF UTILS.Align(program.bss, varIdent.type.align) THEN |
| IF UTILS.maxint - program.bss >= size THEN |
| varIdent.offset := program.bss; |
| INC(program.bss, size) |
| 280,7 → 281,7 |
| IF (ident.typ = idVAR) & (ident.offset = -1) THEN |
| ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0); |
| IF ident.export THEN |
| offset := getOffset(ident) |
| offset := getOffset(unit.program, ident) |
| END |
| END; |
| ident := ident.prev(IDENT) |
| 321,6 → 322,7 |
| item: IDENT; |
| res: BOOLEAN; |
| proc: PROC; |
| procs: LISTS.LIST; |
| BEGIN |
| ASSERT(unit # NIL); |
| 335,8 → 337,8 |
| item.typ := typ; |
| item.unit := NIL; |
| item.export := FALSE; |
| item._import := NIL; |
| item._type := NIL; |
| item.import := NIL; |
| item.type := NIL; |
| item.value.typ := 0; |
| item.stproc := 0; |
| 346,12 → 348,13 |
| IF item.typ IN {idPROC, idIMP} THEN |
| NEW(proc); |
| proc._import := NIL; |
| proc.import := NIL; |
| proc.label := 0; |
| proc.used := FALSE; |
| proc.processed := FALSE; |
| proc.using := LISTS.create(NIL); |
| LISTS.push(program.procs, proc); |
| procs := unit.program.procs; |
| LISTS.push(procs, proc); |
| item.proc := proc |
| END; |
| 390,16 → 393,16 |
| END UseProc; |
| PROCEDURE setVarsType* (unit: UNIT; _type: _TYPE); |
| PROCEDURE setVarsType* (unit: UNIT; type: TYPE_); |
| VAR |
| item: IDENT; |
| BEGIN |
| ASSERT(_type # NIL); |
| ASSERT(type # NIL); |
| item := unit.idents.last(IDENT); |
| WHILE (item # NIL) & (item.typ = idVAR) & (item._type = NIL) DO |
| item._type := _type; |
| WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO |
| item.type := type; |
| item := item.prev(IDENT) |
| END |
| END setVarsType; |
| 478,10 → 481,10 |
| ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0) |
| END; |
| IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN |
| IF del._type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN |
| IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN |
| lvar := IL.NewVar(); |
| lvar.offset := del.offset; |
| lvar.size := del._type.size; |
| lvar.size := del.type.size; |
| IF del.typ = idVAR THEN |
| lvar.offset := -lvar.offset |
| END; |
| 501,18 → 504,18 |
| END closeScope; |
| PROCEDURE frwPtr* (unit: UNIT; _type: _TYPE; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); |
| PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); |
| VAR |
| newptr: FRWPTR; |
| BEGIN |
| ASSERT(unit # NIL); |
| ASSERT(_type # NIL); |
| ASSERT(type # NIL); |
| ASSERT(baseIdent # NIL); |
| NEW(newptr); |
| newptr._type := _type; |
| newptr.type := type; |
| newptr.baseIdent := baseIdent; |
| newptr.pos := pos; |
| newptr.linked := FALSE; |
| 536,8 → 539,8 |
| ident := getIdent(unit, item.baseIdent, TRUE); |
| IF (ident # NIL) THEN |
| IF (ident.typ = idTYPE) & (ident._type.typ = tRECORD) THEN |
| item._type.base := ident._type; |
| IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN |
| item.type.base := ident.type; |
| item.linked := TRUE |
| ELSE |
| item.notRecord := TRUE; |
| 555,7 → 558,7 |
| END linkPtr; |
| PROCEDURE isTypeEq* (t1, t2: _TYPE): BOOLEAN; |
| PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| param1, param2: LISTS.ITEM; |
| 573,7 → 576,7 |
| res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL)); |
| WHILE res & (param1 # NIL) & (param2 # NIL) DO |
| res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM)._type, param2(PARAM)._type); |
| res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type); |
| param1 := param1.next; |
| param2 := param2.next; |
| res := res & ((param1 # NIL) = (param2 # NIL)) |
| 591,7 → 594,7 |
| END isTypeEq; |
| PROCEDURE isBaseOf* (t0, t1: _TYPE): BOOLEAN; |
| PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| 614,12 → 617,12 |
| END isBaseOf; |
| PROCEDURE isOpenArray* (t: _TYPE): BOOLEAN; |
| PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN; |
| RETURN (t.typ = tARRAY) & (t.length = 0) |
| END isOpenArray; |
| PROCEDURE arrcomp* (src, dst: _TYPE): BOOLEAN; |
| PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN; |
| RETURN (dst.typ = tARRAY) & isOpenArray(src) & |
| ~isOpenArray(src.base) & ~isOpenArray(dst.base) & |
| isTypeEq(src.base, dst.base) |
| 626,7 → 629,7 |
| END arrcomp; |
| PROCEDURE getUnit* (name: SCAN.IDENT): UNIT; |
| PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
| VAR |
| item: UNIT; |
| 639,7 → 642,7 |
| item := item.next(UNIT) |
| END; |
| IF (item = NIL) & ((name.s = "SYSTEM") OR LowerCase & (name.s = "system")) THEN |
| IF (item = NIL) & (name.s = "SYSTEM") THEN |
| item := program.sysunit |
| END |
| 647,40 → 650,36 |
| END getUnit; |
| PROCEDURE enterStTypes (unit: UNIT); |
| PROCEDURE enter (unit: UNIT; name: SCAN.LEXSTR; _type: _TYPE); |
| PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM); |
| VAR |
| ident: IDENT; |
| upper: SCAN.LEXSTR; |
| BEGIN |
| IF LowerCase THEN |
| ident := addIdent(unit, SCAN.enterid(name), idTYPE); |
| ident._type := _type |
| END; |
| upper := name; |
| STRINGS.UpCase(upper); |
| ident := addIdent(unit, SCAN.enterid(upper), idTYPE); |
| ident._type := _type |
| END enter; |
| ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE); |
| ident.type := program.stTypes.tINTEGER; |
| ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE); |
| ident.type := program.stTypes.tBYTE; |
| BEGIN |
| enter(unit, "integer", program.stTypes.tINTEGER); |
| enter(unit, "byte", program.stTypes.tBYTE); |
| enter(unit, "char", program.stTypes.tCHAR); |
| enter(unit, "set", program.stTypes.tSET); |
| enter(unit, "boolean", program.stTypes.tBOOLEAN); |
| ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE); |
| ident.type := program.stTypes.tCHAR; |
| ident := addIdent(unit, SCAN.enterid("SET"), idTYPE); |
| ident.type := program.stTypes.tSET; |
| ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); |
| ident.type := program.stTypes.tBOOLEAN; |
| IF TARGETS.RealSize # 0 THEN |
| enter(unit, "real", program.stTypes.tREAL) |
| ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE); |
| ident.type := program.stTypes.tREAL |
| END; |
| IF TARGETS.BitDepth >= 32 THEN |
| enter(unit, "wchar", program.stTypes.tWCHAR) |
| ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE); |
| ident.type := program.stTypes.tWCHAR |
| END |
| END enterStTypes; |
| 690,19 → 689,9 |
| PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER); |
| VAR |
| ident: IDENT; |
| upper: SCAN.LEXSTR; |
| BEGIN |
| IF LowerCase THEN |
| ident := addIdent(unit, SCAN.enterid(name), idSTPROC); |
| ident.stproc := proc; |
| ident._type := program.stTypes.tNONE |
| END; |
| upper := name; |
| STRINGS.UpCase(upper); |
| ident := addIdent(unit, SCAN.enterid(upper), idSTPROC); |
| ident.stproc := proc; |
| ident._type := program.stTypes.tNONE |
| ident.stproc := proc |
| END EnterProc; |
| 709,72 → 698,64 |
| PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER); |
| VAR |
| ident: IDENT; |
| upper: SCAN.LEXSTR; |
| BEGIN |
| IF LowerCase THEN |
| ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); |
| ident.stproc := func; |
| ident._type := program.stTypes.tNONE |
| END; |
| upper := name; |
| STRINGS.UpCase(upper); |
| ident := addIdent(unit, SCAN.enterid(upper), idSTFUNC); |
| ident.stproc := func; |
| ident._type := program.stTypes.tNONE |
| ident.stproc := func |
| END EnterFunc; |
| BEGIN |
| EnterProc(unit, "assert", stASSERT); |
| EnterProc(unit, "dec", stDEC); |
| EnterProc(unit, "excl", stEXCL); |
| EnterProc(unit, "inc", stINC); |
| EnterProc(unit, "incl", stINCL); |
| EnterProc(unit, "new", stNEW); |
| EnterProc(unit, "copy", stCOPY); |
| EnterProc(unit, "ASSERT", stASSERT); |
| EnterProc(unit, "DEC", stDEC); |
| EnterProc(unit, "EXCL", stEXCL); |
| EnterProc(unit, "INC", stINC); |
| EnterProc(unit, "INCL", stINCL); |
| EnterProc(unit, "NEW", stNEW); |
| EnterProc(unit, "COPY", stCOPY); |
| EnterFunc(unit, "abs", stABS); |
| EnterFunc(unit, "asr", stASR); |
| EnterFunc(unit, "chr", stCHR); |
| EnterFunc(unit, "len", stLEN); |
| EnterFunc(unit, "lsl", stLSL); |
| EnterFunc(unit, "odd", stODD); |
| EnterFunc(unit, "ord", stORD); |
| EnterFunc(unit, "ror", stROR); |
| EnterFunc(unit, "bits", stBITS); |
| EnterFunc(unit, "lsr", stLSR); |
| EnterFunc(unit, "length", stLENGTH); |
| EnterFunc(unit, "min", stMIN); |
| EnterFunc(unit, "max", stMAX); |
| EnterFunc(unit, "ABS", stABS); |
| EnterFunc(unit, "ASR", stASR); |
| EnterFunc(unit, "CHR", stCHR); |
| EnterFunc(unit, "LEN", stLEN); |
| EnterFunc(unit, "LSL", stLSL); |
| EnterFunc(unit, "ODD", stODD); |
| EnterFunc(unit, "ORD", stORD); |
| EnterFunc(unit, "ROR", stROR); |
| EnterFunc(unit, "BITS", stBITS); |
| EnterFunc(unit, "LSR", stLSR); |
| EnterFunc(unit, "LENGTH", stLENGTH); |
| EnterFunc(unit, "MIN", stMIN); |
| EnterFunc(unit, "MAX", stMAX); |
| IF TARGETS.RealSize # 0 THEN |
| EnterProc(unit, "pack", stPACK); |
| EnterProc(unit, "unpk", stUNPK); |
| EnterFunc(unit, "floor", stFLOOR); |
| EnterFunc(unit, "flt", stFLT) |
| EnterProc(unit, "PACK", stPACK); |
| EnterProc(unit, "UNPK", stUNPK); |
| EnterFunc(unit, "FLOOR", stFLOOR); |
| EnterFunc(unit, "FLT", stFLT) |
| END; |
| IF TARGETS.BitDepth >= 32 THEN |
| EnterFunc(unit, "wchr", stWCHR) |
| EnterFunc(unit, "WCHR", stWCHR) |
| END; |
| IF TARGETS.Dispose THEN |
| EnterProc(unit, "dispose", stDISPOSE) |
| EnterProc(unit, "DISPOSE", stDISPOSE) |
| END |
| END enterStProcs; |
| PROCEDURE newUnit* (name: SCAN.IDENT): UNIT; |
| PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
| VAR |
| unit: UNIT; |
| BEGIN |
| ASSERT(program # NIL); |
| ASSERT(name # NIL); |
| NEW(unit); |
| unit.program := program; |
| unit.name := name; |
| unit.closed := FALSE; |
| unit.idents := LISTS.create(NIL); |
| 782,7 → 763,7 |
| ASSERT(openScope(unit, NIL)); |
| enterStTypes(unit); |
| enterStTypes(unit, program); |
| enterStProcs(unit); |
| ASSERT(openScope(unit, NIL)); |
| 804,7 → 785,7 |
| END newUnit; |
| PROCEDURE getField* (self: _TYPE; name: SCAN.IDENT; unit: UNIT): FIELD; |
| PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; |
| VAR |
| field: FIELD; |
| 836,7 → 817,7 |
| END getField; |
| PROCEDURE addField* (self: _TYPE; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; |
| PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; |
| VAR |
| field: FIELD; |
| res: BOOLEAN; |
| 851,7 → 832,7 |
| field.name := name; |
| field.export := export; |
| field._type := NIL; |
| field.type := NIL; |
| field.offset := self.size; |
| LISTS.push(self.fields, field) |
| 861,33 → 842,33 |
| END addField; |
| PROCEDURE setFields* (self: _TYPE; _type: _TYPE): BOOLEAN; |
| PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN; |
| VAR |
| item: FIELD; |
| res: BOOLEAN; |
| BEGIN |
| ASSERT(_type # NIL); |
| ASSERT(type # NIL); |
| item := self.fields.first(FIELD); |
| WHILE (item # NIL) & (item._type # NIL) DO |
| WHILE (item # NIL) & (item.type # NIL) DO |
| item := item.next(FIELD) |
| END; |
| res := TRUE; |
| WHILE res & (item # NIL) & (item._type = NIL) DO |
| item._type := _type; |
| WHILE res & (item # NIL) & (item.type = NIL) DO |
| item.type := type; |
| IF ~self.noalign THEN |
| res := UTILS.Align(self.size, _type.align) |
| res := UTILS.Align(self.size, type.align) |
| ELSE |
| res := TRUE |
| END; |
| item.offset := self.size; |
| res := res & (UTILS.maxint - self.size >= _type.size); |
| res := res & (UTILS.maxint - self.size >= type.size); |
| IF res THEN |
| INC(self.size, _type.size) |
| INC(self.size, type.size) |
| END; |
| item := item.next(FIELD) |
| END |
| 896,7 → 877,7 |
| END setFields; |
| PROCEDURE getParam* (self: _TYPE; name: SCAN.IDENT): PARAM; |
| PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM; |
| VAR |
| item: PARAM; |
| 913,7 → 894,7 |
| END getParam; |
| PROCEDURE addParam* (self: _TYPE; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; |
| PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; |
| VAR |
| param: PARAM; |
| res: BOOLEAN; |
| 927,7 → 908,7 |
| NEW(param); |
| param.name := name; |
| param._type := NIL; |
| param.type := NIL; |
| param.vPar := vPar; |
| LISTS.push(self.params, param) |
| 937,7 → 918,7 |
| END addParam; |
| PROCEDURE Dim* (t: _TYPE): INTEGER; |
| PROCEDURE Dim* (t: TYPE_): INTEGER; |
| VAR |
| res: INTEGER; |
| 951,7 → 932,7 |
| END Dim; |
| PROCEDURE OpenBase* (t: _TYPE): _TYPE; |
| PROCEDURE OpenBase* (t: TYPE_): TYPE_; |
| BEGIN |
| WHILE isOpenArray(t) DO t := t.base END |
| RETURN t |
| 958,7 → 939,7 |
| END OpenBase; |
| PROCEDURE getFloatParamsPos* (self: _TYPE; maxoffs: INTEGER; VAR int, flt: INTEGER): SET; |
| PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET; |
| VAR |
| res: SET; |
| param: PARAM; |
| 969,7 → 950,7 |
| flt := 0; |
| param := self.params.first(PARAM); |
| WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO |
| IF ~param.vPar & (param._type.typ = tREAL) THEN |
| IF ~param.vPar & (param.type.typ = tREAL) THEN |
| INCL(res, param.offset - STACK_FRAME); |
| INC(flt) |
| END; |
| 982,7 → 963,7 |
| END getFloatParamsPos; |
| PROCEDURE setParams* (self: _TYPE; _type: _TYPE); |
| PROCEDURE setParams* (self: TYPE_; type: TYPE_); |
| VAR |
| item: LISTS.ITEM; |
| param: PARAM; |
| 989,42 → 970,42 |
| word, size: INTEGER; |
| BEGIN |
| ASSERT(_type # NIL); |
| ASSERT(type # NIL); |
| word := UTILS.target.bit_depth DIV 8; |
| item := self.params.first; |
| WHILE (item # NIL) & (item(PARAM)._type # NIL) DO |
| WHILE (item # NIL) & (item(PARAM).type # NIL) DO |
| item := item.next |
| END; |
| WHILE (item # NIL) & (item(PARAM)._type = NIL) DO |
| WHILE (item # NIL) & (item(PARAM).type = NIL) DO |
| param := item(PARAM); |
| param._type := _type; |
| param.type := type; |
| IF param.vPar THEN |
| IF _type.typ = tRECORD THEN |
| IF type.typ = tRECORD THEN |
| size := 2 |
| ELSIF isOpenArray(_type) THEN |
| size := Dim(_type) + 1 |
| ELSIF isOpenArray(type) THEN |
| size := Dim(type) + 1 |
| ELSE |
| size := 1 |
| END; |
| param.offset := self.parSize + ORD(_type.typ = tRECORD) + Dim(_type) + STACK_FRAME; |
| param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; |
| INC(self.parSize, size) |
| ELSE |
| IF _type.typ IN {tRECORD, tARRAY} THEN |
| IF isOpenArray(_type) THEN |
| size := Dim(_type) + 1 |
| IF type.typ IN {tRECORD, tARRAY} THEN |
| IF isOpenArray(type) THEN |
| size := Dim(type) + 1 |
| ELSE |
| size := 1 |
| END |
| ELSE |
| size := _type.size; |
| size := type.size; |
| ASSERT(UTILS.Align(size, word)); |
| size := size DIV word |
| END; |
| param.offset := self.parSize + Dim(_type) + STACK_FRAME; |
| param.offset := self.parSize + Dim(type) + STACK_FRAME; |
| INC(self.parSize, size) |
| END; |
| 1034,9 → 1015,9 |
| END setParams; |
| PROCEDURE enterType* (typ, size, length: INTEGER; unit: UNIT): _TYPE; |
| PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; |
| VAR |
| t: _TYPE; |
| t: TYPE_; |
| BEGIN |
| NEW(t); |
| 1057,7 → 1038,7 |
| |64: t.call := default64 |
| END; |
| t._import := FALSE; |
| t.import := FALSE; |
| t.noalign := FALSE; |
| t.parSize := 0; |
| 1077,9 → 1058,9 |
| END enterType; |
| PROCEDURE getType* (typ: INTEGER): _TYPE; |
| PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_; |
| VAR |
| res: _TYPE; |
| res: TYPE_; |
| BEGIN |
| 1097,7 → 1078,7 |
| END getType; |
| PROCEDURE createSysUnit; |
| PROCEDURE createSysUnit (program: PROGRAM); |
| VAR |
| ident: IDENT; |
| unit: UNIT; |
| 1106,69 → 1087,50 |
| PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); |
| VAR |
| ident: IDENT; |
| upper: SCAN.LEXSTR; |
| BEGIN |
| IF LowerCase THEN |
| ident := addIdent(sys, SCAN.enterid(name), idtyp); |
| ident.stproc := proc; |
| ident._type := program.stTypes.tNONE; |
| ident.export := TRUE |
| END; |
| upper := name; |
| STRINGS.UpCase(upper); |
| ident := addIdent(sys, SCAN.enterid(upper), idtyp); |
| ident.stproc := proc; |
| ident._type := program.stTypes.tNONE; |
| ident.export := TRUE |
| END EnterProc; |
| BEGIN |
| unit := newUnit(SCAN.enterid("$SYSTEM")); |
| unit := newUnit(program, SCAN.enterid("$SYSTEM")); |
| EnterProc(unit, "adr", idSYSFUNC, sysADR); |
| EnterProc(unit, "size", idSYSFUNC, sysSIZE); |
| EnterProc(unit, "sadr", idSYSFUNC, sysSADR); |
| EnterProc(unit, "typeid", idSYSFUNC, sysTYPEID); |
| EnterProc(unit, "ADR", idSYSFUNC, sysADR); |
| EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE); |
| EnterProc(unit, "SADR", idSYSFUNC, sysSADR); |
| EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID); |
| EnterProc(unit, "get", idSYSPROC, sysGET); |
| EnterProc(unit, "get8", idSYSPROC, sysGET8); |
| EnterProc(unit, "put", idSYSPROC, sysPUT); |
| EnterProc(unit, "put8", idSYSPROC, sysPUT8); |
| EnterProc(unit, "code", idSYSPROC, sysCODE); |
| EnterProc(unit, "move", idSYSPROC, sysMOVE); |
| EnterProc(unit, "GET", idSYSPROC, sysGET); |
| EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); |
| EnterProc(unit, "PUT", idSYSPROC, sysPUT); |
| EnterProc(unit, "CODE", idSYSPROC, sysCODE); |
| EnterProc(unit, "MOVE", idSYSPROC, sysMOVE); |
| (* |
| IF program.target.sys = mConst.Target_iMSP430 THEN |
| EnterProc(unit, "nop", idSYSPROC, sysNOP); |
| EnterProc(unit, "eint", idSYSPROC, sysEINT); |
| EnterProc(unit, "dint", idSYSPROC, sysDINT) |
| EnterProc(unit, "NOP", idSYSPROC, sysNOP); |
| EnterProc(unit, "EINT", idSYSPROC, sysEINT); |
| EnterProc(unit, "DINT", idSYSPROC, sysDINT) |
| END; |
| *) |
| IF TARGETS.RealSize # 0 THEN |
| EnterProc(unit, "inf", idSYSFUNC, sysINF); |
| EnterProc(unit, "INF", idSYSFUNC, sysINF); |
| END; |
| IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
| EnterProc(unit, "copy", idSYSPROC, sysCOPY) |
| EnterProc(unit, "COPY", idSYSPROC, sysCOPY) |
| END; |
| IF TARGETS.BitDepth >= 32 THEN |
| EnterProc(unit, "wsadr", idSYSFUNC, sysWSADR); |
| EnterProc(unit, "put16", idSYSPROC, sysPUT16); |
| EnterProc(unit, "put32", idSYSPROC, sysPUT32); |
| EnterProc(unit, "get16", idSYSPROC, sysGET16); |
| EnterProc(unit, "get32", idSYSPROC, sysGET32); |
| EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); |
| EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); |
| EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); |
| IF LowerCase THEN |
| ident := addIdent(unit, SCAN.enterid("card32"), idTYPE); |
| ident._type := program.stTypes.tCARD32; |
| ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); |
| ident.type := program.stTypes.tCARD32; |
| ident.export := TRUE |
| END; |
| ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); |
| ident._type := program.stTypes.tCARD32; |
| ident.export := TRUE; |
| END; |
| closeUnit(unit); |
| 1176,7 → 1138,7 |
| END createSysUnit; |
| PROCEDURE DelUnused* (DelImport: DELIMPORT); |
| PROCEDURE DelUnused* (program: PROGRAM; DelImport: DELIMPORT); |
| VAR |
| proc: PROC; |
| flag: BOOLEAN; |
| 1218,10 → 1180,10 |
| WHILE proc # NIL DO |
| IF ~proc.used THEN |
| IF proc._import = NIL THEN |
| IF proc.import = NIL THEN |
| IL.delete2(proc.enter, proc.leave) |
| ELSE |
| DelImport(proc._import) |
| DelImport(proc.import) |
| END |
| END; |
| proc := proc.next(PROC) |
| 1230,28 → 1192,24 |
| END DelUnused; |
| PROCEDURE ResetLocSize*; |
| BEGIN |
| program.locsize := 0 |
| END ResetLocSize; |
| PROCEDURE create* (options: OPTIONS): PROGRAM; |
| VAR |
| program: PROGRAM; |
| PROCEDURE create* (options: OPTIONS); |
| BEGIN |
| LowerCase := options.lower; |
| SCAN.init(options.lower); |
| idents := C.create(); |
| UTILS.SetBitDepth(TARGETS.BitDepth, TARGETS.RealSize = 8); |
| NEW(program); |
| program.options := options; |
| CASE TARGETS.OS OF |
| |TARGETS.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
| |TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
| |TARGETS.osWIN32: program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osLINUX32: program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osKOS: program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
| |TARGETS.osWIN64: program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
| |TARGETS.osLINUX64: program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
| |TARGETS.osNONE: program.sysflags := {sf_code} |
| END; |
| 1262,11 → 1220,11 |
| program.types := LISTS.create(NIL); |
| program.procs := LISTS.create(NIL); |
| program.stTypes.tINTEGER := enterType(tINTEGER, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tBYTE := enterType(tBYTE, 1, 0, NIL); |
| program.stTypes.tCHAR := enterType(tCHAR, 1, 0, NIL); |
| program.stTypes.tSET := enterType(tSET, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tBOOLEAN := enterType(tBOOLEAN, 1, 0, NIL); |
| program.stTypes.tINTEGER := enterType(program, tINTEGER, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); |
| program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); |
| program.stTypes.tSET := enterType(program, tSET, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); |
| program.stTypes.tINTEGER.align := TARGETS.WordSize; |
| program.stTypes.tBYTE.align := 1; |
| 1275,24 → 1233,26 |
| program.stTypes.tBOOLEAN.align := 1; |
| IF TARGETS.BitDepth >= 32 THEN |
| program.stTypes.tWCHAR := enterType(tWCHAR, 2, 0, NIL); |
| program.stTypes.tCARD32 := enterType(tCARD32, 4, 0, NIL); |
| program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); |
| program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); |
| program.stTypes.tWCHAR.align := 2; |
| program.stTypes.tCARD32.align := 4 |
| END; |
| IF TARGETS.RealSize # 0 THEN |
| program.stTypes.tREAL := enterType(tREAL, TARGETS.RealSize, 0, NIL); |
| program.stTypes.tREAL := enterType(program, tREAL, TARGETS.RealSize, 0, NIL); |
| program.stTypes.tREAL.align := TARGETS.RealSize |
| END; |
| program.stTypes.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tNIL := enterType(tNIL, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tNONE := enterType(tNONE, 0, 0, NIL); |
| program.stTypes.tANYREC := enterType(tRECORD, 0, 0, NIL); |
| program.stTypes.tSTRING := enterType(program, tSTRING, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tNIL := enterType(program, tNIL, TARGETS.WordSize, 0, NIL); |
| program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); |
| program.stTypes.tANYREC.closed := TRUE; |
| createSysUnit |
| createSysUnit(program) |
| RETURN program |
| END create; |
| /programs/develop/oberon07/Source/REG.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 156,7 → 156,7 |
| PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN; |
| VAR |
| free: INTEGER; |
| free, n: INTEGER; |
| res: BOOLEAN; |
| 178,8 → 178,8 |
| Put(R, reg); |
| res := TRUE |
| ELSE |
| res := InStk(R, reg) # -1; |
| IF res THEN |
| n := InStk(R, reg); |
| IF n # -1 THEN |
| free := GetFreeReg(R); |
| IF free # -1 THEN |
| Put(R, free); |
| 192,9 → 192,12 |
| IF free # reg THEN |
| exch(R, reg, free) |
| END |
| END; |
| res := TRUE |
| ELSE |
| res := FALSE |
| END |
| END |
| END |
| RETURN res |
| END GetReg; |
| /programs/develop/oberon07/Source/SCAN.ob07 |
|---|
| 1,13 → 1,13 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| MODULE SCAN; |
| IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS; |
| IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS; |
| CONST |
| 48,12 → 48,6 |
| LEXSTR* = ARRAY LEXLEN OF CHAR; |
| DEF = POINTER TO RECORD (LISTS.ITEM) |
| ident: LEXSTR |
| END; |
| IDENT* = POINTER TO RECORD (AVL.DATA) |
| s*: LEXSTR; |
| 94,11 → 88,9 |
| NewIdent: IDENT; |
| upto, LowerCase, _if: BOOLEAN; |
| upto: BOOLEAN; |
| def: LISTS.LIST; |
| PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; |
| RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s) |
| END nodecmp; |
| 174,7 → 166,7 |
| VAR |
| c: CHAR; |
| hex: BOOLEAN; |
| error, sym: INTEGER; |
| error: INTEGER; |
| BEGIN |
| c := text.peak; |
| 182,7 → 174,7 |
| error := 0; |
| sym := lxINTEGER; |
| lex.sym := lxINTEGER; |
| hex := FALSE; |
| WHILE S.digit(c) DO |
| 199,17 → 191,17 |
| IF c = "H" THEN |
| putchar(lex, c); |
| TXT.next(text); |
| sym := lxHEX |
| lex.sym := lxHEX |
| ELSIF c = "X" THEN |
| putchar(lex, c); |
| TXT.next(text); |
| sym := lxCHAR |
| lex.sym := lxCHAR |
| ELSIF c = "." THEN |
| IF hex THEN |
| sym := lxERROR01 |
| lex.sym := lxERROR01 |
| ELSE |
| c := nextc(text); |
| 216,9 → 208,9 |
| IF c # "." THEN |
| putchar(lex, "."); |
| sym := lxFLOAT |
| lex.sym := lxFLOAT |
| ELSE |
| sym := lxINTEGER; |
| lex.sym := lxINTEGER; |
| text.peak := 7FX; |
| upto := TRUE |
| END; |
| 243,7 → 235,7 |
| c := nextc(text) |
| END |
| ELSE |
| sym := lxERROR02 |
| lex.sym := lxERROR02 |
| END |
| END |
| 251,32 → 243,31 |
| END |
| ELSIF hex THEN |
| sym := lxERROR01 |
| lex.sym := lxERROR01 |
| END; |
| IF lex.over & (sym >= 0) THEN |
| sym := lxERROR07 |
| IF lex.over & (lex.sym >= 0) THEN |
| lex.sym := lxERROR07 |
| END; |
| IF sym = lxINTEGER THEN |
| IF lex.sym = lxINTEGER THEN |
| ARITH.iconv(lex.s, lex.value, error) |
| ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN |
| ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN |
| ARITH.hconv(lex.s, lex.value, error) |
| ELSIF sym = lxFLOAT THEN |
| ELSIF lex.sym = lxFLOAT THEN |
| ARITH.fconv(lex.s, lex.value, error) |
| END; |
| CASE error OF |
| |0: |
| |1: sym := lxERROR08 |
| |2: sym := lxERROR09 |
| |3: sym := lxERROR10 |
| |4: sym := lxERROR11 |
| |5: sym := lxERROR12 |
| END; |
| |1: lex.sym := lxERROR08 |
| |2: lex.sym := lxERROR09 |
| |3: lex.sym := lxERROR10 |
| |4: lex.sym := lxERROR11 |
| |5: lex.sym := lxERROR12 |
| END |
| lex.sym := sym |
| END number; |
| 358,9 → 349,6 |
| PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR); |
| VAR |
| sym: INTEGER; |
| BEGIN |
| putchar(lex, c); |
| c := nextc(text); |
| 367,19 → 355,19 |
| CASE lex.s[0] OF |
| |"+": |
| sym := lxPLUS |
| lex.sym := lxPLUS |
| |"-": |
| sym := lxMINUS |
| lex.sym := lxMINUS |
| |"*": |
| sym := lxMUL |
| lex.sym := lxMUL |
| |"/": |
| sym := lxSLASH; |
| lex.sym := lxSLASH; |
| IF c = "/" THEN |
| sym := lxCOMMENT; |
| lex.sym := lxCOMMENT; |
| REPEAT |
| TXT.next(text) |
| UNTIL text.eol OR text.eof |
| 386,93 → 374,91 |
| END |
| |"~": |
| sym := lxNOT |
| lex.sym := lxNOT |
| |"&": |
| sym := lxAND |
| lex.sym := lxAND |
| |".": |
| sym := lxPOINT; |
| lex.sym := lxPOINT; |
| IF c = "." THEN |
| sym := lxRANGE; |
| lex.sym := lxRANGE; |
| putchar(lex, c); |
| TXT.next(text) |
| END |
| |",": |
| sym := lxCOMMA |
| lex.sym := lxCOMMA |
| |";": |
| sym := lxSEMI |
| lex.sym := lxSEMI |
| |"|": |
| sym := lxBAR |
| lex.sym := lxBAR |
| |"(": |
| sym := lxLROUND; |
| lex.sym := lxLROUND; |
| IF c = "*" THEN |
| sym := lxCOMMENT; |
| lex.sym := lxCOMMENT; |
| TXT.next(text); |
| comment(text) |
| END |
| |"[": |
| sym := lxLSQUARE |
| lex.sym := lxLSQUARE |
| |"{": |
| sym := lxLCURLY |
| lex.sym := lxLCURLY |
| |"^": |
| sym := lxCARET |
| lex.sym := lxCARET |
| |"=": |
| sym := lxEQ |
| lex.sym := lxEQ |
| |"#": |
| sym := lxNE |
| lex.sym := lxNE |
| |"<": |
| sym := lxLT; |
| lex.sym := lxLT; |
| IF c = "=" THEN |
| sym := lxLE; |
| lex.sym := lxLE; |
| putchar(lex, c); |
| TXT.next(text) |
| END |
| |">": |
| sym := lxGT; |
| lex.sym := lxGT; |
| IF c = "=" THEN |
| sym := lxGE; |
| lex.sym := lxGE; |
| putchar(lex, c); |
| TXT.next(text) |
| END |
| |":": |
| sym := lxCOLON; |
| lex.sym := lxCOLON; |
| IF c = "=" THEN |
| sym := lxASSIGN; |
| lex.sym := lxASSIGN; |
| putchar(lex, c); |
| TXT.next(text) |
| END |
| |")": |
| sym := lxRROUND |
| lex.sym := lxRROUND |
| |"]": |
| sym := lxRSQUARE |
| lex.sym := lxRSQUARE |
| |"}": |
| sym := lxRCURLY |
| lex.sym := lxRCURLY |
| END; |
| END |
| lex.sym := sym |
| END delimiter; |
| 480,110 → 466,9 |
| VAR |
| c: CHAR; |
| PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER); |
| BEGIN |
| IF ~cond THEN |
| ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno) |
| END |
| END check; |
| PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN; |
| VAR |
| cur: DEF; |
| BEGIN |
| cur := def.first(DEF); |
| WHILE (cur # NIL) & (cur.ident # str) DO |
| cur := cur.next(DEF) |
| END |
| RETURN cur # NIL |
| END IsDef; |
| PROCEDURE Skip (text: SCANNER); |
| VAR |
| i: INTEGER; |
| BEGIN |
| i := 0; |
| WHILE (i <= text.ifc) & ~text._skip[i] DO |
| INC(i) |
| END; |
| text.skip := i <= text.ifc |
| END Skip; |
| PROCEDURE prep_if (text: SCANNER; VAR lex: LEX); |
| VAR |
| skip: BOOLEAN; |
| BEGIN |
| INC(text.ifc); |
| text._elsif[text.ifc] := lex.sym = lxELSIF; |
| IF lex.sym = lxIF THEN |
| INC(text.elsec); |
| text._else[text.elsec] := FALSE |
| END; |
| _if := TRUE; |
| skip := TRUE; |
| text.skip := FALSE; |
| Next(text, lex); |
| check(lex.sym = lxLROUND, text, lex, 64); |
| Next(text, lex); |
| check(lex.sym = lxIDENT, text, lex, 22); |
| REPEAT |
| IF IsDef(lex.s) THEN |
| skip := FALSE |
| END; |
| Next(text, lex); |
| IF lex.sym = lxBAR THEN |
| Next(text, lex); |
| check(lex.sym = lxIDENT, text, lex, 22) |
| ELSE |
| check(lex.sym = lxRROUND, text, lex, 33) |
| END |
| UNTIL lex.sym = lxRROUND; |
| _if := FALSE; |
| text._skip[text.ifc] := skip; |
| Skip(text); |
| Next(text, lex) |
| END prep_if; |
| PROCEDURE prep_end (text: SCANNER; VAR lex: LEX); |
| BEGIN |
| check(text.ifc > 0, text, lex, 118); |
| IF lex.sym = lxEND THEN |
| WHILE text._elsif[text.ifc] DO |
| DEC(text.ifc) |
| END; |
| DEC(text.ifc); |
| DEC(text.elsec) |
| ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN |
| check(~text._else[text.elsec], text, lex, 118); |
| text._skip[text.ifc] := ~text._skip[text.ifc]; |
| text._else[text.elsec] := lex.sym = lxELSE |
| END; |
| Skip(text); |
| IF lex.sym = lxELSIF THEN |
| prep_if(text, lex) |
| ELSE |
| Next(text, lex) |
| END |
| END prep_end; |
| BEGIN |
| REPEAT |
| c := text.peak; |
| WHILE S.space(c) DO |
| 605,26 → 490,8 |
| string(text, lex, c) |
| ELSIF delimiters[ORD(c)] THEN |
| delimiter(text, lex, c) |
| ELSIF c = "$" THEN |
| IF S.letter(nextc(text)) THEN |
| ident(text, lex); |
| IF lex.sym = lxIF THEN |
| IF ~_if THEN |
| prep_if(text, lex) |
| END |
| ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN |
| IF ~_if THEN |
| prep_end(text, lex) |
| END |
| ELSE |
| check(FALSE, text, lex, 119) |
| END |
| ELSE |
| check(FALSE, text, lex, 119) |
| END |
| ELSIF c = 0X THEN |
| lex.sym := lxEOF; |
| text.skip := FALSE; |
| IF text.eof THEN |
| INC(lex.pos.col) |
| END |
| 647,7 → 514,7 |
| lex.error := 0 |
| END |
| UNTIL (lex.sym # lxCOMMENT) & ~text.skip |
| UNTIL lex.sym # lxCOMMENT |
| END Next; |
| 663,7 → 530,7 |
| END close; |
| PROCEDURE init* (lower: BOOLEAN); |
| PROCEDURE init; |
| VAR |
| i: INTEGER; |
| delim: ARRAY 23 OF CHAR; |
| 672,23 → 539,15 |
| PROCEDURE enterkw (key: INTEGER; kw: LEXSTR); |
| VAR |
| id: IDENT; |
| upper: LEXSTR; |
| BEGIN |
| IF LowerCase THEN |
| id := enterid(kw); |
| id.key := key |
| END; |
| upper := kw; |
| S.UpCase(upper); |
| id := enterid(upper); |
| id.key := key |
| END enterkw; |
| BEGIN |
| upto := FALSE; |
| LowerCase := lower; |
| FOR i := 0 TO 255 DO |
| delimiters[i] := FALSE |
| 708,54 → 567,43 |
| 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") |
| 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") |
| END init; |
| PROCEDURE NewDef* (str: ARRAY OF CHAR); |
| VAR |
| item: DEF; |
| BEGIN |
| NEW(item); |
| COPY(str, item.ident); |
| LISTS.push(def, item) |
| END NewDef; |
| BEGIN |
| def := LISTS.create(NIL) |
| init |
| END SCAN. |
| /programs/develop/oberon07/Source/STATEMENTS.ob07 |
|---|
| 9,7 → 9,7 |
| IMPORT |
| PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVM32I, |
| PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, |
| ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS; |
| 48,7 → 48,7 |
| variant, self: INTEGER; |
| _type: PROG._TYPE; |
| type: PROG.TYPE_; |
| prev: CASE_LABEL |
| 75,7 → 75,7 |
| CPU: INTEGER; |
| tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE; |
| tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_; |
| PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; |
| 89,17 → 89,17 |
| PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tBOOLEAN) |
| RETURN isExpr(e) & (e.type = tBOOLEAN) |
| END isBoolean; |
| PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tINTEGER) |
| RETURN isExpr(e) & (e.type = tINTEGER) |
| END isInteger; |
| PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tBYTE) |
| RETURN isExpr(e) & (e.type = tBYTE) |
| END isByte; |
| 109,42 → 109,42 |
| PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tREAL) |
| RETURN isExpr(e) & (e.type = tREAL) |
| END isReal; |
| PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tSET) |
| RETURN isExpr(e) & (e.type = tSET) |
| END isSet; |
| PROCEDURE isString (e: PARS.EXPR): BOOLEAN; |
| RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR}) |
| RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR}) |
| END isString; |
| PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN; |
| RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) |
| RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) |
| END isStringW; |
| PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tCHAR) |
| RETURN isExpr(e) & (e.type = tCHAR) |
| END isChar; |
| PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type = tWCHAR) |
| RETURN isExpr(e) & (e.type = tWCHAR) |
| END isCharW; |
| PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER) |
| RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) |
| END isPtr; |
| PROCEDURE isRec (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type.typ = PROG.tRECORD) |
| RETURN isExpr(e) & (e.type.typ = PROG.tRECORD) |
| END isRec; |
| 154,27 → 154,27 |
| PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type.typ = PROG.tARRAY) |
| RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) |
| END isArr; |
| PROCEDURE isProc (e: PARS.EXPR): BOOLEAN; |
| RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) |
| RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) |
| END isProc; |
| PROCEDURE isNil (e: PARS.EXPR): BOOLEAN; |
| RETURN e._type.typ = PROG.tNIL |
| RETURN e.type.typ = PROG.tNIL |
| END isNil; |
| PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; |
| RETURN isArr(e) & (e._type.base = tCHAR) |
| RETURN isArr(e) & (e.type.base = tCHAR) |
| END isCharArray; |
| PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; |
| RETURN isArr(e) & (e._type.base = tWCHAR) |
| RETURN isArr(e) & (e.type.base = tWCHAR) |
| END isCharArrayW; |
| 204,7 → 204,7 |
| BEGIN |
| ASSERT(isString(e)); |
| IF e._type = tCHAR THEN |
| IF e.type = tCHAR THEN |
| res := 1 |
| ELSE |
| res := LENGTH(e.value.string(SCAN.IDENT).s) |
| 237,7 → 237,7 |
| BEGIN |
| ASSERT(isStringW(e)); |
| IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN |
| IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN |
| res := 1 |
| ELSE |
| res := _length(e.value.string(SCAN.IDENT).s) |
| 257,11 → 257,11 |
| PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN; |
| RETURN isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1) |
| RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1) |
| END isStringW1; |
| PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN; |
| PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| 268,7 → 268,7 |
| BEGIN |
| IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
| IF t = e._type 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 |
| 279,10 → 279,10 |
| 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 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 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 |
| 331,9 → 331,9 |
| END; |
| offset := string.offsetW |
| ELSE |
| IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN |
| IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN |
| offset := IL.putstrW1(ARITH.Int(e.value)) |
| ELSE (* e._type.typ = PROG.tSTRING *) |
| ELSE (* e.type.typ = PROG.tSTRING *) |
| string := e.value.string(SCAN.IDENT); |
| IF string.offsetW = -1 THEN |
| string.offsetW := IL.putstrW(string.s); |
| 358,18 → 358,8 |
| END CheckRange; |
| PROCEDURE Float (parser: PARS.PARSER; e: PARS.EXPR); |
| PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; |
| VAR |
| pos: PARS.POSITION; |
| BEGIN |
| getpos(parser, pos); |
| IL.Float(ARITH.Float(e.value), pos.line, pos.col) |
| END Float; |
| PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| label: INTEGER; |
| 376,7 → 366,7 |
| BEGIN |
| IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
| res := TRUE; |
| IF PROG.arrcomp(e._type, VarType) THEN |
| IF PROG.arrcomp(e.type, VarType) THEN |
| IF ~PROG.isOpenArray(VarType) THEN |
| IL.Const(VarType.length) |
| 383,7 → 373,7 |
| END; |
| IL.AddCmd(IL.opCOPYA, VarType.base.size); |
| label := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJNZ, label); |
| IL.AddJmpCmd(IL.opJE, label); |
| IL.OnError(line, errCOPY); |
| IL.SetLabel(label) |
| 424,7 → 414,7 |
| END |
| ELSIF isReal(e) & (VarType = tREAL) THEN |
| IF e.obj = eCONST THEN |
| Float(parser, e) |
| IL.Float(ARITH.Float(e.value)) |
| END; |
| IL.savef(e.obj = eCONST) |
| ELSIF isChar(e) & (VarType = tCHAR) THEN |
| 443,19 → 433,19 |
| ELSE |
| IL.AddCmd0(IL.opSAVE16) |
| END |
| ELSIF PROG.isBaseOf(VarType, e._type) THEN |
| ELSIF PROG.isBaseOf(VarType, e.type) THEN |
| IF VarType.typ = PROG.tPOINTER THEN |
| IL.AddCmd0(IL.opSAVE) |
| ELSE |
| IL.AddCmd(IL.opCOPY, VarType.size) |
| END |
| ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN |
| ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN |
| IL.AddCmd0(IL.opSAVE32) |
| ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN |
| 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) |
| ELSIF e.obj = eIMP THEN |
| IL.AssignImpProc(e.ident._import) |
| IL.AssignImpProc(e.ident.import) |
| ELSE |
| IF VarType.typ = PROG.tPROCEDURE THEN |
| IL.AddCmd0(IL.opSAVE) |
| 491,11 → 481,11 |
| PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; |
| VAR |
| t1, t2: PROG._TYPE; |
| t1, t2: PROG.TYPE_; |
| BEGIN |
| t1 := p._type; |
| t2 := e._type; |
| t1 := p.type; |
| t2 := e.type; |
| WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO |
| t1 := t1.base; |
| t2 := t2.base |
| 505,7 → 495,7 |
| END arrcomp; |
| PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER; |
| PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; |
| VAR |
| res: INTEGER; |
| 520,7 → 510,7 |
| END ArrLen; |
| PROCEDURE OpenArray (t, t2: PROG._TYPE); |
| PROCEDURE OpenArray (t, t2: PROG.TYPE_); |
| VAR |
| n, d1, d2: INTEGER; |
| 557,8 → 547,8 |
| IF p.vPar THEN |
| PARS.check(isVar(e), pos, 93); |
| IF p._type.typ = PROG.tRECORD THEN |
| PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66); |
| IF p.type.typ = PROG.tRECORD THEN |
| PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66); |
| IF e.obj = eVREC THEN |
| IF e.ident # NIL THEN |
| IL.AddCmd(IL.opVADR, e.ident.offset - 1) |
| 566,14 → 556,14 |
| IL.AddCmd0(IL.opPUSHT) |
| END |
| ELSE |
| IL.Const(e._type.num) |
| IL.Const(e.type.num) |
| END; |
| IL.AddCmd(IL.opPARAM, 2) |
| ELSIF PROG.isOpenArray(p._type) THEN |
| ELSIF PROG.isOpenArray(p.type) THEN |
| PARS.check(arrcomp(e, p), pos, 66); |
| OpenArray(e._type, p._type) |
| OpenArray(e.type, p.type) |
| ELSE |
| PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66); |
| PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66); |
| IL.Param1 |
| END; |
| PARS.check(~e.readOnly, pos, 94) |
| 580,16 → 570,16 |
| ELSE |
| PARS.check(isExpr(e) OR isProc(e), pos, 66); |
| IF PROG.isOpenArray(p._type) THEN |
| IF e._type.typ = PROG.tARRAY THEN |
| IF PROG.isOpenArray(p.type) THEN |
| IF e.type.typ = PROG.tARRAY THEN |
| PARS.check(arrcomp(e, p), pos, 66); |
| OpenArray(e._type, p._type) |
| ELSIF isString(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tCHAR) THEN |
| OpenArray(e.type, p.type) |
| ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN |
| IL.StrAdr(String(e)); |
| IL.Param1; |
| IL.Const(strlen(e) + 1); |
| IL.Param1 |
| ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN |
| ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN |
| IL.StrAdr(StringW(e)); |
| IL.Param1; |
| IL.Const(utf8strlen(e) + 1); |
| 598,24 → 588,24 |
| PARS.error(pos, 66) |
| END |
| ELSE |
| PARS.check(~PROG.isOpenArray(e._type), pos, 66); |
| PARS.check(assigncomp(e, p._type), pos, 66); |
| PARS.check(~PROG.isOpenArray(e.type), pos, 66); |
| PARS.check(assigncomp(e, p.type), pos, 66); |
| IF e.obj = eCONST THEN |
| IF e._type = tREAL THEN |
| Float(parser, e); |
| IL.AddCmd0(IL.opPUSHF) |
| ELSIF e._type.typ = PROG.tNIL THEN |
| IF e.type = tREAL THEN |
| IL.Float(ARITH.Float(e.value)); |
| IL.pushf |
| ELSIF e.type.typ = PROG.tNIL THEN |
| IL.Const(0); |
| IL.Param1 |
| ELSIF isStringW1(e) & (p._type = tWCHAR) THEN |
| ELSIF isStringW1(e) & (p.type = tWCHAR) THEN |
| IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s)); |
| IL.Param1 |
| ELSIF (e._type.typ = PROG.tSTRING) OR |
| (e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN |
| IF p._type.base = tCHAR THEN |
| ELSIF (e.type.typ = PROG.tSTRING) OR |
| (e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN |
| IF p.type.base = tCHAR THEN |
| stroffs := String(e); |
| IL.StrAdr(stroffs); |
| IF (CPU = TARGETS.cpuMSP430) & (p._type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
| IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
| ERRORS.WarningMsg(pos.line, pos.col, 0) |
| END |
| ELSE (* WCHAR *) |
| 622,7 → 612,7 |
| stroffs := StringW(e); |
| IL.StrAdr(stroffs) |
| END; |
| IL.set_dmin(stroffs + p._type.size); |
| IL.set_dmin(stroffs + p.type.size); |
| IL.Param1 |
| ELSE |
| LoadConst(e); |
| 633,12 → 623,12 |
| IL.PushProc(e.ident.proc.label); |
| IL.Param1 |
| ELSIF e.obj = eIMP THEN |
| IL.PushImpProc(e.ident._import); |
| IL.PushImpProc(e.ident.import); |
| IL.Param1 |
| ELSIF isExpr(e) & (e._type = tREAL) THEN |
| IL.AddCmd0(IL.opPUSHF) |
| ELSIF isExpr(e) & (e.type = tREAL) THEN |
| IL.pushf |
| ELSE |
| IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN |
| IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN |
| CheckRange(256, pos.line, errBYTE) |
| END; |
| IL.Param1 |
| 661,7 → 651,6 |
| pos: PARS.POSITION; |
| proc, |
| label, |
| size, |
| n, i: INTEGER; |
| code: ARITH.VALUE; |
| wchar, |
| 727,8 → 716,7 |
| END |
| ELSE |
| label := IL.NewLabel(); |
| IL.not; |
| IL.AndOrOpt(label); |
| IL.AddJmpCmd(IL.opJE, label); |
| IL.OnError(pos.line, errASSERT); |
| IL.SetLabel(label) |
| END |
| 736,7 → 724,7 |
| |PROG.stINC, PROG.stDEC: |
| IL.pushBegEnd(begcall, endcall); |
| varparam(parser, pos, isInt, TRUE, e); |
| IF e._type = tINTEGER THEN |
| IF e.type = tINTEGER THEN |
| IF parser.sym = SCAN.lxCOMMA THEN |
| NextPos(parser, pos); |
| IL.setlast(begcall); |
| 751,7 → 739,7 |
| ELSE |
| IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1) |
| END |
| ELSE (* e._type = tBYTE *) |
| ELSE (* e.type = tBYTE *) |
| IF parser.sym = SCAN.lxCOMMA THEN |
| NextPos(parser, pos); |
| IL.setlast(begcall); |
| 789,9 → 777,9 |
| |PROG.stNEW: |
| varparam(parser, pos, isPtr, TRUE, e); |
| IF CPU = TARGETS.cpuMSP430 THEN |
| PARS.check(e._type.base.size + 16 < Options.ram, pos, 63) |
| PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) |
| END; |
| IL.New(e._type.base.size, e._type.base.num) |
| IL.New(e.type.base.size, e.type.base.num) |
| |PROG.stDISPOSE: |
| varparam(parser, pos, isPtr, TRUE, e); |
| 827,8 → 815,8 |
| PARS.error(pos, 66) |
| END; |
| IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN |
| IL.Const(e._type.length) |
| IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN |
| IL.Const(e.type.length) |
| END; |
| PARS.checklex(parser, SCAN.lxCOMMA); |
| 844,11 → 832,11 |
| varparam(parser, pos, isCharArray, TRUE, e1) |
| END; |
| wchar := e1._type.base = tWCHAR |
| wchar := e1.type.base = tWCHAR |
| END; |
| IF ~PROG.isOpenArray(e1._type) THEN |
| IL.Const(e1._type.length) |
| IF ~PROG.isOpenArray(e1.type) THEN |
| IL.Const(e1.type.length) |
| END; |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| 862,10 → 850,10 |
| IL.Const(strlen(e) + 1) |
| END |
| END; |
| IL.AddCmd(IL.opCOPYS, e1._type.base.size); |
| IL.AddCmd(IL.opCOPYS, e1.type.base.size); |
| IL.popBegEnd(begcall, endcall) |
| |PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32: |
| |PROG.sysGET: |
| PExpression(parser, e); |
| PARS.check(isInt(e), pos, 66); |
| PARS.checklex(parser, SCAN.lxCOMMA); |
| 872,25 → 860,11 |
| NextPos(parser, pos); |
| parser.designator(parser, e2); |
| PARS.check(isVar(e2), pos, 93); |
| IF proc = PROG.sysGET THEN |
| PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66) |
| ELSE |
| PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66) |
| END; |
| CASE proc OF |
| |PROG.sysGET: size := e2._type.size |
| |PROG.sysGET8: size := 1 |
| |PROG.sysGET16: size := 2 |
| |PROG.sysGET32: size := 4 |
| END; |
| PARS.check(size <= e2._type.size, pos, 66); |
| PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
| IF e.obj = eCONST THEN |
| IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size) |
| IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size) |
| ELSE |
| IL.AddCmd(IL.opGET, size) |
| IL.AddCmd(IL.opGET, e2.type.size) |
| END |
| |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: |
| 907,40 → 881,39 |
| PARS.check(isExpr(e2), pos, 66); |
| IF proc = PROG.sysPUT THEN |
| PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
| PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
| IF e2.obj = eCONST THEN |
| IF e2._type = tREAL THEN |
| Float(parser, e2); |
| IF e2.type = tREAL THEN |
| IL.Float(ARITH.Float(e2.value)); |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| IL.savef(FALSE) |
| ELSE |
| LoadConst(e2); |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| IL.SysPut(e2._type.size) |
| IL.SysPut(e2.type.size) |
| END |
| ELSE |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| IF e2._type = tREAL THEN |
| IF e2.type = tREAL THEN |
| IL.savef(FALSE) |
| ELSIF e2._type = tBYTE THEN |
| ELSIF e2.type = tBYTE THEN |
| IL.SysPut(tINTEGER.size) |
| ELSE |
| IL.SysPut(e2._type.size) |
| IL.SysPut(e2.type.size) |
| END |
| 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.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; |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| CASE proc OF |
| |PROG.sysPUT8: size := 1 |
| |PROG.sysPUT16: size := 2 |
| |PROG.sysPUT32: size := 4 |
| END; |
| IL.SysPut(size) |
| |PROG.sysPUT8: IL.SysPut(1) |
| |PROG.sysPUT16: IL.SysPut(2) |
| |PROG.sysPUT32: IL.SysPut(4) |
| END |
| END; |
| IL.popBegEnd(begcall, endcall) |
| 967,7 → 940,7 |
| FOR i := 1 TO 2 DO |
| parser.designator(parser, e); |
| PARS.check(isVar(e), pos, 93); |
| n := PROG.Dim(e._type); |
| n := PROG.Dim(e.type); |
| WHILE n > 0 DO |
| IL.drop; |
| DEC(n) |
| 988,11 → 961,10 |
| getpos(parser, pos); |
| PARS.ConstExpression(parser, code); |
| PARS.check(code.typ = ARITH.tINTEGER, pos, 43); |
| IF TARGETS.WordSize > TARGETS.InstrSize THEN |
| CASE TARGETS.InstrSize OF |
| |1: PARS.check(ARITH.range(code, 0, 255), pos, 42) |
| |2: PARS.check(ARITH.range(code, 0, 65535), pos, 110) |
| END |
| IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
| PARS.check(ARITH.range(code, 0, 255), pos, 42) |
| ELSIF CPU = TARGETS.cpuTHUMB THEN |
| PARS.check(ARITH.range(code, 0, 65535), pos, 110) |
| END; |
| IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
| comma := parser.sym = SCAN.lxCOMMA; |
| 1019,7 → 991,7 |
| END; |
| e.obj := eEXPR; |
| e._type := NIL |
| e.type := NIL |
| ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN |
| 1040,7 → 1012,7 |
| NextPos(parser, pos); |
| PExpression(parser, e2); |
| PARS.check(isInt(e2), pos, 66); |
| e._type := tINTEGER; |
| e.type := tINTEGER; |
| IF (e.obj = eCONST) & (e2.obj = eCONST) THEN |
| ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) |
| ELSE |
| 1057,7 → 1029,7 |
| |PROG.stCHR: |
| PExpression(parser, e); |
| PARS.check(isInt(e), pos, 66); |
| e._type := tCHAR; |
| e.type := tCHAR; |
| IF e.obj = eCONST THEN |
| ARITH.setChar(e.value, ARITH.getInt(e.value)); |
| PARS.check(ARITH.check(e.value), pos, 107) |
| 1072,7 → 1044,7 |
| |PROG.stWCHR: |
| PExpression(parser, e); |
| PARS.check(isInt(e), pos, 66); |
| e._type := tWCHAR; |
| e.type := tWCHAR; |
| IF e.obj = eCONST THEN |
| ARITH.setWChar(e.value, ARITH.getInt(e.value)); |
| PARS.check(ARITH.check(e.value), pos, 101) |
| 1087,58 → 1059,58 |
| |PROG.stFLOOR: |
| PExpression(parser, e); |
| PARS.check(isReal(e), pos, 66); |
| e._type := tINTEGER; |
| e.type := tINTEGER; |
| IF e.obj = eCONST THEN |
| PARS.check(ARITH.floor(e.value), pos, 39) |
| ELSE |
| IL.AddCmd0(IL.opFLOOR) |
| IL.floor |
| END |
| |PROG.stFLT: |
| PExpression(parser, e); |
| PARS.check(isInt(e), pos, 66); |
| e._type := tREAL; |
| e.type := tREAL; |
| IF e.obj = eCONST THEN |
| ARITH.flt(e.value) |
| ELSE |
| IL.AddCmd2(IL.opFLT, pos.line, pos.col) |
| PARS.check(IL.flt(), pos, 41) |
| END |
| |PROG.stLEN: |
| cmd1 := IL.getlast(); |
| varparam(parser, pos, isArr, FALSE, e); |
| IF e._type.length > 0 THEN |
| IF e.type.length > 0 THEN |
| cmd2 := IL.getlast(); |
| IL.delete2(cmd1.next, cmd2); |
| IL.setlast(cmd1); |
| ASSERT(ARITH.setInt(e.value, e._type.length)); |
| ASSERT(ARITH.setInt(e.value, e.type.length)); |
| e.obj := eCONST |
| ELSE |
| IL.len(PROG.Dim(e._type)) |
| IL.len(PROG.Dim(e.type)) |
| END; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| |PROG.stLENGTH: |
| PExpression(parser, e); |
| IF isCharArray(e) THEN |
| IF e._type.length > 0 THEN |
| IL.Const(e._type.length) |
| IF e.type.length > 0 THEN |
| IL.Const(e.type.length) |
| END; |
| IL.AddCmd0(IL.opLENGTH) |
| ELSIF isCharArrayW(e) THEN |
| IF e._type.length > 0 THEN |
| IL.Const(e._type.length) |
| IF e.type.length > 0 THEN |
| IL.Const(e.type.length) |
| END; |
| IL.AddCmd0(IL.opLENGTHW) |
| ELSE |
| PARS.error(pos, 66); |
| END; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| |PROG.stODD: |
| PExpression(parser, e); |
| PARS.check(isInt(e), pos, 66); |
| e._type := tBOOLEAN; |
| e.type := tBOOLEAN; |
| IF e.obj = eCONST THEN |
| ARITH.odd(e.value) |
| ELSE |
| 1156,10 → 1128,10 |
| END |
| ELSE |
| IF isBoolean(e) THEN |
| IL._ord |
| IL.AddCmd0(IL.opORD) |
| END |
| END; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| |PROG.stBITS: |
| PExpression(parser, e); |
| 1167,12 → 1139,12 |
| IF e.obj = eCONST THEN |
| ARITH.bits(e.value) |
| END; |
| e._type := tSET |
| e.type := tSET |
| |PROG.sysADR: |
| parser.designator(parser, e); |
| IF isVar(e) THEN |
| n := PROG.Dim(e._type); |
| n := PROG.Dim(e.type); |
| WHILE n > 0 DO |
| IL.drop; |
| DEC(n) |
| 1180,17 → 1152,17 |
| ELSIF e.obj = ePROC THEN |
| IL.PushProc(e.ident.proc.label) |
| ELSIF e.obj = eIMP THEN |
| IL.PushImpProc(e.ident._import) |
| IL.PushImpProc(e.ident.import) |
| ELSE |
| PARS.error(pos, 108) |
| END; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| |PROG.sysSADR: |
| PExpression(parser, e); |
| PARS.check(isString(e), pos, 66); |
| IL.StrAdr(String(e)); |
| e._type := tINTEGER; |
| e.type := tINTEGER; |
| e.obj := eEXPR |
| |PROG.sysWSADR: |
| 1197,33 → 1169,33 |
| PExpression(parser, e); |
| PARS.check(isStringW(e), pos, 66); |
| IL.StrAdr(StringW(e)); |
| e._type := tINTEGER; |
| e.type := tINTEGER; |
| e.obj := eEXPR |
| |PROG.sysTYPEID: |
| PExpression(parser, e); |
| PARS.check(e.obj = eTYPE, pos, 68); |
| IF e._type.typ = PROG.tRECORD THEN |
| ASSERT(ARITH.setInt(e.value, e._type.num)) |
| ELSIF e._type.typ = PROG.tPOINTER THEN |
| ASSERT(ARITH.setInt(e.value, e._type.base.num)) |
| IF e.type.typ = PROG.tRECORD THEN |
| ASSERT(ARITH.setInt(e.value, e.type.num)) |
| ELSIF e.type.typ = PROG.tPOINTER THEN |
| ASSERT(ARITH.setInt(e.value, e.type.base.num)) |
| ELSE |
| PARS.error(pos, 52) |
| END; |
| e.obj := eCONST; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| |PROG.sysINF: |
| IL.AddCmd2(IL.opINF, pos.line, pos.col); |
| PARS.check(IL.inf(), pos, 41); |
| e.obj := eEXPR; |
| e._type := tREAL |
| e.type := tREAL |
| |PROG.sysSIZE: |
| PExpression(parser, e); |
| PARS.check(e.obj = eTYPE, pos, 68); |
| ASSERT(ARITH.setInt(e.value, e._type.size)); |
| ASSERT(ARITH.setInt(e.value, e.type.size)); |
| e.obj := eCONST; |
| e._type := tINTEGER |
| e.type := tINTEGER |
| END |
| 1243,7 → 1215,7 |
| PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR); |
| VAR |
| proc: PROG._TYPE; |
| proc: PROG.TYPE_; |
| param: LISTS.ITEM; |
| e1: PARS.EXPR; |
| pos: PARS.POSITION; |
| 1252,7 → 1224,7 |
| ASSERT(parser.sym = SCAN.lxLROUND); |
| IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN |
| proc := e._type; |
| proc := e.type; |
| PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86); |
| PARS.Next(parser); |
| 1279,7 → 1251,7 |
| PARS.Next(parser); |
| e.obj := eEXPR; |
| e._type := proc.base |
| e.type := proc.base |
| ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN |
| stProc(parser, e) |
| 1293,13 → 1265,13 |
| PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR); |
| VAR |
| ident: PROG.IDENT; |
| imp: BOOLEAN; |
| import: BOOLEAN; |
| pos: PARS.POSITION; |
| BEGIN |
| PARS.checklex(parser, SCAN.lxIDENT); |
| getpos(parser, pos); |
| imp := FALSE; |
| import := FALSE; |
| ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); |
| PARS.check1(ident # NIL, parser, 48); |
| IF ident.typ = PROG.idMODULE THEN |
| 1307,7 → 1279,7 |
| PARS.ExpectSym(parser, SCAN.lxIDENT); |
| ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE); |
| PARS.check1((ident # NIL) & ident.export, parser, 48); |
| imp := TRUE |
| import := TRUE |
| END; |
| PARS.Next(parser); |
| 1317,24 → 1289,24 |
| CASE ident.typ OF |
| |PROG.idCONST: |
| e.obj := eCONST; |
| e._type := ident._type; |
| e.type := ident.type; |
| e.value := ident.value |
| |PROG.idTYPE: |
| e.obj := eTYPE; |
| e._type := ident._type |
| e.type := ident.type |
| |PROG.idVAR: |
| e.obj := eVAR; |
| e._type := ident._type; |
| e.readOnly := imp |
| e.type := ident.type; |
| e.readOnly := import |
| |PROG.idPROC: |
| e.obj := ePROC; |
| e._type := ident._type |
| e.type := ident.type |
| |PROG.idIMP: |
| e.obj := eIMP; |
| e._type := ident._type |
| e.type := ident.type |
| |PROG.idVPAR: |
| e._type := ident._type; |
| IF e._type.typ = PROG.tRECORD THEN |
| e.type := ident.type; |
| IF e.type.typ = PROG.tRECORD THEN |
| e.obj := eVREC |
| ELSE |
| e.obj := eVPAR |
| 1341,24 → 1313,20 |
| END |
| |PROG.idPARAM: |
| e.obj := ePARAM; |
| e._type := ident._type; |
| e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) |
| e.type := ident.type; |
| e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) |
| |PROG.idSTPROC: |
| e.obj := eSTPROC; |
| e._type := ident._type; |
| e.stproc := ident.stproc |
| |PROG.idSTFUNC: |
| e.obj := eSTFUNC; |
| e._type := ident._type; |
| e.stproc := ident.stproc |
| |PROG.idSYSPROC: |
| e.obj := eSYSPROC; |
| e._type := ident._type; |
| e.stproc := ident.stproc |
| |PROG.idSYSFUNC: |
| PARS.check(~parser.constexp, pos, 109); |
| e.obj := eSYSFUNC; |
| e._type := ident._type; |
| e.stproc := ident.stproc |
| |PROG.idNONE: |
| PARS.error(pos, 115) |
| 1377,12 → 1345,12 |
| BEGIN |
| IF load THEN |
| IL.load(e._type.size) |
| IL.load(e.type.size) |
| END; |
| IF chkPTR IN Options.checking THEN |
| label := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJNZ1, label); |
| IL.AddJmpCmd(IL.opJNZ, label); |
| IL.OnError(pos.line, error); |
| IL.SetLabel(label) |
| END |
| 1405,7 → 1373,7 |
| offset, n: INTEGER; |
| BEGIN |
| offset := e.ident.offset; |
| n := PROG.Dim(e._type); |
| n := PROG.Dim(e.type); |
| WHILE n >= 0 DO |
| IL.AddCmd(IL.opVADR, offset); |
| DEC(offset); |
| 1416,7 → 1384,7 |
| BEGIN |
| IF e.obj = eVAR THEN |
| offset := PROG.getOffset(e.ident); |
| offset := PROG.getOffset(PARS.program, e.ident); |
| IF e.ident.global THEN |
| IL.AddCmd(IL.opGADR, offset) |
| ELSE |
| 1423,15 → 1391,15 |
| IL.AddCmd(IL.opLADR, -offset) |
| END |
| ELSIF e.obj = ePARAM THEN |
| IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN |
| IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN |
| IL.AddCmd(IL.opVADR, e.ident.offset) |
| ELSIF PROG.isOpenArray(e._type) THEN |
| ELSIF PROG.isOpenArray(e.type) THEN |
| OpenArray(e) |
| ELSE |
| IL.AddCmd(IL.opLADR, e.ident.offset) |
| END |
| ELSIF e.obj IN {eVPAR, eVREC} THEN |
| IF PROG.isOpenArray(e._type) THEN |
| IF PROG.isOpenArray(e.type) THEN |
| OpenArray(e) |
| ELSE |
| IL.AddCmd(IL.opVADR, e.ident.offset) |
| 1443,7 → 1411,7 |
| PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); |
| VAR |
| label, offset, n, k: INTEGER; |
| _type: PROG._TYPE; |
| type: PROG.TYPE_; |
| BEGIN |
| 1456,11 → 1424,11 |
| IL.AddCmd(IL.opCHKIDX2, -1) |
| END; |
| _type := PROG.OpenBase(e._type); |
| IF _type.size # 1 THEN |
| IL.AddCmd(IL.opMULC, _type.size) |
| type := PROG.OpenBase(e.type); |
| IF type.size # 1 THEN |
| IL.AddCmd(IL.opMULC, type.size) |
| END; |
| n := PROG.Dim(e._type) - 1; |
| n := PROG.Dim(e.type) - 1; |
| k := n; |
| WHILE n > 0 DO |
| IL.AddCmd0(IL.opMUL); |
| 1490,23 → 1458,23 |
| WHILE parser.sym = SCAN.lxPOINT DO |
| getpos(parser, pos); |
| PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); |
| IF e._type.typ = PROG.tPOINTER THEN |
| PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); |
| IF e.type.typ = PROG.tPOINTER THEN |
| deref(pos, e, TRUE, errPTR) |
| END; |
| PARS.ExpectSym(parser, SCAN.lxIDENT); |
| IF e._type.typ = PROG.tPOINTER THEN |
| e._type := e._type.base; |
| IF e.type.typ = PROG.tPOINTER THEN |
| e.type := e.type.base; |
| e.readOnly := FALSE |
| END; |
| field := PROG.getField(e._type, parser.lex.ident, parser.unit); |
| field := PROG.getField(e.type, parser.lex.ident, parser.unit); |
| PARS.check1(field # NIL, parser, 74); |
| e._type := field._type; |
| e.type := field.type; |
| IF e.obj = eVREC THEN |
| e.obj := eVPAR |
| END; |
| IF field.offset # 0 THEN |
| IL.AddCmd(IL.opADDC, field.offset) |
| IL.AddCmd(IL.opADDR, field.offset) |
| END; |
| PARS.Next(parser); |
| e.ident := NIL |
| 1521,10 → 1489,10 |
| PARS.check(isInt(idx), pos, 76); |
| IF idx.obj = eCONST THEN |
| IF e._type.length > 0 THEN |
| PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83); |
| IF e.type.length > 0 THEN |
| PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83); |
| IF ARITH.Int(idx.value) > 0 THEN |
| IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size) |
| IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size) |
| END |
| ELSE |
| PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83); |
| 1532,12 → 1500,12 |
| OpenIdx(parser, pos, e) |
| END |
| ELSE |
| IF e._type.length > 0 THEN |
| IF e.type.length > 0 THEN |
| IF chkIDX IN Options.checking THEN |
| CheckRange(e._type.length, pos.line, errIDX) |
| CheckRange(e.type.length, pos.line, errIDX) |
| END; |
| IF e._type.base.size # 1 THEN |
| IL.AddCmd(IL.opMULC, e._type.base.size) |
| IF e.type.base.size # 1 THEN |
| IL.AddCmd(IL.opMULC, e.type.base.size) |
| END; |
| IL.AddCmd0(IL.opADD) |
| ELSE |
| 1545,7 → 1513,7 |
| END |
| END; |
| e._type := e._type.base |
| e.type := e.type.base |
| UNTIL parser.sym # SCAN.lxCOMMA; |
| 1557,15 → 1525,15 |
| getpos(parser, pos); |
| PARS.check1(isPtr(e), parser, 77); |
| deref(pos, e, TRUE, errPTR); |
| e._type := e._type.base; |
| e.type := e.type.base; |
| e.readOnly := FALSE; |
| PARS.Next(parser); |
| e.ident := NIL; |
| e.obj := eVREC |
| ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO |
| ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO |
| IF e._type.typ = PROG.tRECORD THEN |
| IF e.type.typ = PROG.tRECORD THEN |
| PARS.check1(e.obj = eVREC, parser, 78) |
| END; |
| NextPos(parser, pos); |
| 1572,26 → 1540,26 |
| qualident(parser, t); |
| PARS.check(t.obj = eTYPE, pos, 79); |
| IF e._type.typ = PROG.tRECORD THEN |
| PARS.check(t._type.typ = PROG.tRECORD, pos, 80); |
| IF e.type.typ = PROG.tRECORD THEN |
| PARS.check(t.type.typ = PROG.tRECORD, pos, 80); |
| IF chkGUARD IN Options.checking THEN |
| IF e.ident = NIL THEN |
| IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD) |
| IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD) |
| ELSE |
| IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
| IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD) |
| IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD) |
| END |
| END; |
| ELSE |
| PARS.check(t._type.typ = PROG.tPOINTER, pos, 81); |
| PARS.check(t.type.typ = PROG.tPOINTER, pos, 81); |
| IF chkGUARD IN Options.checking THEN |
| IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD) |
| IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD) |
| END |
| END; |
| PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82); |
| PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82); |
| e._type := t._type; |
| e.type := t.type; |
| PARS.checklex(parser, SCAN.lxRROUND); |
| PARS.Next(parser) |
| 1601,7 → 1569,7 |
| END designator; |
| PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); |
| PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); |
| VAR |
| cconv, |
| parSize, |
| 1626,7 → 1594,7 |
| fparSize := 0 |
| END; |
| IL.setlast(begcall); |
| IL.AddCmd(IL.opPRECALL, ORD(isfloat)); |
| fregs := IL.precall(isfloat); |
| IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
| IL.AddCmd(IL.opALIGN16, parSize) |
| 1638,7 → 1606,7 |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| IF e.obj = eIMP THEN |
| IL.CallImp(e.ident._import, callconv, fparSize) |
| IL.CallImp(e.ident.import, callconv, fparSize) |
| ELSIF e.obj = ePROC THEN |
| IL.Call(e.ident.proc.label, callconv, fparSize) |
| ELSIF isExpr(e) THEN |
| 1659,14 → 1627,11 |
| IL.AddCmd(IL.opCLEANUP, parSize) |
| END; |
| IF CallStat THEN |
| IL.AddCmd0(IL.opRES); |
| IL.drop |
| ELSE |
| IF ~CallStat THEN |
| IF isfloat THEN |
| IL.AddCmd2(IL.opRESF, pos.line, pos.col) |
| PARS.check(IL.resf(fregs), pos, 41) |
| ELSE |
| IL.AddCmd0(IL.opRES) |
| IL.res(fregs) |
| END |
| END |
| END ProcCall; |
| 1675,9 → 1640,12 |
| PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
| VAR |
| pos, pos0, pos1: PARS.POSITION; |
| op: INTEGER; |
| e1: PARS.EXPR; |
| op, cmp, error: INTEGER; |
| constant, eq: BOOLEAN; |
| constant: BOOLEAN; |
| operator: ARITH.RELATION; |
| error: INTEGER; |
| PROCEDURE relation (sym: INTEGER): BOOLEAN; |
| 1733,7 → 1701,7 |
| END |
| END; |
| e._type := tSET; |
| e.type := tSET; |
| IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN |
| ARITH.constrSet(e.value, e1.value, e2.value); |
| 1764,7 → 1732,7 |
| ASSERT(parser.sym = SCAN.lxLCURLY); |
| e.obj := eCONST; |
| e._type := tSET; |
| e.type := tSET; |
| ARITH.emptySet(e.value); |
| PARS.Next(parser); |
| 1784,9 → 1752,9 |
| ARITH.opSet(e.value, e1.value, "+") |
| ELSE |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opADDSC, ARITH.Int(e.value)) |
| IL.AddCmd(IL.opADDSL, ARITH.Int(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| IL.AddCmd(IL.opADDSC, ARITH.Int(e1.value)) |
| IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value)) |
| ELSE |
| IL.AddCmd0(IL.opADDS) |
| END; |
| 1805,15 → 1773,16 |
| pos: PARS.POSITION; |
| e1: PARS.EXPR; |
| isfloat: BOOLEAN; |
| fregs: INTEGER; |
| PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION); |
| BEGIN |
| IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN |
| IF e._type = tREAL THEN |
| IL.AddCmd2(IL.opLOADF, pos.line, pos.col) |
| IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN |
| IF e.type = tREAL THEN |
| PARS.check(IL.loadf(), pos, 41) |
| ELSE |
| IL.load(e._type.size) |
| IL.load(e.type.size) |
| END |
| END |
| END LoadVar; |
| 1825,18 → 1794,18 |
| IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN |
| e.obj := eCONST; |
| e.value := parser.lex.value; |
| e._type := PROG.getType(e.value.typ); |
| e.type := PROG.getType(PARS.program, e.value.typ); |
| PARS.Next(parser) |
| ELSIF sym = SCAN.lxNIL THEN |
| e.obj := eCONST; |
| e._type := PROG.program.stTypes.tNIL; |
| e.type := PARS.program.stTypes.tNIL; |
| PARS.Next(parser) |
| ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN |
| e.obj := eCONST; |
| ARITH.setbool(e.value, sym = SCAN.lxTRUE); |
| e._type := tBOOLEAN; |
| e.type := tBOOLEAN; |
| PARS.Next(parser) |
| ELSIF sym = SCAN.lxLCURLY THEN |
| 1854,12 → 1823,12 |
| IF parser.sym = SCAN.lxLROUND THEN |
| e1 := e; |
| ActualParameters(parser, e); |
| PARS.check(e._type # NIL, pos, 59); |
| isfloat := e._type = tREAL; |
| PARS.check(e.type # NIL, pos, 59); |
| isfloat := e.type = tREAL; |
| IF e1.obj IN {ePROC, eIMP} THEN |
| ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE) |
| ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE) |
| ELSIF isExpr(e1) THEN |
| ProcCall(e1, e1._type, isfloat, parser, pos, FALSE) |
| ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE) |
| END |
| END; |
| IL.popBegEnd(begcall, endcall) |
| 1915,7 → 1884,9 |
| IF e.obj = eCONST THEN |
| IL.Const(ORD(ARITH.getBool(e.value))) |
| END; |
| IL.AndOrOpt(label) |
| IL.AddCmd0(IL.opACC); |
| IL.AddJmpCmd(IL.opJZ, label); |
| IL.drop |
| END |
| END; |
| 1943,11 → 1914,11 |
| END |
| ELSIF isReal(e) THEN |
| IF e.obj = eCONST THEN |
| Float(parser, e) |
| IL.Float(ARITH.Float(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| Float(parser, e1) |
| IL.Float(ARITH.Float(e1.value)) |
| END; |
| IL.AddCmd0(IL.opMULF) |
| IL.fbinop(IL.opMULF) |
| ELSIF isSet(e) THEN |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opMULSC, ARITH.Int(e.value)) |
| 1975,13 → 1946,13 |
| ELSE |
| IF isReal(e) THEN |
| IF e.obj = eCONST THEN |
| Float(parser, e); |
| IL.AddCmd0(IL.opDIVFI) |
| IL.Float(ARITH.Float(e.value)); |
| IL.fbinop(IL.opDIVFI) |
| ELSIF e1.obj = eCONST THEN |
| Float(parser, e1); |
| IL.AddCmd0(IL.opDIVF) |
| IL.Float(ARITH.Float(e1.value)); |
| IL.fbinop(IL.opDIVF) |
| ELSE |
| IL.AddCmd0(IL.opDIVF) |
| IL.fbinop(IL.opDIVF) |
| END |
| ELSIF isSet(e) THEN |
| IF e.obj = eCONST THEN |
| 2036,24 → 2007,15 |
| e.obj := eEXPR; |
| IF e1.obj = eCONST THEN |
| IL.Const(ORD(ARITH.getBool(e1.value))) |
| END; |
| IL.AddCmd0(IL.opACC) |
| END |
| END |
| END |
| END; |
| IF label # -1 THEN |
| label1 := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJNZ, label1); |
| IL.SetLabel(label); |
| IL.Const(0); |
| IL.drop; |
| label := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJMP, label); |
| IL.SetLabel(label1); |
| IL.Const(1); |
| IL.SetLabel(label); |
| IL.AddCmd0(IL.opAND) |
| IL.SetLabel(label) |
| END |
| END term; |
| 2063,11 → 2025,10 |
| pos: PARS.POSITION; |
| op: INTEGER; |
| e1: PARS.EXPR; |
| s, s1: SCAN.LEXSTR; |
| plus, minus: BOOLEAN; |
| label, label1: INTEGER; |
| label: INTEGER; |
| BEGIN |
| plus := parser.sym = SCAN.lxPLUS; |
| 2120,8 → 2081,9 |
| IF e.obj = eCONST THEN |
| IL.Const(ORD(ARITH.getBool(e.value))) |
| END; |
| IL.not; |
| IL.AndOrOpt(label) |
| IL.AddCmd0(IL.opACC); |
| IL.AddJmpCmd(IL.opJNZ, label); |
| IL.drop |
| END |
| END; |
| 2131,69 → 2093,47 |
| CASE op OF |
| |SCAN.lxPLUS, SCAN.lxMINUS: |
| minus := op = SCAN.lxMINUS; |
| IF minus THEN |
| IF op = SCAN.lxPLUS THEN |
| op := ORD("+") |
| ELSE |
| op := ORD("-") |
| ELSE |
| op := ORD("+") |
| END; |
| PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37); |
| PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
| IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
| CASE e.value.typ OF |
| |ARITH.tINTEGER: |
| PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39) |
| |ARITH.tREAL: |
| PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40) |
| |ARITH.tSET: |
| ARITH.opSet(e.value, e1.value, CHR(op)) |
| |ARITH.tCHAR, ARITH.tSTRING: |
| IF e.value.typ = ARITH.tCHAR THEN |
| ARITH.charToStr(e.value, s) |
| ELSE |
| s := e.value.string(SCAN.IDENT).s |
| END; |
| IF e1.value.typ = ARITH.tCHAR THEN |
| ARITH.charToStr(e1.value, s1) |
| ELSE |
| s1 := e1.value.string(SCAN.IDENT).s |
| END; |
| PARS.check(ARITH.concat(s, s1), pos, 5); |
| e.value.string := SCAN.enterid(s); |
| e.value.typ := ARITH.tSTRING; |
| e._type := PROG.program.stTypes.tSTRING |
| |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39) |
| |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40) |
| |ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op)) |
| END |
| ELSE |
| IF isInt(e) THEN |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value)) |
| IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value)) |
| IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
| ELSE |
| IL.AddCmd0(IL.opADD + ORD(minus)) |
| IL.AddCmd0(IL.opADD + ORD(op = ORD("-"))) |
| END |
| ELSIF isReal(e) THEN |
| IF e.obj = eCONST THEN |
| Float(parser, e); |
| IL.AddCmd0(IL.opADDF - ORD(minus)) |
| IL.Float(ARITH.Float(e.value)); |
| IL.fbinop(IL.opADDFI + ORD(op = ORD("-"))) |
| ELSIF e1.obj = eCONST THEN |
| Float(parser, e1); |
| IL.AddCmd0(IL.opADDF + ORD(minus)) |
| IL.Float(ARITH.Float(e1.value)); |
| IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
| ELSE |
| IL.AddCmd0(IL.opADDF + ORD(minus)) |
| IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
| END |
| ELSIF isSet(e) THEN |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value)) |
| IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value)) |
| IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
| ELSE |
| IL.AddCmd0(IL.opADDS + ORD(minus)) |
| IL.AddCmd0(IL.opADDS + ORD(op = ORD("-"))) |
| END |
| END; |
| e.obj := eEXPR |
| 2208,24 → 2148,15 |
| e.obj := eEXPR; |
| IF e1.obj = eCONST THEN |
| IL.Const(ORD(ARITH.getBool(e1.value))) |
| END; |
| IL.AddCmd0(IL.opACC) |
| END |
| END |
| END |
| END; |
| IF label # -1 THEN |
| label1 := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJZ, label1); |
| IL.SetLabel(label); |
| IL.Const(1); |
| IL.drop; |
| label := IL.NewLabel(); |
| IL.AddJmpCmd(IL.opJMP, label); |
| IL.SetLabel(label1); |
| IL.Const(0); |
| IL.SetLabel(label); |
| IL.AddCmd0(IL.opOR) |
| IL.SetLabel(label) |
| END |
| END SimpleExpression; |
| 2237,14 → 2168,12 |
| BEGIN |
| CASE op OF |
| |SCAN.lxEQ: res := ARITH.opEQ |
| |SCAN.lxNE: res := ARITH.opNE |
| |SCAN.lxLT: res := ARITH.opLT |
| |SCAN.lxLE: res := ARITH.opLE |
| |SCAN.lxGT: res := ARITH.opGT |
| |SCAN.lxGE: res := ARITH.opGE |
| |SCAN.lxIN: res := ARITH.opIN |
| |SCAN.lxIS: res := ARITH.opIS |
| |SCAN.lxEQ: res := 0 |
| |SCAN.lxNE: res := 1 |
| |SCAN.lxLT: res := 2 |
| |SCAN.lxLE: res := 3 |
| |SCAN.lxGT: res := 4 |
| |SCAN.lxGE: res := 5 |
| END |
| RETURN res |
| 2257,14 → 2186,12 |
| BEGIN |
| CASE op OF |
| |SCAN.lxEQ: res := ARITH.opEQ |
| |SCAN.lxNE: res := ARITH.opNE |
| |SCAN.lxLT: res := ARITH.opGT |
| |SCAN.lxLE: res := ARITH.opGE |
| |SCAN.lxGT: res := ARITH.opLT |
| |SCAN.lxGE: res := ARITH.opLE |
| |SCAN.lxIN: res := ARITH.opIN |
| |SCAN.lxIS: res := ARITH.opIS |
| |SCAN.lxEQ: res := 0 |
| |SCAN.lxNE: res := 1 |
| |SCAN.lxLT: res := 4 |
| |SCAN.lxLE: res := 5 |
| |SCAN.lxGT: res := 2 |
| |SCAN.lxGE: res := 3 |
| END |
| RETURN res |
| 2284,11 → 2211,9 |
| PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| cmp: INTEGER; |
| BEGIN |
| res := TRUE; |
| cmp := cmpcode(op); |
| IF isString(e) & isCharArray(e1) THEN |
| IL.StrAdr(String(e)); |
| 2295,26 → 2220,36 |
| IL.Const(strlen(e) + 1); |
| IL.AddCmd0(IL.opEQS + invcmpcode(op)) |
| ELSIF (isString(e) OR isStringW(e)) & isCharArrayW(e1) THEN |
| ELSIF isString(e) & isCharArrayW(e1) THEN |
| IL.StrAdr(StringW(e)); |
| IL.Const(utf8strlen(e) + 1); |
| IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
| ELSIF isStringW(e) & isCharArrayW(e1) THEN |
| IL.StrAdr(StringW(e)); |
| IL.Const(utf8strlen(e) + 1); |
| IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
| ELSIF isCharArray(e) & isString(e1) THEN |
| IL.StrAdr(String(e1)); |
| IL.Const(strlen(e1) + 1); |
| IL.AddCmd0(IL.opEQS + cmp) |
| IL.AddCmd0(IL.opEQS + cmpcode(op)) |
| ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN |
| ELSIF isCharArrayW(e) & isString(e1) THEN |
| IL.StrAdr(StringW(e1)); |
| IL.Const(utf8strlen(e1) + 1); |
| IL.AddCmd0(IL.opEQSW + cmp) |
| IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
| ELSIF isCharArrayW(e) & isStringW(e1) THEN |
| IL.StrAdr(StringW(e1)); |
| IL.Const(utf8strlen(e1) + 1); |
| IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
| ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN |
| IL.AddCmd0(IL.opEQSW + cmp) |
| IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
| ELSIF isCharArray(e) & isCharArray(e1) THEN |
| IL.AddCmd0(IL.opEQS + cmp) |
| IL.AddCmd0(IL.opEQS + cmpcode(op)) |
| ELSIF isString(e) & isString(e1) THEN |
| PARS.strcmp(e.value, e1.value, op) |
| 2332,8 → 2267,8 |
| getpos(parser, pos0); |
| SimpleExpression(parser, e); |
| IF relation(parser.sym) THEN |
| IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN |
| IL.Const(e._type.length) |
| IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN |
| IL.Const(e.type.length) |
| END; |
| op := parser.sym; |
| getpos(parser, pos); |
| 2342,50 → 2277,61 |
| getpos(parser, pos1); |
| SimpleExpression(parser, e1); |
| IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN |
| IL.Const(e1._type.length) |
| IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN |
| IL.Const(e1.type.length) |
| END; |
| constant := (e.obj = eCONST) & (e1.obj = eCONST); |
| CASE op OF |
| |SCAN.lxEQ: operator := "=" |
| |SCAN.lxNE: operator := "#" |
| |SCAN.lxLT: operator := "<" |
| |SCAN.lxLE: operator := "<=" |
| |SCAN.lxGT: operator := ">" |
| |SCAN.lxGE: operator := ">=" |
| |SCAN.lxIN: operator := "IN" |
| |SCAN.lxIS: operator := "" |
| END; |
| error := 0; |
| cmp := cmpcode(op); |
| CASE op OF |
| |SCAN.lxEQ, SCAN.lxNE: |
| eq := op = SCAN.lxEQ; |
| IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR |
| isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR |
| isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR |
| isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR |
| isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN |
| isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, cmp, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
| ELSE |
| IL.AddCmd0(IL.opEQ + cmp) |
| IL.AddCmd0(IL.opEQ + cmpcode(op)) |
| END |
| END |
| ELSIF isStringW1(e) & isCharW(e1) THEN |
| IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.IDENT).s)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
| ELSIF isStringW1(e1) & isCharW(e) THEN |
| IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
| ELSIF isBoolean(e) & isBoolean(e1) THEN |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, cmp, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| BoolCmp(eq, ARITH.Int(e.value) # 0) |
| BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0) |
| ELSIF e1.obj = eCONST THEN |
| BoolCmp(eq, ARITH.Int(e1.value) # 0) |
| BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0) |
| ELSE |
| IF eq THEN |
| IF op = SCAN.lxEQ THEN |
| IL.AddCmd0(IL.opEQB) |
| ELSE |
| IL.AddCmd0(IL.opNEB) |
| 2395,14 → 2341,14 |
| ELSIF isReal(e) & isReal(e1) THEN |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, cmp, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| Float(parser, e) |
| IL.Float(ARITH.Float(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| Float(parser, e1) |
| IL.Float(ARITH.Float(e1.value)) |
| END; |
| IL.AddCmd0(IL.opEQF + cmp) |
| IL.fcmp(IL.opEQF + cmpcode(op)) |
| END |
| ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN |
| 2411,7 → 2357,7 |
| END |
| ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN |
| IL.AddCmd0(IL.opEQC + cmp) |
| IL.AddCmd0(IL.opEQC + cmpcode(op)) |
| ELSIF isProc(e) & isNil(e1) THEN |
| IF e.obj IN {ePROC, eIMP} THEN |
| 2418,9 → 2364,9 |
| PARS.check(e.ident.global, pos0, 85); |
| constant := TRUE; |
| e.obj := eCONST; |
| ARITH.setbool(e.value, ~eq) |
| ARITH.setbool(e.value, op = SCAN.lxNE) |
| ELSE |
| IL.AddCmd0(IL.opEQC + cmp) |
| IL.AddCmd0(IL.opEQC + cmpcode(op)) |
| END |
| ELSIF isNil(e) & isProc(e1) THEN |
| 2428,12 → 2374,12 |
| PARS.check(e1.ident.global, pos1, 85); |
| constant := TRUE; |
| e.obj := eCONST; |
| ARITH.setbool(e.value, ~eq) |
| ARITH.setbool(e.value, op = SCAN.lxNE) |
| ELSE |
| IL.AddCmd0(IL.opEQC + cmp) |
| IL.AddCmd0(IL.opEQC + cmpcode(op)) |
| END |
| ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN |
| ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN |
| IF e.obj = ePROC THEN |
| PARS.check(e.ident.global, pos0, 85) |
| END; |
| 2443,27 → 2389,27 |
| IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN |
| constant := TRUE; |
| e.obj := eCONST; |
| IF eq THEN |
| IF op = SCAN.lxEQ THEN |
| ARITH.setbool(e.value, e.ident = e1.ident) |
| ELSE |
| ARITH.setbool(e.value, e.ident # e1.ident) |
| END |
| ELSIF e.obj = ePROC THEN |
| IL.ProcCmp(e.ident.proc.label, eq) |
| IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ) |
| ELSIF e1.obj = ePROC THEN |
| IL.ProcCmp(e1.ident.proc.label, eq) |
| IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ) |
| ELSIF e.obj = eIMP THEN |
| IL.ProcImpCmp(e.ident._import, eq) |
| IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ) |
| ELSIF e1.obj = eIMP THEN |
| IL.ProcImpCmp(e1.ident._import, eq) |
| IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ) |
| ELSE |
| IL.AddCmd0(IL.opEQ + cmp) |
| IL.AddCmd0(IL.opEQ + cmpcode(op)) |
| END |
| ELSIF isNil(e) & isNil(e1) THEN |
| constant := TRUE; |
| e.obj := eCONST; |
| ARITH.setbool(e.value, eq) |
| ARITH.setbool(e.value, op = SCAN.lxEQ) |
| ELSE |
| PARS.error(pos, 37) |
| 2476,14 → 2422,14 |
| isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, cmp, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value)) |
| ELSIF e1.obj = eCONST THEN |
| IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
| ELSE |
| IL.AddCmd0(IL.opEQ + cmp) |
| IL.AddCmd0(IL.opEQ + cmpcode(op)) |
| END |
| END |
| 2491,20 → 2437,20 |
| IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
| ELSIF isStringW1(e1) & isCharW(e) THEN |
| IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.IDENT).s)) |
| IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
| ELSIF isReal(e) & isReal(e1) THEN |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, cmp, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| Float(parser, e); |
| IL.AddCmd0(IL.opEQF + invcmpcode(op)) |
| IL.Float(ARITH.Float(e.value)); |
| IL.fcmp(IL.opEQF + invcmpcode(op)) |
| ELSIF e1.obj = eCONST THEN |
| Float(parser, e1); |
| IL.AddCmd0(IL.opEQF + cmp) |
| IL.Float(ARITH.Float(e1.value)); |
| IL.fcmp(IL.opEQF + cmpcode(op)) |
| ELSE |
| IL.AddCmd0(IL.opEQF + cmp) |
| IL.fcmp(IL.opEQF + cmpcode(op)) |
| END |
| END |
| 2523,7 → 2469,7 |
| PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56) |
| END; |
| IF constant THEN |
| ARITH.relation(e.value, e1.value, ARITH.opIN, error) |
| ARITH.relation(e.value, e1.value, operator, error) |
| ELSE |
| IF e.obj = eCONST THEN |
| IL.AddCmd(IL.opINL, ARITH.Int(e.value)) |
| 2540,25 → 2486,25 |
| IF isRec(e) THEN |
| PARS.check(e.obj = eVREC, pos0, 78); |
| PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80); |
| PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80); |
| IF e.ident = NIL THEN |
| IL.TypeCheck(e1._type.num) |
| IL.TypeCheck(e1.type.num) |
| ELSE |
| IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
| IL.TypeCheckRec(e1._type.num) |
| IL.TypeCheckRec(e1.type.num) |
| END |
| ELSE |
| PARS.check(e1._type.typ = PROG.tPOINTER, pos1, 81); |
| IL.TypeCheck(e1._type.base.num) |
| PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81); |
| IL.TypeCheck(e1.type.base.num) |
| END; |
| PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82) |
| PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82) |
| END; |
| ASSERT(error = 0); |
| e._type := tBOOLEAN; |
| e.type := tBOOLEAN; |
| IF ~constant THEN |
| e.obj := eEXPR |
| 2574,6 → 2520,7 |
| pos: PARS.POSITION; |
| line: INTEGER; |
| call: BOOLEAN; |
| fregs: INTEGER; |
| BEGIN |
| getpos(parser, pos); |
| 2594,7 → 2541,7 |
| IL.setlast(endcall.prev(IL.COMMAND)); |
| PARS.check(assign(parser, e1, e._type, line), pos, 91); |
| PARS.check(assign(e1, e.type, line), pos, 91); |
| IF e1.obj = ePROC THEN |
| PARS.check(e1.ident.global, pos, 85) |
| END; |
| 2604,7 → 2551,7 |
| ELSIF parser.sym = SCAN.lxLROUND THEN |
| e1 := e; |
| ActualParameters(parser, e1); |
| PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92); |
| PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92); |
| call := TRUE |
| ELSE |
| IF e.obj IN {eSYSPROC, eSTPROC} THEN |
| 2612,8 → 2559,8 |
| call := FALSE |
| ELSE |
| PARS.check(isProc(e), pos, 86); |
| PARS.check((e._type.base = NIL) OR ODD(e._type.call), pos, 92); |
| PARS.check1(e._type.params.first = NIL, parser, 64); |
| PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92); |
| PARS.check1(e.type.params.first = NIL, parser, 64); |
| call := TRUE |
| END |
| END; |
| 2620,9 → 2567,9 |
| IF call THEN |
| IF e.obj IN {ePROC, eIMP} THEN |
| ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE) |
| ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE) |
| ELSIF isExpr(e) THEN |
| ProcCall(e, e._type, FALSE, parser, pos, TRUE) |
| ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE) |
| END |
| END; |
| 2630,7 → 2577,7 |
| END ElementaryStatement; |
| PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN); |
| PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); |
| VAR |
| e: PARS.EXPR; |
| pos: PARS.POSITION; |
| 2640,7 → 2587,7 |
| BEGIN |
| L := IL.NewLabel(); |
| IF ~_if THEN |
| IF ~if THEN |
| IL.AddCmd0(IL.opLOOP); |
| IL.SetLabel(L) |
| END; |
| 2658,10 → 2605,10 |
| IL.AddJmpCmd(IL.opJMP, label) |
| END |
| ELSE |
| IL.AndOrOpt(label) |
| IL.AddJmpCmd(IL.opJNE, label) |
| END; |
| IF _if THEN |
| IF if THEN |
| PARS.checklex(parser, SCAN.lxTHEN) |
| ELSE |
| PARS.checklex(parser, SCAN.lxDO) |
| 2670,25 → 2617,25 |
| PARS.Next(parser); |
| parser.StatSeq(parser); |
| IF ~_if OR (parser.sym # SCAN.lxEND) THEN |
| IL.AddJmpCmd(IL.opJMP, L) |
| END; |
| IL.AddJmpCmd(IL.opJMP, L); |
| IL.SetLabel(label) |
| UNTIL parser.sym # SCAN.lxELSIF; |
| IF _if THEN |
| IF if THEN |
| IF parser.sym = SCAN.lxELSE THEN |
| PARS.Next(parser); |
| parser.StatSeq(parser) |
| END; |
| IL.SetLabel(L) |
| ELSE |
| IL.AddCmd0(IL.opENDLOOP) |
| END; |
| PARS.checklex(parser, SCAN.lxEND); |
| IF ~if THEN |
| IL.AddCmd0(IL.opENDLOOP) |
| END; |
| PARS.Next(parser) |
| END IfStatement; |
| 2698,7 → 2645,6 |
| e: PARS.EXPR; |
| pos: PARS.POSITION; |
| label: INTEGER; |
| L: IL.COMMAND; |
| BEGIN |
| IL.AddCmd0(IL.opLOOP); |
| 2705,7 → 2651,6 |
| label := IL.NewLabel(); |
| IL.SetLabel(label); |
| L := IL.getlast(); |
| PARS.Next(parser); |
| parser.StatSeq(parser); |
| 2719,8 → 2664,7 |
| IL.AddJmpCmd(IL.opJMP, label) |
| END |
| ELSE |
| IL.AndOrOpt(label); |
| L.param1 := label |
| IL.AddJmpCmd(IL.opJNE, label) |
| END; |
| IL.AddCmd0(IL.opENDLOOP) |
| 2780,7 → 2724,7 |
| pos: PARS.POSITION; |
| PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER; |
| PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; |
| VAR |
| a: INTEGER; |
| label: PARS.EXPR; |
| 2789,7 → 2733,7 |
| BEGIN |
| getpos(parser, pos); |
| _type := NIL; |
| type := NIL; |
| IF isChar(caseExpr) THEN |
| PARS.ConstExpression(parser, value); |
| 2810,13 → 2754,13 |
| ELSIF isRecPtr(caseExpr) THEN |
| qualident(parser, label); |
| PARS.check(label.obj = eTYPE, pos, 79); |
| PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99); |
| PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99); |
| IF isRec(caseExpr) THEN |
| a := label._type.num |
| a := label.type.num |
| ELSE |
| a := label._type.base.num |
| a := label.type.base.num |
| END; |
| _type := label._type |
| type := label.type |
| END |
| RETURN a |
| 2823,12 → 2767,12 |
| END Label; |
| PROCEDURE CheckType (node: AVL.NODE; _type: PROG._TYPE; parser: PARS.PARSER; pos: PARS.POSITION); |
| PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION); |
| BEGIN |
| IF node # NIL THEN |
| PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL)._type, _type) OR PROG.isBaseOf(_type, node.data(CASE_LABEL)._type)), pos, 100); |
| CheckType(node.left, _type, parser, pos); |
| CheckType(node.right, _type, parser, pos) |
| PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100); |
| CheckType(node.left, type, parser, pos); |
| CheckType(node.right, type, parser, pos) |
| END |
| END CheckType; |
| 2854,12 → 2798,12 |
| label.self := IL.NewLabel(); |
| getpos(parser, pos1); |
| range.a := Label(parser, caseExpr, label._type); |
| range.a := Label(parser, caseExpr, label.type); |
| IF parser.sym = SCAN.lxRANGE THEN |
| PARS.check1(~isRecPtr(caseExpr), parser, 53); |
| NextPos(parser, pos); |
| range.b := Label(parser, caseExpr, label._type); |
| range.b := Label(parser, caseExpr, label.type); |
| PARS.check(range.a <= range.b, pos, 103) |
| ELSE |
| range.b := range.a |
| 2868,7 → 2812,7 |
| label.range := range; |
| IF isRecPtr(caseExpr) THEN |
| CheckType(tree, label._type, parser, pos1) |
| CheckType(tree, label.type, parser, pos1) |
| END; |
| tree := AVL.insert(tree, label, LabelCmp, newnode, node); |
| PARS.check(newnode, pos1, 100) |
| 2899,10 → 2843,10 |
| END CaseLabelList; |
| PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER); |
| PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER); |
| VAR |
| sym: INTEGER; |
| t: PROG._TYPE; |
| t: PROG.TYPE_; |
| variant: INTEGER; |
| node: AVL.NODE; |
| last: IL.COMMAND; |
| 2915,8 → 2859,8 |
| PARS.checklex(parser, SCAN.lxCOLON); |
| PARS.Next(parser); |
| IF isRecPtr(caseExpr) THEN |
| t := caseExpr._type; |
| caseExpr.ident._type := node.data(CASE_LABEL)._type |
| t := caseExpr.type; |
| caseExpr.ident.type := node.data(CASE_LABEL).type |
| END; |
| last := IL.getlast(); |
| 2927,16 → 2871,16 |
| END; |
| parser.StatSeq(parser); |
| IL.AddJmpCmd(IL.opJMP, _end); |
| IL.AddJmpCmd(IL.opJMP, end); |
| IF isRecPtr(caseExpr) THEN |
| caseExpr.ident._type := t |
| caseExpr.ident.type := t |
| END |
| END |
| END _case; |
| END case; |
| PROCEDURE Table (node: AVL.NODE; _else: INTEGER); |
| PROCEDURE Table (node: AVL.NODE; else: INTEGER); |
| VAR |
| L, R: INTEGER; |
| range: RANGE; |
| 2953,7 → 2897,7 |
| IF left # NIL THEN |
| L := left.data(CASE_LABEL).self |
| ELSE |
| L := _else |
| L := else |
| END; |
| right := node.right; |
| 2960,7 → 2904,7 |
| IF right # NIL THEN |
| R := right.data(CASE_LABEL).self |
| ELSE |
| R := _else |
| R := else |
| END; |
| last := IL.getlast(); |
| 2974,7 → 2918,7 |
| IL.setlast(v.cmd); |
| IL.SetLabel(node.data(CASE_LABEL).self); |
| IL._case(range.a, range.b, L, R); |
| IL.case(range.a, range.b, L, R); |
| IF v.processed THEN |
| IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant) |
| END; |
| 2982,8 → 2926,8 |
| IL.setlast(last); |
| Table(left, _else); |
| Table(right, _else) |
| Table(left, else); |
| Table(right, else) |
| END |
| END Table; |
| 2991,7 → 2935,8 |
| PROCEDURE TableT (node: AVL.NODE); |
| BEGIN |
| IF node # NIL THEN |
| IL.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a); |
| IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); |
| TableT(node.left); |
| TableT(node.right) |
| END |
| 3000,14 → 2945,14 |
| PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION); |
| VAR |
| table, _end, _else: INTEGER; |
| table, end, else: INTEGER; |
| tree: AVL.NODE; |
| item: LISTS.ITEM; |
| BEGIN |
| LISTS.push(CaseVariants, NewVariant(0, NIL)); |
| _end := IL.NewLabel(); |
| _else := IL.NewLabel(); |
| end := IL.NewLabel(); |
| else := IL.NewLabel(); |
| table := IL.NewLabel(); |
| IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e))); |
| IL.AddJmpCmd(IL.opJMP, table); |
| 3014,17 → 2959,17 |
| tree := NIL; |
| _case(parser, e, tree, _end); |
| case(parser, e, tree, end); |
| WHILE parser.sym = SCAN.lxBAR DO |
| PARS.Next(parser); |
| _case(parser, e, tree, _end) |
| case(parser, e, tree, end) |
| END; |
| IL.SetLabel(_else); |
| IL.SetLabel(else); |
| IF parser.sym = SCAN.lxELSE THEN |
| PARS.Next(parser); |
| parser.StatSeq(parser); |
| IL.AddJmpCmd(IL.opJMP, _end) |
| IL.AddJmpCmd(IL.opJMP, end) |
| ELSE |
| IL.OnError(pos.line, errCASE) |
| END; |
| 3035,14 → 2980,14 |
| IF isRecPtr(e) THEN |
| IL.SetLabel(table); |
| TableT(tree); |
| IL.AddJmpCmd(IL.opJMP, _else) |
| IL.AddJmpCmd(IL.opJMP, else) |
| ELSE |
| tree.data(CASE_LABEL).self := table; |
| Table(tree, _else) |
| Table(tree, else) |
| END; |
| AVL.destroy(tree, DestroyLabel); |
| IL.SetLabel(_end); |
| IL.SetLabel(end); |
| IL.AddCmd0(IL.opENDSW); |
| REPEAT |
| 3103,13 → 3048,13 |
| ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE); |
| PARS.check1(ident # NIL, parser, 48); |
| PARS.check1(ident.typ = PROG.idVAR, parser, 93); |
| PARS.check1(ident._type = tINTEGER, parser, 97); |
| PARS.check1(ident.type = tINTEGER, parser, 97); |
| PARS.ExpectSym(parser, SCAN.lxASSIGN); |
| NextPos(parser, pos); |
| expression(parser, e); |
| PARS.check(isInt(e), pos, 76); |
| offset := PROG.getOffset(ident); |
| offset := PROG.getOffset(PARS.program, ident); |
| IF ident.global THEN |
| IL.AddCmd(IL.opGADR, offset) |
| 3130,7 → 3075,7 |
| ELSE |
| IL.AddCmd(IL.opLADR, -offset) |
| END; |
| IL.load(ident._type.size); |
| IL.load(ident.type.size); |
| PARS.checklex(parser, SCAN.lxTO); |
| NextPos(parser, pos2); |
| 3167,7 → 3112,7 |
| END |
| END; |
| IL.AddJmpCmd(IL.opJZ, L2); |
| IL.AddJmpCmd(IL.opJNE, L2); |
| PARS.checklex(parser, SCAN.lxDO); |
| PARS.Next(parser); |
| 3226,7 → 3171,7 |
| END StatSeq; |
| PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN; |
| PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| 3234,20 → 3179,24 |
| res := assigncomp(e, t); |
| IF res THEN |
| IF e.obj = eCONST THEN |
| IF e._type = tREAL THEN |
| Float(parser, e) |
| ELSIF e._type.typ = PROG.tNIL THEN |
| IF e.type = tREAL THEN |
| IL.Float(ARITH.Float(e.value)) |
| ELSIF e.type.typ = PROG.tNIL THEN |
| IL.Const(0) |
| ELSE |
| LoadConst(e) |
| END |
| ELSIF (e._type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN |
| ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN |
| CheckRange(256, pos.line, errBYTE) |
| ELSIF e.obj = ePROC THEN |
| PARS.check(e.ident.global, pos, 85); |
| IL.PushProc(e.ident.proc.label) |
| ELSIF e.obj = eIMP THEN |
| IL.PushImpProc(e.ident._import) |
| IL.PushImpProc(e.ident.import) |
| END; |
| IF e.type = tREAL THEN |
| IL.retf |
| END |
| END |
| 3267,8 → 3216,8 |
| BEGIN |
| id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); |
| IF (id # NIL) & (id._import # NIL) THEN |
| IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label); |
| IF (id # NIL) & (id.import # NIL) THEN |
| IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label); |
| id.proc.used := TRUE |
| ELSIF (id # NIL) & (id.proc # NIL) THEN |
| IL.set_rtl(idx, id.proc.label); |
| 3280,7 → 3229,7 |
| BEGIN |
| rtl := PROG.program.rtl; |
| rtl := PARS.program.rtl; |
| ASSERT(rtl # NIL); |
| getproc(rtl, "_strcmp", IL._strcmp); |
| 3307,7 → 3256,7 |
| getproc(rtl, "_isrec", IL._isrec); |
| getproc(rtl, "_dllentry", IL._dllentry); |
| getproc(rtl, "_sofinit", IL._sofinit) |
| ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} THEN |
| ELSIF CPU = TARGETS.cpuTHUMB THEN |
| getproc(rtl, "_fmul", IL._fmul); |
| getproc(rtl, "_fdiv", IL._fdiv); |
| getproc(rtl, "_fdivi", IL._fdivi); |
| 3318,11 → 3267,8 |
| getproc(rtl, "_floor", IL._floor); |
| getproc(rtl, "_flt", IL._flt); |
| getproc(rtl, "_pack", IL._pack); |
| getproc(rtl, "_unpk", IL._unpk); |
| IF CPU = TARGETS.cpuRVM32I THEN |
| getproc(rtl, "_error", IL._error) |
| getproc(rtl, "_unpk", IL._unpk) |
| END |
| END |
| END setrtl; |
| 3333,13 → 3279,13 |
| ext: PARS.PATH; |
| BEGIN |
| tINTEGER := PROG.program.stTypes.tINTEGER; |
| tBYTE := PROG.program.stTypes.tBYTE; |
| tCHAR := PROG.program.stTypes.tCHAR; |
| tSET := PROG.program.stTypes.tSET; |
| tBOOLEAN := PROG.program.stTypes.tBOOLEAN; |
| tWCHAR := PROG.program.stTypes.tWCHAR; |
| tREAL := PROG.program.stTypes.tREAL; |
| tINTEGER := PARS.program.stTypes.tINTEGER; |
| tBYTE := PARS.program.stTypes.tBYTE; |
| tCHAR := PARS.program.stTypes.tCHAR; |
| tSET := PARS.program.stTypes.tSET; |
| tBOOLEAN := PARS.program.stTypes.tBOOLEAN; |
| tWCHAR := PARS.program.stTypes.tWCHAR; |
| tREAL := PARS.program.stTypes.tREAL; |
| Options := options; |
| CPU := TARGETS.CPU; |
| 3353,7 → 3299,7 |
| IL.init(CPU); |
| IF TARGETS.RTL THEN |
| IF CPU # TARGETS.cpuMSP430 THEN |
| parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
| IF parser.open(parser, UTILS.RTL_NAME) THEN |
| parser.parse(parser); |
| 3381,17 → 3327,17 |
| PARS.destroy(parser); |
| IF PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN |
| IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN |
| ERRORS.Error(204) |
| END; |
| IF TARGETS.RTL THEN |
| IF CPU # TARGETS.cpuMSP430 THEN |
| setrtl |
| END; |
| PROG.DelUnused(IL.DelImport); |
| PROG.DelUnused(PARS.program, IL.DelImport); |
| IL.set_bss(PROG.program.bss); |
| IL.set_bss(PARS.program.bss); |
| CASE CPU OF |
| |TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options) |
| 3398,7 → 3344,6 |
| |TARGETS.cpuX86: X86.CodeGen(outname, target, options) |
| |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options) |
| |TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options) |
| |TARGETS.cpuRVM32I: RVM32I.CodeGen(outname, target, options) |
| END |
| END compile; |
| /programs/develop/oberon07/Source/STRINGS.ob07 |
|---|
| 10,20 → 10,9 |
| IMPORT UTILS; |
| PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); |
| BEGIN |
| WHILE count > 0 DO |
| dst[dpos] := src[spos]; |
| INC(spos); |
| INC(dpos); |
| DEC(count) |
| END |
| END copy; |
| PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
| VAR |
| n1, n2: INTEGER; |
| n1, n2, i, j: INTEGER; |
| BEGIN |
| n1 := LENGTH(s1); |
| 31,14 → 20,43 |
| ASSERT(n1 + n2 < LEN(s1)); |
| copy(s2, s1, 0, n1, n2); |
| s1[n1 + n2] := 0X |
| i := 0; |
| j := n1; |
| WHILE i < n2 DO |
| s1[j] := s2[i]; |
| INC(i); |
| INC(j) |
| END; |
| s1[j] := 0X |
| END append; |
| PROCEDURE reverse (VAR s: ARRAY OF CHAR); |
| VAR |
| i, j: INTEGER; |
| a, b: CHAR; |
| BEGIN |
| i := 0; |
| j := LENGTH(s) - 1; |
| WHILE i < j DO |
| a := s[i]; |
| b := s[j]; |
| s[i] := b; |
| s[j] := a; |
| INC(i); |
| DEC(j) |
| END |
| END reverse; |
| PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR); |
| VAR |
| i, a: INTEGER; |
| minus: BOOLEAN; |
| BEGIN |
| IF x = UTILS.minint THEN |
| 49,35 → 67,48 |
| END |
| ELSE |
| minus := x < 0; |
| IF minus THEN |
| x := -x |
| END; |
| i := 0; |
| IF x < 0 THEN |
| x := -x; |
| i := 1; |
| str[0] := "-" |
| a := 0; |
| REPEAT |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10; |
| INC(i) |
| UNTIL x = 0; |
| IF minus THEN |
| str[i] := "-"; |
| INC(i) |
| END; |
| a := x; |
| REPEAT |
| INC(i); |
| a := a DIV 10 |
| UNTIL a = 0; |
| str[i] := 0X; |
| reverse(str) |
| REPEAT |
| DEC(i); |
| str[i] := CHR(x MOD 10 + ORD("0")); |
| x := x DIV 10 |
| UNTIL x = 0 |
| END |
| END IntToStr; |
| PROCEDURE hexdgt (n: BYTE): BYTE; |
| BEGIN |
| IF n < 10 THEN |
| n := n + ORD("0") |
| ELSE |
| n := n - 10 + ORD("A") |
| END |
| RETURN n |
| END hexdgt; |
| PROCEDURE IntToHex* (x: INTEGER; VAR str: ARRAY OF CHAR; n: INTEGER); |
| BEGIN |
| str[n] := 0X; |
| WHILE n > 0 DO |
| str[n - 1] := CHR(UTILS.hexdgt(x MOD 16)); |
| str[n - 1] := CHR(hexdgt(x MOD 16)); |
| x := x DIV 16; |
| DEC(n) |
| END |
| 84,6 → 115,17 |
| END IntToHex; |
| PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); |
| BEGIN |
| WHILE count > 0 DO |
| dst[dpos] := src[spos]; |
| INC(spos); |
| INC(dpos); |
| DEC(count) |
| END |
| END copy; |
| PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN); |
| VAR |
| length: INTEGER; |
| 143,10 → 185,10 |
| i: INTEGER; |
| BEGIN |
| i := LENGTH(str) - 1; |
| WHILE i >= 0 DO |
| i := 0; |
| WHILE (i < LEN(str)) & (str[i] # 0X) DO |
| cap(str[i]); |
| DEC(i) |
| INC(i) |
| END |
| END UpCase; |
| /programs/develop/oberon07/Source/TARGETS.ob07 |
|---|
| 24,19 → 24,13 |
| Linux64* = 11; |
| Linux64SO* = 12; |
| STM32CM3* = 13; |
| RVM32I* = 14; |
| cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3; |
| cpuRVM32I* = 4; |
| osNONE* = 0; osWIN32* = 1; osWIN64* = 2; |
| osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5; |
| noDISPOSE = {MSP430, STM32CM3, RVM32I}; |
| noRTL = {MSP430}; |
| TYPE |
| STRING = ARRAY 32 OF CHAR; |
| 43,7 → 37,7 |
| TARGET = RECORD |
| target, CPU, OS, RealSize: INTEGER; |
| target, CPU, BitDepth, OS, RealSize: INTEGER; |
| ComLinePar*, LibDir, FileExt: STRING |
| END; |
| 51,23 → 45,18 |
| VAR |
| Targets*: ARRAY 15 OF TARGET; |
| Targets*: ARRAY 14 OF TARGET; |
| CPUs: ARRAY 5 OF |
| RECORD |
| BitDepth, InstrSize: INTEGER; |
| LittleEndian: BOOLEAN |
| END; |
| target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER; |
| target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*: INTEGER; |
| ComLinePar*, LibDir*, FileExt*: STRING; |
| Import*, Dispose*, RTL*, Dll*, LittleEndian*: BOOLEAN; |
| Import*, Dispose*, Dll*: BOOLEAN; |
| PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); |
| PROCEDURE Enter (idx, CPU, BitDepth, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); |
| BEGIN |
| Targets[idx].target := idx; |
| Targets[idx].CPU := CPU; |
| Targets[idx].BitDepth := BitDepth; |
| Targets[idx].RealSize := RealSize; |
| Targets[idx].OS := OS; |
| Targets[idx].ComLinePar := ComLinePar; |
| 91,9 → 80,7 |
| IF res THEN |
| target := Targets[i].target; |
| CPU := Targets[i].CPU; |
| BitDepth := CPUs[CPU].BitDepth; |
| InstrSize := CPUs[CPU].InstrSize; |
| LittleEndian := CPUs[CPU].LittleEndian; |
| BitDepth := Targets[i].BitDepth; |
| RealSize := Targets[i].RealSize; |
| OS := Targets[i].OS; |
| ComLinePar := Targets[i].ComLinePar; |
| 101,8 → 88,7 |
| FileExt := Targets[i].FileExt; |
| Import := OS IN {osWIN32, osWIN64, osKOS}; |
| Dispose := ~(target IN noDISPOSE); |
| RTL := ~(target IN noRTL); |
| Dispose := ~(target IN {MSP430, STM32CM3}); |
| Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; |
| WordSize := BitDepth DIV 8; |
| AdrSize := WordSize |
| 112,34 → 98,19 |
| END Select; |
| PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN); |
| BEGIN |
| CPUs[cpu].BitDepth := BitDepth; |
| CPUs[cpu].InstrSize := InstrSize; |
| CPUs[cpu].LittleEndian := LittleEndian |
| END EnterCPU; |
| BEGIN |
| EnterCPU(cpuX86, 32, 1, TRUE); |
| EnterCPU(cpuAMD64, 64, 1, TRUE); |
| EnterCPU(cpuMSP430, 16, 2, TRUE); |
| EnterCPU(cpuTHUMB, 32, 2, TRUE); |
| EnterCPU(cpuRVM32I, 32, 4, TRUE); |
| Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex"); |
| Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows32", ".exe"); |
| Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows32", ".exe"); |
| Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows32", ".dll"); |
| Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", ""); |
| Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj"); |
| Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows64", ".exe"); |
| Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows64", ".exe"); |
| Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows64", ".dll"); |
| Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux32", ""); |
| Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux32", ".so"); |
| Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux64", ""); |
| Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux64", ".so"); |
| Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); |
| Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", "RVM32I", ".bin"); |
| Enter( MSP430, cpuMSP430, 16, 0, osNONE, "msp430", "MSP430", ".hex"); |
| Enter( Win32C, cpuX86, 32, 8, osWIN32, "win32con", "Windows32", ".exe"); |
| Enter( Win32GUI, cpuX86, 32, 8, osWIN32, "win32gui", "Windows32", ".exe"); |
| Enter( Win32DLL, cpuX86, 32, 8, osWIN32, "win32dll", "Windows32", ".dll"); |
| Enter( KolibriOS, cpuX86, 32, 8, osKOS, "kosexe", "KolibriOS", ""); |
| Enter( KolibriOSDLL, cpuX86, 32, 8, osKOS, "kosdll", "KolibriOS", ".obj"); |
| Enter( Win64C, cpuAMD64, 64, 8, osWIN64, "win64con", "Windows64", ".exe"); |
| Enter( Win64GUI, cpuAMD64, 64, 8, osWIN64, "win64gui", "Windows64", ".exe"); |
| Enter( Win64DLL, cpuAMD64, 64, 8, osWIN64, "win64dll", "Windows64", ".dll"); |
| Enter( Linux32, cpuX86, 32, 8, osLINUX32, "linux32exe", "Linux32", ""); |
| Enter( Linux32SO, cpuX86, 32, 8, osLINUX32, "linux32so", "Linux32", ".so"); |
| Enter( Linux64, cpuAMD64, 64, 8, osLINUX64, "linux64exe", "Linux64", ""); |
| Enter( Linux64SO, cpuAMD64, 64, 8, osLINUX64, "linux64so", "Linux64", ".so"); |
| Enter( STM32CM3, cpuTHUMB, 32, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); |
| END TARGETS. |
| /programs/develop/oberon07/Source/TEXTDRV.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 28,16 → 28,9 |
| CR: BOOLEAN; |
| line*, col*: INTEGER; |
| ifc*: INTEGER; |
| elsec*: INTEGER; |
| eof*: BOOLEAN; |
| eol*: BOOLEAN; |
| skip*: BOOLEAN; |
| peak*: CHAR; |
| _skip*, |
| _elsif*, |
| _else*: ARRAY 100 OF BOOLEAN; |
| fname*: ARRAY 2048 OF CHAR |
| peak*: CHAR |
| END; |
| 168,13 → 161,8 |
| text.col := 1; |
| text.eof := FALSE; |
| text.eol := FALSE; |
| text.skip := FALSE; |
| text.ifc := 0; |
| text.elsec := 0; |
| text._skip[0] := FALSE; |
| text.peak := 0X; |
| text.file := FILES.open(name); |
| COPY(name, text.fname); |
| IF text.file # NIL THEN |
| load(text); |
| init(text) |
| /programs/develop/oberon07/Source/THUMB.ob07 |
|---|
| 616,14 → 616,14 |
| PROCEDURE SetIV (idx, label, CodeAdr: INTEGER); |
| VAR |
| l, h: LISTS.ITEM; |
| l, h: ANYCODE; |
| BEGIN |
| l := CodeList.first; |
| h := l.next; |
| l := CodeList.first(ANYCODE); |
| h := l.next(ANYCODE); |
| WHILE idx > 0 DO |
| l := h.next; |
| h := l.next; |
| l := h.next(ANYCODE); |
| h := l.next(ANYCODE); |
| DEC(idx) |
| END; |
| label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1; |
| 784,9 → 784,8 |
| PROCEDURE xchg (r1, r2: INTEGER); |
| BEGIN |
| push(r1); |
| mov(r1, r2); |
| pop(r2) |
| push(r1); push(r2); |
| pop(r1); pop(r2) |
| END xchg; |
| 1093,7 → 1092,7 |
| |IL.opCALLP: |
| UnOp(r1); |
| AddImm8(r1, 1); (* Thumb mode *) |
| AddImm8(r1, 1); |
| gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *) |
| drop; |
| ASSERT(R.top = -1) |
| 1177,7 → 1176,7 |
| |IL.opERR: |
| call(genTrap) |
| |IL.opNOP, IL.opAND, IL.opOR: |
| |IL.opNOP: |
| |IL.opSADR: |
| reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2) |
| 1348,25 → 1347,37 |
| SetCC(jne, r1) |
| END |
| |IL.opACC: |
| IF (R.top # 0) OR (R.stk[0] # ACC) THEN |
| PushAll(0); |
| GetRegA; |
| pop(ACC); |
| DEC(R.pushed) |
| END |
| |IL.opDROP: |
| UnOp(r1); |
| drop |
| |IL.opJNZ1: |
| |IL.opJNZ: |
| UnOp(r1); |
| cbnz(r1, param1) |
| |IL.opJZ: |
| UnOp(r1); |
| cbz(r1, param1) |
| |IL.opJG: |
| UnOp(r1); |
| Tst(r1); |
| jcc(jg, param1) |
| |IL.opJNZ: |
| |IL.opJE: |
| UnOp(r1); |
| cbnz(r1, param1); |
| drop |
| |IL.opJZ: |
| |IL.opJNE: |
| UnOp(r1); |
| cbz(r1, param1); |
| drop |
| 1424,10 → 1435,10 |
| cc := cond(opcode); |
| next := cmd.next(COMMAND); |
| IF next.opcode = IL.opJNZ THEN |
| IF next.opcode = IL.opJE THEN |
| jcc(cc, next.param1); |
| cmd := next |
| ELSIF next.opcode = IL.opJZ THEN |
| ELSIF next.opcode = IL.opJNE THEN |
| jcc(inv0(cc), next.param1); |
| cmd := next |
| ELSE |
| 1476,7 → 1487,7 |
| END; |
| drop |
| |IL.opADDC: |
| |IL.opADDL, IL.opADDR: |
| UnOp(r1); |
| AddConst(r1, param2) |
| 1750,7 → 1761,7 |
| gen4(14, r2, r1); (* bic r1, r2 *) |
| drop |
| |IL.opADDSC: |
| |IL.opADDSL, IL.opADDSR: |
| MovConst(GetAnyReg(), param2); |
| BinOp(r1, r2); |
| gen4(12, r2, r1); (* orr r1, r2 *) |
| 2003,7 → 2014,7 |
| CallRTL(IL._fdivi, 2); |
| GetRegA |
| |IL.opADDF: |
| |IL.opADDF, IL.opADDFI: |
| PushAll(2); |
| CallRTL(IL._fadd, 2); |
| GetRegA |
| 2325,6 → 2336,8 |
| DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER; |
| File: WR.FILE; |
| BEGIN |
| IF target = TARGETS.STM32CM3 THEN |
| CortexM3 |
| 2374,12 → 2387,12 |
| ERRORS.Error(204) |
| END; |
| WR.Create(outname); |
| File := WR.Create(outname); |
| HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr)); |
| HEX.End; |
| HEX.Data2(File, program.code, 0, CodeSize, high(Target.FlashAdr)); |
| HEX.End(File); |
| WR.Close; |
| WR.Close(File); |
| C.StringLn("--------------------------------------------"); |
| C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)"); |
| /programs/develop/oberon07/Source/UTILS.ob07 |
|---|
| 13,17 → 13,18 |
| CONST |
| slash* = HOST.slash; |
| eol* = HOST.eol; |
| bit_depth* = HOST.bit_depth; |
| maxint* = HOST.maxint; |
| minint* = HOST.minint; |
| OS = HOST.OS; |
| min32* = -2147483647-1; |
| max32* = 2147483647; |
| vMajor* = 1; |
| vMinor* = 43; |
| vMinor* = 29; |
| FILE_EXT* = ".ob07"; |
| RTL_NAME* = "RTL"; |
| 31,10 → 32,17 |
| MAX_GLOBAL_SIZE* = 1600000000; |
| TYPE |
| DAYS = ARRAY 12, 31, 2 OF INTEGER; |
| VAR |
| time*: INTEGER; |
| eol*: ARRAY 3 OF CHAR; |
| maxreal*: REAL; |
| target*: |
| 53,7 → 61,9 |
| bit_diff*: INTEGER; |
| days: DAYS; |
| PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
| RETURN HOST.FileRead(F, Buffer, bytes) |
| END FileRead; |
| 80,12 → 90,6 |
| END FileOpen; |
| PROCEDURE chmod* (FName: ARRAY OF CHAR); |
| BEGIN |
| HOST.chmod(FName) |
| END chmod; |
| PROCEDURE GetArg* (i: INTEGER; VAR str: ARRAY OF CHAR); |
| BEGIN |
| HOST.GetArg(i, str) |
| 130,8 → 134,25 |
| 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; |
| RETURN HOST.UnixTime() |
| VAR |
| year, month, day, hour, min, sec: INTEGER; |
| res: INTEGER; |
| BEGIN |
| IF OS = "LINUX" THEN |
| res := HOST.UnixTime() |
| ELSE |
| HOST.now(year, month, day, hour, min, sec); |
| res := GetUnixTime(year, month, day, hour, min, sec) |
| END |
| RETURN res |
| END UnixTime; |
| 208,19 → 229,51 |
| END Log2; |
| PROCEDURE hexdgt* (n: BYTE): BYTE; |
| PROCEDURE init (VAR days: DAYS); |
| VAR |
| i, j, n0, n1: INTEGER; |
| BEGIN |
| IF n < 10 THEN |
| INC(n, ORD("0")) |
| ELSE |
| INC(n, ORD("A") - 10) |
| FOR i := 0 TO 11 DO |
| FOR j := 0 TO 30 DO |
| days[i, j, 0] := 0; |
| days[i, j, 1] := 0; |
| END |
| END; |
| RETURN n |
| END hexdgt; |
| 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(); |
| maxreal := HOST.maxreal |
| COPY(HOST.eol, eol); |
| maxreal := HOST.maxreal; |
| init(days) |
| END UTILS. |
| /programs/develop/oberon07/Source/WRITER.ob07 |
|---|
| 1,7 → 1,7 |
| (* |
| BSD 2-Clause License |
| Copyright (c) 2018-2020, Anton Krotov |
| Copyright (c) 2018-2019, Anton Krotov |
| All rights reserved. |
| *) |
| 10,16 → 10,20 |
| IMPORT FILES, ERRORS, UTILS; |
| TYPE |
| FILE* = FILES.FILE; |
| VAR |
| counter*: INTEGER; |
| file: FILES.FILE; |
| PROCEDURE align* (n, _align: INTEGER): INTEGER; |
| PROCEDURE align (n, _align: INTEGER): INTEGER; |
| BEGIN |
| IF n MOD _align # 0 THEN |
| INC(n, _align - (n MOD _align)) |
| n := n + _align - (n MOD _align) |
| END |
| RETURN n |
| 26,7 → 30,7 |
| END align; |
| PROCEDURE WriteByte* (n: BYTE); |
| PROCEDURE WriteByte* (file: FILE; n: BYTE); |
| BEGIN |
| IF FILES.WriteByte(file, n) THEN |
| INC(counter) |
| 36,7 → 40,7 |
| END WriteByte; |
| PROCEDURE Write* (chunk: ARRAY OF BYTE; bytes: INTEGER); |
| PROCEDURE Write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER); |
| VAR |
| n: INTEGER; |
| 49,36 → 53,36 |
| END Write; |
| PROCEDURE Write64LE* (n: INTEGER); |
| PROCEDURE Write64LE* (file: FILE; n: INTEGER); |
| VAR |
| i: INTEGER; |
| BEGIN |
| FOR i := 0 TO 7 DO |
| WriteByte(UTILS.Byte(n, i)) |
| WriteByte(file, UTILS.Byte(n, i)) |
| END |
| END Write64LE; |
| PROCEDURE Write32LE* (n: INTEGER); |
| PROCEDURE Write32LE* (file: FILE; n: INTEGER); |
| VAR |
| i: INTEGER; |
| BEGIN |
| FOR i := 0 TO 3 DO |
| WriteByte(UTILS.Byte(n, i)) |
| WriteByte(file, UTILS.Byte(n, i)) |
| END |
| END Write32LE; |
| PROCEDURE Write16LE* (n: INTEGER); |
| PROCEDURE Write16LE* (file: FILE; n: INTEGER); |
| BEGIN |
| WriteByte(UTILS.Byte(n, 0)); |
| WriteByte(UTILS.Byte(n, 1)) |
| WriteByte(file, UTILS.Byte(n, 0)); |
| WriteByte(file, UTILS.Byte(n, 1)) |
| END Write16LE; |
| PROCEDURE Padding* (FileAlignment: INTEGER); |
| PROCEDURE Padding* (file: FILE; FileAlignment: INTEGER); |
| VAR |
| i: INTEGER; |
| 85,20 → 89,20 |
| BEGIN |
| i := align(counter, FileAlignment) - counter; |
| WHILE i > 0 DO |
| WriteByte(0); |
| WriteByte(file, 0); |
| DEC(i) |
| END |
| END Padding; |
| PROCEDURE Create* (FileName: ARRAY OF CHAR); |
| PROCEDURE Create* (FileName: ARRAY OF CHAR): FILE; |
| BEGIN |
| counter := 0; |
| file := FILES.create(FileName) |
| counter := 0 |
| RETURN FILES.create(FileName) |
| END Create; |
| PROCEDURE Close*; |
| PROCEDURE Close* (VAR file: FILE); |
| BEGIN |
| FILES.close(file) |
| END Close; |
| /programs/develop/oberon07/Source/X86.ob07 |
|---|
| 8,7 → 8,7 |
| MODULE X86; |
| IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG, |
| CHL := CHUNKLISTS, PATHS, TARGETS, ERRORS; |
| CHL := CHUNKLISTS, PATHS, TARGETS; |
| CONST |
| 22,8 → 22,6 |
| esp = 4; |
| ebp = 5; |
| MAX_FR = 7; |
| sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; |
| je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H; jnb = 83H; |
| 31,9 → 29,7 |
| CODECHUNK = 8; |
| FPR_ERR = 41; |
| TYPE |
| COMMAND = IL.COMMAND; |
| 96,11 → 92,7 |
| tcount: INTEGER; |
| FR: ARRAY 1000 OF INTEGER; |
| fname: PATHS.PATH; |
| PROCEDURE OutByte* (n: BYTE); |
| VAR |
| c: CODE; |
| 154,7 → 146,7 |
| END OutWord; |
| PROCEDURE isByte* (n: INTEGER): BOOLEAN; |
| PROCEDURE isByte (n: INTEGER): BOOLEAN; |
| RETURN (-128 <= n) & (n <= 127) |
| END isByte; |
| 190,24 → 182,24 |
| END shift; |
| PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); (* op reg1, reg2 *) |
| PROCEDURE mov (reg1, reg2: INTEGER); |
| BEGIN |
| OutByte2(op, 0C0H + 8 * reg2 + reg1) |
| END oprr; |
| OutByte2(89H, 0C0H + reg2 * 8 + reg1) (* mov reg1, reg2 *) |
| END mov; |
| PROCEDURE mov (reg1, reg2: INTEGER); (* mov reg1, reg2 *) |
| BEGIN |
| oprr(89H, reg1, reg2) |
| END mov; |
| PROCEDURE xchg (reg1, reg2: INTEGER); |
| VAR |
| regs: SET; |
| PROCEDURE xchg (reg1, reg2: INTEGER); (* xchg reg1, reg2 *) |
| BEGIN |
| IF eax IN {reg1, reg2} THEN |
| OutByte(90H + reg1 + reg2) |
| ELSE |
| oprr(87H, reg1, reg2) |
| regs := {reg1, reg2}; |
| IF regs = {eax, ecx} THEN |
| OutByte(91H) (* xchg eax, ecx *) |
| ELSIF regs = {eax, edx} THEN |
| OutByte(92H) (* xchg eax, edx *) |
| ELSIF regs = {ecx, edx} THEN |
| OutByte2(87H, 0D1H) (* xchg ecx, edx *) |
| END |
| END xchg; |
| 224,24 → 216,14 |
| END push; |
| PROCEDURE xor (reg1, reg2: INTEGER); (* xor reg1, reg2 *) |
| BEGIN |
| oprr(31H, reg1, reg2) |
| END xor; |
| PROCEDURE movrc (reg, n: INTEGER); |
| BEGIN |
| IF n = 0 THEN |
| xor(reg, reg) |
| ELSE |
| OutByte(0B8H + reg); (* mov reg, n *) |
| OutInt(n) |
| END |
| END movrc; |
| PROCEDURE pushc* (n: INTEGER); |
| PROCEDURE pushc (n: INTEGER); |
| BEGIN |
| OutByte(68H + short(n)); (* push n *) |
| OutIntByte(n) |
| 266,85 → 248,67 |
| END not; |
| PROCEDURE add (reg1, reg2: INTEGER); (* add reg1, reg2 *) |
| PROCEDURE add (reg1, reg2: INTEGER); |
| BEGIN |
| oprr(01H, reg1, reg2) |
| OutByte2(01H, 0C0H + reg2 * 8 + reg1) (* add reg1, reg2 *) |
| END add; |
| PROCEDURE oprc* (op, reg, n: INTEGER); |
| PROCEDURE andrc (reg, n: INTEGER); |
| BEGIN |
| IF (reg = eax) & ~isByte(n) THEN |
| CASE op OF |
| |0C0H: op := 05H (* add *) |
| |0E8H: op := 2DH (* sub *) |
| |0F8H: op := 3DH (* cmp *) |
| |0E0H: op := 25H (* and *) |
| |0C8H: op := 0DH (* or *) |
| |0F0H: op := 35H (* xor *) |
| END; |
| OutByte(op); |
| OutInt(n) |
| ELSE |
| OutByte2(81H + short(n), op + reg MOD 8); |
| OutByte2(81H + short(n), 0E0H + reg); (* and reg, n *) |
| OutIntByte(n) |
| END |
| END oprc; |
| PROCEDURE andrc (reg, n: INTEGER); (* and reg, n *) |
| BEGIN |
| oprc(0E0H, reg, n) |
| END andrc; |
| PROCEDURE orrc (reg, n: INTEGER); (* or reg, n *) |
| PROCEDURE orrc (reg, n: INTEGER); |
| BEGIN |
| oprc(0C8H, reg, n) |
| OutByte2(81H + short(n), 0C8H + reg); (* or reg, n *) |
| OutIntByte(n) |
| END orrc; |
| PROCEDURE xorrc (reg, n: INTEGER); (* xor reg, n *) |
| PROCEDURE addrc (reg, n: INTEGER); |
| BEGIN |
| oprc(0F0H, reg, n) |
| END xorrc; |
| OutByte2(81H + short(n), 0C0H + reg); (* add reg, n *) |
| OutIntByte(n) |
| END addrc; |
| PROCEDURE addrc (reg, n: INTEGER); (* add reg, n *) |
| PROCEDURE subrc (reg, n: INTEGER); |
| BEGIN |
| oprc(0C0H, reg, n) |
| END addrc; |
| OutByte2(81H + short(n), 0E8H + reg); (* sub reg, n *) |
| OutIntByte(n) |
| END subrc; |
| PROCEDURE subrc (reg, n: INTEGER); (* sub reg, n *) |
| PROCEDURE cmprr (reg1, reg2: INTEGER); |
| BEGIN |
| oprc(0E8H, reg, n) |
| END subrc; |
| OutByte2(39H, 0C0H + reg2 * 8 + reg1) (* cmp reg1, reg2 *) |
| END cmprr; |
| PROCEDURE cmprc (reg, n: INTEGER); (* cmp reg, n *) |
| PROCEDURE cmprc (reg, n: INTEGER); |
| BEGIN |
| IF n = 0 THEN |
| test(reg) |
| ELSE |
| oprc(0F8H, reg, n) |
| OutByte2(81H + short(n), 0F8H + reg); (* cmp reg, n *) |
| OutIntByte(n) |
| END |
| END cmprc; |
| PROCEDURE cmprr (reg1, reg2: INTEGER); (* cmp reg1, reg2 *) |
| PROCEDURE setcc (cond, reg: INTEGER); |
| BEGIN |
| oprr(39H, reg1, reg2) |
| END cmprr; |
| OutByte3(0FH, cond, 0C0H + reg) (* setcc reg *) |
| END setcc; |
| PROCEDURE setcc* (cc, reg: INTEGER); (* setcc reg *) |
| PROCEDURE xor (reg1, reg2: INTEGER); |
| BEGIN |
| IF reg >= 8 THEN |
| OutByte(41H) |
| END; |
| OutByte3(0FH, cc, 0C0H + reg MOD 8) |
| END setcc; |
| OutByte2(31H, 0C0H + reg2 * 8 + reg1) (* xor reg1, reg2 *) |
| END xor; |
| PROCEDURE ret*; |
| 614,7 → 578,7 |
| OutByte2(0DAH, 0E9H); (* fucompp *) |
| OutByte3(09BH, 0DFH, 0E0H); (* fstsw ax *) |
| OutByte(09EH); (* sahf *) |
| OutByte(0B8H); OutInt(0) (* mov eax, 0 *) |
| movrc(eax, 0) |
| END fcmp; |
| 730,7 → 694,7 |
| VAR |
| cmd, next: COMMAND; |
| reg1, reg2, fr: INTEGER; |
| reg1, reg2: INTEGER; |
| n, a, b, label, cc: INTEGER; |
| 741,8 → 705,6 |
| BEGIN |
| cmd := IL.codes.commands.first(COMMAND); |
| fr := -1; |
| WHILE cmd # NIL DO |
| param1 := cmd.param1; |
| 776,18 → 738,16 |
| ASSERT(R.top = -1) |
| |IL.opPRECALL: |
| PushAll(0); |
| IF (param2 # 0) & (fr >= 0) THEN |
| n := param2; |
| IF (param1 # 0) & (n # 0) THEN |
| subrc(esp, 8) |
| END; |
| INC(FR[0]); |
| FR[FR[0]] := fr + 1; |
| WHILE fr >= 0 DO |
| WHILE n > 0 DO |
| subrc(esp, 8); |
| OutByte3(0DDH, 01CH, 024H); (* fstp qword[esp] *) |
| DEC(fr) |
| DEC(n) |
| END; |
| ASSERT(fr = -1) |
| PushAll(0) |
| |IL.opALIGN16: |
| ASSERT(eax IN R.regs); |
| 799,31 → 759,27 |
| END; |
| push(eax) |
| |IL.opRESF, IL.opRES: |
| |IL.opRES: |
| ASSERT(R.top = -1); |
| ASSERT(fr = -1); |
| n := FR[FR[0]]; DEC(FR[0]); |
| GetRegA; |
| n := param2; |
| WHILE n > 0 DO |
| OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
| addrc(esp, 8); |
| DEC(n) |
| END |
| IF opcode = IL.opRESF THEN |
| INC(fr); |
| |IL.opRESF: |
| n := param2; |
| IF n > 0 THEN |
| OutByte3(0DDH, 5CH + long(n * 8), 24H); |
| OutIntByte(n * 8); (* fstp qword[esp + n*8] *) |
| DEC(fr); |
| INC(n) |
| END; |
| IF fr + n > MAX_FR THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END |
| ELSE |
| GetRegA |
| END; |
| WHILE n > 0 DO |
| OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
| addrc(esp, 8); |
| INC(fr); |
| DEC(n) |
| END |
| 860,12 → 816,6 |
| ASSERT(R.top = -1); |
| IF opcode = IL.opLEAVEF THEN |
| DEC(fr) |
| END; |
| ASSERT(fr = -1); |
| IF param1 > 0 THEN |
| mov(esp, ebp) |
| END; |
| 899,8 → 849,9 |
| END |
| |IL.opCLEANUP: |
| IF param2 # 0 THEN |
| addrc(esp, param2 * 4) |
| n := param2 * 4; |
| IF n # 0 THEN |
| addrc(esp, n) |
| END |
| |IL.opPOPSP: |
| 912,14 → 863,9 |
| |IL.opLABEL: |
| SetLabel(param1) (* L: *) |
| |IL.opNOP, IL.opAND, IL.opOR: |
| |IL.opNOP: |
| |IL.opGADR: |
| next := cmd.next(COMMAND); |
| IF next.opcode = IL.opADDC THEN |
| INC(param2, next.param2); |
| cmd := next |
| END; |
| reg1 := GetAnyReg(); |
| IF pic THEN |
| Pic(reg1, BIN.PICBSS, param2) |
| 929,12 → 875,7 |
| END |
| |IL.opLADR: |
| next := cmd.next(COMMAND); |
| n := param2 * 4; |
| IF next.opcode = IL.opADDC THEN |
| INC(n, next.param2); |
| cmd := next |
| END; |
| OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); (* lea reg1, dword[ebp + n] *) |
| OutIntByte(n) |
| 966,6 → 907,7 |
| drop |
| |IL.opVLOAD32: |
| n := param2 * 4; |
| reg1 := GetAnyReg(); |
| movrm(reg1, ebp, param2 * 4); |
| movrm(reg1, reg1, 0) |
| 1037,7 → 979,7 |
| add(reg1, reg2); |
| drop |
| |IL.opADDC: |
| |IL.opADDL, IL.opADDR: |
| IF param2 # 0 THEN |
| UnOp(reg1); |
| next := cmd.next(COMMAND); |
| 1068,17 → 1010,18 |
| |IL.opSUB: |
| BinOp(reg1, reg2); |
| oprr(29H, reg1, reg2); (* sub reg1, reg2 *) |
| OutByte2(29H, 0C0H + reg2 * 8 + reg1); (* sub reg1, reg2 *) |
| drop |
| |IL.opSUBR, IL.opSUBL: |
| UnOp(reg1); |
| IF param2 = 1 THEN |
| n := param2; |
| IF n = 1 THEN |
| OutByte(48H + reg1) (* dec reg1 *) |
| ELSIF param2 = -1 THEN |
| ELSIF n = -1 THEN |
| OutByte(40H + reg1) (* inc reg1 *) |
| ELSIF param2 # 0 THEN |
| subrc(reg1, param2) |
| ELSIF n # 0 THEN |
| subrc(reg1, n) |
| END; |
| IF opcode = IL.opSUBL THEN |
| neg(reg1) |
| 1236,10 → 1179,10 |
| cc := cond(opcode); |
| next := cmd.next(COMMAND); |
| IF next.opcode = IL.opJNZ THEN |
| IF next.opcode = IL.opJE THEN |
| jcc(cc, next.param1); |
| cmd := next |
| ELSIF next.opcode = IL.opJZ THEN |
| ELSIF next.opcode = IL.opJNE THEN |
| jcc(inv0(cc), next.param1); |
| cmd := next |
| ELSE |
| 1269,27 → 1212,40 |
| END; |
| andrc(reg1, 1) |
| |IL.opACC: |
| IF (R.top # 0) OR (R.stk[0] # eax) THEN |
| PushAll(0); |
| GetRegA; |
| pop(eax); |
| DEC(R.pushed) |
| END |
| |IL.opDROP: |
| UnOp(reg1); |
| drop |
| |IL.opJNZ1: |
| |IL.opJNZ: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jne, param1) |
| |IL.opJZ: |
| UnOp(reg1); |
| test(reg1); |
| jcc(je, param1) |
| |IL.opJG: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jg, param1) |
| |IL.opJNZ: |
| |IL.opJE: |
| UnOp(reg1); |
| test(reg1); |
| jcc(jne, param1); |
| drop |
| |IL.opJZ: |
| |IL.opJNE: |
| UnOp(reg1); |
| test(reg1); |
| jcc(je, param1); |
| 1433,7 → 1389,7 |
| |IL.opMULS: |
| BinOp(reg1, reg2); |
| oprr(21H, reg1, reg2); (* and reg1, reg2 *) |
| OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) |
| drop |
| |IL.opMULSC: |
| 1447,20 → 1403,21 |
| |IL.opDIVSC: |
| UnOp(reg1); |
| xorrc(reg1, param2) |
| OutByte2(81H + short(param2), 0F0H + reg1); (* xor reg1, n *) |
| OutIntByte(param2) |
| |IL.opADDS: |
| BinOp(reg1, reg2); |
| oprr(9H, reg1, reg2); (* or reg1, reg2 *) |
| OutByte2(9H, 0C0H + reg2 * 8 + reg1); (* or reg1, reg2 *) |
| drop |
| |IL.opSUBS: |
| BinOp(reg1, reg2); |
| not(reg2); |
| oprr(21H, reg1, reg2); (* and reg1, reg2 *) |
| OutByte2(21H, 0C0H + reg2 * 8 + reg1); (* and reg1, reg2 *) |
| drop |
| |IL.opADDSC: |
| |IL.opADDSL, IL.opADDSR: |
| UnOp(reg1); |
| orrc(reg1, param2) |
| 1551,15 → 1508,9 |
| |IL.opMAXC, IL.opMINC: |
| UnOp(reg1); |
| cmprc(reg1, param2); |
| label := NewLabel(); |
| IF opcode = IL.opMINC THEN |
| cc := jle |
| ELSE |
| cc := jge |
| END; |
| jcc(cc, label); |
| movrc(reg1, param2); |
| SetLabel(label) |
| OutByte2(07DH + ORD(opcode = IL.opMINC), 5); (* jge/jle L *) |
| movrc(reg1, param2) |
| (* L: *) |
| |IL.opIN, IL.opINR: |
| IF opcode = IL.opINR THEN |
| 1873,25 → 1824,15 |
| drop |
| |IL.opPUSHF: |
| ASSERT(fr >= 0); |
| DEC(fr); |
| subrc(esp, 8); |
| OutByte3(0DDH, 01CH, 024H) (* fstp qword[esp] *) |
| |IL.opLOADF: |
| INC(fr); |
| IF fr > MAX_FR THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| UnOp(reg1); |
| OutByte2(0DDH, reg1); (* fld qword[reg1] *) |
| drop |
| |IL.opCONSTF: |
| INC(fr); |
| IF fr > MAX_FR THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| float := cmd.float; |
| IF float = 0.0 THEN |
| OutByte2(0D9H, 0EEH) (* fldz *) |
| 1909,55 → 1850,35 |
| END |
| |IL.opSAVEF, IL.opSAVEFI: |
| ASSERT(fr >= 0); |
| DEC(fr); |
| UnOp(reg1); |
| OutByte2(0DDH, 018H + reg1); (* fstp qword[reg1] *) |
| drop |
| |IL.opADDF: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| |IL.opADDF, IL.opADDFI: |
| OutByte2(0DEH, 0C1H) (* faddp st1, st *) |
| |IL.opSUBF: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| OutByte2(0DEH, 0E9H) (* fsubp st1, st *) |
| |IL.opSUBFI: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| OutByte2(0DEH, 0E1H) (* fsubrp st1, st *) |
| |IL.opMULF: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| OutByte2(0DEH, 0C9H) (* fmulp st1, st *) |
| |IL.opDIVF: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| OutByte2(0DEH, 0F9H) (* fdivp st1, st *) |
| |IL.opDIVFI: |
| ASSERT(fr >= 1); |
| DEC(fr); |
| OutByte2(0DEH, 0F1H) (* fdivrp st1, st *) |
| |IL.opUMINF: |
| ASSERT(fr >= 0); |
| OutByte2(0D9H, 0E0H) (* fchs *) |
| |IL.opFABS: |
| ASSERT(fr >= 0); |
| OutByte2(0D9H, 0E1H) (* fabs *) |
| |IL.opFLT: |
| INC(fr); |
| IF fr > MAX_FR THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| UnOp(reg1); |
| push(reg1); |
| OutByte3(0DBH, 004H, 024H); (* fild dword[esp] *) |
| 1965,8 → 1886,6 |
| drop |
| |IL.opFLOOR: |
| ASSERT(fr >= 0); |
| DEC(fr); |
| subrc(esp, 8); |
| OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); (* fstcw word[esp+4] *) |
| OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); (* fstcw word[esp+6] *) |
| 1980,8 → 1899,6 |
| addrc(esp, 4) |
| |IL.opEQF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 003H); (* jp L *) |
| setcc(sete, al) |
| 1988,8 → 1905,6 |
| (* L: *) |
| |IL.opNEF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 003H); (* jp L *) |
| setcc(setne, al) |
| 1996,8 → 1911,6 |
| (* L: *) |
| |IL.opLTF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 00EH); (* jp L *) |
| setcc(setc, al); |
| 2008,8 → 1921,6 |
| (* L: *) |
| |IL.opGTF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 00FH); (* jp L *) |
| setcc(setc, al); |
| 2020,8 → 1931,6 |
| (* L: *) |
| |IL.opLEF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 003H); (* jp L *) |
| setcc(setnc, al) |
| 2028,8 → 1937,6 |
| (* L: *) |
| |IL.opGEF: |
| ASSERT(fr >= 1); |
| DEC(fr, 2); |
| fcmp; |
| OutByte2(07AH, 010H); (* jp L *) |
| setcc(setc, al); |
| 2041,10 → 1948,6 |
| (* L: *) |
| |IL.opINF: |
| INC(fr); |
| IF fr > MAX_FR THEN |
| ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) |
| END; |
| pushc(7FF00000H); |
| pushc(0); |
| OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) |
| 2173,9 → 2076,6 |
| OutIntByte(n); |
| OutByte(param2) |
| |IL.opFNAME: |
| fname := cmd(IL.FNAMECMD).fname |
| |IL.opLOOP, IL.opENDLOOP: |
| END; |
| 2184,8 → 2084,8 |
| END; |
| ASSERT(R.pushed = 0); |
| ASSERT(R.top = -1); |
| ASSERT(fr = -1) |
| ASSERT(R.top = -1) |
| END translate; |
| 2194,9 → 2094,9 |
| reg1, entry, L, dcount: INTEGER; |
| BEGIN |
| entry := NewLabel(); |
| SetLabel(entry); |
| dcount := CHL.Length(IL.codes.data); |
| IF target = TARGETS.Win32DLL THEN |
| push(ebp); |
| 2206,17 → 2106,19 |
| pushm(ebp, 8); |
| CallRTL(pic, IL._dllentry); |
| test(eax); |
| jcc(je, dllret); |
| pushc(0) |
| jcc(je, dllret) |
| ELSIF target = TARGETS.KolibriOSDLL THEN |
| SetLabel(dllinit); |
| OutByte(68H); (* push IMPORT *) |
| Reloc(BIN.IMPTAB, 0) |
| ELSIF target = TARGETS.KolibriOS THEN |
| SetLabel(dllinit) |
| END; |
| IF target = TARGETS.KolibriOS THEN |
| reg1 := GetAnyReg(); |
| Pic(reg1, BIN.IMPTAB, 0); |
| push(reg1); (* push IMPORT *) |
| drop |
| ELSIF target = TARGETS.KolibriOSDLL THEN |
| OutByte(68H); (* push IMPORT *) |
| Reloc(BIN.IMPTAB, 0) |
| ELSIF target = TARGETS.Linux32 THEN |
| push(esp) |
| ELSE |
| 2227,25 → 2129,39 |
| reg1 := GetAnyReg(); |
| Pic(reg1, BIN.PICCODE, entry); |
| push(reg1); (* push CODE *) |
| drop |
| ELSE |
| OutByte(68H); (* push CODE *) |
| Reloc(BIN.RCODE, entry) |
| END; |
| IF pic THEN |
| reg1 := GetAnyReg(); |
| Pic(reg1, BIN.PICDATA, 0); |
| push(reg1); (* push _data *) |
| drop |
| ELSE |
| OutByte(68H); (* push _data *) |
| Reloc(BIN.RDATA, 0) |
| END; |
| dcount := CHL.Length(IL.codes.data); |
| pushc(tcount); |
| IF pic THEN |
| reg1 := GetAnyReg(); |
| Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); |
| push(reg1); (* push _data + tcount * 4 + dcount *) |
| drop |
| ELSE |
| OutByte(68H); (* push CODE *) |
| Reloc(BIN.RCODE, entry); |
| OutByte(68H); (* push _data *) |
| Reloc(BIN.RDATA, 0); |
| pushc(tcount); |
| OutByte(68H); (* push _data + tcount * 4 + dcount *) |
| Reloc(BIN.RDATA, tcount * 4 + dcount) |
| END; |
| CallRTL(pic, IL._init); |
| IF target IN {TARGETS.Win32C, TARGETS.Win32GUI, TARGETS.Linux32} THEN |
| IF target = TARGETS.Linux32 THEN |
| L := NewLabel(); |
| pushc(0); |
| push(esp); |
| 2270,7 → 2186,7 |
| dcount, i: INTEGER; |
| PROCEDURE _import (imp: LISTS.LIST); |
| PROCEDURE import (imp: LISTS.LIST); |
| VAR |
| lib: IL.IMPORT_LIB; |
| proc: IL.IMPORT_PROC; |
| 2288,7 → 2204,7 |
| lib := lib.next(IL.IMPORT_LIB) |
| END |
| END _import; |
| END import; |
| BEGIN |
| 2340,11 → 2256,12 |
| exp := exp.next(IL.EXPORT_PROC) |
| END; |
| _import(IL.codes._import); |
| import(IL.codes.import); |
| IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); |
| BIN.SetParams(program, IL.codes.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; |
| 2354,7 → 2271,6 |
| opt: PROG.OPTIONS; |
| BEGIN |
| FR[0] := 0; |
| tcount := CHL.Length(IL.codes.types); |
| opt := options; |