diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index c3149a0f5f..4eaf1f48f9 100644 Binary files a/programs/develop/oberon07/Compiler.kex and b/programs/develop/oberon07/Compiler.kex differ diff --git a/programs/develop/oberon07/Docs/About1251.txt b/programs/develop/oberon07/Docs/About1251.txt index 9eeb905aa6..33172eaa37 100644 --- a/programs/develop/oberon07/Docs/About1251.txt +++ b/programs/develop/oberon07/Docs/About1251.txt @@ -17,6 +17,7 @@ UTF-8 "kos" - KolibriOS "obj" - KolibriOS DLL "elfexe" - Linux ELF-EXEC + "elfso" - Linux ELF-SO 4) эхюс чрЄхы№э√х ярЁрьхЄЁ√-ъы■ўш -stk ЁрчьхЁ ёЄ¤ър т ьхурсрщЄрї (яю єьюыўрэш■ 2 ╠с) -base
рфЁхё чруЁєчъш шёяюыэ хьюую Їрщыр т ъшыюсрщЄрї @@ -144,10 +145,10 @@ UTF-8 фю 32 сшЄ, фы  чряшёш срщЄют шёяюы№чютрЄ№ SYSTEM.PUT8, фы  WCHAR -- SYSTEM.PUT16 - PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) ╧рь Є№[a] := ьырф°шх 8 сшЄ (x) - PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) ╧рь Є№[a] := ьырф°шх 16 сшЄ (x) PROCEDURE MOVE(Source, Dest, n: INTEGER) @@ -358,8 +359,8 @@ Oberon- ┬ёх яЁюуЁрьь√ эх тэю шёяюы№чє■Є ьюфєы№ RTL. ╩юьяшы ЄюЁ ЄЁрэёышЁєхЄ эхъюЄюЁ√х юяхЁрЎшш (яЁютхЁър ш юїЁрэр Єшяр, ёЁртэхэшх ёЄЁюъ, ёююс∙хэш  юс ю°шсърї тЁхьхэш т√яюыэхэш  ш фЁ.) ъръ т√чют√ яЁюЎхфєЁ ¤Єюую ьюфєы . ═х -ёыхфєхЄ  тэю т√ч√трЄ№ ¤Єш яЁюЎхфєЁ√, чр шёъы■ўхэшхь яЁюЎхфєЁ√ SetDll, -хёыш яЁшыюцхэшх ъюьяшышЁєхЄё  ъръ Windows DLL: +ёыхфєхЄ  тэю т√ч√трЄ№ ¤Єш яЁюЎхфєЁ√, чр шёъы■ўхэшхь яЁюЎхфєЁ SetDll ш SetFini +хёыш яЁшыюцхэшх ъюьяшышЁєхЄё  ъръ Windows DLL шыш Linux SO, ёююЄтхЄёЄтхээю: PROCEDURE SetDll (process_detach, thread_detach, thread_attach: DLL_ENTRY); @@ -372,8 +373,15 @@ SetDll - ёючфрэшш эютюую яюЄюър (thread_attach) - єэшўЄюцхэшш яюЄюър (thread_detach) -─ы  яЁюўшї Єшяют яЁшыюцхэшщ, т√чют яЁюЎхфєЁ√ SetDll эх тыш хЄ эр + + PROCEDURE SetFini (ProcFini: PROC); + уфх TYPE PROC = PROCEDURE (* схч ярЁрьхЄЁют *) + +SetFini эрчэрўрхЄ яЁюЎхфєЁє ProcFini т√ч√трхьющ яЁш т√уЁєчъх so-сшсышюЄхъш. + +─ы  яЁюўшї Єшяют яЁшыюцхэшщ, т√чют яЁюЎхфєЁ SetDll ш SetFini эх тыш хЄ эр яютхфхэшх яЁюуЁрьь√. + ╤ююс∙хэш  юс ю°шсърї тЁхьхэш т√яюыэхэш  т√тюф Єё  т фшрыюуют√ї юъэрї (Windows), т ЄхЁьшэры (Linux), эр фюёъє юЄырфъш (KolibriOS). @@ -395,6 +403,4 @@ SetDll PROCEDURE [stdcall] lib_init (): INTEGER ▌Єр яЁюЎхфєЁр фюыцэр с√Є№ т√чтрэр яхЁхф шёяюы№чютрэшхь DLL. -╧ЁюЎхфєЁр тёхуфр тючтЁр∙рхЄ 1. - - ─ы  Linux, ухэхЁрЎш  фшэрьшўхёъшї сшсышюЄхъ эх Ёхрышчютрэр. \ No newline at end of file +╧ЁюЎхфєЁр тёхуфр тючтЁр∙рхЄ 1. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/About866.txt b/programs/develop/oberon07/Docs/About866.txt index 74af19c3bf..b0147dc787 100644 --- a/programs/develop/oberon07/Docs/About866.txt +++ b/programs/develop/oberon07/Docs/About866.txt @@ -17,6 +17,7 @@ UTF-8 "kos" - KolibriOS "obj" - KolibriOS DLL "elfexe" - Linux ELF-EXEC + "elfso" - Linux ELF-SO 4) необязательные параметры-ключи -stk размер стэка в мегабайтах (по умолчанию 2 Мб) -base
адрес загрузки исполняемого файла в килобайтах @@ -144,10 +145,10 @@ UTF-8 до 32 бит, для записи байтов использовать SYSTEM.PUT8, для WCHAR -- SYSTEM.PUT16 - PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + PROCEDURE PUT8(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) Память[a] := младшие 8 бит (x) - PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + PROCEDURE PUT16(a: INTEGER; x: INTEGER, SET, BYTE, CHAR, WCHAR) Память[a] := младшие 16 бит (x) PROCEDURE MOVE(Source, Dest, n: INTEGER) @@ -358,8 +359,8 @@ Oberon-реа Все программы неявно используют модуль RTL. Компилятор транслирует некоторые операции (проверка и охрана типа, сравнение строк, сообщения об ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не -следует явно вызывать эти процедуры, за исключением процедуры SetDll, -если приложение компилируется как Windows DLL: +следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini +если приложение компилируется как Windows DLL или Linux SO, соответственно: PROCEDURE SetDll (process_detach, thread_detach, thread_attach: DLL_ENTRY); @@ -372,8 +373,15 @@ SetDll - создании нового потока (thread_attach) - уничтожении потока (thread_detach) -Для прочих типов приложений, вызов процедуры SetDll не влияет на + + PROCEDURE SetFini (ProcFini: PROC); + где TYPE PROC = PROCEDURE (* без параметров *) + +SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки. + +Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на поведение программы. + Сообщения об ошибках времени выполнения выводятся в диалоговых окнах (Windows), в терминал (Linux), на доску отладки (KolibriOS). @@ -395,6 +403,4 @@ SetDll PROCEDURE [stdcall] lib_init (): INTEGER Эта процедура должна быть вызвана перед использованием DLL. -Процедура всегда возвращает 1. - - Для Linux, генерация динамических библиотек не реализована. \ No newline at end of file +Процедура всегда возвращает 1. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/KOSLib1251.txt b/programs/develop/oberon07/Docs/KOSLib1251.txt index 0f8175a68e..ea757d300c 100644 --- a/programs/develop/oberon07/Docs/KOSLib1251.txt +++ b/programs/develop/oberon07/Docs/KOSLib1251.txt @@ -98,8 +98,8 @@ MODULE Math - CONST - pi = 3.141592653589793D+00 - e = 2.718281828459045D+00 + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 PROCEDURE IsNan(x: REAL): BOOLEAN @@ -153,13 +153,13 @@ MODULE Math - PROCEDURE tanh(x: REAL): REAL ушяхЁсюышўхёъшщ Єрэухэё x - PROCEDURE arcsinh(x: REAL): REAL + PROCEDURE arsinh(x: REAL): REAL юсЁрЄэ√щ ушяхЁсюышўхёъшщ ёшэєё x - PROCEDURE arccosh(x: REAL): REAL + PROCEDURE arcosh(x: REAL): REAL юсЁрЄэ√щ ушяхЁсюышўхёъшщ ъюёшэєё x - PROCEDURE arctanh(x: REAL): REAL + PROCEDURE artanh(x: REAL): REAL юсЁрЄэ√щ ушяхЁсюышўхёъшщ Єрэухэё x PROCEDURE round(x: REAL): REAL @@ -181,6 +181,9 @@ MODULE Math - хёыш x < 0 тючтЁр∙рхЄ -1 хёыш x = 0 тючтЁр∙рхЄ 0 + PROCEDURE fact(n: INTEGER): REAL + ЇръЄюЁшры n + ------------------------------------------------------------------------------ MODULE Debug - т√тюф эр фюёъє юЄырфъш ╚эЄхЁЇхщё ъръ ьюфєы№ Out @@ -337,7 +340,7 @@ MODULE DateTime - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL тючтЁр∙рхЄ фрЄє, яюыєўхээє■ шч ъюьяюэхэЄют Year, Month, Day, Hour, Min, Sec; - яЁш ю°шсъх тючтЁр∙рхЄ ъюэёЄрэЄє ERR = -7.0D5 + яЁш ю°шсъх тючтЁр∙рхЄ ъюэёЄрэЄє ERR = -7.0E5 PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, Hour, Min, Sec: INTEGER): BOOLEAN diff --git a/programs/develop/oberon07/Docs/KOSLib866.txt b/programs/develop/oberon07/Docs/KOSLib866.txt index 4e3e15fb1f..a163da19ee 100644 --- a/programs/develop/oberon07/Docs/KOSLib866.txt +++ b/programs/develop/oberon07/Docs/KOSLib866.txt @@ -1,94 +1,94 @@ ============================================================================== - Библиотека (KolibriOS) + Библиотека (KolibriOS) ------------------------------------------------------------------------------ MODULE Out - консольный вывод - PROCEDURE Open - формально открывает консольный вывод + PROCEDURE Open + формально открывает консольный вывод - PROCEDURE Int(x, width: INTEGER) - вывод целого числа x; - width - количество знакомест, используемых для вывода + PROCEDURE Int(x, width: INTEGER) + вывод целого числа x; + width - количество знакомест, используемых для вывода - PROCEDURE Real(x: REAL; width: INTEGER) - вывод вещественного числа x в плавающем формате; - width - количество знакомест, используемых для вывода + PROCEDURE Real(x: REAL; width: INTEGER) + вывод вещественного числа x в плавающем формате; + width - количество знакомест, используемых для вывода - PROCEDURE Char(x: CHAR) - вывод символа x + PROCEDURE Char(x: CHAR) + вывод символа x - PROCEDURE FixReal(x: REAL; width, p: INTEGER) - вывод вещественного числа x в фиксированном формате; - width - количество знакомест, используемых для вывода; - p - количество знаков после десятичной точки + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + вывод вещественного числа x в фиксированном формате; + width - количество знакомест, используемых для вывода; + p - количество знаков после десятичной точки - PROCEDURE Ln - переход на следующую строку + PROCEDURE Ln + переход на следующую строку - PROCEDURE String(s: ARRAY OF CHAR) - вывод строки s + PROCEDURE String(s: ARRAY OF CHAR) + вывод строки s ------------------------------------------------------------------------------ MODULE In - консольный ввод - VAR Done: BOOLEAN - принимает значение TRUE в случае успешного выполнения - операции ввода, иначе FALSE + VAR Done: BOOLEAN + принимает значение TRUE в случае успешного выполнения + операции ввода, иначе FALSE - PROCEDURE Open - формально открывает консольный ввод, - также присваивает переменной Done значение TRUE + PROCEDURE Open + формально открывает консольный ввод, + также присваивает переменной Done значение TRUE - PROCEDURE Int(VAR x: INTEGER) - ввод числа типа INTEGER + PROCEDURE Int(VAR x: INTEGER) + ввод числа типа INTEGER - PROCEDURE Char(VAR x: CHAR) - ввод символа + PROCEDURE Char(VAR x: CHAR) + ввод символа - PROCEDURE Real(VAR x: REAL) - ввод числа типа REAL + PROCEDURE Real(VAR x: REAL) + ввод числа типа REAL - PROCEDURE String(VAR s: ARRAY OF CHAR) - ввод строки + PROCEDURE String(VAR s: ARRAY OF CHAR) + ввод строки - PROCEDURE Ln - ожидание нажатия ENTER + PROCEDURE Ln + ожидание нажатия ENTER ------------------------------------------------------------------------------ MODULE Console - дополнительные процедуры консольного вывода - CONST + CONST - Следующие константы определяют цвет консольного вывода + Следующие константы определяют цвет консольного вывода - Black = 0 Blue = 1 Green = 2 - Cyan = 3 Red = 4 Magenta = 5 - Brown = 6 LightGray = 7 DarkGray = 8 - LightBlue = 9 LightGreen = 10 LightCyan = 11 - LightRed = 12 LightMagenta = 13 Yellow = 14 - White = 15 + Black = 0 Blue = 1 Green = 2 + Cyan = 3 Red = 4 Magenta = 5 + Brown = 6 LightGray = 7 DarkGray = 8 + LightBlue = 9 LightGreen = 10 LightCyan = 11 + LightRed = 12 LightMagenta = 13 Yellow = 14 + White = 15 - PROCEDURE Cls - очистка окна консоли + PROCEDURE Cls + очистка окна консоли - PROCEDURE SetColor(FColor, BColor: INTEGER) - установка цвета консольного вывода: FColor - цвет текста, - BColor - цвет фона, возможные значения - вышеперечисленные - константы + PROCEDURE SetColor(FColor, BColor: INTEGER) + установка цвета консольного вывода: FColor - цвет текста, + BColor - цвет фона, возможные значения - вышеперечисленные + константы - PROCEDURE SetCursor(x, y: INTEGER) - установка курсора консоли в позицию (x, y) + PROCEDURE SetCursor(x, y: INTEGER) + установка курсора консоли в позицию (x, y) - PROCEDURE GetCursor(VAR x, y: INTEGER) - записывает в параметры текущие координаты курсора консоли + PROCEDURE GetCursor(VAR x, y: INTEGER) + записывает в параметры текущие координаты курсора консоли - PROCEDURE GetCursorX(): INTEGER - возвращает текущую x-координату курсора консоли + PROCEDURE GetCursorX(): INTEGER + возвращает текущую x-координату курсора консоли - PROCEDURE GetCursorY(): INTEGER - возвращает текущую y-координату курсора консоли + PROCEDURE GetCursorY(): INTEGER + возвращает текущую y-координату курсора консоли ------------------------------------------------------------------------------ MODULE ConsoleLib - обертка библиотеки console.obj @@ -96,466 +96,469 @@ MODULE ConsoleLib - ------------------------------------------------------------------------------ MODULE Math - математические функции - CONST + CONST - pi = 3.141592653589793D+00 - e = 2.718281828459045D+00 + pi = 3.141592653589793E+00 + e = 2.718281828459045E+00 - PROCEDURE IsNan(x: REAL): BOOLEAN - возвращает TRUE, если x - не число + PROCEDURE IsNan(x: REAL): BOOLEAN + возвращает TRUE, если x - не число - PROCEDURE IsInf(x: REAL): BOOLEAN - возвращает TRUE, если x - бесконечность + PROCEDURE IsInf(x: REAL): BOOLEAN + возвращает TRUE, если x - бесконечность - PROCEDURE sqrt(x: REAL): REAL - квадратный корень x + PROCEDURE sqrt(x: REAL): REAL + квадратный корень x - PROCEDURE exp(x: REAL): REAL - экспонента x + PROCEDURE exp(x: REAL): REAL + экспонента x - PROCEDURE ln(x: REAL): REAL - натуральный логарифм x + PROCEDURE ln(x: REAL): REAL + натуральный логарифм x - PROCEDURE sin(x: REAL): REAL - синус x + PROCEDURE sin(x: REAL): REAL + синус x - PROCEDURE cos(x: REAL): REAL - косинус x + PROCEDURE cos(x: REAL): REAL + косинус x - PROCEDURE tan(x: REAL): REAL - тангенс x + PROCEDURE tan(x: REAL): REAL + тангенс x - PROCEDURE arcsin(x: REAL): REAL - арксинус x + PROCEDURE arcsin(x: REAL): REAL + арксинус x - PROCEDURE arccos(x: REAL): REAL - арккосинус x + PROCEDURE arccos(x: REAL): REAL + арккосинус x - PROCEDURE arctan(x: REAL): REAL - арктангенс x + PROCEDURE arctan(x: REAL): REAL + арктангенс x - PROCEDURE arctan2(y, x: REAL): REAL - арктангенс y/x + PROCEDURE arctan2(y, x: REAL): REAL + арктангенс y/x - PROCEDURE power(base, exponent: REAL): REAL - возведение числа base в степень exponent + PROCEDURE power(base, exponent: REAL): REAL + возведение числа base в степень exponent - PROCEDURE log(base, x: REAL): REAL - логарифм x по основанию base + PROCEDURE log(base, x: REAL): REAL + логарифм x по основанию base - PROCEDURE sinh(x: REAL): REAL - гиперболический синус x + PROCEDURE sinh(x: REAL): REAL + гиперболический синус x - PROCEDURE cosh(x: REAL): REAL - гиперболический косинус x + PROCEDURE cosh(x: REAL): REAL + гиперболический косинус x - PROCEDURE tanh(x: REAL): REAL - гиперболический тангенс x + PROCEDURE tanh(x: REAL): REAL + гиперболический тангенс x - PROCEDURE arcsinh(x: REAL): REAL - обратный гиперболический синус x + PROCEDURE arsinh(x: REAL): REAL + обратный гиперболический синус x - PROCEDURE arccosh(x: REAL): REAL - обратный гиперболический косинус x + PROCEDURE arcosh(x: REAL): REAL + обратный гиперболический косинус x - PROCEDURE arctanh(x: REAL): REAL - обратный гиперболический тангенс x + PROCEDURE artanh(x: REAL): REAL + обратный гиперболический тангенс x - PROCEDURE round(x: REAL): REAL - округление x до ближайшего целого + PROCEDURE round(x: REAL): REAL + округление x до ближайшего целого - PROCEDURE frac(x: REAL): REAL; - дробная часть числа x + PROCEDURE frac(x: REAL): REAL; + дробная часть числа x - PROCEDURE floor(x: REAL): REAL - наибольшее целое число (представление как REAL), - не больше x: floor(1.2) = 1.0 + PROCEDURE floor(x: REAL): REAL + наибольшее целое число (представление как REAL), + не больше x: floor(1.2) = 1.0 - PROCEDURE ceil(x: REAL): REAL - наименьшее целое число (представление как REAL), - не меньше x: ceil(1.2) = 2.0 + PROCEDURE ceil(x: REAL): REAL + наименьшее целое число (представление как REAL), + не меньше x: ceil(1.2) = 2.0 - PROCEDURE sgn(x: REAL): INTEGER - если x > 0 возвращает 1 - если x < 0 возвращает -1 - если x = 0 возвращает 0 + PROCEDURE sgn(x: REAL): INTEGER + если x > 0 возвращает 1 + если x < 0 возвращает -1 + если x = 0 возвращает 0 + + PROCEDURE fact(n: INTEGER): REAL + факториал n ------------------------------------------------------------------------------ MODULE Debug - вывод на доску отладки - Интерфейс как модуль Out + Интерфейс как модуль Out - PROCEDURE Open - открывает доску отладки + PROCEDURE Open + открывает доску отладки ------------------------------------------------------------------------------ MODULE File - работа с файловой системой - TYPE + TYPE - FNAME = ARRAY 520 OF CHAR + FNAME = ARRAY 520 OF CHAR - FS = POINTER TO rFS + FS = POINTER TO rFS - rFS = RECORD (* информационная структура файла *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END + rFS = RECORD (* информационная структура файла *) + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END - FD = POINTER TO rFD + FD = POINTER TO rFD - rFD = RECORD (* структура блока данных входа каталога *) - attr: INTEGER; - ntyp: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create, date_create, - time_access, date_access, - time_modif, date_modif, - size, hsize: INTEGER; - name: FNAME - END + rFD = RECORD (* структура блока данных входа каталога *) + attr: INTEGER; + ntyp: CHAR; + reserved: ARRAY 3 OF CHAR; + time_create, date_create, + time_access, date_access, + time_modif, date_modif, + size, hsize: INTEGER; + name: FNAME + END - CONST + CONST - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - Загружает в память файл с именем FName, записывает в параметр - size размер файла, возвращает адрес загруженного файла - или 0 (ошибка). При необходимости, распаковывает - файл (kunpack). + PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; + Загружает в память файл с именем FName, записывает в параметр + size размер файла, возвращает адрес загруженного файла + или 0 (ошибка). При необходимости, распаковывает + файл (kunpack). - PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN - Записывает структуру блока данных входа каталога для файла - или папки с именем FName в параметр Info. - При ошибке возвращает FALSE. + PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN + Записывает структуру блока данных входа каталога для файла + или папки с именем FName в параметр Info. + При ошибке возвращает FALSE. - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - возвращает TRUE, если файл с именем FName существует + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если файл с именем FName существует - PROCEDURE Close(VAR F: FS) - освобождает память, выделенную для информационной структуры - файла F и присваивает F значение NIL + PROCEDURE Close(VAR F: FS) + освобождает память, выделенную для информационной структуры + файла F и присваивает F значение NIL - PROCEDURE Open(FName: ARRAY OF CHAR): FS - возвращает указатель на информационную структуру файла с - именем FName, при ошибке возвращает NIL + PROCEDURE Open(FName: ARRAY OF CHAR): FS + возвращает указатель на информационную структуру файла с + именем FName, при ошибке возвращает NIL - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - удаляет файл с именем FName, при ошибке возвращает FALSE + PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN + удаляет файл с именем FName, при ошибке возвращает FALSE - PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER - устанавливает позицию чтения-записи файла F на Offset, - относительно Origin = (SEEK_BEG - начало файла, - SEEK_CUR - текущая позиция, SEEK_END - конец файла), - возвращает позицию относительно начала файла, например: - Seek(F, 0, SEEK_END) - устанавливает позицию на конец файла и возвращает длину - файла; при ошибке возвращает -1 + PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER + устанавливает позицию чтения-записи файла F на Offset, + относительно Origin = (SEEK_BEG - начало файла, + SEEK_CUR - текущая позиция, SEEK_END - конец файла), + возвращает позицию относительно начала файла, например: + Seek(F, 0, SEEK_END) + устанавливает позицию на конец файла и возвращает длину + файла; при ошибке возвращает -1 - PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER - Читает данные из файла в память. F - указатель на - информационную структуру файла, Buffer - адрес области - памяти, Count - количество байт, которое требуется прочитать - из файла; возвращает количество байт, которое было прочитано - и соответствующим образом изменяет позицию чтения/записи в - информационной структуре F. + PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER + Читает данные из файла в память. F - указатель на + информационную структуру файла, Buffer - адрес области + памяти, Count - количество байт, которое требуется прочитать + из файла; возвращает количество байт, которое было прочитано + и соответствующим образом изменяет позицию чтения/записи в + информационной структуре F. - PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER - Записывает данные из памяти в файл. F - указатель на - информационную структуру файла, Buffer - адрес области - памяти, Count - количество байт, которое требуется записать - в файл; возвращает количество байт, которое было записано и - соответствующим образом изменяет позицию чтения/записи в - информационной структуре F. + PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER + Записывает данные из памяти в файл. F - указатель на + информационную структуру файла, Buffer - адрес области + памяти, Count - количество байт, которое требуется записать + в файл; возвращает количество байт, которое было записано и + соответствующим образом изменяет позицию чтения/записи в + информационной структуре F. - PROCEDURE Create(FName: ARRAY OF CHAR): FS - создает новый файл с именем FName (полное имя), возвращает - указатель на информационную структуру файла, - при ошибке возвращает NIL + PROCEDURE Create(FName: ARRAY OF CHAR): FS + создает новый файл с именем FName (полное имя), возвращает + указатель на информационную структуру файла, + при ошибке возвращает NIL - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - создает папку с именем DirName, все промежуточные папки - должны существовать, при ошибке возвращает FALSE + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + создает папку с именем DirName, все промежуточные папки + должны существовать, при ошибке возвращает FALSE - PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN - удаляет пустую папку с именем DirName, - при ошибке возвращает FALSE + PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN + удаляет пустую папку с именем DirName, + при ошибке возвращает FALSE - PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN - возвращает TRUE, если папка с именем DirName существует + PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN + возвращает TRUE, если папка с именем DirName существует ------------------------------------------------------------------------------ MODULE Read - чтение основных типов данных из файла F - Процедуры возвращают TRUE в случае успешной операции чтения и - соответствующим образом изменяют позицию чтения/записи в - информационной структуре F + Процедуры возвращают TRUE в случае успешной операции чтения и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN + PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN ------------------------------------------------------------------------------ MODULE Write - запись основных типов данных в файл F - Процедуры возвращают TRUE в случае успешной операции записи и - соответствующим образом изменяют позицию чтения/записи в - информационной структуре F + Процедуры возвращают TRUE в случае успешной операции записи и + соответствующим образом изменяют позицию чтения/записи в + информационной структуре F - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN + PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN + PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN + PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN + PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN + PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN + PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN ------------------------------------------------------------------------------ MODULE DateTime - дата, время - CONST ERR = -7.0E5 + CONST ERR = -7.0E5 - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - записывает в параметры компоненты текущей системной даты и - времени + PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) + записывает в параметры компоненты текущей системной даты и + времени - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL - возвращает дату, полученную из компонентов - Year, Month, Day, Hour, Min, Sec; - при ошибке возвращает константу ERR = -7.0D5 + PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL + возвращает дату, полученную из компонентов + Year, Month, Day, Hour, Min, Sec; + при ошибке возвращает константу ERR = -7.0E5 - PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, - Hour, Min, Sec: INTEGER): BOOLEAN - извлекает компоненты - Year, Month, Day, Hour, Min, Sec из даты Date; - при ошибке возвращает FALSE + PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, + Hour, Min, Sec: INTEGER): BOOLEAN + извлекает компоненты + Year, Month, Day, Hour, Min, Sec из даты Date; + при ошибке возвращает FALSE ------------------------------------------------------------------------------ MODULE Args - параметры программы - VAR argc: INTEGER - количество параметров программы, включая имя - исполняемого файла + VAR argc: INTEGER + количество параметров программы, включая имя + исполняемого файла - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - записывает в строку s n-й параметр программы, - нумерация параметров от 0 до argc - 1, - нулевой параметр -- имя исполняемого файла + PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) + записывает в строку s n-й параметр программы, + нумерация параметров от 0 до argc - 1, + нулевой параметр -- имя исполняемого файла ------------------------------------------------------------------------------ MODULE KOSAPI - PROCEDURE sysfunc1(arg1: INTEGER): INTEGER - PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER - ... - PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER - Обертки для функций API ядра KolibriOS. - arg1 .. arg7 соответствуют регистрам - eax, ebx, ecx, edx, esi, edi, ebp; - возвращают значение регистра eax после системного вызова. + PROCEDURE sysfunc1(arg1: INTEGER): INTEGER + PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER + ... + PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER + Обертки для функций API ядра KolibriOS. + arg1 .. arg7 соответствуют регистрам + eax, ebx, ecx, edx, esi, edi, ebp; + возвращают значение регистра eax после системного вызова. - PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER - Обертка для функций API ядра KolibriOS. - arg1 - регистр eax, arg2 - регистр ebx, - res2 - значение регистра ebx после системного вызова; - возвращает значение регистра eax после системного вызова. + PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER + Обертка для функций API ядра KolibriOS. + arg1 - регистр eax, arg2 - регистр ebx, + res2 - значение регистра ebx после системного вызова; + возвращает значение регистра eax после системного вызова. - PROCEDURE malloc(size: INTEGER): INTEGER - Выделяет блок памяти. - size - размер блока в байтах, - возвращает адрес выделенного блока + PROCEDURE malloc(size: INTEGER): INTEGER + Выделяет блок памяти. + size - размер блока в байтах, + возвращает адрес выделенного блока - PROCEDURE free(ptr: INTEGER): INTEGER - Освобождает ранее выделенный блок памяти с адресом ptr, - возвращает 0 + PROCEDURE free(ptr: INTEGER): INTEGER + Освобождает ранее выделенный блок памяти с адресом ptr, + возвращает 0 - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - Перераспределяет блок памяти, - ptr - адрес ранее выделенного блока, - size - новый размер, - возвращает указатель на перераспределенный блок, - 0 при ошибке + PROCEDURE realloc(ptr, size: INTEGER): INTEGER + Перераспределяет блок памяти, + ptr - адрес ранее выделенного блока, + size - новый размер, + возвращает указатель на перераспределенный блок, + 0 при ошибке - PROCEDURE GetCommandLine(): INTEGER - Возвращает адрес строки параметров + PROCEDURE GetCommandLine(): INTEGER + Возвращает адрес строки параметров - PROCEDURE GetName(): INTEGER - Возвращает адрес строки с именем программы + PROCEDURE GetName(): INTEGER + Возвращает адрес строки с именем программы - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - Загружает DLL с полным именем name. Возвращает адрес таблицы - экспорта. При ошибке возвращает 0. + PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER + Загружает DLL с полным именем name. Возвращает адрес таблицы + экспорта. При ошибке возвращает 0. - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - имя процедуры - lib - адрес таблицы экспорта DLL - Возвращает адрес процедуры. При ошибке возвращает 0. + PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER + name - имя процедуры + lib - адрес таблицы экспорта DLL + Возвращает адрес процедуры. При ошибке возвращает 0. ------------------------------------------------------------------------------ MODULE ColorDlg - работа с диалогом "Color Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* структура диалога *) - status: INTEGER (* состояние диалога: - 0 - пользователь нажал Cancel - 1 - пользователь нажал OK - 2 - диалог открыт *) + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) - color: INTEGER (* выбранный цвет *) - END + color: INTEGER (* выбранный цвет *) + END - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - создать диалог - draw_window - процедура перерисовки основного окна - (TYPE DRAW_WINDOW = PROCEDURE); - процедура возвращает указатель на структуру диалога + PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog + создать диалог + draw_window - процедура перерисовки основного окна + (TYPE DRAW_WINDOW = PROCEDURE); + процедура возвращает указатель на структуру диалога - PROCEDURE Show(cd: Dialog) - показать диалог - cd - указатель на структуру диалога, который был создан ранее - процедурой Create + PROCEDURE Show(cd: Dialog) + показать диалог + cd - указатель на структуру диалога, который был создан ранее + процедурой Create - PROCEDURE Destroy(VAR cd: Dialog) - уничтожить диалог - cd - указатель на структуру диалога + PROCEDURE Destroy(VAR cd: Dialog) + уничтожить диалог + cd - указатель на структуру диалога ------------------------------------------------------------------------------ MODULE OpenDlg - работа с диалогом "Open Dialog" - TYPE + TYPE - Dialog = POINTER TO RECORD (* структура диалога *) - status: INTEGER (* состояние диалога: - 0 - пользователь нажал Cancel - 1 - пользователь нажал OK - 2 - диалог открыт *) + Dialog = POINTER TO RECORD (* структура диалога *) + status: INTEGER (* состояние диалога: + 0 - пользователь нажал Cancel + 1 - пользователь нажал OK + 2 - диалог открыт *) - FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) - FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного - файла *) - END + FileName: ARRAY 4096 OF CHAR (* имя выбранного файла *) + FilePath: ARRAY 4096 OF CHAR (* полное имя выбранного + файла *) + END - PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, - filter: ARRAY OF CHAR): Dialog - создать диалог - draw_window - процедура перерисовки основного окна - (TYPE DRAW_WINDOW = PROCEDURE) - type - тип диалога - 0 - открыть - 1 - сохранить - 2 - выбрать папку - def_path - путь по умолчанию, папка def_path будет открыта - при первом запуске диалога - filter - в строке записано перечисление расширений файлов, - которые будут показаны в диалоговом окне, расширения - разделяются символом "|", например: "ASM|TXT|INI" - процедура возвращает указатель на структуру диалога + PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, + filter: ARRAY OF CHAR): Dialog + создать диалог + draw_window - процедура перерисовки основного окна + (TYPE DRAW_WINDOW = PROCEDURE) + type - тип диалога + 0 - открыть + 1 - сохранить + 2 - выбрать папку + def_path - путь по умолчанию, папка def_path будет открыта + при первом запуске диалога + filter - в строке записано перечисление расширений файлов, + которые будут показаны в диалоговом окне, расширения + разделяются символом "|", например: "ASM|TXT|INI" + процедура возвращает указатель на структуру диалога - PROCEDURE Show(od: Dialog; Width, Height: INTEGER) - показать диалог - od - указатель на структуру диалога, который был создан ранее - процедурой Create - Width и Height - ширина и высота диалогового окна + PROCEDURE Show(od: Dialog; Width, Height: INTEGER) + показать диалог + od - указатель на структуру диалога, который был создан ранее + процедурой Create + Width и Height - ширина и высота диалогового окна - PROCEDURE Destroy(VAR od: Dialog) - уничтожить диалог - od - указатель на структуру диалога + PROCEDURE Destroy(VAR od: Dialog) + уничтожить диалог + od - указатель на структуру диалога ------------------------------------------------------------------------------ MODULE kfonts - работа с kf-шрифтами - CONST + CONST - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 + bold = 1 + italic = 2 + underline = 4 + strike_through = 8 + smoothing = 16 + bpp32 = 32 - TYPE + TYPE - TFont = POINTER TO TFont_desc (* указатель на шрифт *) + TFont = POINTER TO TFont_desc (* указатель на шрифт *) - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - загрузить шрифт из файла - file_name имя kf-файла - рез-т: указатель на шрифт/NIL (ошибка) + PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont + загрузить шрифт из файла + file_name имя kf-файла + рез-т: указатель на шрифт/NIL (ошибка) - PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN - установить размер шрифта - Font указатель на шрифт - font_size размер шрифта - рез-т: TRUE/FALSE (ошибка) + PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN + установить размер шрифта + Font указатель на шрифт + font_size размер шрифта + рез-т: TRUE/FALSE (ошибка) - PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN - проверить, есть ли шрифт, заданного размера - Font указатель на шрифт - font_size размер шрифта - рез-т: TRUE/FALSE (шрифта нет) + PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN + проверить, есть ли шрифт, заданного размера + Font указатель на шрифт + font_size размер шрифта + рез-т: TRUE/FALSE (шрифта нет) - PROCEDURE Destroy(VAR Font: TFont) - выгрузить шрифт, освободить динамическую память - Font указатель на шрифт - Присваивает переменной Font значение NIL + PROCEDURE Destroy(VAR Font: TFont) + выгрузить шрифт, освободить динамическую память + Font указатель на шрифт + Присваивает переменной Font значение NIL - PROCEDURE TextHeight(Font: TFont): INTEGER - получить высоту строки текста - Font указатель на шрифт - рез-т: высота строки текста в пикселях + PROCEDURE TextHeight(Font: TFont): INTEGER + получить высоту строки текста + Font указатель на шрифт + рез-т: высота строки текста в пикселях - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - получить ширину строки текста - Font указатель на шрифт - str адрес строки текста в кодировке Win-1251 - length количество символов в строке или -1, если строка - завершается нулем - params параметры-флаги см. ниже - рез-т: ширина строки текста в пикселях + PROCEDURE TextWidth(Font: TFont; + str, length, params: INTEGER): INTEGER + получить ширину строки текста + Font указатель на шрифт + str адрес строки текста в кодировке Win-1251 + length количество символов в строке или -1, если строка + завершается нулем + params параметры-флаги см. ниже + рез-т: ширина строки текста в пикселях - PROCEDURE TextOut(Font: TFont; - canvas, x, y, str, length, color, params: INTEGER) - вывести текст в буфер - для вывода буфера в окно, использовать ф.65 или - ф.7 (если буфер 24-битный) - Font указатель на шрифт - canvas адрес графического буфера - структура буфера: - Xsize dd - Ysize dd - picture rb Xsize * Ysize * 4 (32 бита) - или Xsize * Ysize * 3 (24 бита) - x, y координаты текста относительно левого верхнего - угла буфера - str адрес строки текста в кодировке Win-1251 - length количество символов в строке или -1, если строка - завершается нулем - color цвет текста 0x00RRGGBB - params параметры-флаги: - 1 жирный - 2 курсив - 4 подчеркнутый - 8 перечеркнутый - 16 применить сглаживание - 32 вывод в 32-битный буфер - возможно использование флагов в любых сочетаниях + PROCEDURE TextOut(Font: TFont; + canvas, x, y, str, length, color, params: INTEGER) + вывести текст в буфер + для вывода буфера в окно, использовать ф.65 или + ф.7 (если буфер 24-битный) + Font указатель на шрифт + canvas адрес графического буфера + структура буфера: + Xsize dd + Ysize dd + picture rb Xsize * Ysize * 4 (32 бита) + или Xsize * Ysize * 3 (24 бита) + x, y координаты текста относительно левого верхнего + угла буфера + str адрес строки текста в кодировке Win-1251 + length количество символов в строке или -1, если строка + завершается нулем + color цвет текста 0x00RRGGBB + params параметры-флаги: + 1 жирный + 2 курсив + 4 подчеркнутый + 8 перечеркнутый + 16 применить сглаживание + 32 вывод в 32-битный буфер + возможно использование флагов в любых сочетаниях ------------------------------------------------------------------------------ MODULE RasterWorks - обертка библиотеки Rasterworks.obj ------------------------------------------------------------------------------ diff --git a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 index 729c365a9f..d25a8d6938 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 @@ -17,7 +17,7 @@ MODULE File; -IMPORT sys := SYSTEM, KOSAPI; +IMPORT sys := SYSTEM, KOSAPI; CONST @@ -47,7 +47,7 @@ TYPE time_modif*, date_modif*, size*, hsize*: INTEGER; name*: FNAME - END; + END; PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER; @@ -67,7 +67,7 @@ BEGIN 0C2H, 008H, 000H (* ret 8 *) ) RETURN 0 -END f_68_27; +END f_68_27; PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; @@ -77,7 +77,7 @@ END Load; PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; VAR - res2: INTEGER; fs: rFS; + res2: INTEGER; fs: rFS; BEGIN fs.subfunc := 5; @@ -88,7 +88,7 @@ BEGIN COPY(FName, fs.name) RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0 -END GetFileInfo; +END GetFileInfo; PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN; @@ -97,7 +97,7 @@ VAR BEGIN RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) END Exists; - + PROCEDURE Close* (VAR F: FS); BEGIN @@ -109,9 +109,9 @@ END Close; PROCEDURE Open* (FName: ARRAY OF CHAR): FS; VAR - F: FS; + F: FS; -BEGIN +BEGIN IF Exists(FName) THEN NEW(F); @@ -128,7 +128,7 @@ BEGIN END RETURN F -END Open; +END Open; PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; @@ -158,7 +158,7 @@ BEGIN RETURN res = 0 END Delete; - + PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER; VAR @@ -202,7 +202,7 @@ BEGIN END RETURN res2 -END Read; +END Read; PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER; @@ -225,7 +225,7 @@ BEGIN RETURN res2 END Write; - + PROCEDURE Create* (FName: ARRAY OF CHAR): FS; VAR @@ -249,14 +249,14 @@ BEGIN RETURN F END Create; - + PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN; VAR fd: rFD; BEGIN RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr)) -END DirExists; +END DirExists; PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; @@ -282,7 +282,7 @@ BEGIN RETURN res = 0 END CreateDir; - + PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN; VAR diff --git a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 index 6031e758ee..b1fe62acc0 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 @@ -1,5 +1,5 @@ я╗┐(* - Copyright 2013, 2014, 2018 Anton Krotov + Copyright 2013, 2014, 2018, 2019 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -167,10 +167,10 @@ END ln; PROCEDURE [stdcall] log* (base, x: REAL): REAL; -BEGIN +BEGIN SYSTEM.CODE( 0D9H, 0E8H, (* fld1 *) - 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) 0D9H, 0F1H, (* fyl2x *) 0D9H, 0E8H, (* fld1 *) 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) @@ -251,58 +251,45 @@ END arctan; PROCEDURE sinh* (x: REAL): REAL; -VAR - res: REAL; - BEGIN - IF IsZero(x) THEN - res := 0.0 - ELSE - res := (exp(x) - exp(-x)) / 2.0 - END - RETURN res + x := exp(x) + RETURN (x - 1.0 / x) * 0.5 END sinh; PROCEDURE cosh* (x: REAL): REAL; -VAR - res: REAL; - BEGIN - IF IsZero(x) THEN - res := 1.0 - ELSE - res := (exp(x) + exp(-x)) / 2.0 - END - RETURN res + x := exp(x) + RETURN (x + 1.0 / x) * 0.5 END cosh; PROCEDURE tanh* (x: REAL): REAL; -VAR - res: REAL; - BEGIN - IF IsZero(x) THEN - res := 0.0 + IF x > 15.0 THEN + x := 1.0 + ELSIF x < -15.0 THEN + x := -1.0 ELSE - res := sinh(x) / cosh(x) + x := exp(2.0 * x); + x := (x - 1.0) / (x + 1.0) END - RETURN res + + RETURN x END tanh; -PROCEDURE arcsinh* (x: REAL): REAL; - RETURN ln(x + sqrt((x * x) + 1.0)) -END arcsinh; +PROCEDURE arsinh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x + 1.0)) +END arsinh; -PROCEDURE arccosh* (x: REAL): REAL; - RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0)) -END arccosh; +PROCEDURE arcosh* (x: REAL): REAL; + RETURN ln(x + sqrt(x * x - 1.0)) +END arcosh; -PROCEDURE arctanh* (x: REAL): REAL; +PROCEDURE artanh* (x: REAL): REAL; VAR res: REAL; @@ -315,7 +302,7 @@ BEGIN res := 0.5 * ln((1.0 + x) / (1.0 - x)) END RETURN res -END arctanh; +END artanh; PROCEDURE floor* (x: REAL): REAL; @@ -374,8 +361,24 @@ BEGIN ELSE res := 0 END + RETURN res END sgn; - + + +PROCEDURE fact* (n: INTEGER): REAL; +VAR + res: REAL; + +BEGIN + res := 1.0; + WHILE n > 1 DO + res := res * FLT(n); + DEC(n) + END + + RETURN res +END fact; + END Math. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 b/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 index 9ed2bfacdb..c0ed629f9c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/NetDevices.ob07 @@ -1,4 +1,4 @@ -(* +я╗┐(* Copyright 2017 Anton Krotov This program is free software: you can redistribute it and/or modify @@ -24,18 +24,18 @@ CONST //net devices types - LOOPBACK* = 0; - ETH* = 1; - SLIP* = 2; + LOOPBACK* = 0; + ETH* = 1; + SLIP* = 2; //Link status - LINK_DOWN* = 0; + LINK_DOWN* = 0; LINK_UNKNOWN* = 1; - LINK_FD* = 2; //full duplex flag - LINK_10M* = 4; - LINK_100M* = 8; - LINK_1G* = 12; + LINK_FD* = 2; //full duplex flag + LINK_10M* = 4; + LINK_100M* = 8; + LINK_1G* = 12; TYPE diff --git a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 index 2758c1e417..0a33a3269c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 @@ -10,7 +10,7 @@ MODULE RTL; IMPORT SYSTEM, API; -CONST +CONST bit_depth* = 32; maxint* = 7FFFFFFFH; @@ -22,11 +22,13 @@ CONST DLL_PROCESS_DETACH = 0; SIZE_OF_DWORD = 4; + MAX_SET = 31; TYPE DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + PROC = PROCEDURE; VAR @@ -40,6 +42,8 @@ VAR thread_attach: DLL_ENTRY END; + fini: PROC; + PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN @@ -107,18 +111,12 @@ BEGIN END _arrcpy; -PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN _move(MIN(len_dst, len_src) * chr_size, src, dst) END _strcpy; -PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); -BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) -END _strcpy2; - - PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); VAR i, n, k: INTEGER; @@ -137,32 +135,29 @@ BEGIN END _rot; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; -VAR - res: INTEGER; - +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; BEGIN - IF (a <= b) & (a <= 31) & (b >= 0) THEN - IF b > 31 THEN - b := 31 + IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN + IF b > MAX_SET THEN + b := MAX_SET END; IF a < 0 THEN a := 0 END; - res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) ELSE - res := 0 + a := 0 END - RETURN res -END _set2; - - -PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; - RETURN _set2(a, b) + RETURN a END _set; +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; + RETURN _set(b, a) +END _set2; + + PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -185,7 +180,7 @@ BEGIN END divmod; -PROCEDURE div_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -196,10 +191,10 @@ BEGIN END RETURN div -END div_; +END _div2; -PROCEDURE mod_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -210,29 +205,19 @@ BEGIN END RETURN mod -END mod_; +END _mod2; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN div_(a, b) + RETURN _div2(a, b) END _div; -PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; - RETURN div_(a, b) -END _div2; - - PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN mod_(a, b) + RETURN _mod2(a, b) END _mod; -PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; - RETURN mod_(a, b) -END _mod2; - - PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); BEGIN ptr := API._NEW(size); @@ -251,50 +236,6 @@ BEGIN END _dispose; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmp; - - -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmpw; - - PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -345,16 +286,71 @@ BEGIN END _lengthw; +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmpw; + + PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: CHAR; BEGIN res := strncmp(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _length(len1, str1) - _length(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -370,21 +366,25 @@ BEGIN END _strcmp; -PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmp(op, len2, str2, len1, str1) -END _strcmp2; - - PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: WCHAR; BEGIN res := strncmpw(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _lengthw(len1, str1) - _lengthw(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2 * 2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1 * 2, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -400,11 +400,6 @@ BEGIN END _strcmpw; -PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmpw(op, len2, str2, len1, str1) -END _strcmpw2; - - PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); VAR c: CHAR; @@ -470,14 +465,14 @@ BEGIN END append; -PROCEDURE [stdcall] _error* (module, err: INTEGER); +PROCEDURE [stdcall] _error* (module, err, line: INTEGER); VAR s, temp: ARRAY 1024 OF CHAR; BEGIN s := ""; - CASE err MOD 16 OF + CASE err OF | 1: append(s, "assertion failure") | 2: append(s, "NIL dereference") | 3: append(s, "division by zero") @@ -493,8 +488,8 @@ BEGIN append(s, API.eol); - append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); - append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + 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); @@ -502,69 +497,42 @@ BEGIN END _error; -PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; BEGIN - (* r IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _isrec; -PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) - IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - ELSE - t1 := -1 + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) END - RETURN t1 = t0 + RETURN p MOD 2 END _is; -PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; BEGIN - (* r:t1 IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _guardrec; -PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) SYSTEM.GET(p, p); IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # t0) & (t1 # 0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) ELSE - t1 := t0 + p := 1 END - RETURN t1 = t0 + RETURN p MOD 2 END _guard; @@ -613,18 +581,50 @@ BEGIN END _exit; -PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + BEGIN SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) API.init(param, code); - types := _types; + types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); + ASSERT(types # 0); + FOR i := 0 TO tcount - 1 DO + FOR j := 0 TO tcount - 1 DO + t0 := i; t1 := j; + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + name := modname; dll.process_detach := NIL; dll.thread_detach := NIL; dll.thread_attach := NIL; + + fini := NIL END _init; +PROCEDURE [stdcall] _sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END _sofinit; + + +PROCEDURE SetFini* (ProcFini: PROC); +BEGIN + fini := ProcFini +END SetFini; + + END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 index 1dc5069bc6..46de391ccd 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Vector.ob07 @@ -1,4 +1,4 @@ -(* +я╗┐(* Copyright 2016 Anton Krotov This program is free software: you can redistribute it and/or modify diff --git a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 index 339516e58e..9506a44109 100644 --- a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 @@ -38,16 +38,6 @@ VAR clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; -PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER; - RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1) -END dlopen; - - -PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER; - RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0])) -END dlsym; - - PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); VAR i, len, ptr: INTEGER; diff --git a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 index 2758c1e417..0a33a3269c 100644 --- a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 @@ -10,7 +10,7 @@ MODULE RTL; IMPORT SYSTEM, API; -CONST +CONST bit_depth* = 32; maxint* = 7FFFFFFFH; @@ -22,11 +22,13 @@ CONST DLL_PROCESS_DETACH = 0; SIZE_OF_DWORD = 4; + MAX_SET = 31; TYPE DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + PROC = PROCEDURE; VAR @@ -40,6 +42,8 @@ VAR thread_attach: DLL_ENTRY END; + fini: PROC; + PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN @@ -107,18 +111,12 @@ BEGIN END _arrcpy; -PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN _move(MIN(len_dst, len_src) * chr_size, src, dst) END _strcpy; -PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); -BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) -END _strcpy2; - - PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); VAR i, n, k: INTEGER; @@ -137,32 +135,29 @@ BEGIN END _rot; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; -VAR - res: INTEGER; - +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; BEGIN - IF (a <= b) & (a <= 31) & (b >= 0) THEN - IF b > 31 THEN - b := 31 + IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN + IF b > MAX_SET THEN + b := MAX_SET END; IF a < 0 THEN a := 0 END; - res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) ELSE - res := 0 + a := 0 END - RETURN res -END _set2; - - -PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; - RETURN _set2(a, b) + RETURN a END _set; +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; + RETURN _set(b, a) +END _set2; + + PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -185,7 +180,7 @@ BEGIN END divmod; -PROCEDURE div_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -196,10 +191,10 @@ BEGIN END RETURN div -END div_; +END _div2; -PROCEDURE mod_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -210,29 +205,19 @@ BEGIN END RETURN mod -END mod_; +END _mod2; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN div_(a, b) + RETURN _div2(a, b) END _div; -PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; - RETURN div_(a, b) -END _div2; - - PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN mod_(a, b) + RETURN _mod2(a, b) END _mod; -PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; - RETURN mod_(a, b) -END _mod2; - - PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); BEGIN ptr := API._NEW(size); @@ -251,50 +236,6 @@ BEGIN END _dispose; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmp; - - -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmpw; - - PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -345,16 +286,71 @@ BEGIN END _lengthw; +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmpw; + + PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: CHAR; BEGIN res := strncmp(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _length(len1, str1) - _length(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -370,21 +366,25 @@ BEGIN END _strcmp; -PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmp(op, len2, str2, len1, str1) -END _strcmp2; - - PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: WCHAR; BEGIN res := strncmpw(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _lengthw(len1, str1) - _lengthw(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2 * 2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1 * 2, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -400,11 +400,6 @@ BEGIN END _strcmpw; -PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmpw(op, len2, str2, len1, str1) -END _strcmpw2; - - PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); VAR c: CHAR; @@ -470,14 +465,14 @@ BEGIN END append; -PROCEDURE [stdcall] _error* (module, err: INTEGER); +PROCEDURE [stdcall] _error* (module, err, line: INTEGER); VAR s, temp: ARRAY 1024 OF CHAR; BEGIN s := ""; - CASE err MOD 16 OF + CASE err OF | 1: append(s, "assertion failure") | 2: append(s, "NIL dereference") | 3: append(s, "division by zero") @@ -493,8 +488,8 @@ BEGIN append(s, API.eol); - append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); - append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + 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); @@ -502,69 +497,42 @@ BEGIN END _error; -PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; BEGIN - (* r IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _isrec; -PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) - IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - ELSE - t1 := -1 + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) END - RETURN t1 = t0 + RETURN p MOD 2 END _is; -PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; BEGIN - (* r:t1 IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _guardrec; -PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) SYSTEM.GET(p, p); IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # t0) & (t1 # 0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) ELSE - t1 := t0 + p := 1 END - RETURN t1 = t0 + RETURN p MOD 2 END _guard; @@ -613,18 +581,50 @@ BEGIN END _exit; -PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + BEGIN SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) API.init(param, code); - types := _types; + types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); + ASSERT(types # 0); + FOR i := 0 TO tcount - 1 DO + FOR j := 0 TO tcount - 1 DO + t0 := i; t1 := j; + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + name := modname; dll.process_detach := NIL; dll.thread_detach := NIL; dll.thread_attach := NIL; + + fini := NIL END _init; +PROCEDURE [stdcall] _sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END _sofinit; + + +PROCEDURE SetFini* (ProcFini: PROC); +BEGIN + fini := ProcFini +END SetFini; + + END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/API.ob07 b/programs/develop/oberon07/Lib/Windows32/API.ob07 index 07b4226363..588669fa75 100644 --- a/programs/develop/oberon07/Lib/Windows32/API.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/API.ob07 @@ -13,14 +13,16 @@ VAR eol*: ARRAY 3 OF CHAR; base*: INTEGER; + heap: INTEGER; -PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); -PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); -PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER; -PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: 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 [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); @@ -30,19 +32,22 @@ END DebugMsg; PROCEDURE _NEW* (size: INTEGER): INTEGER; - RETURN Alloc(64, size) + RETURN HeapAlloc(heap, 8, size) END _NEW; PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; - RETURN Free(p) +BEGIN + HeapFree(heap, 0, p) + RETURN 0 END _DISPOSE; PROCEDURE init* (reserved, code: INTEGER); BEGIN eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; - base := code - 4096 + base := code - 4096; + heap := GetProcessHeap() END init; diff --git a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 index 2758c1e417..0a33a3269c 100644 --- a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 @@ -10,7 +10,7 @@ MODULE RTL; IMPORT SYSTEM, API; -CONST +CONST bit_depth* = 32; maxint* = 7FFFFFFFH; @@ -22,11 +22,13 @@ CONST DLL_PROCESS_DETACH = 0; SIZE_OF_DWORD = 4; + MAX_SET = 31; TYPE DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + PROC = PROCEDURE; VAR @@ -40,6 +42,8 @@ VAR thread_attach: DLL_ENTRY END; + fini: PROC; + PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN @@ -107,18 +111,12 @@ BEGIN END _arrcpy; -PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); BEGIN _move(MIN(len_dst, len_src) * chr_size, src, dst) END _strcpy; -PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); -BEGIN - _move(MIN(len_dst, len_src) * chr_size, src, dst) -END _strcpy2; - - PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); VAR i, n, k: INTEGER; @@ -137,32 +135,29 @@ BEGIN END _rot; -PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; -VAR - res: INTEGER; - +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; BEGIN - IF (a <= b) & (a <= 31) & (b >= 0) THEN - IF b > 31 THEN - b := 31 + IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN + IF b > MAX_SET THEN + b := MAX_SET END; IF a < 0 THEN a := 0 END; - res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b) ELSE - res := 0 + a := 0 END - RETURN res -END _set2; - - -PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; - RETURN _set2(a, b) + RETURN a END _set; +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; + RETURN _set(b, a) +END _set2; + + PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -185,7 +180,7 @@ BEGIN END divmod; -PROCEDURE div_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -196,10 +191,10 @@ BEGIN END RETURN div -END div_; +END _div2; -PROCEDURE mod_ (x, y: INTEGER): INTEGER; +PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER; VAR div, mod: INTEGER; @@ -210,29 +205,19 @@ BEGIN END RETURN mod -END mod_; +END _mod2; PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; - RETURN div_(a, b) + RETURN _div2(a, b) END _div; -PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; - RETURN div_(a, b) -END _div2; - - PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; - RETURN mod_(a, b) + RETURN _mod2(a, b) END _mod; -PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; - RETURN mod_(a, b) -END _mod2; - - PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); BEGIN ptr := API._NEW(size); @@ -251,50 +236,6 @@ BEGIN END _dispose; -PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a); - SYSTEM.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmp; - - -PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; -VAR - A, B: WCHAR; - res: INTEGER; - -BEGIN - res := 0; - WHILE n > 0 DO - SYSTEM.GET(a, A); INC(a, 2); - SYSTEM.GET(b, B); INC(b, 2); - DEC(n); - IF A # B THEN - res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN res -END strncmpw; - - PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; BEGIN SYSTEM.CODE( @@ -345,16 +286,71 @@ BEGIN END _lengthw; +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := minint; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + res := 0; + n := 0 + END + END + RETURN res +END strncmpw; + + PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: CHAR; BEGIN res := strncmp(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _length(len1, str1) - _length(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -370,21 +366,25 @@ BEGIN END _strcmp; -PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmp(op, len2, str2, len1, str1) -END _strcmp2; - - PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; VAR res: INTEGER; bRes: BOOLEAN; + c: WCHAR; BEGIN res := strncmpw(str1, str2, MIN(len1, len2)); - IF res = 0 THEN - res := _lengthw(len1, str1) - _lengthw(len2, str2) + IF res = minint THEN + IF len1 > len2 THEN + SYSTEM.GET(str1 + len2 * 2, c); + res := ORD(c) + ELSIF len1 < len2 THEN + SYSTEM.GET(str2 + len1 * 2, c); + res := -ORD(c) + ELSE + res := 0 + END END; CASE op OF @@ -400,11 +400,6 @@ BEGIN END _strcmpw; -PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; - RETURN _strcmpw(op, len2, str2, len1, str1) -END _strcmpw2; - - PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); VAR c: CHAR; @@ -470,14 +465,14 @@ BEGIN END append; -PROCEDURE [stdcall] _error* (module, err: INTEGER); +PROCEDURE [stdcall] _error* (module, err, line: INTEGER); VAR s, temp: ARRAY 1024 OF CHAR; BEGIN s := ""; - CASE err MOD 16 OF + CASE err OF | 1: append(s, "assertion failure") | 2: append(s, "NIL dereference") | 3: append(s, "division by zero") @@ -493,8 +488,8 @@ BEGIN append(s, API.eol); - append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); - append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + 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); @@ -502,69 +497,42 @@ BEGIN END _error; -PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER; BEGIN - (* r IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _isrec; -PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) - IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - ELSE - t1 := -1 + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) END - RETURN t1 = t0 + RETURN p MOD 2 END _is; -PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER; BEGIN - (* r:t1 IS t0 *) - - WHILE (t1 # 0) & (t1 # t0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END - - RETURN t1 = t0 + SYSTEM.GET(t0 + t1 + types, t0) + RETURN t0 MOD 2 END _guardrec; -PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; -VAR - t1: INTEGER; - +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER; BEGIN - (* p IS t0 *) SYSTEM.GET(p, p); IF p # 0 THEN - DEC(p, SIZE_OF_DWORD); - SYSTEM.GET(p, t1); - WHILE (t1 # t0) & (t1 # 0) DO - SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) - END + SYSTEM.GET(p - SIZE_OF_DWORD, p); + SYSTEM.GET(t0 + p + types, p) ELSE - t1 := t0 + p := 1 END - RETURN t1 = t0 + RETURN p MOD 2 END _guard; @@ -613,18 +581,50 @@ BEGIN END _exit; -PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); +VAR + t0, t1, i, j: INTEGER; + BEGIN SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) API.init(param, code); - types := _types; + types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); + ASSERT(types # 0); + FOR i := 0 TO tcount - 1 DO + FOR j := 0 TO tcount - 1 DO + t0 := i; t1 := j; + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1) + END; + + SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) + END + END; + name := modname; dll.process_detach := NIL; dll.thread_detach := NIL; dll.thread_attach := NIL; + + fini := NIL END _init; +PROCEDURE [stdcall] _sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END _sofinit; + + +PROCEDURE SetFini* (ProcFini: PROC); +BEGIN + fini := ProcFini +END SetFini; + + END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/AMD64.ob07 b/programs/develop/oberon07/Source/AMD64.ob07 index c1fa1f65c0..fb34e0754d 100644 --- a/programs/develop/oberon07/Source/AMD64.ob07 +++ b/programs/develop/oberon07/Source/AMD64.ob07 @@ -7,7 +7,7 @@ MODULE AMD64; -IMPORT CODE, BIN, WR := WRITER, CHL := CHUNKLISTS, MACHINE, LISTS, PATHS, +IMPORT IL, BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS, PATHS, PROG, REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86; @@ -31,7 +31,7 @@ CONST sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; - shl = CODE.opLSL2; shr = CODE.opLSR2; sar = CODE.opASR2; ror = CODE.opROR2; + shl = IL.opLSL2; shr = IL.opLSR2; sar = IL.opASR2; ror = IL.opROR2; sCODE = BIN.PICCODE; sDATA = BIN.PICDATA; @@ -41,7 +41,7 @@ CONST TYPE - COMMAND = CODE.COMMAND; + COMMAND = IL.COMMAND; Number = POINTER TO RECORD (LISTS.ITEM) value: INTEGER END; @@ -58,7 +58,9 @@ VAR prog: BIN.PROGRAM; - dllret: INTEGER; + tcount: INTEGER; + + dllret, sofinit: INTEGER; Win64RegPar: ARRAY 4 OF INTEGER; SystemVRegPar: ARRAY 6 OF INTEGER; @@ -87,10 +89,10 @@ END OutByte3; PROCEDURE OutInt (n: INTEGER); BEGIN - OutByte(MACHINE.Byte(n, 0)); - OutByte(MACHINE.Byte(n, 1)); - OutByte(MACHINE.Byte(n, 2)); - OutByte(MACHINE.Byte(n, 3)) + OutByte(UTILS.Byte(n, 0)); + OutByte(UTILS.Byte(n, 1)); + OutByte(UTILS.Byte(n, 2)); + OutByte(UTILS.Byte(n, 3)) END OutInt; @@ -112,7 +114,7 @@ END long; PROCEDURE OutIntByte (n: INTEGER); BEGIN IF isByte(n) THEN - OutByte(MACHINE.Byte(n, 0)) + OutByte(UTILS.Byte(n, 0)) ELSE OutInt(n) END @@ -120,7 +122,7 @@ END OutIntByte; PROCEDURE isLong (n: INTEGER): BOOLEAN; - RETURN (n > MACHINE.max32) OR (n < MACHINE.min32) + RETURN (n > UTILS.max32) OR (n < UTILS.min32) END isLong; @@ -139,7 +141,7 @@ END NewNumber; PROCEDURE NewLabel (): INTEGER; BEGIN BIN.NewLabel(prog) - RETURN CODE.NewLabel() + RETURN IL.NewLabel() END NewLabel; @@ -257,12 +259,22 @@ BEGIN END drop; +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE GetVarReg (offs: INTEGER): INTEGER; + RETURN REG.GetVarReg(R, offs) +END GetVarReg; + + PROCEDURE callimp (label: INTEGER); VAR reg: INTEGER; BEGIN - reg := REG.GetAnyReg(R); + reg := GetAnyReg(); lea(reg, label, sIMP); IF reg >= 8 THEN // call qword[reg] OutByte(41H) @@ -277,7 +289,7 @@ VAR reg: INTEGER; BEGIN - reg := REG.GetAnyReg(R); + reg := GetAnyReg(); lea(reg, offs, sDATA); push(reg); drop @@ -290,7 +302,7 @@ VAR BEGIN REG.Store(R); - label := CODE.codes.rtl[proc]; + label := IL.codes.rtl[proc]; IF label < 0 THEN callimp(-label) ELSE @@ -315,7 +327,7 @@ END BinOp; PROCEDURE PushAll (NumberOfParameters: INTEGER); BEGIN REG.PushAll(R); - R.pushed := R.pushed - NumberOfParameters + DEC(R.pushed, NumberOfParameters) END PushAll; @@ -327,7 +339,7 @@ BEGIN Rex(reg, 0); OutByte(0B8H + reg MOD 8); // movabs reg, n FOR i := 0 TO 7 DO - OutByte(MACHINE.Byte(n, i)) + OutByte(UTILS.Byte(n, i)) END END movabs; @@ -336,6 +348,8 @@ PROCEDURE movrc (reg, n: INTEGER); // mov reg, n BEGIN IF isLong(n) THEN movabs(reg, n) + ELSIF n = 0 THEN + xor(reg, reg) ELSE Rex(reg, 0); OutByte2(0C7H, 0C0H + reg MOD 8); @@ -355,7 +369,7 @@ VAR reg2: INTEGER; BEGIN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movabs(reg2, n); oprr(reg, reg2); drop @@ -404,7 +418,7 @@ VAR BEGIN IF isLong(n) THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movabs(reg2, n); push(reg2); drop @@ -642,14 +656,14 @@ BEGIN END shiftrc; -PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): CODE.LOCALVAR; +PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): IL.LOCALVAR; VAR - cur: CODE.LOCALVAR; + cur: IL.LOCALVAR; BEGIN - cur := variables.first(CODE.LOCALVAR); + cur := variables.first(IL.LOCALVAR); WHILE (cur # NIL) & (cur.offset # offset) DO - cur := cur.next(CODE.LOCALVAR) + cur := cur.next(IL.LOCALVAR) END RETURN cur @@ -662,7 +676,7 @@ VAR leaf: BOOLEAN; cur: COMMAND; variables: LISTS.LIST; - lvar, rvar: CODE.LOCALVAR; + lvar, rvar: IL.LOCALVAR; reg: INTEGER; max: INTEGER; loop: INTEGER; @@ -677,83 +691,76 @@ BEGIN cur := cmd.next(COMMAND); REPEAT CASE cur.opcode OF - |CODE.opLLOAD64, - CODE.opLLOAD8, - CODE.opLLOAD16, - CODE.opLLOAD32, - CODE.opLLOAD64_PARAM, - CODE.opLLOAD32_PARAM, - CODE.opLADR_SAVE, - CODE.opLADR_INC1, - CODE.opLADR_DEC1, - CODE.opLADR_INC, - CODE.opLADR_DEC, - CODE.opLADR_INC1B, - CODE.opLADR_DEC1B, - CODE.opLADR_INCB, - CODE.opLADR_DECB, - CODE.opLADR_INCL, - CODE.opLADR_EXCL, - CODE.opLADR_UNPK: + |IL.opLLOAD64, + IL.opLLOAD8, + IL.opLLOAD16, + IL.opLLOAD32, + IL.opLLOAD64_PARAM, + IL.opLLOAD32_PARAM, + IL.opLADR_SAVE, + IL.opLADR_INC, + IL.opLADR_DEC, + IL.opLADR_INCB, + IL.opLADR_DECB, + IL.opLADR_INCL, + IL.opLADR_EXCL, + IL.opLADR_UNPK: lvar := getVar(variables, cur.param2); IF (lvar # NIL) & (lvar.count # -1) THEN INC(lvar.count, loop) END - |CODE.opLADR_SAVEC, - CODE.opLADR_INCC, - CODE.opLADR_DECC, - CODE.opLADR_INCCB, - CODE.opLADR_DECCB, - CODE.opLADR_INCLC, - CODE.opLADR_EXCLC: + |IL.opLADR_SAVEC, + IL.opLADR_INCC, + IL.opLADR_INCCB, + IL.opLADR_DECCB, + IL.opLADR_INCLC, + IL.opLADR_EXCLC: lvar := getVar(variables, cur.param1); IF (lvar # NIL) & (lvar.count # -1) THEN INC(lvar.count, loop) END - |CODE.opLADR: + |IL.opLADR: lvar := getVar(variables, cur.param2); IF (lvar # NIL) & (lvar.count # -1) THEN lvar.count := -1 END - |CODE.opLOOP: + |IL.opLOOP: INC(loop, 10) - |CODE.opENDLOOP: + |IL.opENDLOOP: DEC(loop, 10) - |CODE.opLEAVE, - CODE.opLEAVER, - CODE.opLEAVEF: + |IL.opLEAVE, + IL.opLEAVER, + IL.opLEAVEF: leave := TRUE - |CODE.opCALL, CODE.opCALLP, CODE.opCALLI, - CODE.opWIN64CALL, CODE.opWIN64CALLP, CODE.opWIN64CALLI, - CODE.opSYSVCALL, CODE.opSYSVCALLP, CODE.opSYSVCALLI, + |IL.opCALL, IL.opCALLP, IL.opCALLI, + IL.opWIN64CALL, IL.opWIN64CALLP, IL.opWIN64CALLI, + IL.opSYSVCALL, IL.opSYSVCALLP, IL.opSYSVCALLI, - CODE.opSAVES, CODE.opRSET, CODE.opRSETR, - CODE.opRSETL, CODE.opRSET1, - CODE.opEQS .. CODE.opGES, - CODE.opEQS2 .. CODE.opGES2, - CODE.opEQSW .. CODE.opGESW, - CODE.opEQSW2 .. CODE.opGESW2, - CODE.opCOPY, CODE.opMOVE, CODE.opCOPYA, - CODE.opCOPYS, CODE.opCOPYS2, CODE.opROT, - CODE.opNEW, CODE.opDISP, CODE.opISREC, - CODE.opIS, CODE.opTYPEGR, CODE.opTYPEGP, - CODE.opCASET, CODE.opDIV, - CODE.opDIVL, CODE.opMOD, - CODE.opMODL, CODE.opLENGTH, CODE.opLENGTHW: + IL.opSAVES, IL.opRSET, IL.opRSETR, + IL.opRSETL, IL.opRSET1, + IL.opEQS .. IL.opGES, + IL.opEQSW .. IL.opGESW, + IL.opCOPY, IL.opMOVE, IL.opCOPYA, + IL.opCOPYS, IL.opROT, + IL.opNEW, IL.opDISP, IL.opISREC, + IL.opIS, IL.opTYPEGR, IL.opTYPEGP, + IL.opCASET, IL.opDIV, + IL.opDIVL, IL.opMOD, + IL.opMODL, IL.opLENGTH, IL.opLENGTHW: leaf := FALSE - |CODE.opDIVR, CODE.opMODR: + |IL.opDIVR, IL.opMODR: param2 := cur.param2; IF param2 >= 1 THEN - param2 := X86.log2(param2) + param2 := UTILS.Log2(param2) ELSIF param2 <= -1 THEN - param2 := X86.log2(-param2) + param2 := UTILS.Log2(-param2) ELSE param2 := -1 END; @@ -772,13 +779,13 @@ BEGIN reg := -1; max := -1; rvar := NIL; - lvar := variables.first(CODE.LOCALVAR); + lvar := variables.first(IL.LOCALVAR); WHILE lvar # NIL DO IF lvar.count > max THEN max := lvar.count; rvar := lvar END; - lvar := lvar.next(CODE.LOCALVAR) + lvar := lvar.next(IL.LOCALVAR) END; IF rvar # NIL THEN @@ -878,30 +885,30 @@ VAR cc, reg: INTEGER; BEGIN - reg := REG.GetAnyReg(R); + reg := GetAnyReg(); xor(reg, reg); CASE op OF - |CODE.opEQF, CODE.opEQFI: + |IL.opEQF: comisd(xmm - 1, xmm); cc := sete - |CODE.opNEF, CODE.opNEFI: + |IL.opNEF: comisd(xmm - 1, xmm); cc := setne - |CODE.opLTF, CODE.opGTFI: + |IL.opLTF: comisd(xmm - 1, xmm); cc := setc - |CODE.opGTF, CODE.opLTFI: + |IL.opGTF: comisd(xmm, xmm - 1); cc := setc - |CODE.opLEF, CODE.opGEFI: + |IL.opLEF: comisd(xmm, xmm - 1); cc := setnc - |CODE.opGEF, CODE.opLEFI: + |IL.opGEF: comisd(xmm - 1, xmm); cc := setnc END; @@ -915,7 +922,7 @@ PROCEDURE translate (commands: LISTS.LIST; stroffs: INTEGER); VAR cmd, next: COMMAND; - param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER; + opcode, param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER; reg1, reg2, xmm: INTEGER; @@ -931,22 +938,24 @@ BEGIN param1 := cmd.param1; param2 := cmd.param2; - CASE cmd.opcode OF + opcode := cmd.opcode; - |CODE.opJMP: + CASE opcode OF + + |IL.opJMP: jmp(param1) - |CODE.opCALL, CODE.opWIN64CALL, CODE.opSYSVCALL: + |IL.opCALL, IL.opWIN64CALL, IL.opSYSVCALL: REG.Store(R); - CASE cmd.opcode OF - |CODE.opCALL: - |CODE.opWIN64CALL: Win64Passing(param2) - |CODE.opSYSVCALL: SysVPassing(param2) + CASE opcode OF + |IL.opCALL: + |IL.opWIN64CALL: Win64Passing(param2) + |IL.opSYSVCALL: SysVPassing(param2) END; X86.call(param1); REG.Restore(R) - |CODE.opCALLP, CODE.opWIN64CALLP, CODE.opSYSVCALLP: + |IL.opCALLP, IL.opWIN64CALLP, IL.opSYSVCALLP: UnOp(reg1); IF reg1 # rax THEN GetRegA; @@ -955,35 +964,35 @@ BEGIN END; drop; REG.Store(R); - CASE cmd.opcode OF - |CODE.opCALLP: - |CODE.opWIN64CALLP: Win64Passing(param2) - |CODE.opSYSVCALLP: SysVPassing(param2) + CASE opcode OF + |IL.opCALLP: + |IL.opWIN64CALLP: Win64Passing(param2) + |IL.opSYSVCALLP: SysVPassing(param2) END; OutByte2(0FFH, 0D0H); // call rax REG.Restore(R); ASSERT(R.top = -1) - |CODE.opCALLI, CODE.opWIN64CALLI, CODE.opSYSVCALLI: + |IL.opCALLI, IL.opWIN64CALLI, IL.opSYSVCALLI: REG.Store(R); - CASE cmd.opcode OF - |CODE.opCALLI: - |CODE.opWIN64CALLI: Win64Passing(param2) - |CODE.opSYSVCALLI: SysVPassing(param2) + CASE opcode OF + |IL.opCALLI: + |IL.opWIN64CALLI: Win64Passing(param2) + |IL.opSYSVCALLI: SysVPassing(param2) END; callimp(param1); REG.Restore(R) - |CODE.opLABEL: - X86.SetLabel(param2) + |IL.opLABEL: + X86.SetLabel(param1) - |CODE.opERR: - CallRTL(CODE._error) + |IL.opERR: + CallRTL(IL._error) - |CODE.opERRC: + |IL.opPUSHC: pushc(param2) - |CODE.opPRECALL: + |IL.opPRECALL: n := param2; IF (param1 # 0) & (n # 0) THEN subrc(rsp, 8) @@ -997,14 +1006,14 @@ BEGIN ASSERT(xmm = -1); PushAll(0) - |CODE.opWIN64ALIGN16: + |IL.opWIN64ALIGN16: ASSERT(rax IN R.regs); mov(rax, rsp); andrc(rsp, -16); push(rax); subrc(rsp, (MAX(param2 - 4, 0) MOD 2 + MAX(4 - param2, 0) + 1) * 8) - |CODE.opSYSVALIGN16: + |IL.opSYSVALIGN16: ASSERT(rax IN R.regs); mov(rax, rsp); andrc(rsp, -16); @@ -1013,7 +1022,7 @@ BEGIN push(rax) END - |CODE.opRESF: + |IL.opRESF: ASSERT(xmm = -1); INC(xmm); n := param2; @@ -1030,7 +1039,7 @@ BEGIN DEC(n) END - |CODE.opRES: + |IL.opRES: ASSERT(R.top = -1); GetRegA; n := param2; @@ -1041,7 +1050,7 @@ BEGIN DEC(n) END - |CODE.opENTER: + |IL.opENTER: ASSERT(R.top = -1); X86.SetLabel(param1); @@ -1122,8 +1131,8 @@ BEGIN allocReg(cmd) END - |CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: - IF cmd.opcode = CODE.opLEAVER THEN + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode = IL.opLEAVER THEN UnOp(reg1); IF reg1 # rax THEN GetRegA; @@ -1135,13 +1144,16 @@ BEGIN ASSERT(R.top = -1); - IF cmd.opcode = CODE.opLEAVEF THEN + IF opcode = IL.opLEAVEF THEN DEC(xmm) END; ASSERT(xmm = -1); - mov(rsp, rbp); + IF param1 > 0 THEN + mov(rsp, rbp) + END; + pop(rbp); IF param2 > 0 THEN OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2 @@ -1150,59 +1162,55 @@ BEGIN END; REG.Reset(R) - |CODE.opSAVES: - UnOp(reg1); - drop; - PushAll(0); - push(reg1); + |IL.opSAVES: + PushAll(1); pushDA(stroffs + param2); pushc(param1); - CallRTL(CODE._move) + CallRTL(IL._move) - |CODE.opSADR: - reg1 := REG.GetAnyReg(R); - lea(reg1, stroffs + param2, sDATA) + |IL.opSADR: + lea(GetAnyReg(), stroffs + param2, sDATA) - |CODE.opLOAD8: + |IL.opLOAD8: UnOp(reg1); movzx(reg1, reg1, 0, FALSE) - |CODE.opLOAD16: + |IL.opLOAD16: UnOp(reg1); movzx(reg1, reg1, 0, TRUE) - |CODE.opLOAD32: + |IL.opLOAD32: UnOp(reg1); movrm32(reg1, reg1, 0); shiftrc(shl, reg1, 32); shiftrc(shr, reg1, 32) - |CODE.opLOAD64: + |IL.opLOAD64: UnOp(reg1); movrm(reg1, reg1, 0) - |CODE.opLLOAD64: - reg1 := REG.GetAnyReg(R); - reg2 := REG.GetVarReg(R, param2); + |IL.opLLOAD64: + reg1 := GetAnyReg(); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN mov(reg1, reg2) ELSE movrm(reg1, rbp, param2 * 8) END - |CODE.opLLOAD8, - CODE.opLLOAD16: - reg1 := REG.GetAnyReg(R); - reg2 := REG.GetVarReg(R, param2); + |IL.opLLOAD8, + IL.opLLOAD16: + reg1 := GetAnyReg(); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN mov(reg1, reg2) ELSE - movzx(reg1, rbp, param2 * 8, cmd.opcode = CODE.opLLOAD16) + movzx(reg1, rbp, param2 * 8, opcode = IL.opLLOAD16) END - |CODE.opLLOAD32: - reg1 := REG.GetAnyReg(R); - reg2 := REG.GetVarReg(R, param2); + |IL.opLLOAD32: + reg1 := GetAnyReg(); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN mov(reg1, reg2) ELSE @@ -1211,73 +1219,71 @@ BEGIN movrm32(reg1, rbp, n) END - |CODE.opGLOAD64: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD64: + reg1 := GetAnyReg(); lea(reg1, param2, sBSS); movrm(reg1, reg1, 0) - |CODE.opGLOAD8: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD8: + reg1 := GetAnyReg(); lea(reg1, param2, sBSS); movzx(reg1, reg1, 0, FALSE) - |CODE.opGLOAD16: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD16: + reg1 := GetAnyReg(); lea(reg1, param2, sBSS); movzx(reg1, reg1, 0, TRUE) - |CODE.opGLOAD32: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD32: + reg1 := GetAnyReg(); xor(reg1, reg1); lea(reg1, param2, sBSS); movrm32(reg1, reg1, 0) - |CODE.opVLOAD64: - reg1 := REG.GetAnyReg(R); + |IL.opVLOAD64: + reg1 := GetAnyReg(); movrm(reg1, rbp, param2 * 8); movrm(reg1, reg1, 0) - |CODE.opVLOAD8, - CODE.opVLOAD16: - reg1 := REG.GetAnyReg(R); + |IL.opVLOAD8, + IL.opVLOAD16: + reg1 := GetAnyReg(); movrm(reg1, rbp, param2 * 8); - movzx(reg1, reg1, 0, cmd.opcode = CODE.opVLOAD16) + movzx(reg1, reg1, 0, opcode = IL.opVLOAD16) - |CODE.opVLOAD32: - reg1 := REG.GetAnyReg(R); - reg2 := REG.GetAnyReg(R); + |IL.opVLOAD32: + reg1 := GetAnyReg(); + reg2 := GetAnyReg(); xor(reg1, reg1); movrm(reg2, rbp, param2 * 8); movrm32(reg1, reg2, 0); drop - |CODE.opLADR: + |IL.opLADR: n := param2 * 8; next := cmd.next(COMMAND); - IF next.opcode = CODE.opSAVEF THEN + IF next.opcode = IL.opSAVEF THEN movsdmr(rbp, n, xmm); DEC(xmm); cmd := next - ELSIF next.opcode = CODE.opLOADF THEN + ELSIF next.opcode = IL.opLOADF THEN INC(xmm); movsdrm(xmm, rbp, n); cmd := next ELSE - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Rex(0, reg1); OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n] OutIntByte(n) END - |CODE.opGADR: - reg1 := REG.GetAnyReg(R); - lea(reg1, param2, sBSS) + |IL.opGADR: + lea(GetAnyReg(), param2, sBSS) - |CODE.opVADR: - reg1 := REG.GetAnyReg(R); - movrm(reg1, rbp, param2 * 8) + |IL.opVADR: + movrm(GetAnyReg(), rbp, param2 * 8) - |CODE.opSAVE8C: + |IL.opSAVE8C: UnOp(reg1); IF reg1 >= 8 THEN OutByte(41H) @@ -1285,7 +1291,7 @@ BEGIN OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2 drop - |CODE.opSAVE16C: + |IL.opSAVE16C: UnOp(reg1); OutByte(66H); IF reg1 >= 8 THEN @@ -1295,10 +1301,10 @@ BEGIN OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2 drop - |CODE.opSAVEC: + |IL.opSAVEC: UnOp(reg1); IF isLong(param2) THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrc(reg2, param2); movmr(reg1, 0, reg2); drop @@ -1309,142 +1315,106 @@ BEGIN END; drop - |CODE.opRSET: + |IL.opRSET: PushAll(2); - CallRTL(CODE._set); + CallRTL(IL._set); GetRegA - |CODE.opRSETR: + |IL.opRSETR: PushAll(1); pushc(param2); - CallRTL(CODE._set); + CallRTL(IL._set); GetRegA - |CODE.opRSETL: + |IL.opRSETL: PushAll(1); pushc(param2); - CallRTL(CODE._set2); + CallRTL(IL._set2); GetRegA - |CODE.opRSET1: + |IL.opRSET1: UnOp(reg1); PushAll(1); push(reg1); - CallRTL(CODE._set); + CallRTL(IL._set); GetRegA - |CODE.opINCL, CODE.opEXCL: + |IL.opINCL, IL.opEXCL: BinOp(reg1, reg2); cmprc(reg1, 64); OutByte2(73H, 04H); // jnb L Rex(reg2, reg1); - OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 + OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 // L: drop; drop - |CODE.opINCLC, CODE.opEXCLC: + |IL.opINCLC, IL.opEXCLC: UnOp(reg1); Rex(reg1, 0); OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2 - OutByte2(28H + 8 * ORD(cmd.opcode = CODE.opEXCLC) + reg1 MOD 8, param2); + OutByte2(28H + 8 * ORD(opcode = IL.opEXCLC) + reg1 MOD 8, param2); drop - |CODE.opEQS .. CODE.opGES: + |IL.opEQS .. IL.opGES: PushAll(4); - pushc(cmd.opcode - CODE.opEQS); - CallRTL(CODE._strcmp); + pushc(opcode - IL.opEQS); + CallRTL(IL._strcmp); GetRegA - |CODE.opEQS2 .. CODE.opGES2: + |IL.opEQSW .. IL.opGESW: PushAll(4); - pushc(cmd.opcode - CODE.opEQS2); - CallRTL(CODE._strcmp2); + pushc(opcode - IL.opEQSW); + CallRTL(IL._strcmpw); GetRegA - |CODE.opEQSW .. CODE.opGESW: - PushAll(4); - pushc(cmd.opcode - CODE.opEQSW); - CallRTL(CODE._strcmpw); - GetRegA + |IL.opCONST: + movrc(GetAnyReg(), param2) - |CODE.opEQSW2 .. CODE.opGESW2: - PushAll(4); - pushc(cmd.opcode - CODE.opEQSW2); - CallRTL(CODE._strcmpw2); - GetRegA - - |CODE.opINC1, CODE.opDEC1: - UnOp(reg1); - Rex(reg1, 0); - OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opDEC1)); - drop - - |CODE.opCONST: - reg1 := REG.GetAnyReg(R); - movrc(reg1, param2) - - |CODE.opGT, CODE.opGE, CODE.opLT, - CODE.opLE, CODE.opEQ, CODE.opNE: - BinOp(reg1, reg2); - cmprr(reg1, reg2); - drop; - drop; - cc := X86.cond(cmd.opcode); - - IF cmd.next(COMMAND).opcode = CODE.opJE THEN - label := cmd.next(COMMAND).param1; - jcc(cc, label); - cmd := cmd.next(COMMAND) - - ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN - label := cmd.next(COMMAND).param1; - jcc(X86.inv1(cc), label); - cmd := cmd.next(COMMAND) + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(reg1, reg2); + cmprr(reg1, reg2); + drop ELSE - reg1 := REG.GetAnyReg(R); - setcc(cc + 16, reg1); - andrc(reg1, 1) - END - - |CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, - CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, - CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: - UnOp(reg1); - IF param2 = 0 THEN - test(reg1) - ELSE - cmprc(reg1, param2) + UnOp(reg1); + IF param2 = 0 THEN + test(reg1) + ELSE + cmprc(reg1, param2) + END END; - drop; - cc := X86.cond(cmd.opcode); - IF cmd.next(COMMAND).opcode = CODE.opJE THEN + drop; + cc := X86.cond(opcode); + + IF cmd.next(COMMAND).opcode = IL.opJE THEN label := cmd.next(COMMAND).param1; jcc(cc, label); cmd := cmd.next(COMMAND) - ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN label := cmd.next(COMMAND).param1; - jcc(X86.inv1(cc), label); + jcc(X86.inv0(cc), label); cmd := cmd.next(COMMAND) ELSE - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); setcc(cc + 16, reg1); andrc(reg1, 1) END - |CODE.opCODE: + |IL.opCODE: OutByte(param2) - |CODE.opPUSHIP: - reg1 := REG.GetAnyReg(R); + |IL.opPUSHIP: + reg1 := GetAnyReg(); lea(reg1, param2, sIMP); movrm(reg1, reg1, 0) - |CODE.opPARAM: + |IL.opPARAM: n := param2; IF n = 1 THEN UnOp(reg1); @@ -1453,9 +1423,9 @@ BEGIN ELSE ASSERT(R.top + 1 <= n); PushAll(n) - END - - |CODE.opACC: + END + + |IL.opACC: IF (R.top # 0) OR (R.stk[0] # rax) THEN PushAll(0); GetRegA; @@ -1463,29 +1433,29 @@ BEGIN DEC(R.pushed) END - |CODE.opJNZ: + |IL.opJNZ: UnOp(reg1); test(reg1); jcc(jne, param1) - |CODE.opJZ: + |IL.opJZ: UnOp(reg1); test(reg1); jcc(je, param1) - |CODE.opJE: + |IL.opJE: UnOp(reg1); test(reg1); jcc(jne, param1); drop - |CODE.opJNE: + |IL.opJNE: UnOp(reg1); test(reg1); jcc(je, param1); drop - |CODE.opIN: + |IL.opIN: label := NewLabel(); L := NewLabel(); BinOp(reg1, reg2); @@ -1501,11 +1471,11 @@ BEGIN X86.SetLabel(label); drop - |CODE.opINR: + |IL.opINR: label := NewLabel(); L := NewLabel(); UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); cmprc(reg1, 64); jcc(jb, L); xor(reg1, reg1); @@ -1519,7 +1489,7 @@ BEGIN X86.SetLabel(label); drop - |CODE.opINL: + |IL.opINL: UnOp(reg1); Rex(reg1, 0); OutByte2(0FH, 0BAH); // bt reg1, param2 @@ -1527,237 +1497,233 @@ BEGIN setcc(setc, reg1); andrc(reg1, 1) - |CODE.opNOT: + |IL.opNOT: UnOp(reg1); test(reg1); setcc(sete, reg1); andrc(reg1, 1) - |CODE.opORD: + |IL.opORD: UnOp(reg1); test(reg1); setcc(setne, reg1); andrc(reg1, 1) - |CODE.opABS: + |IL.opABS: UnOp(reg1); test(reg1); OutByte2(7DH, 03H); // jge L neg(reg1) // L: - |CODE.opEQB, CODE.opNEB: + |IL.opEQB, IL.opNEB: BinOp(reg1, reg2); drop; - drop; - test(reg1); - OutByte2(74H, 07H); // je L1 + label := NewLabel(); + jcc(je, label); movrc(reg1, 1); - // L1: + X86.SetLabel(label); test(reg2); - OutByte2(74H, 07H); // je L2 + label := NewLabel(); + jcc(je, label); movrc(reg2, 1); - // L2: + X86.SetLabel(label); cmprr(reg1, reg2); - reg1 := REG.GetAnyReg(R); - IF cmd.opcode = CODE.opEQB THEN + IF opcode = IL.opEQB THEN setcc(sete, reg1) ELSE setcc(setne, reg1) END; andrc(reg1, 1) - |CODE.opMULSC: + |IL.opMULSC: UnOp(reg1); andrc(reg1, param2) - |CODE.opDIVSC, CODE.opADDSL, CODE.opADDSR: + |IL.opDIVSC, IL.opADDSL, IL.opADDSR: UnOp(reg1); Rex(reg1, 0); - OutByte2(81H + short(param2), 0C8H + 28H * ORD(cmd.opcode = CODE.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 + OutByte2(81H + short(param2), 0C8H + 28H * ORD(opcode = IL.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 OutIntByte(param2) - |CODE.opSUBSL: + |IL.opSUBSL: UnOp(reg1); not(reg1); andrc(reg1, param2) - |CODE.opSUBSR: + |IL.opSUBSR: UnOp(reg1); andrc(reg1, ORD(-BITS(param2))) - |CODE.opMULS: + |IL.opMULS: BinOp(reg1, reg2); and(reg1, reg2); drop - |CODE.opDIVS: + |IL.opDIVS: BinOp(reg1, reg2); xor(reg1, reg2); drop - |CODE.opUMINS: + |IL.opUMINS: UnOp(reg1); not(reg1) - |CODE.opCOPY: + |IL.opCOPY: PushAll(2); pushc(param2); - CallRTL(CODE._move2) + CallRTL(IL._move2) - |CODE.opMOVE: + |IL.opMOVE: PushAll(3); - CallRTL(CODE._move2) + CallRTL(IL._move2) - |CODE.opCOPYA: + |IL.opCOPYA: PushAll(4); pushc(param2); - CallRTL(CODE._arrcpy); + CallRTL(IL._arrcpy); GetRegA - |CODE.opCOPYS: + |IL.opCOPYS: PushAll(4); pushc(param2); - CallRTL(CODE._strcpy) + CallRTL(IL._strcpy) - |CODE.opCOPYS2: - PushAll(4); - pushc(param2); - CallRTL(CODE._strcpy2) - - |CODE.opROT: + |IL.opROT: PushAll(0); push(rsp); pushc(param2); - CallRTL(CODE._rot) + CallRTL(IL._rot) - |CODE.opNEW: + |IL.opNEW: PushAll(1); n := param2 + 16; - ASSERT(MACHINE.Align(n, 64)); + ASSERT(UTILS.Align(n, 64)); pushc(n); pushc(param1); - CallRTL(CODE._new) + CallRTL(IL._new) - |CODE.opDISP: + |IL.opDISP: PushAll(1); - CallRTL(CODE._dispose) + CallRTL(IL._dispose) - |CODE.opPUSHT: + |IL.opPUSHT: UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrm(reg2, reg1, -8) - |CODE.opISREC: + |IL.opISREC: PushAll(2); - pushc(param2); - CallRTL(CODE._isrec); + pushc(param2 * tcount); + CallRTL(IL._isrec); GetRegA - |CODE.opIS: + |IL.opIS: PushAll(1); - pushc(param2); - CallRTL(CODE._is); + pushc(param2 * tcount); + CallRTL(IL._is); GetRegA - |CODE.opTYPEGR: + |IL.opTYPEGR: PushAll(1); - pushc(param2); - CallRTL(CODE._guardrec); + pushc(param2 * tcount); + CallRTL(IL._guardrec); GetRegA - |CODE.opTYPEGP: + |IL.opTYPEGP: UnOp(reg1); PushAll(0); push(reg1); - pushc(param2); - CallRTL(CODE._guard); + pushc(param2 * tcount); + CallRTL(IL._guard); GetRegA - |CODE.opTYPEGD: + |IL.opTYPEGD: UnOp(reg1); PushAll(0); pushm(reg1, -8); - pushc(param2); - CallRTL(CODE._guardrec); + pushc(param2 * tcount); + CallRTL(IL._guardrec); GetRegA - |CODE.opCASET: + |IL.opCASET: push(r10); push(r10); - pushc(param2); - CallRTL(CODE._guardrec); + pushc(param2 * tcount); + CallRTL(IL._guardrec); pop(r10); test(rax); jcc(jne, param1) - |CODE.opSAVEP: + |IL.opSAVEP: UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); lea(reg2, param2, sCODE); movmr(reg1, 0, reg2); drop; drop - |CODE.opPUSHP: - reg1 := REG.GetAnyReg(R); - lea(reg1, param2, sCODE) + |IL.opPUSHP: + lea(GetAnyReg(), param2, sCODE) - |CODE.opINC, CODE.opDEC: + |IL.opINC, IL.opDEC: BinOp(reg1, reg2); // add/sub qword[reg2], reg1 Rex(reg2, reg1); - OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); + OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); drop; drop - |CODE.opINCC, CODE.opDECC: + |IL.opINCC: UnOp(reg1); IF isLong(param2) THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrc(reg2, param2); - // add/sub qword[reg1], reg2 + // add qword[reg1], reg2 Rex(reg1, reg2); - OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDECC), reg1 MOD 8 + (reg2 MOD 8) * 8); + OutByte2(01H, reg1 MOD 8 + (reg2 MOD 8) * 8); drop - ELSE - // add/sub qword[reg1], param2 + ELSIF ABS(param2) = 1 THEN Rex(reg1, 0); - OutByte2(81H + short(param2), 28H * ORD(cmd.opcode = CODE.opDECC) + reg1 MOD 8); + OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(param2 = -1)) // inc/dec qword[reg1] + ELSE + // add qword[reg1], param2 + Rex(reg1, 0); + OutByte2(81H + short(param2), reg1 MOD 8); OutIntByte(param2) END; drop - |CODE.opDROP: + |IL.opDROP: UnOp(reg1); drop - |CODE.opSAVE, CODE.opSAVE64: + |IL.opSAVE, IL.opSAVE64: BinOp(reg2, reg1); movmr(reg1, 0, reg2); drop; drop - |CODE.opSAVE8: + |IL.opSAVE8: BinOp(reg2, reg1); movmr8(reg1, 0, reg2); drop; drop - |CODE.opSAVE16: + |IL.opSAVE16: BinOp(reg2, reg1); movmr16(reg1, 0, reg2); drop; drop - |CODE.opSAVE32: + |IL.opSAVE32: BinOp(reg2, reg1); movmr32(reg1, 0, reg2); drop; drop - |CODE.opMIN: + |IL.opMIN: BinOp(reg1, reg2); cmprr(reg1, reg2); OutByte2(7EH, 3); // jle L @@ -1765,7 +1731,7 @@ BEGIN // L: drop - |CODE.opMAX: + |IL.opMAX: BinOp(reg1, reg2); cmprr(reg1, reg2); OutByte2(7DH, 3); // jge L @@ -1773,7 +1739,7 @@ BEGIN // L: drop - |CODE.opMINC: + |IL.opMINC: UnOp(reg1); cmprc(reg1, param2); label := NewLabel(); @@ -1781,7 +1747,7 @@ BEGIN movrc(reg1, param2); X86.SetLabel(label) - |CODE.opMAXC: + |IL.opMAXC: UnOp(reg1); cmprc(reg1, param2); label := NewLabel(); @@ -1789,41 +1755,43 @@ BEGIN movrc(reg1, param2); X86.SetLabel(label) - |CODE.opSBOOL: + |IL.opSBOOL: BinOp(reg2, reg1); test(reg2); - setcc(setne, reg2); - movmr8(reg1, 0, reg2); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte3(0FH, 95H, reg1 MOD 8); // setne byte[reg1] drop; drop - |CODE.opSBOOLC: + |IL.opSBOOLC: UnOp(reg1); IF reg1 >= 8 THEN OutByte(41H) END; - OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); + OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); // mov byte[reg1], 0/1 drop - |CODE.opODD: + |IL.opODD: UnOp(reg1); andrc(reg1, 1) - |CODE.opUMINUS: + |IL.opUMINUS: UnOp(reg1); neg(reg1) - |CODE.opADD: + |IL.opADD: BinOp(reg1, reg2); add(reg1, reg2); drop - |CODE.opSUB: + |IL.opSUB: BinOp(reg1, reg2); sub(reg1, reg2); drop - |CODE.opSUBR, CODE.opSUBL: + |IL.opSUBR, IL.opSUBL: UnOp(reg1); n := param2; IF n = 1 THEN @@ -1833,11 +1801,11 @@ BEGIN ELSIF n # 0 THEN subrc(reg1, n) END; - IF cmd.opcode = CODE.opSUBL THEN + IF opcode = IL.opSUBL THEN neg(reg1) END - |CODE.opADDL, CODE.opADDR: + |IL.opADDL, IL.opADDR: IF param2 # 0 THEN UnOp(reg1); IF param2 = 1 THEN @@ -1849,17 +1817,17 @@ BEGIN END END - |CODE.opDIV: + |IL.opDIV: PushAll(2); - CallRTL(CODE._div); + CallRTL(IL._div); GetRegA - |CODE.opDIVR: + |IL.opDIVR: a := param2; IF a > 1 THEN - n := X86.log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := X86.log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -1874,7 +1842,7 @@ BEGIN UnOp(reg1); IF a < 0 THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); mov(reg2, reg1); shiftrc(sar, reg1, n); sub(reg1, reg2); @@ -1886,28 +1854,28 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(CODE._div); + CallRTL(IL._div); GetRegA END END - |CODE.opDIVL: + |IL.opDIVL: PushAll(1); pushc(param2); - CallRTL(CODE._div2); + CallRTL(IL._div2); GetRegA - |CODE.opMOD: + |IL.opMOD: PushAll(2); - CallRTL(CODE._mod); + CallRTL(IL._mod); GetRegA - |CODE.opMODR: + |IL.opMODR: a := param2; IF a > 1 THEN - n := X86.log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := X86.log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -1931,30 +1899,30 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(CODE._mod); + CallRTL(IL._mod); GetRegA END END - |CODE.opMODL: + |IL.opMODL: PushAll(1); pushc(param2); - CallRTL(CODE._mod2); + CallRTL(IL._mod2); GetRegA - |CODE.opMUL: + |IL.opMUL: BinOp(reg1, reg2); oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2 drop - |CODE.opMULC: + |IL.opMULC: UnOp(reg1); a := param2; IF a > 1 THEN - n := X86.log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := X86.log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -1979,20 +1947,20 @@ BEGIN END END - |CODE.opADDS: + |IL.opADDS: BinOp(reg1, reg2); or(reg1, reg2); drop - |CODE.opSUBS: + |IL.opSUBS: BinOp(reg1, reg2); not(reg2); and(reg1, reg2); drop - |CODE.opNOP: + |IL.opNOP: - |CODE.opSWITCH: + |IL.opSWITCH: UnOp(reg1); IF param2 = 0 THEN reg2 := rax @@ -2006,65 +1974,71 @@ BEGIN END; drop - |CODE.opENDSW: + |IL.opENDSW: - |CODE.opCASEL: + |IL.opCASEL: cmprc(rax, param1); jcc(jl, param2) - |CODE.opCASER: + |IL.opCASER: cmprc(rax, param1); jcc(jg, param2) - |CODE.opCASELR: + |IL.opCASELR: cmprc(rax, param1); jcc(jl, param2); jcc(jg, cmd.param3) - |CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: + |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: BinOp(reg1, reg2); xchg(reg2, rcx); Rex(reg1, 0); OutByte(0D3H); - X86.shift(cmd.opcode, reg1 MOD 8); // shift reg1, cl + X86.shift(opcode, reg1 MOD 8); // shift reg1, cl xchg(reg2, rcx); drop - |CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: - reg1 := REG.GetAnyReg(R); + |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: + reg1 := GetAnyReg(); movrc(reg1, param2); BinOp(reg1, reg2); xchg(reg1, rcx); Rex(reg2, 0); OutByte(0D3H); - X86.shift(cmd.opcode, reg2 MOD 8); // shift reg2, cl + X86.shift(opcode, reg2 MOD 8); // shift reg2, cl xchg(reg1, rcx); drop; drop; ASSERT(REG.GetReg(R, reg2)) - |CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: UnOp(reg1); - shiftrc(cmd.opcode, reg1, ORD(BITS(param2) * {0..5})) + shiftrc(opcode, reg1, param2 MOD 64) - |CODE.opGET: - BinOp(reg1, reg2); + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(reg1, reg2) + ELSIF opcode = IL.opGETC THEN + UnOp(reg2); + reg1 := GetAnyReg(); + movrc(reg1, param1) + END; drop; drop; _movrm(reg1, reg1, 0, param2 * 8, FALSE); _movrm(reg1, reg2, 0, param2 * 8, TRUE) - |CODE.opCHKBYTE: + |IL.opCHKBYTE: BinOp(reg1, reg2); cmprc(reg1, 256); jcc(jb, param1) - |CODE.opCHKIDX: + |IL.opCHKIDX: UnOp(reg1); cmprc(reg1, param2); jcc(jb, param1) - |CODE.opCHKIDX2: + |IL.opCHKIDX2: BinOp(reg1, reg2); IF param2 # -1 THEN cmprr(reg2, reg1); @@ -2077,17 +2051,17 @@ BEGIN R.stk[R.top] := reg2 END - |CODE.opLENGTH: + |IL.opLENGTH: PushAll(2); - CallRTL(CODE._length); + CallRTL(IL._length); GetRegA - |CODE.opLENGTHW: + |IL.opLENGTHW: PushAll(2); - CallRTL(CODE._lengthw); + CallRTL(IL._lengthw); GetRegA - |CODE.opLEN: + |IL.opLEN: n := param2; UnOp(reg1); drop; @@ -2102,23 +2076,23 @@ BEGIN INCL(R.regs, reg1); ASSERT(REG.GetReg(R, reg1)) - |CODE.opCHR: + |IL.opCHR: UnOp(reg1); andrc(reg1, 255) - |CODE.opWCHR: + |IL.opWCHR: UnOp(reg1); andrc(reg1, 65535) - |CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: + |IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP: UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); - CASE cmd.opcode OF - |CODE.opEQP, CODE.opNEP: + CASE opcode OF + |IL.opEQP, IL.opNEP: lea(reg2, param1, sCODE) - |CODE.opEQIP, CODE.opNEIP: + |IL.opEQIP, IL.opNEIP: lea(reg2, param1, sIMP); movrm(reg2, reg2, 0) END; @@ -2126,43 +2100,35 @@ BEGIN cmprr(reg1, reg2); drop; drop; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); - CASE cmd.opcode OF - |CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) - |CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) + CASE opcode OF + |IL.opEQP, IL.opEQIP: setcc(sete, reg1) + |IL.opNEP, IL.opNEIP: setcc(setne, reg1) END; andrc(reg1, 1) - |CODE.opINC1B, CODE.opDEC1B: + |IL.opINCCB, IL.opDECCB: UnOp(reg1); IF reg1 >= 8 THEN OutByte(41H) END; - OutByte2(0FEH, 8 * ORD(cmd.opcode = CODE.opDEC1B) + reg1 MOD 8); // inc/dec byte[reg1] + OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 drop - |CODE.opINCCB, CODE.opDECCB: - UnOp(reg1); - IF reg1 >= 8 THEN - OutByte(41H) - END; - OutByte3(80H, 28H * ORD(cmd.opcode = CODE.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 - drop - - |CODE.opINCB, CODE.opDECB: + |IL.opINCB, IL.opDECB: BinOp(reg1, reg2); IF (reg1 >= 8) OR (reg2 >= 8) THEN OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8)) END; - OutByte2(28H * ORD(cmd.opcode = CODE.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 + OutByte2(28H * ORD(opcode = IL.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 drop; drop - |CODE.opSAVEIP: + |IL.opSAVEIP: UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); lea(reg2, param2, sIMP); movrm(reg2, reg2, 0); push(reg2); @@ -2173,90 +2139,90 @@ BEGIN OutByte2(8FH, reg1 MOD 8); // pop qword[reg1] drop - |CODE.opCLEANUP: + |IL.opCLEANUP: n := param2 * 8; IF n # 0 THEN addrc(rsp, n) END - |CODE.opPOPSP: + |IL.opPOPSP: pop(rsp) - |CODE.opLOADF: + |IL.opLOADF: UnOp(reg1); INC(xmm); movsdrm(xmm, reg1, 0); drop - |CODE.opPUSHF: + |IL.opPUSHF: subrc(rsp, 8); movsdmr(rsp, 0, xmm); DEC(xmm) - |CODE.opCONSTF: + |IL.opCONSTF: float := cmd.float; INC(xmm); - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA); movsdrm(xmm, reg1, 0); drop; NewNumber(UTILS.splitf(float, a, b)) - |CODE.opSAVEF: + |IL.opSAVEF: UnOp(reg1); movsdmr(reg1, 0, xmm); DEC(xmm); drop - |CODE.opADDF, CODE.opADDFI: + |IL.opADDF, IL.opADDFI: opxx(58H, xmm - 1, xmm); DEC(xmm) - |CODE.opSUBF: + |IL.opSUBF: opxx(5CH, xmm - 1, xmm); DEC(xmm) - |CODE.opSUBFI: + |IL.opSUBFI: opxx(5CH, xmm, xmm - 1); opxx(10H, xmm - 1, xmm); DEC(xmm) - |CODE.opMULF: + |IL.opMULF: opxx(59H, xmm - 1, xmm); DEC(xmm) - |CODE.opDIVF: + |IL.opDIVF: opxx(5EH, xmm - 1, xmm); DEC(xmm) - |CODE.opDIVFI: + |IL.opDIVFI: opxx(5EH, xmm, xmm - 1); opxx(10H, xmm - 1, xmm); DEC(xmm) - |CODE.opUMINF: - reg1 := REG.GetAnyReg(R); + |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 - |CODE.opFABS: - reg1 := REG.GetAnyReg(R); + |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 - |CODE.opFLT: + |IL.opFLT: UnOp(reg1); INC(xmm); OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1 OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); drop - |CODE.opFLOOR: - reg1 := REG.GetAnyReg(R); + |IL.opFLOOR: + reg1 := GetAnyReg(); subrc(rsp, 8); OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4]; OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp]; @@ -2269,23 +2235,23 @@ BEGIN addrc(rsp, 8); DEC(xmm) - |CODE.opEQF .. CODE.opGEFI: - fcmp(cmd.opcode, xmm); + |IL.opEQF .. IL.opGEF: + fcmp(opcode, xmm); DEC(xmm, 2) - |CODE.opINF: + |IL.opINF: INC(xmm); - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); lea(reg1, Numbers_Offs + 32, sDATA); movsdrm(xmm, reg1, 0); drop - |CODE.opPACK, CODE.opPACKC: - IF cmd.opcode = CODE.opPACK THEN + |IL.opPACK, IL.opPACKC: + IF opcode = IL.opPACK THEN BinOp(reg1, reg2) ELSE UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrc(reg2, param2) END; push(reg1); @@ -2310,15 +2276,15 @@ BEGIN drop; drop - |CODE.opUNPK, CODE.opLADR_UNPK: + |IL.opUNPK, IL.opLADR_UNPK: - IF cmd.opcode = CODE.opLADR_UNPK THEN + IF opcode = IL.opLADR_UNPK THEN n := param2 * 8; UnOp(reg1); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); regVar := reg2 # -1; IF ~regVar THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); Rex(0, reg2); OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n] OutIntByte(n) @@ -2336,7 +2302,7 @@ BEGIN IF regVar THEN mov(reg2, reg1); - reg2 := REG.GetAnyReg(R) + reg2 := GetAnyReg() ELSE movmr(reg2, 0, reg1) END; @@ -2357,44 +2323,44 @@ BEGIN drop; drop - |CODE.opSADR_PARAM: + |IL.opSADR_PARAM: pushDA(stroffs + param2) - |CODE.opVADR_PARAM: + |IL.opVADR_PARAM: pushm(rbp, param2 * 8) - |CODE.opLOAD64_PARAM: + |IL.opLOAD64_PARAM: UnOp(reg1); pushm(reg1, 0); drop - |CODE.opLLOAD64_PARAM: - reg1 := REG.GetVarReg(R, param2); + |IL.opLLOAD64_PARAM: + reg1 := GetVarReg(param2); IF reg1 # -1 THEN push(reg1) ELSE pushm(rbp, param2 * 8) END - |CODE.opGLOAD64_PARAM: - reg2 := REG.GetAnyReg(R); + |IL.opGLOAD64_PARAM: + reg2 := GetAnyReg(); lea(reg2, param2, sBSS); movrm(reg2, reg2, 0); push(reg2); drop - |CODE.opCONST_PARAM: + |IL.opCONST_PARAM: pushc(param2) - |CODE.opGLOAD32_PARAM: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD32_PARAM: + reg1 := GetAnyReg(); xor(reg1, reg1); lea(reg1, param2, sBSS); movrm32(reg1, reg1, 0); push(reg1); drop - |CODE.opLOAD32_PARAM: + |IL.opLOAD32_PARAM: UnOp(reg1); movrm32(reg1, reg1, 0); shiftrc(shl, reg1, 32); @@ -2402,10 +2368,10 @@ BEGIN push(reg1); drop - |CODE.opLLOAD32_PARAM: - reg1 := REG.GetAnyReg(R); + |IL.opLLOAD32_PARAM: + reg1 := GetAnyReg(); xor(reg1, reg1); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN mov(reg1, reg2) ELSE @@ -2414,14 +2380,14 @@ BEGIN push(reg1); drop - |CODE.opLADR_SAVEC: + |IL.opLADR_SAVEC: n := param1 * 8; - reg1 := REG.GetVarReg(R, param1); + reg1 := GetVarReg(param1); IF reg1 # -1 THEN movrc(reg1, param2) ELSE IF isLong(param2) THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrc(reg2, param2); movmr(rbp, n, reg2); drop @@ -2432,17 +2398,17 @@ BEGIN END END - |CODE.opGADR_SAVEC: + |IL.opGADR_SAVEC: IF isLong(param2) THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); movrc(reg1, param2); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); lea(reg2, param1, sBSS); movmr(reg2, 0, reg1); drop; drop ELSE - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); lea(reg2, param1, sBSS); Rex(reg2, 0); OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2 @@ -2450,9 +2416,9 @@ BEGIN drop END - |CODE.opLADR_SAVE: + |IL.opLADR_SAVE: UnOp(reg1); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN mov(reg2, reg1) ELSE @@ -2460,79 +2426,48 @@ BEGIN END; drop - |CODE.opLADR_INC1: - reg1 := REG.GetVarReg(R, param2); - IF reg1 # -1 THEN - incr(reg1) - ELSE - n := param2 * 8; - OutByte3(48H, 0FFH, 45H + long(n)); // inc qword[rbp+n] - OutIntByte(n) - END - - |CODE.opLADR_DEC1: - reg1 := REG.GetVarReg(R, param2); - IF reg1 # -1 THEN - decr(reg1) - ELSE - n := param2 * 8; - OutByte3(48H, 0FFH, 4DH + long(n)); // dec qword[rbp+n] - OutIntByte(n) - END - - |CODE.opLADR_INCC, CODE.opLADR_DECC: - reg1 := REG.GetVarReg(R, param1); + |IL.opLADR_INCC: + reg1 := GetVarReg(param1); IF isLong(param2) THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); movrc(reg2, param2); IF reg1 # -1 THEN - IF cmd.opcode = CODE.opLADR_DECC THEN - sub(reg1, reg2) - ELSE - add(reg1, reg2) - END + add(reg1, reg2) ELSE n := param1 * 8; Rex(0, reg2); - OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DECC), 45H + long(n) + (reg2 MOD 8) * 8); - OutIntByte(n) // add/sub qword[rbp+n],reg2 + OutByte2(01H, 45H + long(n) + (reg2 MOD 8) * 8); + OutIntByte(n) // add qword[rbp+n],reg2 END; drop - ELSE + ELSIF ABS(param2) = 1 THEN IF reg1 # -1 THEN - IF cmd.opcode = CODE.opLADR_DECC THEN - subrc(reg1, param2) + IF param2 = 1 THEN + incr(reg1) ELSE - addrc(reg1, param2) + decr(reg1) END ELSE n := param1 * 8; - OutByte3(48H, 81H + short(param2), 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECC)); + OutByte3(48H, 0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec qword[rbp+n] + OutIntByte(n) + END + ELSE + IF reg1 # -1 THEN + addrc(reg1, param2) + ELSE + n := param1 * 8; + OutByte3(48H, 81H + short(param2), 45H + long(n)); OutIntByte(n); - OutIntByte(param2) // add/sub qword[rbp+n],param2 + OutIntByte(param2) // add qword[rbp+n],param2 END END - |CODE.opLADR_INC1B, CODE.opLADR_DEC1B: - reg1 := REG.GetVarReg(R, param2); - IF reg1 # -1 THEN - IF cmd.opcode = CODE.opLADR_DEC1B THEN - decr(reg1) - ELSE - incr(reg1) - END; - andrc(reg1, 255) - ELSE - n := param2 * 8; - OutByte2(0FEH, 45H + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_DEC1B)); - OutIntByte(n) // inc/dec byte[rbp+n] - END - - |CODE.opLADR_INCCB, CODE.opLADR_DECCB: - reg1 := REG.GetVarReg(R, param1); + |IL.opLADR_INCCB, IL.opLADR_DECCB: + reg1 := GetVarReg(param1); param2 := param2 MOD 256; IF reg1 # -1 THEN - IF cmd.opcode = CODE.opLADR_DECCB THEN + IF opcode = IL.opLADR_DECCB THEN subrc(reg1, param2) ELSE addrc(reg1, param2) @@ -2540,16 +2475,16 @@ BEGIN andrc(reg1, 255) ELSE n := param1 * 8; - OutByte2(80H, 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECCB)); + OutByte2(80H, 45H + long(n) + 28H * ORD(opcode = IL.opLADR_DECCB)); OutIntByte(n); OutByte(param2) // add/sub byte[rbp+n],param2 END - |CODE.opLADR_INC, CODE.opLADR_DEC: + |IL.opLADR_INC, IL.opLADR_DEC: UnOp(reg1); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN - IF cmd.opcode = CODE.opLADR_DEC THEN + IF opcode = IL.opLADR_DEC THEN sub(reg2, reg1) ELSE add(reg2, reg1) @@ -2557,16 +2492,16 @@ BEGIN ELSE n := param2 * 8; Rex(0, reg1); - OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); + OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); OutIntByte(n) // add/sub qword[rbp+n],reg1 END; drop - |CODE.opLADR_INCB, CODE.opLADR_DECB: + |IL.opLADR_INCB, IL.opLADR_DECB: UnOp(reg1); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN - IF cmd.opcode = CODE.opLADR_DECB THEN + IF opcode = IL.opLADR_DECB THEN sub(reg2, reg1) ELSE add(reg2, reg1) @@ -2577,43 +2512,43 @@ BEGIN IF reg1 >= 8 THEN OutByte(44H) END; - OutByte2(28H * ORD(cmd.opcode = CODE.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); + OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); OutIntByte(n) // add/sub byte[rbp+n], reg1_8 END; drop - |CODE.opLADR_INCL, CODE.opLADR_EXCL: + |IL.opLADR_INCL, IL.opLADR_EXCL: UnOp(reg1); cmprc(reg1, 64); - reg2 := REG.GetVarReg(R, param2); + reg2 := GetVarReg(param2); IF reg2 # -1 THEN OutByte2(73H, 4); // jnb L - oprr2(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 + oprr2(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 ELSE n := param2 * 8; OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L Rex(0, reg1); - OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); + OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); OutIntByte(n) // bts/btr qword[rbp+n], reg1 END; // L: drop - |CODE.opLADR_INCLC, CODE.opLADR_EXCLC: - reg1 := REG.GetVarReg(R, param1); + |IL.opLADR_INCLC, IL.opLADR_EXCLC: + reg1 := GetVarReg(param1); IF reg1 # -1 THEN Rex(reg1, 0); OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2 - OutByte2(reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC), param2) + OutByte2(reg1 MOD 8 + 8 * ORD(opcode = IL.opLADR_EXCLC), param2) ELSE n := param1 * 8; OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2 - OutByte(6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); + OutByte(6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); OutIntByte(n); OutByte(param2) END - |CODE.opLOOP, CODE.opENDLOOP: + |IL.opLOOP, IL.opENDLOOP: END; @@ -2626,14 +2561,14 @@ BEGIN END translate; -PROCEDURE prolog (code: CODE.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); +PROCEDURE prolog (code: IL.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); VAR - ModName_Offs, entry: INTEGER; + ModName_Offs, entry, L: INTEGER; BEGIN - ModName_Offs := CHL.Length(code.types) * 8 + CHL.Length(code.data); + ModName_Offs := tcount * 8 + CHL.Length(code.data); Numbers_Offs := ModName_Offs + LENGTH(modname) + 1; - ASSERT(MACHINE.Align(Numbers_Offs, 16)); + ASSERT(UTILS.Align(Numbers_Offs, 16)); entry := NewLabel(); X86.SetLabel(entry); @@ -2643,44 +2578,64 @@ BEGIN push(r8); push(rdx); push(rcx); - CallRTL(CODE._dllentry); + CallRTL(IL._dllentry); test(rax); jcc(je, dllret) END; - push(rsp); + IF target = mConst.Target_iELF64 THEN + push(rsp) + ELSE + pushc(0) + END; + lea(rax, entry, sCODE); push(rax); pushDA(0); //TYPES - pushc(CHL.Length(code.types)); + pushc(tcount); pushDA(ModName_Offs); //MODNAME - CallRTL(CODE._init) + CallRTL(IL._init); + + IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64} THEN + L := NewLabel(); + pushc(0); + push(rsp); + pushc(1024 * 1024 * stack_size); + pushc(0); + CallRTL(IL._new); + pop(rax); + test(rax); + jcc(je, L); + addrc(rax, 1024 * 1024 * stack_size - 8); + mov(rsp, rax); + X86.SetLabel(L) + END END prolog; -PROCEDURE epilog (code: CODE.CODES; modname: ARRAY OF CHAR; target: INTEGER); +PROCEDURE epilog (code: IL.CODES; modname: ARRAY OF CHAR; target: INTEGER); VAR i, n: INTEGER; number: Number; - exp: CODE.EXPORT_PROC; + exp: IL.EXPORT_PROC; PROCEDURE import (imp: LISTS.LIST); VAR - lib: CODE.IMPORT_LIB; - proc: CODE.IMPORT_PROC; + lib: IL.IMPORT_LIB; + proc: IL.IMPORT_PROC; BEGIN - lib := imp.first(CODE.IMPORT_LIB); + lib := imp.first(IL.IMPORT_LIB); WHILE lib # NIL DO BIN.Import(prog, lib.name, 0); - proc := lib.procs.first(CODE.IMPORT_PROC); + proc := lib.procs.first(IL.IMPORT_PROC); WHILE proc # NIL DO BIN.Import(prog, proc.name, proc.label); - proc := proc.next(CODE.IMPORT_PROC) + proc := proc.next(IL.IMPORT_PROC) END; - lib := lib.next(CODE.IMPORT_LIB) + lib := lib.next(IL.IMPORT_LIB) END END import; @@ -2690,15 +2645,21 @@ BEGIN IF target = mConst.Target_iDLL64 THEN X86.SetLabel(dllret); OutByte(0C3H) // ret + ELSIF target = mConst.Target_iELFSO64 THEN + sofinit := NewLabel(); + OutByte(0C3H); // ret + X86.SetLabel(sofinit); + CallRTL(IL._sofinit); + OutByte(0C3H) // ret ELSE pushc(0); - CallRTL(CODE._exit) + CallRTL(IL._exit) END; X86.fixup; i := 0; - WHILE i < CHL.Length(code.types) DO + WHILE i < tcount DO BIN.PutData64LE(prog, CHL.GetInt(code.types, i)); INC(i) END; @@ -2712,7 +2673,7 @@ BEGIN BIN.PutDataStr(prog, modname); BIN.PutData(prog, 0); n := CHL.Length(prog.data); - ASSERT(MACHINE.Align(n, 16)); + ASSERT(UTILS.Align(n, 16)); i := n - CHL.Length(prog.data); WHILE i > 0 DO BIN.PutData(prog, 0); @@ -2724,10 +2685,10 @@ BEGIN number := number.next(Number) END; - exp := code.export.first(CODE.EXPORT_PROC); + exp := code.export.first(IL.EXPORT_PROC); WHILE exp # NIL DO BIN.Export(prog, exp.name, exp.label); - exp := exp.next(CODE.EXPORT_PROC) + exp := exp.next(IL.EXPORT_PROC) END; import(code.import) @@ -2758,12 +2719,13 @@ BEGIN END rsave; -PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base: INTEGER); +PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); VAR path, modname, ext: PATHS.PATH; - n: INTEGER; BEGIN + tcount := CHL.Length(code.types); + Win64RegPar[0] := rcx; Win64RegPar[1] := rdx; Win64RegPar[2] := r8; @@ -2779,13 +2741,9 @@ BEGIN PATHS.split(outname, path, modname, ext); S.append(modname, ext); - R := REG.Create(push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); + REG.Init(R, push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); - n := code.dmin - CHL.Length(code.data); - IF n > 0 THEN - INC(code.bss, n) - END; - code.bss := MAX(code.bss, 8); + code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 8)); Numbers := LISTS.create(NIL); Numbers_Count := 0; @@ -2798,19 +2756,19 @@ BEGIN NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *) prog := BIN.create(code.lcount); - BIN.SetParams(prog, code.bss, stack, WCHR(1), WCHR(0)); + BIN.SetParams(prog, code.bss, 1, WCHR(1), WCHR(0)); X86.SetProgram(prog); - prolog(code, modname, target, stack); - translate(code.commands, CHL.Length(code.types) * 8); + prolog(code, modname, target, options.stack); + translate(code.commands, tcount * 8); epilog(code, modname, target); BIN.fixup(prog); IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN - PE32.write(prog, outname, base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) - ELSIF target = mConst.Target_iELF64 THEN - ELF.write(prog, outname, TRUE) + PE32.write(prog, outname, options.base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) + ELSIF target IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN + ELF.write(prog, outname, sofinit, target = mConst.Target_iELFSO64, TRUE) END END CodeGen; diff --git a/programs/develop/oberon07/Source/ARITH.ob07 b/programs/develop/oberon07/Source/ARITH.ob07 index 3ee0ab9a6e..7a5734ab46 100644 --- a/programs/develop/oberon07/Source/ARITH.ob07 +++ b/programs/develop/oberon07/Source/ARITH.ob07 @@ -7,7 +7,7 @@ MODULE ARITH; -IMPORT AVLTREES, STRINGS, MACHINE, UTILS; +IMPORT AVLTREES, STRINGS, UTILS; CONST @@ -53,10 +53,7 @@ BEGIN ELSIF v.typ = tWCHAR THEN res := v.int ELSIF v.typ = tSET THEN - res := ORD(v.set); - IF MACHINE._64to32 THEN - res := MACHINE.Int32To64(res) - END + res := UTILS.Long(ORD(v.set)) ELSIF v.typ = tBOOLEAN THEN res := ORD(v.bool) END @@ -88,13 +85,13 @@ VAR BEGIN error := FALSE; - IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN + IF (v.typ = tINTEGER) & ((v.int < UTILS.target.minInt) OR (v.int > UTILS.target.maxInt)) THEN error := TRUE ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN error := TRUE ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN error := TRUE - ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN + ELSIF (v.typ = tREAL) & ((v.float < -UTILS.target.maxReal) OR (v.float > UTILS.target.maxReal)) THEN error := TRUE END @@ -172,7 +169,7 @@ BEGIN n := i END; - IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN + IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN error := 2 ELSE value := value * 16 + d; @@ -181,9 +178,7 @@ BEGIN END; - IF MACHINE._64to32 THEN - value := MACHINE.Int32To64(value); - END; + value := UTILS.Long(value); IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN error := 3 @@ -471,58 +466,53 @@ END mulInt; PROCEDURE _ASR (x, n: INTEGER): INTEGER; -BEGIN - IF MACHINE._64to32 THEN - x := MACHINE.Int32To64(x) - END - - RETURN ASR(x, n) + RETURN ASR(UTILS.Long(x), n) END _ASR; PROCEDURE _LSR (x, n: INTEGER): INTEGER; -BEGIN - IF MACHINE._64to32 THEN - x := MACHINE.Int64To32(x); - x := LSR(x, n); - x := MACHINE.Int32To64(x) - ELSE - x := LSR(x, n) - END - - RETURN x + RETURN UTILS.Long(LSR(UTILS.Short(x), n)) END _LSR; PROCEDURE _LSL (x, n: INTEGER): INTEGER; -BEGIN - x := LSL(x, n); - IF MACHINE._64to32 THEN - x := MACHINE.Int32To64(x) - END - - RETURN x + RETURN UTILS.Long(LSL(x, n)) END _LSL; PROCEDURE _ROR1_32 (x: INTEGER): INTEGER; BEGIN - x := MACHINE.Int64To32(x); + x := UTILS.Short(x); x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31))) - RETURN MACHINE.Int32To64(x) + RETURN UTILS.Long(x) END _ROR1_32; +PROCEDURE _ROR1_16 (x: INTEGER): INTEGER; +BEGIN + x := x MOD 65536; + x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15))) + RETURN UTILS.Long(x) +END _ROR1_16; + + PROCEDURE _ROR (x, n: INTEGER): INTEGER; BEGIN - IF MACHINE._64to32 THEN + + CASE UTILS.bit_diff OF + |0: x := ROR(x, n) + |16, 48: + n := n MOD 16; + WHILE n > 0 DO + x := _ROR1_16(x); + DEC(n) + END + |32: n := n MOD 32; WHILE n > 0 DO x := _ROR1_32(x); DEC(n) END - ELSE - x := ROR(x, n) END RETURN x @@ -587,11 +577,7 @@ BEGIN CASE v.typ OF |tCHAR, tWCHAR: |tBOOLEAN: v.int := ORD(v.bool) - |tSET: - v.int := ORD(v.set); - IF MACHINE._64to32 THEN - v.int := MACHINE.Int32To64(v.int) - END + |tSET: v.int := UTILS.Long(ORD(v.set)) END; v.typ := tINTEGER END ord; @@ -616,7 +602,7 @@ VAR res: BOOLEAN; BEGIN - res := FALSE; + res := FALSE; CASE v.typ OF |tREAL: @@ -627,8 +613,8 @@ BEGIN v.int := ABS(v.int); res := TRUE END - END - + END + RETURN res END abs; @@ -787,7 +773,7 @@ BEGIN |"I": IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN - IF range(v, 0, MACHINE.target.maxSet) THEN + IF range(v, 0, UTILS.target.maxSet) THEN res := v.int IN v2.set ELSE error := 2 diff --git a/programs/develop/oberon07/Source/AVLTREES.ob07 b/programs/develop/oberon07/Source/AVLTREES.ob07 index 2fe539173a..84053be03e 100644 --- a/programs/develop/oberon07/Source/AVLTREES.ob07 +++ b/programs/develop/oberon07/Source/AVLTREES.ob07 @@ -1,11 +1,11 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) -MODULE AVLTREES; +MODULE AVLTREES; IMPORT C := COLLECTIONS; @@ -39,7 +39,7 @@ VAR node: NODE; citem: C.ITEM; -BEGIN +BEGIN citem := C.pop(nodes); IF citem = NIL THEN NEW(node) @@ -181,8 +181,8 @@ BEGIN IF destructor # NIL THEN destructor(node.data) - END; - + END; + C.push(nodes, node); node := NIL; diff --git a/programs/develop/oberon07/Source/BIN.ob07 b/programs/develop/oberon07/Source/BIN.ob07 index faba2e6fc2..a3f7db6433 100644 --- a/programs/develop/oberon07/Source/BIN.ob07 +++ b/programs/develop/oberon07/Source/BIN.ob07 @@ -7,7 +7,7 @@ MODULE BIN; -IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS; +IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS; CONST @@ -138,7 +138,10 @@ BEGIN END; IF UTILS.bit_depth = 64 THEN - x := MACHINE.Int32To64(x) + x := LSL(x, 16); + x := LSL(x, 16); + x := ASR(x, 16); + x := ASR(x, 16) END RETURN x @@ -151,7 +154,7 @@ VAR BEGIN FOR i := 0 TO 3 DO - CHL.SetByte(array, idx + i, MACHINE.Byte(x, i)) + CHL.SetByte(array, idx + i, UTILS.Byte(x, i)) END END put32le; @@ -162,7 +165,7 @@ VAR BEGIN FOR i := 0 TO 3 DO - CHL.PushByte(program.data, MACHINE.Byte(x, i)) + CHL.PushByte(program.data, UTILS.Byte(x, i)) END END PutData32LE; @@ -173,7 +176,7 @@ VAR BEGIN FOR i := 0 TO 7 DO - CHL.PushByte(program.data, MACHINE.Byte(x, i)) + CHL.PushByte(program.data, UTILS.Byte(x, i)) END END PutData64LE; @@ -203,7 +206,7 @@ VAR BEGIN FOR i := 0 TO 3 DO - CHL.PushByte(program.code, MACHINE.Byte(x, i)) + CHL.PushByte(program.code, UTILS.Byte(x, i)) END END PutCode32LE; @@ -217,7 +220,6 @@ END SetLabel; PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); VAR imp: IMPRT; - i: INTEGER; BEGIN CHL.PushByte(program.import, 0); @@ -228,16 +230,9 @@ BEGIN END; NEW(imp); - imp.nameoffs := CHL.Length(program.import); + imp.nameoffs := CHL.PushStr(program.import, name); imp.label := label; - LISTS.push(program.imp_list, imp); - - i := 0; - WHILE name[i] # 0X DO - CHL.PushByte(program.import, ORD(name[i])); - INC(i) - END; - CHL.PushByte(program.import, 0) + LISTS.push(program.imp_list, imp) END Import; @@ -262,19 +257,11 @@ END less; PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); VAR exp, cur: EXPRT; - i: INTEGER; BEGIN NEW(exp); - exp.nameoffs := CHL.Length(program.export); exp.label := CHL.GetInt(program.labels, label); - - i := 0; - WHILE name[i] # 0X DO - CHL.PushByte(program.export, ORD(name[i])); - INC(i) - END; - CHL.PushByte(program.export, 0); + exp.nameoffs := CHL.PushStr(program.export, name); cur := program.exp_list.first(EXPRT); WHILE (cur # NIL) & less(program.export, cur, exp) DO @@ -389,7 +376,7 @@ BEGIN array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) END; - idx := idx + k + INC(idx, k) END InitArray; diff --git a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 index 015fe6f1bb..b604c2d6cc 100644 --- a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 +++ b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -118,11 +118,46 @@ BEGIN END PushByte; +PROCEDURE PushStr* (list: BYTELIST; str: ARRAY OF CHAR): INTEGER; +VAR + i, res: INTEGER; + +BEGIN + res := list.length; + i := 0; + REPEAT + PushByte(list, ORD(str[i])); + INC(i) + UNTIL str[i - 1] = 0X + + RETURN res +END PushStr; + + +PROCEDURE GetStr* (list: BYTELIST; pos: INTEGER; VAR str: ARRAY OF CHAR): BOOLEAN; +VAR + i: INTEGER; + res: BOOLEAN; + +BEGIN + res := FALSE; + i := 0; + WHILE (pos < list.length) & (i < LEN(str)) & ~res DO + str[i] := CHR(GetByte(list, pos)); + res := str[i] = 0X; + INC(pos); + INC(i) + END + + RETURN res +END GetStr; + + PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST); VAR chunk: BYTECHUNK; -BEGIN +BEGIN chunk := list.first(BYTECHUNK); WHILE chunk # NIL DO WR.Write(file, chunk.data, chunk.count); diff --git a/programs/develop/oberon07/Source/COLLECTIONS.ob07 b/programs/develop/oberon07/Source/COLLECTIONS.ob07 index 3e4175af1d..311d6dfac3 100644 --- a/programs/develop/oberon07/Source/COLLECTIONS.ob07 +++ b/programs/develop/oberon07/Source/COLLECTIONS.ob07 @@ -1,12 +1,12 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) MODULE COLLECTIONS; - + TYPE diff --git a/programs/develop/oberon07/Source/CONSOLE.ob07 b/programs/develop/oberon07/Source/CONSOLE.ob07 index e5c293a429..7b4072faa9 100644 --- a/programs/develop/oberon07/Source/CONSOLE.ob07 +++ b/programs/develop/oberon07/Source/CONSOLE.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -23,29 +23,39 @@ BEGIN END String; -PROCEDURE Int* (n: INTEGER); +PROCEDURE Int* (x: INTEGER); VAR - s: ARRAY 32 OF CHAR; + s: ARRAY 24 OF CHAR; BEGIN - STRINGS.IntToStr(n, s); + STRINGS.IntToStr(x, s); String(s) END Int; -PROCEDURE Int2* (n: INTEGER); +PROCEDURE Hex* (x, n: INTEGER); +VAR + s: ARRAY 24 OF CHAR; + BEGIN - IF n < 10 THEN + STRINGS.IntToHex(x, s, n); + String(s) +END Hex; + + +PROCEDURE Int2* (x: INTEGER); +BEGIN + IF x < 10 THEN String("0") END; - Int(n) + Int(x) END Int2; PROCEDURE Ln*; BEGIN String(UTILS.eol) -END Ln; +END Ln; PROCEDURE StringLn* (s: ARRAY OF CHAR); @@ -55,16 +65,16 @@ BEGIN END StringLn; -PROCEDURE IntLn* (n: INTEGER); -BEGIN - Int(n); +PROCEDURE IntLn* (x: INTEGER); +BEGIN + Int(x); Ln END IntLn; -PROCEDURE Int2Ln* (n: INTEGER); -BEGIN - Int2(n); +PROCEDURE Int2Ln* (x: INTEGER); +BEGIN + Int2(x); Ln END Int2Ln; diff --git a/programs/develop/oberon07/Source/CONSTANTS.ob07 b/programs/develop/oberon07/Source/CONSTANTS.ob07 index db218cada1..a3b2b2de2b 100644 --- a/programs/develop/oberon07/Source/CONSTANTS.ob07 +++ b/programs/develop/oberon07/Source/CONSTANTS.ob07 @@ -9,8 +9,8 @@ MODULE CONSTANTS; CONST - vMajor* = 0; - vMinor* = 98; + vMajor* = 1; + vMinor* = 0; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL"; @@ -26,7 +26,10 @@ CONST Target_iGUI64* = 7; Target_iDLL64* = 8; Target_iELF32* = 9; - Target_iELF64* = 10; + Target_iELFSO32* = 10; + Target_iELF64* = 11; + Target_iELFSO64* = 12; + Target_iMSP430* = 13; Target_sConsole* = "console"; Target_sGUI* = "gui"; @@ -37,7 +40,10 @@ CONST Target_sGUI64* = "gui64"; Target_sDLL64* = "dll64"; Target_sELF32* = "elfexe"; + Target_sELFSO32* = "elfso"; Target_sELF64* = "elfexe64"; + Target_sELFSO64* = "elfso64"; + Target_sMSP430* = "msp430"; END CONSTANTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/Compiler.ob07 b/programs/develop/oberon07/Source/Compiler.ob07 index d53c866736..0156182889 100644 --- a/programs/develop/oberon07/Source/Compiler.ob07 +++ b/programs/develop/oberon07/Source/Compiler.ob07 @@ -7,7 +7,7 @@ MODULE Compiler; -IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER; +IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER, MSP430; PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; @@ -33,8 +33,14 @@ BEGIN res := mConst.Target_iDLL64 ELSIF s = mConst.Target_sELF32 THEN res := mConst.Target_iELF32 + ELSIF s = mConst.Target_sELFSO32 THEN + res := mConst.Target_iELFSO32 ELSIF s = mConst.Target_sELF64 THEN res := mConst.Target_iELF64 + ELSIF s = mConst.Target_sELFSO64 THEN + res := mConst.Target_iELFSO64 + ELSIF s = mConst.Target_sMSP430 THEN + res := mConst.Target_iMSP430 ELSE res := 0 END @@ -43,7 +49,7 @@ BEGIN END Target; -PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET); +PROCEDURE keys (VAR options: PROG.OPTIONS); VAR param: PARS.PATH; i, j: INTEGER; @@ -51,8 +57,10 @@ VAR value: INTEGER; minor, major: INTEGER; + checking: SET; BEGIN + checking := options.checking; end := FALSE; i := 4; REPEAT @@ -62,7 +70,7 @@ BEGIN INC(i); UTILS.GetArg(i, param); IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN - StackSize := value + options.stack := value END; IF param[0] = "-" THEN DEC(i) @@ -72,7 +80,27 @@ BEGIN INC(i); UTILS.GetArg(i, param); IF STRINGS.StrToInt(param, value) THEN - BaseAddress := ((value DIV 64) * 64) * 1024 + options.base := ((value DIV 64) * 64) * 1024 + END; + IF param[0] = "-" THEN + DEC(i) + END + + ELSIF param = "-ram" THEN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToInt(param, value) THEN + options.ram := value + END; + IF param[0] = "-" THEN + DEC(i) + END + + ELSIF param = "-rom" THEN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToInt(param, value) THEN + options.rom := value END; IF param[0] = "-" THEN DEC(i) @@ -109,32 +137,34 @@ BEGIN END; INC(j) - END + END; + END ELSIF param = "-ver" THEN INC(i); UTILS.GetArg(i, param); IF STRINGS.StrToVer(param, major, minor) THEN - Version := major * 65536 + minor + options.version := major * 65536 + minor END; IF param[0] = "-" THEN DEC(i) END ELSIF param = "-pic" THEN - pic := TRUE + options.pic := TRUE ELSIF param = "" THEN end := TRUE ELSE - ERRORS.error3("bad parameter: ", param, "") + ERRORS.BadParam(param) END; INC(i) - UNTIL end + UNTIL end; + options.checking := checking END keys; @@ -149,38 +179,34 @@ VAR outname: PARS.PATH; param: PARS.PATH; temp: PARS.PATH; - target: INTEGER; - + bit_depth: INTEGER; time: INTEGER; - - StackSize, - Version, - BaseAdr: INTEGER; - pic: BOOLEAN; - checking: SET; - - bits64: BOOLEAN; + options: PROG.OPTIONS; BEGIN - StackSize := 2; - Version := 65536; - pic := FALSE; - checking := ST.chkALL; + options.stack := 2; + options.version := 65536; + options.pic := FALSE; + options.checking := ST.chkALL; PATHS.GetCurrentDirectory(app_path); lib_path := app_path; UTILS.GetArg(1, inname); + C.Ln; + C.String("Akron Oberon Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); + C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); + C.StringLn("Copyright (c) 2018-2019, Anton Krotov"); + IF inname = "" THEN - C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); - C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln; + C.Ln; C.StringLn("Usage: Compiler
[optional settings]"); C.Ln; IF UTILS.bit_depth = 64 THEN - C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln; + C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfso | elfexe64 | elfso64 | msp430'); C.Ln; ELSIF UTILS.bit_depth = 32 THEN - C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln; + C.StringLn('target = console | gui | dll | kos | obj | elfexe | elfso | msp430'); C.Ln; END; C.StringLn("optional settings:"); C.Ln; C.StringLn(" -stk set size of stack in megabytes"); C.Ln; @@ -188,14 +214,17 @@ BEGIN C.StringLn(' -ver set version of program'); C.Ln; C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; + C.StringLn(" -ram set size of RAM in bytes (MSP430)"); C.Ln; + C.StringLn(" -rom set size of ROM in bytes (MSP430)"); C.Ln; UTILS.Exit(0) END; PATHS.split(inname, path, modname, ext); IF ext # mConst.FILE_EXT THEN - ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"') + ERRORS.Error(207) END; + IF PATHS.isRelative(path) THEN PATHS.RelPath(app_path, path, temp); path := temp @@ -203,7 +232,7 @@ BEGIN UTILS.GetArg(2, outname); IF outname = "" THEN - ERRORS.error1("not enough parameters") + ERRORS.Error(205) END; IF PATHS.isRelative(outname) THEN PATHS.RelPath(app_path, outname, temp); @@ -212,59 +241,70 @@ BEGIN UTILS.GetArg(3, param); IF param = "" THEN - ERRORS.error1("not enough parameters") + ERRORS.Error(205) END; target := Target(param); IF target = 0 THEN - ERRORS.error1("bad parameter ") + ERRORS.Error(206) END; - bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; - - IF bits64 THEN - IF UTILS.bit_depth = 32 THEN - ERRORS.error1("bad parameter ") - END; - PARS.init(64, target) - ELSE - PARS.init(32, target) + CASE target OF + |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: + bit_depth := 64 + |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, + mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, mConst.Target_iELFSO32: + bit_depth := 32 + |mConst.Target_iMSP430: + bit_depth := 16; + options.ram := MSP430.minRAM; + options.rom := MSP430.minROM END; - PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64}; - PARS.program.obj := target = mConst.Target_iObject; + IF UTILS.bit_depth < bit_depth THEN + ERRORS.Error(206) + END; STRINGS.append(lib_path, "lib"); STRINGS.append(lib_path, UTILS.slash); - IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN + CASE target OF + |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL: IF target = mConst.Target_iDLL THEN - BaseAdr := 10000000H + options.base := 10000000H ELSE - BaseAdr := 400000H + options.base := 400000H END; STRINGS.append(lib_path, "Windows32") - ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN + |mConst.Target_iKolibri, mConst.Target_iObject: STRINGS.append(lib_path, "KolibriOS") - ELSIF target = mConst.Target_iELF32 THEN + |mConst.Target_iELF32, mConst.Target_iELFSO32: STRINGS.append(lib_path, "Linux32") - ELSIF target = mConst.Target_iELF64 THEN + |mConst.Target_iELF64, mConst.Target_iELFSO64: STRINGS.append(lib_path, "Linux64") - ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN + |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64: STRINGS.append(lib_path, "Windows64") + |mConst.Target_iMSP430: + STRINGS.append(lib_path, "MSP430") + END; STRINGS.append(lib_path, UTILS.slash); - keys(StackSize, BaseAdr, Version, pic, checking); + keys(options); - ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking); + PARS.init(bit_depth, target, options); + + PARS.program.dll := target IN {mConst.Target_iELFSO32, mConst.Target_iELFSO64, mConst.Target_iDLL, mConst.Target_iDLL64, mConst.Target_iObject}; + PARS.program.obj := target = mConst.Target_iObject; + + ST.compile(path, lib_path, modname, outname, target, options); time := UTILS.GetTickCount() - UTILS.time; diff --git a/programs/develop/oberon07/Source/ELF.ob07 b/programs/develop/oberon07/Source/ELF.ob07 index 749ee5632a..2c74d467f0 100644 --- a/programs/develop/oberon07/Source/ELF.ob07 +++ b/programs/develop/oberon07/Source/ELF.ob07 @@ -7,7 +7,7 @@ MODULE ELF; -IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS; +IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS, LISTS; CONST @@ -68,9 +68,35 @@ TYPE END; + + Elf32_Dyn = POINTER TO RECORD (LISTS.ITEM) + + d_tag, d_val: INTEGER + + END; + + + Elf32_Sym = POINTER TO RECORD (LISTS.ITEM) + + name, value, size: INTEGER; + info, other: CHAR; + shndx: WCHAR + + END; + + FILE = WR.FILE; +VAR + + dynamic: LISTS.LIST; + strtab: CHL.BYTELIST; + symtab: LISTS.LIST; + + hashtab, bucket, chain: CHL.INTLIST; + + PROCEDURE align (n, _align: INTEGER): INTEGER; BEGIN IF n MOD _align # 0 THEN @@ -136,7 +162,75 @@ BEGIN END fixup; -PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN); +PROCEDURE NewDyn (tag, val: INTEGER); +VAR + dyn: Elf32_Dyn; + +BEGIN + NEW(dyn); + dyn.d_tag := tag; + dyn.d_val := val; + LISTS.push(dynamic, dyn) +END NewDyn; + + +PROCEDURE NewSym (name, value, size: INTEGER; info, other: CHAR; shndx: WCHAR); +VAR + sym: Elf32_Sym; + +BEGIN + NEW(sym); + sym.name := name; + sym.value := value; + sym.size := size; + sym.info := info; + sym.other := other; + sym.shndx := shndx; + + LISTS.push(symtab, sym) +END NewSym; + + +PROCEDURE HashStr (name: ARRAY OF CHAR): INTEGER; +VAR + i, h: INTEGER; + g: SET; + +BEGIN + h := 0; + i := 0; + WHILE name[i] # 0X DO + h := h * 16 + ORD(name[i]); + g := BITS(h) * {28..31}; + h := ORD(BITS(h) / BITS(LSR(ORD(g), 24)) - g); + INC(i) + END + + RETURN h +END HashStr; + + +PROCEDURE MakeHash (bucket, chain: CHL.INTLIST; symCount: INTEGER); +VAR + symi, hi, k: INTEGER; + +BEGIN + FOR symi := 0 TO symCount - 1 DO + CHL.SetInt(chain, symi, 0); + hi := CHL.GetInt(hashtab, symi) MOD symCount; + IF CHL.GetInt(bucket, hi) # 0 THEN + k := symi; + WHILE CHL.GetInt(chain, k) # 0 DO + k := CHL.GetInt(chain, k) + END; + CHL.SetInt(chain, k, CHL.GetInt(bucket, hi)) + END; + CHL.SetInt(bucket, hi, symi) + END +END MakeHash; + + +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; fini: INTEGER; so, amd64: BOOLEAN); CONST interp = 0; dyn = 1; @@ -145,33 +239,67 @@ CONST data = 4; bss = 5; + linuxInterpreter64 = "/lib64/ld-linux-x86-64.so.2"; + linuxInterpreter32 = "/lib/ld-linux.so.2"; + + exeBaseAddress32 = 8048000H; + exeBaseAddress64 = 400000H; + dllBaseAddress = 0; + + DT_NULL = 0; + DT_NEEDED = 1; + DT_HASH = 4; + DT_STRTAB = 5; + DT_SYMTAB = 6; + DT_RELA = 7; + DT_RELASZ = 8; + DT_RELAENT = 9; + DT_STRSZ = 10; + DT_SYMENT = 11; + DT_INIT = 12; + DT_FINI = 13; + DT_SONAME = 14; + DT_REL = 17; + DT_RELSZ = 18; + DT_RELENT = 19; + VAR ehdr: Elf32_Ehdr; phdr: ARRAY 16 OF Elf32_Phdr; - i, LoadAdr, offset, pad, VA: INTEGER; + i, BaseAdr, offset, pad, VA, symCount: INTEGER; SizeOf: RECORD header, code, data, bss: INTEGER END; + Offset: RECORD symtab, reltab, hash, strtab, dyn: INTEGER END; + File: FILE; - str: ARRAY 40 OF CHAR; lstr: INTEGER; - Dyn: ARRAY 350 OF BYTE; + Interpreter: ARRAY 40 OF CHAR; lenInterpreter: INTEGER; + + item: LISTS.ITEM; + + Name: ARRAY 2048 OF CHAR; BEGIN - IF amd64 THEN - str := "/lib64/ld-linux-x86-64.so.2" - ELSE - str := "/lib/ld-linux.so.2" - END; - lstr := LENGTH(str); + dynamic := LISTS.create(NIL); + symtab := LISTS.create(NIL); + strtab := CHL.CreateByteList(); IF amd64 THEN - LoadAdr := 400000H + BaseAdr := exeBaseAddress64; + Interpreter := linuxInterpreter64 ELSE - LoadAdr := 08048000H + BaseAdr := exeBaseAddress32; + Interpreter := linuxInterpreter32 END; + IF so THEN + BaseAdr := dllBaseAddress + END; + + lenInterpreter := LENGTH(Interpreter) + 1; + SizeOf.code := CHL.Length(program.code); SizeOf.data := CHL.Length(program.data); SizeOf.bss := program.bss; @@ -192,7 +320,12 @@ BEGIN ehdr.e_ident[i] := 0 END; - ehdr.e_type := WCHR(ET_EXEC); + IF so THEN + ehdr.e_type := WCHR(ET_DYN) + ELSE + ehdr.e_type := WCHR(ET_EXEC) + END; + ehdr.e_version := 1; ehdr.e_shoff := 0; ehdr.e_flags := 0; @@ -218,24 +351,92 @@ BEGIN phdr[interp].p_type := 3; phdr[interp].p_offset := SizeOf.header; - phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset; - phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset; - phdr[interp].p_filesz := lstr + 1; - phdr[interp].p_memsz := lstr + 1; + phdr[interp].p_vaddr := BaseAdr + phdr[interp].p_offset; + phdr[interp].p_paddr := phdr[interp].p_vaddr; + phdr[interp].p_filesz := lenInterpreter; + phdr[interp].p_memsz := lenInterpreter; phdr[interp].p_flags := PF_R; phdr[interp].p_align := 1; phdr[dyn].p_type := 2; phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz; - phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset; - phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset; - IF amd64 THEN - phdr[dyn].p_filesz := 0A0H; - phdr[dyn].p_memsz := 0A0H - ELSE - phdr[dyn].p_filesz := 50H; - phdr[dyn].p_memsz := 50H + phdr[dyn].p_vaddr := BaseAdr + phdr[dyn].p_offset; + phdr[dyn].p_paddr := phdr[dyn].p_vaddr; + + hashtab := CHL.CreateIntList(); + + CHL.PushInt(hashtab, HashStr("")); + NewSym(CHL.PushStr(strtab, ""), 0, 0, 0X, 0X, 0X); + CHL.PushInt(hashtab, HashStr("dlopen")); + NewSym(CHL.PushStr(strtab, "dlopen"), 0, 0, 12X, 0X, 0X); + CHL.PushInt(hashtab, HashStr("dlsym")); + NewSym(CHL.PushStr(strtab, "dlsym"), 0, 0, 12X, 0X, 0X); + + IF so THEN + item := program.exp_list.first; + WHILE item # NIL DO + ASSERT(CHL.GetStr(program.export, item(BIN.EXPRT).nameoffs, Name)); + CHL.PushInt(hashtab, HashStr(Name)); + NewSym(CHL.PushStr(strtab, Name), item(BIN.EXPRT).label, 0, 12X, 0X, 0X); + item := item.next + END; + ASSERT(CHL.GetStr(program.data, program.modname, Name)) END; + + symCount := LISTS.count(symtab); + + bucket := CHL.CreateIntList(); + chain := CHL.CreateIntList(); + + FOR i := 1 TO symCount DO + CHL.PushInt(bucket, 0); + CHL.PushInt(chain, 0) + END; + + MakeHash(bucket, chain, symCount); + + NewDyn(DT_NEEDED, CHL.PushStr(strtab, "libdl.so.2")); + NewDyn(DT_STRTAB, 0); + NewDyn(DT_STRSZ, CHL.Length(strtab)); + NewDyn(DT_SYMTAB, 0); + + IF amd64 THEN + NewDyn(DT_SYMENT, 24); + NewDyn(DT_RELA, 0); + NewDyn(DT_RELASZ, 48); + NewDyn(DT_RELAENT, 24) + ELSE + NewDyn(DT_SYMENT, 16); + NewDyn(DT_REL, 0); + NewDyn(DT_RELSZ, 16); + NewDyn(DT_RELENT, 8) + END; + + NewDyn(DT_HASH, 0); + + IF so THEN + NewDyn(DT_SONAME, CHL.PushStr(strtab, Name)); + NewDyn(DT_INIT, 0); + NewDyn(DT_FINI, 0) + END; + + NewDyn(DT_NULL, 0); + + Offset.symtab := LISTS.count(dynamic) * (8 + 8 * ORD(amd64)); + Offset.reltab := Offset.symtab + symCount * (16 + 8 * ORD(amd64)); + Offset.hash := Offset.reltab + (8 + 16 * ORD(amd64)) * 2; + Offset.strtab := Offset.hash + (symCount * 2 + 2) * 4; + + Offset.dyn := phdr[dyn].p_offset; + + 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; + phdr[dyn].p_flags := PF_R; phdr[dyn].p_align := 1; @@ -243,20 +444,15 @@ BEGIN phdr[header].p_type := 1; phdr[header].p_offset := offset; - phdr[header].p_vaddr := LoadAdr; - phdr[header].p_paddr := LoadAdr; - IF amd64 THEN - phdr[header].p_filesz := 305H; - phdr[header].p_memsz := 305H - ELSE - phdr[header].p_filesz := 1D0H; - phdr[header].p_memsz := 1D0H - END; + phdr[header].p_vaddr := BaseAdr; + phdr[header].p_paddr := BaseAdr; + 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; - + offset := offset + phdr[header].p_filesz; - VA := LoadAdr + offset + 1000H; + VA := BaseAdr + offset + 1000H; phdr[text].p_type := 1; phdr[text].p_offset := offset; @@ -268,9 +464,9 @@ BEGIN phdr[text].p_align := 1000H; ehdr.e_entry := phdr[text].p_vaddr; - + offset := offset + phdr[text].p_filesz; - VA := LoadAdr + offset + 2000H; + VA := BaseAdr + offset + 2000H; pad := (16 - VA MOD 16) MOD 16; phdr[data].p_type := 1; @@ -281,9 +477,9 @@ BEGIN phdr[data].p_memsz := SizeOf.data + pad; phdr[data].p_flags := PF_R + PF_W; phdr[data].p_align := 1000H; - + offset := offset + phdr[data].p_filesz; - VA := LoadAdr + offset + 3000H; + VA := BaseAdr + offset + 3000H; phdr[bss].p_type := 1; phdr[bss].p_offset := offset; @@ -294,7 +490,20 @@ BEGIN phdr[bss].p_flags := PF_R + PF_W; phdr[bss].p_align := 1000H; - fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); + fixup(program, ehdr.e_entry, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); + + item := symtab.first; + WHILE item # NIL DO + IF item(Elf32_Sym).value # 0 THEN + INC(item(Elf32_Sym).value, ehdr.e_entry) + END; + item := item.next + END; + + IF so THEN + item := LISTS.getidx(dynamic, 10); item(Elf32_Dyn).d_val := ehdr.e_entry; + item := LISTS.getidx(dynamic, 11); item(Elf32_Dyn).d_val := BIN.GetLabel(program, fini) + ehdr.e_entry + END; File := WR.Create(FileName); @@ -340,34 +549,94 @@ BEGIN WritePH(File, phdr[bss]) END; - FOR i := 0 TO lstr DO - WR.WriteByte(File, ORD(str[i])) + FOR i := 0 TO lenInterpreter - 1 DO + WR.WriteByte(File, ORD(Interpreter[i])) END; i := 0; IF amd64 THEN - BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000"); - BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000"); - BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000"); - BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000"); - BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000"); - BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000"); - BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000"); - BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000"); - BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000"); - BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69"); - BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000") - ELSE - BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408"); - BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000"); - BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000"); - BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000"); - BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000"); - BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32"); - BIN.InitArray(Dyn, i, "000000000000000000") - END; + item := dynamic.first; + WHILE item # NIL DO + WR.Write64LE(File, item(Elf32_Dyn).d_tag); + WR.Write64LE(File, item(Elf32_Dyn).d_val); + item := item.next + END; - WR.Write(File, Dyn, i); + item := symtab.first; + WHILE item # NIL DO + 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(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(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(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(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); + + 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.Write32LE(File, 0); + WR.Write32LE(File, 0) + + END; CHL.WriteToFile(File, program.code); WHILE pad > 0 DO diff --git a/programs/develop/oberon07/Source/ERRORS.ob07 b/programs/develop/oberon07/Source/ERRORS.ob07 index 9d242e62d9..6738d047b9 100644 --- a/programs/develop/oberon07/Source/ERRORS.ob07 +++ b/programs/develop/oberon07/Source/ERRORS.ob07 @@ -7,25 +7,35 @@ MODULE ERRORS; -IMPORT C := CONSOLE, UTILS; +IMPORT C := CONSOLE, UTILS, mConst := CONSTANTS; -PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); +PROCEDURE HintMsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); BEGIN IF hint = 0 THEN - C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")"); - C.String(" variable '"); C.String(name); C.StringLn("' never used") + C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); + C.String("variable '"); C.String(name); C.StringLn("' never used") END -END hintmsg; +END HintMsg; -PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); +PROCEDURE WarningMsg* (line, col, warning: INTEGER); +BEGIN + C.String(" warning ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); + CASE warning OF + |0: C.StringLn("passing a string value as a fixed array") + |1: C.StringLn("endless FOR loop") + END +END WarningMsg; + + +PROCEDURE ErrorMsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); VAR str: ARRAY 80 OF CHAR; BEGIN C.Ln; - C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); + C.String(" error ("); C.Int(errno); C.String(") ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); CASE errno OF | 1: str := "missing 'H' or 'X'" @@ -36,6 +46,7 @@ BEGIN | 6: str := "identifier too long" | 7: str := "number too long" | 8..12: str := "number too large" + | 13: str := "real numbers not supported" | 21: str := "'MODULE' expected" | 22: str := "identifier expected" @@ -79,7 +90,7 @@ BEGIN | 60: str := "identifier does not match procedure name" | 61: str := "illegally marked identifier" | 62: str := "expression should be constant" - | 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected" + | 63: str := "not enough RAM" | 64: str := "'(' expected" | 65: str := "',' expected" | 66: str := "incompatible parameter" @@ -126,46 +137,81 @@ BEGIN |107: str := "too large parameter of CHR" |108: str := "a variable or a procedure expected" |109: str := "expression should be constant" - |110: str := "'noalign' expected" + |111: str := "record [noalign] cannot have a base type" |112: str := "record [noalign] cannot be a base type" |113: str := "result type of procedure should not be REAL" |114: str := "identifiers 'lib_init' and 'version' are reserved" |115: str := "recursive constant definition" |116: str := "procedure too deep nested" - |117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected" - |118: str := "this flag for Windows only" - |119: str := "this flag for Linux only" + |120: str := "too many formal parameters" + + |122: str := "negative divisor" + |123: str := "illegal flag" + |124: str := "unknown flag" + |125: str := "flag not supported" END; C.StringLn(str); C.String(" file: "); C.StringLn(fname); UTILS.Exit(1) -END errormsg; +END ErrorMsg; -PROCEDURE error1* (s1: ARRAY OF CHAR); +PROCEDURE Error1 (s1: ARRAY OF CHAR); BEGIN C.Ln; C.StringLn(s1); UTILS.Exit(1) -END error1; +END Error1; -PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR); +PROCEDURE Error3 (s1, s2, s3: ARRAY OF CHAR); BEGIN C.Ln; C.String(s1); C.String(s2); C.StringLn(s3); UTILS.Exit(1) -END error3; +END Error3; -PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR); +PROCEDURE Error5 (s1, s2, s3, s4, s5: ARRAY OF CHAR); BEGIN C.Ln; C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5); UTILS.Exit(1) -END error5; +END Error5; + + +PROCEDURE WrongRTL* (ProcName: ARRAY OF CHAR); +BEGIN + Error5("procedure ", mConst.RTL_NAME, ".", ProcName, " not found") +END WrongRTL; + + +PROCEDURE BadParam* (param: ARRAY OF CHAR); +BEGIN + Error3("bad parameter: ", param, "") +END BadParam; + + +PROCEDURE FileNotFound* (Path, Name, Ext: ARRAY OF CHAR); +BEGIN + Error5("file ", Path, Name, Ext, " not found") +END FileNotFound; + + +PROCEDURE Error* (n: INTEGER); +BEGIN + CASE n OF + |201: Error1("writing file error") + |202: Error1("too many relocations") + |203: Error1("size of program is too large") + |204: Error1("size of global variables is too large") + |205: Error1("not enough parameters") + |206: Error1("bad parameter ") + |207: Error3('inputfile name extension must be "', mConst.FILE_EXT, '"') + END +END Error; END ERRORS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/FILES.ob07 b/programs/develop/oberon07/Source/FILES.ob07 index 23032ca6cc..fc67c1fecd 100644 --- a/programs/develop/oberon07/Source/FILES.ob07 +++ b/programs/develop/oberon07/Source/FILES.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) diff --git a/programs/develop/oberon07/Source/IL.ob07 b/programs/develop/oberon07/Source/IL.ob07 new file mode 100644 index 0000000000..89278d5bc7 --- /dev/null +++ b/programs/develop/oberon07/Source/IL.ob07 @@ -0,0 +1,1182 @@ +я╗┐(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE IL; + +IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS; + + +CONST + + little_endian* = 0; + big_endian* = 1; + + call_stack* = 0; + call_win64* = 1; + call_sysv* = 2; + + 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; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; + opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; + opNOT* = 29; + + opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *); + opEQC* = 36; opNEC* = opEQC + 1; opLTC* = opEQC + 2; opLEC* = opEQC + 3; opGTC* = opEQC + 4; opGEC* = opEQC + 5; (* 41 *) + opEQF* = 42; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; (* 47 *) + opEQS* = 48; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5; (* 53 *) + opEQSW* = 54; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 59 *); + + opVLOAD32* = 60; opGLOAD32* = 61; + + opJNE* = 62; opJE* = 63; + + opSAVE32* = 64; opLLOAD8* = 65; + + opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; + opUMINF* = 72; opADDFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; + + opACC* = 77; opJG* = 78; + opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; + + opCASEL* = 83; opCASER* = 84; opCASELR* = 85; + + opPOPSP* = 86; + opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91; + + opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97; + opPUSHC* = 98; opSWITCH* = 99; + + opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; + + opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; + 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; + + opLEAVEC* = 122; opCODE* = 123; opALIGN16* = 124; + opINCC* = 125; opINC* = 126; opDEC* = 127; + opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133; + opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; + opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; + opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; + opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; + 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; 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; 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; opGETC* = 215; opLENGTHW* = 216; + + opSYSVCALL* = 217; opSYSVCALLI* = 218; opSYSVCALLP* = 219; opSYSVALIGN16* = 220; opWIN64ALIGN16* = 221; + + + 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; + + opLADR_SAVEC* = -10; opGADR_SAVEC* = -11; opLADR_SAVE* = -12; + + opLADR_INCC* = -13; opLADR_INCCB* = -14; opLADR_DECCB* = -15; + opLADR_INC* = -16; opLADR_DEC* = -17; opLADR_INCB* = -18; opLADR_DECB* = -19; + opLADR_INCL* = -20; opLADR_EXCL* = -21; opLADR_INCLC* = -22; opLADR_EXCLC* = -23; + opLADR_UNPK* = -24; + + + _move *= 0; + _move2 *= 1; + _strcmpw *= 2; + _exit *= 3; + _set *= 4; + _set2 *= 5; + _lengthw *= 6; + _strcpy *= 7; + _div *= 8; + _mod *= 9; + _div2 *= 10; + _mod2 *= 11; + _arrcpy *= 12; + _rot *= 13; + _new *= 14; + _dispose *= 15; + _strcmp *= 16; + _error *= 17; + _is *= 18; + _isrec *= 19; + _guard *= 20; + _guardrec *= 21; + _length *= 22; + _init *= 23; + _dllentry *= 24; + _sofinit *= 25; + + +TYPE + + LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) + + offset*, size*, count*: INTEGER + + END; + + COMMAND* = POINTER TO RECORD (LISTS.ITEM) + + opcode*: INTEGER; + param1*: INTEGER; + param2*: INTEGER; + param3*: INTEGER; + float*: REAL; + variables*: LISTS.LIST; + allocReg*: BOOLEAN + + END; + + CMDSTACK = POINTER TO RECORD + + data: ARRAY 1000 OF COMMAND; + top: INTEGER + + END; + + EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + name*: SCAN.LEXSTR + + END; + + IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) + + name*: SCAN.LEXSTR; + procs*: LISTS.LIST + + END; + + IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + lib*: IMPORT_LIB; + name*: SCAN.LEXSTR; + count: INTEGER + + END; + + + CODES* = POINTER TO RECORD + + last: COMMAND; + begcall: CMDSTACK; + endcall: CMDSTACK; + commands*: LISTS.LIST; + export*: LISTS.LIST; + import*: LISTS.LIST; + types*: CHL.INTLIST; + data*: CHL.BYTELIST; + dmin*: INTEGER; + lcount*: INTEGER; + bss*: INTEGER; + rtl*: ARRAY 26 OF INTEGER; + errlabels*: ARRAY 12 OF INTEGER; + + charoffs: ARRAY 256 OF INTEGER; + wcharoffs: ARRAY 65536 OF INTEGER; + + fregs: INTEGER; + wstr: ARRAY 4*1024 OF WCHAR + END; + + +VAR + + codes*: CODES; + endianness: INTEGER; + numRegsFloat: INTEGER; + + commands, variables: C.COLLECTION; + + +PROCEDURE NewCmd (): COMMAND; +VAR + cmd: COMMAND; + citem: C.ITEM; + +BEGIN + citem := C.pop(commands); + IF citem = NIL THEN + NEW(cmd) + ELSE + cmd := citem(COMMAND) + END; + + cmd.allocReg := FALSE + + RETURN cmd +END NewCmd; + + +PROCEDURE NewVar* (): LOCALVAR; +VAR + lvar: LOCALVAR; + citem: C.ITEM; + +BEGIN + citem := C.pop(variables); + IF citem = NIL THEN + NEW(lvar) + ELSE + lvar := citem(LOCALVAR) + END; + + lvar.count := 0 + + RETURN lvar +END NewVar; + + +PROCEDURE setlast* (cmd: COMMAND); +BEGIN + codes.last := cmd +END setlast; + + +PROCEDURE getlast* (): COMMAND; + RETURN codes.last +END getlast; + + +PROCEDURE PutByte (codes: CODES; b: BYTE); +BEGIN + CHL.PushByte(codes.data, b) +END PutByte; + + +PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; +BEGIN + res := CHL.Length(codes.data); + + i := 0; + n := LENGTH(s); + WHILE i < n DO + PutByte(codes, ORD(s[i])); + INC(i) + END; + + PutByte(codes, 0) + + RETURN res +END putstr; + + +PROCEDURE putstr1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.charoffs[c] = -1 THEN + res := CHL.Length(codes.data); + PutByte(codes, c); + PutByte(codes, 0); + codes.charoffs[c] := res + ELSE + res := codes.charoffs[c] + END + + RETURN res +END putstr1; + + +PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; + +BEGIN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(codes, 0); + INC(res) + END; + + n := STRINGS.Utf8To16(s, codes.wstr); + + i := 0; + WHILE i < n DO + IF endianness = little_endian THEN + PutByte(codes, ORD(codes.wstr[i]) MOD 256); + PutByte(codes, ORD(codes.wstr[i]) DIV 256) + ELSIF endianness = big_endian THEN + PutByte(codes, ORD(codes.wstr[i]) DIV 256); + PutByte(codes, ORD(codes.wstr[i]) MOD 256) + END; + INC(i) + END; + + PutByte(codes, 0); + PutByte(codes, 0) + + RETURN res +END putstrW; + + +PROCEDURE putstrW1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.wcharoffs[c] = -1 THEN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(codes, 0); + INC(res) + END; + + IF endianness = little_endian THEN + PutByte(codes, c MOD 256); + PutByte(codes, c DIV 256) + ELSIF endianness = big_endian THEN + PutByte(codes, c DIV 256); + PutByte(codes, c MOD 256) + END; + + PutByte(codes, 0); + PutByte(codes, 0); + + codes.wcharoffs[c] := res + ELSE + res := codes.wcharoffs[c] + END + + RETURN res +END putstrW1; + + +PROCEDURE push (stk: CMDSTACK; cmd: COMMAND); +BEGIN + INC(stk.top); + stk.data[stk.top] := cmd +END push; + + +PROCEDURE pop (stk: CMDSTACK): COMMAND; +VAR + res: COMMAND; +BEGIN + res := stk.data[stk.top]; + DEC(stk.top) + RETURN res +END pop; + + +PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); +BEGIN + push(codes.begcall, beg); + push(codes.endcall, end); + beg := codes.last; + end := beg.next(COMMAND) +END pushBegEnd; + + +PROCEDURE popBegEnd* (VAR beg, end: COMMAND); +BEGIN + beg := pop(codes.begcall); + end := pop(codes.endcall) +END popBegEnd; + + +PROCEDURE AddRec* (base: INTEGER); +BEGIN + CHL.PushInt(codes.types, base) +END AddRec; + + +PROCEDURE insert (cur, nov: COMMAND); +VAR + old_opcode, param2: INTEGER; + + + PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER); + BEGIN + cur.opcode := opcode; + cur.param1 := cur.param2; + cur.param2 := param2 + END set; + + +BEGIN + old_opcode := cur.opcode; + param2 := nov.param2; + + IF (nov.opcode = opPARAM) & (param2 = 1) THEN + + CASE old_opcode OF + |opGLOAD64: cur.opcode := opGLOAD64_PARAM + |opLLOAD64: cur.opcode := opLLOAD64_PARAM + |opLOAD64: cur.opcode := opLOAD64_PARAM + |opGLOAD32: cur.opcode := opGLOAD32_PARAM + |opLLOAD32: cur.opcode := opLLOAD32_PARAM + |opLOAD32: cur.opcode := opLOAD32_PARAM + |opSADR: cur.opcode := opSADR_PARAM + |opVADR: cur.opcode := opVADR_PARAM + |opCONST: cur.opcode := opCONST_PARAM + ELSE + old_opcode := -1 + END + + ELSIF old_opcode = opLADR THEN + + CASE nov.opcode OF + |opSAVEC: set(cur, opLADR_SAVEC, param2) + |opSAVE: cur.opcode := opLADR_SAVE + |opINC: cur.opcode := opLADR_INC + |opDEC: cur.opcode := opLADR_DEC + |opINCB: cur.opcode := opLADR_INCB + |opDECB: cur.opcode := opLADR_DECB + |opINCL: cur.opcode := opLADR_INCL + |opEXCL: cur.opcode := opLADR_EXCL + |opUNPK: cur.opcode := opLADR_UNPK + |opINCC: set(cur, opLADR_INCC, param2) + |opINCCB: set(cur, opLADR_INCCB, param2) + |opDECCB: set(cur, opLADR_DECCB, param2) + |opINCLC: set(cur, opLADR_INCLC, param2) + |opEXCLC: set(cur, opLADR_EXCLC, param2) + ELSE + old_opcode := -1 + END + + ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN + set(cur, opGADR_SAVEC, param2) + + ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN + cur.param2 := param2 * cur.param2 + + ELSE + old_opcode := -1 + END; + + IF old_opcode = -1 THEN + LISTS.insert(codes.commands, cur, nov); + codes.last := nov + ELSE + C.push(commands, nov); + codes.last := cur + END +END insert; + + +PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := 0; + cmd.param2 := param; + insert(codes.last, cmd) +END AddCmd; + + +PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := param1; + cmd.param2 := param2; + insert(codes.last, cmd) +END AddCmd2; + + +PROCEDURE Const* (val: INTEGER); +BEGIN + AddCmd(opCONST, val) +END Const; + + +PROCEDURE StrAdr* (adr: INTEGER); +BEGIN + AddCmd(opSADR, adr) +END StrAdr; + + +PROCEDURE Param1*; +BEGIN + AddCmd(opPARAM, 1) +END Param1; + + +PROCEDURE NewLabel* (): INTEGER; +BEGIN + INC(codes.lcount) + RETURN codes.lcount - 1 +END NewLabel; + + +PROCEDURE SetLabel* (label: INTEGER); +BEGIN + AddCmd2(opLABEL, label, 0) +END SetLabel; + + +PROCEDURE SetErrLabel* (errno: INTEGER); +BEGIN + codes.errlabels[errno] := NewLabel(); + SetLabel(codes.errlabels[errno]) +END SetErrLabel; + + +PROCEDURE AddCmd0* (opcode: INTEGER); +BEGIN + AddCmd(opcode, 0) +END AddCmd0; + + +PROCEDURE deleteVarList (list: LISTS.LIST); +VAR + last: LISTS.ITEM; + +BEGIN + WHILE list.last # NIL DO + last := LISTS.pop(list); + C.push(variables, last) + END +END deleteVarList; + + +PROCEDURE delete (cmd: COMMAND); +BEGIN + IF cmd.variables # NIL THEN + deleteVarList(cmd.variables) + END; + LISTS.delete(codes.commands, cmd); + C.push(commands, cmd) +END delete; + + +PROCEDURE delete2* (first, last: LISTS.ITEM); +VAR + cur, next: LISTS.ITEM; + +BEGIN + cur := first; + + IF first # last THEN + REPEAT + next := cur.next; + LISTS.delete(codes.commands, cur); + C.push(commands, cur); + cur := next + UNTIL cur = last + END; + + LISTS.delete(codes.commands, cur); + C.push(commands, cur) +END delete2; + + +PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); +VAR + prev: COMMAND; + not: BOOLEAN; + +BEGIN + prev := codes.last; + not := prev.opcode = opNOT; + IF not THEN + IF opcode = opJE THEN + opcode := opJNE + ELSIF opcode = opJNE THEN + opcode := opJE + ELSE + not := FALSE + END + END; + + AddCmd2(opcode, label, label); + + IF not THEN + delete(prev) + END + +END AddJmpCmd; + + +PROCEDURE OnError* (line, error: INTEGER); +BEGIN + AddCmd(opPUSHC, line); + AddJmpCmd(opJMP, codes.errlabels[error]) +END OnError; + + +PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); +VAR + label: INTEGER; +BEGIN + AddCmd(op, t); + label := NewLabel(); + AddJmpCmd(opJE, label); + OnError(line, error); + SetLabel(label) +END TypeGuard; + + +PROCEDURE TypeCheck* (t: INTEGER); +BEGIN + AddCmd(opIS, t) +END TypeCheck; + + +PROCEDURE TypeCheckRec* (t: INTEGER); +BEGIN + AddCmd(opISREC, t) +END TypeCheckRec; + + +PROCEDURE New* (size, typenum: INTEGER); +BEGIN + AddCmd2(opNEW, typenum, size) +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; +BEGIN + prev := codes.last; + IF prev.opcode = opNOT THEN + codes.last := prev.prev(COMMAND); + delete(prev) + ELSE + AddCmd0(opNOT) + END +END not; + + +PROCEDURE Enter* (label, params: INTEGER): COMMAND; +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opENTER; + cmd.param1 := label; + cmd.param3 := params; + cmd.allocReg := TRUE; + insert(codes.last, cmd) + + RETURN codes.last +END Enter; + + +PROCEDURE Leave* (result, float: BOOLEAN; locsize, paramsize: INTEGER): COMMAND; +BEGIN + IF result THEN + IF float THEN + AddCmd2(opLEAVEF, locsize, paramsize) + ELSE + AddCmd2(opLEAVER, locsize, paramsize) + END + ELSE + AddCmd2(opLEAVE, locsize, paramsize) + END + + RETURN codes.last +END Leave; + + +PROCEDURE EnterC* (label: INTEGER): COMMAND; +BEGIN + SetLabel(label) + RETURN codes.last +END EnterC; + + +PROCEDURE LeaveC* (): COMMAND; +BEGIN + AddCmd0(opLEAVEC) + RETURN codes.last +END LeaveC; + + +PROCEDURE Call* (proc, callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALL, proc) + |call_win64: AddJmpCmd(opWIN64CALL, proc) + |call_sysv: AddJmpCmd(opSYSVCALL, proc) + END; + codes.last(COMMAND).param2 := fparams +END Call; + + +PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) + |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) + |call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label) + END; + codes.last(COMMAND).param2 := fparams +END CallImp; + + +PROCEDURE CallP* (callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddCmd0(opCALLP) + |call_win64: AddCmd(opWIN64CALLP, fparams) + |call_sysv: AddCmd(opSYSVCALLP, fparams) + END +END CallP; + + +PROCEDURE AssignProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opSAVEP, proc) +END AssignProc; + + +PROCEDURE AssignImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) +END AssignImpProc; + + +PROCEDURE PushProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opPUSHP, proc) +END PushProc; + + +PROCEDURE PushImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) +END PushImpProc; + + +PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQP, proc) + ELSE + AddJmpCmd(opNEP, proc) + END +END ProcCmp; + + +PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQIP, proc(IMPORT_PROC).label) + ELSE + AddJmpCmd(opNEIP, proc(IMPORT_PROC).label) + END +END ProcImpCmp; + + +PROCEDURE load* (size: INTEGER); +VAR + last: COMMAND; + +BEGIN + last := codes.last; + CASE size OF + |1: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD8 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD8 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD8 + ELSE + AddCmd0(opLOAD8) + END + + |2: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD16 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD16 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD16 + ELSE + AddCmd0(opLOAD16) + END + + |4: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD32 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD32 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD32 + ELSE + AddCmd0(opLOAD32) + END + + |8: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD64 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD64 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD64 + ELSE + AddCmd0(opLOAD64) + END + END +END load; + + +PROCEDURE SysPut* (size: INTEGER); +BEGIN + CASE size OF + |1: AddCmd0(opSAVE8) + |2: AddCmd0(opSAVE16) + |4: AddCmd0(opSAVE32) + |8: AddCmd0(opSAVE64) + END +END SysPut; + + +PROCEDURE savef*; +BEGIN + AddCmd0(opSAVEF); + 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) +END saves; + + +PROCEDURE abs* (real: BOOLEAN); +BEGIN + IF real THEN + AddCmd0(opFABS) + ELSE + AddCmd0(opABS) + END +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 odd*; +BEGIN + AddCmd0(opODD) +END odd; + + +PROCEDURE ord*; +BEGIN + AddCmd0(opORD) +END ord; + + +PROCEDURE shift_minmax* (op: CHAR); +BEGIN + CASE op OF + |"A": AddCmd0(opASR) + |"L": AddCmd0(opLSL) + |"O": AddCmd0(opROR) + |"R": AddCmd0(opLSR) + |"m": AddCmd0(opMIN) + |"x": AddCmd0(opMAX) + END +END shift_minmax; + + +PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR1, x) + |"L": AddCmd(opLSL1, x) + |"O": AddCmd(opROR1, x) + |"R": AddCmd(opLSR1, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax1; + + +PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR2, x) + |"L": AddCmd(opLSL2, x) + |"O": AddCmd(opROR2, x) + |"R": AddCmd(opLSR2, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax2; + + +PROCEDURE len* (dim: INTEGER); +BEGIN + AddCmd(opLEN, dim) +END len; + + +PROCEDURE Float* (r: REAL); +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opCONSTF; + cmd.float := r; + 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) +END drop; + + +PROCEDURE case* (a, b, L, R: INTEGER); +VAR + cmd: COMMAND; + +BEGIN + IF a = b THEN + cmd := NewCmd(); + cmd.opcode := opCASELR; + cmd.param1 := a; + cmd.param2 := L; + cmd.param3 := R; + insert(codes.last, cmd) + ELSE + AddCmd2(opCASEL, a, L); + AddCmd2(opCASER, b, R) + END +END case; + + +PROCEDURE caset* (a, label: INTEGER); +BEGIN + AddCmd2(opCASET, label, a) +END caset; + + +PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); +VAR + exp: EXPORT_PROC; + +BEGIN + NEW(exp); + exp.label := label; + exp.name := name; + LISTS.push(codes.export, exp) +END AddExp; + + +PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; +VAR + lib: IMPORT_LIB; + p: IMPORT_PROC; + +BEGIN + lib := codes.import.first(IMPORT_LIB); + WHILE (lib # NIL) & (lib.name # dll) DO + lib := lib.next(IMPORT_LIB) + END; + + IF lib = NIL THEN + NEW(lib); + lib.name := dll; + lib.procs := LISTS.create(NIL); + LISTS.push(codes.import, lib) + END; + + p := lib.procs.first(IMPORT_PROC); + WHILE (p # NIL) & (p.name # proc) DO + p := p.next(IMPORT_PROC) + END; + + IF p = NIL THEN + NEW(p); + p.name := proc; + p.label := NewLabel(); + p.lib := lib; + p.count := 1; + LISTS.push(lib.procs, p) + ELSE + INC(p.count) + END + + RETURN p +END AddImp; + + +PROCEDURE DelImport* (imp: LISTS.ITEM); +VAR + lib: IMPORT_LIB; + +BEGIN + DEC(imp(IMPORT_PROC).count); + IF imp(IMPORT_PROC).count = 0 THEN + lib := imp(IMPORT_PROC).lib; + LISTS.delete(lib.procs, imp); + IF lib.procs.first = NIL THEN + LISTS.delete(codes.import, lib) + END + END +END DelImport; + + +PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER); +VAR + cmd: COMMAND; + i: INTEGER; + +BEGIN + commands := C.create(); + variables := C.create(); + numRegsFloat := pNumRegsFloat; + endianness := pEndianness; + + NEW(codes); + NEW(codes.begcall); + codes.begcall.top := -1; + NEW(codes.endcall); + codes.endcall.top := -1; + codes.commands := LISTS.create(NIL); + codes.export := LISTS.create(NIL); + codes.import := LISTS.create(NIL); + codes.types := CHL.CreateIntList(); + codes.data := CHL.CreateByteList(); + + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + codes.last := cmd; + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + + AddRec(0); + + codes.lcount := 0; + + codes.fregs := 0; + + FOR i := 0 TO LEN(codes.charoffs) - 1 DO + codes.charoffs[i] := -1 + END; + + FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO + codes.wcharoffs[i] := -1 + END + +END init; + + +END IL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/KOS.ob07 b/programs/develop/oberon07/Source/KOS.ob07 index 6d7258a34a..fe44eed0a5 100644 --- a/programs/develop/oberon07/Source/KOS.ob07 +++ b/programs/develop/oberon07/Source/KOS.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -197,7 +197,7 @@ BEGIN WR.Write32LE(File, header.sp); WR.Write32LE(File, header.param); WR.Write32LE(File, header.path); - + CHL.WriteToFile(File, program.code); WR.Padding(File, FileAlignment); @@ -206,8 +206,8 @@ BEGIN FOR i := 0 TO ILen - 1 DO WR.Write32LE(File, CHL.GetInt(ImportTable, i)) - END; - + END; + CHL.WriteToFile(File, program.import); WR.Close(File) diff --git a/programs/develop/oberon07/Source/LISTS.ob07 b/programs/develop/oberon07/Source/LISTS.ob07 index 3e3188dc94..59b1342ca6 100644 --- a/programs/develop/oberon07/Source/LISTS.ob07 +++ b/programs/develop/oberon07/Source/LISTS.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -168,14 +168,32 @@ BEGIN END count; +PROCEDURE getidx* (list: LIST; idx: INTEGER): ITEM; +VAR + item: ITEM; + +BEGIN + ASSERT(list # NIL); + ASSERT(idx >= 0); + + item := list.first; + WHILE (item # NIL) & (idx > 0) DO + item := item.next; + DEC(idx) + END + + RETURN item +END getidx; + + PROCEDURE create* (list: LIST): LIST; BEGIN IF list = NIL THEN NEW(list) END; - list.first := NIL; - list.last := NIL + list.first := NIL; + list.last := NIL RETURN list END create; diff --git a/programs/develop/oberon07/Source/MSCOFF.ob07 b/programs/develop/oberon07/Source/MSCOFF.ob07 index c05c3e4033..5abc8310d9 100644 --- a/programs/develop/oberon07/Source/MSCOFF.ob07 +++ b/programs/develop/oberon07/Source/MSCOFF.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -136,7 +136,7 @@ VAR PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER); BEGIN IF NumberOfRelocations >= 65536 THEN - ERRORS.error1("too many relocations") + ERRORS.Error(202) END; section.NumberOfRelocations := WCHR(NumberOfRelocations) END SetNumberOfRelocations; diff --git a/programs/develop/oberon07/Source/MSP430.ob07 b/programs/develop/oberon07/Source/MSP430.ob07 new file mode 100644 index 0000000000..a2edaffab1 --- /dev/null +++ b/programs/develop/oberon07/Source/MSP430.ob07 @@ -0,0 +1,1793 @@ +я╗┐(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE MSP430; + +IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, FILES, WRITER, + UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; + + +CONST + + minRAM* = 128; maxRAM* = 10240; + minROM* = 2048; maxROM* = 49152; + + minStackSize = 64; + + IntVectorSize* = RTL.IntVectorSize; + + PC = 0; SP = 1; SR = 2; CG = 3; + + R4 = 4; R5 = 5; R6 = 6; R7 = 7; + + IR = 13; HP = 14; BP = 15; + + ACC = R4; + + opRRC = 1000H; opSWPB = 1080H; opRRA = 1100H; opSXT = 1180H; + opPUSH = 1200H; opCALL = 1280H; opRETI = 1300H; + + opMOV = 04000H; opADD = 05000H; opADDC = 06000H; opSUBC = 07000H; + opSUB = 08000H; opCMP = 09000H; opDADD = 0A000H; opBIT = 0B000H; + opBIC = 0C000H; opBIS = 0D000H; opXOR = 0E000H; opAND = 0F000H; + + opJNE = 2000H; opJEQ = 2400H; opJNC = 2800H; opJC = 2C00H; + opJN = 3000H; opJGE = 3400H; opJL = 3800H; opJMP = 3C00H; + + sREG = 0; sIDX = 16; sINDIR = 32; sINCR = 48; BW = 64; dIDX = 128; + + NOWORD = 10000H; + + RCODE = 0; RDATA = 1; RBSS = 2; + + je = 0; jne = je + 1; + jge = 2; jl = jge + 1; + jle = 4; jg = jle + 1; + jb = 6; + + +TYPE + + ANYCODE = POINTER TO RECORD (LISTS.ITEM) + + offset: INTEGER + + END; + + WORD = POINTER TO RECORD (ANYCODE) + + val: INTEGER + + END; + + LABEL = POINTER TO RECORD (ANYCODE) + + num: INTEGER + + END; + + JMP = POINTER TO RECORD (ANYCODE) + + cc, label: INTEGER; + short: BOOLEAN + + END; + + CALL = POINTER TO RECORD (ANYCODE) + + label: INTEGER + + END; + + COMMAND = IL.COMMAND; + + RELOC = POINTER TO RECORD (LISTS.ITEM) + + section: INTEGER; + WordPtr: WORD + + END; + + +VAR + + R: REG.REGS; + + CodeList: LISTS.LIST; + RelList: LISTS.LIST; + + mem: ARRAY 65536 OF BYTE; + + Labels: CHL.INTLIST; + + IV: ARRAY RTL.LenIV OF INTEGER; + + IdxWords: RECORD src, dst: INTEGER END; + + +PROCEDURE EmitLabel (L: INTEGER); +VAR + label: LABEL; + +BEGIN + NEW(label); + label.num := L; + LISTS.push(CodeList, label) +END EmitLabel; + + +PROCEDURE EmitWord (val: INTEGER); +VAR + word: WORD; + +BEGIN + IF val < 0 THEN + ASSERT(val >= -32768); + val := val MOD 65536 + ELSE + ASSERT(val <= 65535) + END; + NEW(word); + word.val := val; + LISTS.push(CodeList, word) +END EmitWord; + + +PROCEDURE EmitJmp (cc, label: INTEGER); +VAR + jmp: JMP; + +BEGIN + NEW(jmp); + jmp.cc := cc; + jmp.label := label; + jmp.short := FALSE; + LISTS.push(CodeList, jmp) +END EmitJmp; + + +PROCEDURE EmitCall (label: INTEGER); +VAR + call: CALL; + +BEGIN + NEW(call); + call.label := label; + LISTS.push(CodeList, call) +END EmitCall; + + +PROCEDURE bw (b: BOOLEAN): INTEGER; + RETURN BW * ORD(b) +END bw; + + +PROCEDURE src_x (x, Rn: INTEGER): INTEGER; +BEGIN + IdxWords.src := x + RETURN Rn * 256 + sIDX +END src_x; + + +PROCEDURE dst_x (x, Rn: INTEGER): INTEGER; +BEGIN + IdxWords.dst := x + RETURN Rn + dIDX +END dst_x; + + +PROCEDURE indir (Rn: INTEGER): INTEGER; + RETURN Rn * 256 + sINDIR +END indir; + + +PROCEDURE incr (Rn: INTEGER): INTEGER; + RETURN Rn * 256 + sINCR +END incr; + + +PROCEDURE imm (x: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE x OF + | 0: res := CG * 256 + | 1: res := src_x(0, CG); IdxWords.src := NOWORD + | 2: res := indir(CG) + | 4: res := indir(SR) + | 8: res := incr(SR) + |-1: res := incr(CG) + ELSE + res := incr(PC); + IdxWords.src := x + END + + RETURN res +END imm; + + +PROCEDURE Op2 (op, src, dst: INTEGER); +BEGIN + ASSERT(BITS(op) + {6, 12..15} = {6, 12..15}); + ASSERT(BITS(src) + {4, 5, 8..11} = {4, 5, 8..11}); + ASSERT(BITS(dst) + {0..3, 7} = {0..3, 7}); + + EmitWord(op + src + dst); + + IF IdxWords.src # NOWORD THEN + EmitWord(IdxWords.src); + IdxWords.src := NOWORD + END; + + IF IdxWords.dst # NOWORD THEN + EmitWord(IdxWords.dst); + IdxWords.dst := NOWORD + END +END Op2; + + +PROCEDURE Op1 (op, reg, As: INTEGER); +BEGIN + EmitWord(op + reg + As) +END Op1; + + +PROCEDURE MovRR (src, dst: INTEGER); +BEGIN + Op2(opMOV, src * 256, dst) +END MovRR; + + +PROCEDURE PushImm (imm: INTEGER); +BEGIN + imm := UTILS.Long(imm); + CASE imm OF + | 0: Op1(opPUSH, CG, sREG) + | 1: Op1(opPUSH, CG, sIDX) + | 2: Op1(opPUSH, CG, sINDIR) + |-1: Op1(opPUSH, CG, sINCR) + ELSE + Op1(opPUSH, PC, sINCR); + EmitWord(imm) + END +END PushImm; + + +PROCEDURE PutWord (word: INTEGER; VAR adr: INTEGER); +BEGIN + ASSERT(~ODD(adr)); + ASSERT((0 <= word) & (word <= 65535)); + mem[adr] := word MOD 256; + mem[adr + 1] := word DIV 256; + INC(adr, 2) +END PutWord; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + CHL.PushInt(Labels, 0) + RETURN IL.NewLabel() +END NewLabel; + + +PROCEDURE LabelOffs (n: INTEGER): INTEGER; + RETURN CHL.GetInt(Labels, n) +END LabelOffs; + + +PROCEDURE Fixup (CodeAdr, IntVectorSize: INTEGER): INTEGER; +VAR + cmd: ANYCODE; + adr: INTEGER; + offset: INTEGER; + diff: INTEGER; + cc: INTEGER; + shorted: BOOLEAN; + +BEGIN + REPEAT + shorted := FALSE; + offset := CodeAdr DIV 2; + + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + cmd.offset := offset; + CASE cmd OF + |LABEL: CHL.SetInt(Labels, cmd.num, offset) + |JMP: INC(offset); + IF ~cmd.short THEN + INC(offset); + IF cmd.cc # opJMP THEN + INC(offset) + END + END + + |CALL: INC(offset, 2) + |WORD: INC(offset) + END; + cmd := cmd.next(ANYCODE) + END; + + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + IF (cmd IS JMP) & ~cmd(JMP).short THEN + diff := LabelOffs(cmd(JMP).label) - cmd.offset - 1; + IF ABS(diff) <= 512 THEN + cmd(JMP).short := TRUE; + shorted := TRUE + END + END; + cmd := cmd.next(ANYCODE) + END + + UNTIL ~shorted; + + IF offset * 2 > 10000H - IntVectorSize THEN + ERRORS.Error(203) + END; + + adr := CodeAdr; + cmd := CodeList.first(ANYCODE); + WHILE cmd # NIL DO + CASE cmd OF + |LABEL: + + |JMP: IF ~cmd.short THEN + CASE cmd.cc OF + |opJNE: cc := opJEQ + |opJEQ: cc := opJNE + |opJNC: cc := opJC + |opJC: cc := opJNC + |opJGE: cc := opJL + |opJL: cc := opJGE + |opJMP: cc := opJMP + END; + + IF cc # opJMP THEN + PutWord(cc + 2, adr) (* jcc L *) + END; + + PutWord(4030H, adr); (* MOV @PC+, PC *) + PutWord(LabelOffs(cmd.label) * 2, adr) + (* L: *) + ELSE + diff := LabelOffs(cmd.label) - cmd.offset - 1; + ASSERT((-512 <= diff) & (diff <= 511)); + PutWord(cmd.cc + diff MOD 1024, adr) + END + + |CALL: PutWord(12B0H, adr); (* CALL @PC+ *) + PutWord(LabelOffs(cmd.label) * 2, adr) + + |WORD: PutWord(cmd.val, adr) + + END; + cmd := cmd.next(ANYCODE) + END + + RETURN adr - CodeAdr +END Fixup; + + +PROCEDURE Push (reg: INTEGER); +BEGIN + Op1(opPUSH, reg, sREG) +END Push; + + +PROCEDURE Pop (reg: INTEGER); +BEGIN + Op2(opMOV, incr(SP), reg) +END Pop; + + +PROCEDURE Test (reg: INTEGER); +BEGIN + Op2(opCMP, imm(0), reg) +END Test; + + +PROCEDURE Clear (reg: INTEGER); +BEGIN + Op2(opMOV, imm(0), reg) +END Clear; + + +PROCEDURE mov (dst, src: INTEGER); +BEGIN + MovRR(src, dst) +END mov; + + +PROCEDURE xchg (reg1, reg2: INTEGER); +BEGIN + Push(reg1); + Push(reg2); + Pop(reg1); + Pop(reg2) +END xchg; + + +PROCEDURE Reloc (section: INTEGER); +VAR + reloc: RELOC; + +BEGIN + NEW(reloc); + reloc.section := section; + reloc.WordPtr := CodeList.last(WORD); + LISTS.push(RelList, reloc) +END Reloc; + + +PROCEDURE CallRTL (proc, params: INTEGER); +BEGIN + EmitCall(RTL.rtl[proc].label); + RTL.Used(proc); + IF params > 0 THEN + Op2(opADD, imm(params * 2), SP) + END +END CallRTL; + + +PROCEDURE UnOp (VAR reg: INTEGER); +BEGIN + REG.UnOp(R, reg) +END UnOp; + + +PROCEDURE BinOp (VAR reg1, reg2: INTEGER); +BEGIN + REG.BinOp(R, reg1, reg2) +END BinOp; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetRegA; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE PushAll_1; +BEGIN + REG.PushAll_1(R) +END PushAll_1; + + +PROCEDURE cond (op: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE op OF + |IL.opGT, IL.opGTC: res := jg + |IL.opGE, IL.opGEC: res := jge + |IL.opLT, IL.opLTC: res := jl + |IL.opLE, IL.opLEC: res := jle + |IL.opEQ, IL.opEQC: res := je + |IL.opNE, IL.opNEC: res := jne + END + + RETURN res +END cond; + + +PROCEDURE jcc (cc, label: INTEGER); +VAR + L: INTEGER; + +BEGIN + CASE cc OF + |jne: + EmitJmp(opJNE, label) + |je: + EmitJmp(opJEQ, label) + |jge: + EmitJmp(opJGE, label) + |jl: + EmitJmp(opJL, label) + |jle: + EmitJmp(opJL, label); + EmitJmp(opJEQ, label) + |jg: + L := NewLabel(); + EmitJmp(opJEQ, L); + EmitJmp(opJGE, label); + EmitLabel(L) + |jb: + EmitJmp(opJNC, label) + END +END jcc; + + +PROCEDURE setcc (cc, reg: INTEGER); +VAR + L: INTEGER; + +BEGIN + L := NewLabel(); + Op2(opMOV, imm(1), reg); + jcc(cc, L); + Clear(reg); + EmitLabel(L) +END setcc; + + +PROCEDURE Shift2 (op, reg, n: INTEGER); +VAR + reg2: INTEGER; + +BEGIN + IF n >= 8 THEN + CASE op OF + |IL.opASR2: Op1(opSWPB, reg, sREG); Op1(opSXT, reg, sREG) + |IL.opROR2: Op1(opSWPB, reg, sREG) + |IL.opLSL2: Op1(opSWPB, reg, sREG); Op2(opBIC, imm(255), reg) + |IL.opLSR2: Op2(opBIC, imm(255), reg); Op1(opSWPB, reg, sREG) + END; + DEC(n, 8) + END; + + IF (op = IL.opROR2) & (n > 0) THEN + reg2 := GetAnyReg(); + MovRR(reg, reg2) + ELSE + reg2 := -1 + END; + + WHILE n > 0 DO + CASE op OF + |IL.opASR2: Op1(opRRA, reg, sREG) + |IL.opROR2: Op1(opRRC, reg2, sREG); Op1(opRRC, reg, sREG) + |IL.opLSL2: Op2(opADD, reg * 256, reg) + |IL.opLSR2: Op2(opBIC, imm(1), SR); Op1(opRRC, reg, sREG) + END; + DEC(n) + END; + + IF reg2 # -1 THEN + drop + END + +END Shift2; + + +PROCEDURE Neg (reg: INTEGER); +BEGIN + Op2(opXOR, imm(-1), reg); + Op2(opADD, imm(1), reg) +END Neg; + + +PROCEDURE translate (code: IL.CODES); +VAR + cmd, next: COMMAND; + + opcode, param1, param2, label, L, a, n, c1, c2: INTEGER; + + reg1, reg2: INTEGER; + + cc: INTEGER; + +BEGIN + cmd := code.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + + opcode := cmd.opcode; + + CASE opcode OF + |IL.opJMP: + EmitJmp(opJMP, param1) + + |IL.opCALL: + EmitCall(param1) + + |IL.opCALLP: + UnOp(reg1); + Op1(opCALL, reg1, sREG); + drop; + ASSERT(R.top = -1) + + |IL.opPRECALL: + PushAll(0) + + |IL.opLABEL: + EmitLabel(param1) + + |IL.opSADR_PARAM: + Op1(opPUSH, PC, sINCR); + EmitWord(param2); + Reloc(RDATA) + + |IL.opERR: + CallRTL(RTL._error, 2) + + |IL.opPUSHC: + PushImm(param2) + + |IL.opLEAVEC: + Pop(PC) + + |IL.opENTER: + ASSERT(R.top = -1); + + EmitLabel(param1); + + Push(BP); + MovRR(SP, BP); + + IF param2 > 8 THEN + Op2(opMOV, imm(param2), R4); + L := NewLabel(); + EmitLabel(L); + Push(CG); + Op2(opSUB, imm(1), R4); + jcc(jne, L) + ELSIF param2 > 0 THEN + WHILE param2 > 0 DO + Push(CG); + DEC(param2) + END + END + + |IL.opLEAVE, IL.opLEAVER: + ASSERT(param2 = 0); + IF opcode = IL.opLEAVER THEN + UnOp(reg1); + IF reg1 # ACC THEN + GetRegA; + ASSERT(REG.Exchange(R, reg1, ACC)); + drop + END; + drop + END; + + ASSERT(R.top = -1); + + IF param1 > 0 THEN + MovRR(BP, SP) + END; + + Pop(BP); + Pop(PC) + + |IL.opRES: + ASSERT(R.top = -1); + GetRegA + + |IL.opCLEANUP: + IF param2 # 0 THEN + Op2(opADD, imm(param2 * 2), SP) + END + + |IL.opCONST: + next := cmd.next(COMMAND); + IF next.opcode = IL.opCONST THEN + c1 := param2; + c2 := next.param2; + next := next.next(COMMAND); + IF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN + Op2(opMOV + bw(next.opcode = IL.opSAVE8), imm(c1), dst_x(c2, SR)); + cmd := next + ELSE + Op2(opMOV, imm(param2), GetAnyReg()) + END + ELSIF (next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVE16) OR (next.opcode = IL.opSAVE8) THEN + UnOp(reg1); + Op2(opMOV + bw(next.opcode = IL.opSAVE8), reg1 * 256, dst_x(param2, SR)); + drop; + cmd := next + ELSE + Op2(opMOV, imm(param2), GetAnyReg()) + END + + |IL.opSADR: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RDATA) + + |IL.opGADR: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RBSS) + + |IL.opLADR: + reg1 := GetAnyReg(); + MovRR(BP, reg1); + Op2(opADD, imm(param2 * 2), reg1) + + |IL.opLLOAD8: + Op2(opMOV + BW, src_x(param2 * 2, BP), GetAnyReg()) + + |IL.opLLOAD16, IL.opVADR: + Op2(opMOV, src_x(param2 * 2, BP), GetAnyReg()) + + |IL.opGLOAD8: + Op2(opMOV + BW, src_x(param2, SR), GetAnyReg()); + Reloc(RBSS) + + |IL.opGLOAD16: + Op2(opMOV, src_x(param2, SR), GetAnyReg()); + Reloc(RBSS) + + |IL.opLOAD8: + UnOp(reg1); + Op2(opMOV + BW, indir(reg1), reg1) + + |IL.opLOAD16: + UnOp(reg1); + Op2(opMOV, indir(reg1), reg1) + + |IL.opVLOAD8: + reg1 := GetAnyReg(); + Op2(opMOV, src_x(param2 * 2, BP), reg1); + Op2(opMOV + BW, indir(reg1), reg1) + + |IL.opVLOAD16: + reg1 := GetAnyReg(); + Op2(opMOV, src_x(param2 * 2, BP), reg1); + Op2(opMOV, indir(reg1), reg1) + + |IL.opSAVE, IL.opSAVE16: + BinOp(reg2, reg1); + Op2(opMOV, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSAVE8: + BinOp(reg2, reg1); + Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSAVE8C: + UnOp(reg1); + Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opSAVE16C, IL.opSAVEC: + UnOp(reg1); + Op2(opMOV, imm(param2), dst_x(0, reg1)); + drop + + |IL.opUMINUS: + UnOp(reg1); + Neg(reg1) + + |IL.opADD: + BinOp(reg1, reg2); + Op2(opADD, reg2 * 256, reg1); + drop + + |IL.opADDL, IL.opADDR: + IF param2 # 0 THEN + UnOp(reg1); + Op2(opADD, imm(param2), reg1) + END + + |IL.opSUB: + BinOp(reg1, reg2); + Op2(opSUB, reg2 * 256, reg1); + drop + + |IL.opSUBR, IL.opSUBL: + UnOp(reg1); + IF param2 # 0 THEN + Op2(opSUB, imm(param2), reg1) + END; + IF opcode = IL.opSUBL THEN + reg2 := GetAnyReg(); + Clear(reg2); + Op2(opSUB, reg1 * 256, reg2); + drop; + drop; + ASSERT(REG.GetReg(R, reg2)) + END + + |IL.opLADR_SAVEC: + Op2(opMOV, imm(param2), dst_x(param1 * 2, BP)) + + |IL.opLADR_SAVE: + UnOp(reg1); + Op2(opMOV, reg1 * 256, dst_x(param2 * 2, BP)); + drop + + |IL.opGADR_SAVEC: + Op2(opMOV, imm(param2), dst_x(param1, SR)); + Reloc(RBSS) + + |IL.opCONST_PARAM: + PushImm(param2) + + |IL.opPARAM: + IF param2 = 1 THEN + UnOp(reg1); + Push(reg1); + drop + ELSE + ASSERT(R.top + 1 <= param2); + PushAll(param2) + END + + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + drop + ELSE + UnOp(reg1); + Op2(opCMP, imm(param2), reg1) + END; + + drop; + cc := cond(opcode); + + IF cmd.next(COMMAND).opcode = IL.opJE THEN + label := cmd.next(COMMAND).param1; + jcc(cc, label); + cmd := cmd.next(COMMAND) + + ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN + label := cmd.next(COMMAND).param1; + jcc(ORD(BITS(cc) / {0}), label); + cmd := cmd.next(COMMAND) + + ELSE + setcc(cc, GetAnyReg()) + END + + |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.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.opJE: + UnOp(reg1); + Test(reg1); + jcc(jne, param1); + drop + + |IL.opJNE: + UnOp(reg1); + Test(reg1); + jcc(je, param1); + drop + + |IL.opNOT: + UnOp(reg1); + Test(reg1); + setcc(je, reg1) + + |IL.opORD: + UnOp(reg1); + Test(reg1); + setcc(jne, reg1) + + |IL.opLOOP: + |IL.opENDLOOP: + + |IL.opGET: + BinOp(reg1, reg2); + drop; + drop; + Op2(opMOV + bw(param2 = 1), indir(reg1), dst_x(0, reg2)) + + |IL.opGETC: + UnOp(reg2); + drop; + Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) + + |IL.opCHKIDX: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + jcc(jb, param1) + + |IL.opCHKIDX2: + BinOp(reg1, reg2); + IF param2 # -1 THEN + Op2(opCMP, reg1 * 256, reg2); + MovRR(reg2, reg1); + drop; + jcc(jb, param1) + ELSE + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 + END + + |IL.opINCC, IL.opINCCB: + UnOp(reg1); + Op2(opADD + bw(opcode = IL.opINCCB), imm(param2), dst_x(0, reg1)); + drop + + |IL.opDECCB: + UnOp(reg1); + Op2(opSUB + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opINC, IL.opINCB: + BinOp(reg1, reg2); + Op2(opADD + bw(opcode = IL.opINCB), reg1 * 256, dst_x(0, reg2)); + drop; + drop + + |IL.opDEC, IL.opDECB: + BinOp(reg1, reg2); + Op2(opSUB + bw(opcode = IL.opDECB), reg1 * 256, dst_x(0, reg2)); + drop; + drop + + |IL.opLADR_INCC, IL.opLADR_INCCB: + Op2(opADD + bw(opcode = IL.opLADR_INCCB), imm(param2), dst_x(param1 * 2, BP)) + + |IL.opLADR_DECCB: + Op2(opSUB + BW, imm(param2), dst_x(param1 * 2, BP)) + + |IL.opLADR_INC, IL.opLADR_INCB: + UnOp(reg1); + Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, dst_x(param2 * 2, BP)); + drop + + |IL.opLADR_DEC, IL.opLADR_DECB: + UnOp(reg1); + Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, dst_x(param2 * 2, BP)); + drop + + |IL.opPUSHT: + UnOp(reg1); + Op2(opMOV, src_x(-2, reg1), GetAnyReg()) + + |IL.opISREC: + PushAll(2); + PushImm(param2); + CallRTL(RTL._guardrec, 3); + GetRegA + + |IL.opIS: + PushAll(1); + PushImm(param2); + CallRTL(RTL._is, 2); + GetRegA + + |IL.opTYPEGR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + GetRegA + + |IL.opTYPEGP: + UnOp(reg1); + PushAll(0); + Push(reg1); + PushImm(param2); + CallRTL(RTL._guard, 2); + GetRegA + + |IL.opTYPEGD: + UnOp(reg1); + PushAll(0); + Op1(opPUSH, reg1, sIDX); + EmitWord(-2); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + GetRegA + + |IL.opMULS: + BinOp(reg1, reg2); + Op2(opAND, reg2 * 256, reg1); + drop + + |IL.opMULSC: + UnOp(reg1); + Op2(opAND, imm(param2), reg1) + + |IL.opDIVS: + BinOp(reg1, reg2); + Op2(opXOR, reg2 * 256, reg1); + drop + + |IL.opDIVSC: + UnOp(reg1); + Op2(opXOR, imm(param2), reg1) + + |IL.opADDS: + BinOp(reg1, reg2); + Op2(opBIS, reg2 * 256, reg1); + drop + + |IL.opSUBS: + BinOp(reg1, reg2); + Op2(opBIC, reg2 * 256, reg1); + drop + + |IL.opADDSL, IL.opADDSR: + UnOp(reg1); + Op2(opBIS, imm(param2), reg1) + + |IL.opSUBSL: + UnOp(reg1); + Op2(opXOR, imm(-1), reg1); + Op2(opAND, imm(param2), reg1) + + |IL.opSUBSR: + UnOp(reg1); + Op2(opBIC, imm(param2), reg1) + + |IL.opUMINS: + UnOp(reg1); + Op2(opXOR, imm(-1), reg1) + + |IL.opLENGTH: + PushAll(2); + CallRTL(RTL._length, 2); + GetRegA + + |IL.opMIN: + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + EmitWord(opJL + 1); (* jl L *) + MovRR(reg2, reg1); + (* L: *) + drop + + + |IL.opMAX: + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + EmitWord(opJGE + 1); (* jge L *) + MovRR(reg2, reg1); + (* L: *) + drop + + |IL.opMINC: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + L := NewLabel(); + jcc(jl, L); + Op2(opMOV, imm(param2), reg1); + EmitLabel(L) + + |IL.opMAXC: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + L := NewLabel(); + jcc(jge, L); + Op2(opMOV, imm(param2), reg1); + EmitLabel(L) + + |IL.opSWITCH: + UnOp(reg1); + IF param2 = 0 THEN + reg2 := ACC + ELSE + reg2 := R5 + END; + IF reg1 # reg2 THEN + ASSERT(REG.GetReg(R, reg2)); + ASSERT(REG.Exchange(R, reg1, reg2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + Op2(opCMP, imm(param1), ACC); + jcc(jl, param2) + + |IL.opCASER: + Op2(opCMP, imm(param1), ACC); + jcc(jg, param2) + + |IL.opCASELR: + Op2(opCMP, imm(param1), ACC); + jcc(jl, param2); + jcc(jg, cmd.param3) + + |IL.opSBOOL: + BinOp(reg2, reg1); + Test(reg2); + setcc(jne, reg2); + Op2(opMOV + BW, reg2 * 256, dst_x(0, reg1)); + drop; + drop + + |IL.opSBOOLC: + UnOp(reg1); + Op2(opMOV + BW, imm(param2), dst_x(0, reg1)); + drop + + |IL.opODD: + UnOp(reg1); + Op2(opAND, imm(1), reg1) + + |IL.opEQS .. IL.opGES: + PushAll(4); + PushImm((opcode - IL.opEQS) * 12); + CallRTL(RTL._strcmp, 5); + GetRegA + + |IL.opLEN: + UnOp(reg1); + drop; + EXCL(R.regs, reg1); + + WHILE param2 > 0 DO + UnOp(reg2); + drop; + DEC(param2) + END; + + 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 + |IL.opLSL: CallRTL(RTL._lsl, 2) + |IL.opASR: CallRTL(RTL._asr, 2) + |IL.opROR: CallRTL(RTL._ror, 2) + |IL.opLSR: CallRTL(RTL._lsr, 2) + END; + GetRegA + + |IL.opLSL1, IL.opASR1, IL.opROR1, IL.opLSR1: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CASE opcode OF + |IL.opLSL1: CallRTL(RTL._lsl, 2) + |IL.opASR1: CallRTL(RTL._asr, 2) + |IL.opROR1: CallRTL(RTL._ror, 2) + |IL.opLSR1: CallRTL(RTL._lsr, 2) + END; + GetRegA + + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: + param2 := param2 MOD 16; + IF param2 # 0 THEN + UnOp(reg1); + Shift2(opcode, reg1, param2) + END + + |IL.opMUL: + PushAll(2); + CallRTL(RTL._mul, 2); + GetRegA + + |IL.opMULC: + UnOp(reg1); + + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + Neg(reg1) + ELSIF a = 0 THEN + Clear(reg1) + ELSE + IF n > 0 THEN + IF a < 0 THEN + Neg(reg1) + END; + Shift2(IL.opLSL2, reg1, n) + ELSE + PushAll(1); + PushImm(a); + CallRTL(RTL._mul, 2); + GetRegA + END + END + + |IL.opDIV: + PushAll(2); + CallRTL(RTL._divmod, 2); + GetRegA + + |IL.opDIVR: + ASSERT(param2 > 0); + + IF param2 > 1 THEN + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(reg1); + Shift2(IL.opASR2, reg1, n) + ELSE + PushAll(1); + PushImm(param2); + CallRTL(RTL._divmod, 2); + GetRegA + END + END + + |IL.opDIVL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._divmod, 2); + GetRegA + + |IL.opMOD: + PushAll(2); + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + + |IL.opMODR: + ASSERT(param2 > 0); + + IF param2 = 1 THEN + UnOp(reg1); + Clear(reg1) + ELSE + IF UTILS.Log2(param2) > 0 THEN + UnOp(reg1); + Op2(opAND, imm(param2 - 1), reg1) + ELSE + PushAll(1); + PushImm(param2); + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + END + END + + |IL.opMODL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._divmod, 2); + ASSERT(REG.GetReg(R, R5)) + + |IL.opCOPYS: + ASSERT(R.top = 3); + Push(R.stk[2]); + Push(R.stk[0]); + Op2(opCMP, R.stk[1] * 256, R.stk[3]); + EmitWord(3801H); (* JL L1 *) + MovRR(R.stk[1], R.stk[3]); + (* L1: *) + Push(R.stk[3]); + drop; + drop; + drop; + drop; + CallRTL(RTL._move, 3) + + |IL.opCOPY: + PushAll(2); + PushImm(param2); + CallRTL(RTL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(RTL._move, 3) + + |IL.opCOPYA: + PushAll(4); + PushImm(param2); + CallRTL(RTL._arrcpy, 5); + GetRegA + + |IL.opROT: + PushAll(0); + MovRR(SP, ACC); + Push(ACC); + PushImm(param2); + CallRTL(RTL._rot, 2) + + |IL.opSAVES: + UnOp(reg1); + PushAll_1; + Op1(opPUSH, PC, sINCR); + EmitWord(param2); + Reloc(RDATA); + Push(reg1); + drop; + PushImm(param1); + CallRTL(RTL._move, 3) + + |IL.opCASET: + Push(R5); + Push(R5); + PushImm(param2); + CallRTL(RTL._guardrec, 2); + Pop(R5); + Test(ACC); + jcc(jne, param1) + + |IL.opCHR: + UnOp(reg1); + Op2(opAND, imm(255), reg1) + + |IL.opABS: + UnOp(reg1); + Test(reg1); + L := NewLabel(); + jcc(jge, L); + Neg(reg1); + EmitLabel(L) + + |IL.opEQB, IL.opNEB: + BinOp(reg1, reg2); + drop; + + Test(reg1); + L := NewLabel(); + jcc(je, L); + Op2(opMOV, imm(1), reg1); + EmitLabel(L); + + Test(reg2); + L := NewLabel(); + jcc(je, L); + Op2(opMOV, imm(1), reg2); + EmitLabel(L); + + Op2(opCMP, reg2 * 256, reg1); + IF opcode = IL.opEQB THEN + setcc(je, reg1) + ELSE + setcc(jne, reg1) + END + + |IL.opSAVEP: + UnOp(reg1); + Op2(opMOV, incr(PC), reg1 + dIDX); + EmitWord(param2); + Reloc(RCODE); + EmitWord(0); + drop + + |IL.opPUSHP: + Op2(opMOV, incr(PC), GetAnyReg()); + EmitWord(param2); + Reloc(RCODE) + + |IL.opEQP, IL.opNEP: + UnOp(reg1); + Op2(opCMP, incr(PC), reg1); + EmitWord(param1); + Reloc(RCODE); + drop; + reg1 := GetAnyReg(); + + IF opcode = IL.opEQP THEN + setcc(je, reg1) + ELSIF opcode = IL.opNEP THEN + setcc(jne, reg1) + END + + |IL.opVADR_PARAM: + Op1(opPUSH, BP, sIDX); + EmitWord(param2 * 2) + + |IL.opNEW: + PushAll(1); + n := param2 + 2; + ASSERT(UTILS.Align(n, 2)); + PushImm(n); + PushImm(param1); + CallRTL(RTL._new, 3) + + |IL.opRSET: + PushAll(2); + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSETR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSETL: + UnOp(reg1); + PushAll_1; + PushImm(param2); + Push(reg1); + drop; + CallRTL(RTL._set, 2); + GetRegA + + |IL.opRSET1: + PushAll(1); + CallRTL(RTL._set1, 1); + GetRegA + + |IL.opINCLC: + UnOp(reg1); + Op2(opBIS, imm(ORD({param2})), dst_x(0, reg1)); + drop + + |IL.opEXCLC: + UnOp(reg1); + Op2(opBIC, imm(ORD({param2})), dst_x(0, reg1)); + drop + + |IL.opIN: + PushAll(2); + CallRTL(RTL._in, 2); + GetRegA + + |IL.opINR: + PushAll(1); + PushImm(param2); + CallRTL(RTL._in, 2); + GetRegA + + |IL.opINL: + PushAll(1); + PushImm(param2); + CallRTL(RTL._in2, 2); + GetRegA + + |IL.opINCL: + PushAll(2); + CallRTL(RTL._incl, 2) + + |IL.opEXCL: + PushAll(2); + CallRTL(RTL._excl, 2) + + |IL.opLADR_INCL, IL.opLADR_EXCL: + PushAll(1); + MovRR(BP, ACC); + Op2(opADD, imm(param2 * 2), ACC); + Push(ACC); + IF opcode = IL.opLADR_INCL THEN + CallRTL(RTL._incl, 2) + ELSIF opcode = IL.opLADR_EXCL THEN + CallRTL(RTL._excl, 2) + END + + |IL.opLADR_INCLC: + Op2(opBIS, imm(ORD({param2})), dst_x(param1 * 2, BP)) + + |IL.opLADR_EXCLC: + Op2(opBIC, imm(ORD({param2})), dst_x(param1 * 2, BP)) + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog (ramSize: INTEGER); +VAR + i: INTEGER; + +BEGIN + RTL.Init(EmitLabel, EmitWord, EmitCall, ramSize); + FOR i := 0 TO LEN(RTL.rtl) - 1 DO + RTL.Set(i, NewLabel()) + END; + + IV[LEN(IV) - 1] := NewLabel(); + EmitLabel(IV[LEN(IV) - 1]); + Op2(opMOV, incr(PC), SP); + EmitWord(0); + Op2(opMOV, incr(PC), HP); + EmitWord(0); + Op2(opMOV, imm(5A80H), dst_x(0120H, SR)); (* stop WDT *) + Op2(opMOV, imm(RTL.empty_proc), dst_x(RTL.int, SR)); + Op2(opMOV, imm(0), dst_x(RTL.trap, SR)) +END prolog; + + +PROCEDURE epilog; +VAR + L1, i: INTEGER; + +BEGIN + Op2(opBIS, imm(10H), SR); (* CPUOFF *) + + L1 := NewLabel(); + FOR i := 0 TO LEN(IV) - 2 DO + IV[i] := NewLabel(); + EmitLabel(IV[i]); + PushImm(i); + IF i # LEN(IV) - 2 THEN + EmitJmp(opJMP, L1) + END + END; + + EmitLabel(L1); + + MovRR(SP, IR); + + FOR i := 0 TO 15 DO + IF i IN R.regs + R.vregs THEN + Push(i) + END + END; + + Push(IR); + Op1(opPUSH, IR, sINDIR); + Op1(opCALL, SR, sIDX); + EmitWord(RTL.int); + Op2(opADD, imm(4), SP); + + FOR i := 15 TO 0 BY -1 DO + IF i IN R.regs + R.vregs THEN + Pop(i) + END + END; + + Op2(opADD, imm(2), SP); + Op1(opRETI, 0, 0); + + RTL.Gen +END epilog; + + +PROCEDURE hexdgt (n: BYTE): BYTE; +BEGIN + IF n < 10 THEN + n := n + ORD("0") + ELSE + n := n - 10 + ORD("A") + END + + RETURN n +END hexdgt; + + +PROCEDURE WriteHexByte (file: FILES.FILE; byte: BYTE); +BEGIN + WRITER.WriteByte(file, hexdgt(byte DIV 16)); + WRITER.WriteByte(file, hexdgt(byte MOD 16)); +END WriteHexByte; + + +PROCEDURE WriteHex (file: FILES.FILE; mem: ARRAY OF BYTE; idx, cnt: INTEGER); +VAR + i, len, chksum: INTEGER; + +BEGIN + WHILE cnt > 0 DO + len := MIN(cnt, 16); + chksum := len + idx DIV 256 + idx MOD 256; + WRITER.WriteByte(file, ORD(":")); + WriteHexByte(file, len); + WriteHexByte(file, idx DIV 256); + WriteHexByte(file, idx MOD 256); + WriteHexByte(file, 0); + FOR i := 1 TO len DO + WriteHexByte(file, mem[idx]); + INC(chksum, mem[idx]); + INC(idx) + END; + WriteHexByte(file, (-chksum) MOD 256); + DEC(cnt, len); + WRITER.WriteByte(file, 0DH); + WRITER.WriteByte(file, 0AH) + END +END WriteHex; + + +PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +VAR + i, adr, heap, stack, TextSize, TypesSize, bits, n: INTEGER; + + Code, Data, Bss, Free: RECORD address, size: INTEGER END; + + ram, rom: INTEGER; + + reloc: RELOC; + + file: FILES.FILE; + +BEGIN + IdxWords.src := NOWORD; + IdxWords.dst := NOWORD; + + ram := options.ram; + rom := options.rom; + + IF ODD(ram) THEN DEC(ram) END; + IF ODD(rom) THEN DEC(rom) END; + + ram := MIN(MAX(ram, minRAM), maxRAM); + rom := MIN(MAX(rom, minROM), maxROM); + + IF code.bss > ram - minStackSize - RTL.VarSize THEN + ERRORS.Error(204) + END; + + Labels := CHL.CreateIntList(); + FOR i := 1 TO code.lcount DO + CHL.PushInt(Labels, 0) + END; + + FOR i := 0 TO LEN(mem) - 1 DO + mem[i] := 0 + END; + + TypesSize := CHL.Length(code.types) * 2; + CodeList := LISTS.create(NIL); + RelList := LISTS.create(NIL); + REG.Init(R, Push, Pop, mov, xchg, NIL, NIL, {R4, R5, R6, R7}, {}); + + prolog(ram); + translate(code); + epilog; + + Code.address := 10000H - rom; + Code.size := Fixup(Code.address, IntVectorSize + TypesSize); + Data.address := Code.address + Code.size; + Data.size := CHL.Length(code.data); + Data.size := Data.size + ORD(ODD(Data.size)); + TextSize := Code.size + Data.size; + + IF Code.address + TextSize + MAX(code.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN + ERRORS.Error(203) + END; + + Bss.address := RTL.ram + RTL.VarSize; + Bss.size := code.bss + ORD(ODD(code.bss)); + heap := Bss.address + Bss.size; + stack := RTL.ram + ram; + ASSERT(stack - heap >= minStackSize); + adr := Code.address + 2; + PutWord(stack, adr); + adr := Code.address + 6; + PutWord(heap, adr); + + reloc := RelList.first(RELOC); + WHILE reloc # NIL DO + adr := reloc.WordPtr.offset * 2; + CASE reloc.section OF + |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; + + adr := Data.address; + + FOR i := 0 TO CHL.Length(code.data) - 1 DO + mem[adr] := CHL.GetByte(code.data, i); + INC(adr) + END; + + adr := 10000H - IntVectorSize - TypesSize; + + FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO + PutWord(CHL.GetInt(code.types, i), adr) + END; + + FOR i := 0 TO 15 DO + PutWord((33 - i) * i, adr); + END; + + FOR n := 0 TO 15 DO + bits := ORD({0 .. n}); + FOR i := 0 TO 15 - n DO + PutWord(bits, adr); + bits := LSL(bits, 1) + END + END; + + Free.address := Code.address + TextSize; + Free.size := rom - (IntVectorSize + TypesSize + TextSize); + + PutWord(Free.address, adr); + PutWord(Free.size, adr); + PutWord(4130H, adr); (* RET *) + PutWord(stack, adr); + + FOR i := 0 TO LEN(IV) - 1 DO + PutWord(LabelOffs(IV[i]) * 2, adr) + END; + + file := FILES.create(outname); + WriteHex(file, mem, Code.address, TextSize); + WriteHex(file, mem, 10000H - IntVectorSize - TypesSize, IntVectorSize + TypesSize); + + WRITER.WriteByte(file, ORD(":")); + WriteHexByte(file, 0); + WriteHexByte(file, 0); + WriteHexByte(file, 0); + WriteHexByte(file, 1); + WriteHexByte(file, 255); + WRITER.WriteByte(file, 0DH); + WRITER.WriteByte(file, 0AH); + + FILES.close(file); + + INC(TextSize, IntVectorSize + TypesSize); + INC(Bss.size, minStackSize + RTL.VarSize); + + C.StringLn("--------------------------------------------"); + C.String( " rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); + IF Free.size > 0 THEN + C.String( " "); C.Int(Free.size); C.String(" bytes free (0"); + C.Hex(Free.address, 4); C.String("H..0"); C.Hex(Free.address + Free.size - 1, 4); C.StringLn("H)") + END; + C.Ln; + C.String( " ram: "); C.Int(Bss.size); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(Bss.size * 100 DIV ram); C.StringLn("%)"); + C.StringLn("--------------------------------------------") + +END CodeGen; + + +END MSP430. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MSP430RTL.ob07 b/programs/develop/oberon07/Source/MSP430RTL.ob07 new file mode 100644 index 0000000000..86e4278c2f --- /dev/null +++ b/programs/develop/oberon07/Source/MSP430RTL.ob07 @@ -0,0 +1,677 @@ +я╗┐(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE MSP430RTL; + + +CONST + + _mul* = 0; + _divmod* = 1; + _lsl* = 2; + _asr* = 3; + _ror* = 4; + _lsr* = 5; + _in* = 6; + _in2* = 7; + _set1* = 8; + _incl* = 9; + _excl* = 10; + _move* = 11; + _set* = 12; + _arrcpy* = 13; + _rot* = 14; + _strcmp* = 15; + _error* = 16; + _is* = 17; + _guard* = 18; + _guardrec* = 19; + _length* = 20; + _new* = 21; + + + HP = 14; + + LenIV* = 32; + + iv = 10000H - LenIV * 2; + sp = iv - 2; + empty_proc* = sp - 2; + free_size = empty_proc - 2; + free_adr = free_size - 2; + bits = free_adr - 272; + bits_offs = bits - 32; + DataSize* = iv - bits_offs; + types = bits_offs - 2; + + IntVectorSize* = LenIV * 2 + DataSize; + + VarSize* = 4; + + +TYPE + + EMITPROC = PROCEDURE (n: INTEGER); + + +VAR + + ram*, trap*, int*: INTEGER; + + rtl*: ARRAY 22 OF + RECORD + label*: INTEGER; + used: BOOLEAN + END; + + Label, Word, Call: EMITPROC; + + +PROCEDURE Gen*; + + + PROCEDURE Word1 (word: INTEGER); + BEGIN + Word(word) + END Word1; + + + PROCEDURE Word2 (word1, word2: INTEGER); + BEGIN + Word1(word1); + Word1(word2) + END Word2; + + + PROCEDURE Word3 (word1, word2, word3: INTEGER); + BEGIN + Word1(word1); + Word1(word2); + Word1(word3) + END Word3; + + +BEGIN + (* _lsl (n, x: INTEGER): INTEGER *) + IF rtl[_lsl].used THEN + Label(rtl[_lsl].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 3); (* JZ L1 *) + (* L2: *) + Word1(5404H); (* ADD R4, R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 3); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _asr (n, x: INTEGER): INTEGER *) + IF rtl[_asr].used THEN + Label(rtl[_asr].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 3); (* JZ L1 *) + (* L2: *) + Word1(1104H); (* RRA R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 3); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _ror (n, x: INTEGER): INTEGER *) + IF rtl[_ror].used THEN + Label(rtl[_ror].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 5); (* JZ L1 *) + Word1(4406H); (* MOV R4, R6 *) + (* L2: *) + Word1(1006H); (* RRC R6 *) + Word1(1004H); (* RRC R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 4); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _lsr (n, x: INTEGER): INTEGER *) + IF rtl[_lsr].used THEN + Label(rtl[_lsr].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 4); (* JZ L1 *) + (* L2: *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1004H); (* RRC R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 4); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _set (b, a: INTEGER): SET *) + IF rtl[_set].used THEN + Label(rtl[_set].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) + Word1(9504H); (* CMP R5, R4 *) + Word1(3800H + 24); (* JL L1 *) + Word2(9035H, 16); (* CMP #16, R5 *) + Word1(3400H + 21); (* JGE L1 *) + Word1(9304H); (* CMP #0, R4 *) + Word1(3800H + 19); (* JL L1 *) + Word2(9034H, 16); (* CMP #16, R4 *) + Word1(3800H + 2); (* JL L2 *) + Word2(4034H, 15); (* MOV #15, R4 *) + (* L2: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(3400H + 1); (* JGE L3 *) + Word1(4305H); (* MOV #0, R5 *) + (* L3: *) + Word1(8504H); (* SUB R5, R4 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits_offs); (* ADD bits_offs, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word1(5505H); (* ADD R5, R5 *) + Word1(5405H); (* ADD R4, R5 *) + Word2(5035H, bits); (* ADD bits, R5 *) + Word1(4524H); (* MOV @R5, R4 *) + Word1(4130H); (* MOV @SP+, PC *) + (* L1: *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _set1 (a: INTEGER): SET *) + IF rtl[_set1].used THEN + Label(rtl[_set1].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 5); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word1(4130H); (* MOV @SP+, PC *) + (* L1: *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _in2 (i, s: INTEGER): BOOLEAN *) + IF rtl[_in2].used THEN + Label(rtl[_in2].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(0F114H, 4); (* AND 4(SP), R4 *) + Word1(2400H + 1); (* JZ L1 *) + Word1(4314H); (* MOV #1, R4 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _in (s, i: INTEGER): BOOLEAN *) + IF rtl[_in].used THEN + Label(rtl[_in].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 9); (* JNZ L2 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(0F114H, 2); (* AND 2(SP), R4 *) + Word1(2400H + 3); (* JZ L1 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H); (* MOV @SP+, PC *) + (* L2: *) + Word1(4304H); (* MOV #0, R4 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _incl (VAR s: SET; i: INTEGER) *) + IF rtl[_incl].used THEN + Label(rtl[_incl].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 8); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) + Word2(0D485H, 0); (* BIS R4, 0(R5) *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _excl (VAR s: SET; i: INTEGER) *) + IF rtl[_excl].used THEN + Label(rtl[_excl].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 8); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) + Word2(0C485H, 0); (* BIC R4, 0(R5) *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _rot (len, adr: INTEGER) *) + IF rtl[_rot].used THEN + Label(rtl[_rot].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *) + Word1(8314H); (* SUB #1, R4 *) + Word1(5404H); (* ADD R4, R4 *) + Word1(1225H); (* PUSH @R5 *) + Word1(4406H); (* MOV R4, R6 *) + (* L1: *) + Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *) + Word1(5325H); (* ADD #2, R5 *) + Word1(8326H); (* SUB #2, R6 *) + Word1(2000H + 400H - 6); (* JNZ L1 *) + Word2(41B5H, 0); (* MOV @SP+, 0(R5) *) + Word1(4130H) (* RET *) + END; + + (* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *) + IF rtl[_divmod].used THEN + Label(rtl[_divmod].label); + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) + Word1(4304H); (* MOV #0, R4 *) + (* L1: *) + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 17); (* JL L3 *) + Word1(4327H); (* MOV #2, R7 *) + Word1(5606H); (* ADD R6, R6 *) + (* L4: *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 6); (* JZ L2 *) + Word1(3800H + 5); (* JL L2 *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 3); (* JL L2 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(5707H); (* ADD R7, R7 *) + Word1(3C00H + 400H - 8); (* JMP L4 *) + (* L2: *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1007H); (* RRC R7 *) + Word1(8605H); (* SUB R6, R5 *) + Word1(5704H); (* ADD R7, R4 *) + Word1(3C00H + 400H - 21); (* JMP L1 *) + (* L3: *) + (*----------- (a < 0) --------------*) + (* L1: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(3400H + 23); (* JGE L3 *) + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) + Word1(4327H); (* MOV #2, R7 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + (* L4: *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 6); (* JZ L2 *) + Word1(3800H + 5); (* JL L2 *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 3); (* JL L2 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(5707H); (* ADD R7, R7 *) + Word1(3C00H + 400H - 8); (* JMP L4 *) + (* L2: *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1007H); (* RRC R7 *) + Word1(5605H); (* ADD R6, R5 *) + Word1(8704H); (* SUB R7, R4 *) + Word1(3C00H + 400H - 25); (* JMP L1 *) + (* L3: *) + Word1(4130H) (* RET *) + END; + + (* _mul (a, b: INTEGER): INTEGER *) + IF rtl[_mul].used THEN + Label(rtl[_mul].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *) + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *) + Word1(4304H); (* MOV #0, R4; res := 0 *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 7); (* JZ L1 *) + (* L2: *) + Word1(0B316H); (* BIT #1, R6 *) + Word1(2400H + 1); (* JZ L3 *) + Word1(5504H); (* ADD R5, R4 *) + (* L3: *) + Word1(5505H); (* ADD R5, R5 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(2000H + 400H - 7); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _error (module, err, line: INTEGER) *) + IF rtl[_error].used THEN + Label(rtl[_error].label); + Word1(0C232H); (* BIC #8, SR; DINT *) + Word1(4303H); (* MOV R3, R3; NOP *) + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- module *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- err *) + Word2(4116H, 6); (* MOV 6(SP), R6; R6 <- line *) + Word2(4211H, sp); (* MOV sp(SR), SP *) + Word1(1206H); (* PUSH R6 *) + Word1(1204H); (* PUSH R4 *) + Word1(1205H); (* PUSH R5 *) + Word2(4214H, trap); (* MOV trap(SR), R4 *) + Word1(9304H); (* TST R4 *) + Word1(2400H + 1); (* JZ L *) + Word1(1284H); (* CALL R4 *) + (* L: *) + Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *) + END; + + (* _new (t, size: INTEGER; VAR ptr: INTEGER) *) + IF rtl[_new].used THEN + Label(rtl[_new].label); + Word1(1202H); (* PUSH SR *) + Word1(4302H); (* MOV #0, SR *) + Word1(4303H); (* NOP *) + Word1(4104H); (* MOV SP, R4 *) + Word2(8034H, 16); (* SUB #16, R4 *) + Word1(4005H + 100H * HP); (* MOV HP, R5 *) + Word2(5115H, 6); (* ADD 6(SP), R5 *) + Word1(9504H); (* CMP R5, R4 *) + Word2(4114H, 8); (* MOV 8(SP), R4 *) + Word1(3800H + 12); (* JL L1 *) + Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *) + Word1(5320H + HP); (* ADD #2, HP *) + Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *) + (* L3 *) + Word2(4380H + HP, 0); (* MOV #0, 0(HP) *) + Word1(5320H + HP); (* ADD #2, HP *) + Word1(9500H + HP); (* CMP R5, HP *) + Word1(3800H + 400H - 5); (* JL L3 *) + Word1(3C00H + 2); (* JMP L2 *) + (* L1 *) + Word2(4384H, 0); (* MOV #0, 0(R4) *) + (* L2 *) + Word1(1300H) (* RETI *) + END; + + (* _guardrec (t0, t1: INTEGER): INTEGER *) + IF rtl[_guardrec].used THEN + Label(rtl[_guardrec].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *) + Word2(4036H, types); (* MOV #types, R6 *) + (* L3: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(2400H + 8); (* JZ L1 *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 10); (* JZ L2 *) + Word1(5505H); (* ADD R5, R5 *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + Word1(5605H); (* ADD R6, R5 *) + Word1(4525H); (* MOV @R5, R5 *) + Word1(3C00H + 400H - 10); (* JMP L3 *) + (* L1: *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 2); (* JZ L2 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H); (* MOV @SP+, PC *) + (* L2: *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H) (* RET *) + END; + + (* _is (t, p: INTEGER): INTEGER *) + IF rtl[_is].used THEN + Label(rtl[_is].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *) + Word1(9304H); (* TST R4 *) + Word1(2400H + 2); (* JZ L *) + Word2(4414H, -2); (* MOV -2(R4), R4 *) + (* L: *) + Word1(1204H); (* PUSH R4 *) + Word1(1205H); (* PUSH R5 *) + Call(rtl[_guardrec].label); (* CALL _guardrec *) + Word1(5221H); (* ADD #4, SP *) + Word1(4130H) (* RET *) + END; + + (* _guard (t, p: INTEGER): INTEGER *) + IF rtl[_guard].used THEN + Label(rtl[_guard].label); + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4525H); (* MOV @R5, R5 *) + Word1(9305H); (* TST R5 *) + Word1(2400H + 9); (* JZ L *) + Word2(4515H, -2); (* MOV -2(R5), R5 *) + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *) + Word1(1205H); (* PUSH R5 *) + Word1(1204H); (* PUSH R4 *) + Call(rtl[_guardrec].label); (* CALL _guardrec *) + Word1(5221H); (* ADD #4, SP *) + (* L: *) + Word1(4130H) (* RET *) + END; + + (* _move (bytes, dest, source: INTEGER) *) + IF rtl[_move].used THEN + Label(rtl[_move].label); + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *) + Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *) + Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *) + Word1(9306H); (* CMP #0, R6 *) + Word1(3800H + 6); (* JL L1 *) + Word1(2400H + 5); (* JZ L1 *) + (* L2: *) + Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *) + Word1(5317H); (* ADD #1, R7 *) + Word1(8316H); (* SUB #1, R6 *) + Word1(2000H + 400H - 5); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *) + IF rtl[_arrcpy].used THEN + Label(rtl[_arrcpy].label); + Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *) + Word1(3800H + 18); (* JL L1 *) + Word2(1211H, 12); (* PUSH 12(SP) *) + Word2(1211H, 10); (* PUSH 10(SP) *) + Word2(1211H, 14); (* PUSH 14(SP) *) + Word2(1211H, 10); (* PUSH 10(SP) *) + Call(rtl[_mul].label); (* CALL _mul *) + Word1(5221H); (* ADD #4, SP *) + Word1(1204H); (* PUSH R4 *) + Call(rtl[_move].label); (* CALL _move *) + Word2(5031H, 6); (* ADD #6, SP *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H); (* RET *) + (* L1 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _length (len, str: INTEGER): INTEGER *) + IF rtl[_length].used THEN + Label(rtl[_length].label); + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *) + Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *) + Word1(4304H); (* MOV #0, R4; res := 0 *) + (* L2: *) + Word1(4775H); (* MOV.B @R7+, R5 *) + Word1(9305H); (* CMP #0, R5 *) + Word1(2400H + 3); (* JZ L1 *) + Word1(5314H); (* ADD #1, R4 *) + Word1(8316H); (* SUB #1, R6 *) + Word1(2000H + 400H - 6); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *) + IF rtl[_strcmp].used THEN + Label(rtl[_strcmp].label); + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) + Word1(9607H); (* CMP R6, R7 *) + Word1(3400H + 1); (* JGE L5 *) + Word1(4706H); (* MOV R7, R6 *) + (* L5: *) + Word1(1206H); (* PUSH R6 *) + Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *) + (* L3: *) + Word2(9381H, 0); (* CMP #0, 0(SP) *) + Word1(2400H + 11); (* JZ L1 *) + Word1(4674H); (* MOV.B @R6+, R4 *) + Word1(4775H); (* MOV.B @R7+, R5 *) + Word2(8391H, 0); (* SUB #1, 0(SP) *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 2); (* JZ L2 *) + Word1(8504H); (* SUB R5, R4 *) + Word1(3C00H + 5); (* JMP L4 *) + (* L2: *) + Word1(9304H); (* CMP #0, R4 *) + Word1(2000H + 400H - 13); (* JNZ L3 *) + Word1(3C00H + 2); (* JMP L4 *) + (* L1: *) + Word2(4034H, 8000H); (* MOV #8000H, R4 *) + (* L4: *) + Word1(5321H); (* ADD #2, SP *) + + Word2(9034H, 8000H); (* CMP #8000H, R4 *) + Word1(2000H + 18); (* JNZ L6 *) + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) + Word1(9607H); (* CMP R6, R7 *) + Word1(2400H + 11); (* JZ L7 *) + Word1(3800H + 4); (* JL L8 *) + Word2(5116H, 10); (* ADD 10(SP), R6 *) + Word1(4664H); (* MOV.B @R6, R4 *) + Word1(3C00H + 7); (* JMP L6 *) + (* L8: *) + Word2(5117H, 6); (* ADD 6(SP), R7 *) + Word1(4764H); (* MOV.B @R7, R4 *) + Word1(0E334H); (* XOR #-1, R4 *) + Word1(5314H); (* ADD #1, R4 *) + Word1(3C00H + 1); (* JMP L6 *) + (* L7: *) + Word1(4304H); (* MOV #0, R4 *) + (* L6: *) + + Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(2400H + 1); (* JZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(2000H + 1); (* JNZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3800H + 1); (* JL L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3800H + 2); (* JL L *) + Word1(2400H + 1); (* JZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(3800H + 2); (* JL L *) + Word1(2400H + 1); (* JZ L *) + Word1(4314H); (* MOV #1, R4 *) + (* L *) + Word1(4130H); (* RET *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3400H + 1); (* JGE L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H) (* RET *) + END + +END Gen; + + +PROCEDURE Set* (idx, label: INTEGER); +BEGIN + rtl[idx].label := label; + rtl[idx].used := FALSE +END Set; + + +PROCEDURE Used* (idx: INTEGER); +BEGIN + rtl[idx].used := TRUE; + IF (idx = _guard) OR (idx = _is) THEN + rtl[_guardrec].used := TRUE + ELSIF idx = _arrcpy THEN + rtl[_move].used := TRUE; + rtl[_mul].used := TRUE + END +END Used; + + +PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC; ramSize: INTEGER); +BEGIN + Label := pLabel; + Word := pWord; + Call := pCall; + + IF ramSize > 2048 THEN + ram := 1100H + ELSE + ram := 200H + END; + trap := ram; + int := trap + 2 +END Init; + + +END MSP430RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PARS.ob07 b/programs/develop/oberon07/Source/PARS.ob07 index 136988f316..3f183a2c18 100644 --- a/programs/develop/oberon07/Source/PARS.ob07 +++ b/programs/develop/oberon07/Source/PARS.ob07 @@ -7,7 +7,7 @@ MODULE PARS; -IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS; +IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS; CONST @@ -24,6 +24,12 @@ TYPE PARSER* = POINTER TO rPARSER; + POSITION* = RECORD (SCAN.POSITION) + + parser*: PARSER + + END; + EXPR* = RECORD obj*: INTEGER; @@ -37,7 +43,7 @@ TYPE STATPROC = PROCEDURE (parser: PARSER); EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR); - RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; + RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN; rPARSER = RECORD (C.ITEM) @@ -67,7 +73,7 @@ TYPE VAR - program*: PROG.PROGRAM; + program*: PROG.PROGRAM; parsers: C.COLLECTION; @@ -83,34 +89,40 @@ BEGIN END destroy; -PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); +PROCEDURE getpos (parser: PARSER; VAR pos: POSITION); BEGIN - ERRORS.errormsg(parser.fname, pos.line, pos.col, errno) + pos.line := parser.lex.pos.line; + pos.col := parser.lex.pos.col; + pos.parser := parser +END getpos; + + +PROCEDURE error* (pos: POSITION; errno: INTEGER); +BEGIN + ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno) END error; -PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); +PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER); BEGIN IF ~condition THEN - error(parser, pos, errno) + error(pos, errno) END END check; PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER); +VAR + pos: POSITION; + BEGIN IF ~condition THEN - error(parser, parser.lex.pos, errno) + getpos(parser, pos); + error(pos, errno) END END check1; -PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION); -BEGIN - pos := parser.lex.pos -END getpos; - - PROCEDURE Next* (parser: PARSER); VAR errno: INTEGER; @@ -118,6 +130,14 @@ VAR BEGIN SCAN.Next(parser.scanner, parser.lex); errno := parser.lex.error; + IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN + IF parser.lex.sym = SCAN.lxFLOAT THEN + errno := -SCAN.lxERROR13 + ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN + errno := -SCAN.lxERROR10 + END + END; + IF errno # 0 THEN check1(FALSE, parser, errno) END; @@ -125,10 +145,10 @@ BEGIN END Next; -PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION); +PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION); BEGIN Next(parser); - pos := parser.lex.pos + getpos(parser, pos) END NextPos; @@ -178,17 +198,14 @@ END ExpectSym; PROCEDURE ImportList (parser: PARSER); VAR - name: SCAN.IDENT; - parser2: PARSER; - pos: SCAN.POSITION; - alias: BOOLEAN; - unit: PROG.UNIT; - ident: PROG.IDENT; - units: PROG.UNITS; + name: SCAN.IDENT; + parser2: PARSER; + pos: POSITION; + alias: BOOLEAN; + unit: PROG.UNIT; + ident: PROG.IDENT; BEGIN - units := program.units; - alias := FALSE; REPEAT @@ -199,18 +216,18 @@ BEGIN getpos(parser, pos); IF ~alias THEN - ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE); - check(ident # NIL, parser, pos, 30) + ident := PROG.addIdent(parser.unit, name, PROG.idMODULE); + check(ident # NIL, pos, 30) END; Next(parser); IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN alias := FALSE; - unit := units.get(units, name); + unit := PROG.getUnit(program, name); IF unit # NIL THEN - check(unit.closed, parser, pos, 31) + check(unit.closed, pos, 31) ELSE parser2 := parser.create(parser.path, parser.lib_path, parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); @@ -220,9 +237,9 @@ BEGIN destroy(parser2); parser2 := parser.create(parser.lib_path, parser.lib_path, parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); - check(parser2.open(parser2, name.s), parser, pos, 29) + check(parser2.open(parser2, name.s), pos, 29) ELSE - check(FALSE, parser, pos, 29) + error(pos, 29) END END; @@ -257,7 +274,7 @@ VAR BEGIN ASSERT(parser.sym = SCAN.lxIDENT); - ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); + ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); IF ~forward THEN check1(ident # NIL, parser, 48) @@ -267,7 +284,7 @@ BEGIN unit := ident.unit; ExpectSym(parser, SCAN.lxPOINT); ExpectSym(parser, SCAN.lxIDENT); - ident := unit.idents.get(unit, parser.lex.ident, FALSE); + ident := PROG.getIdent(unit, parser.lex.ident, FALSE); check1((ident # NIL) & ident.export, parser, 48) END @@ -312,30 +329,29 @@ BEGIN END; ARITH.setbool(v, bool) - END strcmp; PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE); VAR e: EXPR; - pos: SCAN.POSITION; + pos: POSITION; BEGIN getpos(parser, pos); parser.constexp := TRUE; parser.expression(parser, e); parser.constexp := FALSE; - check(e.obj = eCONST, parser, pos, 62); + check(e.obj = eCONST, pos, 62); v := e.value END ConstExpression; PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_); VAR - name: SCAN.IDENT; - export: BOOLEAN; - pos: SCAN.POSITION; + name: SCAN.IDENT; + export: BOOLEAN; + pos: POSITION; BEGIN ASSERT(parser.sym = SCAN.lxIDENT); @@ -355,7 +371,7 @@ BEGIN Next(parser) END; - check(rec.fields.add(rec, name, export), parser, pos, 30); + check(PROG.addField(rec, name, export), pos, 30); IF parser.sym = SCAN.lxCOMMA THEN ExpectSym(parser, SCAN.lxIDENT) @@ -391,7 +407,7 @@ VAR exit := FALSE; WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO - check1(type.params.add(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) @@ -412,13 +428,13 @@ VAR t1 := t0; WHILE dim > 0 DO - t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit); + t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit); t1.base := t0; t0 := t1; DEC(dim) END; - type.params.set(type, t1); + PROG.setParams(type, t1); Next(parser); exit := TRUE ELSE @@ -449,7 +465,7 @@ BEGIN ExpectSym(parser, SCAN.lxIDENT); ident := QIdent(parser, FALSE); check1(ident.typ = PROG.idTYPE, parser, 68); - check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69); + 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) @@ -461,54 +477,83 @@ BEGIN END FormalParameters; -PROCEDURE sysflag (parser: PARSER): INTEGER; +PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER; VAR - res: INTEGER; + res, sf: INTEGER; BEGIN IF parser.lex.s = "stdcall" THEN - res := PROG.stdcall + sf := PROG.sf_stdcall ELSIF parser.lex.s = "stdcall64" THEN - res := PROG.stdcall64 + sf := PROG.sf_stdcall64 ELSIF parser.lex.s = "ccall" THEN - res := PROG.ccall + sf := PROG.sf_ccall ELSIF parser.lex.s = "ccall16" THEN - res := PROG.ccall16 + sf := PROG.sf_ccall16 ELSIF parser.lex.s = "win64" THEN - res := PROG.win64 + sf := PROG.sf_win64 ELSIF parser.lex.s = "systemv" THEN - res := PROG.systemv + sf := PROG.sf_systemv ELSIF parser.lex.s = "windows" THEN + sf := PROG.sf_windows + ELSIF parser.lex.s = "linux" THEN + sf := PROG.sf_linux + ELSIF parser.lex.s = "code" THEN + sf := PROG.sf_code + ELSIF parser.lex.s = "noalign" THEN + sf := PROG.sf_noalign + ELSE + check1(FALSE, parser, 124) + END; + + check1(sf IN program.target.sysflags, parser, 125); + + IF proc THEN + check1(sf IN PROG.proc_flags, parser, 123) + ELSE + check1(sf IN PROG.rec_flags, parser, 123) + END; + + CASE sf OF + |PROG.sf_stdcall: + res := PROG.stdcall + |PROG.sf_stdcall64: + res := PROG.stdcall64 + |PROG.sf_ccall: + res := PROG.ccall + |PROG.sf_ccall16: + res := PROG.ccall16 + |PROG.sf_win64: + res := PROG.win64 + |PROG.sf_systemv: + res := PROG.systemv + |PROG.sf_code: + res := PROG.code + |PROG.sf_windows: IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN res := PROG.stdcall ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN res := PROG.win64 - ELSE - check1(FALSE, parser, 118) END - ELSIF parser.lex.s = "linux" THEN - IF program.target.sys = mConst.Target_iELF32 THEN + |PROG.sf_linux: + IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN res := PROG.ccall16 - ELSIF program.target.sys = mConst.Target_iELF64 THEN + ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN res := PROG.systemv - ELSE - check1(FALSE, parser, 119) END - ELSIF parser.lex.s = "noalign" THEN + |PROG.sf_noalign: res := PROG.noalign - ELSE - res := 0 END RETURN res END sysflag; -PROCEDURE procflag (parser: PARSER; VAR import: CODE.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: SCAN.POSITION; + pos: POSITION; BEGIN @@ -518,12 +563,7 @@ BEGIN getpos(parser, pos); check1(parser.unit.sysimport, parser, 54); Next(parser); - call := sysflag(parser); - IF program.target.bit_depth = 64 THEN - check1(call IN PROG.callconv64, parser, 117) - ELSIF program.target.bit_depth = 32 THEN - check1(call IN PROG.callconv32, parser, 63) - END; + call := sysflag(parser, TRUE); Next(parser); IF parser.sym = SCAN.lxMINUS THEN Next(parser); @@ -539,20 +579,21 @@ BEGIN ExpectSym(parser, SCAN.lxSTRING); proc := parser.lex.s; Next(parser); - import := CODE.AddImp(dll, proc) + import := IL.AddImp(dll, proc) END; checklex(parser, SCAN.lxRSQUARE); Next(parser) ELSE - IF program.target.bit_depth = 32 THEN - call := PROG.default - ELSIF program.target.bit_depth = 64 THEN - call := PROG.default64 + CASE program.target.bit_depth OF + |16: call := PROG.default16 + |32: call := PROG.default32 + |64: call := PROG.default64 END END; IF import # NIL THEN - check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70) + check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32, + mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70) END RETURN call @@ -570,12 +611,12 @@ VAR typeSize: ARITH.VALUE; ident: PROG.IDENT; unit: PROG.UNIT; - pos, pos2: SCAN.POSITION; + pos, pos2: POSITION; fieldType: PROG.TYPE_; baseIdent: SCAN.IDENT; a, b: INTEGER; RecFlag: INTEGER; - import: CODE.IMPORT_PROC; + import: IL.IMPORT_PROC; BEGIN unit := parser.unit; @@ -604,11 +645,11 @@ BEGIN ConstExpression(parser, arrLen); - check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43); - check(ARITH.check(arrLen), parser, pos, 39); - check(ARITH.getInt(arrLen) > 0, parser, pos, 51); + check(arrLen.typ = ARITH.tINTEGER, pos, 43); + check(ARITH.check(arrLen), pos, 39); + check(ARITH.getInt(arrLen) > 0, pos, 51); - t := program.enterType(program, 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}) @@ -623,8 +664,8 @@ BEGIN a := t.length; b := t.base.size; - check(ARITH.mulInt(a, b), parser, pos2, 104); - check(ARITH.setInt(typeSize, a), parser, pos2, 104); + check(ARITH.mulInt(a, b), pos2, 104); + check(ARITH.setInt(typeSize, a), pos2, 104); t.size := a; t.closed := TRUE @@ -633,19 +674,14 @@ BEGIN getpos(parser, pos2); Next(parser); - t := program.enterType(program, PROG.tRECORD, 0, 0, unit); + t := PROG.enterType(program, PROG.tRECORD, 0, 0, unit); t.align := 1; IF parser.sym = SCAN.lxLSQUARE THEN check1(parser.unit.sysimport, parser, 54); Next(parser); - RecFlag := sysflag(parser); - IF RecFlag = PROG.noalign THEN - t.noalign := TRUE - ELSE - check1(FALSE, parser, 110) - END; - + RecFlag := sysflag(parser, FALSE); + t.noalign := RecFlag = PROG.noalign; ExpectSym(parser, SCAN.lxRSQUARE); Next(parser) END; @@ -657,14 +693,14 @@ BEGIN type(parser, t.base, {closed}); - check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52); + check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52); IF t.base.typ = PROG.tPOINTER THEN t.base := t.base.base; - check(t.base # NIL, parser, pos, 55) + check(t.base # NIL, pos, 55) END; - check(~t.base.noalign, parser, pos, 112); + check(~t.base.noalign, pos, 112); checklex(parser, SCAN.lxRROUND); Next(parser); @@ -684,7 +720,7 @@ BEGIN Next(parser); type(parser, fieldType, {closed}); - check(t.fields.set(t, fieldType), parser, pos2, 104); + check(PROG.setFields(t, fieldType), pos2, 104); IF (fieldType.align > t.align) & ~t.noalign THEN t.align := fieldType.align @@ -699,21 +735,21 @@ BEGIN t.closed := TRUE; - CODE.AddRec(t.base.num); + IL.AddRec(t.base.num); IF ~t.noalign THEN - check(MACHINE.Align(t.size, t.align), parser, pos2, 104); - check(ARITH.setInt(typeSize, t.size), parser, pos2, 104) + check(UTILS.Align(t.size, t.align), pos2, 104); + check(ARITH.setInt(typeSize, t.size), pos2, 104) END; checklex(parser, SCAN.lxEND); Next(parser) - ELSIF parser.sym = SCAN.lxPOINTER THEN + ELSIF parser.sym = SCAN.lxPOINTER THEN ExpectSym(parser, SCAN.lxTO); Next(parser); - t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); + t := PROG.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); t.align := program.target.adr; getpos(parser, pos); @@ -725,14 +761,14 @@ BEGIN type(parser, t.base, {forward}); IF t.base # NIL THEN - check(t.base.typ = PROG.tRECORD, parser, pos, 58) + check(t.base.typ = PROG.tRECORD, pos, 58) ELSE - unit.pointers.add(unit, t, baseIdent, pos) + PROG.frwPtr(unit, t, baseIdent, pos) END ELSIF parser.sym = SCAN.lxPROCEDURE THEN NextPos(parser, pos); - t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); + t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); t.align := program.target.adr; t.call := procflag(parser, import, FALSE); FormalParameters(parser, t) @@ -746,15 +782,15 @@ END type; PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT; VAR ident: PROG.IDENT; - pos: SCAN.POSITION; + pos: POSITION; BEGIN ASSERT(parser.sym = SCAN.lxIDENT); name := parser.lex.ident; getpos(parser, pos); - ident := parser.unit.idents.add(parser.unit, name, typ); - check(ident # NIL, parser, pos, 30); + ident := PROG.addIdent(parser.unit, name, typ); + check(ident # NIL, pos, 30); ident.pos := pos; Next(parser); @@ -770,9 +806,9 @@ END IdentDef; PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN); VAR - ident: PROG.IDENT; - name: SCAN.IDENT; - pos: SCAN.POSITION; + ident: PROG.IDENT; + name: SCAN.IDENT; + pos: POSITION; BEGIN IF const THEN @@ -787,12 +823,12 @@ BEGIN IF const THEN ConstExpression(parser, ident.value); IF ident.value.typ = ARITH.tINTEGER THEN - check(ARITH.check(ident.value), parser, pos, 39) + check(ARITH.check(ident.value), pos, 39) ELSIF ident.value.typ = ARITH.tREAL THEN - check(ARITH.check(ident.value), parser, pos, 40) + check(ARITH.check(ident.value), pos, 40) END; ident.typ := PROG.idCONST; - ident.type := program.getType(program, ident.value.typ) + ident.type := PROG.getType(program, ident.value.typ) ELSE type(parser, ident.type, {}) END; @@ -805,9 +841,9 @@ END ConstTypeDeclaration; PROCEDURE VarDeclaration (parser: PARSER); VAR - ident: PROG.IDENT; - name: SCAN.IDENT; - t: PROG.TYPE_; + ident: PROG.IDENT; + name: SCAN.IDENT; + t: PROG.TYPE_; BEGIN @@ -819,7 +855,7 @@ BEGIN ELSIF parser.sym = SCAN.lxCOLON THEN Next(parser); type(parser, t, {}); - parser.unit.setvars(parser.unit, t); + PROG.setVarsType(parser.unit, t); checklex(parser, SCAN.lxSEMI); Next(parser) ELSE @@ -835,6 +871,7 @@ PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN; VAR ptr: PROG.FRWPTR; endmod: BOOLEAN; + pos: POSITION; PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN; @@ -842,20 +879,24 @@ VAR proc: PROG.IDENT; endname, name: SCAN.IDENT; - param: LISTS.ITEM; + param: PROG.PARAM; unit: PROG.UNIT; ident: PROG.IDENT; e: EXPR; - pos: SCAN.POSITION; + pos, pos1, + pos2: POSITION; label: INTEGER; - enter: CODE.COMMAND; + enter: IL.COMMAND; call: INTEGER; t: PROG.TYPE_; - import: CODE.IMPORT_PROC; + import: IL.IMPORT_PROC; endmod, b: BOOLEAN; fparams: SET; variables: LISTS.LIST; int, flt: INTEGER; + comma: BOOLEAN; + code: ARITH.VALUE; + codeProc: BOOLEAN; BEGIN endmod := FALSE; @@ -865,6 +906,7 @@ VAR call := procflag(parser, import, TRUE); getpos(parser, pos); + pos1 := pos; checklex(parser, SCAN.lxIDENT); IF import # NIL THEN @@ -875,29 +917,56 @@ VAR proc := IdentDef(parser, PROG.idPROC, name) END; - check(unit.scope.open(unit, proc.proc), parser, pos, 116); + check(PROG.openScope(unit, proc.proc), pos, 116); - proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); + proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); t := proc.type; - t.align := program.target.adr; - t.call := call; + t.align := program.target.adr; + t.call := call; FormalParameters(parser, t); - + + codeProc := call IN {PROG.code, PROG._code}; + IF call IN {PROG.systemv, PROG._systemv} THEN - check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120) + check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120) END; - param := t.params.first; + param := t.params.first(PROG.PARAM); WHILE param # NIL DO - ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM); + ident := PROG.addIdent(unit, param.name, PROG.idPARAM); ASSERT(ident # NIL); - ident.type := param(PROG.PARAM).type; - ident.offset := param(PROG.PARAM).offset; - IF param(PROG.PARAM).vPar THEN + ident.type := param.type; + ident.offset := param.offset; + IF param.vPar THEN ident.typ := PROG.idVPAR END; - param := param.next + param := param.next(PROG.PARAM) + END; + + IF import = NIL THEN + label := IL.NewLabel(); + proc.proc.label := label + END; + + IF codeProc THEN + enter := IL.EnterC(label); + comma := FALSE; + WHILE (parser.sym # SCAN.lxSEMI) OR comma DO + getpos(parser, pos2); + ConstExpression(parser, code); + check(code.typ = ARITH.tINTEGER, pos2, 43); + IF program.target.sys # mConst.Target_iMSP430 THEN + check(ARITH.range(code, 0, 255), pos2, 42) + END; + IL.AddCmd(IL.opCODE, ARITH.getInt(code)); + comma := parser.sym = SCAN.lxCOMMA; + IF comma THEN + Next(parser) + ELSE + checklex(parser, SCAN.lxSEMI) + END + END END; checklex(parser, SCAN.lxSEMI); @@ -905,55 +974,64 @@ VAR IF import = NIL THEN - label := CODE.NewLabel(); - proc.proc.label := label; - IF parser.main & proc.export & program.dll THEN IF program.obj THEN - check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114) + check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114) END; - CODE.AddExp(label, proc.name.s); + IL.AddExp(label, proc.name.s); proc.proc.used := TRUE END; - b := DeclarationSequence(parser); + IF ~codeProc THEN + b := DeclarationSequence(parser) + END; program.locsize := 0; IF call IN {PROG._win64, PROG.win64} THEN - fparams := proc.type.params.getfparams(proc.type, 3, int, flt); - enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 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 := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); - enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size)) + 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 - enter := CODE.Enter(label, 0) + enter := IL.Enter(label, 0) END; proc.proc.enter := enter; - IF parser.sym = SCAN.lxBEGIN THEN + IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN Next(parser); parser.StatSeq(parser) END; - IF t.base # NIL THEN + IF ~codeProc & (t.base # NIL) THEN checklex(parser, SCAN.lxRETURN); NextPos(parser, pos); parser.expression(parser, e); - check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87) + check(parser.chkreturn(parser, e, t.base, pos), pos, 87) END; - proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), - t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); - enter.param2 := program.locsize; - checklex(parser, SCAN.lxEND) + IF ~codeProc THEN + 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 := program.locsize; + checklex(parser, SCAN.lxEND) + ELSE + proc.proc.leave := IL.LeaveC() + END; + + IF program.target.sys = mConst.Target_iMSP430 THEN + check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63) + END END; IF parser.sym = SCAN.lxEND THEN ExpectSym(parser, SCAN.lxIDENT); getpos(parser, pos); endname := parser.lex.ident; - IF import = NIL THEN - check(endname = name, parser, pos, 60); + IF ~codeProc & (import = NIL) THEN + check(endname = name, pos, 60); ExpectSym(parser, SCAN.lxSEMI); Next(parser) ELSE @@ -965,20 +1043,20 @@ VAR ExpectSym(parser, SCAN.lxSEMI); Next(parser) ELSE - check(FALSE, parser, pos, 60) + error(pos, 60) END END END; - IF import = NIL THEN + IF ~codeProc & (import = NIL) THEN variables := LISTS.create(NIL); ELSE variables := NIL END; - unit.scope.close(unit, variables); + PROG.closeScope(unit, variables); - IF import = NIL THEN + IF ~codeProc & (import = NIL) THEN enter.variables := variables END @@ -1001,12 +1079,15 @@ BEGIN END END; - ptr := parser.unit.pointers.link(parser.unit); + ptr := PROG.linkPtr(parser.unit); IF ptr # NIL THEN + pos.line := ptr.pos.line; + pos.col := ptr.pos.col; + pos.parser := parser; IF ptr.notRecord THEN - error(parser, ptr.pos, 58) + error(pos, 58) ELSE - error(parser, ptr.pos, 48) + error(pos, 48) END END; @@ -1029,10 +1110,12 @@ END DeclarationSequence; PROCEDURE parse (parser: PARSER); VAR - unit: PROG.UNIT; - label: INTEGER; - name: INTEGER; - endmod: BOOLEAN; + unit: PROG.UNIT; + label: INTEGER; + name: INTEGER; + endmod: BOOLEAN; + errlabel: INTEGER; + errno: INTEGER; BEGIN ASSERT(parser # NIL); @@ -1045,7 +1128,7 @@ BEGIN check1(parser.lex.s = parser.modname, parser, 23) END; - unit := program.units.create(program.units, parser.lex.ident); + unit := PROG.newUnit(program, parser.lex.ident); parser.unit := unit; @@ -1062,19 +1145,26 @@ BEGIN END; CONSOLE.Ln; - label := CODE.NewLabel(); - CODE.AddJmpCmd(CODE.opJMP, label); + label := IL.NewLabel(); + IL.AddJmpCmd(IL.opJMP, label); - name := CODE.putstr(unit.name.s); + name := IL.putstr(unit.name.s); - CODE.SetErrLabel; - CODE.AddCmd(CODE.opSADR, name); - CODE.AddCmd(CODE.opPARAM, 1); - CODE.AddCmd0(CODE.opERR); + errlabel := IL.NewLabel(); + IL.SetLabel(errlabel); + IL.StrAdr(name); + IL.Param1; + IL.AddCmd0(IL.opERR); + + FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO + IL.SetErrLabel(errno); + IL.AddCmd(IL.opPUSHC, errno); + IL.AddJmpCmd(IL.opJMP, errlabel) + END; endmod := DeclarationSequence(parser); - CODE.SetLabel(label); + IL.SetLabel(label); IF ~endmod THEN @@ -1091,8 +1181,7 @@ BEGIN END; - unit.close(unit) - + PROG.closeUnit(unit) END parse; @@ -1156,9 +1245,9 @@ BEGIN END create; -PROCEDURE init* (bit_depth, sys: INTEGER); +PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS); BEGIN - program := PROG.create(bit_depth, sys); + program := PROG.create(bit_depth, target, options); parsers := C.create() END init; diff --git a/programs/develop/oberon07/Source/PATHS.ob07 b/programs/develop/oberon07/Source/PATHS.ob07 index 4a86cfdd52..e6ea79255e 100644 --- a/programs/develop/oberon07/Source/PATHS.ob07 +++ b/programs/develop/oberon07/Source/PATHS.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -12,11 +12,11 @@ IMPORT STRINGS, UTILS; CONST - slash = UTILS.slash; - + slash = UTILS.slash; + PATHLEN = 2048; - - + + TYPE PATH* = ARRAY PATHLEN OF CHAR; @@ -92,12 +92,12 @@ BEGIN res[i] := 0X END -END RelPath; +END RelPath; PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; RETURN UTILS.isRelative(path) -END isRelative; +END isRelative; PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); diff --git a/programs/develop/oberon07/Source/PROG.ob07 b/programs/develop/oberon07/Source/PROG.ob07 index d08a984a0c..a5e090126f 100644 --- a/programs/develop/oberon07/Source/PROG.ob07 +++ b/programs/develop/oberon07/Source/PROG.ob07 @@ -7,7 +7,7 @@ MODULE PROG; -IMPORT SCAN, LISTS, ARITH, ERRORS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS, CODE, UTILS; +IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS; CONST @@ -39,9 +39,10 @@ CONST sysMOVE* = 27; stLENGTH* = 28; stMIN* = 29; stMAX* = 30; sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34; sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38; - sysWSADR* = 39; sysPUT32* = 40; + sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42; + sysDINT* = 43;*) - default* = 2; + default32* = 2; stdcall* = 4; _stdcall* = stdcall + 1; ccall* = 6; _ccall* = ccall + 1; ccall16* = 8; _ccall16* = ccall16 + 1; @@ -49,19 +50,34 @@ CONST stdcall64* = 12; _stdcall64* = stdcall64 + 1; default64* = 14; systemv* = 16; _systemv* = systemv + 1; + default16* = 18; + code* = 20; _code* = code + 1; - noalign* = 20; + noalign* = 22; - callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64}; - caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv}; - callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16}; - callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv}; + callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64}; + + 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_noalign* = 9; + + 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; TYPE + OPTIONS* = RECORD + + version*, stack*, base*, ram*, rom*: INTEGER; + pic*: BOOLEAN; + checking*: SET + + END; + IDENT* = POINTER TO rIDENT; UNIT* = POINTER TO rUNIT; @@ -81,13 +97,6 @@ TYPE END; - IDENTS = POINTER TO RECORD (LISTS.LIST) - - add*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; - get*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT - - END; - PROC* = POINTER TO RECORD (LISTS.ITEM) label*: INTEGER; @@ -110,31 +119,13 @@ TYPE program*: PROGRAM; name*: SCAN.IDENT; - idents*: IDENTS; + idents*: LISTS.LIST; frwPointers: LISTS.LIST; gscope: IDENT; closed*: BOOLEAN; scopeLvl*: INTEGER; sysimport*: BOOLEAN; - - scopes*: ARRAY MAXSCOPE OF PROC; - - scope*: RECORD - - open*: PROCEDURE (unit: UNIT; proc: PROC): BOOLEAN; - close*: PROCEDURE (unit: UNIT; variables: LISTS.LIST) - - END; - - close*: PROCEDURE (unit: UNIT); - setvars*: PROCEDURE (unit: UNIT; type: TYPE_); - - pointers*: RECORD - - add*: PROCEDURE (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); - link*: PROCEDURE (unit: UNIT): FRWPTR - - END + scopes*: ARRAY MAXSCOPE OF PROC END; @@ -142,34 +133,16 @@ TYPE PARAM* = POINTER TO rPARAM; - FIELDS = POINTER TO RECORD (LISTS.LIST) - - add*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; - get*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; - set*: PROCEDURE (rec: TYPE_; type: TYPE_): BOOLEAN - - END; - - PARAMS = POINTER TO RECORD (LISTS.LIST) - - size*: INTEGER; - - add*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; - get*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT): PARAM; - set*: PROCEDURE (proc: TYPE_; type: TYPE_); - getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET - - END; - rTYPE_ = RECORD (LISTS.ITEM) typ*: INTEGER; size*: INTEGER; + parSize*: INTEGER; length*: INTEGER; align*: INTEGER; base*: TYPE_; - fields*: FIELDS; - params*: PARAMS; + fields*: LISTS.LIST; + params*: LISTS.LIST; unit*: UNIT; closed*: BOOLEAN; num*: INTEGER; @@ -215,19 +188,10 @@ TYPE END; - UNITS* = POINTER TO RECORD (LISTS.LIST) - - program: PROGRAM; - - create*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT; - get*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT - - END; - rPROGRAM = RECORD recCount: INTEGER; - units*: UNITS; + units*: LISTS.LIST; types*: LISTS.LIST; sysunit*: UNIT; rtl*: UNIT; @@ -238,10 +202,10 @@ TYPE dll*: BOOLEAN; obj*: BOOLEAN; - stTypes*: RECORD + stTypes*: RECORD - tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*, - tCARD16*, tCARD32*, tANYREC*: TYPE_ + tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, + tSTRING*, tNIL*, tCARD16*, tCARD32*, tANYREC*: TYPE_ END; @@ -250,12 +214,11 @@ TYPE bit_depth*: INTEGER; word*: INTEGER; adr*: INTEGER; - sys*: INTEGER + sys*: INTEGER; + sysflags*: SET; + options*: OPTIONS - END; - - enterType*: PROCEDURE (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; - getType*: PROCEDURE (program: PROGRAM; typ: INTEGER): TYPE_ + END END; @@ -292,7 +255,7 @@ VAR BEGIN IF varIdent.offset = -1 THEN IF varIdent.global THEN - IF MACHINE.Align(program.bss, varIdent.type.align) THEN + IF UTILS.Align(program.bss, varIdent.type.align) THEN IF UTILS.maxint - program.bss >= varIdent.type.size THEN varIdent.offset := program.bss; INC(program.bss, varIdent.type.size) @@ -301,7 +264,7 @@ BEGIN ELSE word := program.target.word; size := varIdent.type.size; - IF MACHINE.Align(size, word) THEN + IF UTILS.Align(size, word) THEN size := size DIV word; IF UTILS.maxint - program.locsize >= size THEN INC(program.locsize, size); @@ -315,7 +278,7 @@ BEGIN END getOffset; -PROCEDURE close (unit: UNIT); +PROCEDURE closeUnit* (unit: UNIT); VAR ident, prev: IDENT; offset: INTEGER; @@ -324,7 +287,7 @@ BEGIN ident := unit.idents.last(IDENT); WHILE (ident # NIL) & (ident.typ # idGUARD) DO IF (ident.typ = idVAR) & (ident.offset = -1) THEN - ERRORS.hintmsg(ident.name.s, ident.pos.line, ident.pos.col, 0); + ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0); IF ident.export THEN offset := getOffset(unit.program, ident) END @@ -343,7 +306,7 @@ BEGIN END; unit.closed := TRUE -END close; +END closeUnit; PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN; @@ -362,12 +325,12 @@ BEGIN END unique; -PROCEDURE addIdent (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; +PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; VAR - item: IDENT; - res: BOOLEAN; - proc: PROC; - procs: LISTS.LIST; + item: IDENT; + res: BOOLEAN; + proc: PROC; + procs: LISTS.LIST; BEGIN ASSERT(unit # NIL); @@ -414,9 +377,9 @@ END addIdent; PROCEDURE UseProc* (unit: UNIT; call_proc: PROC); VAR - procs: LISTS.LIST; - cur: LISTS.ITEM; - proc: USED_PROC; + procs: LISTS.LIST; + cur: LISTS.ITEM; + proc: USED_PROC; BEGIN IF unit.scopeLvl = 0 THEN @@ -438,7 +401,7 @@ BEGIN END UseProc; -PROCEDURE setvars (unit: UNIT; type: TYPE_); +PROCEDURE setVarsType* (unit: UNIT; type: TYPE_); VAR item: IDENT; @@ -450,10 +413,10 @@ BEGIN item.type := type; item := item.prev(IDENT) END -END setvars; +END setVarsType; -PROCEDURE getIdent (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT; +PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT; VAR item: IDENT; @@ -462,26 +425,28 @@ BEGIN item := unit.idents.last(IDENT); - ASSERT(item # NIL); + IF item # NIL THEN - IF currentScope THEN - WHILE (item.name # ident) & (item.typ # idGUARD) DO - item := item.prev(IDENT) - END; - IF item.name # ident THEN - item := NIL - END - ELSE - WHILE (item # NIL) & (item.name # ident) DO - item := item.prev(IDENT) + IF currentScope THEN + WHILE (item.name # ident) & (item.typ # idGUARD) DO + item := item.prev(IDENT) + END; + IF item.name # ident THEN + item := NIL + END + ELSE + WHILE (item # NIL) & (item.name # ident) DO + item := item.prev(IDENT) + END END + END RETURN item END getIdent; -PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN; +PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN; VAR item: IDENT; res: BOOLEAN; @@ -508,11 +473,11 @@ BEGIN END openScope; -PROCEDURE closeScope (unit: UNIT; variables: LISTS.LIST); +PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST); VAR item: IDENT; del: IDENT; - lvar: CODE.LOCALVAR; + lvar: IL.LOCALVAR; BEGIN item := unit.idents.last(IDENT); @@ -521,11 +486,11 @@ BEGIN del := item; item := item.prev(IDENT); IF (del.typ = idVAR) & (del.offset = -1) THEN - ERRORS.hintmsg(del.name.s, del.pos.line, del.pos.col, 0) + 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 - lvar := CODE.NewVar(); + lvar := IL.NewVar(); lvar.offset := del.offset; lvar.size := del.type.size; IF del.typ = idVAR THEN @@ -548,7 +513,7 @@ BEGIN 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; @@ -559,17 +524,17 @@ BEGIN NEW(newptr); - newptr.type := type; - newptr.baseIdent := baseIdent; - newptr.pos := pos; - newptr.linked := FALSE; - newptr.notRecord := FALSE; + newptr.type := type; + newptr.baseIdent := baseIdent; + newptr.pos := pos; + newptr.linked := FALSE; + newptr.notRecord := FALSE; LISTS.push(unit.frwPointers, newptr) -END frwptr; +END frwPtr; -PROCEDURE linkptr (unit: UNIT): FRWPTR; +PROCEDURE linkPtr* (unit: UNIT): FRWPTR; VAR item: FRWPTR; ident: IDENT; @@ -580,7 +545,7 @@ BEGIN item := unit.frwPointers.last(FRWPTR); WHILE (item # NIL) & ~item.linked & (res = NIL) DO - ident := unit.idents.get(unit, item.baseIdent, TRUE); + ident := getIdent(unit, item.baseIdent, TRUE); IF (ident # NIL) THEN IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN @@ -599,7 +564,7 @@ BEGIN END RETURN res -END linkptr; +END linkPtr; PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN; @@ -617,7 +582,7 @@ BEGIN param1 := t1.params.first; param2 := t2.params.first; - res := (t1.call = t2.call) & ((param1 # NIL) = (param2 # NIL)); + 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); @@ -643,18 +608,21 @@ VAR res: BOOLEAN; BEGIN - res := ((t0.typ = tPOINTER) & (t1.typ = tPOINTER)) OR ((t0.typ = tRECORD) & (t1.typ = tRECORD)); + res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD}); - IF (t0.typ = tPOINTER) & (t1.typ = tPOINTER) THEN + IF res & (t0.typ = tPOINTER) THEN t0 := t0.base; t1 := t1.base END; - WHILE res & (t1 # NIL) & (t1 # t0) DO - t1 := t1.base + IF res THEN + WHILE (t1 # NIL) & (t1 # t0) DO + t1 := t1.base + END; + res := t1 # NIL END - RETURN res & (t1 = t0) + RETURN res END isBaseOf; @@ -663,61 +631,54 @@ PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN; END isOpenArray; -PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT; +PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; VAR item: UNIT; BEGIN ASSERT(name # NIL); - item := units.first(UNIT); + item := program.units.first(UNIT); WHILE (item # NIL) & (item.name # name) DO item := item.next(UNIT) END; IF (item = NIL) & (name.s = "SYSTEM") THEN - item := units.program.sysunit + item := program.sysunit END RETURN item -END getunit; +END getUnit; PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM); VAR - ident: IDENT; - stName: SCAN.IDENT; + ident: IDENT; BEGIN - - stName := SCAN.enterid("INTEGER"); - ident := addIdent(unit, stName, idTYPE); + ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE); ident.type := program.stTypes.tINTEGER; - stName := SCAN.enterid("BYTE"); - ident := addIdent(unit, stName, idTYPE); + ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE); ident.type := program.stTypes.tBYTE; - stName := SCAN.enterid("CHAR"); - ident := addIdent(unit, stName, idTYPE); + ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE); ident.type := program.stTypes.tCHAR; - stName := SCAN.enterid("WCHAR"); - ident := addIdent(unit, stName, idTYPE); - ident.type := program.stTypes.tWCHAR; - - stName := SCAN.enterid("SET"); - ident := addIdent(unit, stName, idTYPE); + ident := addIdent(unit, SCAN.enterid("SET"), idTYPE); ident.type := program.stTypes.tSET; - stName := SCAN.enterid("BOOLEAN"); - ident := addIdent(unit, stName, idTYPE); + ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); ident.type := program.stTypes.tBOOLEAN; - stName := SCAN.enterid("REAL"); - ident := addIdent(unit, stName, idTYPE); - ident.type := program.stTypes.tREAL; + IF program.target.sys # mConst.Target_iMSP430 THEN + ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE); + ident.type := program.stTypes.tREAL; + + ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE); + ident.type := program.stTypes.tWCHAR + END END enterStTypes; @@ -725,86 +686,86 @@ END enterStTypes; PROCEDURE enterStProcs (unit: UNIT); - PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); + PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER); VAR ident: IDENT; BEGIN - ident := addIdent(unit, SCAN.enterid(name), idtyp); + ident := addIdent(unit, SCAN.enterid(name), idSTPROC); ident.stproc := proc END EnterProc; -BEGIN - EnterProc(unit, "ASSERT", idSTPROC, stASSERT); - EnterProc(unit, "DEC", idSTPROC, stDEC); - EnterProc(unit, "EXCL", idSTPROC, stEXCL); - EnterProc(unit, "INC", idSTPROC, stINC); - EnterProc(unit, "INCL", idSTPROC, stINCL); - EnterProc(unit, "NEW", idSTPROC, stNEW); - EnterProc(unit, "PACK", idSTPROC, stPACK); - EnterProc(unit, "UNPK", idSTPROC, stUNPK); - EnterProc(unit, "DISPOSE", idSTPROC, stDISPOSE); - EnterProc(unit, "COPY", idSTPROC, stCOPY); + PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER); + VAR + ident: IDENT; + BEGIN + ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); + 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); + + 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 unit.program.target.sys # mConst.Target_iMSP430 THEN + EnterProc(unit, "PACK", stPACK); + EnterProc(unit, "UNPK", stUNPK); + EnterProc(unit, "DISPOSE", stDISPOSE); + + EnterFunc(unit, "WCHR", stWCHR); + EnterFunc(unit, "FLOOR", stFLOOR); + EnterFunc(unit, "FLT", stFLT) + END - EnterProc(unit, "ABS", idSTFUNC, stABS); - EnterProc(unit, "ASR", idSTFUNC, stASR); - EnterProc(unit, "CHR", idSTFUNC, stCHR); - EnterProc(unit, "WCHR", idSTFUNC, stWCHR); - EnterProc(unit, "FLOOR", idSTFUNC, stFLOOR); - EnterProc(unit, "FLT", idSTFUNC, stFLT); - EnterProc(unit, "LEN", idSTFUNC, stLEN); - EnterProc(unit, "LSL", idSTFUNC, stLSL); - EnterProc(unit, "ODD", idSTFUNC, stODD); - EnterProc(unit, "ORD", idSTFUNC, stORD); - EnterProc(unit, "ROR", idSTFUNC, stROR); - EnterProc(unit, "BITS", idSTFUNC, stBITS); - EnterProc(unit, "LSR", idSTFUNC, stLSR); - EnterProc(unit, "LENGTH", idSTFUNC, stLENGTH); - EnterProc(unit, "MIN", idSTFUNC, stMIN); - EnterProc(unit, "MAX", idSTFUNC, stMAX); END enterStProcs; -PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT; +PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; VAR - unit: UNIT; - idents: IDENTS; + unit: UNIT; BEGIN - ASSERT(units # NIL); + ASSERT(program # NIL); ASSERT(name # NIL); NEW(unit); - NEW(idents); - ASSERT(LISTS.create(idents) = idents); - - idents.add := addIdent; - idents.get := getIdent; - - unit.program := units.program; + unit.program := program; unit.name := name; unit.closed := FALSE; - unit.idents := idents; + unit.idents := LISTS.create(NIL); unit.frwPointers := LISTS.create(NIL); - unit.scope.open := openScope; - unit.scope.close := closeScope; - unit.close := close; - unit.setvars := setvars; - unit.pointers.add := frwptr; - unit.pointers.link := linkptr; + ASSERT(openScope(unit, NIL)); - ASSERT(unit.scope.open(unit, NIL)); - - enterStTypes(unit, units.program); + enterStTypes(unit, program); enterStProcs(unit); - ASSERT(unit.scope.open(unit, NIL)); + ASSERT(openScope(unit, NIL)); unit.gscope := unit.idents.last(IDENT); - LISTS.push(units, unit); + LISTS.push(program.units, unit); unit.scopeLvl := 0; unit.scopes[0] := NIL; @@ -812,16 +773,16 @@ BEGIN unit.sysimport := FALSE; IF unit.name.s = mConst.RTL_NAME THEN - unit.program.rtl := unit + program.rtl := unit END RETURN unit -END newunit; +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; + field: FIELD; BEGIN ASSERT(self # NIL); @@ -851,10 +812,10 @@ BEGIN 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; + field: FIELD; + res: BOOLEAN; BEGIN ASSERT(name # NIL); @@ -876,7 +837,7 @@ BEGIN END addField; -PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN; +PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN; VAR item: FIELD; res: BOOLEAN; @@ -895,7 +856,7 @@ BEGIN WHILE res & (item # NIL) & (item.type = NIL) DO item.type := type; IF ~self.noalign THEN - res := MACHINE.Align(self.size, type.align) + res := UTILS.Align(self.size, type.align) ELSE res := TRUE END; @@ -911,9 +872,9 @@ BEGIN END setFields; -PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM; +PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM; VAR - item: PARAM; + item: PARAM; BEGIN ASSERT(name # NIL); @@ -928,15 +889,15 @@ BEGIN 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; + param: PARAM; + res: BOOLEAN; BEGIN ASSERT(name # NIL); - res := self.params.get(self, name) = NIL; + res := getParam(self, name) = NIL; IF res THEN NEW(param); @@ -973,7 +934,7 @@ BEGIN 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; @@ -991,13 +952,13 @@ BEGIN param := param.next(PARAM) END; - int := self.params.size - flt + int := self.parSize - flt RETURN res END getFloatParamsPos; -PROCEDURE setParams (self: TYPE_; type: TYPE_); +PROCEDURE setParams* (self: TYPE_; type: TYPE_); VAR item: LISTS.ITEM; param: PARAM; @@ -1006,7 +967,7 @@ VAR BEGIN ASSERT(type # NIL); - word := MACHINE.target.bit_depth DIV 8; + word := UTILS.target.bit_depth DIV 8; item := self.params.first; @@ -1025,8 +986,8 @@ BEGIN ELSE size := 1 END; - param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; - INC(self.params.size, size) + 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 @@ -1036,11 +997,11 @@ BEGIN END ELSE size := type.size; - ASSERT(MACHINE.Align(size, word)); + ASSERT(UTILS.Align(size, word)); size := size DIV word END; - param.offset := self.params.size + Dim(type) + STACK_FRAME; - INC(self.params.size, size) + param.offset := self.parSize + Dim(type) + STACK_FRAME; + INC(self.parSize, size) END; item := item.next @@ -1049,47 +1010,32 @@ BEGIN END setParams; -PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; +PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; VAR - t: TYPE_; - fields: FIELDS; - params: PARAMS; + t: TYPE_; BEGIN NEW(t); - NEW(fields); - ASSERT(LISTS.create(fields) = fields); - - NEW(params); - ASSERT(LISTS.create(params) = params); - t.typ := typ; t.size := size; t.length := length; t.align := 0; t.base := NIL; - t.fields := fields; - t.params := params; + t.fields := LISTS.create(NIL); + t.params := LISTS.create(NIL); t.unit := unit; t.num := 0; - IF program.target.bit_depth = 32 THEN - t.call := default - ELSIF program.target.bit_depth = 64 THEN - t.call := default64 + + CASE program.target.bit_depth OF + |16: t.call := default16 + |32: t.call := default32 + |64: t.call := default64 END; + t.import := FALSE; t.noalign := FALSE; - - t.fields.add := addField; - t.fields.get := getField; - t.fields.set := setFields; - - t.params.add := addParam; - t.params.get := getParam; - t.params.getfparams := getFloatParamsPos; - t.params.set := setParams; - t.params.size := 0; + t.parSize := 0; IF typ IN {tARRAY, tRECORD} THEN t.closed := FALSE; @@ -1107,7 +1053,7 @@ BEGIN END enterType; -PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_; +PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_; VAR res: TYPE_; @@ -1154,33 +1100,42 @@ VAR BEGIN - unit := program.units.create(program.units, 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, "WSADR", idSYSFUNC, sysWSADR); EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID); - EnterProc(unit, "INF", idSYSFUNC, sysINF); EnterProc(unit, "GET", idSYSPROC, sysGET); - EnterProc(unit, "PUT", idSYSPROC, sysPUT); EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); - EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); - EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); + EnterProc(unit, "PUT", idSYSPROC, sysPUT); EnterProc(unit, "CODE", idSYSPROC, sysCODE); EnterProc(unit, "MOVE", idSYSPROC, sysMOVE); - EnterProc(unit, "COPY", idSYSPROC, sysCOPY); + (* + IF program.target.sys = mConst.Target_iMSP430 THEN + EnterProc(unit, "NOP", idSYSPROC, sysNOP); + EnterProc(unit, "EINT", idSYSPROC, sysEINT); + EnterProc(unit, "DINT", idSYSPROC, sysDINT) + END; + *) + IF program.target.sys # mConst.Target_iMSP430 THEN + EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); + EnterProc(unit, "INF", idSYSFUNC, sysINF); + EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); + EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); + EnterProc(unit, "COPY", idSYSPROC, sysCOPY); - ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE); - ident.type := program.stTypes.tCARD16; - ident.export := TRUE; + ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE); + ident.type := program.stTypes.tCARD16; + ident.export := TRUE; - ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); - ident.type := program.stTypes.tCARD32; - ident.export := TRUE; + ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); + ident.type := program.stTypes.tCARD32; + ident.export := TRUE + END; - unit.close(unit); + closeUnit(unit); program.sysunit := unit END createSysUnit; @@ -1188,8 +1143,8 @@ END createSysUnit; PROCEDURE DelUnused* (program: PROGRAM; DelImport: DELIMPORT); VAR - proc: PROC; - flag: BOOLEAN; + proc: PROC; + flag: BOOLEAN; PROCEDURE process (proc: PROC); @@ -1211,7 +1166,6 @@ VAR BEGIN REPEAT - flag := FALSE; proc := program.procs.first(PROC); @@ -1230,7 +1184,7 @@ BEGIN WHILE proc # NIL DO IF ~proc.used THEN IF proc.import = NIL THEN - CODE.delete2(proc.enter, proc.leave) + IL.delete2(proc.enter, proc.leave) ELSE DelImport(proc.import) END @@ -1241,63 +1195,81 @@ BEGIN END DelUnused; -PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM; +PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM; VAR program: PROGRAM; - units: UNITS; BEGIN idents := C.create(); - MACHINE.SetBitDepth(bit_depth); + UTILS.SetBitDepth(bit_depth); NEW(program); - NEW(units); - ASSERT(LISTS.create(units) = units); program.target.bit_depth := bit_depth; program.target.word := bit_depth DIV 8; program.target.adr := bit_depth DIV 8; - program.target.sys := sys; + program.target.sys := target; + program.target.options := options; + + CASE target OF + |mConst.Target_iConsole, + mConst.Target_iGUI, + mConst.Target_iDLL: program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + + |mConst.Target_iELF32, + mConst.Target_iELFSO32: program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + + |mConst.Target_iKolibri, + mConst.Target_iObject: program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} + + |mConst.Target_iConsole64, + mConst.Target_iGUI64, + mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} + + |mConst.Target_iELF64, + mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} + + |mConst.Target_iMSP430: program.target.sysflags := {sf_code} + END; program.recCount := -1; program.bss := 0; - program.units := units; + program.units := LISTS.create(NIL); program.types := LISTS.create(NIL); - program.procs := LISTS.create(NIL); - program.enterType := enterType; - program.getType := getType; - program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL); program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); - program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL); program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); - program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); - program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL); - program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL); - program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL); - program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); - program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); + + IF target # mConst.Target_iMSP430 THEN + program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); + program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); + program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL); + program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL) + END; + + program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL); + program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL); + + program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); program.stTypes.tANYREC.closed := TRUE; program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; program.stTypes.tBYTE.align := 1; program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; - program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; program.stTypes.tSET.align := program.stTypes.tSET.size; program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; - program.stTypes.tREAL.align := program.stTypes.tREAL.size; - program.stTypes.tCARD16.align := program.stTypes.tCARD16.size; - program.stTypes.tCARD32.align := program.stTypes.tCARD32.size; - units.program := program; - - units.create := newunit; - units.get := getunit; + IF target # mConst.Target_iMSP430 THEN + program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; + program.stTypes.tREAL.align := program.stTypes.tREAL.size; + program.stTypes.tCARD16.align := program.stTypes.tCARD16.size; + program.stTypes.tCARD32.align := program.stTypes.tCARD32.size + END; program.dll := FALSE; program.obj := FALSE; diff --git a/programs/develop/oberon07/Source/REG.ob07 b/programs/develop/oberon07/Source/REG.ob07 index 1f448d833b..b77aebf4e2 100644 --- a/programs/develop/oberon07/Source/REG.ob07 +++ b/programs/develop/oberon07/Source/REG.ob07 @@ -12,8 +12,10 @@ CONST N = 16; - R0* = 0; R1* = 1; R2* = 2; - R8* = 8; R9* = 9; R10* = 10; R11* = 11; + R0* = 0; R1* = 1; R2* = 2; R3* = 3; + R4* = 4; R5* = 5; R6* = 6; R7* = 7; + R8* = 8; R9* = 9; R10* = 10; R11* = 11; + R12* = 12; R13* = 13; R14* = 14; R15* = 15; NVR = 32; @@ -24,7 +26,7 @@ TYPE OP2 = PROCEDURE (arg1, arg2: INTEGER); OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER); - REGS* = POINTER TO RECORD + REGS* = RECORD regs*: SET; stk*: ARRAY N OF INTEGER; @@ -42,7 +44,7 @@ TYPE END; -PROCEDURE push (R: REGS); +PROCEDURE push (VAR R: REGS); VAR i, reg: INTEGER; @@ -58,7 +60,7 @@ BEGIN END push; -PROCEDURE pop (R: REGS; reg: INTEGER); +PROCEDURE pop (VAR R: REGS; reg: INTEGER); VAR i: INTEGER; @@ -111,7 +113,7 @@ BEGIN END GetFreeReg; -PROCEDURE Put (R: REGS; reg: INTEGER); +PROCEDURE Put (VAR R: REGS; reg: INTEGER); BEGIN EXCL(R.regs, reg); INC(R.top); @@ -119,7 +121,7 @@ BEGIN END Put; -PROCEDURE PopAnyReg (R: REGS): INTEGER; +PROCEDURE PopAnyReg (VAR R: REGS): INTEGER; VAR reg: INTEGER; @@ -134,7 +136,7 @@ BEGIN END PopAnyReg; -PROCEDURE GetAnyReg* (R: REGS): INTEGER; +PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER; VAR reg: INTEGER; @@ -152,13 +154,13 @@ BEGIN END GetAnyReg; -PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN; +PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN; VAR free, n: INTEGER; res: BOOLEAN; - PROCEDURE exch (R: REGS; reg1, reg2: INTEGER); + PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER); VAR n1, n2: INTEGER; @@ -201,7 +203,7 @@ BEGIN END GetReg; -PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN; +PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN; VAR n1, n2: INTEGER; res: BOOLEAN; @@ -239,14 +241,14 @@ BEGIN END Exchange; -PROCEDURE Drop* (R: REGS); +PROCEDURE Drop* (VAR R: REGS); BEGIN INCL(R.regs, R.stk[R.top]); DEC(R.top) END Drop; -PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER); +PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER); BEGIN IF R.top > 0 THEN reg1 := R.stk[R.top - 1]; @@ -261,7 +263,7 @@ BEGIN END BinOp; -PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER); +PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER); BEGIN IF R.top >= 0 THEN reg := R.stk[R.top] @@ -271,7 +273,7 @@ BEGIN END UnOp; -PROCEDURE PushAll* (R: REGS); +PROCEDURE PushAll* (VAR R: REGS); BEGIN WHILE R.top >= 0 DO push(R) @@ -279,7 +281,15 @@ BEGIN END PushAll; -PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER); +PROCEDURE PushAll_1* (VAR R: REGS); +BEGIN + WHILE R.top >= 1 DO + push(R) + END +END PushAll_1; + + +PROCEDURE Lock* (VAR R: REGS; reg, offs, size: INTEGER); BEGIN ASSERT(reg IN R.vregs); ASSERT(offs # 0); @@ -291,7 +301,7 @@ BEGIN END Lock; -PROCEDURE Release* (R: REGS; reg: INTEGER); +PROCEDURE Release* (VAR R: REGS; reg: INTEGER); BEGIN ASSERT(reg IN R.vregs); R.offs[reg] := 0 @@ -350,7 +360,7 @@ BEGIN END Restore; -PROCEDURE Reset* (R: REGS); +PROCEDURE Reset* (VAR R: REGS); VAR i: INTEGER; @@ -401,14 +411,11 @@ BEGIN END GetAnyVarReg; -PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS; +PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET); VAR - R: REGS; i: INTEGER; BEGIN - NEW(R); - R.regs := regs; R.pushed := 0; R.top := -1; @@ -427,8 +434,7 @@ BEGIN R.size[i] := 0 END - RETURN R -END Create; +END Init; END REG. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/SCAN.ob07 b/programs/develop/oberon07/Source/SCAN.ob07 index ab771009a3..91de0575a9 100644 --- a/programs/develop/oberon07/Source/SCAN.ob07 +++ b/programs/develop/oberon07/Source/SCAN.ob07 @@ -1,46 +1,47 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) MODULE SCAN; -IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS; +IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS; CONST LEXLEN = 1024; - lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3; - lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7; - lxEOF* = 8; + lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3; + lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7; + lxEOF* = 8; - lxKW = 101; + lxPLUS* = 21; lxMINUS* = 22; lxMUL* = 23; lxSLASH* = 24; + lxNOT* = 25; lxAND* = 26; lxPOINT* = 27; lxCOMMA* = 28; + lxSEMI* = 29; lxBAR* = 30; lxLROUND* = 31; lxLSQUARE* = 32; + lxLCURLY* = 33; lxCARET* = 34; lxEQ* = 35; lxNE* = 36; + lxLT* = 37; lxGT* = 38; lxCOLON* = 39; lxRROUND* = 40; + lxRSQUARE* = 41; lxRCURLY* = 42; lxLE* = 43; lxGE* = 44; + lxASSIGN* = 45; lxRANGE* = 46; - lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104; - lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108; - lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112; - lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116; - lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120; - lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124; - lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128; - lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132; - lxWHILE* = 133; + lxKW = 51; - lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204; - lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208; - lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212; - lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216; - lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220; - lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224; - lxASSIGN* = 225; lxRANGE* = 226; + lxARRAY* = 51; lxBEGIN* = 52; lxBY* = 53; lxCASE* = 54; + lxCONST* = 55; lxDIV* = 56; lxDO* = 57; lxELSE* = 58; + lxELSIF* = 59; lxEND* = 60; lxFALSE* = 61; lxFOR* = 62; + lxIF* = 63; lxIMPORT* = 64; lxIN* = 65; lxIS* = 66; + lxMOD* = 67; lxMODULE* = 68; lxNIL* = 69; lxOF* = 70; + lxOR* = 71; lxPOINTER* = 72; lxPROCEDURE* = 73; lxRECORD* = 74; + lxREPEAT* = 75; lxRETURN* = 76; lxTHEN* = 77; lxTO* = 78; + lxTRUE* = 79; lxTYPE* = 80; lxUNTIL* = 81; lxVAR* = 82; + lxWHILE* = 83; - lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4; - lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8; - lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12; + lxERROR01* = -1; lxERROR02* = -2; lxERROR03* = -3; lxERROR04* = -4; + lxERROR05* = -5; lxERROR06* = -6; lxERROR07* = -7; lxERROR08* = -8; + lxERROR09* = -9; lxERROR10* = -10; lxERROR11* = -11; lxERROR12* = -12; + lxERROR13* = -13; TYPE @@ -62,25 +63,20 @@ TYPE LEX* = RECORD - s*: LEXSTR; - length*: INTEGER; - sym*: INTEGER; - pos*: POSITION; - ident*: IDENT; - string*: IDENT; - value*: ARITH.VALUE; - error*: INTEGER; + s*: LEXSTR; + length*: INTEGER; + sym*: INTEGER; + pos*: POSITION; + ident*: IDENT; + string*: IDENT; + value*: ARITH.VALUE; + error*: INTEGER; - over: BOOLEAN + over: BOOLEAN END; - SCANNER* = POINTER TO RECORD (C.ITEM) - - text: TEXTDRV.TEXT; - range: BOOLEAN - - END; + SCANNER* = TXT.TEXT; KEYWORD = ARRAY 10 OF CHAR; @@ -89,16 +85,14 @@ VAR vocabulary: RECORD - KW: ARRAY 33 OF KEYWORD; - - delimiters: ARRAY 256 OF BOOLEAN; - - idents: AVL.NODE; - ident: IDENT + KW: ARRAY 33 OF KEYWORD; + delimiters: ARRAY 256 OF BOOLEAN; + idents: AVL.NODE; + ident: IDENT END; - scanners: C.COLLECTION; + upto: BOOLEAN; PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; @@ -109,36 +103,27 @@ END nodecmp; PROCEDURE key (VAR lex: LEX); VAR L, R, M: INTEGER; + found: BOOLEAN; BEGIN L := 0; R := LEN(vocabulary.KW) - 1; - M := (L + R) DIV 2; + found := FALSE; - WHILE L # M DO - IF lex.s > vocabulary.KW[M] THEN - L := M; - M := (L + R) DIV 2 - ELSIF lex.s < vocabulary.KW[M] THEN - R := M; - M := (L + R) DIV 2 + REPEAT + M := (L + R) DIV 2; + + IF lex.s # vocabulary.KW[M] THEN + IF lex.s > vocabulary.KW[M] THEN + L := M + 1 + ELSE + R := M - 1 + END ELSE - lex.sym := lxKW + M; - L := M; - R := M + found := TRUE; + lex.sym := lxKW + M END - END; - - IF L # R THEN - IF lex.s = vocabulary.KW[L] THEN - lex.sym := lxKW + L - END; - - IF lex.s = vocabulary.KW[R] THEN - lex.sym := lxKW + R - END - END - + UNTIL found OR (L > R) END key; @@ -173,18 +158,24 @@ BEGIN END putchar; -PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX); +PROCEDURE nextc (text: TXT.TEXT): CHAR; +BEGIN + TXT.next(text) + RETURN text.peak +END nextc; + + +PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX); VAR c: CHAR; BEGIN - c := text.peak(text); + c := text.peak; ASSERT(S.letter(c)); WHILE S.letter(c) OR S.digit(c) DO putchar(lex, c); - text.nextc(text); - c := text.peak(text) + c := nextc(text) END; IF lex.over THEN @@ -201,44 +192,40 @@ BEGIN END ident; -PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); +PROCEDURE number (text: TXT.TEXT; VAR lex: LEX); VAR c: CHAR; hex: BOOLEAN; error: INTEGER; BEGIN - c := text.peak(text); + c := text.peak; ASSERT(S.digit(c)); error := 0; - range := FALSE; - lex.sym := lxINTEGER; hex := FALSE; WHILE S.digit(c) DO putchar(lex, c); - text.nextc(text); - c := text.peak(text) + c := nextc(text) END; WHILE S.hexdigit(c) DO putchar(lex, c); - text.nextc(text); - c := text.peak(text); + c := nextc(text); hex := TRUE END; IF c = "H" THEN putchar(lex, c); - text.nextc(text); + TXT.next(text); lex.sym := lxHEX ELSIF c = "X" THEN putchar(lex, c); - text.nextc(text); + TXT.next(text); lex.sym := lxCHAR ELSIF c = "." THEN @@ -247,39 +234,35 @@ BEGIN lex.sym := lxERROR01 ELSE - text.nextc(text); - c := text.peak(text); + c := nextc(text); IF c # "." THEN putchar(lex, "."); lex.sym := lxFLOAT ELSE lex.sym := lxINTEGER; - range := TRUE + text.peak := 7FX; + upto := TRUE END; WHILE S.digit(c) DO putchar(lex, c); - text.nextc(text); - c := text.peak(text) + c := nextc(text) END; IF c = "E" THEN putchar(lex, c); - text.nextc(text); - c := text.peak(text); + c := nextc(text); IF (c = "+") OR (c = "-") THEN putchar(lex, c); - text.nextc(text); - c := text.peak(text) + c := nextc(text) END; IF S.digit(c) THEN WHILE S.digit(c) DO putchar(lex, c); - text.nextc(text); - c := text.peak(text) + c := nextc(text) END ELSE lex.sym := lxERROR02 @@ -289,11 +272,8 @@ BEGIN END - ELSE - - IF hex THEN - lex.sym := lxERROR01 - END + ELSIF hex THEN + lex.sym := lxERROR01 END; @@ -321,31 +301,23 @@ BEGIN END number; -PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX); +PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR); VAR - c, c1: CHAR; - n: INTEGER; - quot: CHAR; + c: CHAR; + n: INTEGER; BEGIN - quot := text.peak(text); - - ASSERT((quot = '"') OR (quot = "'")); - - text.nextc(text); - c := text.peak(text); - c1 := c; - n := 0; + c := nextc(text); + n := 0; WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO putchar(lex, c); - text.nextc(text); - c := text.peak(text); + c := nextc(text); INC(n) END; IF c = quot THEN - text.nextc(text); + TXT.next(text); IF lex.over THEN lex.sym := lxERROR05 ELSE @@ -353,7 +325,7 @@ BEGIN lex.sym := lxSTRING ELSE lex.sym := lxCHAR; - ARITH.setChar(lex.value, ORD(c1)) + ARITH.setChar(lex.value, ORD(lex.s[0])) END END ELSE @@ -369,19 +341,19 @@ BEGIN END string; -PROCEDURE comment (text: TEXTDRV.TEXT); +PROCEDURE comment (text: TXT.TEXT); VAR c: CHAR; cond, depth: INTEGER; BEGIN - cond := 0; + cond := 0; depth := 1; REPEAT - c := text.peak(text); - text.nextc(text); + c := text.peak; + TXT.next(text); IF c = "*" THEN IF cond = 1 THEN @@ -406,21 +378,12 @@ BEGIN END comment; -PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); -VAR - c: CHAR; - +PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR); BEGIN - c := text.peak(text); - - IF range THEN - ASSERT(c = ".") - END; - putchar(lex, c); - text.nextc(text); + c := nextc(text); - CASE c OF + CASE lex.s[0] OF |"+": lex.sym := lxPLUS @@ -433,10 +396,10 @@ BEGIN |"/": lex.sym := lxSLASH; - IF text.peak(text) = "/" THEN + IF c = "/" THEN lex.sym := lxCOMMENT; REPEAT - text.nextc(text) + TXT.next(text) UNTIL text.eol OR text.eof END @@ -447,24 +410,12 @@ BEGIN lex.sym := lxAND |".": - IF range THEN + lex.sym := lxPOINT; - putchar(lex, "."); + IF c = "." THEN lex.sym := lxRANGE; - range := FALSE; - DEC(lex.pos.col) - - ELSE - - lex.sym := lxPOINT; - c := text.peak(text); - - IF c = "." THEN - lex.sym := lxRANGE; - putchar(lex, c); - text.nextc(text) - END - + putchar(lex, c); + TXT.next(text) END |",": @@ -478,12 +429,10 @@ BEGIN |"(": lex.sym := lxLROUND; - c := text.peak(text); IF c = "*" THEN lex.sym := lxCOMMENT; - putchar(lex, c); - text.nextc(text); + TXT.next(text); comment(text) END @@ -504,32 +453,29 @@ BEGIN |"<": lex.sym := lxLT; - c := text.peak(text); IF c = "=" THEN lex.sym := lxLE; putchar(lex, c); - text.nextc(text) + TXT.next(text) END |">": lex.sym := lxGT; - c := text.peak(text); IF c = "=" THEN lex.sym := lxGE; putchar(lex, c); - text.nextc(text) + TXT.next(text) END |":": lex.sym := lxCOLON; - c := text.peak(text); IF c = "=" THEN lex.sym := lxASSIGN; putchar(lex, c); - text.nextc(text) + TXT.next(text) END |")": @@ -546,26 +492,21 @@ BEGIN END delimiter; -PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX); +PROCEDURE Next* (text: SCANNER; VAR lex: LEX); VAR c: CHAR; - text: TEXTDRV.TEXT; BEGIN - text := scanner.text; REPEAT - - c := text.peak(text); + c := text.peak; WHILE S.space(c) DO - text.nextc(text); - c := text.peak(text) + c := nextc(text) END; lex.s[0] := 0X; lex.length := 0; - lex.sym := lxUNDEF; lex.pos.line := text.line; lex.pos.col := text.col; lex.ident := NIL; @@ -574,19 +515,26 @@ BEGIN IF S.letter(c) THEN ident(text, lex) ELSIF S.digit(c) THEN - number(text, lex, scanner.range) + number(text, lex) ELSIF (c = '"') OR (c = "'") THEN - string(text, lex) + string(text, lex, c) ELSIF vocabulary.delimiters[ORD(c)] THEN - delimiter(text, lex, scanner.range) + delimiter(text, lex, c) ELSIF c = 0X THEN lex.sym := lxEOF; IF text.eof THEN INC(lex.pos.col) END + ELSIF (c = 7FX) & upto THEN + upto := FALSE; + lex.sym := lxRANGE; + putchar(lex, "."); + putchar(lex, "."); + DEC(lex.pos.col); + TXT.next(text) ELSE putchar(lex, c); - text.nextc(text); + TXT.next(text); lex.sym := lxERROR04 END; @@ -601,53 +549,14 @@ BEGIN END Next; -PROCEDURE NewScanner (): SCANNER; -VAR - scan: SCANNER; - citem: C.ITEM; - -BEGIN - citem := C.pop(scanners); - IF citem = NIL THEN - NEW(scan) - ELSE - scan := citem(SCANNER) - END - - RETURN scan -END NewScanner; - - PROCEDURE open* (name: ARRAY OF CHAR): SCANNER; -VAR - scanner: SCANNER; - text: TEXTDRV.TEXT; - -BEGIN - text := TEXTDRV.create(); - IF text.open(text, name) THEN - scanner := NewScanner(); - scanner.text := text; - scanner.range := FALSE - ELSE - scanner := NIL; - TEXTDRV.destroy(text) - END - - RETURN scanner + RETURN TXT.open(name) END open; PROCEDURE close* (VAR scanner: SCANNER); BEGIN - IF scanner # NIL THEN - IF scanner.text # NIL THEN - TEXTDRV.destroy(scanner.text) - END; - - C.push(scanners, scanner); - scanner := NIL - END + TXT.close(scanner) END close; @@ -656,14 +565,16 @@ VAR i: INTEGER; delim: ARRAY 23 OF CHAR; + PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD); BEGIN vocabulary.KW[i] := kw; INC(i) END enterkw; + BEGIN - scanners := C.create(); + upto := FALSE; FOR i := 0 TO 255 DO vocabulary.delimiters[i] := FALSE @@ -714,7 +625,7 @@ BEGIN vocabulary.ident.s := ""; vocabulary.ident.offset := -1; vocabulary.ident.offsetW := -1; - vocabulary.idents := NIL + vocabulary.idents := NIL END init; diff --git a/programs/develop/oberon07/Source/STATEMENTS.ob07 b/programs/develop/oberon07/Source/STATEMENTS.ob07 index ef9886c11a..8f53dd80c4 100644 --- a/programs/develop/oberon07/Source/STATEMENTS.ob07 +++ b/programs/develop/oberon07/Source/STATEMENTS.ob07 @@ -9,8 +9,8 @@ MODULE STATEMENTS; IMPORT - PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64, - ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; + PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, + ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; CONST @@ -21,14 +21,16 @@ CONST eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC; eIMP = PARS.eIMP; - errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4; - errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8; + errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4; + errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8; errCHR = 9; errWCHR = 10; errBYTE = 11; chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5; chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; + cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3; + TYPE @@ -56,23 +58,27 @@ TYPE CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM) - label: INTEGER; - cmd: CODE.COMMAND; - processed: BOOLEAN + label: INTEGER; + cmd: IL.COMMAND; + processed: BOOLEAN END; VAR - begcall, endcall: CODE.COMMAND; + Options: PROG.OPTIONS; - checking: SET; + begcall, endcall: IL.COMMAND; CaseLabels, CaseVar: C.COLLECTION; CaseVariants: LISTS.LIST; + CPU: INTEGER; + + tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_; + PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC} @@ -85,17 +91,17 @@ END isVar; PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tBOOLEAN) + RETURN isExpr(e) & (e.type = tBOOLEAN) END isBoolean; PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER) + RETURN isExpr(e) & (e.type = tINTEGER) END isInteger; PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tBYTE) + RETURN isExpr(e) & (e.type = tBYTE) END isByte; @@ -105,12 +111,12 @@ END isInt; PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tREAL) + RETURN isExpr(e) & (e.type = tREAL) END isReal; PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tSET) + RETURN isExpr(e) & (e.type = tSET) END isSet; @@ -125,30 +131,15 @@ END isStringW; PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tCHAR) + RETURN isExpr(e) & (e.type = tCHAR) END isChar; -PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR) -END isCharArray; - - PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR) + RETURN isExpr(e) & (e.type = tWCHAR) END isCharW; -PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR) -END isCharArrayW; - - -PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; - RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) -END isCharArrayX; - - PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) END isPtr; @@ -159,6 +150,11 @@ PROCEDURE isRec (e: PARS.EXPR): BOOLEAN; END isRec; +PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN; + RETURN isRec(e) OR isPtr(e) +END isRecPtr; + + PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) END isArr; @@ -174,15 +170,33 @@ PROCEDURE isNil (e: PARS.EXPR): BOOLEAN; END isNil; -PROCEDURE getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); +PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; + RETURN isArr(e) & (e.type.base = tCHAR) +END isCharArray; + + +PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; + RETURN isArr(e) & (e.type.base = tWCHAR) +END isCharArrayW; + + +PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; + RETURN isCharArray(e) OR isCharArrayW(e) +END isCharArrayX; + + +PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION); BEGIN - pos := parser.lex.pos + pos.line := parser.lex.pos.line; + pos.col := parser.lex.pos.col; + pos.parser := parser END getpos; -PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); +PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION); BEGIN - PARS.NextPos(parser, pos) + PARS.Next(parser); + getpos(parser, pos) END NextPos; @@ -192,7 +206,7 @@ VAR BEGIN ASSERT(isString(e)); - IF e.type.typ = PROG.tCHAR THEN + IF e.type = tCHAR THEN res := 1 ELSE res := LENGTH(e.value.string(SCAN.IDENT).s) @@ -266,24 +280,24 @@ BEGIN IF arrcomp(e.type, t) THEN res := TRUE ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN - IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN + IF (e.obj = eCONST) & (t = tBYTE) THEN res := ARITH.range(e.value, 0, 255) ELSE res := TRUE END - ELSIF isSet(e) & (t.typ = PROG.tSET) THEN + ELSIF isSet(e) & (t = tSET) THEN res := TRUE - ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN + ELSIF isBoolean(e) & (t = tBOOLEAN) THEN res := TRUE - ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN + ELSIF isReal(e) & (t = tREAL) THEN res := TRUE - ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN + ELSIF isChar(e) & (t = tCHAR) THEN res := TRUE - ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN + ELSIF (e.obj = eCONST) & isChar(e) & (t = tWCHAR) THEN res := TRUE - ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN + ELSIF isStringW1(e) & (t = tWCHAR) THEN res := TRUE - ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN + ELSIF isCharW(e) & (t = tWCHAR) THEN res := TRUE ELSIF PROG.isBaseOf(t, e.type) THEN res := TRUE @@ -291,9 +305,9 @@ BEGIN res := TRUE ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN res := TRUE - ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN + ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))) THEN res := TRUE - ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tWCHAR) & (t.length > utf8strlen(e))) THEN + ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))) THEN res := TRUE ELSE res := FALSE @@ -314,11 +328,11 @@ BEGIN IF strlen(e) # 1 THEN string := e.value.string(SCAN.IDENT); IF string.offset = -1 THEN - string.offset := CODE.putstr(string.s); + string.offset := IL.putstr(string.s); END; offset := string.offset ELSE - offset := CODE.putstr1(ARITH.Int(e.value)) + offset := IL.putstr1(ARITH.Int(e.value)) END RETURN offset @@ -334,16 +348,16 @@ BEGIN IF utf8strlen(e) # 1 THEN string := e.value.string(SCAN.IDENT); IF string.offsetW = -1 THEN - string.offsetW := CODE.putstrW(string.s); + string.offsetW := IL.putstrW(string.s); END; offset := string.offsetW ELSE IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN - offset := CODE.putstrW1(ARITH.Int(e.value)) + offset := IL.putstrW1(ARITH.Int(e.value)) ELSE (* e.type.typ = PROG.tSTRING *) string := e.value.string(SCAN.IDENT); IF string.offsetW = -1 THEN - string.offsetW := CODE.putstrW(string.s); + string.offsetW := IL.putstrW(string.s); END; offset := string.offsetW END @@ -358,10 +372,10 @@ VAR label: INTEGER; BEGIN - label := CODE.NewLabel(); - CODE.AddCmd2(CODE.opCHKIDX, label, range); - CODE.OnError(line, errno); - CODE.SetLabel(label) + label := IL.NewLabel(); + IL.AddCmd2(IL.opCHKIDX, label, range); + IL.OnError(line, errno); + IL.SetLabel(label) END CheckRange; @@ -384,98 +398,98 @@ BEGIN IF arrcomp(e.type, VarType) THEN IF ~PROG.isOpenArray(VarType) THEN - CODE.AddCmd(CODE.opCONST, VarType.length) + IL.Const(VarType.length) END; - CODE.AddCmd(CODE.opCOPYA, VarType.base.size); - label := CODE.NewLabel(); - CODE.AddJmpCmd(CODE.opJE, label); - CODE.OnError(line, errCOPY); - CODE.SetLabel(label) + IL.AddCmd(IL.opCOPYA, VarType.base.size); + label := IL.NewLabel(); + IL.AddJmpCmd(IL.opJE, label); + IL.OnError(line, errCOPY); + IL.SetLabel(label) ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN - IF VarType.typ = PROG.tINTEGER THEN + IF VarType = tINTEGER THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSAVE) + IL.AddCmd0(IL.opSAVE) END ELSE IF e.obj = eCONST THEN res := ARITH.range(e.value, 0, 255); IF res THEN - CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) END ELSE - IF chkBYTE IN checking THEN - label := CODE.NewLabel(); - CODE.AddCmd2(CODE.opCHKBYTE, label, 0); - CODE.OnError(line, errBYTE); - CODE.SetLabel(label) + IF chkBYTE IN Options.checking THEN + label := IL.NewLabel(); + IL.AddCmd2(IL.opCHKBYTE, label, 0); + IL.OnError(line, errBYTE); + IL.SetLabel(label) END; - CODE.AddCmd0(CODE.opSAVE8) + IL.AddCmd0(IL.opSAVE8) END END - ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN + ELSIF isSet(e) & (VarType = tSET) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSAVE) + IL.AddCmd0(IL.opSAVE) END - ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN + ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value)) + IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSBOOL) + IL.AddCmd0(IL.opSBOOL) END - ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN + ELSIF isReal(e) & (VarType = tREAL) THEN IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)) + IL.Float(ARITH.Float(e.value)) END; - CODE.savef - ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN + IL.savef + ELSIF isChar(e) & (VarType = tCHAR) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSAVE8) + IL.AddCmd0(IL.opSAVE8) END - ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN - CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) - ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN - CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) - ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN + ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN + IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) + ELSIF isStringW1(e) & (VarType = tWCHAR) THEN + IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) + ELSIF isCharW(e) & (VarType = tWCHAR) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSAVE16) + IL.AddCmd0(IL.opSAVE16) END ELSIF PROG.isBaseOf(VarType, e.type) THEN IF VarType.typ = PROG.tPOINTER THEN - CODE.AddCmd0(CODE.opSAVE) + IL.AddCmd0(IL.opSAVE) ELSE - CODE.AddCmd(CODE.opCOPY, VarType.size) + IL.AddCmd(IL.opCOPY, VarType.size) END ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN - CODE.AddCmd0(CODE.opSAVE32) + IL.AddCmd0(IL.opSAVE32) ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN - CODE.AddCmd0(CODE.opSAVE16) + IL.AddCmd0(IL.opSAVE16) ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN IF e.obj = ePROC THEN - CODE.AssignProc(e.ident.proc.label) + IL.AssignProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - CODE.AssignImpProc(e.ident.import) + IL.AssignImpProc(e.ident.import) ELSE IF VarType.typ = PROG.tPROCEDURE THEN - CODE.AddCmd0(CODE.opSAVE) + IL.AddCmd0(IL.opSAVE) ELSE - CODE.AddCmd(CODE.opCOPY, VarType.size) + IL.AddCmd(IL.opCOPY, VarType.size) END END ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN - CODE.AddCmd(CODE.opSAVEC, 0) - ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN - CODE.saves(String(e), strlen(e) + 1) - ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN - CODE.saves(StringW(e), (utf8strlen(e) + 1) * 2) + IL.AddCmd(IL.opSAVEC, 0) + ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN + IL.saves(String(e), strlen(e) + 1) + ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN + IL.saves(StringW(e), (utf8strlen(e) + 1) * 2) ELSE res := FALSE END @@ -488,11 +502,13 @@ END assign; PROCEDURE LoadConst (e: PARS.EXPR); BEGIN - CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value)) + IL.Const(ARITH.Int(e.value)) END LoadConst; -PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM); +PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM); +VAR + stroffs: INTEGER; PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; VAR @@ -530,11 +546,11 @@ PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: P d1, d2: INTEGER; BEGIN IF t.length # 0 THEN - CODE.AddCmd(CODE.opPARAM, 1); + IL.Param1; n := PROG.Dim(t2) - 1; WHILE n >= 0 DO - CODE.AddCmd(CODE.opCONST, ArrLen(t, n)); - CODE.AddCmd(CODE.opPARAM, 1); + IL.Const(ArrLen(t, n)); + IL.Param1; DEC(n) END ELSE @@ -543,16 +559,16 @@ PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: P IF d1 # d2 THEN n := d2 - d1; WHILE d2 > d1 DO - CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1)); + IL.Const(ArrLen(t, d2 - 1)); DEC(d2) END; d2 := PROG.Dim(t2); WHILE n > 0 DO - CODE.AddCmd(CODE.opROT, d2); + IL.AddCmd(IL.opROT, d2); DEC(n) END END; - CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1) + IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1) END END OpenArray; @@ -560,87 +576,92 @@ PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: P BEGIN IF p.vPar THEN - PARS.check(isVar(e), parser, pos, 93); + PARS.check(isVar(e), pos, 93); IF p.type.typ = PROG.tRECORD THEN - PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66); + PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66); IF e.obj = eVREC THEN IF e.ident # NIL THEN - CODE.AddCmd(CODE.opVADR, e.ident.offset - 1) + IL.AddCmd(IL.opVADR, e.ident.offset - 1) ELSE - CODE.AddCmd0(CODE.opPUSHT) + IL.AddCmd0(IL.opPUSHT) END ELSE - CODE.AddCmd(CODE.opCONST, e.type.num) + IL.Const(e.type.num) END; - CODE.AddCmd(CODE.opPARAM, 2) + IL.AddCmd(IL.opPARAM, 2) ELSIF PROG.isOpenArray(p.type) THEN - PARS.check(arrcomp(e, p), parser, pos, 66); + PARS.check(arrcomp(e, p), pos, 66); OpenArray(e.type, p.type) ELSE - PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66); - CODE.AddCmd(CODE.opPARAM, 1) + PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66); + IL.Param1 END; - PARS.check(~e.readOnly, parser, pos, 94) + PARS.check(~e.readOnly, pos, 94) ELSE - PARS.check(isExpr(e) OR isProc(e), parser, pos, 66); + PARS.check(isExpr(e) OR isProc(e), pos, 66); IF PROG.isOpenArray(p.type) THEN IF e.type.typ = PROG.tARRAY THEN - PARS.check(arrcomp(e, p), parser, pos, 66); + PARS.check(arrcomp(e, p), pos, 66); OpenArray(e.type, p.type) - ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN - CODE.AddCmd(CODE.opSADR, String(e)); - CODE.AddCmd(CODE.opPARAM, 1); - CODE.AddCmd(CODE.opCONST, strlen(e) + 1); - CODE.AddCmd(CODE.opPARAM, 1) - ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN - CODE.AddCmd(CODE.opSADR, StringW(e)); - CODE.AddCmd(CODE.opPARAM, 1); - CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); - CODE.AddCmd(CODE.opPARAM, 1) + 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 + IL.StrAdr(StringW(e)); + IL.Param1; + IL.Const(utf8strlen(e) + 1); + IL.Param1 ELSE - PARS.error(parser, pos, 66) + PARS.error(pos, 66) END ELSE - PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66); - PARS.check(assigncomp(e, p.type), parser, 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.typ = PROG.tREAL THEN - CODE.Float(ARITH.Float(e.value)); - CODE.pushf + IF e.type = tREAL THEN + IL.Float(ARITH.Float(e.value)); + IL.pushf ELSIF e.type.typ = PROG.tNIL THEN - CODE.AddCmd(CODE.opCONST, 0); - CODE.AddCmd(CODE.opPARAM, 1) - ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN - CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s)); - CODE.AddCmd(CODE.opPARAM, 1) + IL.Const(0); + IL.Param1 + 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 - CODE.SetMinDataSize(p.type.size); - IF p.type.base.typ = PROG.tCHAR THEN - CODE.AddCmd(CODE.opSADR, String(e)) + IF p.type.base = tCHAR THEN + stroffs := String(e); + IL.StrAdr(stroffs); + IF (CPU = cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN + ERRORS.WarningMsg(pos.line, pos.col, 0) + END ELSE (* WCHAR *) - CODE.AddCmd(CODE.opSADR, StringW(e)) + stroffs := StringW(e); + IL.StrAdr(stroffs) END; - CODE.AddCmd(CODE.opPARAM, 1) + IL.codes.dmin := stroffs + p.type.size; + IL.Param1 ELSE LoadConst(e); - CODE.AddCmd(CODE.opPARAM, 1) + IL.Param1 END ELSIF e.obj = ePROC THEN - PARS.check(e.ident.global, parser, pos, 85); - CODE.PushProc(e.ident.proc.label); - CODE.AddCmd(CODE.opPARAM, 1) + PARS.check(e.ident.global, pos, 85); + IL.PushProc(e.ident.proc.label); + IL.Param1 ELSIF e.obj = eIMP THEN - CODE.PushImpProc(e.ident.import); - CODE.AddCmd(CODE.opPARAM, 1) - ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN - CODE.pushf + IL.PushImpProc(e.ident.import); + IL.Param1 + ELSIF isExpr(e) & (e.type = tREAL) THEN + IL.pushf ELSE - IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN + IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN CheckRange(256, pos.line, errBYTE) END; - CODE.AddCmd(CODE.opPARAM, 1) + IL.Param1 END END @@ -648,10 +669,16 @@ BEGIN END paramcomp; +PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); +BEGIN + parser.expression(parser, e) +END PExpression; + + PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR e2: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; proc: INTEGER; label: INTEGER; n, i: INTEGER; @@ -659,16 +686,17 @@ VAR e1: PARS.EXPR; wchar: BOOLEAN; cmd1, - cmd2: CODE.COMMAND; + cmd2: IL.COMMAND; + comma: BOOLEAN; - PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); + PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); BEGIN parser.designator(parser, e); - PARS.check(isVar(e), parser, pos, 93); - PARS.check(isfunc(e), parser, pos, 66); + PARS.check(isVar(e), pos, 93); + PARS.check(isfunc(e), pos, 66); IF readOnly THEN - PARS.check(~e.readOnly, parser, pos, 94) + PARS.check(~e.readOnly, pos, 94) END END varparam; @@ -691,13 +719,18 @@ VAR BEGIN ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC}); + proc := e.stproc; + +(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) + PARS.checklex(parser, SCAN.lxLROUND); + PARS.Next(parser); +(* END; *) getpos(parser, pos); - proc := e.stproc; IF e.obj IN {eSYSPROC, eSYSFUNC} THEN IF parser.unit.scopeLvl > 0 THEN - parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE + parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE END END; @@ -705,90 +738,93 @@ BEGIN CASE proc OF |PROG.stASSERT: - parser.expression(parser, e); - PARS.check(isBoolean(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isBoolean(e), pos, 66); IF e.obj = eCONST THEN IF ~ARITH.getBool(e.value) THEN - CODE.OnError(pos.line, errASSERT) + IL.OnError(pos.line, errASSERT) END ELSE - label := CODE.NewLabel(); - CODE.AddJmpCmd(CODE.opJE, label); - CODE.OnError(pos.line, errASSERT); - CODE.SetLabel(label) + label := IL.NewLabel(); + IL.AddJmpCmd(IL.opJE, label); + IL.OnError(pos.line, errASSERT); + IL.SetLabel(label) END |PROG.stINC, PROG.stDEC: - CODE.pushBegEnd(begcall, endcall); + IL.pushBegEnd(begcall, endcall); varparam(parser, pos, isInt, TRUE, e); - IF e.type.typ = PROG.tINTEGER THEN + IF e.type = tINTEGER THEN IF parser.sym = SCAN.lxCOMMA THEN NextPos(parser, pos); - CODE.setlast(begcall); - parser.expression(parser, e2); - CODE.setlast(endcall.prev(CODE.COMMAND)); - PARS.check(isInt(e2), parser, pos, 66); + IL.setlast(begcall); + PExpression(parser, e2); + IL.setlast(endcall.prev(IL.COMMAND)); + PARS.check(isInt(e2), pos, 66); IF e2.obj = eCONST THEN - CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) + IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1)) ELSE - CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC)) + IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC)) END ELSE - CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC)) + IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1) END - ELSE (* e.type.typ = PROG.tBYTE *) + ELSE (* e.type = tBYTE *) IF parser.sym = SCAN.lxCOMMA THEN NextPos(parser, pos); - CODE.setlast(begcall); - parser.expression(parser, e2); - CODE.setlast(endcall.prev(CODE.COMMAND)); - PARS.check(isInt(e2), parser, pos, 66); + IL.setlast(begcall); + PExpression(parser, e2); + IL.setlast(endcall.prev(IL.COMMAND)); + PARS.check(isInt(e2), pos, 66); IF e2.obj = eCONST THEN - CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) + IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) ELSE - CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC)) + IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC)) END ELSE - CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC)) + IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1) END END; - CODE.popBegEnd(begcall, endcall) + IL.popBegEnd(begcall, endcall) |PROG.stINCL, PROG.stEXCL: - CODE.pushBegEnd(begcall, endcall); + IL.pushBegEnd(begcall, endcall); varparam(parser, pos, isSet, TRUE, e); PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); - CODE.setlast(begcall); - parser.expression(parser, e2); - CODE.setlast(endcall.prev(CODE.COMMAND)); - PARS.check(isInt(e2), parser, pos, 66); + IL.setlast(begcall); + PExpression(parser, e2); + IL.setlast(endcall.prev(IL.COMMAND)); + PARS.check(isInt(e2), pos, 66); IF e2.obj = eCONST THEN - PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56); - CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) + PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56); + IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) ELSE - CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL)) + IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL)) END; - CODE.popBegEnd(begcall, endcall) + IL.popBegEnd(begcall, endcall) |PROG.stNEW: varparam(parser, pos, isPtr, TRUE, e); - CODE.New(e.type.base.size, e.type.base.num) + IF CPU = cpuMSP430 THEN + PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) + END; + IL.New(e.type.base.size, e.type.base.num) |PROG.stDISPOSE: varparam(parser, pos, isPtr, TRUE, e); - CODE.AddCmd0(CODE.opDISP) + IL.AddCmd0(IL.opDISP) |PROG.stPACK: varparam(parser, pos, isReal, TRUE, e); PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); - parser.expression(parser, e2); - PARS.check(isInt(e2), parser, pos, 66); + PExpression(parser, e2); + PARS.check(isInt(e2), pos, 66); IF e2.obj = eCONST THEN - CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value)) + IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value)) ELSE - CODE.AddCmd0(CODE.opPACK) + IL.AddCmd0(IL.opPACK) END |PROG.stUNPK: @@ -796,24 +832,26 @@ BEGIN PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); varparam(parser, pos, isInteger, TRUE, e2); - CODE.AddCmd0(CODE.opUNPK) + IL.AddCmd0(IL.opUNPK) |PROG.stCOPY: - parser.expression(parser, e); + IL.pushBegEnd(begcall, endcall); + PExpression(parser, e); IF isString(e) OR isCharArray(e) THEN wchar := FALSE ELSIF isStringW(e) OR isCharArrayW(e) THEN wchar := TRUE ELSE - PARS.check(FALSE, parser, pos, 66) + PARS.error(pos, 66) END; IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN - CODE.AddCmd(CODE.opCONST, e.type.length) + IL.Const(e.type.length) END; PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); + IL.setlast(begcall); IF wchar THEN varparam(parser, pos, isCharArrayW, TRUE, e1) @@ -824,96 +862,96 @@ BEGIN varparam(parser, pos, isCharArray, TRUE, e1) END; - wchar := e1.type.base.typ = PROG.tWCHAR + wchar := e1.type.base = tWCHAR END; IF ~PROG.isOpenArray(e1.type) THEN - CODE.AddCmd(CODE.opCONST, e1.type.length) + IL.Const(e1.type.length) END; + IL.setlast(endcall.prev(IL.COMMAND)); + IF e.obj = eCONST THEN IF wchar THEN - CODE.AddCmd(CODE.opSADR, StringW(e)); - CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1) + IL.StrAdr(StringW(e)); + IL.Const(utf8strlen(e) + 1) ELSE - CODE.AddCmd(CODE.opSADR, String(e)); - CODE.AddCmd(CODE.opCONST, strlen(e) + 1) - END; - CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size) - ELSE - CODE.AddCmd(CODE.opCOPYS, e1.type.base.size) - END + IL.StrAdr(String(e)); + IL.Const(strlen(e) + 1) + END + END; + IL.AddCmd(IL.opCOPYS, e1.type.base.size); + IL.popBegEnd(begcall, endcall) |PROG.sysGET: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); - IF e.obj = eCONST THEN - LoadConst(e) - END; + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); parser.designator(parser, e2); - PARS.check(isVar(e2), parser, pos, 93); - PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); - CODE.SysGet(e2.type.size) + PARS.check(isVar(e2), pos, 93); + 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), e2.type.size) + ELSE + IL.AddCmd(IL.opGET, e2.type.size) + END |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: - CODE.pushBegEnd(begcall, endcall); - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + IL.pushBegEnd(begcall, endcall); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); IF e.obj = eCONST THEN LoadConst(e) END; PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); - CODE.setlast(begcall); - parser.expression(parser, e2); - PARS.check(isExpr(e2), parser, pos, 66); + IL.setlast(begcall); + PExpression(parser, e2); + PARS.check(isExpr(e2), pos, 66); IF proc = PROG.sysPUT THEN - PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); + PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); IF e2.obj = eCONST THEN - IF e2.type.typ = PROG.tREAL THEN - CODE.setlast(endcall.prev(CODE.COMMAND)); - CODE.Float(ARITH.Float(e2.value)); - CODE.savef + IF e2.type = tREAL THEN + IL.setlast(endcall.prev(IL.COMMAND)); + IL.Float(ARITH.Float(e2.value)); + IL.savef ELSE LoadConst(e2); - CODE.setlast(endcall.prev(CODE.COMMAND)); - CODE.SysPut(e2.type.size) + IL.setlast(endcall.prev(IL.COMMAND)); + IL.SysPut(e2.type.size) END ELSE - CODE.setlast(endcall.prev(CODE.COMMAND)); - IF e2.type.typ = PROG.tREAL THEN - CODE.savef - ELSIF e2.type.typ = PROG.tBYTE THEN - CODE.SysPut(PARS.program.stTypes.tINTEGER.size) + IL.setlast(endcall.prev(IL.COMMAND)); + IF e2.type = tREAL THEN + IL.savef + ELSIF e2.type = tBYTE THEN + IL.SysPut(tINTEGER.size) ELSE - CODE.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.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66); + PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, pos, 66); IF e2.obj = eCONST THEN LoadConst(e2) END; - CODE.setlast(endcall.prev(CODE.COMMAND)); - IF proc = PROG.sysPUT8 THEN - CODE.SysPut(1) - ELSIF proc = PROG.sysPUT16 THEN - CODE.SysPut(2) - ELSIF proc = PROG.sysPUT32 THEN - CODE.SysPut(4) + IL.setlast(endcall.prev(IL.COMMAND)); + CASE proc OF + |PROG.sysPUT8: IL.SysPut(1) + |PROG.sysPUT16: IL.SysPut(2) + |PROG.sysPUT32: IL.SysPut(4) END END; - CODE.popBegEnd(begcall, endcall) + IL.popBegEnd(begcall, endcall) |PROG.sysMOVE: FOR i := 1 TO 2 DO - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); IF e.obj = eCONST THEN LoadConst(e) END; @@ -921,47 +959,63 @@ BEGIN NextPos(parser, pos) END; - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); IF e.obj = eCONST THEN LoadConst(e) END; - CODE.AddCmd0(CODE.opMOVE) + IL.AddCmd0(IL.opMOVE) |PROG.sysCOPY: FOR i := 1 TO 2 DO parser.designator(parser, e); - PARS.check(isVar(e), parser, pos, 93); + PARS.check(isVar(e), pos, 93); n := PROG.Dim(e.type); WHILE n > 0 DO - CODE.drop; + IL.drop; DEC(n) END; PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos) END; - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); IF e.obj = eCONST THEN LoadConst(e) END; - CODE.AddCmd0(CODE.opMOVE) + IL.AddCmd0(IL.opMOVE) |PROG.sysCODE: REPEAT getpos(parser, pos); PARS.ConstExpression(parser, code); - PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43); - PARS.check(ARITH.range(code, 0, 255), parser, pos, 42); - IF parser.sym = SCAN.lxCOMMA THEN + PARS.check(code.typ = ARITH.tINTEGER, pos, 43); + IF CPU # cpuMSP430 THEN + PARS.check(ARITH.range(code, 0, 255), pos, 42) + END; + IL.AddCmd(IL.opCODE, ARITH.getInt(code)); + comma := parser.sym = SCAN.lxCOMMA; + IF comma THEN PARS.Next(parser) ELSE PARS.checklex(parser, SCAN.lxRROUND) - END; - CODE.AddCmd(CODE.opCODE, ARITH.getInt(code)) - UNTIL parser.sym = SCAN.lxRROUND - + END + UNTIL (parser.sym = SCAN.lxRROUND) & ~comma + (* + |PROG.sysNOP, PROG.sysDINT, PROG.sysEINT: + IF parser.sym = SCAN.lxLROUND THEN + PARS.Next(parser); + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser) + END; + ASSERT(CPU = cpuMSP430); + CASE proc OF + |PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H) + |PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H) + |PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H) + END + *) END; e.obj := eEXPR; @@ -971,129 +1025,129 @@ BEGIN CASE e.stproc OF |PROG.stABS: - parser.expression(parser, e); - PARS.check(isInt(e) OR isReal(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e) OR isReal(e), pos, 66); IF e.obj = eCONST THEN - PARS.check(ARITH.abs(e.value), parser, pos, 39) + PARS.check(ARITH.abs(e.value), pos, 39) ELSE - CODE.abs(isReal(e)) + IL.abs(isReal(e)) END |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); PARS.checklex(parser, SCAN.lxCOMMA); NextPos(parser, pos); - parser.expression(parser, e2); - PARS.check(isInt(e2), parser, pos, 66); - e.type := PARS.program.stTypes.tINTEGER; + PExpression(parser, e2); + PARS.check(isInt(e2), pos, 66); + e.type := tINTEGER; IF (e.obj = eCONST) & (e2.obj = eCONST) THEN ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) ELSE IF e.obj = eCONST THEN - CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) + IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) ELSIF e2.obj = eCONST THEN - CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) + IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) ELSE - CODE.shift_minmax(shift_minmax(proc)) + IL.shift_minmax(shift_minmax(proc)) END; e.obj := eEXPR END |PROG.stCHR: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); - e.type := PARS.program.stTypes.tCHAR; + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); + e.type := tCHAR; IF e.obj = eCONST THEN ARITH.setChar(e.value, ARITH.getInt(e.value)); - PARS.check(ARITH.check(e.value), parser, pos, 107) + PARS.check(ARITH.check(e.value), pos, 107) ELSE - IF chkCHR IN checking THEN + IF chkCHR IN Options.checking THEN CheckRange(256, pos.line, errCHR) ELSE - CODE.AddCmd0(CODE.opCHR) + IL.AddCmd0(IL.opCHR) END END |PROG.stWCHR: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); - e.type := PARS.program.stTypes.tWCHAR; + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); + e.type := tWCHAR; IF e.obj = eCONST THEN ARITH.setWChar(e.value, ARITH.getInt(e.value)); - PARS.check(ARITH.check(e.value), parser, pos, 101) + PARS.check(ARITH.check(e.value), pos, 101) ELSE - IF chkWCHR IN checking THEN + IF chkWCHR IN Options.checking THEN CheckRange(65536, pos.line, errWCHR) ELSE - CODE.AddCmd0(CODE.opWCHR) + IL.AddCmd0(IL.opWCHR) END END |PROG.stFLOOR: - parser.expression(parser, e); - PARS.check(isReal(e), parser, pos, 66); - e.type := PARS.program.stTypes.tINTEGER; + PExpression(parser, e); + PARS.check(isReal(e), pos, 66); + e.type := tINTEGER; IF e.obj = eCONST THEN - PARS.check(ARITH.floor(e.value), parser, pos, 39) + PARS.check(ARITH.floor(e.value), pos, 39) ELSE - CODE.floor + IL.floor END |PROG.stFLT: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); - e.type := PARS.program.stTypes.tREAL; + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); + e.type := tREAL; IF e.obj = eCONST THEN ARITH.flt(e.value) ELSE - PARS.check(CODE.flt(), parser, pos, 41) + PARS.check(IL.flt(), pos, 41) END |PROG.stLEN: - cmd1 := CODE.getlast(); + cmd1 := IL.getlast(); varparam(parser, pos, isArr, FALSE, e); IF e.type.length > 0 THEN - cmd2 := CODE.getlast(); - CODE.delete2(cmd1.next, cmd2); - CODE.setlast(cmd1); + cmd2 := IL.getlast(); + IL.delete2(cmd1.next, cmd2); + IL.setlast(cmd1); ASSERT(ARITH.setInt(e.value, e.type.length)); e.obj := eCONST ELSE - CODE.len(PROG.Dim(e.type)) + IL.len(PROG.Dim(e.type)) END; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER |PROG.stLENGTH: - parser.expression(parser, e); + PExpression(parser, e); IF isCharArray(e) THEN IF e.type.length > 0 THEN - CODE.AddCmd(CODE.opCONST, e.type.length) + IL.Const(e.type.length) END; - CODE.AddCmd0(CODE.opLENGTH) + IL.AddCmd0(IL.opLENGTH) ELSIF isCharArrayW(e) THEN IF e.type.length > 0 THEN - CODE.AddCmd(CODE.opCONST, e.type.length) + IL.Const(e.type.length) END; - CODE.AddCmd0(CODE.opLENGTHW) + IL.AddCmd0(IL.opLENGTHW) ELSE - PARS.check(FALSE, parser, pos, 66); + PARS.error(pos, 66); END; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER |PROG.stODD: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); - e.type := PARS.program.stTypes.tBOOLEAN; + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); + e.type := tBOOLEAN; IF e.obj = eCONST THEN ARITH.odd(e.value) ELSE - CODE.odd + IL.odd END |PROG.stORD: - parser.expression(parser, e); - PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66); IF e.obj = eCONST THEN IF isStringW1(e) THEN ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s))) @@ -1102,81 +1156,83 @@ BEGIN END ELSE IF isBoolean(e) THEN - CODE.ord + IL.ord END END; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER |PROG.stBITS: - parser.expression(parser, e); - PARS.check(isInt(e), parser, pos, 66); + PExpression(parser, e); + PARS.check(isInt(e), pos, 66); IF e.obj = eCONST THEN ARITH.bits(e.value) END; - e.type := PARS.program.stTypes.tSET + e.type := tSET |PROG.sysADR: parser.designator(parser, e); IF isVar(e) THEN n := PROG.Dim(e.type); WHILE n > 0 DO - CODE.drop; + IL.drop; DEC(n) END ELSIF e.obj = ePROC THEN - CODE.PushProc(e.ident.proc.label) + IL.PushProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - CODE.PushImpProc(e.ident.import) + IL.PushImpProc(e.ident.import) ELSE - PARS.check(FALSE, parser, pos, 108) + PARS.error(pos, 108) END; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER |PROG.sysSADR: - parser.expression(parser, e); - PARS.check(isString(e), parser, pos, 66); - CODE.AddCmd(CODE.opSADR, String(e)); - e.type := PARS.program.stTypes.tINTEGER; + PExpression(parser, e); + PARS.check(isString(e), pos, 66); + IL.StrAdr(String(e)); + e.type := tINTEGER; e.obj := eEXPR |PROG.sysWSADR: - parser.expression(parser, e); - PARS.check(isStringW(e), parser, pos, 66); - CODE.AddCmd(CODE.opSADR, StringW(e)); - e.type := PARS.program.stTypes.tINTEGER; + PExpression(parser, e); + PARS.check(isStringW(e), pos, 66); + IL.StrAdr(StringW(e)); + e.type := tINTEGER; e.obj := eEXPR |PROG.sysTYPEID: - parser.expression(parser, e); - PARS.check(e.obj = eTYPE, parser, pos, 68); + 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 + ELSIF e.type.typ = PROG.tPOINTER THEN ASSERT(ARITH.setInt(e.value, e.type.base.num)) ELSE - PARS.check(FALSE, parser, pos, 52) + PARS.error(pos, 52) END; e.obj := eCONST; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER |PROG.sysINF: - PARS.check(CODE.inf(), parser, pos, 41); + PARS.check(IL.inf(), pos, 41); e.obj := eEXPR; - e.type := PARS.program.stTypes.tREAL + e.type := tREAL |PROG.sysSIZE: - parser.expression(parser, e); - PARS.check(e.obj = eTYPE, parser, pos, 68); + PExpression(parser, e); + PARS.check(e.obj = eTYPE, pos, 68); ASSERT(ARITH.setInt(e.value, e.type.size)); e.obj := eCONST; - e.type := PARS.program.stTypes.tINTEGER + e.type := tINTEGER END END; - PARS.checklex(parser, SCAN.lxRROUND); - PARS.Next(parser); +(* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser); +(* END; *) IF e.obj # eCONST THEN e.obj := eEXPR @@ -1190,7 +1246,7 @@ VAR proc: PROG.TYPE_; param: LISTS.ITEM; e1: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; BEGIN ASSERT(parser.sym = SCAN.lxLROUND); @@ -1204,12 +1260,12 @@ BEGIN WHILE param # NIL DO getpos(parser, pos); - CODE.setlast(begcall); + IL.setlast(begcall); IF param(PROG.PARAM).vPar THEN parser.designator(parser, e1) ELSE - parser.expression(parser, e1) + PExpression(parser, e1) END; paramcomp(parser, pos, e1, param(PROG.PARAM)); param := param.next; @@ -1226,7 +1282,6 @@ BEGIN e.type := proc.base ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN - PARS.Next(parser); stProc(parser, e) ELSE PARS.check1(FALSE, parser, 86) @@ -1239,18 +1294,18 @@ PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR ident: PROG.IDENT; import: BOOLEAN; - pos: SCAN.POSITION; + pos: PARS.POSITION; BEGIN PARS.checklex(parser, SCAN.lxIDENT); getpos(parser, pos); import := FALSE; - ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); + ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); PARS.check1(ident # NIL, parser, 48); IF ident.typ = PROG.idMODULE THEN PARS.ExpectSym(parser, SCAN.lxPOINT); PARS.ExpectSym(parser, SCAN.lxIDENT); - ident := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE); + ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE); PARS.check1((ident # NIL) & ident.export, parser, 48); import := TRUE END; @@ -1298,34 +1353,34 @@ BEGIN e.obj := eSYSPROC; e.stproc := ident.stproc |PROG.idSYSFUNC: - PARS.check(~parser.constexp, parser, pos, 109); + PARS.check(~parser.constexp, pos, 109); e.obj := eSYSFUNC; e.stproc := ident.stproc |PROG.idNONE: - PARS.check(FALSE, parser, pos, 115) + PARS.error(pos, 115) END; IF isVar(e) THEN - PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105) + PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105) END END qualident; -PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); +PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); VAR label: INTEGER; BEGIN IF load THEN - CODE.load(e.type.size) + IL.load(e.type.size) END; - IF chkPTR IN checking THEN - label := CODE.NewLabel(); - CODE.AddJmpCmd(CODE.opJNZ, label); - CODE.OnError(pos.line, error); - CODE.SetLabel(label) + IF chkPTR IN Options.checking THEN + label := IL.NewLabel(); + IL.AddJmpCmd(IL.opJNZ, label); + IL.OnError(pos.line, error); + IL.SetLabel(label) END END deref; @@ -1333,7 +1388,7 @@ END deref; PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR field: PROG.FIELD; - pos: SCAN.POSITION; + pos: PARS.POSITION; t, idx: PARS.EXPR; @@ -1348,7 +1403,7 @@ VAR offset := e.ident.offset; n := PROG.Dim(e.type); WHILE n >= 0 DO - CODE.AddCmd(CODE.opVADR, offset); + IL.AddCmd(IL.opVADR, offset); DEC(offset); DEC(n) END @@ -1359,29 +1414,29 @@ VAR IF e.obj = eVAR THEN offset := PROG.getOffset(PARS.program, e.ident); IF e.ident.global THEN - CODE.AddCmd(CODE.opGADR, offset) + IL.AddCmd(IL.opGADR, offset) ELSE - CODE.AddCmd(CODE.opLADR, -offset) + 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 - CODE.AddCmd(CODE.opVADR, e.ident.offset) + IL.AddCmd(IL.opVADR, e.ident.offset) ELSIF PROG.isOpenArray(e.type) THEN OpenArray(e) ELSE - CODE.AddCmd(CODE.opLADR, e.ident.offset) + IL.AddCmd(IL.opLADR, e.ident.offset) END ELSIF e.obj IN {eVPAR, eVREC} THEN IF PROG.isOpenArray(e.type) THEN OpenArray(e) ELSE - CODE.AddCmd(CODE.opVADR, e.ident.offset) + IL.AddCmd(IL.opVADR, e.ident.offset) END END END LoadAdr; - PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR); + PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); VAR label: INTEGER; type: PROG.TYPE_; @@ -1389,30 +1444,30 @@ VAR BEGIN - IF chkIDX IN checking THEN - label := CODE.NewLabel(); - CODE.AddCmd2(CODE.opCHKIDX2, label, 0); - CODE.OnError(pos.line, errIDX); - CODE.SetLabel(label) + IF chkIDX IN Options.checking THEN + label := IL.NewLabel(); + IL.AddCmd2(IL.opCHKIDX2, label, 0); + IL.OnError(pos.line, errIDX); + IL.SetLabel(label) ELSE - CODE.AddCmd(CODE.opCHKIDX2, -1) + IL.AddCmd(IL.opCHKIDX2, -1) END; type := PROG.OpenBase(e.type); IF type.size # 1 THEN - CODE.AddCmd(CODE.opMULC, type.size) + IL.AddCmd(IL.opMULC, type.size) END; n := PROG.Dim(e.type) - 1; k := n; WHILE n > 0 DO - CODE.AddCmd0(CODE.opMUL); + IL.AddCmd0(IL.opMUL); DEC(n) END; - CODE.AddCmd0(CODE.opADD); + IL.AddCmd0(IL.opADD); offset := e.ident.offset - 1; n := k; WHILE n > 0 DO - CODE.AddCmd(CODE.opVADR, offset); + IL.AddCmd(IL.opVADR, offset); DEC(offset); DEC(n) END @@ -1441,14 +1496,14 @@ BEGIN e.type := e.type.base; e.readOnly := FALSE END; - field := e.type.fields.get(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; IF e.obj = eVREC THEN e.obj := eVPAR END; IF field.offset # 0 THEN - CODE.AddCmd(CODE.opADDR, field.offset) + IL.AddCmd(IL.opADDR, field.offset) END; PARS.Next(parser); e.ident := NIL @@ -1459,29 +1514,29 @@ BEGIN PARS.check1(isArr(e), parser, 75); NextPos(parser, pos); - parser.expression(parser, idx); - PARS.check(isInt(idx), parser, pos, 76); + PExpression(parser, idx); + 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), parser, pos, 83); + PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83); IF ARITH.Int(idx.value) > 0 THEN - CODE.AddCmd(CODE.opADDR, 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, MACHINE.target.maxInt), parser, pos, 83); + PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83); LoadConst(idx); OpenIdx(parser, pos, e) END ELSE IF e.type.length > 0 THEN - IF chkIDX IN checking THEN + IF chkIDX IN Options.checking THEN CheckRange(e.type.length, pos.line, errIDX) END; IF e.type.base.size # 1 THEN - CODE.AddCmd(CODE.opMULC, e.type.base.size) + IL.AddCmd(IL.opMULC, e.type.base.size) END; - CODE.AddCmd0(CODE.opADD) + IL.AddCmd0(IL.opADD) ELSE OpenIdx(parser, pos, e) END @@ -1512,26 +1567,26 @@ BEGIN END; NextPos(parser, pos); qualident(parser, t); - PARS.check(t.obj = eTYPE, parser, pos, 79); + PARS.check(t.obj = eTYPE, pos, 79); IF e.type.typ = PROG.tRECORD THEN - PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80); - IF chkGUARD IN checking THEN + PARS.check(t.type.typ = PROG.tRECORD, pos, 80); + IF chkGUARD IN Options.checking THEN IF e.ident = NIL THEN - CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD) + IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD) ELSE - CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); - CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD) + IL.AddCmd(IL.opVADR, e.ident.offset - 1); + IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD) END END; ELSE - PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81); - IF chkGUARD IN checking THEN - CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD) + 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) END END; - PARS.check(PROG.isBaseOf(e.type, t.type), parser, pos, 82); + PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82); e.type := t.type; @@ -1543,69 +1598,69 @@ BEGIN END designator; -PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.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: INTEGER; - params: INTEGER; - callconv: INTEGER; - fparams: INTEGER; - int, flt: INTEGER; - stk_par: INTEGER; + cconv: INTEGER; + parSize: INTEGER; + callconv: INTEGER; + fparSize: INTEGER; + int, flt: INTEGER; + stk_par: INTEGER; BEGIN cconv := procType.call; - params := procType.params.size; + parSize := procType.parSize; IF cconv IN {PROG._win64, PROG.win64} THEN - callconv := CODE.call_win64; - fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4) + callconv := IL.call_win64; + fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4) ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN - callconv := CODE.call_sysv; - fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params; + callconv := IL.call_sysv; + fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize; stk_par := MAX(0, int - 6) + MAX(0, flt - 8) ELSE - callconv := CODE.call_stack; - fparams := 0 + callconv := IL.call_stack; + fparSize := 0 END; - CODE.setlast(begcall); - fregs := CODE.precall(isfloat); + IL.setlast(begcall); + fregs := IL.precall(isfloat); IF cconv IN {PROG._ccall16, PROG.ccall16} THEN - CODE.AddCmd(CODE.opALIGN16, params) + IL.AddCmd(IL.opALIGN16, parSize) ELSIF cconv IN {PROG._win64, PROG.win64} THEN - CODE.AddCmd(CODE.opWIN64ALIGN16, params) + IL.AddCmd(IL.opWIN64ALIGN16, parSize) ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN - CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par) + IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par) END; - CODE.setlast(endcall.prev(CODE.COMMAND)); + IL.setlast(endcall.prev(IL.COMMAND)); IF e.obj = eIMP THEN - CODE.CallImp(e.ident.import, callconv, fparams) + IL.CallImp(e.ident.import, callconv, fparSize) ELSIF e.obj = ePROC THEN - CODE.Call(e.ident.proc.label, callconv, fparams) + IL.Call(e.ident.proc.label, callconv, fparSize) ELSIF isExpr(e) THEN deref(pos, e, CallStat, errPROC); - CODE.CallP(callconv, fparams) + IL.CallP(callconv, fparSize) END; IF cconv IN {PROG._ccall16, PROG.ccall16} THEN - CODE.AddCmd(CODE.opCLEANUP, params); - CODE.AddCmd0(CODE.opPOPSP) + IL.AddCmd(IL.opCLEANUP, parSize); + IL.AddCmd0(IL.opPOPSP) ELSIF cconv IN {PROG._win64, PROG.win64} THEN - CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1); - CODE.AddCmd0(CODE.opPOPSP) + IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1); + IL.AddCmd0(IL.opPOPSP) ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN - CODE.AddCmd(CODE.opCLEANUP, params + stk_par); - CODE.AddCmd0(CODE.opPOPSP) - ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN - CODE.AddCmd(CODE.opCLEANUP, params) + IL.AddCmd(IL.opCLEANUP, parSize + stk_par); + IL.AddCmd0(IL.opPOPSP) + ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN + IL.AddCmd(IL.opCLEANUP, parSize) END; IF ~CallStat THEN IF isfloat THEN - PARS.check(CODE.resf(fregs), parser, pos, 41) + PARS.check(IL.resf(fregs), pos, 41) ELSE - CODE.res(fregs) + IL.res(fregs) END END END ProcCall; @@ -1613,7 +1668,7 @@ END ProcCall; PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - pos, pos0, pos1: SCAN.POSITION; + pos, pos0, pos1: PARS.POSITION; op: INTEGER; e1: PARS.EXPR; @@ -1646,17 +1701,17 @@ VAR PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR e1, e2: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; range: BOOLEAN; BEGIN range := FALSE; getpos(parser, pos); expression(parser, e1); - PARS.check(isInt(e1), parser, pos, 76); + PARS.check(isInt(e1), pos, 76); IF e1.obj = eCONST THEN - PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44) + PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44) END; range := parser.sym = SCAN.lxRANGE; @@ -1664,10 +1719,10 @@ VAR IF range THEN NextPos(parser, pos); expression(parser, e2); - PARS.check(isInt(e2), parser, pos, 76); + PARS.check(isInt(e2), pos, 76); IF e2.obj = eCONST THEN - PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44) + PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44) END ELSE IF e1.obj = eCONST THEN @@ -1675,7 +1730,7 @@ VAR END END; - e.type := PARS.program.stTypes.tSET; + e.type := tSET; IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN ARITH.constrSet(e.value, e1.value, e2.value); @@ -1683,14 +1738,14 @@ VAR ELSE IF range THEN IF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value)) + IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value)) ELSIF e2.obj = eCONST THEN - CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value)) + IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value)) ELSE - CODE.AddCmd0(CODE.opRSET) + IL.AddCmd0(IL.opRSET) END ELSE - CODE.AddCmd0(CODE.opRSET1) + IL.AddCmd0(IL.opRSET1) END; e.obj := eEXPR END @@ -1706,7 +1761,7 @@ VAR ASSERT(parser.sym = SCAN.lxLCURLY); e.obj := eCONST; - e.type := PARS.program.stTypes.tSET; + e.type := tSET; ARITH.emptySet(e.value); PARS.Next(parser); @@ -1726,11 +1781,11 @@ VAR ARITH.opSet(e.value, e1.value, "+") ELSE IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value)) + IL.AddCmd(IL.opADDSL, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value)) + IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opADDS) + IL.AddCmd0(IL.opADDS) END; e.obj := eEXPR END @@ -1744,19 +1799,19 @@ VAR PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR sym: INTEGER; - pos: SCAN.POSITION; + pos: PARS.POSITION; e1: PARS.EXPR; isfloat: BOOLEAN; fregs: INTEGER; - PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION); + 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.typ = PROG.tREAL THEN - PARS.check(CODE.loadf(), parser, pos, 41) + IF e.type = tREAL THEN + PARS.check(IL.loadf(), pos, 41) ELSE - CODE.load(e.type.size) + IL.load(e.type.size) END END END LoadVar; @@ -1768,18 +1823,18 @@ VAR 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 := PARS.program.getType(PARS.program, 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 := PARS.program.stTypes.tNIL; + e.obj := eCONST; + e.type := PARS.program.stTypes.tNIL; PARS.Next(parser) ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN - e.obj := eCONST; + e.obj := eCONST; ARITH.setbool(e.value, sym = SCAN.lxTRUE); - e.type := PARS.program.stTypes.tBOOLEAN; + e.type := tBOOLEAN; PARS.Next(parser) ELSIF sym = SCAN.lxLCURLY THEN @@ -1788,7 +1843,7 @@ VAR ELSIF sym = SCAN.lxIDENT THEN getpos(parser, pos); - CODE.pushBegEnd(begcall, endcall); + IL.pushBegEnd(begcall, endcall); designator(parser, e); IF isVar(e) THEN @@ -1797,15 +1852,15 @@ VAR IF parser.sym = SCAN.lxLROUND THEN e1 := e; ActualParameters(parser, e); - PARS.check(e.type # NIL, parser, pos, 59); - isfloat := e.type.typ = PROG.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, fregs, parser, pos, FALSE) ELSIF isExpr(e1) THEN ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE) END END; - CODE.popBegEnd(begcall, endcall) + IL.popBegEnd(begcall, endcall) ELSIF sym = SCAN.lxLROUND THEN PARS.Next(parser); @@ -1819,9 +1874,9 @@ VAR ELSIF sym = SCAN.lxNOT THEN NextPos(parser, pos); factor(parser, e); - PARS.check(isBoolean(e), parser, pos, 72); + PARS.check(isBoolean(e), pos, 72); IF e.obj # eCONST THEN - CODE.not; + IL.not; e.obj := eEXPR ELSE ASSERT(ARITH.neg(e.value)) @@ -1835,7 +1890,7 @@ VAR PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - pos: SCAN.POSITION; + pos: PARS.POSITION; op: INTEGER; e1: PARS.EXPR; @@ -1855,15 +1910,15 @@ VAR IF ~parser.constexp THEN IF label = -1 THEN - label := CODE.NewLabel() + label := IL.NewLabel() END; IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) - END; - CODE.AddCmd0(CODE.opACC); - CODE.AddJmpCmd(CODE.opJZ, label); - CODE.drop + IL.Const(ORD(ARITH.getBool(e.value))) + END; + IL.AddCmd0(IL.opACC); + IL.AddJmpCmd(IL.opJZ, label); + IL.drop END END; @@ -1871,135 +1926,142 @@ VAR CASE op OF |SCAN.lxMUL: - PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, 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, "*"), parser, pos, 39) - |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40) + |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39) + |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40) |ARITH.tSET: ARITH.opSet(e.value, e1.value, "*") END ELSE IF isInt(e) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value)) + IL.AddCmd(IL.opMULC, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value)) + IL.AddCmd(IL.opMULC, ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opMUL) + IL.AddCmd0(IL.opMUL) END ELSIF isReal(e) THEN IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)) + IL.Float(ARITH.Float(e.value)) ELSIF e1.obj = eCONST THEN - CODE.Float(ARITH.Float(e1.value)) + IL.Float(ARITH.Float(e1.value)) END; - CODE.fbinop(CODE.opMULF) + IL.fbinop(IL.opMULF) ELSIF isSet(e) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value)) + IL.AddCmd(IL.opMULSC, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value)) + IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opMULS) + IL.AddCmd0(IL.opMULS) END END; e.obj := eEXPR END |SCAN.lxSLASH: - PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); + PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); IF (e1.obj = eCONST) & isReal(e1) THEN - PARS.check(~ARITH.isZero(e1.value), parser, pos, 45) + PARS.check(~ARITH.isZero(e1.value), pos, 45) END; IF (e.obj = eCONST) & (e1.obj = eCONST) THEN CASE e.value.typ OF - |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40) + |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40) |ARITH.tSET: ARITH.opSet(e.value, e1.value, "/") END ELSE IF isReal(e) THEN IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)); - CODE.fbinop(CODE.opDIVFI) + IL.Float(ARITH.Float(e.value)); + IL.fbinop(IL.opDIVFI) ELSIF e1.obj = eCONST THEN - CODE.Float(ARITH.Float(e1.value)); - CODE.fbinop(CODE.opDIVF) + IL.Float(ARITH.Float(e1.value)); + IL.fbinop(IL.opDIVF) ELSE - CODE.fbinop(CODE.opDIVF) + IL.fbinop(IL.opDIVF) END ELSIF isSet(e) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value)) + IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value)) + IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opDIVS) + IL.AddCmd0(IL.opDIVS) END END; e.obj := eEXPR END |SCAN.lxDIV, SCAN.lxMOD: - PARS.check(isInt(e) & isInt(e1), parser, pos, 37); + PARS.check(isInt(e) & isInt(e1), pos, 37); IF e1.obj = eCONST THEN - PARS.check(~ARITH.isZero(e1.value), parser, pos, 46) + PARS.check(~ARITH.isZero(e1.value), pos, 46); + IF CPU = cpuMSP430 THEN + PARS.check(ARITH.Int(e1.value) > 0, pos, 122) + END END; IF (e.obj = eCONST) & (e1.obj = eCONST) THEN IF op = SCAN.lxDIV THEN - PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39) + PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39) ELSE ASSERT(ARITH.opInt(e.value, e1.value, "M")) END ELSE IF e1.obj # eCONST THEN - label1 := CODE.NewLabel(); - CODE.AddJmpCmd(CODE.opJNZ, label1) + label1 := IL.NewLabel(); + IF CPU = cpuMSP430 THEN + IL.AddJmpCmd(IL.opJG, label1) + ELSE + IL.AddJmpCmd(IL.opJNZ, label1) + END END; IF e.obj = eCONST THEN - CODE.OnError(pos.line, errDIV); - CODE.SetLabel(label1); - CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) + IL.OnError(pos.line, errDIV); + IL.SetLabel(label1); + IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) + IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) ELSE - CODE.OnError(pos.line, errDIV); - CODE.SetLabel(label1); - CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD)) + IL.OnError(pos.line, errDIV); + IL.SetLabel(label1); + IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD)) END; e.obj := eEXPR END |SCAN.lxAND: - PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); + PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); IF (e.obj = eCONST) & (e1.obj = eCONST) THEN ARITH.opBoolean(e.value, e1.value, "&") ELSE e.obj := eEXPR; IF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) + IL.Const(ORD(ARITH.getBool(e1.value))) END; - CODE.AddCmd0(CODE.opACC) + IL.AddCmd0(IL.opACC) END END END; IF label # -1 THEN - CODE.SetLabel(label) + IL.SetLabel(label) END END term; PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); VAR - pos: SCAN.POSITION; + pos: PARS.POSITION; op: INTEGER; e1: PARS.EXPR; @@ -2019,20 +2081,20 @@ VAR term(parser, e); IF plus OR minus THEN - PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36); + PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36); IF minus & (e.obj = eCONST) THEN - PARS.check(ARITH.neg(e.value), parser, pos, 39) + PARS.check(ARITH.neg(e.value), pos, 39) END; IF e.obj # eCONST THEN IF minus THEN IF isInt(e) THEN - CODE.AddCmd0(CODE.opUMINUS) + IL.AddCmd0(IL.opUMINUS) ELSIF isReal(e) THEN - CODE.AddCmd0(CODE.opUMINF) + IL.AddCmd0(IL.opUMINF) ELSIF isSet(e) THEN - CODE.AddCmd0(CODE.opUMINS) + IL.AddCmd0(IL.opUMINS) END END; e.obj := eEXPR @@ -2052,15 +2114,15 @@ VAR IF ~parser.constexp THEN IF label = -1 THEN - label := CODE.NewLabel() + label := IL.NewLabel() END; IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) - END; - CODE.AddCmd0(CODE.opACC); - CODE.AddJmpCmd(CODE.opJNZ, label); - CODE.drop + IL.Const(ORD(ARITH.getBool(e.value))) + END; + IL.AddCmd0(IL.opACC); + IL.AddJmpCmd(IL.opJNZ, label); + IL.drop END END; @@ -2076,64 +2138,64 @@ VAR op := ORD("-") END; - PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, 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)), parser, pos, 39) - |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40) + |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 - CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) + IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) + IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-"))) + IL.AddCmd0(IL.opADD + ORD(op = ORD("-"))) END ELSIF isReal(e) THEN IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)); - CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-"))) + IL.Float(ARITH.Float(e.value)); + IL.fbinop(IL.opADDFI + ORD(op = ORD("-"))) ELSIF e1.obj = eCONST THEN - CODE.Float(ARITH.Float(e1.value)); - CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) + IL.Float(ARITH.Float(e1.value)); + IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) ELSE - CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) + IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) END ELSIF isSet(e) THEN IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) + IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) + IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-"))) + IL.AddCmd0(IL.opADDS + ORD(op = ORD("-"))) END END; e.obj := eEXPR END |SCAN.lxOR: - PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); + PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); IF (e.obj = eCONST) & (e1.obj = eCONST) THEN ARITH.opBoolean(e.value, e1.value, "|") ELSE e.obj := eEXPR; IF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) + IL.Const(ORD(ARITH.getBool(e1.value))) END; - CODE.AddCmd0(CODE.opACC) + IL.AddCmd0(IL.opACC) END END END; IF label # -1 THEN - CODE.SetLabel(label) + IL.SetLabel(label) END END SimpleExpression; @@ -2142,6 +2204,7 @@ VAR PROCEDURE cmpcode (op: INTEGER): INTEGER; VAR res: INTEGER; + BEGIN CASE op OF |SCAN.lxEQ: res := 0 @@ -2156,12 +2219,30 @@ VAR END cmpcode; + PROCEDURE invcmpcode (op: INTEGER): INTEGER; + VAR + res: INTEGER; + + BEGIN + CASE op OF + |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 + END invcmpcode; + + PROCEDURE BoolCmp (eq, val: BOOLEAN); BEGIN IF eq = val THEN - CODE.AddCmd0(CODE.opNER) + IL.AddCmd0(IL.opNEC) ELSE - CODE.AddCmd0(CODE.opEQR) + IL.AddCmd0(IL.opEQC) END END BoolCmp; @@ -2175,40 +2256,40 @@ VAR res := TRUE; IF isString(e) & isCharArray(e1) THEN - CODE.AddCmd(CODE.opSADR, String(e)); - CODE.AddCmd(CODE.opCONST, strlen(e) + 1); - CODE.AddCmd0(CODE.opEQS2 + cmpcode(op)) + IL.StrAdr(String(e)); + IL.Const(strlen(e) + 1); + IL.AddCmd0(IL.opEQS + invcmpcode(op)) ELSIF isString(e) & isCharArrayW(e1) THEN - CODE.AddCmd(CODE.opSADR, StringW(e)); - CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); - CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) + IL.StrAdr(StringW(e)); + IL.Const(utf8strlen(e) + 1); + IL.AddCmd0(IL.opEQSW + invcmpcode(op)) ELSIF isStringW(e) & isCharArrayW(e1) THEN - CODE.AddCmd(CODE.opSADR, StringW(e)); - CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); - CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) + IL.StrAdr(StringW(e)); + IL.Const(utf8strlen(e) + 1); + IL.AddCmd0(IL.opEQSW + invcmpcode(op)) ELSIF isCharArray(e) & isString(e1) THEN - CODE.AddCmd(CODE.opSADR, String(e1)); - CODE.AddCmd(CODE.opCONST, strlen(e1) + 1); - CODE.AddCmd0(CODE.opEQS + cmpcode(op)) + IL.StrAdr(String(e1)); + IL.Const(strlen(e1) + 1); + IL.AddCmd0(IL.opEQS + cmpcode(op)) ELSIF isCharArrayW(e) & isString(e1) THEN - CODE.AddCmd(CODE.opSADR, StringW(e1)); - CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); - CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + IL.StrAdr(StringW(e1)); + IL.Const(utf8strlen(e1) + 1); + IL.AddCmd0(IL.opEQSW + cmpcode(op)) ELSIF isCharArrayW(e) & isStringW(e1) THEN - CODE.AddCmd(CODE.opSADR, StringW(e1)); - CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); - CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + IL.StrAdr(StringW(e1)); + IL.Const(utf8strlen(e1) + 1); + IL.AddCmd0(IL.opEQSW + cmpcode(op)) ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN - CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + IL.AddCmd0(IL.opEQSW + cmpcode(op)) ELSIF isCharArray(e) & isCharArray(e1) THEN - CODE.AddCmd0(CODE.opEQS + cmpcode(op)) + IL.AddCmd0(IL.opEQS + cmpcode(op)) ELSIF isString(e) & isString(e1) THEN PARS.strcmp(e.value, e1.value, op) @@ -2227,17 +2308,17 @@ BEGIN SimpleExpression(parser, e); IF relation(parser.sym) THEN IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN - CODE.AddCmd(CODE.opCONST, e.type.length) + IL.Const(e.type.length) END; op := parser.sym; getpos(parser, pos); PARS.Next(parser); - pos1 := parser.lex.pos; + getpos(parser, pos1); SimpleExpression(parser, e1); IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN - CODE.AddCmd(CODE.opCONST, e1.type.length) + IL.Const(e1.type.length) END; constant := (e.obj = eCONST) & (e1.obj = eCONST); @@ -2267,19 +2348,19 @@ BEGIN ARITH.relation(e.value, e1.value, operator, error) ELSE IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) + IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) + IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + IL.AddCmd0(IL.opEQ + cmpcode(op)) END END ELSIF isStringW1(e) & isCharW(e1) THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, 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 - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, 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 @@ -2291,9 +2372,9 @@ BEGIN BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0) ELSE IF op = SCAN.lxEQ THEN - CODE.AddCmd0(CODE.opEQB) + IL.AddCmd0(IL.opEQB) ELSE - CODE.AddCmd0(CODE.opNEB) + IL.AddCmd0(IL.opNEB) END END END @@ -2303,50 +2384,47 @@ BEGIN ARITH.relation(e.value, e1.value, operator, error) ELSE IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)); - CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) + IL.Float(ARITH.Float(e.value)) ELSIF e1.obj = eCONST THEN - CODE.Float(ARITH.Float(e1.value)); - CODE.fcmp(CODE.opEQF + cmpcode(op)) - ELSE - CODE.fcmp(CODE.opEQF + cmpcode(op)) - END + IL.Float(ARITH.Float(e1.value)) + END; + IL.fcmp(IL.opEQF + cmpcode(op)) END ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN IF ~strcmp(e, e1, op) THEN - PARS.error(parser, pos, 37) + PARS.error(pos, 37) END ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN - CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + IL.AddCmd0(IL.opEQC + cmpcode(op)) ELSIF isProc(e) & isNil(e1) THEN IF e.obj IN {ePROC, eIMP} THEN - PARS.check(e.ident.global, parser, pos0, 85); + PARS.check(e.ident.global, pos0, 85); constant := TRUE; e.obj := eCONST; ARITH.setbool(e.value, op = SCAN.lxNE) ELSE - CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + IL.AddCmd0(IL.opEQC + cmpcode(op)) END ELSIF isNil(e) & isProc(e1) THEN IF e1.obj IN {ePROC, eIMP} THEN - PARS.check(e1.ident.global, parser, pos1, 85); + PARS.check(e1.ident.global, pos1, 85); constant := TRUE; e.obj := eCONST; ARITH.setbool(e.value, op = SCAN.lxNE) ELSE - CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + IL.AddCmd0(IL.opEQC + cmpcode(op)) END ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN IF e.obj = ePROC THEN - PARS.check(e.ident.global, parser, pos0, 85) + PARS.check(e.ident.global, pos0, 85) END; IF e1.obj = ePROC THEN - PARS.check(e1.ident.global, parser, pos1, 85) + PARS.check(e1.ident.global, pos1, 85) END; IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN constant := TRUE; @@ -2357,15 +2435,15 @@ BEGIN ARITH.setbool(e.value, e.ident # e1.ident) END ELSIF e.obj = ePROC THEN - CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0) + IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ) ELSIF e1.obj = ePROC THEN - CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0) + IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ) ELSIF e.obj = eIMP THEN - CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0) + IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ) ELSIF e1.obj = eIMP THEN - CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0) + IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ) ELSE - CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + IL.AddCmd0(IL.opEQ + cmpcode(op)) END ELSIF isNil(e) & isNil(e1) THEN @@ -2374,7 +2452,7 @@ BEGIN ARITH.setbool(e.value, op = SCAN.lxEQ) ELSE - PARS.error(parser, pos, 37) + PARS.error(pos, 37) END |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE: @@ -2387,88 +2465,86 @@ BEGIN ARITH.relation(e.value, e1.value, operator, error) ELSE IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) + IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) + IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + IL.AddCmd0(IL.opEQ + cmpcode(op)) END END ELSIF isStringW1(e) & isCharW(e1) THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) + IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) ELSIF isStringW1(e1) & isCharW(e) THEN - CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, 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, operator, error) ELSE IF e.obj = eCONST THEN - CODE.Float(ARITH.Float(e.value)); - CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) + IL.Float(ARITH.Float(e.value)); + IL.fcmp(IL.opEQF + invcmpcode(op)) ELSIF e1.obj = eCONST THEN - CODE.Float(ARITH.Float(e1.value)); - CODE.fcmp(CODE.opEQF + cmpcode(op)) + IL.Float(ARITH.Float(e1.value)); + IL.fcmp(IL.opEQF + cmpcode(op)) ELSE - CODE.fcmp(CODE.opEQF + cmpcode(op)) + IL.fcmp(IL.opEQF + cmpcode(op)) END END ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN IF ~strcmp(e, e1, op) THEN - PARS.error(parser, pos, 37) + PARS.error(pos, 37) END ELSE - PARS.error(parser, pos, 37) + PARS.error(pos, 37) END |SCAN.lxIN: - PARS.check(isInt(e) & isSet(e1), parser, pos, 37); + PARS.check(isInt(e) & isSet(e1), pos, 37); IF e.obj = eCONST THEN - PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56) + PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56) END; IF constant THEN ARITH.relation(e.value, e1.value, operator, error) ELSE IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opINL, ARITH.Int(e.value)) + IL.AddCmd(IL.opINL, ARITH.Int(e.value)) ELSIF e1.obj = eCONST THEN - CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value)) + IL.AddCmd(IL.opINR, ARITH.Int(e1.value)) ELSE - CODE.AddCmd0(CODE.opIN) + IL.AddCmd0(IL.opIN) END END |SCAN.lxIS: - PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73); - IF e.type.typ = PROG.tRECORD THEN - PARS.check(e.obj = eVREC, parser, pos0, 78) - END; - PARS.check(e1.obj = eTYPE, parser, pos1, 79); + PARS.check(isRecPtr(e), pos, 73); + PARS.check(e1.obj = eTYPE, pos1, 79); - IF e.type.typ = PROG.tRECORD THEN - PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80); + IF isRec(e) THEN + PARS.check(e.obj = eVREC, pos0, 78); + PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80); IF e.ident = NIL THEN - CODE.TypeCheck(e1.type.num) + IL.TypeCheck(e1.type.num) ELSE - CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); - CODE.TypeCheckRec(e1.type.num) + IL.AddCmd(IL.opVADR, e.ident.offset - 1); + IL.TypeCheckRec(e1.type.num) END ELSE - PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81); - CODE.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), parser, pos1, 82) + PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82) END; ASSERT(error = 0); - e.type := PARS.program.stTypes.tBOOLEAN; + e.type := tBOOLEAN; IF ~constant THEN e.obj := eEXPR @@ -2481,7 +2557,7 @@ END expression; PROCEDURE ElementaryStatement (parser: PARS.PARSER); VAR e, e1: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; line: INTEGER; call: BOOLEAN; fregs: INTEGER; @@ -2489,25 +2565,25 @@ VAR BEGIN getpos(parser, pos); - CODE.pushBegEnd(begcall, endcall); + IL.pushBegEnd(begcall, endcall); designator(parser, e); IF parser.sym = SCAN.lxASSIGN THEN line := parser.lex.pos.line; - PARS.check(isVar(e), parser, pos, 93); - PARS.check(~e.readOnly, parser, pos, 94); + PARS.check(isVar(e), pos, 93); + PARS.check(~e.readOnly, pos, 94); - CODE.setlast(begcall); + IL.setlast(begcall); NextPos(parser, pos); expression(parser, e1); - CODE.setlast(endcall.prev(CODE.COMMAND)); + IL.setlast(endcall.prev(IL.COMMAND)); - PARS.check(assign(e1, e.type, line), parser, pos, 91); + PARS.check(assign(e1, e.type, line), pos, 91); IF e1.obj = ePROC THEN - PARS.check(e1.ident.global, parser, pos, 85) + PARS.check(e1.ident.global, pos, 85) END; call := FALSE ELSIF parser.sym = SCAN.lxEQ THEN @@ -2515,13 +2591,18 @@ BEGIN ELSIF parser.sym = SCAN.lxLROUND THEN e1 := e; ActualParameters(parser, e1); - PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92); + PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92); call := TRUE ELSE - PARS.check(isProc(e), parser, pos, 86); - PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92); - PARS.check1(e.type.params.first = NIL, parser, 64); - call := TRUE + IF e.obj IN {eSYSPROC, eSTPROC} THEN + stProc(parser, e); + 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); + call := TRUE + END END; IF call THEN @@ -2532,39 +2613,39 @@ BEGIN END END; - CODE.popBegEnd(begcall, endcall) + IL.popBegEnd(begcall, endcall) END ElementaryStatement; PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); VAR e: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; label, L: INTEGER; BEGIN - L := CODE.NewLabel(); + L := IL.NewLabel(); IF ~if THEN - CODE.AddCmd0(CODE.opLOOP); - CODE.SetLabel(L) + IL.AddCmd0(IL.opLOOP); + IL.SetLabel(L) END; REPEAT NextPos(parser, pos); - label := CODE.NewLabel(); + label := IL.NewLabel(); expression(parser, e); - PARS.check(isBoolean(e), parser, pos, 72); + PARS.check(isBoolean(e), pos, 72); IF e.obj = eCONST THEN IF ~ARITH.getBool(e.value) THEN - CODE.AddJmpCmd(CODE.opJMP, label) + IL.AddJmpCmd(IL.opJMP, label) END ELSE - CODE.AddJmpCmd(CODE.opJNE, label) + IL.AddJmpCmd(IL.opJNE, label) END; IF if THEN @@ -2576,8 +2657,8 @@ BEGIN PARS.Next(parser); parser.StatSeq(parser); - CODE.AddJmpCmd(CODE.opJMP, L); - CODE.SetLabel(label) + IL.AddJmpCmd(IL.opJMP, L); + IL.SetLabel(label) UNTIL parser.sym # SCAN.lxELSIF; @@ -2586,13 +2667,13 @@ BEGIN PARS.Next(parser); parser.StatSeq(parser) END; - CODE.SetLabel(L) + IL.SetLabel(L) END; PARS.checklex(parser, SCAN.lxEND); IF ~if THEN - CODE.AddCmd0(CODE.opENDLOOP) + IL.AddCmd0(IL.opENDLOOP) END; PARS.Next(parser) @@ -2602,31 +2683,31 @@ END IfStatement; PROCEDURE RepeatStatement (parser: PARS.PARSER); VAR e: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; label: INTEGER; BEGIN - CODE.AddCmd0(CODE.opLOOP); + IL.AddCmd0(IL.opLOOP); - label := CODE.NewLabel(); - CODE.SetLabel(label); + label := IL.NewLabel(); + IL.SetLabel(label); PARS.Next(parser); parser.StatSeq(parser); PARS.checklex(parser, SCAN.lxUNTIL); NextPos(parser, pos); expression(parser, e); - PARS.check(isBoolean(e), parser, pos, 72); + PARS.check(isBoolean(e), pos, 72); IF e.obj = eCONST THEN IF ~ARITH.getBool(e.value) THEN - CODE.AddJmpCmd(CODE.opJMP, label) + IL.AddJmpCmd(IL.opJMP, label) END ELSE - CODE.AddJmpCmd(CODE.opJNE, label) + IL.AddJmpCmd(IL.opJNE, label) END; - CODE.AddCmd0(CODE.opENDLOOP) + IL.AddCmd0(IL.opENDLOOP) END RepeatStatement; @@ -2656,7 +2737,7 @@ BEGIN END DestroyLabel; -PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT; +PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT; VAR res: CASE_VARIANT; citem: C.ITEM; @@ -2680,19 +2761,14 @@ END NewVariant; PROCEDURE CaseStatement (parser: PARS.PARSER); VAR e: PARS.EXPR; - pos: SCAN.POSITION; - - - PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN; - RETURN isRec(caseExpr) OR isPtr(caseExpr) - END isRecPtr; + pos: PARS.POSITION; PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; VAR a: INTEGER; label: PARS.EXPR; - pos: SCAN.POSITION; + pos: PARS.POSITION; value: ARITH.VALUE; BEGIN @@ -2701,24 +2777,24 @@ VAR IF isChar(caseExpr) THEN PARS.ConstExpression(parser, value); - PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99); + PARS.check(value.typ = ARITH.tCHAR, pos, 99); a := ARITH.getInt(value) ELSIF isCharW(caseExpr) THEN PARS.ConstExpression(parser, value); IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s))) ELSE - PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99) + PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99) END; a := ARITH.getInt(value) ELSIF isInt(caseExpr) THEN PARS.ConstExpression(parser, value); - PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99); + PARS.check(value.typ = ARITH.tINTEGER, pos, 99); a := ARITH.getInt(value) ELSIF isRecPtr(caseExpr) THEN qualident(parser, label); - PARS.check(label.obj = eTYPE, parser, pos, 79); - PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99); + PARS.check(label.obj = eTYPE, pos, 79); + PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99); IF isRec(caseExpr) THEN a := label.type.num ELSE @@ -2731,10 +2807,10 @@ VAR END Label; - PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.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)), parser, pos, 100); + 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 @@ -2745,7 +2821,7 @@ VAR VAR label: CASE_LABEL; citem: C.ITEM; - pos, pos1: SCAN.POSITION; + pos, pos1: PARS.POSITION; node: AVL.NODE; newnode: BOOLEAN; range: RANGE; @@ -2759,7 +2835,7 @@ VAR END; label.variant := variant; - label.self := CODE.NewLabel(); + label.self := IL.NewLabel(); getpos(parser, pos1); range.a := Label(parser, caseExpr, label.type); @@ -2768,7 +2844,7 @@ VAR PARS.check1(~isRecPtr(caseExpr), parser, 53); NextPos(parser, pos); range.b := Label(parser, caseExpr, label.type); - PARS.check(range.a <= range.b, parser, pos, 103) + PARS.check(range.a <= range.b, pos, 103) ELSE range.b := range.a END; @@ -2779,7 +2855,7 @@ VAR CheckType(tree, label.type, parser, pos1) END; tree := AVL.insert(tree, label, LabelCmp, newnode, node); - PARS.check(newnode, parser, pos1, 100) + PARS.check(newnode, pos1, 100) RETURN node @@ -2813,12 +2889,12 @@ VAR t: PROG.TYPE_; variant: INTEGER; node: AVL.NODE; - last: CODE.COMMAND; + last: IL.COMMAND; BEGIN sym := parser.sym; IF sym # SCAN.lxBAR THEN - variant := CODE.NewLabel(); + variant := IL.NewLabel(); node := CaseLabelList(parser, caseExpr, tree, variant); PARS.checklex(parser, SCAN.lxCOLON); PARS.Next(parser); @@ -2827,15 +2903,15 @@ VAR caseExpr.ident.type := node.data(CASE_LABEL).type END; - last := CODE.getlast(); - CODE.SetLabel(variant); + last := IL.getlast(); + IL.SetLabel(variant); IF ~isRecPtr(caseExpr) THEN LISTS.push(CaseVariants, NewVariant(variant, last)) END; parser.StatSeq(parser); - CODE.AddJmpCmd(CODE.opJMP, end); + IL.AddJmpCmd(IL.opJMP, end); IF isRecPtr(caseExpr) THEN caseExpr.ident.type := t @@ -2849,7 +2925,7 @@ VAR L, R: INTEGER; range: RANGE; left, right: AVL.NODE; - last: CODE.COMMAND; + last: IL.COMMAND; v: CASE_VARIANT; BEGIN @@ -2871,7 +2947,7 @@ VAR R := else END; - last := CODE.getlast(); + last := IL.getlast(); v := CaseVariants.last(CASE_VARIANT); WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO @@ -2879,16 +2955,16 @@ VAR END; ASSERT((v # NIL) & (v.label # 0)); - CODE.setlast(v.cmd); + IL.setlast(v.cmd); - CODE.SetLabel(node.data(CASE_LABEL).self); - CODE.case(range.a, range.b, L, R); + IL.SetLabel(node.data(CASE_LABEL).self); + IL.case(range.a, range.b, L, R); IF v.processed THEN - CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant) + IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant) END; v.processed := TRUE; - CODE.setlast(last); + IL.setlast(last); Table(left, else); Table(right, else) @@ -2899,7 +2975,7 @@ VAR PROCEDURE TableT (node: AVL.NODE); BEGIN IF node # NIL THEN - CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); + IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); TableT(node.left); TableT(node.right) @@ -2907,7 +2983,7 @@ VAR END TableT; - PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION); + PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION); VAR table, end, else: INTEGER; tree: AVL.NODE; @@ -2915,11 +2991,11 @@ VAR BEGIN LISTS.push(CaseVariants, NewVariant(0, NIL)); - end := CODE.NewLabel(); - else := CODE.NewLabel(); - table := CODE.NewLabel(); - CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e))); - CODE.AddJmpCmd(CODE.opJMP, table); + end := IL.NewLabel(); + else := IL.NewLabel(); + table := IL.NewLabel(); + IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e))); + IL.AddJmpCmd(IL.opJMP, table); tree := NIL; @@ -2929,30 +3005,30 @@ VAR case(parser, e, tree, end) END; - CODE.SetLabel(else); + IL.SetLabel(else); IF parser.sym = SCAN.lxELSE THEN PARS.Next(parser); parser.StatSeq(parser); - CODE.AddJmpCmd(CODE.opJMP, end) + IL.AddJmpCmd(IL.opJMP, end) ELSE - CODE.OnError(pos.line, errCASE) + IL.OnError(pos.line, errCASE) END; PARS.checklex(parser, SCAN.lxEND); PARS.Next(parser); IF isRecPtr(e) THEN - CODE.SetLabel(table); + IL.SetLabel(table); TableT(tree); - CODE.AddJmpCmd(CODE.opJMP, else) + IL.AddJmpCmd(IL.opJMP, else) ELSE tree.data(CASE_LABEL).self := table; Table(tree, else) END; AVL.destroy(tree, DestroyLabel); - CODE.SetLabel(end); - CODE.AddCmd0(CODE.opENDSW); + IL.SetLabel(end); + IL.AddCmd0(IL.opENDSW); REPEAT item := LISTS.pop(CaseVariants); @@ -2965,25 +3041,25 @@ VAR BEGIN NextPos(parser, pos); expression(parser, e); - PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95); + PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95); IF isRecPtr(e) THEN - PARS.check(isVar(e), parser, pos, 93); - PARS.check(e.ident # NIL, parser, pos, 106) + PARS.check(isVar(e), pos, 93); + PARS.check(e.ident # NIL, pos, 106) END; IF isRec(e) THEN - PARS.check(e.obj = eVREC, parser, pos, 78) + PARS.check(e.obj = eVREC, pos, 78) END; IF e.obj = eCONST THEN LoadConst(e) ELSIF isRec(e) THEN - CODE.drop; - CODE.AddCmd(CODE.opLADR, e.ident.offset - 1); - CODE.load(PARS.program.target.word) + IL.drop; + IL.AddCmd(IL.opLADR, e.ident.offset - 1); + IL.load(PARS.program.target.word) ELSIF isPtr(e) THEN deref(pos, e, FALSE, errPTR); - CODE.AddCmd(CODE.opSUBR, PARS.program.target.word); - CODE.load(PARS.program.target.word) + IL.AddCmd(IL.opSUBR, PARS.program.target.word); + IL.load(PARS.program.target.word) END; PARS.checklex(parser, SCAN.lxOF); @@ -2994,114 +3070,110 @@ END CaseStatement; PROCEDURE ForStatement (parser: PARS.PARSER); VAR - e: PARS.EXPR; - pos: SCAN.POSITION; - step: ARITH.VALUE; - st: INTEGER; - ident: PROG.IDENT; - offset: INTEGER; - L1, L2: INTEGER; + e: PARS.EXPR; + pos, pos2: PARS.POSITION; + step: ARITH.VALUE; + st: INTEGER; + ident: PROG.IDENT; + offset: INTEGER; + L1, L2: INTEGER; BEGIN - CODE.AddCmd0(CODE.opLOOP); + IL.AddCmd0(IL.opLOOP); - L1 := CODE.NewLabel(); - L2 := CODE.NewLabel(); + L1 := IL.NewLabel(); + L2 := IL.NewLabel(); PARS.ExpectSym(parser, SCAN.lxIDENT); - ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE); + 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.typ = PROG.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), parser, pos, 76); + PARS.check(isInt(e), pos, 76); offset := PROG.getOffset(PARS.program, ident); IF ident.global THEN - CODE.AddCmd(CODE.opGADR, offset) + IL.AddCmd(IL.opGADR, offset) ELSE - CODE.AddCmd(CODE.opLADR, -offset) + IL.AddCmd(IL.opLADR, -offset) END; IF e.obj = eCONST THEN - CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) ELSE - CODE.AddCmd0(CODE.opSAVE) + IL.AddCmd0(IL.opSAVE) END; - CODE.SetLabel(L1); + IL.SetLabel(L1); IF ident.global THEN - CODE.AddCmd(CODE.opGADR, offset) + IL.AddCmd(IL.opGADR, offset) ELSE - CODE.AddCmd(CODE.opLADR, -offset) + IL.AddCmd(IL.opLADR, -offset) END; - CODE.load(ident.type.size); + IL.load(ident.type.size); PARS.checklex(parser, SCAN.lxTO); - NextPos(parser, pos); + NextPos(parser, pos2); expression(parser, e); - PARS.check(isInt(e), parser, pos, 76); + PARS.check(isInt(e), pos2, 76); IF parser.sym = SCAN.lxBY THEN NextPos(parser, pos); PARS.ConstExpression(parser, step); - PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76); + PARS.check(step.typ = ARITH.tINTEGER, pos, 76); st := ARITH.getInt(step); - PARS.check(st # 0, parser, pos, 98) + PARS.check(st # 0, pos, 98) ELSE st := 1 END; IF e.obj = eCONST THEN IF st > 0 THEN - CODE.AddCmd(CODE.opLER, ARITH.Int(e.value)) + IL.AddCmd(IL.opLEC, ARITH.Int(e.value)); + IF ARITH.Int(e.value) = UTILS.target.maxInt THEN + ERRORS.WarningMsg(pos2.line, pos2.col, 1) + END ELSE - CODE.AddCmd(CODE.opGER, ARITH.Int(e.value)) + IL.AddCmd(IL.opGEC, ARITH.Int(e.value)); + IF ARITH.Int(e.value) = UTILS.target.minInt THEN + ERRORS.WarningMsg(pos2.line, pos2.col, 1) + END END ELSE IF st > 0 THEN - CODE.AddCmd0(CODE.opLE) + IL.AddCmd0(IL.opLE) ELSE - CODE.AddCmd0(CODE.opGE) + IL.AddCmd0(IL.opGE) END END; - CODE.AddJmpCmd(CODE.opJNE, L2); + IL.AddJmpCmd(IL.opJNE, L2); PARS.checklex(parser, SCAN.lxDO); PARS.Next(parser); parser.StatSeq(parser); IF ident.global THEN - CODE.AddCmd(CODE.opGADR, offset) + IL.AddCmd(IL.opGADR, offset) ELSE - CODE.AddCmd(CODE.opLADR, -offset) + IL.AddCmd(IL.opLADR, -offset) END; - IF st = 1 THEN - CODE.AddCmd0(CODE.opINC1) - ELSIF st = -1 THEN - CODE.AddCmd0(CODE.opDEC1) - ELSE - IF st > 0 THEN - CODE.AddCmd(CODE.opINCC, st) - ELSE - CODE.AddCmd(CODE.opDECC, -st) - END - END; + IL.AddCmd(IL.opINCC, st); - CODE.AddJmpCmd(CODE.opJMP, L1); + IL.AddJmpCmd(IL.opJMP, L1); PARS.checklex(parser, SCAN.lxEND); PARS.Next(parser); - CODE.SetLabel(L2); + IL.SetLabel(L2); - CODE.AddCmd0(CODE.opENDLOOP) + IL.AddCmd0(IL.opENDLOOP) END ForStatement; @@ -3139,7 +3211,7 @@ BEGIN END StatSeq; -PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; +PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN; VAR res: BOOLEAN; @@ -3147,24 +3219,24 @@ BEGIN res := assigncomp(e, t); IF res THEN IF e.obj = eCONST THEN - IF e.type.typ = PROG.tREAL THEN - CODE.Float(ARITH.Float(e.value)) + IF e.type = tREAL THEN + IL.Float(ARITH.Float(e.value)) ELSIF e.type.typ = PROG.tNIL THEN - CODE.AddCmd(CODE.opCONST, 0) + IL.Const(0) ELSE LoadConst(e) END - ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN 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, parser, pos, 85); - CODE.PushProc(e.ident.proc.label) + PARS.check(e.ident.global, pos, 85); + IL.PushProc(e.ident.proc.label) ELSIF e.obj = eIMP THEN - CODE.PushImpProc(e.ident.import) + IL.PushImpProc(e.ident.import) END; - IF e.type.typ = PROG.tREAL THEN - CODE.retf + IF e.type = tREAL THEN + IL.retf END END @@ -3182,16 +3254,16 @@ VAR id: PROG.IDENT; BEGIN - id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE); + id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); IF (id # NIL) & (id.import # NIL) THEN - CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label; + IL.codes.rtl[idx] := -id.import(IL.IMPORT_PROC).label; id.proc.used := TRUE ELSIF (id # NIL) & (id.proc # NIL) THEN - CODE.codes.rtl[idx] := id.proc.label; + IL.codes.rtl[idx] := id.proc.label; id.proc.used := TRUE ELSE - ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found") + ERRORS.WrongRTL(name) END END getproc; @@ -3200,46 +3272,65 @@ BEGIN rtl := PARS.program.rtl; ASSERT(rtl # NIL); - getproc(rtl, "_move", CODE._move); - getproc(rtl, "_move2", CODE._move2); - getproc(rtl, "_set", CODE._set); - getproc(rtl, "_set2", CODE._set2); - getproc(rtl, "_div", CODE._div); - getproc(rtl, "_mod", CODE._mod); - getproc(rtl, "_div2", CODE._div2); - getproc(rtl, "_mod2", CODE._mod2); - getproc(rtl, "_arrcpy", CODE._arrcpy); - getproc(rtl, "_rot", CODE._rot); - getproc(rtl, "_new", CODE._new); - getproc(rtl, "_dispose", CODE._dispose); - getproc(rtl, "_strcmp", CODE._strcmp); - getproc(rtl, "_error", CODE._error); - getproc(rtl, "_is", CODE._is); - getproc(rtl, "_isrec", CODE._isrec); - getproc(rtl, "_guard", CODE._guard); - getproc(rtl, "_guardrec", CODE._guardrec); - getproc(rtl, "_length", CODE._length); - getproc(rtl, "_init", CODE._init); - getproc(rtl, "_dllentry", CODE._dllentry); - getproc(rtl, "_strcpy", CODE._strcpy); - getproc(rtl, "_exit", CODE._exit); - getproc(rtl, "_strcpy2", CODE._strcpy2); - getproc(rtl, "_lengthw", CODE._lengthw); - getproc(rtl, "_strcmp2", CODE._strcmp2); - getproc(rtl, "_strcmpw", CODE._strcmpw); - getproc(rtl, "_strcmpw2", CODE._strcmpw2); + IF CPU IN {cpuX86, cpuAMD64} THEN + getproc(rtl, "_strcmp", IL._strcmp); + getproc(rtl, "_length", IL._length); + getproc(rtl, "_arrcpy", IL._arrcpy); + getproc(rtl, "_move", IL._move); + getproc(rtl, "_is", IL._is); + getproc(rtl, "_guard", IL._guard); + getproc(rtl, "_guardrec", IL._guardrec); + getproc(rtl, "_error", IL._error); + getproc(rtl, "_new", IL._new); + getproc(rtl, "_rot", IL._rot); + getproc(rtl, "_strcpy", IL._strcpy); + getproc(rtl, "_move2", IL._move2); + getproc(rtl, "_div2", IL._div2); + getproc(rtl, "_mod2", IL._mod2); + getproc(rtl, "_div", IL._div); + getproc(rtl, "_mod", IL._mod); + getproc(rtl, "_set", IL._set); + getproc(rtl, "_set2", IL._set2); + getproc(rtl, "_isrec", IL._isrec); + getproc(rtl, "_lengthw", IL._lengthw); + getproc(rtl, "_strcmpw", IL._strcmpw); + getproc(rtl, "_dllentry", IL._dllentry); + getproc(rtl, "_dispose", IL._dispose); + getproc(rtl, "_exit", IL._exit); + getproc(rtl, "_init", IL._init); + getproc(rtl, "_sofinit", IL._sofinit) + END END setrtl; -PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET); +PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS); VAR - parser: PARS.PARSER; + parser: PARS.PARSER; ext: PARS.PATH; - amd64: BOOLEAN; BEGIN - amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; + 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; + + CASE target OF + |mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64, mConst.Target_iELFSO64: + CPU := cpuAMD64 + |mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, + mConst.Target_iKolibri, mConst.Target_iObject, mConst.Target_iELF32, + mConst.Target_iELFSO32: + CPU := cpuX86 + |mConst.Target_iMSP430: + CPU := cpuMSP430 + END; + ext := mConst.FILE_EXT; CaseLabels := C.create(); CaseVar := C.create(); @@ -3247,26 +3338,26 @@ BEGIN CaseVariants := LISTS.create(NIL); LISTS.push(CaseVariants, NewVariant(0, NIL)); - checking := chk; - - IF amd64 THEN - CODE.init(6, CODE.little_endian) - ELSE - CODE.init(8, CODE.little_endian) + CASE CPU OF + |cpuAMD64: IL.init(6, IL.little_endian) + |cpuX86: IL.init(8, IL.little_endian) + |cpuMSP430: IL.init(0, IL.little_endian) END; - parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); - IF parser.open(parser, mConst.RTL_NAME) THEN - parser.parse(parser); - PARS.destroy(parser) - ELSE - PARS.destroy(parser); - parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); + IF CPU # cpuMSP430 THEN + parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); IF parser.open(parser, mConst.RTL_NAME) THEN parser.parse(parser); PARS.destroy(parser) ELSE - ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found") + PARS.destroy(parser); + parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); + IF parser.open(parser, mConst.RTL_NAME) THEN + parser.parse(parser); + PARS.destroy(parser) + ELSE + ERRORS.FileNotFound(lib_path, mConst.RTL_NAME, mConst.FILE_EXT) + END END END; @@ -3276,25 +3367,29 @@ BEGIN IF parser.open(parser, modname) THEN parser.parse(parser) ELSE - ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found") + ERRORS.FileNotFound(path, modname, mConst.FILE_EXT) END; PARS.destroy(parser); IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN - ERRORS.error1("size of global variables is too large") + ERRORS.Error(204) END; - setrtl; + IF CPU # cpuMSP430 THEN + setrtl + END; - PROG.DelUnused(PARS.program, CODE.DelImport); + PROG.DelUnused(PARS.program, IL.DelImport); - CODE.codes.bss := PARS.program.bss; - IF amd64 THEN - AMD64.CodeGen(CODE.codes, outname, target, stack, base) - ELSE - X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic) + IL.codes.bss := PARS.program.bss; + + CASE CPU OF + | cpuAMD64: AMD64.CodeGen(IL.codes, outname, target, options) + | cpuX86: X86.CodeGen(IL.codes, outname, target, options) + |cpuMSP430: MSP430.CodeGen(IL.codes, outname, target, options) END + END compile; diff --git a/programs/develop/oberon07/Source/STRINGS.ob07 b/programs/develop/oberon07/Source/STRINGS.ob07 index b33e4bbcdf..2905c08b81 100644 --- a/programs/develop/oberon07/Source/STRINGS.ob07 +++ b/programs/develop/oberon07/Source/STRINGS.ob07 @@ -92,6 +92,29 @@ BEGIN 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(hexdgt(x MOD 16)); + x := x DIV 16; + DEC(n) + END +END IntToHex; + + PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); BEGIN WHILE count > 0 DO @@ -261,12 +284,12 @@ BEGIN |0E1X..0EFX: u := LSL(ORD(c) - 0E0H, 12); - IF i + 1 < srclen THEN + IF i + 1 < srclen THEN INC(i); INC(u, ORD(BITS(ORD(src[i])) * {0..5}) * 64) END; IF i + 1 < srclen THEN - INC(i); + INC(i); INC(u, ORD(BITS(ORD(src[i])) * {0..5})) END (* diff --git a/programs/develop/oberon07/Source/TEXTDRV.ob07 b/programs/develop/oberon07/Source/TEXTDRV.ob07 index 0e6a6369d6..5838782399 100644 --- a/programs/develop/oberon07/Source/TEXTDRV.ob07 +++ b/programs/develop/oberon07/Source/TEXTDRV.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -30,10 +30,7 @@ TYPE line*, col*: INTEGER; eof*: BOOLEAN; eol*: BOOLEAN; - - open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; - peak*: PROCEDURE (text: TEXT): CHAR; - nextc*: PROCEDURE (text: TEXT) + peak*: CHAR END; @@ -43,26 +40,6 @@ VAR texts: C.COLLECTION; -PROCEDURE reset (text: TEXT); -BEGIN - text.chunk[0] := 0; - text.pos := 0; - text.size := 0; - text.file := NIL; - text.utf8 := FALSE; - text.CR := FALSE; - text.line := 1; - text.col := 1; - text.eof := FALSE; - text.eol := FALSE -END reset; - - -PROCEDURE peak (text: TEXT): CHAR; - RETURN CHR(text.chunk[text.pos]) -END peak; - - PROCEDURE load (text: TEXT); BEGIN IF ~text.eof THEN @@ -71,37 +48,40 @@ BEGIN IF text.size = 0 THEN text.eof := TRUE; text.chunk[0] := 0 - END + END; + text.peak := CHR(text.chunk[0]) END END load; -PROCEDURE next (text: TEXT); +PROCEDURE next* (text: TEXT); VAR c: CHAR; + BEGIN IF text.pos < text.size - 1 THEN - INC(text.pos) + INC(text.pos); + text.peak := CHR(text.chunk[text.pos]) ELSE load(text) END; IF ~text.eof THEN - c := peak(text); + c := text.peak; IF c = CR THEN INC(text.line); - text.col := 0; - text.eol := TRUE; - text.CR := TRUE + text.col := 0; + text.eol := TRUE; + text.CR := TRUE ELSIF c = LF THEN IF ~text.CR THEN INC(text.line); - text.col := 0; - text.eol := TRUE + text.col := 0; + text.eol := TRUE ELSE - text.eol := FALSE + text.eol := FALSE END; text.CR := FALSE ELSE @@ -123,7 +103,6 @@ END next; PROCEDURE init (text: TEXT); BEGIN - IF (text.pos = 0) & (text.size >= 3) THEN IF (text.chunk[0] = 0EFH) & (text.chunk[1] = 0BBH) & @@ -140,58 +119,13 @@ BEGIN END; text.line := 1; - text.col := 1 + text.col := 1; + text.peak := CHR(text.chunk[text.pos]) END init; -PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; -BEGIN - ASSERT(text # NIL); - - reset(text); - text.file := FILES.open(name); - IF text.file # NIL THEN - load(text); - init(text) - END - - RETURN text.file # NIL -END open; - - -PROCEDURE NewText (): TEXT; -VAR - text: TEXT; - citem: C.ITEM; - -BEGIN - citem := C.pop(texts); - IF citem = NIL THEN - NEW(text) - ELSE - text := citem(TEXT) - END - - RETURN text -END NewText; - - -PROCEDURE create* (): TEXT; -VAR - text: TEXT; -BEGIN - text := NewText(); - reset(text); - text.open := open; - text.peak := peak; - text.nextc := next - - RETURN text -END create; - - -PROCEDURE destroy* (VAR text: TEXT); +PROCEDURE close* (VAR text: TEXT); BEGIN IF text # NIL THEN IF text.file # NIL THEN @@ -201,7 +135,44 @@ BEGIN C.push(texts, text); text := NIL END -END destroy; +END close; + + +PROCEDURE open* (name: ARRAY OF CHAR): TEXT; +VAR + text: TEXT; + citem: C.ITEM; + +BEGIN + citem := C.pop(texts); + IF citem = NIL THEN + NEW(text) + ELSE + text := citem(TEXT) + END; + + IF text # NIL THEN + text.chunk[0] := 0; + text.pos := 0; + text.size := 0; + text.utf8 := FALSE; + text.CR := FALSE; + text.line := 1; + text.col := 1; + text.eof := FALSE; + text.eol := FALSE; + text.peak := 0X; + text.file := FILES.open(name); + IF text.file # NIL THEN + load(text); + init(text) + ELSE + close(text) + END + END + + RETURN text +END open; BEGIN diff --git a/programs/develop/oberon07/Source/UNIXTIME.ob07 b/programs/develop/oberon07/Source/UNIXTIME.ob07 index be1979b63b..e5f6ce39de 100644 --- a/programs/develop/oberon07/Source/UNIXTIME.ob07 +++ b/programs/develop/oberon07/Source/UNIXTIME.ob07 @@ -1,7 +1,7 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) @@ -55,12 +55,7 @@ END init; PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; -VAR - d, s: INTEGER; -BEGIN - d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4; - s := d * 86400 + hour * 3600 + min * 60 + sec - RETURN s + 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; diff --git a/programs/develop/oberon07/Source/UTILS.ob07 b/programs/develop/oberon07/Source/UTILS.ob07 index 8f0766b766..c31ac8189e 100644 --- a/programs/develop/oberon07/Source/UTILS.ob07 +++ b/programs/develop/oberon07/Source/UTILS.ob07 @@ -17,9 +17,12 @@ CONST bit_depth* = HOST.bit_depth; maxint* = HOST.maxint; minint* = HOST.minint; - + OS = HOST.OS; + min32* = -2147483647-1; + max32* = 2147483647; + VAR @@ -29,6 +32,22 @@ VAR maxreal*: REAL; + target*: + + RECORD + + bit_depth*, + maxInt*, + minInt*, + maxSet*, + maxHex*: INTEGER; + + maxReal*: REAL + + END; + + bit_diff*: INTEGER; + PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; RETURN HOST.FileRead(F, Buffer, bytes) @@ -112,6 +131,76 @@ BEGIN END UnixTime; +PROCEDURE SetBitDepth* (BitDepth: INTEGER); +BEGIN + ASSERT((BitDepth = 16) OR (BitDepth = 32) OR (BitDepth = 64)); + bit_diff := bit_depth - BitDepth; + ASSERT(bit_diff >= 0); + + target.bit_depth := BitDepth; + target.maxSet := BitDepth - 1; + target.maxHex := BitDepth DIV 4; + target.minInt := ASR(minint, bit_diff); + target.maxInt := ASR(maxint, bit_diff); + target.maxReal := 1.9; + PACK(target.maxReal, 1023); +END SetBitDepth; + + +PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE; + RETURN ASR(n, 8 * idx) MOD 256 +END Byte; + + +PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF bytes MOD align # 0 THEN + res := maxint - bytes >= align - (bytes MOD align); + IF res THEN + bytes := bytes + align - (bytes MOD align) + END + ELSE + res := TRUE + END + + RETURN res +END Align; + + +PROCEDURE Long* (value: INTEGER): INTEGER; + RETURN ASR(LSL(value, bit_diff), bit_diff) +END Long; + + +PROCEDURE Short* (value: INTEGER): INTEGER; + RETURN LSR(LSL(value, bit_diff), bit_diff) +END Short; + + +PROCEDURE Log2* (x: INTEGER): INTEGER; +VAR + n: INTEGER; + +BEGIN + ASSERT(x > 0); + + n := 0; + WHILE ~ODD(x) DO + x := x DIV 2; + INC(n) + END; + + IF x # 1 THEN + n := -1 + END + + RETURN n +END Log2; + + BEGIN time := GetTickCount(); COPY(HOST.eol, eol); diff --git a/programs/develop/oberon07/Source/WRITER.ob07 b/programs/develop/oberon07/Source/WRITER.ob07 index 92f90fe513..4781013bd1 100644 --- a/programs/develop/oberon07/Source/WRITER.ob07 +++ b/programs/develop/oberon07/Source/WRITER.ob07 @@ -1,13 +1,13 @@ я╗┐(* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2019, Anton Krotov All rights reserved. *) MODULE WRITER; -IMPORT FILES, ERRORS, MACHINE; +IMPORT FILES, ERRORS, UTILS; TYPE @@ -35,7 +35,7 @@ BEGIN IF FILES.WriteByte(file, n) THEN INC(counter) ELSE - ERRORS.error1("writing file error") + ERRORS.Error(201) END END WriteByte; @@ -47,7 +47,7 @@ VAR BEGIN n := FILES.write(file, chunk, bytes); IF n # bytes THEN - ERRORS.error1("writing file error") + ERRORS.Error(201) END; INC(counter, n) END Write; @@ -59,7 +59,7 @@ VAR BEGIN FOR i := 0 TO 7 DO - WriteByte(file, MACHINE.Byte(n, i)) + WriteByte(file, UTILS.Byte(n, i)) END END Write64LE; @@ -70,15 +70,15 @@ VAR BEGIN FOR i := 0 TO 3 DO - WriteByte(file, MACHINE.Byte(n, i)) + WriteByte(file, UTILS.Byte(n, i)) END END Write32LE; PROCEDURE Write16LE* (file: FILE; n: INTEGER); BEGIN - WriteByte(file, MACHINE.Byte(n, 0)); - WriteByte(file, MACHINE.Byte(n, 1)) + WriteByte(file, UTILS.Byte(n, 0)); + WriteByte(file, UTILS.Byte(n, 1)) END Write16LE; diff --git a/programs/develop/oberon07/Source/X86.ob07 b/programs/develop/oberon07/Source/X86.ob07 index 6dee89a4fc..fde3b94b47 100644 --- a/programs/develop/oberon07/Source/X86.ob07 +++ b/programs/develop/oberon07/Source/X86.ob07 @@ -7,7 +7,8 @@ MODULE X86; -IMPORT CODE, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, mConst := CONSTANTS, MACHINE, CHL := CHUNKLISTS, PATHS; +IMPORT IL, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, PROG, + mConst := CONSTANTS, CHL := CHUNKLISTS, PATHS; CONST @@ -31,7 +32,7 @@ CONST TYPE - COMMAND = CODE.COMMAND; + COMMAND = IL.COMMAND; ANYCODE = POINTER TO RECORD (LISTS.ITEM) @@ -40,7 +41,7 @@ TYPE END; - TCODE = POINTER TO RECORD (ANYCODE) + CODE = POINTER TO RECORD (ANYCODE) code: ARRAY CODECHUNK OF BYTE; length: INTEGER @@ -89,27 +90,29 @@ VAR CodeList: LISTS.LIST; + tcount: INTEGER; + PROCEDURE Byte (n: INTEGER): BYTE; - RETURN MACHINE.Byte(n, 0) + RETURN UTILS.Byte(n, 0) END Byte; PROCEDURE Word (n: INTEGER): INTEGER; - RETURN MACHINE.Byte(n, 0) + MACHINE.Byte(n, 1) * 256 + RETURN UTILS.Byte(n, 0) + UTILS.Byte(n, 1) * 256 END Word; PROCEDURE OutByte* (n: BYTE); VAR - c: TCODE; + c: CODE; last: ANYCODE; BEGIN last := CodeList.last(ANYCODE); - IF (last IS TCODE) & (last(TCODE).length < CODECHUNK) THEN - c := last(TCODE); + IF (last IS CODE) & (last(CODE).length < CODECHUNK) THEN + c := last(CODE); c.code[c.length] := n; INC(c.length) ELSE @@ -124,10 +127,10 @@ END OutByte; PROCEDURE OutInt (n: INTEGER); BEGIN - OutByte(MACHINE.Byte(n, 0)); - OutByte(MACHINE.Byte(n, 1)); - OutByte(MACHINE.Byte(n, 2)); - OutByte(MACHINE.Byte(n, 3)) + OutByte(UTILS.Byte(n, 0)); + OutByte(UTILS.Byte(n, 1)); + OutByte(UTILS.Byte(n, 2)); + OutByte(UTILS.Byte(n, 3)) END OutInt; @@ -181,10 +184,10 @@ END OutIntByte; PROCEDURE shift* (op, reg: INTEGER); BEGIN CASE op OF - |CODE.opASR, CODE.opASR1, CODE.opASR2: OutByte(0F8H + reg) - |CODE.opROR, CODE.opROR1, CODE.opROR2: OutByte(0C8H + reg) - |CODE.opLSL, CODE.opLSL1, CODE.opLSL2: OutByte(0E0H + reg) - |CODE.opLSR, CODE.opLSR1, CODE.opLSR2: OutByte(0E8H + reg) + |IL.opASR, IL.opASR1, IL.opASR2: OutByte(0F8H + reg) + |IL.opROR, IL.opROR1, IL.opROR2: OutByte(0C8H + reg) + |IL.opLSL, IL.opLSL1, IL.opLSL2: OutByte(0E0H + reg) + |IL.opLSR, IL.opLSR1, IL.opLSR2: OutByte(0E8H + reg) END END shift; @@ -320,25 +323,9 @@ BEGIN END drop; -PROCEDURE log2* (x: INTEGER): INTEGER; -VAR - n: INTEGER; - -BEGIN - ASSERT(x > 0); - - n := 0; - WHILE ~ODD(x) DO - x := x DIV 2; - INC(n) - END; - - IF x # 1 THEN - n := -1 - END - - RETURN n -END log2; +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; PROCEDURE cond* (op: INTEGER): INTEGER; @@ -347,28 +334,21 @@ VAR BEGIN CASE op OF - |CODE.opGT, CODE.opGTR, CODE.opLTL: res := jg - |CODE.opGE, CODE.opGER, CODE.opLEL: res := jge - |CODE.opLT, CODE.opLTR, CODE.opGTL: res := jl - |CODE.opLE, CODE.opLER, CODE.opGEL: res := jle - |CODE.opEQ, CODE.opEQR, CODE.opEQL: res := je - |CODE.opNE, CODE.opNER, CODE.opNEL: res := jne + |IL.opGT, IL.opGTC: res := jg + |IL.opGE, IL.opGEC: res := jge + |IL.opLT, IL.opLTC: res := jl + |IL.opLE, IL.opLEC: res := jle + |IL.opEQ, IL.opEQC: res := je + |IL.opNE, IL.opNEC: res := jne END RETURN res END cond; -PROCEDURE inv1* (op: INTEGER): INTEGER; -BEGIN - IF ODD(op) THEN - DEC(op) - ELSE - INC(op) - END - - RETURN op -END inv1; +PROCEDURE inv0* (op: INTEGER): INTEGER; + RETURN ORD(BITS(op) / {0}) +END inv0; PROCEDURE Reloc* (op, value: INTEGER); @@ -436,12 +416,12 @@ VAR reg1: INTEGER; BEGIN - label := CODE.codes.rtl[proc]; + label := IL.codes.rtl[proc]; IF label < 0 THEN label := -label; IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICIMP, label); OutByte2(0FFH, 010H + reg1); // call dword[reg1] drop @@ -485,7 +465,7 @@ BEGIN code.offset := count; CASE code OF - |TCODE: INC(count, code.length) + |CODE: INC(count, code.length) |LABEL: BIN.SetLabel(program, code.label, count) |JMP: IF code.short THEN INC(count, 2) ELSE INC(count, 5) END; code.offset := count |JCC: IF code.short THEN INC(count, 2) ELSE INC(count, 6) END; code.offset := count @@ -518,7 +498,7 @@ BEGIN CASE code OF - |TCODE: + |CODE: FOR i := 0 TO code.length - 1 DO BIN.PutCode(program, code.code[i]) END @@ -576,14 +556,14 @@ END BinOp; PROCEDURE PushAll (NumberOfParameters: INTEGER); BEGIN REG.PushAll(R); - R.pushed := R.pushed - NumberOfParameters + DEC(R.pushed, NumberOfParameters) END PushAll; PROCEDURE NewLabel (): INTEGER; BEGIN BIN.NewLabel(program) - RETURN CODE.NewLabel() + RETURN IL.NewLabel() END NewLabel; @@ -593,7 +573,7 @@ BEGIN END GetRegA; -PROCEDURE translate (code: CODE.CODES; pic: BOOLEAN; stroffs: INTEGER); +PROCEDURE translate (code: IL.CODES; pic: BOOLEAN; stroffs: INTEGER); VAR cmd: COMMAND; @@ -601,7 +581,7 @@ VAR n, a, b, label, cc: INTEGER; - param1, param2: INTEGER; + opcode, param1, param2: INTEGER; float: REAL; @@ -613,17 +593,19 @@ BEGIN param1 := cmd.param1; param2 := cmd.param2; - CASE cmd.opcode OF + opcode := cmd.opcode; - |CODE.opJMP: + CASE opcode OF + + |IL.opJMP: jmp(param1) - |CODE.opCALL: + |IL.opCALL: call(param1) - |CODE.opCALLI: + |IL.opCALLI: IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICIMP, param1); OutByte2(0FFH, 010H + reg1); // call dword[reg1] drop @@ -632,13 +614,13 @@ BEGIN Reloc(BIN.RIMP, param1) END - |CODE.opCALLP: + |IL.opCALLP: UnOp(reg1); OutByte2(0FFH, 0D0H + reg1); // call reg1 drop; ASSERT(R.top = -1) - |CODE.opPRECALL: + |IL.opPRECALL: n := param2; IF (param1 # 0) & (n # 0) THEN subrc(esp, 8) @@ -650,7 +632,7 @@ BEGIN END; PushAll(0) - |CODE.opALIGN16: + |IL.opALIGN16: ASSERT(eax IN R.regs); mov(eax, esp); andrc(esp, -16); @@ -660,7 +642,7 @@ BEGIN END; push(eax) - |CODE.opRES: + |IL.opRES: ASSERT(R.top = -1); GetRegA; n := param2; @@ -670,7 +652,7 @@ BEGIN DEC(n) END - |CODE.opRESF: + |IL.opRESF: n := param2; IF n > 0 THEN OutByte3(0DDH, 5CH + long(n * 8), 24H); @@ -684,7 +666,7 @@ BEGIN DEC(n) END - |CODE.opENTER: + |IL.opENTER: ASSERT(R.top = -1); SetLabel(param1); @@ -704,8 +686,8 @@ BEGIN END END - |CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: - IF cmd.opcode = CODE.opLEAVER THEN + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode = IL.opLEAVER THEN UnOp(reg1); IF reg1 # eax THEN GetRegA; @@ -717,7 +699,10 @@ BEGIN ASSERT(R.top = -1); - mov(esp, ebp); + IF param1 > 0 THEN + mov(esp, ebp) + END; + pop(ebp); n := param2; @@ -728,10 +713,10 @@ BEGIN OutByte(0C3H) // ret END - |CODE.opERRC: + |IL.opPUSHC: pushc(param2) - |CODE.opPARAM: + |IL.opPARAM: n := param2; IF n = 1 THEN UnOp(reg1); @@ -742,26 +727,25 @@ BEGIN PushAll(n) END - |CODE.opCLEANUP: + |IL.opCLEANUP: n := param2 * 4; IF n # 0 THEN addrc(esp, n) END - |CODE.opPOPSP: + |IL.opPOPSP: pop(esp) - |CODE.opCONST: - reg1 := REG.GetAnyReg(R); - movrc(reg1, param2) + |IL.opCONST: + movrc(GetAnyReg(), param2) - |CODE.opLABEL: - SetLabel(param2) // L: + |IL.opLABEL: + SetLabel(param1) // L: - |CODE.opNOP: + |IL.opNOP: - |CODE.opGADR: - reg1 := REG.GetAnyReg(R); + |IL.opGADR: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2) ELSE @@ -769,20 +753,18 @@ BEGIN Reloc(BIN.RBSS, param2) END - |CODE.opLADR: + |IL.opLADR: n := param2 * 4; - reg1 := REG.GetAnyReg(R); - OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] + OutByte2(8DH, 45H + GetAnyReg() * 8 + long(n)); // lea reg1, dword[ebp + n] OutIntByte(n) - |CODE.opVADR: + |IL.opVADR: n := param2 * 4; - reg1 := REG.GetAnyReg(R); - OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] OutIntByte(n) - |CODE.opSADR: - reg1 := REG.GetAnyReg(R); + |IL.opSADR: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICDATA, stroffs + param2); ELSE @@ -790,30 +772,30 @@ BEGIN Reloc(BIN.RDATA, stroffs + param2) END - |CODE.opSAVEC: + |IL.opSAVEC: UnOp(reg1); OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2 drop - |CODE.opSAVE8C: + |IL.opSAVE8C: UnOp(reg1); OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2 drop - |CODE.opSAVE16C: + |IL.opSAVE16C: UnOp(reg1); OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2 drop - |CODE.opVLOAD32: + |IL.opVLOAD32: n := param2 * 4; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] OutIntByte(n); OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] - |CODE.opGLOAD32: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD32: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] @@ -822,25 +804,24 @@ BEGIN Reloc(BIN.RBSS, param2) END - |CODE.opLLOAD32: + |IL.opLLOAD32: n := param2 * 4; - reg1 := REG.GetAnyReg(R); - OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutByte2(8BH, 45H + GetAnyReg() * 8 + long(n)); // mov reg1, dword[ebp + n] OutIntByte(n) - |CODE.opLOAD32: + |IL.opLOAD32: UnOp(reg1); OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] - |CODE.opVLOAD8: + |IL.opVLOAD8: n := param2 * 4; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] OutIntByte(n); OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] - |CODE.opGLOAD8: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD8: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] @@ -849,25 +830,24 @@ BEGIN Reloc(BIN.RBSS, param2) END - |CODE.opLLOAD8: + |IL.opLLOAD8: n := param2 * 4; - reg1 := REG.GetAnyReg(R); - OutByte3(0FH, 0B6H, 45H + reg1 * 8 + long(n)); // movzx reg1, byte[ebp + n] + OutByte3(0FH, 0B6H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, byte[ebp + n] OutIntByte(n) - |CODE.opLOAD8: + |IL.opLOAD8: UnOp(reg1); OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] - |CODE.opVLOAD16: + |IL.opVLOAD16: n := param2 * 4; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] OutIntByte(n); OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] - |CODE.opGLOAD16: - reg1 := REG.GetAnyReg(R); + |IL.opGLOAD16: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICBSS, param2); OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] @@ -876,26 +856,25 @@ BEGIN Reloc(BIN.RBSS, param2) END - |CODE.opLLOAD16: + |IL.opLLOAD16: n := param2 * 4; - reg1 := REG.GetAnyReg(R); - OutByte3(0FH, 0B7H, 45H + reg1 * 8 + long(n)); // movzx reg1, word[ebp + n] + OutByte3(0FH, 0B7H, 45H + GetAnyReg() * 8 + long(n)); // movzx reg1, word[ebp + n] OutIntByte(n) - |CODE.opLOAD16: + |IL.opLOAD16: UnOp(reg1); OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] - |CODE.opUMINUS: + |IL.opUMINUS: UnOp(reg1); neg(reg1) - |CODE.opADD: + |IL.opADD: BinOp(reg1, reg2); add(reg1, reg2); drop - |CODE.opADDL, CODE.opADDR: + |IL.opADDL, IL.opADDR: IF param2 # 0 THEN UnOp(reg1); IF param2 = 1 THEN @@ -907,12 +886,12 @@ BEGIN END END - |CODE.opSUB: + |IL.opSUB: BinOp(reg1, reg2); OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 drop - |CODE.opSUBR, CODE.opSUBL: + |IL.opSUBR, IL.opSUBL: UnOp(reg1); n := param2; IF n = 1 THEN @@ -922,18 +901,18 @@ BEGIN ELSIF n # 0 THEN subrc(reg1, n) END; - IF cmd.opcode = CODE.opSUBL THEN + IF opcode = IL.opSUBL THEN neg(reg1) END - |CODE.opMULC: + |IL.opMULC: UnOp(reg1); a := param2; IF a > 1 THEN - n := log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -961,33 +940,33 @@ BEGIN END END - |CODE.opMUL: + |IL.opMUL: BinOp(reg1, reg2); OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2 drop - |CODE.opSAVE, CODE.opSAVE32: + |IL.opSAVE, IL.opSAVE32: BinOp(reg2, reg1); OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2 drop; drop - |CODE.opSAVE8: + |IL.opSAVE8: BinOp(reg2, reg1); OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 drop; drop - |CODE.opSAVE16: + |IL.opSAVE16: BinOp(reg2, reg1); OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2 drop; drop - |CODE.opSAVEP: + |IL.opSAVEP: UnOp(reg1); IF pic THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); Pic(reg2, BIN.PICCODE, param2); OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2 drop @@ -997,10 +976,10 @@ BEGIN END; drop - |CODE.opSAVEIP: + |IL.opSAVEIP: UnOp(reg1); IF pic THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); Pic(reg2, BIN.PICIMP, param2); OutByte2(0FFH, 30H + reg2); // push dword[reg2] OutByte2(08FH, reg1); // pop dword[reg1] @@ -1012,8 +991,8 @@ BEGIN END; drop - |CODE.opPUSHP: - reg1 := REG.GetAnyReg(R); + |IL.opPUSHP: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICCODE, param2) ELSE @@ -1021,8 +1000,8 @@ BEGIN Reloc(BIN.RCODE, param2) END - |CODE.opPUSHIP: - reg1 := REG.GetAnyReg(R); + |IL.opPUSHIP: + reg1 := GetAnyReg(); IF pic THEN Pic(reg1, BIN.PICIMP, param2); OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1] @@ -1031,90 +1010,71 @@ BEGIN Reloc(BIN.RIMP, param2) END - |CODE.opNOT: + |IL.opNOT: UnOp(reg1); test(reg1); setcc(sete, reg1); andrc(reg1, 1) - |CODE.opORD: + |IL.opORD: UnOp(reg1); test(reg1); setcc(setne, reg1); andrc(reg1, 1) - |CODE.opSBOOL: + |IL.opSBOOL: BinOp(reg2, reg1); test(reg2); - setcc(setne, reg2); - OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 + OutByte3(0FH, 95H, reg1); // setne byte[reg1] drop; drop - |CODE.opSBOOLC: + |IL.opSBOOLC: UnOp(reg1); OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1 drop - |CODE.opODD: + |IL.opODD: UnOp(reg1); andrc(reg1, 1) - |CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, - CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, - CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: - UnOp(reg1); - IF param2 = 0 THEN - test(reg1) + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(reg1, reg2); + cmprr(reg1, reg2); + drop ELSE - cmprc(reg1, param2) + UnOp(reg1); + IF param2 = 0 THEN + test(reg1) + ELSE + cmprc(reg1, param2) + END END; - drop; - cc := cond(cmd.opcode); - IF cmd.next(COMMAND).opcode = CODE.opJE THEN + drop; + cc := cond(opcode); + + IF cmd.next(COMMAND).opcode = IL.opJE THEN label := cmd.next(COMMAND).param1; jcc(cc, label); cmd := cmd.next(COMMAND) - ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + ELSIF cmd.next(COMMAND).opcode = IL.opJNE THEN label := cmd.next(COMMAND).param1; - jcc(inv1(cc), label); + jcc(inv0(cc), label); cmd := cmd.next(COMMAND) ELSE - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); setcc(cc + 16, reg1); andrc(reg1, 1) END - |CODE.opGT, CODE.opGE, CODE.opLT, - CODE.opLE, CODE.opEQ, CODE.opNE: + |IL.opEQB, IL.opNEB: BinOp(reg1, reg2); - cmprr(reg1, reg2); - drop; - drop; - cc := cond(cmd.opcode); - - IF cmd.next(COMMAND).opcode = CODE.opJE THEN - label := cmd.next(COMMAND).param1; - jcc(cc, label); - cmd := cmd.next(COMMAND) - - ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN - label := cmd.next(COMMAND).param1; - jcc(inv1(cc), label); - cmd := cmd.next(COMMAND) - - ELSE - reg1 := REG.GetAnyReg(R); - setcc(cc + 16, reg1); - andrc(reg1, 1) - END - - |CODE.opEQB, CODE.opNEB: - BinOp(reg1, reg2); - drop; drop; test(reg1); @@ -1127,15 +1087,14 @@ BEGIN // @@: cmprr(reg1, reg2); - reg1 := REG.GetAnyReg(R); - IF cmd.opcode = CODE.opEQB THEN + IF opcode = IL.opEQB THEN setcc(sete, reg1) ELSE setcc(setne, reg1) END; andrc(reg1, 1) - - |CODE.opACC: + + |IL.opACC: IF (R.top # 0) OR (R.stk[0] # eax) THEN PushAll(0); GetRegA; @@ -1143,33 +1102,33 @@ BEGIN DEC(R.pushed) END - |CODE.opDROP: + |IL.opDROP: UnOp(reg1); drop - |CODE.opJNZ: + |IL.opJNZ: UnOp(reg1); test(reg1); jcc(jne, param1) - |CODE.opJZ: + |IL.opJZ: UnOp(reg1); test(reg1); jcc(je, param1) - |CODE.opJE: + |IL.opJE: UnOp(reg1); test(reg1); jcc(jne, param1); - drop; + drop - |CODE.opJNE: + |IL.opJNE: UnOp(reg1); test(reg1); jcc(je, param1); - drop; + drop - |CODE.opSWITCH: + |IL.opSWITCH: UnOp(reg1); IF param2 = 0 THEN reg2 := eax @@ -1183,26 +1142,32 @@ BEGIN END; drop - |CODE.opENDSW: + |IL.opENDSW: - |CODE.opCASEL: + |IL.opCASEL: cmprc(eax, param1); jcc(jl, param2) - |CODE.opCASER: + |IL.opCASER: cmprc(eax, param1); jcc(jg, param2) - |CODE.opCASELR: + |IL.opCASELR: cmprc(eax, param1); jcc(jl, param2); jcc(jg, cmd.param3) - |CODE.opCODE: + |IL.opCODE: OutByte(param2) - |CODE.opGET: - BinOp(reg1, reg2); + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(reg1, reg2) + ELSIF opcode = IL.opGETC THEN + UnOp(reg2); + reg1 := GetAnyReg(); + movrc(reg1, param1) + END; drop; drop; @@ -1224,11 +1189,11 @@ BEGIN push(reg2); push(reg1); pushc(8); - CallRTL(pic, CODE._move) + CallRTL(pic, IL._move) END - |CODE.opSAVES: + |IL.opSAVES: UnOp(reg1); drop; PushAll(0); @@ -1243,19 +1208,19 @@ BEGIN END; pushc(param1); - CallRTL(pic, CODE._move) + CallRTL(pic, IL._move) - |CODE.opCHKBYTE: + |IL.opCHKBYTE: BinOp(reg1, reg2); cmprc(reg1, 256); jcc(jb, param1) - |CODE.opCHKIDX: + |IL.opCHKIDX: UnOp(reg1); cmprc(reg1, param2); jcc(jb, param1) - |CODE.opCHKIDX2: + |IL.opCHKIDX2: BinOp(reg1, reg2); IF param2 # -1 THEN cmprr(reg2, reg1); @@ -1268,7 +1233,7 @@ BEGIN R.stk[R.top] := reg2 END - |CODE.opLEN: + |IL.opLEN: n := param2; UnOp(reg1); drop; @@ -1283,136 +1248,94 @@ BEGIN INCL(R.regs, reg1); ASSERT(REG.GetReg(R, reg1)) - |CODE.opINC1: + |IL.opINCC: UnOp(reg1); - OutByte2(0FFH, reg1); // inc dword[reg1] + OutByte2(81H + short(param2), reg1); OutIntByte(param2); // add dword[reg1], param2 drop - |CODE.opDEC1: - UnOp(reg1); - OutByte2(0FFH, 8 + reg1); // dec dword[reg1] - drop - - |CODE.opINCC: - UnOp(reg1); - n := param2; - OutByte2(81H + short(n), reg1); OutIntByte(n); // add dword[reg1], n - drop - - |CODE.opDECC: - UnOp(reg1); - n := param2; - OutByte2(81H + short(n), 28H + reg1); OutIntByte(n); // sub dword[reg1], n - drop - - |CODE.opINC: + |IL.opINC, IL.opDEC: BinOp(reg1, reg2); - OutByte2(01H, reg1 * 8 + reg2); // add dword[reg2], reg1 + OutByte2(01H + 28H * ORD(opcode = IL.opDEC), reg1 * 8 + reg2); // add/sub dword[reg2], reg1 drop; drop - |CODE.opDEC: + |IL.opINCCB, IL.opDECCB: + UnOp(reg1); + OutByte3(80H, 28H * ORD(opcode = IL.opDECCB) + reg1, Byte(param2)); // add/sub byte[reg1], n + drop + + |IL.opINCB, IL.opDECB: BinOp(reg1, reg2); - OutByte2(29H, reg1 * 8 + reg2); // sub dword[reg2], reg1 + OutByte2(28H * ORD(opcode = IL.opDECB), reg1 * 8 + reg2); // add/sub byte[reg2], reg1 drop; drop - |CODE.opINC1B: - UnOp(reg1); - OutByte2(0FEH, reg1); // inc byte[reg1] - drop - - |CODE.opDEC1B: - UnOp(reg1); - OutByte2(0FEH, 08H + reg1); // dec byte[reg1] - drop - - |CODE.opINCCB: - UnOp(reg1); - OutByte3(80H, reg1, Byte(param2)); // add byte[reg1], n - drop - - |CODE.opDECCB: - UnOp(reg1); - OutByte3(80H, 28H + reg1, Byte(param2)); // sub byte[reg1], n - drop - - |CODE.opINCB, CODE.opDECB: - BinOp(reg1, reg2); - IF cmd.opcode = CODE.opINCB THEN - OutByte2(00H, reg1 * 8 + reg2) // add byte[reg2], reg1 - ELSE - OutByte2(28H, reg1 * 8 + reg2) // sub byte[reg2], reg1 - END; - drop; - drop - - |CODE.opMULS: + |IL.opMULS: BinOp(reg1, reg2); OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 drop - |CODE.opMULSC: + |IL.opMULSC: UnOp(reg1); andrc(reg1, param2) - |CODE.opDIVS: + |IL.opDIVS: BinOp(reg1, reg2); xor(reg1, reg2); drop - |CODE.opDIVSC: + |IL.opDIVSC: UnOp(reg1); OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n OutIntByte(param2) - |CODE.opADDS: + |IL.opADDS: BinOp(reg1, reg2); OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2 drop - |CODE.opSUBS: + |IL.opSUBS: BinOp(reg1, reg2); not(reg2); OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 drop - |CODE.opADDSL, CODE.opADDSR: + |IL.opADDSL, IL.opADDSR: UnOp(reg1); orrc(reg1, param2) - |CODE.opSUBSL: + |IL.opSUBSL: UnOp(reg1); not(reg1); andrc(reg1, param2) - |CODE.opSUBSR: + |IL.opSUBSR: UnOp(reg1); - andrc(reg1, ORD(-BITS(param2))); + andrc(reg1, ORD(-BITS(param2))) - |CODE.opUMINS: + |IL.opUMINS: UnOp(reg1); not(reg1) - |CODE.opLENGTH: + |IL.opLENGTH: PushAll(2); - CallRTL(pic, CODE._length); + CallRTL(pic, IL._length); GetRegA - |CODE.opLENGTHW: + |IL.opLENGTHW: PushAll(2); - CallRTL(pic, CODE._lengthw); + CallRTL(pic, IL._lengthw); GetRegA - |CODE.opCHR: + |IL.opCHR: UnOp(reg1); andrc(reg1, 255) - |CODE.opWCHR: + |IL.opWCHR: UnOp(reg1); andrc(reg1, 65535) - |CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: + |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: UnOp(reg1); IF reg1 # ecx THEN ASSERT(REG.GetReg(R, ecx)); @@ -1423,10 +1346,10 @@ BEGIN BinOp(reg1, reg2); ASSERT(reg2 = ecx); OutByte(0D3H); - shift(cmd.opcode, reg1); // shift reg1, cl + shift(opcode, reg1); // shift reg1, cl drop - |CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: + |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: UnOp(reg1); IF reg1 # ecx THEN ASSERT(REG.GetReg(R, ecx)); @@ -1434,30 +1357,30 @@ BEGIN drop END; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); movrc(reg1, param2); BinOp(reg1, reg2); ASSERT(reg1 = ecx); OutByte(0D3H); - shift(cmd.opcode, reg2); // shift reg2, cl + shift(opcode, reg2); // shift reg2, cl drop; drop; ASSERT(REG.GetReg(R, reg2)) - |CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: UnOp(reg1); - n := ORD(BITS(param2) * {0..4}); + n := param2 MOD 32; IF n # 1 THEN OutByte(0C1H) ELSE OutByte(0D1H) END; - shift(cmd.opcode, reg1); // shift reg1, n + shift(opcode, reg1); // shift reg1, n IF n # 1 THEN OutByte(n) END - |CODE.opMIN: + |IL.opMIN: BinOp(reg1, reg2); cmprr(reg1, reg2); OutByte2(07EH, 002H); // jle @f @@ -1465,7 +1388,7 @@ BEGIN // @@: drop - |CODE.opMAX: + |IL.opMAX: BinOp(reg1, reg2); cmprr(reg1, reg2); OutByte2(07DH, 002H); // jge @f @@ -1473,21 +1396,21 @@ BEGIN // @@: drop - |CODE.opMINC: + |IL.opMINC: UnOp(reg1); cmprc(reg1, param2); OutByte2(07EH, 005H); // jle @f - movrc(reg1, param2); // mov reg1, param2 + movrc(reg1, param2) // mov reg1, param2 // @@: - |CODE.opMAXC: + |IL.opMAXC: UnOp(reg1); cmprc(reg1, param2); OutByte2(07DH, 005H); // jge @f - movrc(reg1, param2); // mov reg1, param2 + movrc(reg1, param2) // mov reg1, param2 // @@: - |CODE.opIN: + |IL.opIN: label := NewLabel(); BinOp(reg1, reg2); cmprc(reg1, 32); @@ -1501,10 +1424,10 @@ BEGIN SetLabel(label); drop - |CODE.opINR: + |IL.opINR: label := NewLabel(); UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); cmprc(reg1, 32); OutByte2(72H, 4); // jb L xor(reg1, reg1); @@ -1517,42 +1440,42 @@ BEGIN SetLabel(label); drop - |CODE.opINL: + |IL.opINL: UnOp(reg1); OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2 setcc(setc, reg1); andrc(reg1, 1) - |CODE.opRSET: + |IL.opRSET: PushAll(2); - CallRTL(pic, CODE._set); + CallRTL(pic, IL._set); GetRegA - |CODE.opRSETR: + |IL.opRSETR: PushAll(1); pushc(param2); - CallRTL(pic, CODE._set); + CallRTL(pic, IL._set); GetRegA - |CODE.opRSETL: + |IL.opRSETL: PushAll(1); pushc(param2); - CallRTL(pic, CODE._set2); + CallRTL(pic, IL._set2); GetRegA - |CODE.opRSET1: + |IL.opRSET1: UnOp(reg1); PushAll(1); push(reg1); - CallRTL(pic, CODE._set); + CallRTL(pic, IL._set); GetRegA - |CODE.opINCL, CODE.opEXCL: + |IL.opINCL, IL.opEXCL: BinOp(reg1, reg2); cmprc(reg1, 32); OutByte2(73H, 03H); // jnb L OutByte(0FH); - IF cmd.opcode = CODE.opINCL THEN + IF opcode = IL.opINCL THEN OutByte(0ABH) // bts dword[reg2], reg1 ELSE OutByte(0B3H) // btr dword[reg2], reg1 @@ -1562,27 +1485,27 @@ BEGIN drop; drop - |CODE.opINCLC: + |IL.opINCLC: UnOp(reg1); OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2 drop - |CODE.opEXCLC: + |IL.opEXCLC: UnOp(reg1); OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2 drop - |CODE.opDIV: + |IL.opDIV: PushAll(2); - CallRTL(pic, CODE._div); + CallRTL(pic, IL._div); GetRegA - |CODE.opDIVR: + |IL.opDIVR: a := param2; IF a > 1 THEN - n := log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -1597,7 +1520,7 @@ BEGIN UnOp(reg1); IF a < 0 THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); mov(reg2, reg1); IF n # 1 THEN OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n @@ -1617,28 +1540,28 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(pic, CODE._div); + CallRTL(pic, IL._div); GetRegA END END - |CODE.opDIVL: + |IL.opDIVL: PushAll(1); pushc(param2); - CallRTL(pic, CODE._div2); + CallRTL(pic, IL._div2); GetRegA - |CODE.opMOD: + |IL.opMOD: PushAll(2); - CallRTL(pic, CODE._mod); + CallRTL(pic, IL._mod); GetRegA - |CODE.opMODR: + |IL.opMODR: a := param2; IF a > 1 THEN - n := log2(a) + n := UTILS.Log2(a) ELSIF a < -1 THEN - n := log2(-a) + n := UTILS.Log2(-a) ELSE n := -1 END; @@ -1666,100 +1589,83 @@ BEGIN ELSE PushAll(1); pushc(param2); - CallRTL(pic, CODE._mod); + CallRTL(pic, IL._mod); GetRegA END END - |CODE.opMODL: + |IL.opMODL: PushAll(1); pushc(param2); - CallRTL(pic, CODE._mod2); + CallRTL(pic, IL._mod2); GetRegA - |CODE.opERR: - CallRTL(pic, CODE._error) + |IL.opERR: + CallRTL(pic, IL._error) - |CODE.opABS: + |IL.opABS: UnOp(reg1); test(reg1); OutByte2(07DH, 002H); // jge @f - neg(reg1); // neg reg1 + neg(reg1) // neg reg1 // @@: - |CODE.opCOPY: + |IL.opCOPY: PushAll(2); pushc(param2); - CallRTL(pic, CODE._move2) + CallRTL(pic, IL._move2) - |CODE.opMOVE: + |IL.opMOVE: PushAll(3); - CallRTL(pic, CODE._move2) + CallRTL(pic, IL._move2) - |CODE.opCOPYA: + |IL.opCOPYA: PushAll(4); pushc(param2); - CallRTL(pic, CODE._arrcpy); + CallRTL(pic, IL._arrcpy); GetRegA - |CODE.opCOPYS: + |IL.opCOPYS: PushAll(4); pushc(param2); - CallRTL(pic, CODE._strcpy) + CallRTL(pic, IL._strcpy) - |CODE.opCOPYS2: - PushAll(4); - pushc(param2); - CallRTL(pic, CODE._strcpy2) - - |CODE.opROT: + |IL.opROT: PushAll(0); push(esp); pushc(param2); - CallRTL(pic, CODE._rot) + CallRTL(pic, IL._rot) - |CODE.opNEW: + |IL.opNEW: PushAll(1); n := param2 + 8; - ASSERT(MACHINE.Align(n, 32)); + ASSERT(UTILS.Align(n, 32)); pushc(n); pushc(param1); - CallRTL(pic, CODE._new) + CallRTL(pic, IL._new) - |CODE.opDISP: + |IL.opDISP: PushAll(1); - CallRTL(pic, CODE._dispose) + CallRTL(pic, IL._dispose) - |CODE.opEQS .. CODE.opGES: + |IL.opEQS .. IL.opGES: PushAll(4); - pushc(cmd.opcode - CODE.opEQS); - CallRTL(pic, CODE._strcmp); + pushc(opcode - IL.opEQS); + CallRTL(pic, IL._strcmp); GetRegA - |CODE.opEQS2 .. CODE.opGES2: + |IL.opEQSW .. IL.opGESW: PushAll(4); - pushc(cmd.opcode - CODE.opEQS2); - CallRTL(pic, CODE._strcmp2); + pushc(opcode - IL.opEQSW); + CallRTL(pic, IL._strcmpw); GetRegA - |CODE.opEQSW .. CODE.opGESW: - PushAll(4); - pushc(cmd.opcode - CODE.opEQSW); - CallRTL(pic, CODE._strcmpw); - GetRegA - - |CODE.opEQSW2 .. CODE.opGESW2: - PushAll(4); - pushc(cmd.opcode - CODE.opEQSW2); - CallRTL(pic, CODE._strcmpw2); - GetRegA - - |CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: + |IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP: UnOp(reg1); - CASE cmd.opcode OF - |CODE.opEQP, CODE.opNEP: + CASE opcode OF + |IL.opEQP, IL.opNEP: IF pic THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); Pic(reg2, BIN.PICCODE, param1); cmprr(reg1, reg2); drop @@ -1768,9 +1674,9 @@ BEGIN Reloc(BIN.RCODE, param1) END - |CODE.opEQIP, CODE.opNEIP: + |IL.opEQIP, IL.opNEIP: IF pic THEN - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); Pic(reg2, BIN.PICIMP, param1); OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2] drop @@ -1781,64 +1687,64 @@ BEGIN END; drop; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); - CASE cmd.opcode OF - |CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) - |CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) + CASE opcode OF + |IL.opEQP, IL.opEQIP: setcc(sete, reg1) + |IL.opNEP, IL.opNEIP: setcc(setne, reg1) END; andrc(reg1, 1) - |CODE.opPUSHT: + |IL.opPUSHT: UnOp(reg1); - reg2 := REG.GetAnyReg(R); + reg2 := GetAnyReg(); OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4] - |CODE.opISREC: + |IL.opISREC: PushAll(2); - pushc(param2); - CallRTL(pic, CODE._isrec); + pushc(param2 * tcount); + CallRTL(pic, IL._isrec); GetRegA - |CODE.opIS: + |IL.opIS: PushAll(1); - pushc(param2); - CallRTL(pic, CODE._is); + pushc(param2 * tcount); + CallRTL(pic, IL._is); GetRegA - |CODE.opTYPEGR: + |IL.opTYPEGR: PushAll(1); - pushc(param2); - CallRTL(pic, CODE._guardrec); + pushc(param2 * tcount); + CallRTL(pic, IL._guardrec); GetRegA - |CODE.opTYPEGP: + |IL.opTYPEGP: UnOp(reg1); PushAll(0); push(reg1); - pushc(param2); - CallRTL(pic, CODE._guard); + pushc(param2 * tcount); + CallRTL(pic, IL._guard); GetRegA - |CODE.opTYPEGD: + |IL.opTYPEGD: UnOp(reg1); PushAll(0); OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4] - pushc(param2); - CallRTL(pic, CODE._guardrec); + pushc(param2 * tcount); + CallRTL(pic, IL._guardrec); GetRegA - |CODE.opCASET: + |IL.opCASET: push(ecx); push(ecx); - pushc(param2); - CallRTL(pic, CODE._guardrec); + pushc(param2 * tcount); + CallRTL(pic, IL._guardrec); pop(ecx); test(eax); jcc(jne, param1) - |CODE.opPACK: + |IL.opPACK: BinOp(reg1, reg2); push(reg2); OutByte3(0DBH, 004H, 024H); // fild dword[esp] @@ -1850,7 +1756,7 @@ BEGIN drop; drop - |CODE.opPACKC: + |IL.opPACKC: UnOp(reg1); pushc(param2); OutByte3(0DBH, 004H, 024H); // fild dword[esp] @@ -1861,7 +1767,7 @@ BEGIN pop(reg1); drop - |CODE.opUNPK: + |IL.opUNPK: BinOp(reg1, reg2); OutByte2(0DDH, reg1); // fld qword[reg1] OutByte2(0D9H, 0F4H); // fxtract @@ -1870,16 +1776,16 @@ BEGIN drop; drop - |CODE.opPUSHF: + |IL.opPUSHF: subrc(esp, 8); OutByte3(0DDH, 01CH, 024H) // fstp qword[esp] - |CODE.opLOADF: + |IL.opLOADF: UnOp(reg1); OutByte2(0DDH, reg1); // fld qword[reg1] drop - |CODE.opCONSTF: + |IL.opCONSTF: float := cmd.float; IF float = 0.0 THEN OutByte2(0D9H, 0EEH) // fldz @@ -1896,44 +1802,43 @@ BEGIN addrc(esp, 8) END - |CODE.opSAVEF: + |IL.opSAVEF: UnOp(reg1); OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] drop - |CODE.opADDF, CODE.opADDFI: + |IL.opADDF, IL.opADDFI: OutByte2(0DEH, 0C1H) // faddp st1, st - |CODE.opSUBF: + |IL.opSUBF: OutByte2(0DEH, 0E9H) // fsubp st1, st - |CODE.opSUBFI: + |IL.opSUBFI: OutByte2(0DEH, 0E1H) // fsubrp st1, st - |CODE.opMULF: + |IL.opMULF: OutByte2(0DEH, 0C9H) // fmulp st1, st - |CODE.opDIVF: + |IL.opDIVF: OutByte2(0DEH, 0F9H) // fdivp st1, st - |CODE.opDIVFI: + |IL.opDIVFI: OutByte2(0DEH, 0F1H) // fdivrp st1, st - |CODE.opUMINF: + |IL.opUMINF: OutByte2(0D9H, 0E0H) // fchs - |CODE.opFABS: + |IL.opFABS: OutByte2(0D9H, 0E1H) // fabs - |CODE.opFLT: + |IL.opFLT: UnOp(reg1); push(reg1); OutByte3(0DBH, 004H, 024H); // fild dword[esp] pop(reg1); drop - |CODE.opFLOOR: - reg1 := REG.GetAnyReg(R); + |IL.opFLOOR: subrc(esp, 8); OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4] OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6] @@ -1942,11 +1847,11 @@ BEGIN OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4] OutByte2(0D9H, 0FCH); // frndint OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] - pop(reg1); + pop(GetAnyReg()); OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2] addrc(esp, 4) - |CODE.opEQF, CODE.opEQFI: + |IL.opEQF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -1956,7 +1861,7 @@ BEGIN setcc(sete, al) // L: - |CODE.opNEF, CODE.opNEFI: + |IL.opNEF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -1966,7 +1871,7 @@ BEGIN setcc(setne, al) // L: - |CODE.opLTF, CODE.opGTFI: + |IL.opLTF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -1980,7 +1885,7 @@ BEGIN andrc(eax, 1) // L: - |CODE.opGTF, CODE.opLTFI: + |IL.opGTF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -1994,7 +1899,7 @@ BEGIN andrc(eax, 1) // L: - |CODE.opLEF, CODE.opGEFI: + |IL.opLEF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -2004,7 +1909,7 @@ BEGIN setcc(setnc, al) // L: - |CODE.opGEF, CODE.opLEFI: + |IL.opGEF: GetRegA; OutByte2(0DAH, 0E9H); // fucompp OutByte3(09BH, 0DFH, 0E0H); // fstsw ax @@ -2019,15 +1924,15 @@ BEGIN andrc(eax, 1) // L: - |CODE.opINF: + |IL.opINF: pushc(7FF00000H); pushc(0); OutByte3(0DDH, 004H, 024H); // fld qword[esp] addrc(esp, 8) - |CODE.opLADR_UNPK: + |IL.opLADR_UNPK: n := param2 * 4; - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] OutIntByte(n); BinOp(reg1, reg2); @@ -2038,9 +1943,9 @@ BEGIN drop; drop - |CODE.opSADR_PARAM: + |IL.opSADR_PARAM: IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, stroffs + param2); push(reg1); drop @@ -2049,17 +1954,17 @@ BEGIN Reloc(BIN.RDATA, stroffs + param2) END - |CODE.opVADR_PARAM: + |IL.opVADR_PARAM: n := param2 * 4; OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] OutIntByte(n) - |CODE.opCONST_PARAM: + |IL.opCONST_PARAM: pushc(param2) - |CODE.opGLOAD32_PARAM: + |IL.opGLOAD32_PARAM: IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICBSS, param2); OutByte2(0FFH, 30H + reg1); // push dword[reg1] drop @@ -2068,132 +1973,96 @@ BEGIN Reloc(BIN.RBSS, param2) END - |CODE.opLLOAD32_PARAM: + |IL.opLLOAD32_PARAM: n := param2 * 4; OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] OutIntByte(n) - |CODE.opLOAD32_PARAM: + |IL.opLOAD32_PARAM: UnOp(reg1); OutByte2(0FFH, 30H + reg1); // push dword[reg1] drop - |CODE.opGADR_SAVEC: + |IL.opGADR_SAVEC: IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICBSS, param1); OutByte2(0C7H, reg1); // mov dword[reg1], param2 OutInt(param2); drop ELSE - OutByte2(0C7H, 05H); // mov dword[_bss + param2], param2 + OutByte2(0C7H, 05H); // mov dword[_bss + param1], param2 Reloc(BIN.RBSS, param1); OutInt(param2) END - |CODE.opLADR_SAVEC: + |IL.opLADR_SAVEC: n := param1 * 4; OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2 OutIntByte(n); OutInt(param2) - |CODE.opLADR_SAVE: + |IL.opLADR_SAVE: n := param2 * 4; UnOp(reg1); OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1 OutIntByte(n); drop - |CODE.opLADR_INC1: - n := param2 * 4; - OutByte2(0FFH, 45H + long(n)); // inc dword[ebp + n] - OutIntByte(n) - - |CODE.opLADR_DEC1: - n := param2 * 4; - OutByte2(0FFH, 4DH + long(n)); // dec dword[ebp + n] - OutIntByte(n) - - |CODE.opLADR_INCC: + |IL.opLADR_INCC: n := param1 * 4; - OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 - OutIntByte(n); - OutIntByte(param2) + IF ABS(param2) = 1 THEN + OutByte2(0FFH, 45H + 8 * ORD(param2 = -1) + long(n)); // inc/dec dword[ebp + n] + OutIntByte(n) + ELSE + OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 + OutIntByte(n); + OutIntByte(param2) + END - |CODE.opLADR_DECC: + |IL.opLADR_INCCB, IL.opLADR_DECCB: n := param1 * 4; - OutByte2(81H + short(param2), 6DH + long(n)); // sub dword[ebp + n], param2 - OutIntByte(n); - OutIntByte(param2) + IF param2 = 1 THEN + OutByte2(0FEH, 45H + 8 * ORD(opcode = IL.opLADR_DECCB) + long(n)); // inc/dec byte[ebp + n] + OutIntByte(n) + ELSE + OutByte2(80H, 45H + 28H * ORD(opcode = IL.opLADR_DECCB) + long(n)); // add/sub byte[ebp + n], param2 + OutIntByte(n); + OutByte(param2 MOD 256) + END - |CODE.opLADR_INC1B: - n := param2 * 4; - OutByte2(0FEH, 45H + long(n)); // inc byte[ebp + n] - OutIntByte(n) - - |CODE.opLADR_DEC1B: - n := param2 * 4; - OutByte2(0FEH, 4DH + long(n)); // dec byte[ebp + n] - OutIntByte(n) - - |CODE.opLADR_INCCB: - n := param1 * 4; - OutByte2(80H, 45H + long(n)); // add byte[ebp + n], param2 - OutIntByte(n); - OutByte(param2 MOD 256) - - |CODE.opLADR_DECCB: - n := param1 * 4; - OutByte2(80H, 6DH + long(n)); // sub byte[ebp + n], param2 - OutIntByte(n); - OutByte(param2 MOD 256) - - |CODE.opLADR_INC: + |IL.opLADR_INC, IL.opLADR_DEC: n := param2 * 4; UnOp(reg1); - OutByte2(01H, 45H + long(n) + reg1 * 8); // add dword[ebp + n], reg1 + OutByte2(01H + 28H * ORD(opcode = IL.opLADR_DEC), 45H + long(n) + reg1 * 8); // add/sub dword[ebp + n], reg1 OutIntByte(n); drop - |CODE.opLADR_DEC: + |IL.opLADR_INCB, IL.opLADR_DECB: n := param2 * 4; UnOp(reg1); - OutByte2(29H, 45H + long(n) + reg1 * 8); // sub dword[ebp + n], reg1 + OutByte2(28H * ORD(opcode = IL.opLADR_DECB), 45H + long(n) + reg1 * 8); // add/sub byte[ebp + n], reg1 OutIntByte(n); drop - |CODE.opLADR_INCB: - n := param2 * 4; - UnOp(reg1); - OutByte2(00H, 45H + long(n) + reg1 * 8); // add byte[ebp + n], reg1 - OutIntByte(n); - drop - - |CODE.opLADR_DECB: - n := param2 * 4; - UnOp(reg1); - OutByte2(28H, 45H + long(n) + reg1 * 8); // sub byte[ebp + n], reg1 - OutIntByte(n); - drop - - |CODE.opLADR_INCL, CODE.opLADR_EXCL: + |IL.opLADR_INCL, IL.opLADR_EXCL: n := param2 * 4; UnOp(reg1); cmprc(reg1, 32); label := NewLabel(); jcc(jnb, label); - OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 + OutByte3(0FH, 0ABH + 8 * ORD(opcode = IL.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 OutIntByte(n); SetLabel(label); drop - |CODE.opLADR_INCLC, CODE.opLADR_EXCLC: + |IL.opLADR_INCLC, IL.opLADR_EXCLC: n := param1 * 4; - OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 + OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(opcode = IL.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 OutIntByte(n); OutByte(param2) - |CODE.opLOOP, CODE.opENDLOOP: + |IL.opLOOP, IL.opENDLOOP: END; @@ -2206,9 +2075,9 @@ BEGIN END translate; -PROCEDURE prolog (code: CODE.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); +PROCEDURE prolog (code: IL.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); VAR - reg1, entry, tcount, dcount: INTEGER; + reg1, entry, dcount: INTEGER; BEGIN @@ -2221,7 +2090,7 @@ BEGIN OutByte3(0FFH, 75H, 16); // push dword[ebp+16] OutByte3(0FFH, 75H, 12); // push dword[ebp+12] OutByte3(0FFH, 75H, 8); // push dword[ebp+8] - CallRTL(pic, CODE._dllentry); + CallRTL(pic, IL._dllentry); test(eax); jcc(je, dllret) ELSIF target = mConst.Target_iObject THEN @@ -2229,7 +2098,7 @@ BEGIN END; IF target = mConst.Target_iKolibri THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.IMPTAB, 0); push(reg1); // push IMPORT drop @@ -2243,7 +2112,7 @@ BEGIN END; IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICCODE, entry); push(reg1); // push CODE drop @@ -2253,7 +2122,7 @@ BEGIN END; IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, 0); push(reg1); // push _data drop @@ -2262,13 +2131,12 @@ BEGIN Reloc(BIN.RDATA, 0) END; - tcount := CHL.Length(code.types); dcount := CHL.Length(code.data); pushc(tcount); IF pic THEN - reg1 := REG.GetAnyReg(R); + reg1 := GetAnyReg(); Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); push(reg1); // push _data + tcount * 4 + dcount drop @@ -2277,35 +2145,34 @@ BEGIN Reloc(BIN.RDATA, tcount * 4 + dcount) END; - CallRTL(pic, CODE._init) + CallRTL(pic, IL._init) END prolog; -PROCEDURE epilog (code: CODE.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret: INTEGER); +PROCEDURE epilog (code: IL.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret, sofinit: INTEGER); VAR - i, n: INTEGER; - exp: CODE.EXPORT_PROC; + exp: IL.EXPORT_PROC; path, name, ext: PATHS.PATH; - tcount, dcount: INTEGER; + dcount, i: INTEGER; PROCEDURE import (imp: LISTS.LIST); VAR - lib: CODE.IMPORT_LIB; - proc: CODE.IMPORT_PROC; + lib: IL.IMPORT_LIB; + proc: IL.IMPORT_PROC; BEGIN - lib := imp.first(CODE.IMPORT_LIB); + lib := imp.first(IL.IMPORT_LIB); WHILE lib # NIL DO BIN.Import(program, lib.name, 0); - proc := lib.procs.first(CODE.IMPORT_PROC); + proc := lib.procs.first(IL.IMPORT_PROC); WHILE proc # NIL DO BIN.Import(program, proc.name, proc.label); - proc := proc.next(CODE.IMPORT_PROC) + proc := proc.next(IL.IMPORT_PROC) END; - lib := lib.next(CODE.IMPORT_LIB) + lib := lib.next(IL.IMPORT_LIB) END END import; @@ -2315,7 +2182,7 @@ BEGIN IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN pushc(0); - CallRTL(pic, CODE._exit); + CallRTL(pic, IL._exit); ELSIF target = mConst.Target_iDLL THEN SetLabel(dllret); movrc(eax, 1); @@ -2324,11 +2191,15 @@ BEGIN ELSIF target = mConst.Target_iObject THEN movrc(eax, 1); OutByte(0C3H) // ret + ELSIF target = mConst.Target_iELFSO32 THEN + OutByte(0C3H); // ret + SetLabel(sofinit); + CallRTL(pic, IL._sofinit); + OutByte(0C3H) // ret END; fixup; - tcount := CHL.Length(code.types); dcount := CHL.Length(code.data); FOR i := 0 TO tcount - 1 DO @@ -2350,61 +2221,62 @@ BEGIN BIN.Export(program, "lib_init", dllinit); END; - exp := code.export.first(CODE.EXPORT_PROC); + exp := code.export.first(IL.EXPORT_PROC); WHILE exp # NIL DO BIN.Export(program, exp.name, exp.label); - exp := exp.next(CODE.EXPORT_PROC) + exp := exp.next(IL.EXPORT_PROC) END; import(code.import); - n := code.dmin - CHL.Length(code.data); - IF n > 0 THEN - INC(code.bss, n) - END; + code.bss := MAX(code.bss, MAX(code.dmin - CHL.Length(code.data), 4)); - BIN.SetParams(program, MAX(code.bss, 4), stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); + BIN.SetParams(program, code.bss, stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); END epilog; -PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base, ver: INTEGER; pic: BOOLEAN); +PROCEDURE CodeGen* (code: IL.CODES; outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); VAR - dllret, dllinit: INTEGER; + dllret, dllinit, sofinit: INTEGER; + opt: PROG.OPTIONS; BEGIN + tcount := CHL.Length(code.types); + opt := options; CodeList := LISTS.create(NIL); program := BIN.create(code.lcount); dllinit := NewLabel(); dllret := NewLabel(); + sofinit := NewLabel(); IF target = mConst.Target_iObject THEN - pic := FALSE + opt.pic := FALSE END; - IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32} THEN - pic := TRUE + IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32, mConst.Target_iELFSO32} THEN + opt.pic := TRUE END; - R := REG.Create(push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); + REG.Init(R, push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); - prolog(code, pic, target, stack, dllinit, dllret); - translate(code, pic, CHL.Length(code.types) * 4); - epilog(code, pic, outname, target, stack, ver, dllinit, dllret); + prolog(code, opt.pic, target, opt.stack, dllinit, dllret); + translate(code, opt.pic, tcount * 4); + epilog(code, opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); BIN.fixup(program); IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN - PE32.write(program, outname, base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) + PE32.write(program, outname, opt.base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) ELSIF target = mConst.Target_iKolibri THEN KOS.write(program, outname) ELSIF target = mConst.Target_iObject THEN - MSCOFF.write(program, outname, ver) - ELSIF target = mConst.Target_iELF32 THEN - ELF.write(program, outname, FALSE) + MSCOFF.write(program, outname, opt.version) + ELSIF target IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN + ELF.write(program, outname, sofinit, target = mConst.Target_iELFSO32, FALSE) END END CodeGen;