diff --git a/programs/develop/oberon07/Compiler b/programs/develop/oberon07/Compiler index a36067d15d..6ffa7ec6cb 100644 Binary files a/programs/develop/oberon07/Compiler and b/programs/develop/oberon07/Compiler differ diff --git a/programs/develop/oberon07/Compiler.exe b/programs/develop/oberon07/Compiler.exe index 7a7530d0e4..afb8854fc9 100644 Binary files a/programs/develop/oberon07/Compiler.exe and b/programs/develop/oberon07/Compiler.exe differ diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index 6c3abc7677..7f7665c6d2 100644 Binary files a/programs/develop/oberon07/Compiler.kex and b/programs/develop/oberon07/Compiler.kex differ diff --git a/programs/develop/oberon07/doc/x86.txt b/programs/develop/oberon07/doc/x86.txt index 0fe277a8a5..142c0b5148 100644 --- a/programs/develop/oberon07/doc/x86.txt +++ b/programs/develop/oberon07/doc/x86.txt @@ -1,413 +1,415 @@ - Компилятор языка программирования Oberon-07/16 для i486 - Windows/Linux/KolibriOS. ------------------------------------------------------------------------------- - - Параметры командной строки - - Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или -UTF-8 с BOM-сигнатурой. - Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF. - Параметры: - 1) имя главного модуля - 2) тип приложения - "win32con" - Windows console - "win32gui" - Windows GUI - "win32dll" - Windows DLL - "linux32exe" - Linux ELF-EXEC - "linux32so" - Linux ELF-SO - "kosexe" - KolibriOS - "kosdll" - KolibriOS DLL - - 3) необязательные параметры-ключи - -out имя результирующего файла; по умолчанию, - совпадает с именем главного модуля, но с другим расширением - (соответствует типу исполняемого файла) - -stk размер стэка в мегабайтах (по умолчанию 2 Мб, - допустимо от 1 до 32 Мб) - -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) - -lower разрешить ключевые слова и встроенные идентификаторы в - нижнем регистре - -def <имя> задать символ условной компиляции - -ver версия программы (только для kosdll) - - параметр -nochk задается в виде строки из символов: - "p" - указатели - "t" - типы - "i" - индексы - "b" - неявное приведение INTEGER к BYTE - "c" - диапазон аргумента функции CHR - "w" - диапазон аргумента функции WCHR - "r" - эквивалентно "bcw" - "a" - все проверки - - Порядок символов может быть любым. Наличие в строке того или иного - символа отключает соответствующую проверку. - - Например: -nochk it - отключить проверку индексов и охрану типа. - -nochk a - отключить все отключаемые проверки. - - Например: - - Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1 - Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll" - Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4 - Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti - Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4 - Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7 - Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a - - В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. -При работе компилятора в KolibriOS, код завершения не передается. - ------------------------------------------------------------------------------- - Отличия от оригинала - -1. Расширен псевдомодуль SYSTEM -2. В идентификаторах допускается символ "_" -3. Добавлены системные флаги -4. Усовершенствован оператор CASE (добавлены константные выражения в - метках вариантов и необязательная ветка ELSE) -5. Расширен набор стандартных процедур -6. Семантика охраны/проверки типа уточнена для нулевого указателя -7. Добавлены однострочные комментарии (начинаются с пары символов "//") -8. Разрешено наследование от типа-указателя -9. Добавлен синтаксис для импорта процедур из внешних библиотек -10. "Строки" можно заключать также в одиночные кавычки: 'строка' -11. Добавлен тип WCHAR -12. Добавлена операция конкатенации строковых и символьных констант -13. Возможен импорт модулей с указанием пути и имени файла -14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt) -15. Имя процедуры в конце объявления (после END) необязательно - ------------------------------------------------------------------------------- - Особенности реализации - -1. Основные типы - - Тип Диапазон значений Размер, байт - - INTEGER -2147483648 .. 2147483647 4 - REAL 4.94E-324 .. 1.70E+308 8 - CHAR символ ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET множество из целых чисел {0 .. 31} 4 - BYTE 0 .. 255 1 - WCHAR символ юникода (0X .. 0FFFFX) 2 - -2. Максимальная длина идентификаторов - 255 символов -3. Максимальная длина строковых констант - 511 символов (UTF-8) -4. Максимальная размерность открытых массивов - 5 -5. Процедура NEW заполняет нулями выделенный блок памяти -6. Глобальные и локальные переменные инициализируются нулями -7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая - модульность отсутствуют -8. Тип BYTE в выражениях всегда приводится к INTEGER -9. Контроль переполнения значений выражений не производится -10. Ошибки времени выполнения: - - 1 ASSERT(x), при x = FALSE - 2 разыменование нулевого указателя - 3 целочисленное деление на неположительное число - 4 вызов процедуры через процедурную переменную с нулевым значением - 5 ошибка охраны типа - 6 нарушение границ массива - 7 непредусмотренное значение выражения в операторе CASE - 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) - 9 CHR(x), если (x < 0) OR (x > 255) -10 WCHR(x), если (x < 0) OR (x > 65535) -11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) - ------------------------------------------------------------------------------- - Псевдомодуль SYSTEM - - Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, -ошибки при использовании процедур псевдомодуля SYSTEM могут привести к -повреждению данных времени выполнения и аварийному завершению программы. - - PROCEDURE ADR(v: любой тип): INTEGER - v - переменная или процедура; - возвращает адрес v - - PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER - возвращает адрес x - - PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER - возвращает адрес x - - PROCEDURE SIZE(T): INTEGER - возвращает размер типа T - - PROCEDURE TYPEID(T): INTEGER - T - тип-запись или тип-указатель, - возвращает номер типа в таблице типов-записей - - PROCEDURE INF(): REAL - возвращает специальное вещественное значение "бесконечность" - - PROCEDURE MOVE(Source, Dest, n: INTEGER) - Копирует n байт памяти из Source в Dest, - области Source и Dest не могут перекрываться - - PROCEDURE GET(a: INTEGER; - VAR v: любой основной тип, PROCEDURE, POINTER) - v := Память[a] - - PROCEDURE GET8(a: INTEGER; - VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 1) - - PROCEDURE GET16(a: INTEGER; - VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 2) - - PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 4) - - PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) - Память[a] := x; - Если x: BYTE или x: WCHAR, то значение x будет расширено - до 32 бит, для записи байтов использовать SYSTEM.PUT8, - для WCHAR -- SYSTEM.PUT16 - - PROCEDURE PUT8(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 8 бит (x) - - PROCEDURE PUT16(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 16 бит (x) - - PROCEDURE PUT32(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 32 бит (x) - - PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) - Копирует n байт памяти из Source в Dest. - Эквивалентно - SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) - - PROCEDURE CODE(byte1, byte2,... : INTEGER) - Вставка машинного кода, - byte1, byte2 ... - константы в диапазоне 0..255, - например: - SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) - - Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не -допускаются никакие явные операции, за исключением присваивания. - - Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. - ------------------------------------------------------------------------------- - Системные флаги - - При объявлении процедурных типов и глобальных процедур, после ключевого -слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall], -[cdecl], [ccall], [windows], [linux], [oberon]. Например: - - PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; - - Если указан флаг [ccall], то принимается соглашение cdecl, но перед -вызовом указатель стэка будет выравнен по границе 16 байт. - Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall]. - Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что -результат процедуры можно игнорировать (не допускается для типа REAL). - Если флаг не указан или указан флаг [oberon], то принимается внутреннее -соглашение о вызове. - - При объявлении типов-записей, после ключевого слова RECORD может быть -указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей -записи. Записи с системным флагом не могут иметь базовый тип и не могут быть -базовыми типами для других записей. - Для использования системных флагов, требуется импортировать SYSTEM. - ------------------------------------------------------------------------------- - Оператор CASE - - Синтаксис оператора CASE: - - CaseStatement = - CASE Expression OF Case {"|" Case} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. - - Например: - - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END - - В метках вариантов можно использовать константные выражения, ветка ELSE -необязательна. Если значение x не соответствует ни одному варианту и ELSE -отсутствует, то программа прерывается с ошибкой времени выполнения. - ------------------------------------------------------------------------------- - Тип WCHAR - - Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и -ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и -ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает -только тип CHAR. Для получения значения типа WCHAR, следует использовать -процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять -исходный код в кодировке UTF-8 с BOM. - ------------------------------------------------------------------------------- - Конкатенация строковых и символьных констант - - Допускается конкатенация ("+") константных строк и символов типа CHAR: - - str = CHR(39) + "string" + CHR(39); (* str = "'string'" *) - - newline = 0DX + 0AX; - ------------------------------------------------------------------------------- - Проверка и охрана типа нулевого указателя - - Оригинальное сообщение о языке не определяет поведение программы при -выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих -Oberon-реализациях выполнение такой операции приводит к ошибке времени -выполнения. В данной реализации охрана типа нулевого указателя не приводит к -ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет -значительно сократить частоту применения охраны типа. - ------------------------------------------------------------------------------- - Дополнительные стандартные процедуры - - DISPOSE (VAR v: любой_указатель) - Освобождает память, выделенную процедурой NEW для - динамической переменной v^, и присваивает переменной v - значение NIL. - - COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); - v := x; - Если LEN(v) < LEN(x), то строка x будет скопирована - не полностью - - LSR (x, n: INTEGER): INTEGER - Логический сдвиг x на n бит вправо. - - MIN (a, b: INTEGER): INTEGER - Минимум из двух значений. - - MAX (a, b: INTEGER): INTEGER - Максимум из двух значений. - - BITS (x: INTEGER): SET - Интерпретирует x как значение типа SET. - Выполняется на этапе компиляции. - - LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER - Длина 0X-завершенной строки s, без учета символа 0X. - Если символ 0X отсутствует, функция возвращает длину - массива s. s не может быть константой. - - WCHR (n: INTEGER): WCHAR - Преобразование типа, аналогично CHR(n: INTEGER): CHAR - ------------------------------------------------------------------------------- - Импорт модулей с указанием пути и имени файла - -Примеры: - - IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *) - - IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *) - ------------------------------------------------------------------------------- - Импортированные процедуры - - Синтаксис импорта: - - PROCEDURE [callconv, library, function] proc_name (FormalParam): Type; - - - callconv -- соглашение о вызове - - library -- имя файла динамической библиотеки (строковая константа) - - function -- имя импортируемой процедуры (строковая константа), если - указана пустая строка, то имя процедуры = proc_name - - например: - - PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER); - - PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); - - В конце объявления может быть добавлено (необязательно) "END proc_name;" - - Объявления импортированных процедур должны располагаться в глобальной - области видимости модуля после объявления переменных, вместе с объявлением - "обычных" процедур, от которых импортированные отличаются только отсутствием - тела процедуры. В остальном, к таким процедурам применимы те же правила: - их можно вызвать, присвоить процедурной переменной или получить адрес. - - Так как импортированная процедура всегда имеет явное указание соглашения о - вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием - соглашения о вызове: - - VAR - ExitProcess: PROCEDURE [windows] (code: INTEGER); - con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); - - В KolibriOS импортировать процедуры можно только из библиотек, размещенных - в /rd/1/lib. Импортировать и вызывать функции инициализации библиотек - (lib_init, START) при этом не нужно. - - Для Linux, импортированные процедуры не реализованы. - ------------------------------------------------------------------------------- - Скрытые параметры процедур - - Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке -формальных параметров, но учитываются компилятором при трансляции вызовов. -Это возможно в следующих случаях: - -1. Процедура имеет формальный параметр открытый массив: - PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); - Вызов транслируется так: - Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) -2. Процедура имеет формальный параметр-переменную типа RECORD: - PROCEDURE Proc (VAR x: Rec); - Вызов транслируется так: - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) - - Скрытые параметры необходимо учитывать при связи с внешними приложениями. - ------------------------------------------------------------------------------- - Модуль RTL - - Все программы неявно используют модуль RTL. Компилятор транслирует -некоторые операции (проверка и охрана типа, сравнение строк, сообщения об -ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не -следует вызывать эти процедуры явно. - Сообщения об ошибках времени выполнения выводятся в диалоговых окнах -(Windows), в терминал (Linux), на доску отладки (KolibriOS). - ------------------------------------------------------------------------------- - Модуль API - - Существуют несколько реализаций модуля API (для различных ОС). - Как и модуль RTL, модуль API не предназначен для прямого использования. -Он обеспечивает связь RTL с ОС. - ------------------------------------------------------------------------------- - Генерация исполняемых файлов DLL - - Разрешается экспортировать только процедуры. Для этого, процедура должна -находиться в главном модуле программы, и ее имя должно быть отмечено символом -экспорта ("*"). Нельзя экспортировать процедуры, которые импортированы из -других dll-библиотек. - - KolibriOS DLL всегда экспортируют идентификаторы "version" (версия -программы) и "lib_init" - адрес процедуры инициализации DLL: - - PROCEDURE [stdcall] lib_init (): INTEGER - -Эта процедура должна быть вызвана перед использованием DLL. + Компилятор языка программирования Oberon-07/16 для i486 + Windows/Linux/KolibriOS. +------------------------------------------------------------------------------ + + Параметры командной строки + + Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или +UTF-8 с BOM-сигнатурой. + Выход - испоняемый файл формата PE32, ELF или MENUET01/MSCOFF. + Параметры: + 1) имя главного модуля + 2) тип приложения + "win32con" - Windows console + "win32gui" - Windows GUI + "win32dll" - Windows DLL + "linux32exe" - Linux ELF-EXEC + "linux32so" - Linux ELF-SO + "kosexe" - KolibriOS + "kosdll" - KolibriOS DLL + + 3) необязательные параметры-ключи + -out имя результирующего файла; по умолчанию, + совпадает с именем главного модуля, но с другим расширением + (соответствует типу исполняемого файла) + -stk размер стэка в мегабайтах (по умолчанию 2 Мб, + допустимо от 1 до 32 Мб) + -tab размер табуляции (используется для вычисления координат в + исходном коде), по умолчанию - 4 + -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре + -def <имя> задать символ условной компиляции + -ver версия программы (только для kosdll) + + параметр -nochk задается в виде строки из символов: + "p" - указатели + "t" - типы + "i" - индексы + "b" - неявное приведение INTEGER к BYTE + "c" - диапазон аргумента функции CHR + "w" - диапазон аргумента функции WCHR + "r" - эквивалентно "bcw" + "a" - все проверки + + Порядок символов может быть любым. Наличие в строке того или иного + символа отключает соответствующую проверку. + + Например: -nochk it - отключить проверку индексов и охрану типа. + -nochk a - отключить все отключаемые проверки. + + Например: + + Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" win32dll -out "C:\example.dll" + Compiler.exe "C:\example.ob07" win32gui -out "C:\example.exe" -stk 4 + Compiler.exe "C:\example.ob07" win32con -out "C:\example.exe" -nochk pti + Compiler.kex "/tmp0/1/example.ob07" kosexe -out "/tmp0/1/example.kex" -stk 4 + Compiler.kex "/tmp0/1/example.ob07" kosdll -out "/tmp0/1/mydll.obj" -ver 2.7 + Compiler.exe "C:\example.ob07" linux32exe -out "C:\example" -stk 1 -nochk a + + В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. +При работе компилятора в KolibriOS, код завершения не передается. + +------------------------------------------------------------------------------ + Отличия от оригинала + +1. Расширен псевдомодуль SYSTEM +2. В идентификаторах допускается символ "_" +3. Добавлены системные флаги +4. Усовершенствован оператор CASE (добавлены константные выражения в + метках вариантов и необязательная ветка ELSE) +5. Расширен набор стандартных процедур +6. Семантика охраны/проверки типа уточнена для нулевого указателя +7. Добавлены однострочные комментарии (начинаются с пары символов "//") +8. Разрешено наследование от типа-указателя +9. Добавлен синтаксис для импорта процедур из внешних библиотек +10. "Строки" можно заключать также в одиночные кавычки: 'строка' +11. Добавлен тип WCHAR +12. Добавлена операция конкатенации строковых и символьных констант +13. Возможен импорт модулей с указанием пути и имени файла +14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt) +15. Имя процедуры в конце объявления (после END) необязательно + +------------------------------------------------------------------------------ + Особенности реализации + +1. Основные типы + + Тип Диапазон значений Размер, байт + + INTEGER -2147483648 .. 2147483647 4 + REAL 4.94E-324 .. 1.70E+308 8 + CHAR символ ASCII (0X .. 0FFX) 1 + BOOLEAN FALSE, TRUE 1 + SET множество из целых чисел {0 .. 31} 4 + BYTE 0 .. 255 1 + WCHAR символ юникода (0X .. 0FFFFX) 2 + +2. Максимальная длина идентификаторов - 255 символов +3. Максимальная длина строковых констант - 511 символов (UTF-8) +4. Максимальная размерность открытых массивов - 5 +5. Процедура NEW заполняет нулями выделенный блок памяти +6. Глобальные и локальные переменные инициализируются нулями +7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая + модульность отсутствуют +8. Тип BYTE в выражениях всегда приводится к INTEGER +9. Контроль переполнения значений выражений не производится +10. Ошибки времени выполнения: + + 1 ASSERT(x), при x = FALSE + 2 разыменование нулевого указателя + 3 целочисленное деление на неположительное число + 4 вызов процедуры через процедурную переменную с нулевым значением + 5 ошибка охраны типа + 6 нарушение границ массива + 7 непредусмотренное значение выражения в операторе CASE + 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) + 9 CHR(x), если (x < 0) OR (x > 255) +10 WCHR(x), если (x < 0) OR (x > 65535) +11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) + +------------------------------------------------------------------------------ + Псевдомодуль SYSTEM + + Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, +ошибки при использовании процедур псевдомодуля SYSTEM могут привести к +повреждению данных времени выполнения и аварийному завершению программы. + + PROCEDURE ADR(v: любой тип): INTEGER + v - переменная или процедура; + возвращает адрес v + + PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER + возвращает адрес x + + PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER + возвращает адрес x + + PROCEDURE SIZE(T): INTEGER + возвращает размер типа T + + PROCEDURE TYPEID(T): INTEGER + T - тип-запись или тип-указатель, + возвращает номер типа в таблице типов-записей + + PROCEDURE INF(): REAL + возвращает специальное вещественное значение "бесконечность" + + PROCEDURE MOVE(Source, Dest, n: INTEGER) + Копирует n байт памяти из Source в Dest, + области Source и Dest не могут перекрываться + + PROCEDURE GET(a: INTEGER; + VAR v: любой основной тип, PROCEDURE, POINTER) + v := Память[a] + + PROCEDURE GET8(a: INTEGER; + VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 1) + + PROCEDURE GET16(a: INTEGER; + VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 2) + + PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 4) + + PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) + Память[a] := x; + Если x: BYTE или x: WCHAR, то значение x будет расширено + до 32 бит, для записи байтов использовать SYSTEM.PUT8, + для WCHAR -- SYSTEM.PUT16 + + PROCEDURE PUT8(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 8 бит (x) + + PROCEDURE PUT16(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 16 бит (x) + + PROCEDURE PUT32(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 32 бит (x) + + PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) + Копирует n байт памяти из Source в Dest. + Эквивалентно + SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) + + PROCEDURE CODE(byte1, byte2,... : INTEGER) + Вставка машинного кода, + byte1, byte2 ... - константы в диапазоне 0..255, + например: + SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) + + Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не +допускаются никакие явные операции, за исключением присваивания. + + Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. + +------------------------------------------------------------------------------ + Системные флаги + + При объявлении процедурных типов и глобальных процедур, после ключевого +слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall], +[cdecl], [ccall], [windows], [linux], [oberon]. Например: + + PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; + + Если указан флаг [ccall], то принимается соглашение cdecl, но перед +вызовом указатель стэка будет выравнен по границе 16 байт. + Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall]. + Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что +результат процедуры можно игнорировать (не допускается для типа REAL). + Если флаг не указан или указан флаг [oberon], то принимается внутреннее +соглашение о вызове. + + При объявлении типов-записей, после ключевого слова RECORD может быть +указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей +записи. Записи с системным флагом не могут иметь базовый тип и не могут быть +базовыми типами для других записей. + Для использования системных флагов, требуется импортировать SYSTEM. + +------------------------------------------------------------------------------ + Оператор CASE + + Синтаксис оператора CASE: + + CaseStatement = + CASE Expression OF Case {"|" Case} + [ELSE StatementSequence] END. + Case = [CaseLabelList ":" StatementSequence]. + CaseLabelList = CaseLabels {"," CaseLabels}. + CaseLabels = ConstExpression [".." ConstExpression]. + + Например: + + CASE x OF + |-1: DoSomething1 + | 1: DoSomething2 + | 0: DoSomething3 + ELSE + DoSomething4 + END + + В метках вариантов можно использовать константные выражения, ветка ELSE +необязательна. Если значение x не соответствует ни одному варианту и ELSE +отсутствует, то программа прерывается с ошибкой времени выполнения. + +------------------------------------------------------------------------------ + Тип WCHAR + + Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и +ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и +ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает +только тип CHAR. Для получения значения типа WCHAR, следует использовать +процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять +исходный код в кодировке UTF-8 с BOM. + +------------------------------------------------------------------------------ + Конкатенация строковых и символьных констант + + Допускается конкатенация ("+") константных строк и символов типа CHAR: + + str = CHR(39) + "string" + CHR(39); (* str = "'string'" *) + + newline = 0DX + 0AX; + +------------------------------------------------------------------------------ + Проверка и охрана типа нулевого указателя + + Оригинальное сообщение о языке не определяет поведение программы при +выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих +Oberon-реализациях выполнение такой операции приводит к ошибке времени +выполнения. В данной реализации охрана типа нулевого указателя не приводит к +ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет +значительно сократить частоту применения охраны типа. + +------------------------------------------------------------------------------ + Дополнительные стандартные процедуры + + DISPOSE (VAR v: любой_указатель) + Освобождает память, выделенную процедурой NEW для + динамической переменной v^, и присваивает переменной v + значение NIL. + + COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); + v := x; + Если LEN(v) < LEN(x), то строка x будет скопирована + не полностью + + LSR (x, n: INTEGER): INTEGER + Логический сдвиг x на n бит вправо. + + MIN (a, b: INTEGER): INTEGER + Минимум из двух значений. + + MAX (a, b: INTEGER): INTEGER + Максимум из двух значений. + + BITS (x: INTEGER): SET + Интерпретирует x как значение типа SET. + Выполняется на этапе компиляции. + + LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER + Длина 0X-завершенной строки s, без учета символа 0X. + Если символ 0X отсутствует, функция возвращает длину + массива s. s не может быть константой. + + WCHR (n: INTEGER): WCHAR + Преобразование типа, аналогично CHR(n: INTEGER): CHAR + +------------------------------------------------------------------------------ + Импорт модулей с указанием пути и имени файла + +Примеры: + + IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *) + + IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *) + +------------------------------------------------------------------------------ + Импортированные процедуры + + Синтаксис импорта: + + PROCEDURE [callconv, library, function] proc_name (FormalParam): Type; + + - callconv -- соглашение о вызове + - library -- имя файла динамической библиотеки (строковая константа) + - function -- имя импортируемой процедуры (строковая константа), если + указана пустая строка, то имя процедуры = proc_name + + например: + + PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER); + + PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); + + В конце объявления может быть добавлено (необязательно) "END proc_name;" + + Объявления импортированных процедур должны располагаться в глобальной + области видимости модуля после объявления переменных, вместе с объявлением + "обычных" процедур, от которых импортированные отличаются только отсутствием + тела процедуры. В остальном, к таким процедурам применимы те же правила: + их можно вызвать, присвоить процедурной переменной или получить адрес. + + Так как импортированная процедура всегда имеет явное указание соглашения о + вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием + соглашения о вызове: + + VAR + ExitProcess: PROCEDURE [windows] (code: INTEGER); + con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); + + В KolibriOS импортировать процедуры можно только из библиотек, размещенных + в /rd/1/lib. Импортировать и вызывать функции инициализации библиотек + (lib_init, START) при этом не нужно. + + Для Linux, импортированные процедуры не реализованы. + +------------------------------------------------------------------------------ + Скрытые параметры процедур + + Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке +формальных параметров, но учитываются компилятором при трансляции вызовов. +Это возможно в следующих случаях: + +1. Процедура имеет формальный параметр открытый массив: + PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); + Вызов транслируется так: + Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) +2. Процедура имеет формальный параметр-переменную типа RECORD: + PROCEDURE Proc (VAR x: Rec); + Вызов транслируется так: + Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) + + Скрытые параметры необходимо учитывать при связи с внешними приложениями. + +------------------------------------------------------------------------------ + Модуль RTL + + Все программы неявно используют модуль RTL. Компилятор транслирует +некоторые операции (проверка и охрана типа, сравнение строк, сообщения об +ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не +следует вызывать эти процедуры явно. + Сообщения об ошибках времени выполнения выводятся в диалоговых окнах +(Windows), в терминал (Linux), на доску отладки (KolibriOS). + +------------------------------------------------------------------------------ + Модуль API + + Существуют несколько реализаций модуля API (для различных ОС). + Как и модуль RTL, модуль API не предназначен для прямого использования. +Он обеспечивает связь RTL с ОС. + +------------------------------------------------------------------------------ + Генерация исполняемых файлов DLL + + Разрешается экспортировать только процедуры. Для этого, процедура должна +находиться в главном модуле программы, и ее имя должно быть отмечено символом +экспорта ("*"). Нельзя экспортировать процедуры, которые импортированы из +других dll-библиотек. + + KolibriOS DLL всегда экспортируют идентификаторы "version" (версия +программы) и "lib_init" - адрес процедуры инициализации DLL: + + PROCEDURE [stdcall] lib_init (): INTEGER + +Эта процедура должна быть вызвана перед использованием DLL. Процедура всегда возвращает 1. \ No newline at end of file diff --git a/programs/develop/oberon07/doc/x86_64.txt b/programs/develop/oberon07/doc/x86_64.txt index c4a523f8cf..59c192db2e 100644 --- a/programs/develop/oberon07/doc/x86_64.txt +++ b/programs/develop/oberon07/doc/x86_64.txt @@ -1,394 +1,396 @@ - Компилятор языка программирования Oberon-07/16 для x86_64 - Windows/Linux ------------------------------------------------------------------------------- - - Параметры командной строки - - Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или -UTF-8 с BOM-сигнатурой. - Выход - испоняемый файл формата PE32+ или ELF64. - Параметры: - 1) имя главного модуля - 2) тип приложения - "win64con" - Windows64 console - "win64gui" - Windows64 GUI - "win64dll" - Windows64 DLL - "linux64exe" - Linux ELF64-EXEC - "linux64so" - Linux ELF64-SO - - 3) необязательные параметры-ключи - -out имя результирующего файла; по умолчанию, - совпадает с именем главного модуля, но с другим расширением - (соответствует типу исполняемого файла) - -stk размер стэка в мегабайтах (по умолчанию 2 Мб, - допустимо от 1 до 32 Мб) - -nochk <"ptibcwra"> отключить проверки при выполнении - -lower разрешить ключевые слова и встроенные идентификаторы в - нижнем регистре - -def <имя> задать символ условной компиляции - - параметр -nochk задается в виде строки из символов: - "p" - указатели - "t" - типы - "i" - индексы - "b" - неявное приведение INTEGER к BYTE - "c" - диапазон аргумента функции CHR - "w" - диапазон аргумента функции WCHR - "r" - эквивалентно "bcw" - "a" - все проверки - - Порядок символов может быть любым. Наличие в строке того или иного - символа отключает соответствующую проверку. - - Например: -nochk it - отключить проверку индексов и охрану типа. - -nochk a - отключить все отключаемые проверки. - - Например: - - Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1 - Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti - Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a - - В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. - ------------------------------------------------------------------------------- - Отличия от оригинала - -1. Расширен псевдомодуль SYSTEM -2. В идентификаторах допускается символ "_" -3. Добавлены системные флаги -4. Усовершенствован оператор CASE (добавлены константные выражения в - метках вариантов и необязательная ветка ELSE) -5. Расширен набор стандартных процедур -6. Семантика охраны/проверки типа уточнена для нулевого указателя -7. Добавлены однострочные комментарии (начинаются с пары символов "//") -8. Разрешено наследование от типа-указателя -9. Добавлен синтаксис для импорта процедур из внешних библиотек -10. "Строки" можно заключать также в одиночные кавычки: 'строка' -11. Добавлен тип WCHAR -12. Добавлена операция конкатенации строковых и символьных констант -13. Возможен импорт модулей с указанием пути и имени файла -14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt) -15. Имя процедуры в конце объявления (после END) необязательно - ------------------------------------------------------------------------------- - Особенности реализации - -1. Основные типы - - Тип Диапазон значений Размер, байт - - INTEGER -9223372036854775808 .. 9223372036854775807 8 - REAL 4.94E-324 .. 1.70E+308 8 - CHAR символ ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET множество из целых чисел {0 .. 63} 8 - BYTE 0 .. 255 1 - WCHAR символ юникода (0X .. 0FFFFX) 2 - -2. Максимальная длина идентификаторов - 255 символов -3. Максимальная длина строковых констант - 511 символов (UTF-8) -4. Максимальная размерность открытых массивов - 5 -5. Процедура NEW заполняет нулями выделенный блок памяти -6. Глобальные и локальные переменные инициализируются нулями -7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая - модульность отсутствуют -8. Тип BYTE в выражениях всегда приводится к INTEGER -9. Контроль переполнения значений выражений не производится -10. Ошибки времени выполнения: - - 1 ASSERT(x), при x = FALSE - 2 разыменование нулевого указателя - 3 целочисленное деление на неположительное число - 4 вызов процедуры через процедурную переменную с нулевым значением - 5 ошибка охраны типа - 6 нарушение границ массива - 7 непредусмотренное значение выражения в операторе CASE - 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) - 9 CHR(x), если (x < 0) OR (x > 255) -10 WCHR(x), если (x < 0) OR (x > 65535) -11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) - ------------------------------------------------------------------------------- - Псевдомодуль SYSTEM - - Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, -ошибки при использовании процедур псевдомодуля SYSTEM могут привести к -повреждению данных времени выполнения и аварийному завершению программы. - - PROCEDURE ADR(v: любой тип): INTEGER - v - переменная или процедура; - возвращает адрес v - - PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER - возвращает адрес x - - PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER - возвращает адрес x - - PROCEDURE SIZE(T): INTEGER - возвращает размер типа T - - PROCEDURE TYPEID(T): INTEGER - T - тип-запись или тип-указатель, - возвращает номер типа в таблице типов-записей - - PROCEDURE INF(): REAL - возвращает специальное вещественное значение "бесконечность" - - PROCEDURE MOVE(Source, Dest, n: INTEGER) - Копирует n байт памяти из Source в Dest, - области Source и Dest не могут перекрываться - - PROCEDURE GET(a: INTEGER; - VAR v: любой основной тип, PROCEDURE, POINTER) - v := Память[a] - - PROCEDURE GET8(a: INTEGER; - VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 1) - - PROCEDURE GET16(a: INTEGER; - VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 2) - - PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32) - Эквивалентно - SYSTEM.MOVE(a, SYSTEM.ADR(x), 4) - - PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) - Память[a] := x; - Если x: BYTE или x: WCHAR, то значение x будет расширено - до 64 бит, для записи байтов использовать SYSTEM.PUT8, - для WCHAR -- SYSTEM.PUT16 - - PROCEDURE PUT8(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 8 бит (x) - - PROCEDURE PUT16(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 16 бит (x) - - PROCEDURE PUT32(a: INTEGER; - x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) - Память[a] := младшие 32 бит (x) - - PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) - Копирует n байт памяти из Source в Dest. - Эквивалентно - SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) - - PROCEDURE CODE(byte1, byte2,... : BYTE) - Вставка машинного кода, - byte1, byte2 ... - константы в диапазоне 0..255, - например: - - SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *) - - Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не -допускаются никакие явные операции, за исключением присваивания. - - Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. - ------------------------------------------------------------------------------- - Системные флаги - - При объявлении процедурных типов и глобальных процедур, после ключевого -слова PROCEDURE может быть указан флаг соглашения о вызове: -[win64], [systemv], [windows], [linux], [oberon], [ccall]. -Например: - - PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER; - - Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv]. - Флаг [ccall] - синоним для [win64] или [systemv] (зависит от целевой ОС). - Знак "-" после имени флага ([win64-], [linux-], ...) означает, что -результат процедуры можно игнорировать (не допускается для типа REAL). - Если флаг не указан или указан флаг [oberon], то принимается внутреннее -соглашение о вызове. [win64] и [systemv] используются для связи с -операционной системой и внешними приложениями. - - При объявлении типов-записей, после ключевого слова RECORD может быть -указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей -записи. Записи с системным флагом не могут иметь базовый тип и не могут быть -базовыми типами для других записей. - Для использования системных флагов, требуется импортировать SYSTEM. - ------------------------------------------------------------------------------- - Оператор CASE - - Синтаксис оператора CASE: - - CaseStatement = - CASE Expression OF Case {"|" Case} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. - - Например: - - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END - - В метках вариантов можно использовать константные выражения, ветка ELSE -необязательна. Если значение x не соответствует ни одному варианту и ELSE -отсутствует, то программа прерывается с ошибкой времени выполнения. - ------------------------------------------------------------------------------- - Тип WCHAR - - Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и -ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и -ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает -только тип CHAR. Для получения значения типа WCHAR, следует использовать -процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять -исходный код в кодировке UTF-8 с BOM. - ------------------------------------------------------------------------------- - Конкатенация строковых и символьных констант - - Допускается конкатенация ("+") константных строк и символов типа CHAR: - - str = CHR(39) + "string" + CHR(39); (* str = "'string'" *) - - newline = 0DX + 0AX; - ------------------------------------------------------------------------------- - Проверка и охрана типа нулевого указателя - - Оригинальное сообщение о языке не определяет поведение программы при -выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих -Oberon-реализациях выполнение такой операции приводит к ошибке времени -выполнения. В данной реализации охрана типа нулевого указателя не приводит к -ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет -значительно сократить частоту применения охраны типа. - ------------------------------------------------------------------------------- - Дополнительные стандартные процедуры - - DISPOSE (VAR v: любой_указатель) - Освобождает память, выделенную процедурой NEW для - динамической переменной v^, и присваивает переменной v - значение NIL. - - COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); - v := x; - Если LEN(v) < LEN(x), то строка x будет скопирована - не полностью - - LSR (x, n: INTEGER): INTEGER - Логический сдвиг x на n бит вправо. - - MIN (a, b: INTEGER): INTEGER - Минимум из двух значений. - - MAX (a, b: INTEGER): INTEGER - Максимум из двух значений. - - BITS (x: INTEGER): SET - Интерпретирует x как значение типа SET. - Выполняется на этапе компиляции. - - LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER - Длина 0X-завершенной строки s, без учета символа 0X. - Если символ 0X отсутствует, функция возвращает длину - массива s. s не может быть константой. - - WCHR (n: INTEGER): WCHAR - Преобразование типа, аналогично CHR(n: INTEGER): CHAR - ------------------------------------------------------------------------------- - Импорт модулей с указанием пути и имени файла - -Примеры: - - IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *) - - IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *) - ------------------------------------------------------------------------------- - Импортированные процедуры - - Синтаксис импорта: - - PROCEDURE [callconv, library, function] proc_name (FormalParam): Type; - - - callconv -- соглашение о вызове - - library -- имя файла динамической библиотеки (строковая константа) - - function -- имя импортируемой процедуры (строковая константа), если - указана пустая строка, то имя процедуры = proc_name - - например: - - PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); - - PROCEDURE [windows, "kernel32.dll", ""] GetTickCount (): INTEGER; - - В конце объявления может быть добавлено (необязательно) "END proc_name;" - - Объявления импортированных процедур должны располагаться в глобальной - области видимости модуля после объявления переменных, вместе с объявлением - "обычных" процедур, от которых импортированные отличаются только отсутствием - тела процедуры. В остальном, к таким процедурам применимы те же правила: - их можно вызвать, присвоить процедурной переменной или получить адрес. - - Так как импортированная процедура всегда имеет явное указание соглашения о - вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием - соглашения о вызове: - - VAR - ExitProcess: PROCEDURE [windows] (code: INTEGER); - - Для Linux, импортированные процедуры не реализованы. - ------------------------------------------------------------------------------- - Скрытые параметры процедур - - Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке -формальных параметров, но учитываются компилятором при трансляции вызовов. -Это возможно в следующих случаях: - -1. Процедура имеет формальный параметр открытый массив: - PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); - Вызов транслируется так: - Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) -2. Процедура имеет формальный параметр-переменную типа RECORD: - PROCEDURE Proc (VAR x: Rec); - Вызов транслируется так: - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) - - Скрытые параметры необходимо учитывать при связи с внешними приложениями. - ------------------------------------------------------------------------------- - Модуль RTL - - Все программы неявно используют модуль RTL. Компилятор транслирует -некоторые операции (проверка и охрана типа, сравнение строк, сообщения об -ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не -следует вызывать эти процедуры явно. - Сообщения об ошибках времени выполнения выводятся в диалоговых окнах -(Windows), в терминал (Linux). - ------------------------------------------------------------------------------- - Модуль API - - Существуют несколько реализаций модуля API (для различных ОС). - Как и модуль RTL, модуль API не предназначен для прямого использования. -Он обеспечивает связь RTL с ОС. - ------------------------------------------------------------------------------- - Генерация исполняемых файлов DLL - - Разрешается экспортировать только процедуры. Для этого, процедура должна -находиться в главном модуле программы, ее имя должно быть отмечено символом -экспорта ("*") и должно быть указано соглашение о вызове. Нельзя + Компилятор языка программирования Oberon-07/16 для x86_64 + Windows/Linux +------------------------------------------------------------------------------ + + Параметры командной строки + + Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или +UTF-8 с BOM-сигнатурой. + Выход - испоняемый файл формата PE32+ или ELF64. + Параметры: + 1) имя главного модуля + 2) тип приложения + "win64con" - Windows64 console + "win64gui" - Windows64 GUI + "win64dll" - Windows64 DLL + "linux64exe" - Linux ELF64-EXEC + "linux64so" - Linux ELF64-SO + + 3) необязательные параметры-ключи + -out имя результирующего файла; по умолчанию, + совпадает с именем главного модуля, но с другим расширением + (соответствует типу исполняемого файла) + -stk размер стэка в мегабайтах (по умолчанию 2 Мб, + допустимо от 1 до 32 Мб) + -tab размер табуляции (используется для вычисления координат в + исходном коде), по умолчанию - 4 + -nochk <"ptibcwra"> отключить проверки при выполнении + -lower разрешить ключевые слова и встроенные идентификаторы в + нижнем регистре + -def <имя> задать символ условной компиляции + + параметр -nochk задается в виде строки из символов: + "p" - указатели + "t" - типы + "i" - индексы + "b" - неявное приведение INTEGER к BYTE + "c" - диапазон аргумента функции CHR + "w" - диапазон аргумента функции WCHR + "r" - эквивалентно "bcw" + "a" - все проверки + + Порядок символов может быть любым. Наличие в строке того или иного + символа отключает соответствующую проверку. + + Например: -nochk it - отключить проверку индексов и охрану типа. + -nochk a - отключить все отключаемые проверки. + + Например: + + Compiler.exe "C:\example.ob07" win64con -out "C:\example.exe" -stk 1 + Compiler.exe "C:\example.ob07" win64dll -out "C:\example.dll" -nochk pti + Compiler "source/Compiler.ob07" linux64exe -out "source/Compiler" -nochk a + + В случае успешной компиляции, компилятор передает код завершения 0, иначе 1. + +------------------------------------------------------------------------------ + Отличия от оригинала + +1. Расширен псевдомодуль SYSTEM +2. В идентификаторах допускается символ "_" +3. Добавлены системные флаги +4. Усовершенствован оператор CASE (добавлены константные выражения в + метках вариантов и необязательная ветка ELSE) +5. Расширен набор стандартных процедур +6. Семантика охраны/проверки типа уточнена для нулевого указателя +7. Добавлены однострочные комментарии (начинаются с пары символов "//") +8. Разрешено наследование от типа-указателя +9. Добавлен синтаксис для импорта процедур из внешних библиотек +10. "Строки" можно заключать также в одиночные кавычки: 'строка' +11. Добавлен тип WCHAR +12. Добавлена операция конкатенации строковых и символьных констант +13. Возможен импорт модулей с указанием пути и имени файла +14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt) +15. Имя процедуры в конце объявления (после END) необязательно + +------------------------------------------------------------------------------ + Особенности реализации + +1. Основные типы + + Тип Диапазон значений Размер, байт + + INTEGER -9223372036854775808 .. 9223372036854775807 8 + REAL 4.94E-324 .. 1.70E+308 8 + CHAR символ ASCII (0X .. 0FFX) 1 + BOOLEAN FALSE, TRUE 1 + SET множество из целых чисел {0 .. 63} 8 + BYTE 0 .. 255 1 + WCHAR символ юникода (0X .. 0FFFFX) 2 + +2. Максимальная длина идентификаторов - 255 символов +3. Максимальная длина строковых констант - 511 символов (UTF-8) +4. Максимальная размерность открытых массивов - 5 +5. Процедура NEW заполняет нулями выделенный блок памяти +6. Глобальные и локальные переменные инициализируются нулями +7. В отличие от многих Oberon-реализаций, сборщик мусора и динамическая + модульность отсутствуют +8. Тип BYTE в выражениях всегда приводится к INTEGER +9. Контроль переполнения значений выражений не производится +10. Ошибки времени выполнения: + + 1 ASSERT(x), при x = FALSE + 2 разыменование нулевого указателя + 3 целочисленное деление на неположительное число + 4 вызов процедуры через процедурную переменную с нулевым значением + 5 ошибка охраны типа + 6 нарушение границ массива + 7 непредусмотренное значение выражения в операторе CASE + 8 ошибка копирования массивов v := x, если LEN(v) < LEN(x) + 9 CHR(x), если (x < 0) OR (x > 255) +10 WCHR(x), если (x < 0) OR (x > 65535) +11 неявное приведение x:INTEGER к v:BYTE, если (x < 0) OR (x > 255) + +------------------------------------------------------------------------------ + Псевдомодуль SYSTEM + + Псевдомодуль SYSTEM содержит низкоуровневые и небезопасные процедуры, +ошибки при использовании процедур псевдомодуля SYSTEM могут привести к +повреждению данных времени выполнения и аварийному завершению программы. + + PROCEDURE ADR(v: любой тип): INTEGER + v - переменная или процедура; + возвращает адрес v + + PROCEDURE SADR(x: строковая константа (CHAR UTF-8)): INTEGER + возвращает адрес x + + PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER + возвращает адрес x + + PROCEDURE SIZE(T): INTEGER + возвращает размер типа T + + PROCEDURE TYPEID(T): INTEGER + T - тип-запись или тип-указатель, + возвращает номер типа в таблице типов-записей + + PROCEDURE INF(): REAL + возвращает специальное вещественное значение "бесконечность" + + PROCEDURE MOVE(Source, Dest, n: INTEGER) + Копирует n байт памяти из Source в Dest, + области Source и Dest не могут перекрываться + + PROCEDURE GET(a: INTEGER; + VAR v: любой основной тип, PROCEDURE, POINTER) + v := Память[a] + + PROCEDURE GET8(a: INTEGER; + VAR x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 1) + + PROCEDURE GET16(a: INTEGER; + VAR x: INTEGER, SET, WCHAR, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 2) + + PROCEDURE GET32(a: INTEGER; VAR x: INTEGER, SET, SYSTEM.CARD32) + Эквивалентно + SYSTEM.MOVE(a, SYSTEM.ADR(x), 4) + + PROCEDURE PUT(a: INTEGER; x: любой основной тип, PROCEDURE, POINTER) + Память[a] := x; + Если x: BYTE или x: WCHAR, то значение x будет расширено + до 64 бит, для записи байтов использовать SYSTEM.PUT8, + для WCHAR -- SYSTEM.PUT16 + + PROCEDURE PUT8(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 8 бит (x) + + PROCEDURE PUT16(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 16 бит (x) + + PROCEDURE PUT32(a: INTEGER; + x: INTEGER, SET, BYTE, CHAR, WCHAR, SYSTEM.CARD32) + Память[a] := младшие 32 бит (x) + + PROCEDURE COPY(VAR Source: любой тип; VAR Dest: любой тип; n: INTEGER) + Копирует n байт памяти из Source в Dest. + Эквивалентно + SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) + + PROCEDURE CODE(byte1, byte2,... : BYTE) + Вставка машинного кода, + byte1, byte2 ... - константы в диапазоне 0..255, + например: + + SYSTEM.CODE(048H,08BH,045H,010H) (* mov rax,qword[rbp+16] *) + + Также, в модуле SYSTEM определен тип CARD32 (4 байта). Для типа CARD32 не +допускаются никакие явные операции, за исключением присваивания. + + Функции псевдомодуля SYSTEM нельзя использовать в константных выражениях. + +------------------------------------------------------------------------------ + Системные флаги + + При объявлении процедурных типов и глобальных процедур, после ключевого +слова PROCEDURE может быть указан флаг соглашения о вызове: +[win64], [systemv], [windows], [linux], [oberon], [ccall]. +Например: + + PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER; + + Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv]. + Флаг [ccall] - синоним для [win64] или [systemv] (зависит от целевой ОС). + Знак "-" после имени флага ([win64-], [linux-], ...) означает, что +результат процедуры можно игнорировать (не допускается для типа REAL). + Если флаг не указан или указан флаг [oberon], то принимается внутреннее +соглашение о вызове. [win64] и [systemv] используются для связи с +операционной системой и внешними приложениями. + + При объявлении типов-записей, после ключевого слова RECORD может быть +указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей +записи. Записи с системным флагом не могут иметь базовый тип и не могут быть +базовыми типами для других записей. + Для использования системных флагов, требуется импортировать SYSTEM. + +------------------------------------------------------------------------------ + Оператор CASE + + Синтаксис оператора CASE: + + CaseStatement = + CASE Expression OF Case {"|" Case} + [ELSE StatementSequence] END. + Case = [CaseLabelList ":" StatementSequence]. + CaseLabelList = CaseLabels {"," CaseLabels}. + CaseLabels = ConstExpression [".." ConstExpression]. + + Например: + + CASE x OF + |-1: DoSomething1 + | 1: DoSomething2 + | 0: DoSomething3 + ELSE + DoSomething4 + END + + В метках вариантов можно использовать константные выражения, ветка ELSE +необязательна. Если значение x не соответствует ни одному варианту и ELSE +отсутствует, то программа прерывается с ошибкой времени выполнения. + +------------------------------------------------------------------------------ + Тип WCHAR + + Тип WCHAR добавлен в язык для удобной поддежки юникода. Для типов WCHAR и +ARRAY OF WCHAR допускаются все те же операции, как для типов CHAR и +ARRAY OF CHAR, за исключением встроенной процедуры CHR, которая возвращает +только тип CHAR. Для получения значения типа WCHAR, следует использовать +процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять +исходный код в кодировке UTF-8 с BOM. + +------------------------------------------------------------------------------ + Конкатенация строковых и символьных констант + + Допускается конкатенация ("+") константных строк и символов типа CHAR: + + str = CHR(39) + "string" + CHR(39); (* str = "'string'" *) + + newline = 0DX + 0AX; + +------------------------------------------------------------------------------ + Проверка и охрана типа нулевого указателя + + Оригинальное сообщение о языке не определяет поведение программы при +выполнении охраны p(T) и проверки типа p IS T при p = NIL. Во многих +Oberon-реализациях выполнение такой операции приводит к ошибке времени +выполнения. В данной реализации охрана типа нулевого указателя не приводит к +ошибке, а проверка типа дает результат FALSE. В ряде случаев это позволяет +значительно сократить частоту применения охраны типа. + +------------------------------------------------------------------------------ + Дополнительные стандартные процедуры + + DISPOSE (VAR v: любой_указатель) + Освобождает память, выделенную процедурой NEW для + динамической переменной v^, и присваивает переменной v + значение NIL. + + COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); + v := x; + Если LEN(v) < LEN(x), то строка x будет скопирована + не полностью + + LSR (x, n: INTEGER): INTEGER + Логический сдвиг x на n бит вправо. + + MIN (a, b: INTEGER): INTEGER + Минимум из двух значений. + + MAX (a, b: INTEGER): INTEGER + Максимум из двух значений. + + BITS (x: INTEGER): SET + Интерпретирует x как значение типа SET. + Выполняется на этапе компиляции. + + LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER + Длина 0X-завершенной строки s, без учета символа 0X. + Если символ 0X отсутствует, функция возвращает длину + массива s. s не может быть константой. + + WCHR (n: INTEGER): WCHAR + Преобразование типа, аналогично CHR(n: INTEGER): CHAR + +------------------------------------------------------------------------------ + Импорт модулей с указанием пути и имени файла + +Примеры: + + IMPORT Math IN "./lib/math.ob07"; (* относительно текущего модуля *) + + IMPORT M1 IN "C:\lib\math.ob07"; (* абсолютный путь *) + +------------------------------------------------------------------------------ + Импортированные процедуры + + Синтаксис импорта: + + PROCEDURE [callconv, library, function] proc_name (FormalParam): Type; + + - callconv -- соглашение о вызове + - library -- имя файла динамической библиотеки (строковая константа) + - function -- имя импортируемой процедуры (строковая константа), если + указана пустая строка, то имя процедуры = proc_name + + например: + + PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); + + PROCEDURE [windows, "kernel32.dll", ""] GetTickCount (): INTEGER; + + В конце объявления может быть добавлено (необязательно) "END proc_name;" + + Объявления импортированных процедур должны располагаться в глобальной + области видимости модуля после объявления переменных, вместе с объявлением + "обычных" процедур, от которых импортированные отличаются только отсутствием + тела процедуры. В остальном, к таким процедурам применимы те же правила: + их можно вызвать, присвоить процедурной переменной или получить адрес. + + Так как импортированная процедура всегда имеет явное указание соглашения о + вызове, то совместимый процедурный тип тоже должен быть объявлен с указанием + соглашения о вызове: + + VAR + ExitProcess: PROCEDURE [windows] (code: INTEGER); + + Для Linux, импортированные процедуры не реализованы. + +------------------------------------------------------------------------------ + Скрытые параметры процедур + + Некоторые процедуры могут иметь скрытые параметры, они отсутствуют в списке +формальных параметров, но учитываются компилятором при трансляции вызовов. +Это возможно в следующих случаях: + +1. Процедура имеет формальный параметр открытый массив: + PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); + Вызов транслируется так: + Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) +2. Процедура имеет формальный параметр-переменную типа RECORD: + PROCEDURE Proc (VAR x: Rec); + Вызов транслируется так: + Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) + + Скрытые параметры необходимо учитывать при связи с внешними приложениями. + +------------------------------------------------------------------------------ + Модуль RTL + + Все программы неявно используют модуль RTL. Компилятор транслирует +некоторые операции (проверка и охрана типа, сравнение строк, сообщения об +ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не +следует вызывать эти процедуры явно. + Сообщения об ошибках времени выполнения выводятся в диалоговых окнах +(Windows), в терминал (Linux). + +------------------------------------------------------------------------------ + Модуль API + + Существуют несколько реализаций модуля API (для различных ОС). + Как и модуль RTL, модуль API не предназначен для прямого использования. +Он обеспечивает связь RTL с ОС. + +------------------------------------------------------------------------------ + Генерация исполняемых файлов DLL + + Разрешается экспортировать только процедуры. Для этого, процедура должна +находиться в главном модуле программы, ее имя должно быть отмечено символом +экспорта ("*") и должно быть указано соглашение о вызове. Нельзя экспортировать процедуры, которые импортированы из других dll-библиотек. \ No newline at end of file diff --git a/programs/develop/oberon07/source/Compiler.ob07 b/programs/develop/oberon07/source/Compiler.ob07 index 0a30e6123d..6bc6d7007f 100644 --- a/programs/develop/oberon07/source/Compiler.ob07 +++ b/programs/develop/oberon07/source/Compiler.ob07 @@ -8,7 +8,7 @@ MODULE Compiler; IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, PROG, C := CONSOLE, - ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN; + ERRORS, STRINGS, WRITER, MSP430, THUMB, TARGETS, SCAN, TEXTDRV; CONST @@ -30,6 +30,23 @@ VAR major: INTEGER; checking: SET; + + PROCEDURE getVal (VAR i: INTEGER; VAR value: INTEGER); + VAR + param: PARS.PATH; + val: INTEGER; + BEGIN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToInt(param, val) THEN + value := val + END; + IF param[0] = "-" THEN + DEC(i) + END + END getVal; + + BEGIN out := ""; checking := options.checking; @@ -57,25 +74,14 @@ BEGIN out := param END + ELSIF param = "-tab" THEN + getVal(i, options.tab) + 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 + getVal(i, options.ram) 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) - END + getVal(i, options.rom) ELSIF param = "-nochk" THEN INC(i); @@ -182,6 +188,7 @@ VAR BEGIN options.stack := 2; + options.tab := TEXTDRV.defTabSize; options.version := 65536; options.pic := FALSE; options.lower := FALSE; @@ -237,6 +244,7 @@ BEGIN C.StringLn(" -ver set version of program (KolibriOS DLL)"); C.Ln; C.StringLn(" -ram set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; C.StringLn(" -rom set size of ROM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; + C.StringLn(" -tab set width for tabs"); C.Ln; UTILS.Exit(0) END; @@ -285,6 +293,7 @@ BEGIN STRINGS.append(lib_path, UTILS.slash); keys(options, outname); + TEXTDRV.setTabSize(options.tab); IF outname = "" THEN outname := path; STRINGS.append(outname, modname); diff --git a/programs/develop/oberon07/source/HEX.ob07 b/programs/develop/oberon07/source/HEX.ob07 index c1f35780f4..f8d2469510 100644 --- a/programs/develop/oberon07/source/HEX.ob07 +++ b/programs/develop/oberon07/source/HEX.ob07 @@ -1,117 +1,117 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020, Anton Krotov - All rights reserved. -*) - -MODULE HEX; - -IMPORT WRITER, CHL := CHUNKLISTS, UTILS; - - -VAR - - chksum: INTEGER; - - -PROCEDURE Byte (byte: BYTE); -BEGIN - WRITER.WriteByte(UTILS.hexdgt(byte DIV 16)); - WRITER.WriteByte(UTILS.hexdgt(byte MOD 16)); - INC(chksum, byte) -END Byte; - - -PROCEDURE Byte4 (a, b, c, d: BYTE); -BEGIN - Byte(a); - Byte(b); - Byte(c); - Byte(d) -END Byte4; - - -PROCEDURE NewLine; -BEGIN - Byte((-chksum) MOD 256); - chksum := 0; - WRITER.WriteByte(0DH); - WRITER.WriteByte(0AH) -END NewLine; - - -PROCEDURE StartCode; -BEGIN - WRITER.WriteByte(ORD(":")); - chksum := 0 -END StartCode; - - -PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER); -VAR - i, len: INTEGER; - -BEGIN - WHILE cnt > 0 DO - len := MIN(cnt, 16); - StartCode; - Byte4(len, idx DIV 256, idx MOD 256, 0); - FOR i := 1 TO len DO - Byte(mem[idx]); - INC(idx) - END; - DEC(cnt, len); - NewLine - END -END Data; - - -PROCEDURE ExtLA* (LA: INTEGER); -BEGIN - ASSERT((0 <= LA) & (LA <= 0FFFFH)); - StartCode; - Byte4(2, 0, 0, 4); - Byte(LA DIV 256); - Byte(LA MOD 256); - NewLine -END ExtLA; - - -PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); -VAR - i, len, offset: INTEGER; - -BEGIN - ExtLA(LA); - offset := 0; - WHILE cnt > 0 DO - ASSERT(offset <= 65536); - IF offset = 65536 THEN - INC(LA); - ExtLA(LA); - offset := 0 - END; - len := MIN(cnt, 16); - StartCode; - Byte4(len, offset DIV 256, offset MOD 256, 0); - FOR i := 1 TO len DO - Byte(CHL.GetByte(mem, idx)); - INC(idx); - INC(offset) - END; - DEC(cnt, len); - NewLine - END -END Data2; - - -PROCEDURE End*; -BEGIN - StartCode; - Byte4(0, 0, 0, 1); - NewLine -END End; - - +(* + BSD 2-Clause License + + Copyright (c) 2020, Anton Krotov + All rights reserved. +*) + +MODULE HEX; + +IMPORT WRITER, CHL := CHUNKLISTS, UTILS; + + +VAR + + chksum: INTEGER; + + +PROCEDURE Byte (byte: BYTE); +BEGIN + WRITER.WriteByte(UTILS.hexdgt(byte DIV 16)); + WRITER.WriteByte(UTILS.hexdgt(byte MOD 16)); + INC(chksum, byte) +END Byte; + + +PROCEDURE Byte4 (a, b, c, d: BYTE); +BEGIN + Byte(a); + Byte(b); + Byte(c); + Byte(d) +END Byte4; + + +PROCEDURE NewLine; +BEGIN + Byte((-chksum) MOD 256); + chksum := 0; + WRITER.WriteByte(0DH); + WRITER.WriteByte(0AH) +END NewLine; + + +PROCEDURE StartCode; +BEGIN + WRITER.WriteByte(ORD(":")); + chksum := 0 +END StartCode; + + +PROCEDURE Data* (mem: ARRAY OF BYTE; idx, cnt: INTEGER); +VAR + i, len: INTEGER; + +BEGIN + WHILE cnt > 0 DO + len := MIN(cnt, 16); + StartCode; + Byte4(len, idx DIV 256, idx MOD 256, 0); + FOR i := 1 TO len DO + Byte(mem[idx]); + INC(idx) + END; + DEC(cnt, len); + NewLine + END +END Data; + + +PROCEDURE ExtLA* (LA: INTEGER); +BEGIN + ASSERT((0 <= LA) & (LA <= 0FFFFH)); + StartCode; + Byte4(2, 0, 0, 4); + Byte(LA DIV 256); + Byte(LA MOD 256); + NewLine +END ExtLA; + + +PROCEDURE Data2* (mem: CHL.BYTELIST; idx, cnt, LA: INTEGER); +VAR + i, len, offset: INTEGER; + +BEGIN + ExtLA(LA); + offset := 0; + WHILE cnt > 0 DO + ASSERT(offset <= 65536); + IF offset = 65536 THEN + INC(LA); + ExtLA(LA); + offset := 0 + END; + len := MIN(cnt, 16); + StartCode; + Byte4(len, offset DIV 256, offset MOD 256, 0); + FOR i := 1 TO len DO + Byte(CHL.GetByte(mem, idx)); + INC(idx); + INC(offset) + END; + DEC(cnt, len); + NewLine + END +END Data2; + + +PROCEDURE End*; +BEGIN + StartCode; + Byte4(0, 0, 0, 1); + NewLine +END End; + + END HEX. \ No newline at end of file diff --git a/programs/develop/oberon07/source/IL.ob07 b/programs/develop/oberon07/source/IL.ob07 index e7033b37b9..72430a489d 100644 --- a/programs/develop/oberon07/source/IL.ob07 +++ b/programs/develop/oberon07/source/IL.ob07 @@ -1,1171 +1,1171 @@ -(* - BSD 2-Clause License - - Copyright (c) 2018-2021, Anton Krotov - All rights reserved. -*) - -MODULE IL; - -IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS; - - -CONST - - call_stack* = 0; - call_win64* = 1; - call_sysv* = 2; - - begin_loop* = 1; end_loop* = 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; opONERR* = 19; opSUBL* = 20; opADDC* = 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; - - opJZ* = 62; opJNZ* = 63; - - opSAVE32* = 64; opLLOAD8* = 65; - - opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; - opUMINF* = 72; opSAVEFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; - - opJNZ1* = 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; opAND* = 90; opOR* = 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; opERR* = 109; opSUBSL* = 110; opADDSC* = 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; - opGETC* = 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; opLENGTHW* = 179; - - opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; - opLSR* = 185; opLSR1* = 186; opLSR2* = 187; - opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192; - opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198; - opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; - opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; - - opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; - opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; - - opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; - - - 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; - - - _init *= 0; - _move *= 1; - _strcmpw *= 2; - _exit *= 3; - _set *= 4; - _set1 *= 5; - _lengthw *= 6; - _strcpy *= 7; - _length *= 8; - _divmod *= 9; - _dllentry *= 10; - _sofinit *= 11; - _arrcpy *= 12; - _rot *= 13; - _new *= 14; - _dispose *= 15; - _strcmp *= 16; - _error *= 17; - _is *= 18; - _isrec *= 19; - _guard *= 20; - _guardrec *= 21; - - _fmul *= 22; - _fdiv *= 23; - _fdivi *= 24; - _fadd *= 25; - _fsub *= 26; - _fsubi *= 27; - _fcmp *= 28; - _floor *= 29; - _flt *= 30; - _pack *= 31; - _unpk *= 32; - - -TYPE - - COMMAND* = POINTER TO RECORD (LISTS.ITEM) - - opcode*: INTEGER; - param1*: INTEGER; - param2*: INTEGER; - param3*: INTEGER; - float*: REAL - - END; - - FNAMECMD* = POINTER TO RECORD (COMMAND) - - fname*: PATHS.PATH - - END; - - CMDSTACK = POINTER TO RECORD - - data: ARRAY 1000 OF COMMAND; - top: INTEGER - - END; - - EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) - - label*: INTEGER; - name*: SCAN.IDSTR - - END; - - IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) - - name*: SCAN.TEXTSTR; - procs*: LISTS.LIST - - END; - - IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) - - label*: INTEGER; - lib*: IMPORT_LIB; - name*: SCAN.TEXTSTR; - count: INTEGER - - END; - - - CODES = 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 33 OF INTEGER; - errlabels*: ARRAY 12 OF INTEGER; - - charoffs: ARRAY 256 OF INTEGER; - wcharoffs: ARRAY 65536 OF INTEGER; - - wstr: ARRAY 4*1024 OF WCHAR - END; - - -VAR - - codes*: CODES; - CPU: INTEGER; - - commands: C.COLLECTION; - - -PROCEDURE set_dmin* (value: INTEGER); -BEGIN - codes.dmin := value -END set_dmin; - - -PROCEDURE set_bss* (value: INTEGER); -BEGIN - codes.bss := value -END set_bss; - - -PROCEDURE set_rtl* (idx, label: INTEGER); -BEGIN - codes.rtl[idx] := label -END set_rtl; - - -PROCEDURE NewCmd (): COMMAND; -VAR - cmd: COMMAND; - citem: C.ITEM; - -BEGIN - citem := C.pop(commands); - IF citem = NIL THEN - NEW(cmd) - ELSE - cmd := citem(COMMAND) - END - - RETURN cmd -END NewCmd; - - -PROCEDURE setlast* (cmd: COMMAND); -BEGIN - codes.last := cmd -END setlast; - - -PROCEDURE getlast* (): COMMAND; - RETURN codes.last -END getlast; - - -PROCEDURE PutByte (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(ORD(s[i])); - INC(i) - END; - - PutByte(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(c); - PutByte(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(0); - INC(res) - END; - - n := STRINGS.Utf8To16(s, codes.wstr); - - i := 0; - WHILE i < n DO - IF TARGETS.LittleEndian THEN - PutByte(ORD(codes.wstr[i]) MOD 256); - PutByte(ORD(codes.wstr[i]) DIV 256) - ELSE - PutByte(ORD(codes.wstr[i]) DIV 256); - PutByte(ORD(codes.wstr[i]) MOD 256) - END; - INC(i) - END; - - PutByte(0); - PutByte(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(0); - INC(res) - END; - - IF TARGETS.LittleEndian THEN - PutByte(c MOD 256); - PutByte(c DIV 256) - ELSE - PutByte(c DIV 256); - PutByte(c MOD 256) - END; - - PutByte(0); - PutByte(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 - IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN - - 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 := cur.param2 * param2 - - ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN - INC(cur.param2, param2) - - ELSE - old_opcode := -1 - END - - ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN - - old_opcode := cur.opcode; - param2 := nov.param2; - - IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN - cur.opcode := opLADR_SAVE - ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN - set(cur, opLADR_INCC, param2) - ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN - cur.param2 := cur.param2 * param2 - ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN - INC(cur.param2, param2) - ELSE - old_opcode := -1 - END - - 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 delete (cmd: COMMAND); -BEGIN - 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 Jmp* (opcode: INTEGER; label: INTEGER); -VAR - prev: COMMAND; - not: BOOLEAN; - -BEGIN - prev := codes.last; - not := prev.opcode = opNOT; - IF not THEN - IF opcode = opJNZ THEN - opcode := opJZ - ELSIF opcode = opJZ THEN - opcode := opJNZ - ELSE - not := FALSE - END - END; - - AddCmd2(opcode, label, label); - - IF not THEN - delete(prev) - END -END Jmp; - - -PROCEDURE AndOrOpt* (VAR label: INTEGER); -VAR - cur, prev: COMMAND; - i, op, l: INTEGER; - jz, not: BOOLEAN; - -BEGIN - cur := codes.last; - not := cur.opcode = opNOT; - IF not THEN - cur := cur.prev(COMMAND) - END; - - IF cur.opcode = opAND THEN - op := opAND - ELSIF cur.opcode = opOR THEN - op := opOR - ELSE - op := -1 - END; - - cur := codes.last; - - IF op # -1 THEN - IF not THEN - IF op = opAND THEN - op := opOR - ELSE (* op = opOR *) - op := opAND - END; - prev := cur.prev(COMMAND); - delete(cur); - cur := prev - END; - - FOR i := 1 TO 9 DO - IF i = 8 THEN - l := cur.param1 - ELSIF i = 9 THEN - jz := cur.opcode = opJZ - END; - prev := cur.prev(COMMAND); - delete(cur); - cur := prev - END; - - setlast(cur); - - IF op = opAND THEN - label := l; - jz := ~jz - END; - - IF jz THEN - Jmp(opJZ, label) - ELSE - Jmp(opJNZ, label) - END; - - IF op = opOR THEN - SetLabel(l) - END - ELSE - Jmp(opJZ, label) - END; - - setlast(codes.last) -END AndOrOpt; - - -PROCEDURE OnError* (line, error: INTEGER); -BEGIN - AddCmd2(opONERR, codes.errlabels[error], line) -END OnError; - - -PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); -VAR - label: INTEGER; -BEGIN - AddCmd(op, t); - label := NewLabel(); - Jmp(opJNZ, 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 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 _ord*; -BEGIN - IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN - AddCmd0(opORD) - END -END _ord; - - -PROCEDURE Enter* (label, params: INTEGER): COMMAND; -VAR - cmd: COMMAND; - -BEGIN - cmd := NewCmd(); - cmd.opcode := opENTER; - cmd.param1 := label; - cmd.param3 := params; - 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: Jmp(opCALL, proc) - |call_win64: Jmp(opWIN64CALL, proc) - |call_sysv: Jmp(opSYSVCALL, proc) - END; - codes.last(COMMAND).param2 := fparams -END Call; - - -PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); -BEGIN - CASE callconv OF - |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label) - |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label) - |call_sysv: Jmp(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 - Jmp(opSAVEP, proc) -END AssignProc; - - -PROCEDURE AssignImpProc* (proc: LISTS.ITEM); -BEGIN - Jmp(opSAVEIP, proc(IMPORT_PROC).label) -END AssignImpProc; - - -PROCEDURE PushProc* (proc: INTEGER); -BEGIN - Jmp(opPUSHP, proc) -END PushProc; - - -PROCEDURE PushImpProc* (proc: LISTS.ITEM); -BEGIN - Jmp(opPUSHIP, proc(IMPORT_PROC).label) -END PushImpProc; - - -PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); -BEGIN - IF eq THEN - Jmp(opEQP, proc) - ELSE - Jmp(opNEP, proc) - END -END ProcCmp; - - -PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); -BEGIN - IF eq THEN - Jmp(opEQIP, proc(IMPORT_PROC).label) - ELSE - Jmp(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* (inv: BOOLEAN); -BEGIN - IF inv THEN - AddCmd0(opSAVEFI) - ELSE - AddCmd0(opSAVEF) - END -END savef; - - -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 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; line, col: INTEGER); -VAR - cmd: COMMAND; - -BEGIN - cmd := NewCmd(); - cmd.opcode := opCONSTF; - cmd.float := r; - cmd.param1 := line; - cmd.param2 := col; - insert(codes.last, cmd) -END Float; - - -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 fname* (name: PATHS.PATH); -VAR - cmd: FNAMECMD; - -BEGIN - NEW(cmd); - cmd.opcode := opFNAME; - cmd.fname := name; - insert(codes.last, cmd) -END fname; - - -PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR); -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.TEXTSTR): 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* (pCPU: INTEGER); -VAR - cmd: COMMAND; - i: INTEGER; - -BEGIN - commands := C.create(); - - CPU := pCPU; - - 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; - - 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; - - +(* + BSD 2-Clause License + + Copyright (c) 2018-2021, Anton Krotov + All rights reserved. +*) + +MODULE IL; + +IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS, TARGETS, PATHS; + + +CONST + + call_stack* = 0; + call_win64* = 1; + call_sysv* = 2; + + begin_loop* = 1; end_loop* = 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; opONERR* = 19; opSUBL* = 20; opADDC* = 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; + + opJZ* = 62; opJNZ* = 63; + + opSAVE32* = 64; opLLOAD8* = 65; + + opCONSTF* = 66; opLOADF* = 67; opSAVEF* = 68; opMULF* = 69; opDIVF* = 70; opDIVFI* = 71; + opUMINF* = 72; opSAVEFI* = 73; opSUBFI* = 74; opADDF* = 75; opSUBF* = 76; + + opJNZ1* = 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; opAND* = 90; opOR* = 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; opERR* = 109; opSUBSL* = 110; opADDSC* = 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; + opGETC* = 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; opLENGTHW* = 179; + + opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; + opLSR* = 185; opLSR1* = 186; opLSR2* = 187; + opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192; + opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198; + opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; + opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; + + opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; + opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; + + opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; + + + 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; + + + _init *= 0; + _move *= 1; + _strcmpw *= 2; + _exit *= 3; + _set *= 4; + _set1 *= 5; + _lengthw *= 6; + _strcpy *= 7; + _length *= 8; + _divmod *= 9; + _dllentry *= 10; + _sofinit *= 11; + _arrcpy *= 12; + _rot *= 13; + _new *= 14; + _dispose *= 15; + _strcmp *= 16; + _error *= 17; + _is *= 18; + _isrec *= 19; + _guard *= 20; + _guardrec *= 21; + + _fmul *= 22; + _fdiv *= 23; + _fdivi *= 24; + _fadd *= 25; + _fsub *= 26; + _fsubi *= 27; + _fcmp *= 28; + _floor *= 29; + _flt *= 30; + _pack *= 31; + _unpk *= 32; + + +TYPE + + COMMAND* = POINTER TO RECORD (LISTS.ITEM) + + opcode*: INTEGER; + param1*: INTEGER; + param2*: INTEGER; + param3*: INTEGER; + float*: REAL + + END; + + FNAMECMD* = POINTER TO RECORD (COMMAND) + + fname*: PATHS.PATH + + END; + + CMDSTACK = POINTER TO RECORD + + data: ARRAY 1000 OF COMMAND; + top: INTEGER + + END; + + EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + name*: SCAN.IDSTR + + END; + + IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) + + name*: SCAN.TEXTSTR; + procs*: LISTS.LIST + + END; + + IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + lib*: IMPORT_LIB; + name*: SCAN.TEXTSTR; + count: INTEGER + + END; + + + CODES = 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 33 OF INTEGER; + errlabels*: ARRAY 12 OF INTEGER; + + charoffs: ARRAY 256 OF INTEGER; + wcharoffs: ARRAY 65536 OF INTEGER; + + wstr: ARRAY 4*1024 OF WCHAR + END; + + +VAR + + codes*: CODES; + CPU: INTEGER; + + commands: C.COLLECTION; + + +PROCEDURE set_dmin* (value: INTEGER); +BEGIN + codes.dmin := value +END set_dmin; + + +PROCEDURE set_bss* (value: INTEGER); +BEGIN + codes.bss := value +END set_bss; + + +PROCEDURE set_rtl* (idx, label: INTEGER); +BEGIN + codes.rtl[idx] := label +END set_rtl; + + +PROCEDURE NewCmd (): COMMAND; +VAR + cmd: COMMAND; + citem: C.ITEM; + +BEGIN + citem := C.pop(commands); + IF citem = NIL THEN + NEW(cmd) + ELSE + cmd := citem(COMMAND) + END + + RETURN cmd +END NewCmd; + + +PROCEDURE setlast* (cmd: COMMAND); +BEGIN + codes.last := cmd +END setlast; + + +PROCEDURE getlast* (): COMMAND; + RETURN codes.last +END getlast; + + +PROCEDURE PutByte (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(ORD(s[i])); + INC(i) + END; + + PutByte(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(c); + PutByte(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(0); + INC(res) + END; + + n := STRINGS.Utf8To16(s, codes.wstr); + + i := 0; + WHILE i < n DO + IF TARGETS.LittleEndian THEN + PutByte(ORD(codes.wstr[i]) MOD 256); + PutByte(ORD(codes.wstr[i]) DIV 256) + ELSE + PutByte(ORD(codes.wstr[i]) DIV 256); + PutByte(ORD(codes.wstr[i]) MOD 256) + END; + INC(i) + END; + + PutByte(0); + PutByte(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(0); + INC(res) + END; + + IF TARGETS.LittleEndian THEN + PutByte(c MOD 256); + PutByte(c DIV 256) + ELSE + PutByte(c DIV 256); + PutByte(c MOD 256) + END; + + PutByte(0); + PutByte(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 + IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64, TARGETS.cpuMSP430} THEN + + 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 := cur.param2 * param2 + + ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN + INC(cur.param2, param2) + + ELSE + old_opcode := -1 + END + + ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN + + old_opcode := cur.opcode; + param2 := nov.param2; + + IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN + cur.opcode := opLADR_SAVE + ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN + set(cur, opLADR_INCC, param2) + ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN + cur.param2 := cur.param2 * param2 + ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN + INC(cur.param2, param2) + ELSE + old_opcode := -1 + END + + 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 delete (cmd: COMMAND); +BEGIN + 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 Jmp* (opcode: INTEGER; label: INTEGER); +VAR + prev: COMMAND; + not: BOOLEAN; + +BEGIN + prev := codes.last; + not := prev.opcode = opNOT; + IF not THEN + IF opcode = opJNZ THEN + opcode := opJZ + ELSIF opcode = opJZ THEN + opcode := opJNZ + ELSE + not := FALSE + END + END; + + AddCmd2(opcode, label, label); + + IF not THEN + delete(prev) + END +END Jmp; + + +PROCEDURE AndOrOpt* (VAR label: INTEGER); +VAR + cur, prev: COMMAND; + i, op, l: INTEGER; + jz, not: BOOLEAN; + +BEGIN + cur := codes.last; + not := cur.opcode = opNOT; + IF not THEN + cur := cur.prev(COMMAND) + END; + + IF cur.opcode = opAND THEN + op := opAND + ELSIF cur.opcode = opOR THEN + op := opOR + ELSE + op := -1 + END; + + cur := codes.last; + + IF op # -1 THEN + IF not THEN + IF op = opAND THEN + op := opOR + ELSE (* op = opOR *) + op := opAND + END; + prev := cur.prev(COMMAND); + delete(cur); + cur := prev + END; + + FOR i := 1 TO 9 DO + IF i = 8 THEN + l := cur.param1 + ELSIF i = 9 THEN + jz := cur.opcode = opJZ + END; + prev := cur.prev(COMMAND); + delete(cur); + cur := prev + END; + + setlast(cur); + + IF op = opAND THEN + label := l; + jz := ~jz + END; + + IF jz THEN + Jmp(opJZ, label) + ELSE + Jmp(opJNZ, label) + END; + + IF op = opOR THEN + SetLabel(l) + END + ELSE + Jmp(opJZ, label) + END; + + setlast(codes.last) +END AndOrOpt; + + +PROCEDURE OnError* (line, error: INTEGER); +BEGIN + AddCmd2(opONERR, codes.errlabels[error], line) +END OnError; + + +PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); +VAR + label: INTEGER; +BEGIN + AddCmd(op, t); + label := NewLabel(); + Jmp(opJNZ, 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 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 _ord*; +BEGIN + IF (codes.last.opcode # opAND) & (codes.last.opcode # opOR) THEN + AddCmd0(opORD) + END +END _ord; + + +PROCEDURE Enter* (label, params: INTEGER): COMMAND; +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opENTER; + cmd.param1 := label; + cmd.param3 := params; + 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: Jmp(opCALL, proc) + |call_win64: Jmp(opWIN64CALL, proc) + |call_sysv: Jmp(opSYSVCALL, proc) + END; + codes.last(COMMAND).param2 := fparams +END Call; + + +PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label) + |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label) + |call_sysv: Jmp(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 + Jmp(opSAVEP, proc) +END AssignProc; + + +PROCEDURE AssignImpProc* (proc: LISTS.ITEM); +BEGIN + Jmp(opSAVEIP, proc(IMPORT_PROC).label) +END AssignImpProc; + + +PROCEDURE PushProc* (proc: INTEGER); +BEGIN + Jmp(opPUSHP, proc) +END PushProc; + + +PROCEDURE PushImpProc* (proc: LISTS.ITEM); +BEGIN + Jmp(opPUSHIP, proc(IMPORT_PROC).label) +END PushImpProc; + + +PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); +BEGIN + IF eq THEN + Jmp(opEQP, proc) + ELSE + Jmp(opNEP, proc) + END +END ProcCmp; + + +PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); +BEGIN + IF eq THEN + Jmp(opEQIP, proc(IMPORT_PROC).label) + ELSE + Jmp(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* (inv: BOOLEAN); +BEGIN + IF inv THEN + AddCmd0(opSAVEFI) + ELSE + AddCmd0(opSAVEF) + END +END savef; + + +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 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; line, col: INTEGER); +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opCONSTF; + cmd.float := r; + cmd.param1 := line; + cmd.param2 := col; + insert(codes.last, cmd) +END Float; + + +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 fname* (name: PATHS.PATH); +VAR + cmd: FNAMECMD; + +BEGIN + NEW(cmd); + cmd.opcode := opFNAME; + cmd.fname := name; + insert(codes.last, cmd) +END fname; + + +PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR); +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.TEXTSTR): 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* (pCPU: INTEGER); +VAR + cmd: COMMAND; + i: INTEGER; + +BEGIN + commands := C.create(); + + CPU := pCPU; + + 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; + + 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/MSP430.ob07 b/programs/develop/oberon07/source/MSP430.ob07 index 9df92b6196..abba309e77 100644 --- a/programs/develop/oberon07/source/MSP430.ob07 +++ b/programs/develop/oberon07/source/MSP430.ob07 @@ -1,1780 +1,1780 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, Anton Krotov - All rights reserved. -*) - -MODULE MSP430; - -IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX, - UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; - - -CONST - - chkSTK* = 6; - - minRAM* = 128; maxRAM* = 2048; - minROM* = 2048; maxROM* = 24576; - - StkReserve = RTL.StkReserve; - - IntVectorSize* = RTL.IntVectorSize; - - PC = 0; SP = 1; SR = 2; CG = 3; - - R4 = 4; R5 = 5; R6 = 6; R7 = 7; - - HP = RTL.HP; - - 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; - - StkCnt, MaxStkCnt: INTEGER; - - -PROCEDURE CheckProcDataSize* (VarSize, RamSize: INTEGER): BOOLEAN; - RETURN (VarSize + 1) * 2 + StkReserve + RTL.VarSize < RamSize -END CheckProcDataSize; - - -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 IncStk; -BEGIN - INC(StkCnt); - MaxStkCnt := MAX(StkCnt, MaxStkCnt) -END IncStk; - - -PROCEDURE bw (b: BOOLEAN): INTEGER; - RETURN BW * ORD(b) -END bw; - - -PROCEDURE src_x (x, Rn: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - IF (x = 0) & ~(Rn IN {PC, SR, CG}) THEN - res := Rn * 256 + sINDIR - ELSE - IdxWords.src := x; - res := Rn * 256 + sIDX - END - - RETURN res -END src_x; - - -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 := CG * 256 + sIDX - | 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} = {}); - ASSERT(BITS(src) - {4, 5, 8..11} = {}); - ASSERT(BITS(dst) - {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; - IncStk -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); - IncStk -END Push; - - -PROCEDURE Pop (reg: INTEGER); -BEGIN - Op2(opMOV, incr(SP), reg); - DEC(StkCnt) -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); - mov(reg1, reg2); - 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 - IncStk; - DEC(StkCnt); - EmitCall(RTL.rtl[proc].label); - RTL.Used(proc); - IF params > 0 THEN - Op2(opADD, imm(params * 2), SP); - DEC(StkCnt, params) - 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 LocalOffset (offset: INTEGER): INTEGER; - RETURN (offset + StkCnt - ORD(offset > 0)) * 2 -END LocalOffset; - - -PROCEDURE LocalDst (offset: INTEGER): INTEGER; - RETURN dst_x(LocalOffset(offset), SP) -END LocalDst; - - -PROCEDURE LocalSrc (offset: INTEGER): INTEGER; - RETURN src_x(LocalOffset(offset), SP) -END LocalSrc; - - -PROCEDURE translate (chk_stk: BOOLEAN); -VAR - cmd, next: COMMAND; - - opcode, param1, param2, L, a, n, c1, c2: INTEGER; - - reg1, reg2: INTEGER; - - cc: INTEGER; - - word: WORD; - -BEGIN - cmd := IL.codes.commands.first(COMMAND); - - WHILE cmd # NIL DO - - param1 := cmd.param1; - param2 := cmd.param2; - - opcode := cmd.opcode; - - CASE opcode OF - |IL.opJMP: - EmitJmp(opJMP, param1) - - |IL.opCALL: - IncStk; - DEC(StkCnt); - EmitCall(param1) - - |IL.opCALLP: - IncStk; - DEC(StkCnt); - 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); - IncStk; - EmitWord(param2); - Reloc(RDATA) - - |IL.opERR: - CallRTL(RTL._error, 2) - - |IL.opPUSHC: - PushImm(param2) - - |IL.opONERR: - DEC(StkCnt); - EmitWord(0C232H); (* BIC #8, SR; DINT *) - EmitWord(4303H); (* MOV R3, R3; NOP *) - PushImm(param2); - EmitJmp(opJMP, param1) - - |IL.opLEAVEC: - Pop(PC) - - |IL.opENTER: - ASSERT(R.top = -1); - EmitLabel(param1); - n := param2 MOD 65536; - param2 := param2 DIV 65536; - StkCnt := 0; - IF chk_stk THEN - L := NewLabel(); - Op2(opMOV, SP * 256, R4); - Op2(opSUB, HP * 256, R4); - Op2(opCMP, imm(StkReserve), R4); - word := CodeList.last(WORD); - jcc(jge, L); - DEC(StkCnt); - EmitWord(0C232H); (* BIC #8, SR; DINT *) - EmitWord(4303H); (* MOV R3, R3; NOP *) - PushImm(n); - EmitJmp(opJMP, cmd.param3); - EmitLabel(L) - END; - - IF param2 > 8 THEN - Op2(opMOV, imm(param2), R4); - L := NewLabel(); - EmitLabel(L); - Push(CG); - Op2(opSUB, imm(1), R4); - jcc(jne, L) - ELSE - FOR n := 1 TO param2 DO - Push(CG) - END - END; - StkCnt := param2; - MaxStkCnt := StkCnt - - |IL.opLEAVE, IL.opLEAVER: - ASSERT(param2 = 0); - IF opcode = IL.opLEAVER THEN - UnOp(reg1); - IF reg1 # ACC THEN - mov(ACC, reg1) - END; - drop - END; - ASSERT(R.top = -1); - ASSERT(StkCnt = param1); - IF chk_stk THEN - INC(word.val, MaxStkCnt * 2) - END; - IF param1 > 0 THEN - Op2(opADD, imm(param1 * 2), SP) - END; - Pop(PC) - - |IL.opRES: - ASSERT(R.top = -1); - GetRegA - - |IL.opCLEANUP: - IF param2 # 0 THEN - Op2(opADD, imm(param2 * 2), SP); - DEC(StkCnt, param2) - 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(); - n := LocalOffset(param2); - Op2(opMOV, SP * 256, reg1); - IF n # 0 THEN - Op2(opADD, imm(n), reg1) - END - - |IL.opLLOAD8: - Op2(opMOV + BW, LocalSrc(param2), GetAnyReg()) - - |IL.opLLOAD16, IL.opVADR: - Op2(opMOV, LocalSrc(param2), 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, LocalSrc(param2), reg1); - Op2(opMOV + BW, indir(reg1), reg1) - - |IL.opVLOAD16: - reg1 := GetAnyReg(); - Op2(opMOV, LocalSrc(param2), 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.opADDC: - 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 - Neg(reg1) - END - - |IL.opLADR_SAVEC: - Op2(opMOV, imm(param2), LocalDst(param1)) - - |IL.opLADR_SAVE: - UnOp(reg1); - Op2(opMOV, reg1 * 256, LocalDst(param2)); - 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); - next := cmd.next(COMMAND); - - IF next.opcode = IL.opJNZ THEN - jcc(cc, next.param1); - cmd := next - ELSIF next.opcode = IL.opJZ THEN - jcc(ORD(BITS(cc) / {0}), next.param1); - cmd := next - ELSE - setcc(cc, GetAnyReg()) - END - - |IL.opNOP, IL.opAND, IL.opOR: - - |IL.opCODE: - EmitWord(param2) - - |IL.opDROP: - UnOp(reg1); - drop - - |IL.opJNZ1: - UnOp(reg1); - Test(reg1); - jcc(jne, param1) - - |IL.opJG: - UnOp(reg1); - Test(reg1); - jcc(jg, param1) - - |IL.opJNZ: - UnOp(reg1); - Test(reg1); - jcc(jne, param1); - drop - - |IL.opJZ: - 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.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.opCHKBYTE: - BinOp(reg1, reg2); - Op2(opCMP, imm(256), reg1); - jcc(jb, param1) - - |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); - jcc(jb, param1) - END; - INCL(R.regs, reg1); - DEC(R.top); - R.stk[R.top] := reg2 - - |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), LocalDst(param1)) - - |IL.opLADR_DECCB: - Op2(opSUB + BW, imm(param2), LocalDst(param1)) - - |IL.opLADR_INC, IL.opLADR_INCB: - UnOp(reg1); - Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, LocalDst(param2)); - drop - - |IL.opLADR_DEC, IL.opLADR_DECB: - UnOp(reg1); - Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, LocalDst(param2)); - 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); - IncStk; - 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.opADDSC: - 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.opMAX,IL.opMIN: - BinOp(reg1, reg2); - Op2(opCMP, reg2 * 256, reg1); - IF opcode = IL.opMIN THEN - cc := opJL + 1 - ELSE - cc := opJGE + 1 - END; - EmitWord(cc); (* jge/jl L *) - MovRR(reg2, reg1); - (* L: *) - drop - - |IL.opMAXC, IL.opMINC: - UnOp(reg1); - Op2(opCMP, imm(param2), reg1); - L := NewLabel(); - IF opcode = IL.opMINC THEN - cc := jl - ELSE - cc := jge - END; - jcc(cc, 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); - IF param2 = cmd.param3 THEN - jcc(jne, param2) - ELSE - jcc(jl, param2); - jcc(jg, cmd.param3) - END - - |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.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.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); - IncStk; - 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: - reg1 := GetAnyReg(); - Op2(opMOV, LocalSrc(param2), reg1); - Push(reg1); - drop - - |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(SP, ACC); - n := LocalOffset(param2); - IF n # 0 THEN - Op2(opADD, imm(n), ACC) - END; - Push(ACC); - IF opcode = IL.opLADR_INCL THEN - CallRTL(RTL._incl, 2) - ELSIF opcode = IL.opLADR_EXCL THEN - CallRTL(RTL._excl, 2) - END - - |IL.opLADR_INCLC: - Op2(opBIS, imm(ORD({param2})), LocalDst(param1)) - - |IL.opLADR_EXCLC: - Op2(opBIC, imm(ORD({param2})), LocalDst(param1)) - - END; - - cmd := cmd.next(COMMAND) - END; - - ASSERT(R.pushed = 0); - ASSERT(R.top = -1) -END translate; - - -PROCEDURE prolog; -VAR - i: INTEGER; - -BEGIN - RTL.Init(EmitLabel, EmitWord, EmitCall); - 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(0, SP)); - Op2(opMOV, imm(RTL.empty_proc), dst_x(2, SP)); -END prolog; - - -PROCEDURE epilog; -VAR - L1, i, n: 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); - - n := 0; - FOR i := 0 TO 15 DO - IF i IN R.regs THEN - Push(i); - INC(n) - END - END; - - MovRR(SP, R4); - Op2(opADD, imm(n * 2), R4); - - Push(R4); - Op1(opPUSH, R4, sINDIR); - Op1(opCALL, SR, sIDX); EmitWord(-RTL.VarSize); Reloc(RBSS); (* call int *) - Op2(opADD, imm(4), SP); - - FOR i := 15 TO 0 BY -1 DO - IF i IN R.regs THEN - Pop(i) - END - END; - - Op2(opADD, imm(2), SP); - Op1(opRETI, 0, 0); - - RTL.Gen -END epilog; - - -PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); -VAR - i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER; - - Code, Data, Bss: RECORD address, size: INTEGER END; - - ram, rom: INTEGER; - - reloc: RELOC; - -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 IL.codes.bss > ram - StkReserve - RTL.VarSize THEN - ERRORS.Error(204) - END; - - Labels := CHL.CreateIntList(); - FOR i := 1 TO IL.codes.lcount DO - CHL.PushInt(Labels, 0) - END; - - CodeList := LISTS.create(NIL); - RelList := LISTS.create(NIL); - REG.Init(R, Push, Pop, mov, xchg, {R4, R5, R6, R7}); - - prolog; - translate(chkSTK IN options.checking); - epilog; - - TypesSize := CHL.Length(IL.codes.types) * 2; - Data.size := CHL.Length(IL.codes.data); - IF ODD(Data.size) THEN - CHL.PushByte(IL.codes.data, 0); - INC(Data.size) - END; - Code.size := Fixup(0, IntVectorSize + TypesSize + Data.size); - Code.address := 10000H - (IntVectorSize + TypesSize + Data.size + Code.size); - IF Code.address < 10000H - rom THEN - ERRORS.Error(203) - END; - Code.size := Fixup(Code.address, IntVectorSize + TypesSize + Data.size); - Data.address := Code.address + Code.size; - TextSize := Code.size + Data.size; - - IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN - ERRORS.Error(203) - END; - - stack := RTL.ram + ram; - Bss.size := IL.codes.bss + IL.codes.bss MOD 2; - DEC(stack, Bss.size); - Bss.address := stack; - DEC(stack, RTL.VarSize); - heap := RTL.ram; - ASSERT(stack - heap >= StkReserve); - 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; - val := reloc.WordPtr.val; - CASE reloc.section OF - |RCODE: PutWord(LabelOffs(val) * 2, adr) - |RDATA: PutWord(val + Data.address, adr) - |RBSS: PutWord((val + Bss.address) MOD 65536, adr) - END; - reloc := reloc.next(RELOC) - END; - - adr := Data.address; - - FOR i := 0 TO Data.size - 1 DO - mem[adr] := CHL.GetByte(IL.codes.data, i); - INC(adr) - END; - - FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO - PutWord(CHL.GetInt(IL.codes.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; - - PutWord(4130H, adr); (* RET *) - PutWord(stack, adr); - PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *) - - FOR i := 0 TO LEN(IV) - 1 DO - PutWord(LabelOffs(IV[i]) * 2, adr) - END; - - INC(TextSize, IntVectorSize + TypesSize + Code.address MOD 16); - INC(Bss.size, StkReserve + RTL.VarSize); - - WR.Create(outname); - HEX.Data(mem, Code.address - Code.address MOD 16, TextSize); - HEX.End; - WR.Close; - - C.Dashes; - C.String(" rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); - 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("%)") -END CodeGen; - - +(* + BSD 2-Clause License + + Copyright (c) 2019-2021, Anton Krotov + All rights reserved. +*) + +MODULE MSP430; + +IMPORT IL, LISTS, REG, CHL := CHUNKLISTS, ERRORS, WR := WRITER, HEX, + UTILS, C := CONSOLE, PROG, RTL := MSP430RTL; + + +CONST + + chkSTK* = 6; + + minRAM* = 128; maxRAM* = 2048; + minROM* = 2048; maxROM* = 24576; + + StkReserve = RTL.StkReserve; + + IntVectorSize* = RTL.IntVectorSize; + + PC = 0; SP = 1; SR = 2; CG = 3; + + R4 = 4; R5 = 5; R6 = 6; R7 = 7; + + HP = RTL.HP; + + 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; + + StkCnt, MaxStkCnt: INTEGER; + + +PROCEDURE CheckProcDataSize* (VarSize, RamSize: INTEGER): BOOLEAN; + RETURN (VarSize + 1) * 2 + StkReserve + RTL.VarSize < RamSize +END CheckProcDataSize; + + +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 IncStk; +BEGIN + INC(StkCnt); + MaxStkCnt := MAX(StkCnt, MaxStkCnt) +END IncStk; + + +PROCEDURE bw (b: BOOLEAN): INTEGER; + RETURN BW * ORD(b) +END bw; + + +PROCEDURE src_x (x, Rn: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF (x = 0) & ~(Rn IN {PC, SR, CG}) THEN + res := Rn * 256 + sINDIR + ELSE + IdxWords.src := x; + res := Rn * 256 + sIDX + END + + RETURN res +END src_x; + + +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 := CG * 256 + sIDX + | 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} = {}); + ASSERT(BITS(src) - {4, 5, 8..11} = {}); + ASSERT(BITS(dst) - {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; + IncStk +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); + IncStk +END Push; + + +PROCEDURE Pop (reg: INTEGER); +BEGIN + Op2(opMOV, incr(SP), reg); + DEC(StkCnt) +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); + mov(reg1, reg2); + 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 + IncStk; + DEC(StkCnt); + EmitCall(RTL.rtl[proc].label); + RTL.Used(proc); + IF params > 0 THEN + Op2(opADD, imm(params * 2), SP); + DEC(StkCnt, params) + 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 LocalOffset (offset: INTEGER): INTEGER; + RETURN (offset + StkCnt - ORD(offset > 0)) * 2 +END LocalOffset; + + +PROCEDURE LocalDst (offset: INTEGER): INTEGER; + RETURN dst_x(LocalOffset(offset), SP) +END LocalDst; + + +PROCEDURE LocalSrc (offset: INTEGER): INTEGER; + RETURN src_x(LocalOffset(offset), SP) +END LocalSrc; + + +PROCEDURE translate (chk_stk: BOOLEAN); +VAR + cmd, next: COMMAND; + + opcode, param1, param2, L, a, n, c1, c2: INTEGER; + + reg1, reg2: INTEGER; + + cc: INTEGER; + + word: WORD; + +BEGIN + cmd := IL.codes.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + + opcode := cmd.opcode; + + CASE opcode OF + |IL.opJMP: + EmitJmp(opJMP, param1) + + |IL.opCALL: + IncStk; + DEC(StkCnt); + EmitCall(param1) + + |IL.opCALLP: + IncStk; + DEC(StkCnt); + 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); + IncStk; + EmitWord(param2); + Reloc(RDATA) + + |IL.opERR: + CallRTL(RTL._error, 2) + + |IL.opPUSHC: + PushImm(param2) + + |IL.opONERR: + DEC(StkCnt); + EmitWord(0C232H); (* BIC #8, SR; DINT *) + EmitWord(4303H); (* MOV R3, R3; NOP *) + PushImm(param2); + EmitJmp(opJMP, param1) + + |IL.opLEAVEC: + Pop(PC) + + |IL.opENTER: + ASSERT(R.top = -1); + EmitLabel(param1); + n := param2 MOD 65536; + param2 := param2 DIV 65536; + StkCnt := 0; + IF chk_stk THEN + L := NewLabel(); + Op2(opMOV, SP * 256, R4); + Op2(opSUB, HP * 256, R4); + Op2(opCMP, imm(StkReserve), R4); + word := CodeList.last(WORD); + jcc(jge, L); + DEC(StkCnt); + EmitWord(0C232H); (* BIC #8, SR; DINT *) + EmitWord(4303H); (* MOV R3, R3; NOP *) + PushImm(n); + EmitJmp(opJMP, cmd.param3); + EmitLabel(L) + END; + + IF param2 > 8 THEN + Op2(opMOV, imm(param2), R4); + L := NewLabel(); + EmitLabel(L); + Push(CG); + Op2(opSUB, imm(1), R4); + jcc(jne, L) + ELSE + FOR n := 1 TO param2 DO + Push(CG) + END + END; + StkCnt := param2; + MaxStkCnt := StkCnt + + |IL.opLEAVE, IL.opLEAVER: + ASSERT(param2 = 0); + IF opcode = IL.opLEAVER THEN + UnOp(reg1); + IF reg1 # ACC THEN + mov(ACC, reg1) + END; + drop + END; + ASSERT(R.top = -1); + ASSERT(StkCnt = param1); + IF chk_stk THEN + INC(word.val, MaxStkCnt * 2) + END; + IF param1 > 0 THEN + Op2(opADD, imm(param1 * 2), SP) + END; + Pop(PC) + + |IL.opRES: + ASSERT(R.top = -1); + GetRegA + + |IL.opCLEANUP: + IF param2 # 0 THEN + Op2(opADD, imm(param2 * 2), SP); + DEC(StkCnt, param2) + 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(); + n := LocalOffset(param2); + Op2(opMOV, SP * 256, reg1); + IF n # 0 THEN + Op2(opADD, imm(n), reg1) + END + + |IL.opLLOAD8: + Op2(opMOV + BW, LocalSrc(param2), GetAnyReg()) + + |IL.opLLOAD16, IL.opVADR: + Op2(opMOV, LocalSrc(param2), 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, LocalSrc(param2), reg1); + Op2(opMOV + BW, indir(reg1), reg1) + + |IL.opVLOAD16: + reg1 := GetAnyReg(); + Op2(opMOV, LocalSrc(param2), 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.opADDC: + 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 + Neg(reg1) + END + + |IL.opLADR_SAVEC: + Op2(opMOV, imm(param2), LocalDst(param1)) + + |IL.opLADR_SAVE: + UnOp(reg1); + Op2(opMOV, reg1 * 256, LocalDst(param2)); + 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); + next := cmd.next(COMMAND); + + IF next.opcode = IL.opJNZ THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJZ THEN + jcc(ORD(BITS(cc) / {0}), next.param1); + cmd := next + ELSE + setcc(cc, GetAnyReg()) + END + + |IL.opNOP, IL.opAND, IL.opOR: + + |IL.opCODE: + EmitWord(param2) + + |IL.opDROP: + UnOp(reg1); + drop + + |IL.opJNZ1: + UnOp(reg1); + Test(reg1); + jcc(jne, param1) + + |IL.opJG: + UnOp(reg1); + Test(reg1); + jcc(jg, param1) + + |IL.opJNZ: + UnOp(reg1); + Test(reg1); + jcc(jne, param1); + drop + + |IL.opJZ: + 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.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.opCHKBYTE: + BinOp(reg1, reg2); + Op2(opCMP, imm(256), reg1); + jcc(jb, param1) + + |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); + jcc(jb, param1) + END; + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 + + |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), LocalDst(param1)) + + |IL.opLADR_DECCB: + Op2(opSUB + BW, imm(param2), LocalDst(param1)) + + |IL.opLADR_INC, IL.opLADR_INCB: + UnOp(reg1); + Op2(opADD + bw(opcode = IL.opLADR_INCB), reg1 * 256, LocalDst(param2)); + drop + + |IL.opLADR_DEC, IL.opLADR_DECB: + UnOp(reg1); + Op2(opSUB + bw(opcode = IL.opLADR_DECB), reg1 * 256, LocalDst(param2)); + 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); + IncStk; + 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.opADDSC: + 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.opMAX,IL.opMIN: + BinOp(reg1, reg2); + Op2(opCMP, reg2 * 256, reg1); + IF opcode = IL.opMIN THEN + cc := opJL + 1 + ELSE + cc := opJGE + 1 + END; + EmitWord(cc); (* jge/jl L *) + MovRR(reg2, reg1); + (* L: *) + drop + + |IL.opMAXC, IL.opMINC: + UnOp(reg1); + Op2(opCMP, imm(param2), reg1); + L := NewLabel(); + IF opcode = IL.opMINC THEN + cc := jl + ELSE + cc := jge + END; + jcc(cc, 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); + IF param2 = cmd.param3 THEN + jcc(jne, param2) + ELSE + jcc(jl, param2); + jcc(jg, cmd.param3) + END + + |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.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.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); + IncStk; + 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: + reg1 := GetAnyReg(); + Op2(opMOV, LocalSrc(param2), reg1); + Push(reg1); + drop + + |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(SP, ACC); + n := LocalOffset(param2); + IF n # 0 THEN + Op2(opADD, imm(n), ACC) + END; + Push(ACC); + IF opcode = IL.opLADR_INCL THEN + CallRTL(RTL._incl, 2) + ELSIF opcode = IL.opLADR_EXCL THEN + CallRTL(RTL._excl, 2) + END + + |IL.opLADR_INCLC: + Op2(opBIS, imm(ORD({param2})), LocalDst(param1)) + + |IL.opLADR_EXCLC: + Op2(opBIC, imm(ORD({param2})), LocalDst(param1)) + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog; +VAR + i: INTEGER; + +BEGIN + RTL.Init(EmitLabel, EmitWord, EmitCall); + 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(0, SP)); + Op2(opMOV, imm(RTL.empty_proc), dst_x(2, SP)); +END prolog; + + +PROCEDURE epilog; +VAR + L1, i, n: 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); + + n := 0; + FOR i := 0 TO 15 DO + IF i IN R.regs THEN + Push(i); + INC(n) + END + END; + + MovRR(SP, R4); + Op2(opADD, imm(n * 2), R4); + + Push(R4); + Op1(opPUSH, R4, sINDIR); + Op1(opCALL, SR, sIDX); EmitWord(-RTL.VarSize); Reloc(RBSS); (* call int *) + Op2(opADD, imm(4), SP); + + FOR i := 15 TO 0 BY -1 DO + IF i IN R.regs THEN + Pop(i) + END + END; + + Op2(opADD, imm(2), SP); + Op1(opRETI, 0, 0); + + RTL.Gen +END epilog; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +VAR + i, adr, heap, stack, TextSize, TypesSize, bits, n, val: INTEGER; + + Code, Data, Bss: RECORD address, size: INTEGER END; + + ram, rom: INTEGER; + + reloc: RELOC; + +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 IL.codes.bss > ram - StkReserve - RTL.VarSize THEN + ERRORS.Error(204) + END; + + Labels := CHL.CreateIntList(); + FOR i := 1 TO IL.codes.lcount DO + CHL.PushInt(Labels, 0) + END; + + CodeList := LISTS.create(NIL); + RelList := LISTS.create(NIL); + REG.Init(R, Push, Pop, mov, xchg, {R4, R5, R6, R7}); + + prolog; + translate(chkSTK IN options.checking); + epilog; + + TypesSize := CHL.Length(IL.codes.types) * 2; + Data.size := CHL.Length(IL.codes.data); + IF ODD(Data.size) THEN + CHL.PushByte(IL.codes.data, 0); + INC(Data.size) + END; + Code.size := Fixup(0, IntVectorSize + TypesSize + Data.size); + Code.address := 10000H - (IntVectorSize + TypesSize + Data.size + Code.size); + IF Code.address < 10000H - rom THEN + ERRORS.Error(203) + END; + Code.size := Fixup(Code.address, IntVectorSize + TypesSize + Data.size); + Data.address := Code.address + Code.size; + TextSize := Code.size + Data.size; + + IF Code.address + TextSize + MAX(IL.codes.dmin - Data.size, IntVectorSize + TypesSize) > 10000H THEN + ERRORS.Error(203) + END; + + stack := RTL.ram + ram; + Bss.size := IL.codes.bss + IL.codes.bss MOD 2; + DEC(stack, Bss.size); + Bss.address := stack; + DEC(stack, RTL.VarSize); + heap := RTL.ram; + ASSERT(stack - heap >= StkReserve); + 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; + val := reloc.WordPtr.val; + CASE reloc.section OF + |RCODE: PutWord(LabelOffs(val) * 2, adr) + |RDATA: PutWord(val + Data.address, adr) + |RBSS: PutWord((val + Bss.address) MOD 65536, adr) + END; + reloc := reloc.next(RELOC) + END; + + adr := Data.address; + + FOR i := 0 TO Data.size - 1 DO + mem[adr] := CHL.GetByte(IL.codes.data, i); + INC(adr) + END; + + FOR i := TypesSize DIV 2 - 1 TO 0 BY -1 DO + PutWord(CHL.GetInt(IL.codes.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; + + PutWord(4130H, adr); (* RET *) + PutWord(stack, adr); + PutWord(0001H, adr); (* bsl signature (adr 0FFBEH) *) + + FOR i := 0 TO LEN(IV) - 1 DO + PutWord(LabelOffs(IV[i]) * 2, adr) + END; + + INC(TextSize, IntVectorSize + TypesSize + Code.address MOD 16); + INC(Bss.size, StkReserve + RTL.VarSize); + + WR.Create(outname); + HEX.Data(mem, Code.address - Code.address MOD 16, TextSize); + HEX.End; + WR.Close; + + C.Dashes; + C.String(" rom: "); C.Int(TextSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(TextSize * 100 DIV rom); C.StringLn("%)"); + 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("%)") +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 index 66f0021d99..4ddfe5ac2c 100644 --- a/programs/develop/oberon07/source/MSP430RTL.ob07 +++ b/programs/develop/oberon07/source/MSP430RTL.ob07 @@ -1,671 +1,671 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, Anton Krotov - All rights reserved. -*) - -MODULE MSP430RTL; - - -CONST - - _mul* = 0; - _divmod* = 1; - _lsl* = 2; - _asr* = 3; - _ror* = 4; - _lsr* = 5; - _in* = 6; - _in2* = 7; - _set1* = 8; - _incl* = 9; - _excl* = 10; - _move* = 11; - _set* = 12; - _arrcpy* = 13; - _rot* = 14; - _strcmp* = 15; - _error* = 16; - _is* = 17; - _guard* = 18; - _guardrec* = 19; - _length* = 20; - _new* = 21; - - - HP* = 15; - - LenIV* = 32; - - iv = 10000H - LenIV * 2; - bsl = iv - 2; - sp = bsl - 2; - empty_proc* = sp - 2; - bits = empty_proc - 272; - bits_offs = bits - 32; - DataSize* = iv - bits_offs; - types = bits_offs - 2; - - IntVectorSize* = LenIV * 2 + DataSize; - - VarSize* = 4; - - StkReserve* = 40; - - trap = 2; - - -TYPE - - EMITPROC = PROCEDURE (n: INTEGER); - - -VAR - - ram*: INTEGER; - - rtl*: ARRAY 22 OF - RECORD - label*: INTEGER; - used: BOOLEAN - END; - - Label, Word, Call: EMITPROC; - - -PROCEDURE Gen*; - - - PROCEDURE Word1 (word: INTEGER); - BEGIN - Word(word) - END Word1; - - - PROCEDURE Word2 (word1, word2: INTEGER); - BEGIN - Word1(word1); - Word1(word2) - END Word2; - - - PROCEDURE Word3 (word1, word2, word3: INTEGER); - BEGIN - Word1(word1); - Word1(word2); - Word1(word3) - END Word3; - - -BEGIN - (* _lsl (n, x: INTEGER): INTEGER *) - IF rtl[_lsl].used THEN - Label(rtl[_lsl].label); - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) - Word2(0F035H, 15); (* AND #15, R5 *) - Word1(2400H + 3); (* JZ L1 *) - (* L2: *) - Word1(5404H); (* ADD R4, R4 *) - Word1(8315H); (* SUB #1, R5 *) - Word1(2000H + 400H - 3); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _asr (n, x: INTEGER): INTEGER *) - IF rtl[_asr].used THEN - Label(rtl[_asr].label); - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) - Word2(0F035H, 15); (* AND #15, R5 *) - Word1(2400H + 3); (* JZ L1 *) - (* L2: *) - Word1(1104H); (* RRA R4 *) - Word1(8315H); (* SUB #1, R5 *) - Word1(2000H + 400H - 3); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _ror (n, x: INTEGER): INTEGER *) - IF rtl[_ror].used THEN - Label(rtl[_ror].label); - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) - Word2(0F035H, 15); (* AND #15, R5 *) - Word1(2400H + 5); (* JZ L1 *) - Word1(4406H); (* MOV R4, R6 *) - (* L2: *) - Word1(1006H); (* RRC R6 *) - Word1(1004H); (* RRC R4 *) - Word1(8315H); (* SUB #1, R5 *) - Word1(2000H + 400H - 4); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _lsr (n, x: INTEGER): INTEGER *) - IF rtl[_lsr].used THEN - Label(rtl[_lsr].label); - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) - Word2(0F035H, 15); (* AND #15, R5 *) - Word1(2400H + 4); (* JZ L1 *) - (* L2: *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1004H); (* RRC R4 *) - Word1(8315H); (* SUB #1, R5 *) - Word1(2000H + 400H - 4); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _set (b, a: INTEGER): SET *) - IF rtl[_set].used THEN - Label(rtl[_set].label); - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *) - Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) - Word1(9504H); (* CMP R5, R4 *) - Word1(3800H + 24); (* JL L1 *) - Word2(9035H, 16); (* CMP #16, R5 *) - Word1(3400H + 21); (* JGE L1 *) - Word1(9304H); (* CMP #0, R4 *) - Word1(3800H + 19); (* JL L1 *) - Word2(9034H, 16); (* CMP #16, R4 *) - Word1(3800H + 2); (* JL L2 *) - Word2(4034H, 15); (* MOV #15, R4 *) - (* L2: *) - Word1(9305H); (* CMP #0, R5 *) - Word1(3400H + 1); (* JGE L3 *) - Word1(4305H); (* MOV #0, R5 *) - (* L3: *) - Word1(8504H); (* SUB R5, R4 *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits_offs); (* ADD bits_offs, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word1(5505H); (* ADD R5, R5 *) - Word1(5405H); (* ADD R4, R5 *) - Word2(5035H, bits); (* ADD bits, R5 *) - Word1(4524H); (* MOV @R5, R4 *) - Word1(4130H); (* RET *) - (* L1: *) - Word1(4304H); (* MOV #0, R4 *) - Word1(4130H) (* RET *) - END; - - (* _set1 (a: INTEGER): SET *) - IF rtl[_set1].used THEN - Label(rtl[_set1].label); - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *) - Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) - Word1(2000H + 5); (* JNZ L1 *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits); (* ADD bits, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word1(4130H); (* RET *) - (* L1: *) - Word1(4304H); (* MOV #0, R4 *) - Word1(4130H) (* RET *) - END; - - (* _in2 (i, s: INTEGER): BOOLEAN *) - IF rtl[_in2].used THEN - Label(rtl[_in2].label); - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits); (* ADD bits, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word2(0F114H, 4); (* AND 4(SP), R4 *) - Word1(2400H + 1); (* JZ L1 *) - Word1(4314H); (* MOV #1, R4 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _in (s, i: INTEGER): BOOLEAN *) - IF rtl[_in].used THEN - Label(rtl[_in].label); - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) - Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) - Word1(2000H + 9); (* JNZ L2 *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits); (* ADD bits, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word2(0F114H, 2); (* AND 2(SP), R4 *) - Word1(2400H + 3); (* JZ L1 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(4130H); (* RET *) - (* L2: *) - Word1(4304H); (* MOV #0, R4 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _incl (VAR s: SET; i: INTEGER) *) - IF rtl[_incl].used THEN - Label(rtl[_incl].label); - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) - Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) - Word1(2000H + 8); (* JNZ L1 *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits); (* ADD bits, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) - Word2(0D485H, 0); (* BIS R4, 0(R5) *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _excl (VAR s: SET; i: INTEGER) *) - IF rtl[_excl].used THEN - Label(rtl[_excl].label); - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) - Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) - Word1(2000H + 8); (* JNZ L1 *) - Word1(5404H); (* ADD R4, R4 *) - Word2(5034H, bits); (* ADD bits, R4 *) - Word1(4424H); (* MOV @R4, R4 *) - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) - Word2(0C485H, 0); (* BIC R4, 0(R5) *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _rot (len, adr: INTEGER) *) - IF rtl[_rot].used THEN - Label(rtl[_rot].label); - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *) - Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *) - Word1(8314H); (* SUB #1, R4 *) - Word1(5404H); (* ADD R4, R4 *) - Word1(1225H); (* PUSH @R5 *) - Word1(4406H); (* MOV R4, R6 *) - (* L1: *) - Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *) - Word1(5325H); (* ADD #2, R5 *) - Word1(8326H); (* SUB #2, R6 *) - Word1(2000H + 400H - 6); (* JNZ L1 *) - Word2(41B5H, 0); (* MOV @SP+, 0(R5) *) - Word1(4130H) (* RET *) - END; - - (* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *) - IF rtl[_divmod].used THEN - Label(rtl[_divmod].label); - Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) - Word1(4304H); (* MOV #0, R4 *) - (* L1: *) - Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) - Word1(9605H); (* CMP R6, R5 *) - Word1(3800H + 17); (* JL L3 *) - Word1(4327H); (* MOV #2, R7 *) - Word1(5606H); (* ADD R6, R6 *) - (* L4: *) - Word1(9306H); (* CMP #0, R6 *) - Word1(2400H + 6); (* JZ L2 *) - Word1(3800H + 5); (* JL L2 *) - Word1(9605H); (* CMP R6, R5 *) - Word1(3800H + 3); (* JL L2 *) - Word1(5606H); (* ADD R6, R6 *) - Word1(5707H); (* ADD R7, R7 *) - Word1(3C00H + 400H - 8); (* JMP L4 *) - (* L2: *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1006H); (* RRC R6 *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1007H); (* RRC R7 *) - Word1(8605H); (* SUB R6, R5 *) - Word1(5704H); (* ADD R7, R4 *) - Word1(3C00H + 400H - 21); (* JMP L1 *) - (* L3: *) - (*----------- (a < 0) --------------*) - (* L1: *) - Word1(9305H); (* CMP #0, R5 *) - Word1(3400H + 23); (* JGE L3 *) - Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) - Word1(4327H); (* MOV #2, R7 *) - Word1(5606H); (* ADD R6, R6 *) - Word1(0E335H); (* XOR #-1, R5 *) - Word1(5315H); (* ADD #1, R5 *) - (* L4: *) - Word1(9306H); (* CMP #0, R6 *) - Word1(2400H + 6); (* JZ L2 *) - Word1(3800H + 5); (* JL L2 *) - Word1(9605H); (* CMP R6, R5 *) - Word1(3800H + 3); (* JL L2 *) - Word1(5606H); (* ADD R6, R6 *) - Word1(5707H); (* ADD R7, R7 *) - Word1(3C00H + 400H - 8); (* JMP L4 *) - (* L2: *) - Word1(0E335H); (* XOR #-1, R5 *) - Word1(5315H); (* ADD #1, R5 *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1006H); (* RRC R6 *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1007H); (* RRC R7 *) - Word1(5605H); (* ADD R6, R5 *) - Word1(8704H); (* SUB R7, R4 *) - Word1(3C00H + 400H - 25); (* JMP L1 *) - (* L3: *) - Word1(4130H) (* RET *) - END; - - (* _mul (a, b: INTEGER): INTEGER *) - IF rtl[_mul].used THEN - Label(rtl[_mul].label); - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *) - Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *) - Word1(4304H); (* MOV #0, R4; res := 0 *) - Word1(9306H); (* CMP #0, R6 *) - Word1(2400H + 7); (* JZ L1 *) - (* L2: *) - Word1(0B316H); (* BIT #1, R6 *) - Word1(2400H + 1); (* JZ L3 *) - Word1(5504H); (* ADD R5, R4 *) - (* L3: *) - Word1(5505H); (* ADD R5, R5 *) - Word1(0C312H); (* BIC #1, SR *) - Word1(1006H); (* RRC R6 *) - Word1(2000H + 400H - 7); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _error (modNum, modName, err, line: INTEGER) *) - IF rtl[_error].used THEN - Label(rtl[_error].label); - Word1(5321H); (* ADD #2, SP *) - Word1(4134H); (* POP R4; R4 <- modNum *) - Word1(4135H); (* POP R5; R5 <- modName *) - Word1(4136H); (* POP R6; R6 <- err *) - Word1(4137H); (* POP R7; R7 <- line *) - Word2(4211H, sp); (* MOV sp(SR), SP *) - Word1(1207H); (* PUSH R7 *) - Word1(1206H); (* PUSH R6 *) - Word1(1205H); (* PUSH R5 *) - Word1(1204H); (* PUSH R4 *) - Word2(4214H, sp); (* MOV sp(SR), R4 *) - Word2(1294H, trap); (* CALL trap(R4) *) - Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *) - END; - - (* _new (t, size: INTEGER; VAR ptr: INTEGER) *) - IF rtl[_new].used THEN - Label(rtl[_new].label); - Word1(1202H); (* PUSH SR *) - Word1(4302H); (* MOV #0, SR *) - Word1(4303H); (* NOP *) - Word1(4104H); (* MOV SP, R4 *) - Word2(8034H, StkReserve); (* SUB #StkReserve, R4 *) - Word1(4005H + 100H * HP); (* MOV HP, R5 *) - Word2(5115H, 6); (* ADD 6(SP), R5 *) - Word1(9504H); (* CMP R5, R4 *) - Word2(4114H, 8); (* MOV 8(SP), R4 *) - Word1(3800H + 12); (* JL L1 *) - Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *) - Word1(5320H + HP); (* ADD #2, HP *) - Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *) - (* L3 *) - Word2(4380H + HP, 0); (* MOV #0, 0(HP) *) - Word1(5320H + HP); (* ADD #2, HP *) - Word1(9500H + HP); (* CMP R5, HP *) - Word1(3800H + 400H - 5); (* JL L3 *) - Word1(3C00H + 2); (* JMP L2 *) - (* L1 *) - Word2(4384H, 0); (* MOV #0, 0(R4) *) - (* L2 *) - Word1(1300H) (* RETI *) - END; - - (* _guardrec (t0, t1: INTEGER): INTEGER *) - IF rtl[_guardrec].used THEN - Label(rtl[_guardrec].label); - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *) - Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *) - Word2(4036H, types); (* MOV #types, R6 *) - (* L3: *) - Word1(9305H); (* CMP #0, R5 *) - Word1(2400H + 8); (* JZ L1 *) - Word1(9405H); (* CMP R4, R5 *) - Word1(2400H + 10); (* JZ L2 *) - Word1(5505H); (* ADD R5, R5 *) - Word1(0E335H); (* XOR #-1, R5 *) - Word1(5315H); (* ADD #1, R5 *) - Word1(5605H); (* ADD R6, R5 *) - Word1(4525H); (* MOV @R5, R5 *) - Word1(3C00H + 400H - 10); (* JMP L3 *) - (* L1: *) - Word1(9405H); (* CMP R4, R5 *) - Word1(2400H + 2); (* JZ L2 *) - Word1(4304H); (* MOV #0, R4 *) - Word1(4130H); (* RET *) - (* L2: *) - Word1(4314H); (* MOV #1, R4 *) - Word1(4130H) (* RET *) - END; - - (* _is (t, p: INTEGER): INTEGER *) - IF rtl[_is].used THEN - Label(rtl[_is].label); - Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *) - Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *) - Word1(9304H); (* TST R4 *) - Word1(2400H + 2); (* JZ L *) - Word2(4414H, -2); (* MOV -2(R4), R4 *) - (* L: *) - Word1(1204H); (* PUSH R4 *) - Word1(1205H); (* PUSH R5 *) - Call(rtl[_guardrec].label); (* CALL _guardrec *) - Word1(5221H); (* ADD #4, SP *) - Word1(4130H) (* RET *) - END; - - (* _guard (t, p: INTEGER): INTEGER *) - IF rtl[_guard].used THEN - Label(rtl[_guard].label); - Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *) - Word1(4314H); (* MOV #1, R4 *) - Word1(4525H); (* MOV @R5, R5 *) - Word1(9305H); (* TST R5 *) - Word1(2400H + 9); (* JZ L *) - Word2(4515H, -2); (* MOV -2(R5), R5 *) - Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *) - Word1(1205H); (* PUSH R5 *) - Word1(1204H); (* PUSH R4 *) - Call(rtl[_guardrec].label); (* CALL _guardrec *) - Word1(5221H); (* ADD #4, SP *) - (* L: *) - Word1(4130H) (* RET *) - END; - - (* _move (bytes, dest, source: INTEGER) *) - IF rtl[_move].used THEN - Label(rtl[_move].label); - Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *) - Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *) - Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *) - Word1(9306H); (* CMP #0, R6 *) - Word1(3800H + 6); (* JL L1 *) - Word1(2400H + 5); (* JZ L1 *) - (* L2: *) - Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *) - Word1(5317H); (* ADD #1, R7 *) - Word1(8316H); (* SUB #1, R6 *) - Word1(2000H + 400H - 5); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *) - IF rtl[_arrcpy].used THEN - Label(rtl[_arrcpy].label); - Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *) - Word1(3800H + 18); (* JL L1 *) - Word2(1211H, 12); (* PUSH 12(SP) *) - Word2(1211H, 10); (* PUSH 10(SP) *) - Word2(1211H, 14); (* PUSH 14(SP) *) - Word2(1211H, 10); (* PUSH 10(SP) *) - Call(rtl[_mul].label); (* CALL _mul *) - Word1(5221H); (* ADD #4, SP *) - Word1(1204H); (* PUSH R4 *) - Call(rtl[_move].label); (* CALL _move *) - Word2(5031H, 6); (* ADD #6, SP *) - Word1(4314H); (* MOV #1, R4 *) - Word1(4130H); (* RET *) - (* L1 *) - Word1(4304H); (* MOV #0, R4 *) - Word1(4130H) (* RET *) - END; - - (* _length (len, str: INTEGER): INTEGER *) - IF rtl[_length].used THEN - Label(rtl[_length].label); - Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *) - Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *) - Word1(4304H); (* MOV #0, R4; res := 0 *) - (* L2: *) - Word1(4775H); (* MOV.B @R7+, R5 *) - Word1(9305H); (* CMP #0, R5 *) - Word1(2400H + 3); (* JZ L1 *) - Word1(5314H); (* ADD #1, R4 *) - Word1(8316H); (* SUB #1, R6 *) - Word1(2000H + 400H - 6); (* JNZ L2 *) - (* L1: *) - Word1(4130H) (* RET *) - END; - - (* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *) - IF rtl[_strcmp].used THEN - Label(rtl[_strcmp].label); - Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) - Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) - Word1(9607H); (* CMP R6, R7 *) - Word1(3400H + 1); (* JGE L5 *) - Word1(4706H); (* MOV R7, R6 *) - (* L5: *) - Word1(1206H); (* PUSH R6 *) - Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *) - Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *) - (* L3: *) - Word2(9381H, 0); (* CMP #0, 0(SP) *) - Word1(2400H + 11); (* JZ L1 *) - Word1(4674H); (* MOV.B @R6+, R4 *) - Word1(4775H); (* MOV.B @R7+, R5 *) - Word2(8391H, 0); (* SUB #1, 0(SP) *) - Word1(9405H); (* CMP R4, R5 *) - Word1(2400H + 2); (* JZ L2 *) - Word1(8504H); (* SUB R5, R4 *) - Word1(3C00H + 5); (* JMP L4 *) - (* L2: *) - Word1(9304H); (* CMP #0, R4 *) - Word1(2000H + 400H - 13); (* JNZ L3 *) - Word1(3C00H + 2); (* JMP L4 *) - (* L1: *) - Word2(4034H, 8000H); (* MOV #8000H, R4 *) - (* L4: *) - Word1(5321H); (* ADD #2, SP *) - - Word2(9034H, 8000H); (* CMP #8000H, R4 *) - Word1(2000H + 18); (* JNZ L6 *) - Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) - Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) - Word1(9607H); (* CMP R6, R7 *) - Word1(2400H + 11); (* JZ L7 *) - Word1(3800H + 4); (* JL L8 *) - Word2(5116H, 10); (* ADD 10(SP), R6 *) - Word1(4664H); (* MOV.B @R6, R4 *) - Word1(3C00H + 7); (* JMP L6 *) - (* L8: *) - Word2(5117H, 6); (* ADD 6(SP), R7 *) - Word1(4764H); (* MOV.B @R7, R4 *) - Word1(0E334H); (* XOR #-1, R4 *) - Word1(5314H); (* ADD #1, R4 *) - Word1(3C00H + 1); (* JMP L6 *) - (* L7: *) - Word1(4304H); (* MOV #0, R4 *) - (* L6: *) - - Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(2400H + 1); (* JZ L *) - Word1(4304H); (* MOV #0, R4 *) - (* L *) - Word1(4130H); (* RET *) - Word1(4303H); (* NOP *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(2000H + 1); (* JNZ L *) - Word1(4304H); (* MOV #0, R4 *) - (* L *) - Word1(4130H); (* RET *) - Word1(4303H); (* NOP *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(3800H + 1); (* JL L *) - Word1(4304H); (* MOV #0, R4 *) - (* L *) - Word1(4130H); (* RET *) - Word1(4303H); (* NOP *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(3800H + 2); (* JL L *) - Word1(2400H + 1); (* JZ L *) - Word1(4304H); (* MOV #0, R4 *) - (* L *) - Word1(4130H); (* RET *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4304H); (* MOV #0, R4 *) - Word1(3800H + 2); (* JL L *) - Word1(2400H + 1); (* JZ L *) - Word1(4314H); (* MOV #1, R4 *) - (* L *) - Word1(4130H); (* RET *) - - Word1(9304H); (* CMP #0, R4 *) - Word1(4314H); (* MOV #1, R4 *) - Word1(3400H + 1); (* JGE L *) - Word1(4304H); (* MOV #0, R4 *) - (* L *) - Word1(4130H) (* RET *) - END - -END Gen; - - -PROCEDURE Set* (idx, label: INTEGER); -BEGIN - rtl[idx].label := label; - rtl[idx].used := FALSE -END Set; - - -PROCEDURE Used* (idx: INTEGER); -BEGIN - rtl[idx].used := TRUE; - IF (idx = _guard) OR (idx = _is) THEN - rtl[_guardrec].used := TRUE - ELSIF idx = _arrcpy THEN - rtl[_move].used := TRUE; - rtl[_mul].used := TRUE - END -END Used; - - -PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC); -BEGIN - Label := pLabel; - Word := pWord; - Call := pCall; - ram := 200H; -END Init; - - +(* + BSD 2-Clause License + + Copyright (c) 2019-2021, Anton Krotov + All rights reserved. +*) + +MODULE MSP430RTL; + + +CONST + + _mul* = 0; + _divmod* = 1; + _lsl* = 2; + _asr* = 3; + _ror* = 4; + _lsr* = 5; + _in* = 6; + _in2* = 7; + _set1* = 8; + _incl* = 9; + _excl* = 10; + _move* = 11; + _set* = 12; + _arrcpy* = 13; + _rot* = 14; + _strcmp* = 15; + _error* = 16; + _is* = 17; + _guard* = 18; + _guardrec* = 19; + _length* = 20; + _new* = 21; + + + HP* = 15; + + LenIV* = 32; + + iv = 10000H - LenIV * 2; + bsl = iv - 2; + sp = bsl - 2; + empty_proc* = sp - 2; + bits = empty_proc - 272; + bits_offs = bits - 32; + DataSize* = iv - bits_offs; + types = bits_offs - 2; + + IntVectorSize* = LenIV * 2 + DataSize; + + VarSize* = 4; + + StkReserve* = 40; + + trap = 2; + + +TYPE + + EMITPROC = PROCEDURE (n: INTEGER); + + +VAR + + ram*: INTEGER; + + rtl*: ARRAY 22 OF + RECORD + label*: INTEGER; + used: BOOLEAN + END; + + Label, Word, Call: EMITPROC; + + +PROCEDURE Gen*; + + + PROCEDURE Word1 (word: INTEGER); + BEGIN + Word(word) + END Word1; + + + PROCEDURE Word2 (word1, word2: INTEGER); + BEGIN + Word1(word1); + Word1(word2) + END Word2; + + + PROCEDURE Word3 (word1, word2, word3: INTEGER); + BEGIN + Word1(word1); + Word1(word2); + Word1(word3) + END Word3; + + +BEGIN + (* _lsl (n, x: INTEGER): INTEGER *) + IF rtl[_lsl].used THEN + Label(rtl[_lsl].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 3); (* JZ L1 *) + (* L2: *) + Word1(5404H); (* ADD R4, R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 3); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _asr (n, x: INTEGER): INTEGER *) + IF rtl[_asr].used THEN + Label(rtl[_asr].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 3); (* JZ L1 *) + (* L2: *) + Word1(1104H); (* RRA R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 3); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _ror (n, x: INTEGER): INTEGER *) + IF rtl[_ror].used THEN + Label(rtl[_ror].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 5); (* JZ L1 *) + Word1(4406H); (* MOV R4, R6 *) + (* L2: *) + Word1(1006H); (* RRC R6 *) + Word1(1004H); (* RRC R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 4); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _lsr (n, x: INTEGER): INTEGER *) + IF rtl[_lsr].used THEN + Label(rtl[_lsr].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- n *) + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- x *) + Word2(0F035H, 15); (* AND #15, R5 *) + Word1(2400H + 4); (* JZ L1 *) + (* L2: *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1004H); (* RRC R4 *) + Word1(8315H); (* SUB #1, R5 *) + Word1(2000H + 400H - 4); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _set (b, a: INTEGER): SET *) + IF rtl[_set].used THEN + Label(rtl[_set].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- b *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) + Word1(9504H); (* CMP R5, R4 *) + Word1(3800H + 24); (* JL L1 *) + Word2(9035H, 16); (* CMP #16, R5 *) + Word1(3400H + 21); (* JGE L1 *) + Word1(9304H); (* CMP #0, R4 *) + Word1(3800H + 19); (* JL L1 *) + Word2(9034H, 16); (* CMP #16, R4 *) + Word1(3800H + 2); (* JL L2 *) + Word2(4034H, 15); (* MOV #15, R4 *) + (* L2: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(3400H + 1); (* JGE L3 *) + Word1(4305H); (* MOV #0, R5 *) + (* L3: *) + Word1(8504H); (* SUB R5, R4 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits_offs); (* ADD bits_offs, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word1(5505H); (* ADD R5, R5 *) + Word1(5405H); (* ADD R4, R5 *) + Word2(5035H, bits); (* ADD bits, R5 *) + Word1(4524H); (* MOV @R5, R4 *) + Word1(4130H); (* RET *) + (* L1: *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _set1 (a: INTEGER): SET *) + IF rtl[_set1].used THEN + Label(rtl[_set1].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- a *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 5); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word1(4130H); (* RET *) + (* L1: *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _in2 (i, s: INTEGER): BOOLEAN *) + IF rtl[_in2].used THEN + Label(rtl[_in2].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- i *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(0F114H, 4); (* AND 4(SP), R4 *) + Word1(2400H + 1); (* JZ L1 *) + Word1(4314H); (* MOV #1, R4 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _in (s, i: INTEGER): BOOLEAN *) + IF rtl[_in].used THEN + Label(rtl[_in].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 9); (* JNZ L2 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(0F114H, 2); (* AND 2(SP), R4 *) + Word1(2400H + 3); (* JZ L1 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H); (* RET *) + (* L2: *) + Word1(4304H); (* MOV #0, R4 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _incl (VAR s: SET; i: INTEGER) *) + IF rtl[_incl].used THEN + Label(rtl[_incl].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 8); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) + Word2(0D485H, 0); (* BIS R4, 0(R5) *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _excl (VAR s: SET; i: INTEGER) *) + IF rtl[_excl].used THEN + Label(rtl[_excl].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- i *) + Word2(0B034H, 0FFF0H); (* BIT #0FFF0H, R4 *) + Word1(2000H + 8); (* JNZ L1 *) + Word1(5404H); (* ADD R4, R4 *) + Word2(5034H, bits); (* ADD bits, R4 *) + Word1(4424H); (* MOV @R4, R4 *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- @s *) + Word2(0C485H, 0); (* BIC R4, 0(R5) *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _rot (len, adr: INTEGER) *) + IF rtl[_rot].used THEN + Label(rtl[_rot].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- len *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- adr *) + Word1(8314H); (* SUB #1, R4 *) + Word1(5404H); (* ADD R4, R4 *) + Word1(1225H); (* PUSH @R5 *) + Word1(4406H); (* MOV R4, R6 *) + (* L1: *) + Word3(4595H, 2, 0); (* MOV 2(R5), 0(R5) *) + Word1(5325H); (* ADD #2, R5 *) + Word1(8326H); (* SUB #2, R6 *) + Word1(2000H + 400H - 6); (* JNZ L1 *) + Word2(41B5H, 0); (* MOV @SP+, 0(R5) *) + Word1(4130H) (* RET *) + END; + + (* _divmod (b, a: INTEGER): INTEGER (* res -> R4, mod -> R5 *) *) + IF rtl[_divmod].used THEN + Label(rtl[_divmod].label); + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- a *) + Word1(4304H); (* MOV #0, R4 *) + (* L1: *) + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 17); (* JL L3 *) + Word1(4327H); (* MOV #2, R7 *) + Word1(5606H); (* ADD R6, R6 *) + (* L4: *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 6); (* JZ L2 *) + Word1(3800H + 5); (* JL L2 *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 3); (* JL L2 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(5707H); (* ADD R7, R7 *) + Word1(3C00H + 400H - 8); (* JMP L4 *) + (* L2: *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1007H); (* RRC R7 *) + Word1(8605H); (* SUB R6, R5 *) + Word1(5704H); (* ADD R7, R4 *) + Word1(3C00H + 400H - 21); (* JMP L1 *) + (* L3: *) + (*----------- (a < 0) --------------*) + (* L1: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(3400H + 23); (* JGE L3 *) + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- b *) + Word1(4327H); (* MOV #2, R7 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + (* L4: *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 6); (* JZ L2 *) + Word1(3800H + 5); (* JL L2 *) + Word1(9605H); (* CMP R6, R5 *) + Word1(3800H + 3); (* JL L2 *) + Word1(5606H); (* ADD R6, R6 *) + Word1(5707H); (* ADD R7, R7 *) + Word1(3C00H + 400H - 8); (* JMP L4 *) + (* L2: *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1007H); (* RRC R7 *) + Word1(5605H); (* ADD R6, R5 *) + Word1(8704H); (* SUB R7, R4 *) + Word1(3C00H + 400H - 25); (* JMP L1 *) + (* L3: *) + Word1(4130H) (* RET *) + END; + + (* _mul (a, b: INTEGER): INTEGER *) + IF rtl[_mul].used THEN + Label(rtl[_mul].label); + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- a *) + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- b *) + Word1(4304H); (* MOV #0, R4; res := 0 *) + Word1(9306H); (* CMP #0, R6 *) + Word1(2400H + 7); (* JZ L1 *) + (* L2: *) + Word1(0B316H); (* BIT #1, R6 *) + Word1(2400H + 1); (* JZ L3 *) + Word1(5504H); (* ADD R5, R4 *) + (* L3: *) + Word1(5505H); (* ADD R5, R5 *) + Word1(0C312H); (* BIC #1, SR *) + Word1(1006H); (* RRC R6 *) + Word1(2000H + 400H - 7); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _error (modNum, modName, err, line: INTEGER) *) + IF rtl[_error].used THEN + Label(rtl[_error].label); + Word1(5321H); (* ADD #2, SP *) + Word1(4134H); (* POP R4; R4 <- modNum *) + Word1(4135H); (* POP R5; R5 <- modName *) + Word1(4136H); (* POP R6; R6 <- err *) + Word1(4137H); (* POP R7; R7 <- line *) + Word2(4211H, sp); (* MOV sp(SR), SP *) + Word1(1207H); (* PUSH R7 *) + Word1(1206H); (* PUSH R6 *) + Word1(1205H); (* PUSH R5 *) + Word1(1204H); (* PUSH R4 *) + Word2(4214H, sp); (* MOV sp(SR), R4 *) + Word2(1294H, trap); (* CALL trap(R4) *) + Word2(04032H, 0F0H) (* MOV CPUOFF+OSCOFF+SCG0+SCG1, SR *) + END; + + (* _new (t, size: INTEGER; VAR ptr: INTEGER) *) + IF rtl[_new].used THEN + Label(rtl[_new].label); + Word1(1202H); (* PUSH SR *) + Word1(4302H); (* MOV #0, SR *) + Word1(4303H); (* NOP *) + Word1(4104H); (* MOV SP, R4 *) + Word2(8034H, StkReserve); (* SUB #StkReserve, R4 *) + Word1(4005H + 100H * HP); (* MOV HP, R5 *) + Word2(5115H, 6); (* ADD 6(SP), R5 *) + Word1(9504H); (* CMP R5, R4 *) + Word2(4114H, 8); (* MOV 8(SP), R4 *) + Word1(3800H + 12); (* JL L1 *) + Word3(4190H + HP, 4, 0); (* MOV 4(SP), 0(HP) *) + Word1(5320H + HP); (* ADD #2, HP *) + Word2(4084H + 100H * HP, 0); (* MOV HP, 0(R4) *) + (* L3 *) + Word2(4380H + HP, 0); (* MOV #0, 0(HP) *) + Word1(5320H + HP); (* ADD #2, HP *) + Word1(9500H + HP); (* CMP R5, HP *) + Word1(3800H + 400H - 5); (* JL L3 *) + Word1(3C00H + 2); (* JMP L2 *) + (* L1 *) + Word2(4384H, 0); (* MOV #0, 0(R4) *) + (* L2 *) + Word1(1300H) (* RETI *) + END; + + (* _guardrec (t0, t1: INTEGER): INTEGER *) + IF rtl[_guardrec].used THEN + Label(rtl[_guardrec].label); + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t0 *) + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- t1 *) + Word2(4036H, types); (* MOV #types, R6 *) + (* L3: *) + Word1(9305H); (* CMP #0, R5 *) + Word1(2400H + 8); (* JZ L1 *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 10); (* JZ L2 *) + Word1(5505H); (* ADD R5, R5 *) + Word1(0E335H); (* XOR #-1, R5 *) + Word1(5315H); (* ADD #1, R5 *) + Word1(5605H); (* ADD R6, R5 *) + Word1(4525H); (* MOV @R5, R5 *) + Word1(3C00H + 400H - 10); (* JMP L3 *) + (* L1: *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 2); (* JZ L2 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H); (* RET *) + (* L2: *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H) (* RET *) + END; + + (* _is (t, p: INTEGER): INTEGER *) + IF rtl[_is].used THEN + Label(rtl[_is].label); + Word2(4114H, 4); (* MOV 4(SP), R4; R4 <- p *) + Word2(4115H, 2); (* MOV 2(SP), R5; R5 <- t *) + Word1(9304H); (* TST R4 *) + Word1(2400H + 2); (* JZ L *) + Word2(4414H, -2); (* MOV -2(R4), R4 *) + (* L: *) + Word1(1204H); (* PUSH R4 *) + Word1(1205H); (* PUSH R5 *) + Call(rtl[_guardrec].label); (* CALL _guardrec *) + Word1(5221H); (* ADD #4, SP *) + Word1(4130H) (* RET *) + END; + + (* _guard (t, p: INTEGER): INTEGER *) + IF rtl[_guard].used THEN + Label(rtl[_guard].label); + Word2(4115H, 4); (* MOV 4(SP), R5; R5 <- p *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4525H); (* MOV @R5, R5 *) + Word1(9305H); (* TST R5 *) + Word1(2400H + 9); (* JZ L *) + Word2(4515H, -2); (* MOV -2(R5), R5 *) + Word2(4114H, 2); (* MOV 2(SP), R4; R4 <- t *) + Word1(1205H); (* PUSH R5 *) + Word1(1204H); (* PUSH R4 *) + Call(rtl[_guardrec].label); (* CALL _guardrec *) + Word1(5221H); (* ADD #4, SP *) + (* L: *) + Word1(4130H) (* RET *) + END; + + (* _move (bytes, dest, source: INTEGER) *) + IF rtl[_move].used THEN + Label(rtl[_move].label); + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- bytes *) + Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- dest *) + Word2(4115H, 6); (* MOV 6(SP), R5; R5 <- source *) + Word1(9306H); (* CMP #0, R6 *) + Word1(3800H + 6); (* JL L1 *) + Word1(2400H + 5); (* JZ L1 *) + (* L2: *) + Word2(45F7H, 0); (* MOV.B @R5+, 0(R7) *) + Word1(5317H); (* ADD #1, R7 *) + Word1(8316H); (* SUB #1, R6 *) + Word1(2000H + 400H - 5); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _arrcpy (base_size, len_dst, dst, len_src, src: INTEGER) *) + IF rtl[_arrcpy].used THEN + Label(rtl[_arrcpy].label); + Word3(9191H, 8, 4); (* CMP 8(SP), 4(SP) *) + Word1(3800H + 18); (* JL L1 *) + Word2(1211H, 12); (* PUSH 12(SP) *) + Word2(1211H, 10); (* PUSH 10(SP) *) + Word2(1211H, 14); (* PUSH 14(SP) *) + Word2(1211H, 10); (* PUSH 10(SP) *) + Call(rtl[_mul].label); (* CALL _mul *) + Word1(5221H); (* ADD #4, SP *) + Word1(1204H); (* PUSH R4 *) + Call(rtl[_move].label); (* CALL _move *) + Word2(5031H, 6); (* ADD #6, SP *) + Word1(4314H); (* MOV #1, R4 *) + Word1(4130H); (* RET *) + (* L1 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(4130H) (* RET *) + END; + + (* _length (len, str: INTEGER): INTEGER *) + IF rtl[_length].used THEN + Label(rtl[_length].label); + Word2(4116H, 2); (* MOV 2(SP), R6; R6 <- len *) + Word2(4117H, 4); (* MOV 4(SP), R7; R7 <- str *) + Word1(4304H); (* MOV #0, R4; res := 0 *) + (* L2: *) + Word1(4775H); (* MOV.B @R7+, R5 *) + Word1(9305H); (* CMP #0, R5 *) + Word1(2400H + 3); (* JZ L1 *) + Word1(5314H); (* ADD #1, R4 *) + Word1(8316H); (* SUB #1, R6 *) + Word1(2000H + 400H - 6); (* JNZ L2 *) + (* L1: *) + Word1(4130H) (* RET *) + END; + + (* _strcmp (op, len2, str2, len1, str1: INTEGER): BOOLEAN *) + IF rtl[_strcmp].used THEN + Label(rtl[_strcmp].label); + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) + Word1(9607H); (* CMP R6, R7 *) + Word1(3400H + 1); (* JGE L5 *) + Word1(4706H); (* MOV R7, R6 *) + (* L5: *) + Word1(1206H); (* PUSH R6 *) + Word2(4116H, 12); (* MOV 12(SP), R6; R6 <- str1 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- str2 *) + (* L3: *) + Word2(9381H, 0); (* CMP #0, 0(SP) *) + Word1(2400H + 11); (* JZ L1 *) + Word1(4674H); (* MOV.B @R6+, R4 *) + Word1(4775H); (* MOV.B @R7+, R5 *) + Word2(8391H, 0); (* SUB #1, 0(SP) *) + Word1(9405H); (* CMP R4, R5 *) + Word1(2400H + 2); (* JZ L2 *) + Word1(8504H); (* SUB R5, R4 *) + Word1(3C00H + 5); (* JMP L4 *) + (* L2: *) + Word1(9304H); (* CMP #0, R4 *) + Word1(2000H + 400H - 13); (* JNZ L3 *) + Word1(3C00H + 2); (* JMP L4 *) + (* L1: *) + Word2(4034H, 8000H); (* MOV #8000H, R4 *) + (* L4: *) + Word1(5321H); (* ADD #2, SP *) + + Word2(9034H, 8000H); (* CMP #8000H, R4 *) + Word1(2000H + 18); (* JNZ L6 *) + Word2(4116H, 4); (* MOV 4(SP), R6; R6 <- len2 *) + Word2(4117H, 8); (* MOV 8(SP), R7; R7 <- len1 *) + Word1(9607H); (* CMP R6, R7 *) + Word1(2400H + 11); (* JZ L7 *) + Word1(3800H + 4); (* JL L8 *) + Word2(5116H, 10); (* ADD 10(SP), R6 *) + Word1(4664H); (* MOV.B @R6, R4 *) + Word1(3C00H + 7); (* JMP L6 *) + (* L8: *) + Word2(5117H, 6); (* ADD 6(SP), R7 *) + Word1(4764H); (* MOV.B @R7, R4 *) + Word1(0E334H); (* XOR #-1, R4 *) + Word1(5314H); (* ADD #1, R4 *) + Word1(3C00H + 1); (* JMP L6 *) + (* L7: *) + Word1(4304H); (* MOV #0, R4 *) + (* L6: *) + + Word2(5110H, 2); (* ADD 2(SP), PC; PC <- PC + op *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(2400H + 1); (* JZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(2000H + 1); (* JNZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3800H + 1); (* JL L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + Word1(4303H); (* NOP *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3800H + 2); (* JL L *) + Word1(2400H + 1); (* JZ L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H); (* RET *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4304H); (* MOV #0, R4 *) + Word1(3800H + 2); (* JL L *) + Word1(2400H + 1); (* JZ L *) + Word1(4314H); (* MOV #1, R4 *) + (* L *) + Word1(4130H); (* RET *) + + Word1(9304H); (* CMP #0, R4 *) + Word1(4314H); (* MOV #1, R4 *) + Word1(3400H + 1); (* JGE L *) + Word1(4304H); (* MOV #0, R4 *) + (* L *) + Word1(4130H) (* RET *) + END + +END Gen; + + +PROCEDURE Set* (idx, label: INTEGER); +BEGIN + rtl[idx].label := label; + rtl[idx].used := FALSE +END Set; + + +PROCEDURE Used* (idx: INTEGER); +BEGIN + rtl[idx].used := TRUE; + IF (idx = _guard) OR (idx = _is) THEN + rtl[_guardrec].used := TRUE + ELSIF idx = _arrcpy THEN + rtl[_move].used := TRUE; + rtl[_mul].used := TRUE + END +END Used; + + +PROCEDURE Init* (pLabel, pWord, pCall: EMITPROC); +BEGIN + Label := pLabel; + Word := pWord; + Call := pCall; + ram := 200H; +END Init; + + END MSP430RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/source/PROG.ob07 b/programs/develop/oberon07/source/PROG.ob07 index f2e3b6c46d..3374779cf9 100644 --- a/programs/develop/oberon07/source/PROG.ob07 +++ b/programs/develop/oberon07/source/PROG.ob07 @@ -71,7 +71,7 @@ TYPE OPTIONS* = RECORD - version*, stack*, ram*, rom*: INTEGER; + version*, stack*, ram*, rom*, tab*: INTEGER; pic*, lower*: BOOLEAN; checking*: SET diff --git a/programs/develop/oberon07/source/RVMxI.ob07 b/programs/develop/oberon07/source/RVMxI.ob07 index d9630221c8..e2d0139910 100644 --- a/programs/develop/oberon07/source/RVMxI.ob07 +++ b/programs/develop/oberon07/source/RVMxI.ob07 @@ -1,1428 +1,1428 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, Anton Krotov - All rights reserved. -*) - -MODULE RVMxI; - -IMPORT - - PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS; - - -CONST - - LTypes = 0; - LStrings = 1; - LGlobal = 2; - LHeap = 3; - LStack = 4; - - numGPRs = 3; - - R0 = 0; R1 = 1; - BP = 3; SP = 4; - - ACC = R0; - - GPRs = {0 .. 2} + {5 .. numGPRs + 1}; - - opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opNOP = 5; - opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11; - opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15; - opLDD = 16; (* 17, 18 *) - opJMP = 19; opCALL = 20; opCALLI = 21; - - opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32; - opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *) - opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54; - opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64; - - opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33; - opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *) - opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55; - opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65; - - opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69; - - opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75; - opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81; - - -VAR - - R: REG.REGS; count, szWord: INTEGER; - - ldr, str: PROCEDURE (r1, r2: INTEGER); - - -PROCEDURE OutByte (n: BYTE); -BEGIN - WR.WriteByte(n); - INC(count) -END OutByte; - - -PROCEDURE OutInt (n: INTEGER); -BEGIN - IF szWord = 8 THEN - WR.Write64LE(n); - INC(count, 8) - ELSE (* szWord = 4 *) - WR.Write32LE(n); - INC(count, 4) - END -END OutInt; - - -PROCEDURE Emit (op, par1, par2: INTEGER); -BEGIN - OutInt(op); - OutInt(par1); - OutInt(par2) -END Emit; - - -PROCEDURE drop; -BEGIN - REG.Drop(R) -END drop; - - -PROCEDURE GetAnyReg (): INTEGER; - RETURN REG.GetAnyReg(R) -END GetAnyReg; - - -PROCEDURE GetAcc; -BEGIN - ASSERT(REG.GetReg(R, ACC)) -END GetAcc; - - -PROCEDURE UnOp (VAR r: INTEGER); -BEGIN - REG.UnOp(R, r) -END UnOp; - - -PROCEDURE BinOp (VAR r1, r2: INTEGER); -BEGIN - REG.BinOp(R, r1, r2) -END BinOp; - - -PROCEDURE PushAll (NumberOfParameters: INTEGER); -BEGIN - REG.PushAll(R); - DEC(R.pushed, NumberOfParameters) -END PushAll; - - -PROCEDURE push (r: INTEGER); -BEGIN - Emit(opPUSH, r, 0) -END push; - - -PROCEDURE pop (r: INTEGER); -BEGIN - Emit(opPOP, r, 0) -END pop; - - -PROCEDURE mov (r1, r2: INTEGER); -BEGIN - Emit(opMOV, r1, r2) -END mov; - - -PROCEDURE xchg (r1, r2: INTEGER); -BEGIN - Emit(opXCHG, r1, r2) -END xchg; - - -PROCEDURE addrc (r, c: INTEGER); -BEGIN - Emit(opADDC, r, c) -END addrc; - - -PROCEDURE subrc (r, c: INTEGER); -BEGIN - Emit(opSUBC, r, c) -END subrc; - - -PROCEDURE movrc (r, c: INTEGER); -BEGIN - Emit(opMOVC, r, c) -END movrc; - - -PROCEDURE pushc (c: INTEGER); -BEGIN - Emit(opPUSHC, c, 0) -END pushc; - - -PROCEDURE add (r1, r2: INTEGER); -BEGIN - Emit(opADD, r1, r2) -END add; - - -PROCEDURE sub (r1, r2: INTEGER); -BEGIN - Emit(opSUB, r1, r2) -END sub; - - -PROCEDURE ldr64 (r1, r2: INTEGER); -BEGIN - Emit(opLDD, r2 * 256 + r1, 0) -END ldr64; - - -PROCEDURE ldr32 (r1, r2: INTEGER); -BEGIN - Emit(opLDW, r2 * 256 + r1, 0) -END ldr32; - - -PROCEDURE ldr16 (r1, r2: INTEGER); -BEGIN - Emit(opLDH, r2 * 256 + r1, 0) -END ldr16; - - -PROCEDURE ldr8 (r1, r2: INTEGER); -BEGIN - Emit(opLDB, r2 * 256 + r1, 0) -END ldr8; - - -PROCEDURE str64 (r1, r2: INTEGER); -BEGIN - Emit(opSTD, r1 * 256 + r2, 0) -END str64; - - -PROCEDURE str32 (r1, r2: INTEGER); -BEGIN - Emit(opSTW, r1 * 256 + r2, 0) -END str32; - - -PROCEDURE str16 (r1, r2: INTEGER); -BEGIN - Emit(opSTH, r1 * 256 + r2, 0) -END str16; - - -PROCEDURE str8 (r1, r2: INTEGER); -BEGIN - Emit(opSTB, r1 * 256 + r2, 0) -END str8; - - -PROCEDURE GlobalAdr (r, offset: INTEGER); -BEGIN - Emit(opLEA, r + 256 * LGlobal, offset) -END GlobalAdr; - - -PROCEDURE StrAdr (r, offset: INTEGER); -BEGIN - Emit(opLEA, r + 256 * LStrings, offset) -END StrAdr; - - -PROCEDURE ProcAdr (r, label: INTEGER); -BEGIN - Emit(opLLA, r, label) -END ProcAdr; - - -PROCEDURE jnz (r, label: INTEGER); -BEGIN - Emit(opCMPC, r, 0); - Emit(opJNE, label, 0) -END jnz; - - -PROCEDURE CallRTL (proc, par: INTEGER); -BEGIN - Emit(opCALL, IL.codes.rtl[proc], 0); - addrc(SP, par * szWord) -END CallRTL; - - -PROCEDURE jcc (cc: INTEGER): INTEGER; -BEGIN - CASE cc OF - |IL.opEQ, IL.opEQC: cc := opJEQ - |IL.opNE, IL.opNEC: cc := opJNE - |IL.opLT, IL.opLTC: cc := opJLT - |IL.opLE, IL.opLEC: cc := opJLE - |IL.opGT, IL.opGTC: cc := opJGT - |IL.opGE, IL.opGEC: cc := opJGE - END - RETURN cc -END jcc; - - -PROCEDURE shift1 (op, param: INTEGER); -VAR - r1, r2: INTEGER; - -BEGIN - r2 := GetAnyReg(); - Emit(opMOVC, r2, param); - BinOp(r1, r2); - Emit(op, r2, r1); - mov(r1, r2); - drop -END shift1; - - -PROCEDURE shift (op: INTEGER); -VAR - r1, r2: INTEGER; - -BEGIN - BinOp(r1, r2); - Emit(op, r1, r2); - drop -END shift; - - -PROCEDURE translate (szWord: INTEGER); -VAR - cmd, next: IL.COMMAND; - - opcode, param1, param2, r1, r2, r3, - a, b, label, opLD, opST, opSTC: INTEGER; - -BEGIN - IF szWord = 8 THEN - opLD := opLDD; - opST := opSTD; - opSTC := opSTDC - ELSE - opLD := opLDW; - opST := opSTW; - opSTC := opSTWC - END; - - cmd := IL.codes.commands.first(IL.COMMAND); - - WHILE cmd # NIL DO - - param1 := cmd.param1; - param2 := cmd.param2; - opcode := cmd.opcode; - - CASE opcode OF - - |IL.opJMP: - Emit(opJMP, param1, 0) - - |IL.opLABEL: - Emit(opLABEL, param1, 0) - - |IL.opCALL: - Emit(opCALL, param1, 0) - - |IL.opCALLP: - UnOp(r1); - Emit(opCALLI, r1, 0); - drop; - ASSERT(R.top = -1) - - |IL.opPUSHC: - pushc(param2) - - |IL.opCLEANUP: - IF param2 # 0 THEN - addrc(SP, param2 * szWord) - END - - |IL.opNOP, IL.opAND, IL.opOR: - - |IL.opSADR: - StrAdr(GetAnyReg(), param2) - - |IL.opGADR: - GlobalAdr(GetAnyReg(), param2) - - |IL.opLADR: - param2 := param2 * szWord; - next := cmd.next(IL.COMMAND); - IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN - UnOp(r1); - Emit(opSTD, BP * 256 + r1, param2); - drop; - cmd := next - ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN - UnOp(r1); - Emit(opSTW, BP * 256 + r1, param2); - drop; - cmd := next - ELSIF next.opcode = IL.opSAVE16 THEN - UnOp(r1); - Emit(opSTH, BP * 256 + r1, param2); - drop; - cmd := next - ELSIF next.opcode = IL.opSAVE8 THEN - UnOp(r1); - Emit(opSTB, BP * 256 + r1, param2); - drop; - cmd := next - ELSE - Emit(opADDRC, BP * 256 + GetAnyReg(), param2) - END - - |IL.opPARAM: - IF param2 = 1 THEN - UnOp(r1); - push(r1); - drop - ELSE - ASSERT(R.top + 1 <= param2); - PushAll(param2) - END - - |IL.opONERR: - pushc(param2); - Emit(opJMP, param1, 0) - - |IL.opPRECALL: - PushAll(0) - - |IL.opRES, IL.opRESF: - ASSERT(R.top = -1); - GetAcc - - |IL.opENTER: - ASSERT(R.top = -1); - Emit(opLABEL, param1, 0); - Emit(opENTER, param2, 0) - - |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: - IF opcode # IL.opLEAVE THEN - UnOp(r1); - IF r1 # ACC THEN - mov(ACC, r1) - END; - drop - END; - - ASSERT(R.top = -1); - - IF param1 > 0 THEN - mov(SP, BP) - END; - - pop(BP); - - Emit(opRET, 0, 0) - - |IL.opLEAVEC: - Emit(opRET, 0, 0) - - |IL.opCONST: - next := cmd.next(IL.COMMAND); - IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN - pushc(param2); - cmd := next - ELSE - movrc(GetAnyReg(), param2) - END - - |IL.opDROP: - UnOp(r1); - drop - - |IL.opSAVEC: - UnOp(r1); - Emit(opSTC, r1, param2); - drop - - |IL.opSAVE8C: - UnOp(r1); - Emit(opSTBC, r1, param2 MOD 256); - drop - - |IL.opSAVE16C: - UnOp(r1); - Emit(opSTHC, r1, param2 MOD 65536); - drop - - |IL.opSAVE, IL.opSAVEF: - BinOp(r2, r1); - str(r1, r2); - drop; - drop - - |IL.opSAVE32: - BinOp(r2, r1); - str32(r1, r2); - drop; - drop - - |IL.opSAVE64: - BinOp(r2, r1); - str64(r1, r2); - drop; - drop - - |IL.opSAVEFI: - BinOp(r2, r1); - str(r2, r1); - drop; - drop - - |IL.opSAVE8: - BinOp(r2, r1); - str8(r1, r2); - drop; - drop - - |IL.opSAVE16: - BinOp(r2, r1); - str16(r1, r2); - drop; - drop - - |IL.opGLOAD32: - r1 := GetAnyReg(); - GlobalAdr(r1, param2); - ldr32(r1, r1) - - |IL.opGLOAD64: - r1 := GetAnyReg(); - GlobalAdr(r1, param2); - ldr64(r1, r1) - - |IL.opVADR: - Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord) - - |IL.opLLOAD32: - Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord) - - |IL.opLLOAD64: - Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord) - - |IL.opVLOAD32: - r1 := GetAnyReg(); - Emit(opLD, BP * 256 + r1, param2 * szWord); - ldr32(r1, r1) - - |IL.opVLOAD64: - r1 := GetAnyReg(); - Emit(opLDD, BP * 256 + r1, param2 * szWord); - ldr64(r1, r1) - - |IL.opGLOAD16: - r1 := GetAnyReg(); - GlobalAdr(r1, param2); - ldr16(r1, r1) - - |IL.opLLOAD16: - Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord) - - |IL.opVLOAD16: - r1 := GetAnyReg(); - Emit(opLD, BP * 256 + r1, param2 * szWord); - ldr16(r1, r1) - - |IL.opGLOAD8: - r1 := GetAnyReg(); - GlobalAdr(r1, param2); - ldr8(r1, r1) - - |IL.opLLOAD8: - Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord) - - |IL.opVLOAD8: - r1 := GetAnyReg(); - Emit(opLD, BP * 256 + r1, param2 * szWord); - ldr8(r1, r1) - - |IL.opLOAD8: - UnOp(r1); - ldr8(r1, r1) - - |IL.opLOAD16: - UnOp(r1); - ldr16(r1, r1) - - |IL.opLOAD32: - UnOp(r1); - ldr32(r1, r1) - - |IL.opLOAD64: - UnOp(r1); - ldr64(r1, r1) - - |IL.opLOADF: - UnOp(r1); - ldr(r1, r1) - - |IL.opUMINUS: - UnOp(r1); - Emit(opNEG, r1, 0) - - |IL.opADD: - BinOp(r1, r2); - add(r1, r2); - drop - - |IL.opSUB: - BinOp(r1, r2); - sub(r1, r2); - drop - - |IL.opADDC: - UnOp(r1); - next := cmd.next(IL.COMMAND); - CASE next.opcode OF - |IL.opLOADF: - Emit(opLD, r1 * 256 + r1, param2); - cmd := next - |IL.opLOAD64: - Emit(opLDD, r1 * 256 + r1, param2); - cmd := next - |IL.opLOAD32: - Emit(opLDW, r1 * 256 + r1, param2); - cmd := next - |IL.opLOAD16: - Emit(opLDH, r1 * 256 + r1, param2); - cmd := next - |IL.opLOAD8: - Emit(opLDB, r1 * 256 + r1, param2); - cmd := next - ELSE - addrc(r1, param2) - END - - |IL.opSUBR: - UnOp(r1); - subrc(r1, param2) - - |IL.opSUBL: - UnOp(r1); - subrc(r1, param2); - Emit(opNEG, r1, 0) - - |IL.opMULC: - UnOp(r1); - Emit(opMULC, r1, param2) - - |IL.opMUL: - BinOp(r1, r2); - Emit(opMUL, r1, r2); - drop - - |IL.opDIV: - BinOp(r1, r2); - Emit(opDIV, r1, r2); - drop - - |IL.opMOD: - BinOp(r1, r2); - Emit(opMOD, r1, r2); - drop - - |IL.opDIVR: - UnOp(r1); - Emit(opDIVC, r1, param2) - - |IL.opMODR: - UnOp(r1); - Emit(opMODC, r1, param2) - - |IL.opDIVL: - UnOp(r1); - r2 := GetAnyReg(); - movrc(r2, param2); - Emit(opDIV, r2, r1); - mov(r1, r2); - drop - - |IL.opMODL: - UnOp(r1); - r2 := GetAnyReg(); - movrc(r2, param2); - Emit(opMOD, r2, r1); - mov(r1, r2); - drop - - |IL.opEQ .. IL.opGE, IL.opEQC .. IL.opGEC: - IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN - BinOp(r1, r2); - Emit(opCMP, r1, r2); - drop - ELSE - UnOp(r1); - Emit(opCMPC, r1, param2) - END; - next := cmd.next(IL.COMMAND); - IF next.opcode = IL.opJZ THEN - Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0); - cmd := next; - drop - ELSIF next.opcode = IL.opJNZ THEN - Emit(jcc(opcode), next.param1, 0); - cmd := next; - drop - ELSE - Emit(jcc(opcode) + 6, r1, 0) - END - - |IL.opJNZ1: - UnOp(r1); - jnz(r1, param1) - - |IL.opJG: - UnOp(r1); - Emit(opCMPC, r1, 0); - Emit(opJGT, param1, 0) - - |IL.opJNZ: - UnOp(r1); - jnz(r1, param1); - drop - - |IL.opJZ: - UnOp(r1); - Emit(opCMPC, r1, 0); - Emit(opJEQ, param1, 0); - drop - - |IL.opMULS: - BinOp(r1, r2); - Emit(opAND, r1, r2); - drop - - |IL.opMULSC: - UnOp(r1); - Emit(opANDC, r1, param2) - - |IL.opDIVS: - BinOp(r1, r2); - Emit(opXOR, r1, r2); - drop - - |IL.opDIVSC: - UnOp(r1); - Emit(opXORC, r1, param2) - - |IL.opADDS: - BinOp(r1, r2); - Emit(opOR, r1, r2); - drop - - |IL.opSUBS: - BinOp(r1, r2); - Emit(opNOT, r2, 0); - Emit(opAND, r1, r2); - drop - - |IL.opADDSC: - UnOp(r1); - Emit(opORC, r1, param2) - - |IL.opSUBSL: - UnOp(r1); - Emit(opNOT, r1, 0); - Emit(opANDC, r1, param2) - - |IL.opSUBSR: - UnOp(r1); - Emit(opANDC, r1, ORD(-BITS(param2))) - - |IL.opUMINS: - UnOp(r1); - Emit(opNOT, r1, 0) - - |IL.opASR: - shift(opASR) - - |IL.opLSL: - shift(opLSL) - - |IL.opROR: - shift(opROR) - - |IL.opLSR: - shift(opLSR) - - |IL.opASR1: - shift1(opASR, param2) - - |IL.opLSL1: - shift1(opLSL, param2) - - |IL.opROR1: - shift1(opROR, param2) - - |IL.opLSR1: - shift1(opLSR, param2) - - |IL.opASR2: - UnOp(r1); - Emit(opASRC, r1, param2 MOD (szWord * 8)) - - |IL.opLSL2: - UnOp(r1); - Emit(opLSLC, r1, param2 MOD (szWord * 8)) - - |IL.opROR2: - UnOp(r1); - Emit(opRORC, r1, param2 MOD (szWord * 8)) - - |IL.opLSR2: - UnOp(r1); - Emit(opLSRC, r1, param2 MOD (szWord * 8)) - - |IL.opCHR: - UnOp(r1); - Emit(opANDC, r1, 255) - - |IL.opWCHR: - UnOp(r1); - Emit(opANDC, r1, 65535) - - |IL.opABS: - UnOp(r1); - Emit(opCMPC, r1, 0); - label := IL.NewLabel(); - Emit(opJGE, label, 0); - Emit(opNEG, r1, 0); - Emit(opLABEL, label, 0) - - |IL.opLEN: - UnOp(r1); - drop; - EXCL(R.regs, r1); - - WHILE param2 > 0 DO - UnOp(r2); - drop; - DEC(param2) - END; - - INCL(R.regs, r1); - ASSERT(REG.GetReg(R, r1)) - - |IL.opSWITCH: - UnOp(r1); - IF param2 = 0 THEN - r2 := ACC - ELSE - r2 := R1 - END; - IF r1 # r2 THEN - ASSERT(REG.GetReg(R, r2)); - ASSERT(REG.Exchange(R, r1, r2)); - drop - END; - drop - - |IL.opENDSW: - - |IL.opCASEL: - Emit(opCMPC, ACC, param1); - Emit(opJLT, param2, 0) - - |IL.opCASER: - Emit(opCMPC, ACC, param1); - Emit(opJGT, param2, 0) - - |IL.opCASELR: - Emit(opCMPC, ACC, param1); - IF param2 = cmd.param3 THEN - Emit(opJNE, param2, 0) - ELSE - Emit(opJLT, param2, 0); - Emit(opJGT, cmd.param3, 0) - END - - |IL.opSBOOL: - BinOp(r2, r1); - Emit(opCMPC, r2, 0); - Emit(opSNE, r2, 0); - str8(r1, r2); - drop; - drop - - |IL.opSBOOLC: - UnOp(r1); - Emit(opSTBC, r1, ORD(param2 # 0)); - drop - - |IL.opINCC: - UnOp(r1); - r2 := GetAnyReg(); - ldr(r2, r1); - addrc(r2, param2); - str(r1, r2); - drop; - drop - - |IL.opINCCB, IL.opDECCB: - IF opcode = IL.opDECCB THEN - param2 := -param2 - END; - UnOp(r1); - r2 := GetAnyReg(); - ldr8(r2, r1); - addrc(r2, param2); - str8(r1, r2); - drop; - drop - - |IL.opINCB, IL.opDECB: - BinOp(r2, r1); - r3 := GetAnyReg(); - ldr8(r3, r1); - IF opcode = IL.opINCB THEN - add(r3, r2) - ELSE - sub(r3, r2) - END; - str8(r1, r3); - drop; - drop; - drop - - |IL.opINC, IL.opDEC: - BinOp(r2, r1); - r3 := GetAnyReg(); - ldr(r3, r1); - IF opcode = IL.opINC THEN - add(r3, r2) - ELSE - sub(r3, r2) - END; - str(r1, r3); - drop; - drop; - drop - - |IL.opINCL, IL.opEXCL: - BinOp(r2, r1); - Emit(opBIT, r2, r2); - r3 := GetAnyReg(); - ldr(r3, r1); - IF opcode = IL.opINCL THEN - Emit(opOR, r3, r2) - ELSE - Emit(opNOT, r2, 0); - Emit(opAND, r3, r2) - END; - str(r1, r3); - drop; - drop; - drop - - |IL.opINCLC, IL.opEXCLC: - UnOp(r1); - r2 := GetAnyReg(); - ldr(r2, r1); - IF opcode = IL.opINCLC THEN - Emit(opORC, r2, ORD({param2})) - ELSE - Emit(opANDC, r2, ORD(-{param2})) - END; - str(r1, r2); - drop; - drop - - |IL.opEQB, IL.opNEB: - BinOp(r1, r2); - Emit(opCMPC, r1, 0); - Emit(opSNE, r1, 0); - Emit(opCMPC, r2, 0); - Emit(opSNE, r2, 0); - Emit(opCMP, r1, r2); - IF opcode = IL.opEQB THEN - Emit(opSEQ, r1, 0) - ELSE - Emit(opSNE, r1, 0) - END; - drop - - |IL.opCHKBYTE: - BinOp(r1, r2); - Emit(opCMPC, r1, 256); - Emit(opJBT, param1, 0) - - |IL.opCHKIDX: - UnOp(r1); - Emit(opCMPC, r1, param2); - Emit(opJBT, param1, 0) - - |IL.opCHKIDX2: - BinOp(r1, r2); - IF param2 # -1 THEN - Emit(opCMP, r2, r1); - Emit(opJBT, param1, 0) - END; - INCL(R.regs, r1); - DEC(R.top); - R.stk[R.top] := r2 - - |IL.opEQP, IL.opNEP: - ProcAdr(GetAnyReg(), param1); - BinOp(r1, r2); - Emit(opCMP, r1, r2); - IF opcode = IL.opEQP THEN - Emit(opSEQ, r1, 0) - ELSE - Emit(opSNE, r1, 0) - END; - drop - - |IL.opSAVEP: - UnOp(r1); - r2 := GetAnyReg(); - ProcAdr(r2, param2); - str(r1, r2); - drop; - drop - - |IL.opPUSHP: - ProcAdr(GetAnyReg(), param2) - - |IL.opPUSHT: - UnOp(r1); - Emit(opLD, r1 * 256 + GetAnyReg(), -szWord) - - |IL.opGET, IL.opGETC: - IF opcode = IL.opGET THEN - BinOp(r1, r2) - ELSIF opcode = IL.opGETC THEN - UnOp(r2); - r1 := GetAnyReg(); - movrc(r1, param1) - END; - drop; - drop; - - CASE param2 OF - |1: ldr8(r1, r1); str8(r2, r1) - |2: ldr16(r1, r1); str16(r2, r1) - |4: ldr32(r1, r1); str32(r2, r1) - |8: ldr64(r1, r1); str64(r2, r1) - END - - |IL.opNOT: - UnOp(r1); - Emit(opCMPC, r1, 0); - Emit(opSEQ, r1, 0) - - |IL.opORD: - UnOp(r1); - Emit(opCMPC, r1, 0); - Emit(opSNE, r1, 0) - - |IL.opMIN, IL.opMAX: - BinOp(r1, r2); - Emit(opCMP, r1, r2); - label := IL.NewLabel(); - IF opcode = IL.opMIN THEN - Emit(opJLE, label, 0) - ELSE - Emit(opJGE, label, 0) - END; - Emit(opMOV, r1, r2); - Emit(opLABEL, label, 0); - drop - - |IL.opMINC, IL.opMAXC: - UnOp(r1); - Emit(opCMPC, r1, param2); - label := IL.NewLabel(); - IF opcode = IL.opMINC THEN - Emit(opJLE, label, 0) - ELSE - Emit(opJGE, label, 0) - END; - Emit(opMOVC, r1, param2); - Emit(opLABEL, label, 0) - - |IL.opIN: - BinOp(r1, r2); - Emit(opBIT, r1, r1); - Emit(opAND, r1, r2); - Emit(opCMPC, r1, 0); - Emit(opSNE, r1, 0); - drop - - |IL.opINL: - UnOp(r1); - Emit(opANDC, r1, ORD({param2})); - Emit(opCMPC, r1, 0); - Emit(opSNE, r1, 0) - - |IL.opINR: - UnOp(r1); - Emit(opBIT, r1, r1); - Emit(opANDC, r1, param2); - Emit(opCMPC, r1, 0); - Emit(opSNE, r1, 0) - - |IL.opERR: - CallRTL(IL._error, 4) - - |IL.opEQS .. IL.opGES: - PushAll(4); - pushc(opcode - IL.opEQS); - CallRTL(IL._strcmp, 5); - GetAcc - - |IL.opEQSW .. IL.opGESW: - PushAll(4); - pushc(opcode - IL.opEQSW); - CallRTL(IL._strcmpw, 5); - GetAcc - - |IL.opCOPY: - PushAll(2); - pushc(param2); - CallRTL(IL._move, 3) - - |IL.opMOVE: - PushAll(3); - CallRTL(IL._move, 3) - - |IL.opCOPYA: - PushAll(4); - pushc(param2); - CallRTL(IL._arrcpy, 5); - GetAcc - - |IL.opCOPYS: - PushAll(4); - pushc(param2); - CallRTL(IL._strcpy, 5) - - |IL.opROT: - PushAll(0); - mov(ACC, SP); - push(ACC); - pushc(param2); - CallRTL(IL._rot, 2) - - |IL.opLENGTH: - PushAll(2); - CallRTL(IL._length, 2); - GetAcc - - |IL.opLENGTHW: - PushAll(2); - CallRTL(IL._lengthw, 2); - GetAcc - - |IL.opSAVES: - UnOp(r2); - REG.PushAll_1(R); - r1 := GetAnyReg(); - StrAdr(r1, param2); - push(r1); - drop; - push(r2); - drop; - pushc(param1); - CallRTL(IL._move, 3) - - |IL.opRSET: - PushAll(2); - CallRTL(IL._set, 2); - GetAcc - - |IL.opRSETR: - PushAll(1); - pushc(param2); - CallRTL(IL._set, 2); - GetAcc - - |IL.opRSETL: - UnOp(r1); - REG.PushAll_1(R); - pushc(param2); - push(r1); - drop; - CallRTL(IL._set, 2); - GetAcc - - |IL.opRSET1: - PushAll(1); - CallRTL(IL._set1, 1); - GetAcc - - |IL.opNEW: - PushAll(1); - INC(param2, szWord); - ASSERT(UTILS.Align(param2, szWord)); - pushc(param2); - pushc(param1); - CallRTL(IL._new, 3) - - |IL.opTYPEGP: - UnOp(r1); - PushAll(0); - push(r1); - pushc(param2); - CallRTL(IL._guard, 2); - GetAcc - - |IL.opIS: - PushAll(1); - pushc(param2); - CallRTL(IL._is, 2); - GetAcc - - |IL.opISREC: - PushAll(2); - pushc(param2); - CallRTL(IL._guardrec, 3); - GetAcc - - |IL.opTYPEGR: - PushAll(1); - pushc(param2); - CallRTL(IL._guardrec, 2); - GetAcc - - |IL.opTYPEGD: - UnOp(r1); - PushAll(0); - subrc(r1, szWord); - ldr(r1, r1); - push(r1); - pushc(param2); - CallRTL(IL._guardrec, 2); - GetAcc - - |IL.opCASET: - push(R1); - push(R1); - pushc(param2); - CallRTL(IL._guardrec, 2); - pop(R1); - jnz(ACC, param1) - - |IL.opCONSTF: - IF szWord = 8 THEN - movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b)) - ELSE (* szWord = 4 *) - movrc(GetAnyReg(), UTILS.d2s(cmd.float)) - END - - |IL.opMULF: - PushAll(2); - CallRTL(IL._fmul, 2); - GetAcc - - |IL.opDIVF: - PushAll(2); - CallRTL(IL._fdiv, 2); - GetAcc - - |IL.opDIVFI: - PushAll(2); - CallRTL(IL._fdivi, 2); - GetAcc - - |IL.opADDF: - PushAll(2); - CallRTL(IL._fadd, 2); - GetAcc - - |IL.opSUBFI: - PushAll(2); - CallRTL(IL._fsubi, 2); - GetAcc - - |IL.opSUBF: - PushAll(2); - CallRTL(IL._fsub, 2); - GetAcc - - |IL.opEQF..IL.opGEF: - PushAll(2); - pushc(opcode - IL.opEQF); - CallRTL(IL._fcmp, 3); - GetAcc - - |IL.opFLOOR: - PushAll(1); - CallRTL(IL._floor, 1); - GetAcc - - |IL.opFLT: - PushAll(1); - CallRTL(IL._flt, 1); - GetAcc - - |IL.opUMINF: - UnOp(r1); - Emit(opRORC, r1, -1); - Emit(opXORC, r1, 1); - Emit(opRORC, r1, 1) - - |IL.opFABS: - UnOp(r1); - Emit(opLSLC, r1, 1); - Emit(opLSRC, r1, 1) - - |IL.opINF: - r1 := GetAnyReg(); - Emit(opMOVC, r1, 1); - Emit(opRORC, r1, 1); - Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8)); - Emit(opLSRC, r1, 1) - - |IL.opPUSHF: - UnOp(r1); - push(r1); - drop - - |IL.opPACK: - PushAll(2); - CallRTL(IL._pack, 2) - - |IL.opPACKC: - PushAll(1); - pushc(param2); - CallRTL(IL._pack, 2) - - |IL.opUNPK: - PushAll(2); - CallRTL(IL._unpk, 2) - - |IL.opCODE: - OutInt(param2) - - |IL.opLADR_SAVE: - UnOp(r1); - Emit(opST, BP * 256 + r1, param2 * szWord); - drop - - |IL.opLADR_INCC: - r1 := GetAnyReg(); - Emit(opLD, BP * 256 + r1, param1 * szWord); - Emit(opADDC, r1, param2); - Emit(opST, BP * 256 + r1, param1 * szWord); - drop - - END; - - cmd := cmd.next(IL.COMMAND) - END; - - ASSERT(R.pushed = 0); - ASSERT(R.top = -1) -END translate; - - -PROCEDURE prolog; -BEGIN - Emit(opLEA, SP + LStack * 256, 0); - Emit(opLEA, ACC + LTypes * 256, 0); - push(ACC); - Emit(opLEA, ACC + LHeap * 256, 0); - push(ACC); - pushc(CHL.Length(IL.codes.types)); - CallRTL(IL._init, 3) -END prolog; - - -PROCEDURE epilog (ram, szWord: INTEGER); -VAR - tcount, dcount, i, offTypes, offStrings, - szData, szGlobal, szHeapStack: INTEGER; - -BEGIN - Emit(opSTOP, 0, 0); - - offTypes := count; - - tcount := CHL.Length(IL.codes.types); - FOR i := 0 TO tcount - 1 DO - OutInt(CHL.GetInt(IL.codes.types, i)) - END; - - offStrings := count; - dcount := CHL.Length(IL.codes.data); - FOR i := 0 TO dcount - 1 DO - OutByte(CHL.GetByte(IL.codes.data, i)) - END; - - IF dcount MOD szWord # 0 THEN - i := szWord - dcount MOD szWord; - WHILE i > 0 DO - OutByte(0); - DEC(i) - END - END; - - szData := count - offTypes; - szGlobal := (IL.codes.bss DIV szWord + 1) * szWord; - szHeapStack := ram - szData - szGlobal; - - OutInt(offTypes); - OutInt(offStrings); - OutInt(szGlobal DIV szWord); - OutInt(szHeapStack DIV szWord); - FOR i := 1 TO 8 DO - OutInt(0) - END -END epilog; - - -PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); -CONST - minRAM = 32*1024; - maxRAM = 256*1024; - -VAR - szData, szRAM: INTEGER; - -BEGIN - szWord := TARGETS.WordSize; - IF szWord = 8 THEN - ldr := ldr64; - str := str64 - ELSE - ldr := ldr32; - str := str32 - END; - szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord; - szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024; - - IF szRAM - szData < 1024*1024 THEN - ERRORS.Error(208) - END; - - count := 0; - WR.Create(outname); - - REG.Init(R, push, pop, mov, xchg, GPRs); - - prolog; - translate(szWord); - epilog(szRAM, szWord); - - WR.Close -END CodeGen; - - +(* + BSD 2-Clause License + + Copyright (c) 2020-2021, Anton Krotov + All rights reserved. +*) + +MODULE RVMxI; + +IMPORT + + PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS; + + +CONST + + LTypes = 0; + LStrings = 1; + LGlobal = 2; + LHeap = 3; + LStack = 4; + + numGPRs = 3; + + R0 = 0; R1 = 1; + BP = 3; SP = 4; + + ACC = R0; + + GPRs = {0 .. 2} + {5 .. numGPRs + 1}; + + opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opNOP = 5; + opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11; + opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15; + opLDD = 16; (* 17, 18 *) + opJMP = 19; opCALL = 20; opCALLI = 21; + + opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32; + opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *) + opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54; + opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64; + + opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33; + opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *) + opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55; + opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65; + + opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69; + + opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75; + opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81; + + +VAR + + R: REG.REGS; count, szWord: INTEGER; + + ldr, str: PROCEDURE (r1, r2: INTEGER); + + +PROCEDURE OutByte (n: BYTE); +BEGIN + WR.WriteByte(n); + INC(count) +END OutByte; + + +PROCEDURE OutInt (n: INTEGER); +BEGIN + IF szWord = 8 THEN + WR.Write64LE(n); + INC(count, 8) + ELSE (* szWord = 4 *) + WR.Write32LE(n); + INC(count, 4) + END +END OutInt; + + +PROCEDURE Emit (op, par1, par2: INTEGER); +BEGIN + OutInt(op); + OutInt(par1); + OutInt(par2) +END Emit; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE GetAcc; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetAcc; + + +PROCEDURE UnOp (VAR r: INTEGER); +BEGIN + REG.UnOp(R, r) +END UnOp; + + +PROCEDURE BinOp (VAR r1, r2: INTEGER); +BEGIN + REG.BinOp(R, r1, r2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE push (r: INTEGER); +BEGIN + Emit(opPUSH, r, 0) +END push; + + +PROCEDURE pop (r: INTEGER); +BEGIN + Emit(opPOP, r, 0) +END pop; + + +PROCEDURE mov (r1, r2: INTEGER); +BEGIN + Emit(opMOV, r1, r2) +END mov; + + +PROCEDURE xchg (r1, r2: INTEGER); +BEGIN + Emit(opXCHG, r1, r2) +END xchg; + + +PROCEDURE addrc (r, c: INTEGER); +BEGIN + Emit(opADDC, r, c) +END addrc; + + +PROCEDURE subrc (r, c: INTEGER); +BEGIN + Emit(opSUBC, r, c) +END subrc; + + +PROCEDURE movrc (r, c: INTEGER); +BEGIN + Emit(opMOVC, r, c) +END movrc; + + +PROCEDURE pushc (c: INTEGER); +BEGIN + Emit(opPUSHC, c, 0) +END pushc; + + +PROCEDURE add (r1, r2: INTEGER); +BEGIN + Emit(opADD, r1, r2) +END add; + + +PROCEDURE sub (r1, r2: INTEGER); +BEGIN + Emit(opSUB, r1, r2) +END sub; + + +PROCEDURE ldr64 (r1, r2: INTEGER); +BEGIN + Emit(opLDD, r2 * 256 + r1, 0) +END ldr64; + + +PROCEDURE ldr32 (r1, r2: INTEGER); +BEGIN + Emit(opLDW, r2 * 256 + r1, 0) +END ldr32; + + +PROCEDURE ldr16 (r1, r2: INTEGER); +BEGIN + Emit(opLDH, r2 * 256 + r1, 0) +END ldr16; + + +PROCEDURE ldr8 (r1, r2: INTEGER); +BEGIN + Emit(opLDB, r2 * 256 + r1, 0) +END ldr8; + + +PROCEDURE str64 (r1, r2: INTEGER); +BEGIN + Emit(opSTD, r1 * 256 + r2, 0) +END str64; + + +PROCEDURE str32 (r1, r2: INTEGER); +BEGIN + Emit(opSTW, r1 * 256 + r2, 0) +END str32; + + +PROCEDURE str16 (r1, r2: INTEGER); +BEGIN + Emit(opSTH, r1 * 256 + r2, 0) +END str16; + + +PROCEDURE str8 (r1, r2: INTEGER); +BEGIN + Emit(opSTB, r1 * 256 + r2, 0) +END str8; + + +PROCEDURE GlobalAdr (r, offset: INTEGER); +BEGIN + Emit(opLEA, r + 256 * LGlobal, offset) +END GlobalAdr; + + +PROCEDURE StrAdr (r, offset: INTEGER); +BEGIN + Emit(opLEA, r + 256 * LStrings, offset) +END StrAdr; + + +PROCEDURE ProcAdr (r, label: INTEGER); +BEGIN + Emit(opLLA, r, label) +END ProcAdr; + + +PROCEDURE jnz (r, label: INTEGER); +BEGIN + Emit(opCMPC, r, 0); + Emit(opJNE, label, 0) +END jnz; + + +PROCEDURE CallRTL (proc, par: INTEGER); +BEGIN + Emit(opCALL, IL.codes.rtl[proc], 0); + addrc(SP, par * szWord) +END CallRTL; + + +PROCEDURE jcc (cc: INTEGER): INTEGER; +BEGIN + CASE cc OF + |IL.opEQ, IL.opEQC: cc := opJEQ + |IL.opNE, IL.opNEC: cc := opJNE + |IL.opLT, IL.opLTC: cc := opJLT + |IL.opLE, IL.opLEC: cc := opJLE + |IL.opGT, IL.opGTC: cc := opJGT + |IL.opGE, IL.opGEC: cc := opJGE + END + RETURN cc +END jcc; + + +PROCEDURE shift1 (op, param: INTEGER); +VAR + r1, r2: INTEGER; + +BEGIN + r2 := GetAnyReg(); + Emit(opMOVC, r2, param); + BinOp(r1, r2); + Emit(op, r2, r1); + mov(r1, r2); + drop +END shift1; + + +PROCEDURE shift (op: INTEGER); +VAR + r1, r2: INTEGER; + +BEGIN + BinOp(r1, r2); + Emit(op, r1, r2); + drop +END shift; + + +PROCEDURE translate (szWord: INTEGER); +VAR + cmd, next: IL.COMMAND; + + opcode, param1, param2, r1, r2, r3, + a, b, label, opLD, opST, opSTC: INTEGER; + +BEGIN + IF szWord = 8 THEN + opLD := opLDD; + opST := opSTD; + opSTC := opSTDC + ELSE + opLD := opLDW; + opST := opSTW; + opSTC := opSTWC + END; + + cmd := IL.codes.commands.first(IL.COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + opcode := cmd.opcode; + + CASE opcode OF + + |IL.opJMP: + Emit(opJMP, param1, 0) + + |IL.opLABEL: + Emit(opLABEL, param1, 0) + + |IL.opCALL: + Emit(opCALL, param1, 0) + + |IL.opCALLP: + UnOp(r1); + Emit(opCALLI, r1, 0); + drop; + ASSERT(R.top = -1) + + |IL.opPUSHC: + pushc(param2) + + |IL.opCLEANUP: + IF param2 # 0 THEN + addrc(SP, param2 * szWord) + END + + |IL.opNOP, IL.opAND, IL.opOR: + + |IL.opSADR: + StrAdr(GetAnyReg(), param2) + + |IL.opGADR: + GlobalAdr(GetAnyReg(), param2) + + |IL.opLADR: + param2 := param2 * szWord; + next := cmd.next(IL.COMMAND); + IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN + UnOp(r1); + Emit(opSTD, BP * 256 + r1, param2); + drop; + cmd := next + ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN + UnOp(r1); + Emit(opSTW, BP * 256 + r1, param2); + drop; + cmd := next + ELSIF next.opcode = IL.opSAVE16 THEN + UnOp(r1); + Emit(opSTH, BP * 256 + r1, param2); + drop; + cmd := next + ELSIF next.opcode = IL.opSAVE8 THEN + UnOp(r1); + Emit(opSTB, BP * 256 + r1, param2); + drop; + cmd := next + ELSE + Emit(opADDRC, BP * 256 + GetAnyReg(), param2) + END + + |IL.opPARAM: + IF param2 = 1 THEN + UnOp(r1); + push(r1); + drop + ELSE + ASSERT(R.top + 1 <= param2); + PushAll(param2) + END + + |IL.opONERR: + pushc(param2); + Emit(opJMP, param1, 0) + + |IL.opPRECALL: + PushAll(0) + + |IL.opRES, IL.opRESF: + ASSERT(R.top = -1); + GetAcc + + |IL.opENTER: + ASSERT(R.top = -1); + Emit(opLABEL, param1, 0); + Emit(opENTER, param2, 0) + + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode # IL.opLEAVE THEN + UnOp(r1); + IF r1 # ACC THEN + mov(ACC, r1) + END; + drop + END; + + ASSERT(R.top = -1); + + IF param1 > 0 THEN + mov(SP, BP) + END; + + pop(BP); + + Emit(opRET, 0, 0) + + |IL.opLEAVEC: + Emit(opRET, 0, 0) + + |IL.opCONST: + next := cmd.next(IL.COMMAND); + IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN + pushc(param2); + cmd := next + ELSE + movrc(GetAnyReg(), param2) + END + + |IL.opDROP: + UnOp(r1); + drop + + |IL.opSAVEC: + UnOp(r1); + Emit(opSTC, r1, param2); + drop + + |IL.opSAVE8C: + UnOp(r1); + Emit(opSTBC, r1, param2 MOD 256); + drop + + |IL.opSAVE16C: + UnOp(r1); + Emit(opSTHC, r1, param2 MOD 65536); + drop + + |IL.opSAVE, IL.opSAVEF: + BinOp(r2, r1); + str(r1, r2); + drop; + drop + + |IL.opSAVE32: + BinOp(r2, r1); + str32(r1, r2); + drop; + drop + + |IL.opSAVE64: + BinOp(r2, r1); + str64(r1, r2); + drop; + drop + + |IL.opSAVEFI: + BinOp(r2, r1); + str(r2, r1); + drop; + drop + + |IL.opSAVE8: + BinOp(r2, r1); + str8(r1, r2); + drop; + drop + + |IL.opSAVE16: + BinOp(r2, r1); + str16(r1, r2); + drop; + drop + + |IL.opGLOAD32: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr32(r1, r1) + + |IL.opGLOAD64: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr64(r1, r1) + + |IL.opVADR: + Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord) + + |IL.opLLOAD32: + Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord) + + |IL.opLLOAD64: + Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord) + + |IL.opVLOAD32: + r1 := GetAnyReg(); + Emit(opLD, BP * 256 + r1, param2 * szWord); + ldr32(r1, r1) + + |IL.opVLOAD64: + r1 := GetAnyReg(); + Emit(opLDD, BP * 256 + r1, param2 * szWord); + ldr64(r1, r1) + + |IL.opGLOAD16: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr16(r1, r1) + + |IL.opLLOAD16: + Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord) + + |IL.opVLOAD16: + r1 := GetAnyReg(); + Emit(opLD, BP * 256 + r1, param2 * szWord); + ldr16(r1, r1) + + |IL.opGLOAD8: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr8(r1, r1) + + |IL.opLLOAD8: + Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord) + + |IL.opVLOAD8: + r1 := GetAnyReg(); + Emit(opLD, BP * 256 + r1, param2 * szWord); + ldr8(r1, r1) + + |IL.opLOAD8: + UnOp(r1); + ldr8(r1, r1) + + |IL.opLOAD16: + UnOp(r1); + ldr16(r1, r1) + + |IL.opLOAD32: + UnOp(r1); + ldr32(r1, r1) + + |IL.opLOAD64: + UnOp(r1); + ldr64(r1, r1) + + |IL.opLOADF: + UnOp(r1); + ldr(r1, r1) + + |IL.opUMINUS: + UnOp(r1); + Emit(opNEG, r1, 0) + + |IL.opADD: + BinOp(r1, r2); + add(r1, r2); + drop + + |IL.opSUB: + BinOp(r1, r2); + sub(r1, r2); + drop + + |IL.opADDC: + UnOp(r1); + next := cmd.next(IL.COMMAND); + CASE next.opcode OF + |IL.opLOADF: + Emit(opLD, r1 * 256 + r1, param2); + cmd := next + |IL.opLOAD64: + Emit(opLDD, r1 * 256 + r1, param2); + cmd := next + |IL.opLOAD32: + Emit(opLDW, r1 * 256 + r1, param2); + cmd := next + |IL.opLOAD16: + Emit(opLDH, r1 * 256 + r1, param2); + cmd := next + |IL.opLOAD8: + Emit(opLDB, r1 * 256 + r1, param2); + cmd := next + ELSE + addrc(r1, param2) + END + + |IL.opSUBR: + UnOp(r1); + subrc(r1, param2) + + |IL.opSUBL: + UnOp(r1); + subrc(r1, param2); + Emit(opNEG, r1, 0) + + |IL.opMULC: + UnOp(r1); + Emit(opMULC, r1, param2) + + |IL.opMUL: + BinOp(r1, r2); + Emit(opMUL, r1, r2); + drop + + |IL.opDIV: + BinOp(r1, r2); + Emit(opDIV, r1, r2); + drop + + |IL.opMOD: + BinOp(r1, r2); + Emit(opMOD, r1, r2); + drop + + |IL.opDIVR: + UnOp(r1); + Emit(opDIVC, r1, param2) + + |IL.opMODR: + UnOp(r1); + Emit(opMODC, r1, param2) + + |IL.opDIVL: + UnOp(r1); + r2 := GetAnyReg(); + movrc(r2, param2); + Emit(opDIV, r2, r1); + mov(r1, r2); + drop + + |IL.opMODL: + UnOp(r1); + r2 := GetAnyReg(); + movrc(r2, param2); + Emit(opMOD, r2, r1); + mov(r1, r2); + drop + + |IL.opEQ .. IL.opGE, IL.opEQC .. IL.opGEC: + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(r1, r2); + Emit(opCMP, r1, r2); + drop + ELSE + UnOp(r1); + Emit(opCMPC, r1, param2) + END; + next := cmd.next(IL.COMMAND); + IF next.opcode = IL.opJZ THEN + Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0); + cmd := next; + drop + ELSIF next.opcode = IL.opJNZ THEN + Emit(jcc(opcode), next.param1, 0); + cmd := next; + drop + ELSE + Emit(jcc(opcode) + 6, r1, 0) + END + + |IL.opJNZ1: + UnOp(r1); + jnz(r1, param1) + + |IL.opJG: + UnOp(r1); + Emit(opCMPC, r1, 0); + Emit(opJGT, param1, 0) + + |IL.opJNZ: + UnOp(r1); + jnz(r1, param1); + drop + + |IL.opJZ: + UnOp(r1); + Emit(opCMPC, r1, 0); + Emit(opJEQ, param1, 0); + drop + + |IL.opMULS: + BinOp(r1, r2); + Emit(opAND, r1, r2); + drop + + |IL.opMULSC: + UnOp(r1); + Emit(opANDC, r1, param2) + + |IL.opDIVS: + BinOp(r1, r2); + Emit(opXOR, r1, r2); + drop + + |IL.opDIVSC: + UnOp(r1); + Emit(opXORC, r1, param2) + + |IL.opADDS: + BinOp(r1, r2); + Emit(opOR, r1, r2); + drop + + |IL.opSUBS: + BinOp(r1, r2); + Emit(opNOT, r2, 0); + Emit(opAND, r1, r2); + drop + + |IL.opADDSC: + UnOp(r1); + Emit(opORC, r1, param2) + + |IL.opSUBSL: + UnOp(r1); + Emit(opNOT, r1, 0); + Emit(opANDC, r1, param2) + + |IL.opSUBSR: + UnOp(r1); + Emit(opANDC, r1, ORD(-BITS(param2))) + + |IL.opUMINS: + UnOp(r1); + Emit(opNOT, r1, 0) + + |IL.opASR: + shift(opASR) + + |IL.opLSL: + shift(opLSL) + + |IL.opROR: + shift(opROR) + + |IL.opLSR: + shift(opLSR) + + |IL.opASR1: + shift1(opASR, param2) + + |IL.opLSL1: + shift1(opLSL, param2) + + |IL.opROR1: + shift1(opROR, param2) + + |IL.opLSR1: + shift1(opLSR, param2) + + |IL.opASR2: + UnOp(r1); + Emit(opASRC, r1, param2 MOD (szWord * 8)) + + |IL.opLSL2: + UnOp(r1); + Emit(opLSLC, r1, param2 MOD (szWord * 8)) + + |IL.opROR2: + UnOp(r1); + Emit(opRORC, r1, param2 MOD (szWord * 8)) + + |IL.opLSR2: + UnOp(r1); + Emit(opLSRC, r1, param2 MOD (szWord * 8)) + + |IL.opCHR: + UnOp(r1); + Emit(opANDC, r1, 255) + + |IL.opWCHR: + UnOp(r1); + Emit(opANDC, r1, 65535) + + |IL.opABS: + UnOp(r1); + Emit(opCMPC, r1, 0); + label := IL.NewLabel(); + Emit(opJGE, label, 0); + Emit(opNEG, r1, 0); + Emit(opLABEL, label, 0) + + |IL.opLEN: + UnOp(r1); + drop; + EXCL(R.regs, r1); + + WHILE param2 > 0 DO + UnOp(r2); + drop; + DEC(param2) + END; + + INCL(R.regs, r1); + ASSERT(REG.GetReg(R, r1)) + + |IL.opSWITCH: + UnOp(r1); + IF param2 = 0 THEN + r2 := ACC + ELSE + r2 := R1 + END; + IF r1 # r2 THEN + ASSERT(REG.GetReg(R, r2)); + ASSERT(REG.Exchange(R, r1, r2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + Emit(opCMPC, ACC, param1); + Emit(opJLT, param2, 0) + + |IL.opCASER: + Emit(opCMPC, ACC, param1); + Emit(opJGT, param2, 0) + + |IL.opCASELR: + Emit(opCMPC, ACC, param1); + IF param2 = cmd.param3 THEN + Emit(opJNE, param2, 0) + ELSE + Emit(opJLT, param2, 0); + Emit(opJGT, cmd.param3, 0) + END + + |IL.opSBOOL: + BinOp(r2, r1); + Emit(opCMPC, r2, 0); + Emit(opSNE, r2, 0); + str8(r1, r2); + drop; + drop + + |IL.opSBOOLC: + UnOp(r1); + Emit(opSTBC, r1, ORD(param2 # 0)); + drop + + |IL.opINCC: + UnOp(r1); + r2 := GetAnyReg(); + ldr(r2, r1); + addrc(r2, param2); + str(r1, r2); + drop; + drop + + |IL.opINCCB, IL.opDECCB: + IF opcode = IL.opDECCB THEN + param2 := -param2 + END; + UnOp(r1); + r2 := GetAnyReg(); + ldr8(r2, r1); + addrc(r2, param2); + str8(r1, r2); + drop; + drop + + |IL.opINCB, IL.opDECB: + BinOp(r2, r1); + r3 := GetAnyReg(); + ldr8(r3, r1); + IF opcode = IL.opINCB THEN + add(r3, r2) + ELSE + sub(r3, r2) + END; + str8(r1, r3); + drop; + drop; + drop + + |IL.opINC, IL.opDEC: + BinOp(r2, r1); + r3 := GetAnyReg(); + ldr(r3, r1); + IF opcode = IL.opINC THEN + add(r3, r2) + ELSE + sub(r3, r2) + END; + str(r1, r3); + drop; + drop; + drop + + |IL.opINCL, IL.opEXCL: + BinOp(r2, r1); + Emit(opBIT, r2, r2); + r3 := GetAnyReg(); + ldr(r3, r1); + IF opcode = IL.opINCL THEN + Emit(opOR, r3, r2) + ELSE + Emit(opNOT, r2, 0); + Emit(opAND, r3, r2) + END; + str(r1, r3); + drop; + drop; + drop + + |IL.opINCLC, IL.opEXCLC: + UnOp(r1); + r2 := GetAnyReg(); + ldr(r2, r1); + IF opcode = IL.opINCLC THEN + Emit(opORC, r2, ORD({param2})) + ELSE + Emit(opANDC, r2, ORD(-{param2})) + END; + str(r1, r2); + drop; + drop + + |IL.opEQB, IL.opNEB: + BinOp(r1, r2); + Emit(opCMPC, r1, 0); + Emit(opSNE, r1, 0); + Emit(opCMPC, r2, 0); + Emit(opSNE, r2, 0); + Emit(opCMP, r1, r2); + IF opcode = IL.opEQB THEN + Emit(opSEQ, r1, 0) + ELSE + Emit(opSNE, r1, 0) + END; + drop + + |IL.opCHKBYTE: + BinOp(r1, r2); + Emit(opCMPC, r1, 256); + Emit(opJBT, param1, 0) + + |IL.opCHKIDX: + UnOp(r1); + Emit(opCMPC, r1, param2); + Emit(opJBT, param1, 0) + + |IL.opCHKIDX2: + BinOp(r1, r2); + IF param2 # -1 THEN + Emit(opCMP, r2, r1); + Emit(opJBT, param1, 0) + END; + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opEQP, IL.opNEP: + ProcAdr(GetAnyReg(), param1); + BinOp(r1, r2); + Emit(opCMP, r1, r2); + IF opcode = IL.opEQP THEN + Emit(opSEQ, r1, 0) + ELSE + Emit(opSNE, r1, 0) + END; + drop + + |IL.opSAVEP: + UnOp(r1); + r2 := GetAnyReg(); + ProcAdr(r2, param2); + str(r1, r2); + drop; + drop + + |IL.opPUSHP: + ProcAdr(GetAnyReg(), param2) + + |IL.opPUSHT: + UnOp(r1); + Emit(opLD, r1 * 256 + GetAnyReg(), -szWord) + + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(r1, r2) + ELSIF opcode = IL.opGETC THEN + UnOp(r2); + r1 := GetAnyReg(); + movrc(r1, param1) + END; + drop; + drop; + + CASE param2 OF + |1: ldr8(r1, r1); str8(r2, r1) + |2: ldr16(r1, r1); str16(r2, r1) + |4: ldr32(r1, r1); str32(r2, r1) + |8: ldr64(r1, r1); str64(r2, r1) + END + + |IL.opNOT: + UnOp(r1); + Emit(opCMPC, r1, 0); + Emit(opSEQ, r1, 0) + + |IL.opORD: + UnOp(r1); + Emit(opCMPC, r1, 0); + Emit(opSNE, r1, 0) + + |IL.opMIN, IL.opMAX: + BinOp(r1, r2); + Emit(opCMP, r1, r2); + label := IL.NewLabel(); + IF opcode = IL.opMIN THEN + Emit(opJLE, label, 0) + ELSE + Emit(opJGE, label, 0) + END; + Emit(opMOV, r1, r2); + Emit(opLABEL, label, 0); + drop + + |IL.opMINC, IL.opMAXC: + UnOp(r1); + Emit(opCMPC, r1, param2); + label := IL.NewLabel(); + IF opcode = IL.opMINC THEN + Emit(opJLE, label, 0) + ELSE + Emit(opJGE, label, 0) + END; + Emit(opMOVC, r1, param2); + Emit(opLABEL, label, 0) + + |IL.opIN: + BinOp(r1, r2); + Emit(opBIT, r1, r1); + Emit(opAND, r1, r2); + Emit(opCMPC, r1, 0); + Emit(opSNE, r1, 0); + drop + + |IL.opINL: + UnOp(r1); + Emit(opANDC, r1, ORD({param2})); + Emit(opCMPC, r1, 0); + Emit(opSNE, r1, 0) + + |IL.opINR: + UnOp(r1); + Emit(opBIT, r1, r1); + Emit(opANDC, r1, param2); + Emit(opCMPC, r1, 0); + Emit(opSNE, r1, 0) + + |IL.opERR: + CallRTL(IL._error, 4) + + |IL.opEQS .. IL.opGES: + PushAll(4); + pushc(opcode - IL.opEQS); + CallRTL(IL._strcmp, 5); + GetAcc + + |IL.opEQSW .. IL.opGESW: + PushAll(4); + pushc(opcode - IL.opEQSW); + CallRTL(IL._strcmpw, 5); + GetAcc + + |IL.opCOPY: + PushAll(2); + pushc(param2); + CallRTL(IL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(IL._move, 3) + + |IL.opCOPYA: + PushAll(4); + pushc(param2); + CallRTL(IL._arrcpy, 5); + GetAcc + + |IL.opCOPYS: + PushAll(4); + pushc(param2); + CallRTL(IL._strcpy, 5) + + |IL.opROT: + PushAll(0); + mov(ACC, SP); + push(ACC); + pushc(param2); + CallRTL(IL._rot, 2) + + |IL.opLENGTH: + PushAll(2); + CallRTL(IL._length, 2); + GetAcc + + |IL.opLENGTHW: + PushAll(2); + CallRTL(IL._lengthw, 2); + GetAcc + + |IL.opSAVES: + UnOp(r2); + REG.PushAll_1(R); + r1 := GetAnyReg(); + StrAdr(r1, param2); + push(r1); + drop; + push(r2); + drop; + pushc(param1); + CallRTL(IL._move, 3) + + |IL.opRSET: + PushAll(2); + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSETR: + PushAll(1); + pushc(param2); + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSETL: + UnOp(r1); + REG.PushAll_1(R); + pushc(param2); + push(r1); + drop; + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSET1: + PushAll(1); + CallRTL(IL._set1, 1); + GetAcc + + |IL.opNEW: + PushAll(1); + INC(param2, szWord); + ASSERT(UTILS.Align(param2, szWord)); + pushc(param2); + pushc(param1); + CallRTL(IL._new, 3) + + |IL.opTYPEGP: + UnOp(r1); + PushAll(0); + push(r1); + pushc(param2); + CallRTL(IL._guard, 2); + GetAcc + + |IL.opIS: + PushAll(1); + pushc(param2); + CallRTL(IL._is, 2); + GetAcc + + |IL.opISREC: + PushAll(2); + pushc(param2); + CallRTL(IL._guardrec, 3); + GetAcc + + |IL.opTYPEGR: + PushAll(1); + pushc(param2); + CallRTL(IL._guardrec, 2); + GetAcc + + |IL.opTYPEGD: + UnOp(r1); + PushAll(0); + subrc(r1, szWord); + ldr(r1, r1); + push(r1); + pushc(param2); + CallRTL(IL._guardrec, 2); + GetAcc + + |IL.opCASET: + push(R1); + push(R1); + pushc(param2); + CallRTL(IL._guardrec, 2); + pop(R1); + jnz(ACC, param1) + + |IL.opCONSTF: + IF szWord = 8 THEN + movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b)) + ELSE (* szWord = 4 *) + movrc(GetAnyReg(), UTILS.d2s(cmd.float)) + END + + |IL.opMULF: + PushAll(2); + CallRTL(IL._fmul, 2); + GetAcc + + |IL.opDIVF: + PushAll(2); + CallRTL(IL._fdiv, 2); + GetAcc + + |IL.opDIVFI: + PushAll(2); + CallRTL(IL._fdivi, 2); + GetAcc + + |IL.opADDF: + PushAll(2); + CallRTL(IL._fadd, 2); + GetAcc + + |IL.opSUBFI: + PushAll(2); + CallRTL(IL._fsubi, 2); + GetAcc + + |IL.opSUBF: + PushAll(2); + CallRTL(IL._fsub, 2); + GetAcc + + |IL.opEQF..IL.opGEF: + PushAll(2); + pushc(opcode - IL.opEQF); + CallRTL(IL._fcmp, 3); + GetAcc + + |IL.opFLOOR: + PushAll(1); + CallRTL(IL._floor, 1); + GetAcc + + |IL.opFLT: + PushAll(1); + CallRTL(IL._flt, 1); + GetAcc + + |IL.opUMINF: + UnOp(r1); + Emit(opRORC, r1, -1); + Emit(opXORC, r1, 1); + Emit(opRORC, r1, 1) + + |IL.opFABS: + UnOp(r1); + Emit(opLSLC, r1, 1); + Emit(opLSRC, r1, 1) + + |IL.opINF: + r1 := GetAnyReg(); + Emit(opMOVC, r1, 1); + Emit(opRORC, r1, 1); + Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8)); + Emit(opLSRC, r1, 1) + + |IL.opPUSHF: + UnOp(r1); + push(r1); + drop + + |IL.opPACK: + PushAll(2); + CallRTL(IL._pack, 2) + + |IL.opPACKC: + PushAll(1); + pushc(param2); + CallRTL(IL._pack, 2) + + |IL.opUNPK: + PushAll(2); + CallRTL(IL._unpk, 2) + + |IL.opCODE: + OutInt(param2) + + |IL.opLADR_SAVE: + UnOp(r1); + Emit(opST, BP * 256 + r1, param2 * szWord); + drop + + |IL.opLADR_INCC: + r1 := GetAnyReg(); + Emit(opLD, BP * 256 + r1, param1 * szWord); + Emit(opADDC, r1, param2); + Emit(opST, BP * 256 + r1, param1 * szWord); + drop + + END; + + cmd := cmd.next(IL.COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog; +BEGIN + Emit(opLEA, SP + LStack * 256, 0); + Emit(opLEA, ACC + LTypes * 256, 0); + push(ACC); + Emit(opLEA, ACC + LHeap * 256, 0); + push(ACC); + pushc(CHL.Length(IL.codes.types)); + CallRTL(IL._init, 3) +END prolog; + + +PROCEDURE epilog (ram, szWord: INTEGER); +VAR + tcount, dcount, i, offTypes, offStrings, + szData, szGlobal, szHeapStack: INTEGER; + +BEGIN + Emit(opSTOP, 0, 0); + + offTypes := count; + + tcount := CHL.Length(IL.codes.types); + FOR i := 0 TO tcount - 1 DO + OutInt(CHL.GetInt(IL.codes.types, i)) + END; + + offStrings := count; + dcount := CHL.Length(IL.codes.data); + FOR i := 0 TO dcount - 1 DO + OutByte(CHL.GetByte(IL.codes.data, i)) + END; + + IF dcount MOD szWord # 0 THEN + i := szWord - dcount MOD szWord; + WHILE i > 0 DO + OutByte(0); + DEC(i) + END + END; + + szData := count - offTypes; + szGlobal := (IL.codes.bss DIV szWord + 1) * szWord; + szHeapStack := ram - szData - szGlobal; + + OutInt(offTypes); + OutInt(offStrings); + OutInt(szGlobal DIV szWord); + OutInt(szHeapStack DIV szWord); + FOR i := 1 TO 8 DO + OutInt(0) + END +END epilog; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +CONST + minRAM = 32*1024; + maxRAM = 256*1024; + +VAR + szData, szRAM: INTEGER; + +BEGIN + szWord := TARGETS.WordSize; + IF szWord = 8 THEN + ldr := ldr64; + str := str64 + ELSE + ldr := ldr32; + str := str32 + END; + szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord; + szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024; + + IF szRAM - szData < 1024*1024 THEN + ERRORS.Error(208) + END; + + count := 0; + WR.Create(outname); + + REG.Init(R, push, pop, mov, xchg, GPRs); + + prolog; + translate(szWord); + epilog(szRAM, szWord); + + WR.Close +END CodeGen; + + END RVMxI. \ No newline at end of file diff --git a/programs/develop/oberon07/source/TARGETS.ob07 b/programs/develop/oberon07/source/TARGETS.ob07 index 0b87e5838d..a9006e944d 100644 --- a/programs/develop/oberon07/source/TARGETS.ob07 +++ b/programs/develop/oberon07/source/TARGETS.ob07 @@ -1,153 +1,153 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, Anton Krotov - All rights reserved. -*) - -MODULE TARGETS; - -IMPORT UTILS; - - -CONST - - MSP430* = 0; - Win32C* = 1; - Win32GUI* = 2; - Win32DLL* = 3; - KolibriOS* = 4; - KolibriOSDLL* = 5; - Win64C* = 6; - Win64GUI* = 7; - Win64DLL* = 8; - Linux32* = 9; - Linux32SO* = 10; - Linux64* = 11; - Linux64SO* = 12; - STM32CM3* = 13; - RVM32I* = 14; - RVM64I* = 15; - - cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3; - cpuRVM32I* = 4; cpuRVM64I* = 5; - - osNONE* = 0; osWIN32* = 1; osWIN64* = 2; - osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5; - - noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I}; - - noRTL = {MSP430}; - - libRVM32I = "RVMxI" + UTILS.slash + "32"; - libRVM64I = "RVMxI" + UTILS.slash + "64"; - - -TYPE - - STRING = ARRAY 32 OF CHAR; - - TARGET = RECORD - - target, CPU, OS, RealSize: INTEGER; - ComLinePar*, LibDir, FileExt: STRING - - END; - - -VAR - - Targets*: ARRAY 16 OF TARGET; - - CPUs: ARRAY 6 OF - RECORD - BitDepth, InstrSize: INTEGER; - LittleEndian: BOOLEAN - END; - - target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER; - ComLinePar*, LibDir*, FileExt*: STRING; - Import*, Dispose*, RTL*, Dll*, LittleEndian*: BOOLEAN; - - -PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); -BEGIN - Targets[idx].target := idx; - Targets[idx].CPU := CPU; - Targets[idx].RealSize := RealSize; - Targets[idx].OS := OS; - Targets[idx].ComLinePar := ComLinePar; - Targets[idx].LibDir := LibDir; - Targets[idx].FileExt := FileExt; -END Enter; - - -PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN; -VAR - i: INTEGER; - res: BOOLEAN; - -BEGIN - i := 0; - WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO - INC(i) - END; - - res := i < LEN(Targets); - IF res THEN - target := Targets[i].target; - CPU := Targets[i].CPU; - BitDepth := CPUs[CPU].BitDepth; - InstrSize := CPUs[CPU].InstrSize; - LittleEndian := CPUs[CPU].LittleEndian; - RealSize := Targets[i].RealSize; - OS := Targets[i].OS; - ComLinePar := Targets[i].ComLinePar; - LibDir := Targets[i].LibDir; - FileExt := Targets[i].FileExt; - - Import := OS IN {osWIN32, osWIN64, osKOS}; - Dispose := ~(target IN noDISPOSE); - RTL := ~(target IN noRTL); - Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; - WordSize := BitDepth DIV 8; - AdrSize := WordSize - END - - RETURN res -END Select; - - -PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN); -BEGIN - CPUs[cpu].BitDepth := BitDepth; - CPUs[cpu].InstrSize := InstrSize; - CPUs[cpu].LittleEndian := LittleEndian -END EnterCPU; - - -BEGIN - EnterCPU(cpuX86, 32, 1, TRUE); - EnterCPU(cpuAMD64, 64, 1, TRUE); - EnterCPU(cpuMSP430, 16, 2, TRUE); - EnterCPU(cpuTHUMB, 32, 2, TRUE); - EnterCPU(cpuRVM32I, 32, 4, TRUE); - EnterCPU(cpuRVM64I, 64, 8, TRUE); - - Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex"); - Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows", ".exe"); - Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows", ".exe"); - Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows", ".dll"); - Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", ""); - Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj"); - Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows", ".exe"); - Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows", ".exe"); - Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows", ".dll"); - Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux", ""); - Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux", ".so"); - Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux", ""); - Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux", ".so"); - Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); - Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", libRVM32I, ".bin"); - Enter( RVM64I, cpuRVM64I, 8, osNONE, "rvm64i", libRVM64I, ".bin"); +(* + BSD 2-Clause License + + Copyright (c) 2019-2021, Anton Krotov + All rights reserved. +*) + +MODULE TARGETS; + +IMPORT UTILS; + + +CONST + + MSP430* = 0; + Win32C* = 1; + Win32GUI* = 2; + Win32DLL* = 3; + KolibriOS* = 4; + KolibriOSDLL* = 5; + Win64C* = 6; + Win64GUI* = 7; + Win64DLL* = 8; + Linux32* = 9; + Linux32SO* = 10; + Linux64* = 11; + Linux64SO* = 12; + STM32CM3* = 13; + RVM32I* = 14; + RVM64I* = 15; + + cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3; + cpuRVM32I* = 4; cpuRVM64I* = 5; + + osNONE* = 0; osWIN32* = 1; osWIN64* = 2; + osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5; + + noDISPOSE = {MSP430, STM32CM3, RVM32I, RVM64I}; + + noRTL = {MSP430}; + + libRVM32I = "RVMxI" + UTILS.slash + "32"; + libRVM64I = "RVMxI" + UTILS.slash + "64"; + + +TYPE + + STRING = ARRAY 32 OF CHAR; + + TARGET = RECORD + + target, CPU, OS, RealSize: INTEGER; + ComLinePar*, LibDir, FileExt: STRING + + END; + + +VAR + + Targets*: ARRAY 16 OF TARGET; + + CPUs: ARRAY 6 OF + RECORD + BitDepth, InstrSize: INTEGER; + LittleEndian: BOOLEAN + END; + + target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER; + ComLinePar*, LibDir*, FileExt*: STRING; + Import*, Dispose*, RTL*, Dll*, LittleEndian*: BOOLEAN; + + +PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); +BEGIN + Targets[idx].target := idx; + Targets[idx].CPU := CPU; + Targets[idx].RealSize := RealSize; + Targets[idx].OS := OS; + Targets[idx].ComLinePar := ComLinePar; + Targets[idx].LibDir := LibDir; + Targets[idx].FileExt := FileExt; +END Enter; + + +PROCEDURE Select* (ComLineParam: ARRAY OF CHAR): BOOLEAN; +VAR + i: INTEGER; + res: BOOLEAN; + +BEGIN + i := 0; + WHILE (i < LEN(Targets)) & (Targets[i].ComLinePar # ComLineParam) DO + INC(i) + END; + + res := i < LEN(Targets); + IF res THEN + target := Targets[i].target; + CPU := Targets[i].CPU; + BitDepth := CPUs[CPU].BitDepth; + InstrSize := CPUs[CPU].InstrSize; + LittleEndian := CPUs[CPU].LittleEndian; + RealSize := Targets[i].RealSize; + OS := Targets[i].OS; + ComLinePar := Targets[i].ComLinePar; + LibDir := Targets[i].LibDir; + FileExt := Targets[i].FileExt; + + Import := OS IN {osWIN32, osWIN64, osKOS}; + Dispose := ~(target IN noDISPOSE); + RTL := ~(target IN noRTL); + Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; + WordSize := BitDepth DIV 8; + AdrSize := WordSize + END + + RETURN res +END Select; + + +PROCEDURE EnterCPU (cpu, BitDepth, InstrSize: INTEGER; LittleEndian: BOOLEAN); +BEGIN + CPUs[cpu].BitDepth := BitDepth; + CPUs[cpu].InstrSize := InstrSize; + CPUs[cpu].LittleEndian := LittleEndian +END EnterCPU; + + +BEGIN + EnterCPU(cpuX86, 32, 1, TRUE); + EnterCPU(cpuAMD64, 64, 1, TRUE); + EnterCPU(cpuMSP430, 16, 2, TRUE); + EnterCPU(cpuTHUMB, 32, 2, TRUE); + EnterCPU(cpuRVM32I, 32, 4, TRUE); + EnterCPU(cpuRVM64I, 64, 8, TRUE); + + Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex"); + Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows", ".exe"); + Enter( Win32GUI, cpuX86, 8, osWIN32, "win32gui", "Windows", ".exe"); + Enter( Win32DLL, cpuX86, 8, osWIN32, "win32dll", "Windows", ".dll"); + Enter( KolibriOS, cpuX86, 8, osKOS, "kosexe", "KolibriOS", ""); + Enter( KolibriOSDLL, cpuX86, 8, osKOS, "kosdll", "KolibriOS", ".obj"); + Enter( Win64C, cpuAMD64, 8, osWIN64, "win64con", "Windows", ".exe"); + Enter( Win64GUI, cpuAMD64, 8, osWIN64, "win64gui", "Windows", ".exe"); + Enter( Win64DLL, cpuAMD64, 8, osWIN64, "win64dll", "Windows", ".dll"); + Enter( Linux32, cpuX86, 8, osLINUX32, "linux32exe", "Linux", ""); + Enter( Linux32SO, cpuX86, 8, osLINUX32, "linux32so", "Linux", ".so"); + Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux", ""); + Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux", ".so"); + Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex"); + Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", libRVM32I, ".bin"); + Enter( RVM64I, cpuRVM64I, 8, osNONE, "rvm64i", libRVM64I, ".bin"); END TARGETS. \ No newline at end of file diff --git a/programs/develop/oberon07/source/TEXTDRV.ob07 b/programs/develop/oberon07/source/TEXTDRV.ob07 index 7f2c416dd2..b7c2f6d7c3 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-2020, Anton Krotov + Copyright (c) 2018-2021, Anton Krotov All rights reserved. *) @@ -12,10 +12,12 @@ IMPORT FILES, C := COLLECTIONS; CONST - CR = 0DX; LF = 0AX; + CR = 0DX; LF = 0AX; HT = 9X; CHUNK = 1024 * 256; + defTabSize* = 4; + TYPE @@ -45,6 +47,7 @@ TYPE VAR texts: C.COLLECTION; + TabSize: INTEGER; PROCEDURE load (text: TEXT); @@ -91,8 +94,11 @@ BEGIN text.eol := FALSE END; text.CR := FALSE + ELSIF c = HT THEN + text.col := text.col + TabSize - text.col MOD TabSize; + text.eol := FALSE; + text.CR := FALSE ELSE - text.eol := FALSE; IF text.utf8 THEN IF ORD(c) DIV 64 # 2 THEN INC(text.col) @@ -100,7 +106,8 @@ BEGIN ELSE INC(text.col) END; - text.CR := FALSE + text.eol := FALSE; + text.CR := FALSE END END @@ -187,6 +194,17 @@ BEGIN END open; +PROCEDURE setTabSize* (n: INTEGER); BEGIN + IF (0 < n) & (n <= 64) THEN + TabSize := n + ELSE + TabSize := defTabSize + END +END setTabSize; + + +BEGIN + TabSize := defTabSize; texts := C.create() END TEXTDRV. \ No newline at end of file diff --git a/programs/develop/oberon07/source/THUMB.ob07 b/programs/develop/oberon07/source/THUMB.ob07 index f53cd57c84..90bbf086de 100644 --- a/programs/develop/oberon07/source/THUMB.ob07 +++ b/programs/develop/oberon07/source/THUMB.ob07 @@ -1,2466 +1,2466 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, Anton Krotov - All rights reserved. -*) - -MODULE THUMB; - -IMPORT PROG, LISTS, CHL := CHUNKLISTS, BIN, REG, IL, C := CONSOLE, - UTILS, WR := WRITER, HEX, ERRORS, TARGETS; - - -CONST - - R0 = 0; R1 = 1; R2 = 2; R3 = 3; R4 = 4; - - SP = 13; LR = 14; PC = 15; - - ACC = R0; - - je = 0; jne = 1; jnb = 2; jb = 3; jge = 10; jl = 11; jg = 12; jle = 13; - - inf = 7F800000H; - - minROM* = 16; maxROM* = 65536; - minRAM* = 4; maxRAM* = 65536; - - maxIVT* = 1023; - - _THUMB2 = 0; _IT = 1; _SDIV = 2; _CBXZ = 3; - - CortexM0 = {}; - CortexM1 = {}; - CortexM3 = {_THUMB2, _IT, _SDIV, _CBXZ}; - CortexM23 = {_SDIV, _CBXZ}; - - -TYPE - - COMMAND = IL.COMMAND; - - ANYCODE = POINTER TO RECORD (LISTS.ITEM) - - offset: INTEGER - - END; - - CODE = POINTER TO RECORD (ANYCODE) - - code: INTEGER - - END; - - LABEL = POINTER TO RECORD (ANYCODE) - - label: INTEGER - - END; - - JUMP = POINTER TO RECORD (ANYCODE) - - label, diff, len, cond: INTEGER; - short: BOOLEAN - - END; - - JMP = POINTER TO RECORD (JUMP) - - END; - - JCC = POINTER TO RECORD (JUMP) - - END; - - CBXZ = POINTER TO RECORD (JUMP) - - reg: INTEGER - - END; - - CALL = POINTER TO RECORD (JUMP) - - END; - - RELOC = POINTER TO RECORD (ANYCODE) - - reg, rel, value: INTEGER - - END; - - RELOCCODE = ARRAY 7 OF INTEGER; - - -VAR - - R: REG.REGS; - - tcount: INTEGER; - - CodeList: LISTS.LIST; - - program: BIN.PROGRAM; - - StkCount: INTEGER; - - Target: RECORD - FlashAdr, - SRAMAdr, - IVTLen, - MinStack, - Reserved: INTEGER; - InstrSet: SET; - isNXP: BOOLEAN - END; - - IVT: ARRAY maxIVT + 1 OF INTEGER; - - sdivProc, trap, genTrap, entry, emptyProc, int0, genInt: INTEGER; - - -PROCEDURE Code (code: INTEGER); -VAR - c: CODE; - -BEGIN - NEW(c); - c.code := code; - LISTS.push(CodeList, c) -END Code; - - -PROCEDURE Label (label: INTEGER); -VAR - L: LABEL; - -BEGIN - NEW(L); - L.label := label; - LISTS.push(CodeList, L) -END Label; - - -PROCEDURE jcc (cond, label: INTEGER); -VAR - j: JCC; - -BEGIN - NEW(j); - j.label := label; - j.cond := cond; - j.short := FALSE; - j.len := 3; - LISTS.push(CodeList, j) -END jcc; - - -PROCEDURE cbxz (cond, reg, label: INTEGER); -VAR - j: CBXZ; - -BEGIN - NEW(j); - j.label := label; - j.cond := cond; - j.reg := reg; - j.short := FALSE; - j.len := 4; - LISTS.push(CodeList, j) -END cbxz; - - -PROCEDURE jmp (label: INTEGER); -VAR - j: JMP; - -BEGIN - NEW(j); - j.label := label; - j.short := FALSE; - j.len := 2; - LISTS.push(CodeList, j) -END jmp; - - -PROCEDURE call (label: INTEGER); -VAR - c: CALL; - -BEGIN - NEW(c); - c.label := label; - c.short := FALSE; - c.len := 2; - LISTS.push(CodeList, c) -END call; - - -PROCEDURE reloc (reg, rel, value: INTEGER); -VAR - r: RELOC; - -BEGIN - NEW(r); - r.reg := reg; - r.rel := rel; - r.value := value; - LISTS.push(CodeList, r) -END reloc; - - -PROCEDURE NewLabel (): INTEGER; -BEGIN - BIN.NewLabel(program) - RETURN IL.NewLabel() -END NewLabel; - - -PROCEDURE range (x, n: INTEGER): BOOLEAN; - RETURN (0 <= x) & (x < LSL(1, n)) -END range; - - -PROCEDURE srange (x, n: INTEGER): BOOLEAN; - RETURN (-LSL(1, n - 1) <= x) & (x < LSL(1, n - 1)) -END srange; - - -PROCEDURE gen1 (op, imm, rs, rd: INTEGER); -BEGIN - ASSERT(op IN {0..2}); - ASSERT(range(imm, 5)); - ASSERT(range(rs, 3)); - ASSERT(range(rd, 3)); - Code(LSL(op, 11) + LSL(imm, 6) + LSL(rs, 3) + rd) -END gen1; - - -PROCEDURE gen2 (i, op: BOOLEAN; imm, rs, rd: INTEGER); -BEGIN - ASSERT(range(imm, 3)); - ASSERT(range(rs, 3)); - ASSERT(range(rd, 3)); - Code(1800H + LSL(ORD(i), 10) + LSL(ORD(op), 9) + LSL(imm, 6) + LSL(rs, 3) + rd) -END gen2; - - -PROCEDURE gen3 (op, rd, imm: INTEGER); -BEGIN - ASSERT(range(op, 2)); - ASSERT(range(rd, 3)); - ASSERT(range(imm, 8)); - Code(2000H + LSL(op, 11) + LSL(rd, 8) + imm) -END gen3; - - -PROCEDURE gen4 (op, rs, rd: INTEGER); -BEGIN - ASSERT(range(op, 4)); - ASSERT(range(rs, 3)); - ASSERT(range(rd, 3)); - Code(4000H + LSL(op, 6) + LSL(rs, 3) + rd) -END gen4; - - -PROCEDURE gen5 (op: INTEGER; h1, h2: BOOLEAN; rs, rd: INTEGER); -BEGIN - ASSERT(range(op, 2)); - ASSERT(range(rs, 3)); - ASSERT(range(rd, 3)); - Code(4400H + LSL(op, 8) + LSL(ORD(h1), 7) + LSL(ORD(h2), 6) + LSL(rs, 3) + rd) -END gen5; - - -PROCEDURE gen7 (l, b: BOOLEAN; ro, rb, rd: INTEGER); -BEGIN - ASSERT(range(ro, 3)); - ASSERT(range(rb, 3)); - ASSERT(range(rd, 3)); - Code(5000H + LSL(ORD(l), 11) + LSL(ORD(b), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) -END gen7; - - -PROCEDURE gen8 (h, s: BOOLEAN; ro, rb, rd: INTEGER); -BEGIN - ASSERT(range(ro, 3)); - ASSERT(range(rb, 3)); - ASSERT(range(rd, 3)); - Code(5200H + LSL(ORD(h), 11) + LSL(ORD(s), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) -END gen8; - - -PROCEDURE gen9 (b, l: BOOLEAN; imm, rb, rd: INTEGER); -BEGIN - ASSERT(range(imm, 5)); - ASSERT(range(rb, 3)); - ASSERT(range(rd, 3)); - Code(6000H + LSL(ORD(b), 12) + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) -END gen9; - - -PROCEDURE gen10 (l: BOOLEAN; imm, rb, rd: INTEGER); -BEGIN - ASSERT(range(imm, 5)); - ASSERT(range(rb, 3)); - ASSERT(range(rd, 3)); - Code(8000H + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) -END gen10; - - -PROCEDURE gen11 (l: BOOLEAN; rd, imm: INTEGER); -BEGIN - ASSERT(range(rd, 3)); - ASSERT(range(imm, 8)); - Code(9000H + LSL(ORD(l), 11) + LSL(rd, 8) + imm) -END gen11; - - -PROCEDURE gen12 (sp: BOOLEAN; rd, imm: INTEGER); -BEGIN - ASSERT(range(rd, 3)); - ASSERT(range(imm, 8)); - Code(0A000H + LSL(ORD(sp), 11) + LSL(rd, 8) + imm) -END gen12; - - -PROCEDURE gen14 (l, r: BOOLEAN; rlist: SET); -VAR - i, n: INTEGER; - -BEGIN - ASSERT(range(ORD(rlist), 8)); - - n := ORD(r); - FOR i := 0 TO 7 DO - IF i IN rlist THEN - INC(n) - END - END; - - IF l THEN - n := -n - END; - - INC(StkCount, n); - - Code(0B400H + LSL(ORD(l), 11) + LSL(ORD(r), 8) + ORD(rlist)) -END gen14; - - -PROCEDURE split16 (imm16: INTEGER; VAR imm4, imm1, imm3, imm8: INTEGER); -BEGIN - ASSERT(range(imm16, 16)); - imm8 := imm16 MOD 256; - imm4 := LSR(imm16, 12); - imm3 := LSR(imm16, 8) MOD 8; - imm1 := LSR(imm16, 11) MOD 2; -END split16; - - -PROCEDURE LslImm (r, imm5: INTEGER); -BEGIN - gen1(0, imm5, r, r) -END LslImm; - - -PROCEDURE LsrImm (r, imm5: INTEGER); -BEGIN - gen1(1, imm5, r, r) -END LsrImm; - - -PROCEDURE AsrImm (r, imm5: INTEGER); -BEGIN - gen1(2, imm5, r, r) -END AsrImm; - - -PROCEDURE AddReg (rd, rs, rn: INTEGER); -BEGIN - gen2(FALSE, FALSE, rn, rs, rd) -END AddReg; - - -PROCEDURE SubReg (rd, rs, rn: INTEGER); -BEGIN - gen2(FALSE, TRUE, rn, rs, rd) -END SubReg; - - -PROCEDURE AddImm8 (rd, imm8: INTEGER); -BEGIN - IF imm8 # 0 THEN - gen3(2, rd, imm8) - END -END AddImm8; - - -PROCEDURE SubImm8 (rd, imm8: INTEGER); -BEGIN - IF imm8 # 0 THEN - gen3(3, rd, imm8) - END -END SubImm8; - - -PROCEDURE AddSubImm12 (r, imm12: INTEGER; sub: BOOLEAN); -VAR - imm4, imm1, imm3, imm8: INTEGER; - -BEGIN - split16(imm12, imm4, imm1, imm3, imm8); - Code(0F200H + LSL(imm1, 10) + r + 0A0H * ORD(sub)); (* addw/subw r, r, imm12 *) - Code(LSL(imm3, 12) + LSL(r, 8) + imm8) -END AddSubImm12; - - -PROCEDURE MovImm8 (rd, imm8: INTEGER); -BEGIN - gen3(0, rd, imm8) -END MovImm8; - - -PROCEDURE CmpImm8 (rd, imm8: INTEGER); -BEGIN - gen3(1, rd, imm8) -END CmpImm8; - - -PROCEDURE Neg (r: INTEGER); -BEGIN - gen4(9, r, r) -END Neg; - - -PROCEDURE Mul (rd, rs: INTEGER); -BEGIN - gen4(13, rs, rd) -END Mul; - - -PROCEDURE Str32 (rs, rb: INTEGER); -BEGIN - gen9(FALSE, FALSE, 0, rb, rs) -END Str32; - - -PROCEDURE Ldr32 (rd, rb: INTEGER); -BEGIN - gen9(FALSE, TRUE, 0, rb, rd) -END Ldr32; - - -PROCEDURE Str16 (rs, rb: INTEGER); -BEGIN - gen10(FALSE, 0, rb, rs) -END Str16; - - -PROCEDURE Ldr16 (rd, rb: INTEGER); -BEGIN - gen10(TRUE, 0, rb, rd) -END Ldr16; - - -PROCEDURE Str8 (rs, rb: INTEGER); -BEGIN - gen9(TRUE, FALSE, 0, rb, rs) -END Str8; - - -PROCEDURE Ldr8 (rd, rb: INTEGER); -BEGIN - gen9(TRUE, TRUE, 0, rb, rd) -END Ldr8; - - -PROCEDURE Cmp (r1, r2: INTEGER); -BEGIN - gen4(10, r2, r1) -END Cmp; - - -PROCEDURE Tst (r: INTEGER); -BEGIN - gen3(1, r, 0) (* cmp r, 0 *) -END Tst; - - -PROCEDURE LdrSp (r, offset: INTEGER); -BEGIN - gen11(TRUE, r, offset) -END LdrSp; - - -PROCEDURE MovImm32 (r, imm32: INTEGER); -BEGIN - MovImm8(r, LSR(imm32, 24) MOD 256); - LslImm(r, 8); - AddImm8(r, LSR(imm32, 16) MOD 256); - LslImm(r, 8); - AddImm8(r, LSR(imm32, 8) MOD 256); - LslImm(r, 8); - AddImm8(r, imm32 MOD 256) -END MovImm32; - - -PROCEDURE low (x: INTEGER): INTEGER; - RETURN x MOD 65536 -END low; - - -PROCEDURE high (x: INTEGER): INTEGER; - RETURN (x DIV 65536) MOD 65536 -END high; - - -PROCEDURE movwt (r, imm16, t: INTEGER); -VAR - imm1, imm3, imm4, imm8: INTEGER; - -BEGIN - ASSERT(range(r, 3)); - ASSERT(range(imm16, 16)); - ASSERT(range(t, 1)); - split16(imm16, imm4, imm1, imm3, imm8); - Code(0F240H + imm1 * 1024 + t * 128 + imm4); - Code(imm3 * 4096 + r * 256 + imm8); -END movwt; - - -PROCEDURE inv0 (cond: INTEGER): INTEGER; - RETURN ORD(BITS(cond) / {0}) -END inv0; - - -PROCEDURE fixup (CodeAdr, DataAdr, BssAdr: INTEGER); -VAR - code: ANYCODE; - count: INTEGER; - shorted: BOOLEAN; - jump: JUMP; - - reloc, i, diff, len: INTEGER; - - RelocCode: RELOCCODE; - - - PROCEDURE genjcc (cond, offset: INTEGER): INTEGER; - BEGIN - ASSERT(range(cond, 4)); - ASSERT(srange(offset, 8)) - RETURN 0D000H + cond * 256 + offset MOD 256 - END genjcc; - - - PROCEDURE genjmp (offset: INTEGER): INTEGER; - BEGIN - ASSERT(srange(offset, 11)) - RETURN 0E000H + offset MOD 2048 - END genjmp; - - - PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE); - VAR - imm1, imm3, imm4, imm8: INTEGER; - - BEGIN - split16(imm16, imm4, imm1, imm3, imm8); - code[t * 2] := 0F240H + imm1 * 1024 + t * 128 + imm4; - code[t * 2 + 1] := imm3 * 4096 + r * 256 + imm8 - END movwt; - - - PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE); - BEGIN - IF _THUMB2 IN Target.InstrSet THEN - movwt(r, low(value), 0, code); - movwt(r, high(value), 1, code) - ELSE - code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* movs r, imm8 *) - code[1] := 0200H + r * 9; (* lsls r, 8 *) - code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* adds r, imm8 *) - code[3] := code[1]; (* lsls r, 8 *) - code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* adds r, imm8 *) - code[5] := code[1]; (* lsls r, 8 *) - code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* adds r, imm8 *) - END - END genmovimm32; - - - PROCEDURE PutCode (code: INTEGER); - BEGIN - BIN.PutCode16LE(program, code) - END PutCode; - - - PROCEDURE genlongjmp (offset: INTEGER); - BEGIN - ASSERT(srange(offset, 22)); - PutCode(0F000H + ASR(offset, 11) MOD 2048); - PutCode(0F800H + offset MOD 2048) - END genlongjmp; - - - PROCEDURE genbc (code: JUMP); - BEGIN - CASE code.len OF - |1: PutCode(genjcc(code.cond, code.diff)) - |2: PutCode(genjcc(inv0(code.cond), 0)); - PutCode(genjmp(code.diff)) - |3: PutCode(genjcc(inv0(code.cond), 1)); - genlongjmp(code.diff) - END - END genbc; - - - PROCEDURE SetIV (idx, label, CodeAdr: INTEGER); - VAR - l, h: LISTS.ITEM; - - BEGIN - l := CodeList.first; - h := l.next; - WHILE idx > 0 DO - l := h.next; - h := l.next; - DEC(idx) - END; - label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1; - l(CODE).code := low(label); - h(CODE).code := high(label) - END SetIV; - - -BEGIN - - REPEAT - - shorted := FALSE; - count := 0; - - code := CodeList.first(ANYCODE); - WHILE code # NIL DO - code.offset := count; - - CASE code OF - |CODE: INC(count) - |LABEL: BIN.SetLabel(program, code.label, count) - |JUMP: INC(count, code.len); code.offset := count + ORD(code.short) - |RELOC: INC(count, 7 - ORD(_THUMB2 IN Target.InstrSet) * 3 + code.rel MOD 2) - END; - - code := code.next(ANYCODE) - END; - - code := CodeList.first(ANYCODE); - WHILE code # NIL DO - - IF code IS JUMP THEN - jump := code(JUMP); - jump.diff := BIN.GetLabel(program, jump.label) - jump.offset; - len := jump.len; - diff := jump.diff; - CASE jump OF - |JMP: - IF (len = 2) & srange(diff, 11) THEN - len := 1 - END - - |JCC: - CASE len OF - |1: - |2: IF srange(diff, 8) THEN DEC(len) END - |3: IF srange(diff, 11) THEN DEC(len) END - END - - |CBXZ: - CASE len OF - |1: - |2: IF range(diff, 6) THEN DEC(len) END - |3: IF srange(diff, 8) THEN DEC(len) END - |4: IF srange(diff, 11) THEN DEC(len) END - END - - |CALL: - - END; - IF len # jump.len THEN - jump.len := len; - jump.short := TRUE; - shorted := TRUE - END - END; - - code := code.next(ANYCODE) - END - - UNTIL ~shorted; - - FOR i := 1 TO Target.IVTLen - 1 DO - SetIV(i, IVT[i], CodeAdr) - END; - - code := CodeList.first(ANYCODE); - WHILE code # NIL DO - - CASE code OF - - |CODE: BIN.PutCode16LE(program, code.code) - - |LABEL: - - |JMP: - IF code.len = 1 THEN - PutCode(genjmp(code.diff)) - ELSE - genlongjmp(code.diff) - END - - |JCC: genbc(code) - - |CBXZ: - IF code.len > 1 THEN - PutCode(2800H + code.reg * 256); (* cmp code.reg, 0 *) - DEC(code.len); - genbc(code) - ELSE - (* cb(n)z code.reg, L *) - PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * (code.diff DIV 32) + (code.diff MOD 32) * 8 + code.reg) - END - - |CALL: genlongjmp(code.diff) - - |RELOC: - CASE code.rel OF - |BIN.RCODE, BIN.PICCODE: reloc := BIN.GetLabel(program, code.value) * 2 + CodeAdr - |BIN.RDATA, BIN.PICDATA: reloc := code.value + DataAdr - |BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr - END; - IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN - DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(_THUMB2 IN Target.InstrSet) + 9)) - END; - genmovimm32(code.reg, reloc, RelocCode); - FOR i := 0 TO 6 - 3 * ORD(_THUMB2 IN Target.InstrSet) DO - PutCode(RelocCode[i]) - END; - IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN - PutCode(4478H + code.reg) (* add code.reg, pc *) - END - END; - - code := code.next(ANYCODE) - END - -END fixup; - - -PROCEDURE push (r: INTEGER); -BEGIN - gen14(FALSE, FALSE, {r}) -END push; - - -PROCEDURE pop (r: INTEGER); -BEGIN - gen14(TRUE, FALSE, {r}) -END pop; - - -PROCEDURE mov (r1, r2: INTEGER); -BEGIN - IF (r1 < 8) & (r2 < 8) THEN - gen1(0, 0, r2, r1) - ELSE - gen5(2, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) - END -END mov; - - -PROCEDURE xchg (r1, r2: INTEGER); -BEGIN - push(r1); - mov(r1, r2); - pop(r2) -END xchg; - - -PROCEDURE drop; -BEGIN - REG.Drop(R) -END drop; - - -PROCEDURE GetAnyReg (): INTEGER; - RETURN REG.GetAnyReg(R) -END GetAnyReg; - - -PROCEDURE UnOp (VAR r: INTEGER); -BEGIN - REG.UnOp(R, r) -END UnOp; - - -PROCEDURE BinOp (VAR r1, r2: INTEGER); -BEGIN - REG.BinOp(R, r1, r2) -END BinOp; - - -PROCEDURE PushAll (NumberOfParameters: INTEGER); -BEGIN - REG.PushAll(R); - DEC(R.pushed, NumberOfParameters) -END PushAll; - - -PROCEDURE cond (op: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - CASE op OF - |IL.opGT, IL.opGTC: res := jg - |IL.opGE, IL.opGEC: res := jge - |IL.opLT, IL.opLTC: res := jl - |IL.opLE, IL.opLEC: res := jle - |IL.opEQ, IL.opEQC: res := je - |IL.opNE, IL.opNEC: res := jne - END - - RETURN res -END cond; - - -PROCEDURE GetRegA; -BEGIN - ASSERT(REG.GetReg(R, ACC)) -END GetRegA; - - -PROCEDURE MovConst (r, c: INTEGER); -BEGIN - IF (0 <= c) & (c <= 255) THEN - MovImm8(r, c) - ELSIF (-255 <= c) & (c < 0) THEN - MovImm8(r, -c); - Neg(r) - ELSIF UTILS.Log2(c) >= 0 THEN - MovImm8(r, 1); - LslImm(r, UTILS.Log2(c)) - ELSIF c = UTILS.min32 THEN - MovImm8(r, 1); - LslImm(r, 31) - ELSE - IF _THUMB2 IN Target.InstrSet THEN - movwt(r, low(c), 0); - IF (c < 0) OR (c > 65535) THEN - movwt(r, high(c), 1) - END - ELSE - MovImm32(r, c) - END - END -END MovConst; - - -PROCEDURE CmpConst (r, c: INTEGER); -VAR - r2: INTEGER; - -BEGIN - IF (0 <= c) & (c <= 255) THEN - CmpImm8(r, c) - ELSE - r2 := GetAnyReg(); - ASSERT(r2 # r); - MovConst(r2, c); - Cmp(r, r2); - drop - END -END CmpConst; - - -PROCEDURE LocalOffset (offset: INTEGER): INTEGER; - RETURN offset + StkCount - ORD(offset > 0) -END LocalOffset; - - -PROCEDURE SetCC (cc, r: INTEGER); -VAR - L1, L2: INTEGER; - -BEGIN - IF _IT IN Target.InstrSet THEN - Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *) - MovConst(r, 1); - MovConst(r, 0) - ELSE - L1 := NewLabel(); - L2 := NewLabel(); - jcc(cc, L1); - MovConst(r, 0); - jmp(L2); - Label(L1); - MovConst(r, 1); - Label(L2) - END -END SetCC; - - -PROCEDURE PushConst (n: INTEGER); -VAR - r: INTEGER; - -BEGIN - r := GetAnyReg(); - MovConst(r, n); - push(r); - drop -END PushConst; - - -PROCEDURE AddConst (r, n: INTEGER); -VAR - r2: INTEGER; - -BEGIN - IF n # 0 THEN - IF (-255 <= n) & (n <= 255) THEN - IF n > 0 THEN - AddImm8(r, n) - ELSE - SubImm8(r, -n) - END - ELSIF (_THUMB2 IN Target.InstrSet) & (-4095 <= n) & (n <= 4095) THEN - AddSubImm12(r, ABS(n), n < 0) - ELSE - r2 := GetAnyReg(); - ASSERT(r2 # r); - IF n > 0 THEN - MovConst(r2, n); - AddReg(r, r, r2) - ELSE - MovConst(r2, -n); - SubReg(r, r, r2) - END; - drop - END - END -END AddConst; - - -PROCEDURE AddHH (r1, r2: INTEGER); -BEGIN - ASSERT((r1 >= 8) OR (r2 >= 8)); - gen5(0, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) -END AddHH; - - -PROCEDURE AddSP (n: INTEGER); -BEGIN - IF n > 0 THEN - IF n < 127 THEN - Code(0B000H + n) (* add sp, n*4 *) - ELSE - ASSERT(R2 IN R.regs); - MovConst(R2, n * 4); - AddHH(SP, R2) - END; - DEC(StkCount, n) - END -END AddSP; - - -PROCEDURE cbxz2 (c, r, label: INTEGER); -BEGIN - IF _CBXZ IN Target.InstrSet THEN - cbxz(c, r, label) - ELSE - Tst(r); - jcc(c, label) - END -END cbxz2; - - -PROCEDURE cbz (r, label: INTEGER); -BEGIN - cbxz2(je, r, label) -END cbz; - - -PROCEDURE cbnz (r, label: INTEGER); -BEGIN - cbxz2(jne, r, label) -END cbnz; - - -PROCEDURE Shift (op, r1, r2: INTEGER); -VAR - L: INTEGER; - -BEGIN - LslImm(r2, 27); - LsrImm(r2, 27); - L := NewLabel(); - cbz(r2, L); - CASE op OF - |IL.opLSL, IL.opLSL1: gen4(2, r2, r1) - |IL.opLSR, IL.opLSR1: gen4(3, r2, r1) - |IL.opASR, IL.opASR1: gen4(4, r2, r1) - |IL.opROR, IL.opROR1: gen4(7, r2, r1) - END; - Label(L) -END Shift; - - -PROCEDURE LocAdr (offs: INTEGER); -VAR - r1, n: INTEGER; - -BEGIN - r1 := GetAnyReg(); - n := LocalOffset(offs); - IF n <= 255 THEN - gen12(TRUE, r1, n) - ELSE - MovConst(r1, n * 4); - AddHH(r1, SP) - END -END LocAdr; - - -PROCEDURE CallRTL (proc, par: INTEGER); -BEGIN - call(IL.codes.rtl[proc]); - AddSP(par) -END CallRTL; - - -PROCEDURE divmod; -BEGIN - call(sdivProc); - AddSP(2) -END divmod; - - -PROCEDURE cpsid_i; -BEGIN - Code(0B672H) (* cpsid i *) -END cpsid_i; - - -PROCEDURE cpsie_i; -BEGIN - Code(0B662H) (* cpsie i *) -END cpsie_i; - - -PROCEDURE translate (pic, stroffs: INTEGER); -VAR - cmd, next: COMMAND; - opcode, param1, param2: INTEGER; - - r1, r2, r3: INTEGER; - - a, n, cc, L, L2: INTEGER; - -BEGIN - cmd := IL.codes.commands.first(COMMAND); - - WHILE cmd # NIL DO - - param1 := cmd.param1; - param2 := cmd.param2; - opcode := cmd.opcode; - - CASE opcode OF - - |IL.opJMP: - jmp(param1) - - |IL.opLABEL: - Label(param1) - - |IL.opHANDLER: - IF param2 = 0 THEN - int0 := param1 - ELSIF param2 = 1 THEN - trap := param1 - ELSE - IVT[param2] := param1 - END - - |IL.opCALL: - call(param1) - - |IL.opCALLP: - UnOp(r1); - AddImm8(r1, 1); (* Thumb mode *) - gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *) - drop; - ASSERT(R.top = -1) - - |IL.opENTER: - ASSERT(R.top = -1); - - Label(param1); - - gen14(FALSE, TRUE, {}); (* push {lr} *) - - n := param2; - IF n >= 5 THEN - MovConst(ACC, 0); - MovConst(R2, n); - L := NewLabel(); - Label(L); - push(ACC); - SubImm8(R2, 1); - Tst(R2); - jcc(jne, L) - ELSIF n > 0 THEN - MovConst(ACC, 0); - WHILE n > 0 DO - push(ACC); - DEC(n) - END - END; - StkCount := param2 - - |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: - IF opcode # IL.opLEAVE THEN - UnOp(r1); - IF r1 # ACC THEN - mov(ACC, r1) - END; - drop - END; - - ASSERT(R.top = -1); - ASSERT(StkCount = param1); - - AddSP(param1); - gen14(TRUE, TRUE, {}) (* pop {pc} *) - - |IL.opLEAVEC: - gen5(3, FALSE, TRUE, 6, 0) (* bx lr *) - - |IL.opPRECALL: - PushAll(0) - - |IL.opPARAM: - n := param2; - IF n = 1 THEN - UnOp(r1); - push(r1); - drop - ELSE - ASSERT(R.top + 1 <= n); - PushAll(n) - END - - |IL.opCLEANUP: - AddSP(param2) - - |IL.opRES, IL.opRESF: - ASSERT(R.top = -1); - GetRegA - - |IL.opPUSHC: - PushConst(param2) - - |IL.opONERR: - cpsid_i; - MovConst(R0, param2); - push(R0); - DEC(StkCount); - jmp(param1) - - |IL.opERR: - call(genTrap) - - |IL.opNOP, IL.opAND, IL.opOR: - - |IL.opSADR: - reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2) - - |IL.opGADR: - reloc(GetAnyReg(), BIN.RBSS + pic, param2) - - |IL.opLADR: - LocAdr(param2) - - |IL.opGLOAD32: - r1 := GetAnyReg(); - reloc(r1, BIN.RBSS + pic, param2); - Ldr32(r1, r1) - - |IL.opGLOAD16: - r1 := GetAnyReg(); - reloc(r1, BIN.RBSS + pic, param2); - Ldr16(r1, r1) - - |IL.opGLOAD8: - r1 := GetAnyReg(); - reloc(r1, BIN.RBSS + pic, param2); - Ldr8(r1, r1) - - |IL.opLADR_SAVE: - UnOp(r1); - n := LocalOffset(param2); - IF n <= 255 THEN - gen11(FALSE, r1, n) (* str r1, [sp, n*4] *) - ELSE - LocAdr(param2); - BinOp(r1, r2); - Str32(r1, r2); - drop - END; - drop - - |IL.opLADR_INCC: - n := LocalOffset(param1); - IF n <= 255 THEN - r1 := GetAnyReg(); - LdrSp(r1, n); - AddConst(r1, param2); - gen11(FALSE, r1, n) (* str r1, [sp, n*4] *) - ELSE - LocAdr(param1); - r1 := GetAnyReg(); - BinOp(r2, r1); - Ldr32(r1, r2); - AddConst(r1, param2); - BinOp(r2, r1); - Str32(r1, r2); - drop - END; - drop - - |IL.opLLOAD32, IL.opVADR, IL.opVLOAD32: - r1 := GetAnyReg(); - n := LocalOffset(param2); - IF n <= 255 THEN - LdrSp(r1, n) - ELSE - drop; - LocAdr(param2); - UnOp(r1); - Ldr32(r1, r1) - END; - IF opcode = IL.opVLOAD32 THEN - Ldr32(r1, r1) - END - - |IL.opLLOAD16: - LocAdr(param2); - UnOp(r1); - Ldr16(r1, r1) - - |IL.opLLOAD8: - LocAdr(param2); - UnOp(r1); - Ldr8(r1, r1) - - |IL.opLOAD32, IL.opLOADF: - UnOp(r1); - Ldr32(r1, r1) - - |IL.opLOAD16: - UnOp(r1); - Ldr16(r1, r1) - - |IL.opLOAD8: - UnOp(r1); - Ldr8(r1, r1) - - |IL.opVLOAD16: - LocAdr(param2); - UnOp(r1); - Ldr32(r1, r1); - Ldr16(r1, r1) - - |IL.opVLOAD8: - LocAdr(param2); - UnOp(r1); - Ldr32(r1, r1); - Ldr8(r1, r1) - - |IL.opSBOOL: - BinOp(r2, r1); - Tst(r2); - SetCC(jne, r2); - Str8(r2, r1); - drop; - drop - - |IL.opSBOOLC: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, ORD(param2 # 0)); - Str8(r2, r1); - drop; - drop - - |IL.opSAVEC: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, param2); - Str32(r2, r1); - drop; - drop - - |IL.opSAVE16C: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, low(param2)); - Str16(r2, r1); - drop; - drop - - |IL.opSAVE8C: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, param2 MOD 256); - Str8(r2, r1); - drop; - drop - - |IL.opSAVE, IL.opSAVE32, IL.opSAVEF: - BinOp(r2, r1); - Str32(r2, r1); - drop; - drop - - |IL.opSAVEFI: - BinOp(r2, r1); - Str32(r1, r2); - drop; - drop - - |IL.opSAVE16: - BinOp(r2, r1); - Str16(r2, r1); - drop; - drop - - |IL.opSAVE8: - BinOp(r2, r1); - Str8(r2, r1); - drop; - drop - - |IL.opSAVEP: - UnOp(r1); - r2 := GetAnyReg(); - reloc(r2, BIN.RCODE + pic, param2); - Str32(r2, r1); - drop; - drop - - |IL.opPUSHP: - reloc(GetAnyReg(), BIN.RCODE + pic, param2) - - |IL.opEQB, IL.opNEB: - BinOp(r1, r2); - drop; - - L := NewLabel(); - cbz(r1, L); - MovConst(r1, 1); - Label(L); - - L := NewLabel(); - cbz(r2, L); - MovConst(r2, 1); - Label(L); - - Cmp(r1, r2); - IF opcode = IL.opEQB THEN - SetCC(je, r1) - ELSE - SetCC(jne, r1) - END - - |IL.opDROP: - UnOp(r1); - drop - - |IL.opJNZ1: - UnOp(r1); - cbnz(r1, param1) - - |IL.opJG: - UnOp(r1); - Tst(r1); - jcc(jg, param1) - - |IL.opJNZ: - UnOp(r1); - cbnz(r1, param1); - drop - - |IL.opJZ: - UnOp(r1); - cbz(r1, param1); - drop - - |IL.opSWITCH: - UnOp(r1); - IF param2 = 0 THEN - r2 := ACC - ELSE - r2 := R2 - END; - IF r1 # r2 THEN - ASSERT(REG.GetReg(R, r2)); - ASSERT(REG.Exchange(R, r1, r2)); - drop - END; - drop - - |IL.opENDSW: - - |IL.opCASEL: - GetRegA; - CmpConst(ACC, param1); - jcc(jl, param2); - drop - - |IL.opCASER: - GetRegA; - CmpConst(ACC, param1); - jcc(jg, param2); - drop - - |IL.opCASELR: - GetRegA; - CmpConst(ACC, param1); - IF param2 = cmd.param3 THEN - jcc(jne, param2) - ELSE - jcc(jl, param2); - jcc(jg, cmd.param3) - END; - drop - - |IL.opCODE: - Code(param2) - - |IL.opEQ..IL.opGE, - IL.opEQC..IL.opGEC: - IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN - BinOp(r1, r2); - Cmp(r1, r2); - drop - ELSE - UnOp(r1); - CmpConst(r1, param2) - END; - - drop; - cc := cond(opcode); - next := cmd.next(COMMAND); - - IF next.opcode = IL.opJNZ THEN - jcc(cc, next.param1); - cmd := next - ELSIF next.opcode = IL.opJZ THEN - jcc(inv0(cc), next.param1); - cmd := next - ELSE - SetCC(cc, GetAnyReg()) - END - - |IL.opINCC: - UnOp(r1); - r2 := GetAnyReg(); - Ldr32(r2, r1); - AddConst(r2, param2); - Str32(r2, r1); - drop; - drop - - |IL.opINCCB, IL.opDECCB: - IF opcode = IL.opDECCB THEN - param2 := -param2 - END; - UnOp(r1); - r2 := GetAnyReg(); - Ldr8(r2, r1); - AddConst(r2, param2); - Str8(r2, r1); - drop; - drop - - |IL.opUMINUS: - UnOp(r1); - Neg(r1) - - |IL.opADD: - BinOp(r1, r2); - CASE cmd.next(COMMAND).opcode OF - |IL.opLOAD32, IL.opLOADF: - gen7(TRUE, FALSE, r2, r1, r1); (* ldr r1, [r1, r2] *) - cmd := cmd.next(COMMAND) - |IL.opLOAD8: - gen7(TRUE, TRUE, r2, r1, r1); (* ldrb r1, [r1, r2] *) - cmd := cmd.next(COMMAND) - |IL.opLOAD16: - gen8(TRUE, FALSE, r2, r1, r1); (* ldrh r1, [r1, r2] *) - cmd := cmd.next(COMMAND) - ELSE - AddReg(r1, r1, r2) - END; - drop - - |IL.opADDC: - UnOp(r1); - AddConst(r1, param2) - - |IL.opSUB: - BinOp(r1, r2); - SubReg(r1, r1, r2); - drop - - |IL.opSUBL, IL.opSUBR: - UnOp(r1); - AddConst(r1, -param2); - IF opcode = IL.opSUBL THEN - Neg(r1) - END - - |IL.opMUL: - BinOp(r1, r2); - Mul(r1, r2); - drop - - |IL.opMULC: - UnOp(r1); - - a := param2; - IF a > 1 THEN - n := UTILS.Log2(a) - ELSIF a < -1 THEN - n := UTILS.Log2(-a) - ELSE - n := -1 - END; - - IF a = 1 THEN - - ELSIF a = -1 THEN - Neg(r1) - ELSIF a = 0 THEN - MovConst(r1, 0) - ELSE - IF n > 0 THEN - IF a < 0 THEN - Neg(r1) - END; - LslImm(r1, n) - ELSE - r2 := GetAnyReg(); - MovConst(r2, a); - Mul(r1, r2); - drop - END - END - - |IL.opABS: - UnOp(r1); - Tst(r1); - L := NewLabel(); - jcc(jge, L); - Neg(r1); - Label(L) - - |IL.opNOT: - UnOp(r1); - Tst(r1); - SetCC(je, r1) - - |IL.opORD: - UnOp(r1); - Tst(r1); - SetCC(jne, r1) - - |IL.opCHR: - UnOp(r1); - Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *) - - |IL.opWCHR: - UnOp(r1); - Code(0B280H + r1 * 9) (* uxth r1, r1 *) - - |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: - BinOp(r1, r2); - Shift(opcode, r1, r2); - drop - - |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: - MovConst(GetAnyReg(), param2); - BinOp(r2, r1); - Shift(opcode, r1, r2); - INCL(R.regs, r2); - DEC(R.top); - R.stk[R.top] := r1 - - |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: - n := param2 MOD 32; - IF n # 0 THEN - UnOp(r1); - CASE opcode OF - |IL.opASR2: AsrImm(r1, n) - |IL.opROR2: r2 := GetAnyReg(); MovConst(r2, n); Shift(IL.opROR, r1, r2); drop - |IL.opLSL2: LslImm(r1, n) - |IL.opLSR2: LsrImm(r1, n) - END - END - - |IL.opCHKBYTE: - BinOp(r1, r2); - CmpConst(r1, 256); - jcc(jb, param1) - - |IL.opCHKIDX: - UnOp(r1); - CmpConst(r1, param2); - jcc(jb, param1) - - |IL.opCHKIDX2: - BinOp(r1, r2); - IF param2 # -1 THEN - Cmp(r2, r1); - jcc(jb, param1) - END; - INCL(R.regs, r1); - DEC(R.top); - R.stk[R.top] := r2 - - |IL.opLEN: - n := param2; - UnOp(r1); - drop; - EXCL(R.regs, r1); - - WHILE n > 0 DO - UnOp(r2); - drop; - DEC(n) - END; - - INCL(R.regs, r1); - ASSERT(REG.GetReg(R, r1)) - - |IL.opINF: - MovConst(GetAnyReg(), inf) - - |IL.opPUSHF: - UnOp(r1); - push(r1); - drop - - |IL.opCONST: - MovConst(GetAnyReg(), param2) - - |IL.opEQP, IL.opNEP: - reloc(GetAnyReg(), BIN.RCODE + pic, param1); - BinOp(r1, r2); - Cmp(r1, r2); - drop; - IF opcode = IL.opEQP THEN - SetCC(je, r1) - ELSE - SetCC(jne, r1) - END - - |IL.opPUSHT: - UnOp(r1); - r2 := GetAnyReg(); - mov(r2, r1); - SubImm8(r2, 4); - Ldr32(r2, r2) - - |IL.opGET, IL.opGETC: - IF opcode = IL.opGET THEN - BinOp(r1, r2) - ELSIF opcode = IL.opGETC THEN - UnOp(r2); - r1 := GetAnyReg(); - MovConst(r1, param1) - END; - drop; - drop; - - CASE param2 OF - |1: Ldr8(r1, r1); Str8(r1, r2) - |2: Ldr16(r1, r1); Str16(r1, r2) - |4: Ldr32(r1, r1); Str32(r1, r2) - END - - |IL.opINC, IL.opDEC: - BinOp(r2, r1); - r3 := GetAnyReg(); - Ldr32(r3, r1); - IF opcode = IL.opINC THEN - AddReg(r3, r3, r2) - ELSE - SubReg(r3, r3, r2) - END; - Str32(r3, r1); - drop; - drop; - drop - - |IL.opINCB, IL.opDECB: - BinOp(r2, r1); - r3 := GetAnyReg(); - Ldr8(r3, r1); - IF opcode = IL.opINCB THEN - AddReg(r3, r3, r2) - ELSE - SubReg(r3, r3, r2) - END; - Str8(r3, r1); - drop; - drop; - drop - - |IL.opMIN, IL.opMAX: - BinOp(r1, r2); - Cmp(r1, r2); - L := NewLabel(); - IF opcode = IL.opMIN THEN - cc := jle - ELSE - cc := jge - END; - jcc(cc, L); - mov(r1, r2); - Label(L); - drop - - |IL.opMINC, IL.opMAXC: - UnOp(r1); - CmpConst(r1, param2); - L := NewLabel(); - IF opcode = IL.opMINC THEN - cc := jle - ELSE - cc := jge - END; - jcc(cc, L); - MovConst(r1, param2); - Label(L) - - |IL.opMULS: - BinOp(r1, r2); - gen4(0, r2, r1); (* ands r1, r2 *) - drop - - |IL.opMULSC: - MovConst(GetAnyReg(), param2); - BinOp(r1, r2); - gen4(0, r2, r1); (* ands r1, r2 *) - drop - - |IL.opDIVS: - BinOp(r1, r2); - gen4(1, r2, r1); (* eors r1, r2 *) - drop - - |IL.opDIVSC: - MovConst(GetAnyReg(), param2); - BinOp(r1, r2); - gen4(1, r2, r1); (* eors r1, r2 *) - drop - - |IL.opADDS: - BinOp(r1, r2); - gen4(12, r2, r1); (* orrs r1, r2 *) - drop - - |IL.opSUBS: - BinOp(r1, r2); - gen4(14, r2, r1); (* bics r1, r2 *) - drop - - |IL.opADDSC: - MovConst(GetAnyReg(), param2); - BinOp(r1, r2); - gen4(12, r2, r1); (* orrs r1, r2 *) - drop - - |IL.opSUBSL: - MovConst(GetAnyReg(), param2); - BinOp(r1, r2); - gen4(14, r1, r2); (* bics r2, r1 *) - INCL(R.regs, r1); - DEC(R.top); - R.stk[R.top] := r2 - - |IL.opSUBSR: - MovConst(GetAnyReg(), param2); - BinOp(r1, r2); - gen4(14, r2, r1); (* bics r1, r2 *) - drop - - |IL.opUMINS: - UnOp(r1); - gen4(15, r1, r1) (* mvns r1, r1 *) - - |IL.opINCL, IL.opEXCL: - BinOp(r1, r2); - r3 := GetAnyReg(); - MovConst(r3, 1); - CmpConst(r1, 32); - L := NewLabel(); - jcc(jnb, L); - gen4(2, r1, r3); (* lsls r3, r1 *) - Ldr32(r1, r2); - IF opcode = IL.opINCL THEN - gen4(12, r3, r1) (* orrs r1, r3 *) - ELSE - gen4(14, r3, r1) (* bics r1, r3 *) - END; - Str32(r1, r2); - Label(L); - drop; - drop; - drop - - |IL.opINCLC, IL.opEXCLC: - UnOp(r2); - r1 := GetAnyReg(); - r3 := GetAnyReg(); - MovConst(r3, 1); - LslImm(r3, param2); - Ldr32(r1, r2); - IF opcode = IL.opINCLC THEN - gen4(12, r3, r1) (* orrs r1, r3 *) - ELSE - gen4(14, r3, r1) (* bics r1, r3 *) - END; - Str32(r1, r2); - drop; - drop; - drop - - |IL.opLENGTH: - PushAll(2); - CallRTL(IL._length, 2); - GetRegA - - |IL.opLENGTHW: - PushAll(2); - CallRTL(IL._lengthw, 2); - GetRegA - - |IL.opSAVES: - UnOp(r2); - REG.PushAll_1(R); - r1 := GetAnyReg(); - reloc(r1, BIN.RDATA + pic, stroffs + param2); - push(r1); - drop; - push(r2); - drop; - PushConst(param1); - CallRTL(IL._move, 3) - - |IL.opEQS .. IL.opGES: - PushAll(4); - PushConst(opcode - IL.opEQS); - CallRTL(IL._strcmp, 5); - GetRegA - - |IL.opEQSW .. IL.opGESW: - PushAll(4); - PushConst(opcode - IL.opEQSW); - CallRTL(IL._strcmpw, 5); - GetRegA - - |IL.opCOPY: - PushAll(2); - PushConst(param2); - CallRTL(IL._move, 3) - - |IL.opMOVE: - PushAll(3); - CallRTL(IL._move, 3) - - |IL.opCOPYA: - PushAll(4); - PushConst(param2); - CallRTL(IL._arrcpy, 5); - GetRegA - - |IL.opCOPYS: - PushAll(4); - PushConst(param2); - CallRTL(IL._strcpy, 5) - - |IL.opDIV: - PushAll(2); - divmod; - GetRegA - - |IL.opDIVL: - UnOp(r1); - REG.PushAll_1(R); - PushConst(param2); - push(r1); - drop; - divmod; - GetRegA - - |IL.opDIVR: - n := UTILS.Log2(param2); - IF n > 0 THEN - UnOp(r1); - AsrImm(r1, n) - ELSIF n < 0 THEN - PushAll(1); - PushConst(param2); - divmod; - GetRegA - END - - |IL.opMOD: - PushAll(2); - divmod; - mov(R0, R1); - GetRegA - - |IL.opMODR: - n := UTILS.Log2(param2); - IF n > 0 THEN - UnOp(r1); - IF n = 8 THEN - Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *) - ELSIF n = 16 THEN - Code(0B280H + r1 * 9) (* uxth r1, r1 *) - ELSE - LslImm(r1, 32 - n); - LsrImm(r1, 32 - n) - END - ELSIF n < 0 THEN - PushAll(1); - PushConst(param2); - divmod; - mov(R0, R1); - GetRegA - ELSE - UnOp(r1); - MovConst(r1, 0) - END - - |IL.opMODL: - UnOp(r1); - REG.PushAll_1(R); - PushConst(param2); - push(r1); - drop; - divmod; - mov(R0, R1); - GetRegA - - |IL.opIN, IL.opINR: - IF opcode = IL.opINR THEN - r2 := GetAnyReg(); - MovConst(r2, param2) - END; - L := NewLabel(); - L2 := NewLabel(); - BinOp(r1, r2); - r3 := GetAnyReg(); - CmpConst(r1, 32); - jcc(jb, L); - MovConst(r1, 0); - jmp(L2); - Label(L); - MovConst(r3, 1); - Shift(IL.opLSL, r3, r1); - gen4(0, r3, r2); (* ands r2, r3 *) - SetCC(jne, r1); - Label(L2); - drop; - drop - - |IL.opINL: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, LSL(1, param2)); - gen4(0, r2, r1); (* ands r1, r2 *) - SetCC(jne, r1); - drop - - |IL.opRSET: - PushAll(2); - CallRTL(IL._set, 2); - GetRegA - - |IL.opRSETR: - PushAll(1); - PushConst(param2); - CallRTL(IL._set, 2); - GetRegA - - |IL.opRSETL: - UnOp(r1); - REG.PushAll_1(R); - PushConst(param2); - push(r1); - drop; - CallRTL(IL._set, 2); - GetRegA - - |IL.opRSET1: - PushAll(1); - CallRTL(IL._set1, 1); - GetRegA - - |IL.opCONSTF: - MovConst(GetAnyReg(), UTILS.d2s(cmd.float)) - - |IL.opMULF: - PushAll(2); - CallRTL(IL._fmul, 2); - GetRegA - - |IL.opDIVF: - PushAll(2); - CallRTL(IL._fdiv, 2); - GetRegA - - |IL.opDIVFI: - PushAll(2); - CallRTL(IL._fdivi, 2); - GetRegA - - |IL.opADDF: - PushAll(2); - CallRTL(IL._fadd, 2); - GetRegA - - |IL.opSUBFI: - PushAll(2); - CallRTL(IL._fsubi, 2); - GetRegA - - |IL.opSUBF: - PushAll(2); - CallRTL(IL._fsub, 2); - GetRegA - - |IL.opEQF..IL.opGEF: - PushAll(2); - PushConst(opcode - IL.opEQF); - CallRTL(IL._fcmp, 3); - GetRegA - - |IL.opFLOOR: - PushAll(1); - CallRTL(IL._floor, 1); - GetRegA - - |IL.opFLT: - PushAll(1); - CallRTL(IL._flt, 1); - GetRegA - - |IL.opUMINF: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, 1); - LslImm(r2, 31); - gen4(1, r2, r1); (* eors r1, r2 *) - drop - - |IL.opFABS: - UnOp(r1); - r2 := GetAnyReg(); - MovConst(r2, 1); - LslImm(r2, 31); - gen4(14, r2, r1); (* bics r1, r2 *) - drop - - |IL.opNEW: - cpsid_i; - PushAll(1); - n := param2 + 4; - ASSERT(UTILS.Align(n, 4)); - PushConst(n); - PushConst(param1); - CallRTL(IL._new, 3); - cpsie_i - - |IL.opTYPEGP: - UnOp(r1); - PushAll(0); - push(r1); - PushConst(param2); - CallRTL(IL._guard, 2); - GetRegA - - |IL.opIS: - PushAll(1); - PushConst(param2); - CallRTL(IL._is, 2); - GetRegA - - |IL.opISREC: - PushAll(2); - PushConst(param2); - CallRTL(IL._guardrec, 3); - GetRegA - - |IL.opTYPEGR: - PushAll(1); - PushConst(param2); - CallRTL(IL._guardrec, 2); - GetRegA - - |IL.opTYPEGD: - UnOp(r1); - PushAll(0); - SubImm8(r1, 4); - Ldr32(r1, r1); - push(r1); - PushConst(param2); - CallRTL(IL._guardrec, 2); - GetRegA - - |IL.opCASET: - push(R2); - push(R2); - PushConst(param2); - CallRTL(IL._guardrec, 2); - pop(R2); - cbnz(ACC, param1) - - |IL.opROT: - PushAll(0); - mov(R2, SP); - push(R2); - PushConst(param2); - CallRTL(IL._rot, 2) - - |IL.opPACK: - PushAll(2); - CallRTL(IL._pack, 2) - - |IL.opPACKC: - PushAll(1); - PushConst(param2); - CallRTL(IL._pack, 2) - - |IL.opUNPK: - PushAll(2); - CallRTL(IL._unpk, 2) - - END; - - cmd := cmd.next(COMMAND) - END; - - ASSERT(R.pushed = 0); - ASSERT(R.top = -1) -END translate; - - -PROCEDURE prolog (GlobSize, tcount, pic, sp, ivt_len: INTEGER); -VAR - r1, r2, i, dcount: INTEGER; - -BEGIN - entry := NewLabel(); - emptyProc := NewLabel(); - genInt := NewLabel(); - genTrap := NewLabel(); - sdivProc := NewLabel(); - - trap := emptyProc; - int0 := emptyProc; - - IVT[0] := sp; - IVT[1] := entry; - FOR i := 2 TO ivt_len - 1 DO - IVT[i] := genInt - END; - - FOR i := 0 TO ivt_len - 1 DO - Code(low(IVT[i])); - Code(high(IVT[i])) - END; - - Label(entry); - cpsie_i; - - r1 := GetAnyReg(); - r2 := GetAnyReg(); - reloc(r1, BIN.RDATA + pic, 0); - - FOR i := 0 TO tcount - 1 DO - MovConst(r2, CHL.GetInt(IL.codes.types, i)); - Str32(r2, r1); - AddImm8(r1, 4) - END; - - dcount := CHL.Length(IL.codes.data); - FOR i := 0 TO dcount - 1 BY 4 DO - MovConst(r2, BIN.get32le(IL.codes.data, i)); - Str32(r2, r1); - AddImm8(r1, 4) - END; - - drop; - drop; - - r1 := GetAnyReg(); - MovConst(r1, sp); - mov(SP, r1); - reloc(r1, BIN.RDATA + pic, 0); - push(r1); - reloc(r1, BIN.RBSS + pic, 0); - r2 := GetAnyReg(); - MovConst(r2, GlobSize); - AddReg(r1, r1, r2); - drop; - push(r1); - drop; - PushConst(tcount); - CallRTL(IL._init, 3) -END prolog; - - -PROCEDURE epilog; -VAR - L1, L2, L3, L4: INTEGER; - -BEGIN - (* L2: *) - Code(0E7FEH); (* b L2 *) - - Label(genInt); - Code(0F3EFH); Code(08005H); (* mrs r0, ipsr *) - gen14(FALSE, TRUE, {R0}); (* push {lr, r0} *) - call(int0); - gen14(TRUE, TRUE, {R0}); (* pop {pc, r0} *) - - Label(emptyProc); - Code(04770H); (* bx lr *) - - Label(genTrap); - call(trap); - call(entry); - - Label(sdivProc); - IF _SDIV IN Target.InstrSet THEN - Code(09800H); (* ldr r0, [sp] *) - Code(09901H); (* ldr r1, [sp, 4] *) - Code(0FB91H); (* sdiv r2, r1, r0 *) - Code(0F2F0H); - Code(00013H); (* movs r3, r2 *) - Code(04343H); (* muls r3, r0, r3 *) - Code(01AC9H); (* subs r1, r1, r3 *) - Code(0DA01H); (* bge L *) - Code(01809H); (* adds r1, r1, r0 *) - Code(03A01H); (* subs r2, 1 *) - (* L: *) - Code(00010H); (* movs r0, r2 *) - Code(04770H); (* bx lr *) - ELSE - (* a / b; a >= 0 *) - L1 := NewLabel(); - L2 := NewLabel(); - L3 := NewLabel(); - L4 := NewLabel(); - - LdrSp(R1, 1); - LdrSp(R2, 0); - MovConst(R0, 0); - push(R4); - - Label(L4); - Cmp(R1, R2); - jcc(jl, L1); - MovConst(R3, 2); - mov(R4, R2); - LslImm(R4, 1); - Label(L3); - Cmp(R1, R4); - jcc(jl, L2); - CmpConst(R4, 0); - jcc(jle, L2); - LslImm(R4, 1); - LslImm(R3, 1); - jmp(L3); - Label(L2); - LsrImm(R4, 1); - LsrImm(R3, 1); - SubReg(R1, R1, R4); - AddReg(R0, R0, R3); - jmp(L4); - Label(L1); - - (* a / b; a < 0 *) - L1 := NewLabel(); - L2 := NewLabel(); - L3 := NewLabel(); - L4 := NewLabel(); - - Label(L4); - CmpConst(R1, 0); - jcc(jge, L1); - MovConst(R3, 2); - mov(R4, R2); - LslImm(R4, 1); - Neg(R1); - Label(L3); - Cmp(R1, R4); - jcc(jl, L2); - CmpConst(R4, 0); - jcc(jle, L2); - LslImm(R4, 1); - LslImm(R3, 1); - jmp(L3); - Label(L2); - Neg(R1); - LsrImm(R4, 1); - LsrImm(R3, 1); - AddReg(R1, R1, R4); - SubReg(R0, R0, R3); - jmp(L4); - Label(L1); - - pop(R4); - Code(04770H); (* bx lr *) - END - -END epilog; - - -PROCEDURE SetTarget (FlashStart, SRAMStart: INTEGER; InstrSet: SET; isNXP: BOOLEAN); -BEGIN - Target.FlashAdr := FlashStart; - Target.SRAMAdr := SRAMStart; - Target.InstrSet := InstrSet; - Target.isNXP := isNXP; - - Target.IVTLen := 256; (* >= 192 *) - Target.Reserved := 0; - Target.MinStack := 512; -END SetTarget; - - -PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); -VAR - opt: PROG.OPTIONS; - - ram, rom, i, j: INTEGER; - - DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER; - -BEGIN - ram := MIN(MAX(options.ram, minRAM), maxRAM) * 1024; - rom := MIN(MAX(options.rom, minROM), maxROM) * 1024; - - IF target = TARGETS.STM32CM3 THEN - SetTarget(08000000H, 20000000H, CortexM3, FALSE) - END; - - tcount := CHL.Length(IL.codes.types); - - opt := options; - CodeList := LISTS.create(NIL); - - program := BIN.create(IL.codes.lcount); - - REG.Init(R, push, pop, mov, xchg, {R0, R1, R2, R3}); - - StkCount := 0; - - DataAdr := Target.SRAMAdr + Target.Reserved; - DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved; - WHILE DataSize MOD 4 # 0 DO - CHL.PushByte(IL.codes.data, 0); - INC(DataSize) - END; - BssAdr := DataAdr + DataSize - Target.Reserved; - - IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); - - BssSize := IL.codes.bss; - ASSERT(UTILS.Align(BssSize, 4)); - - prolog(BssSize, tcount, ORD(opt.pic), Target.SRAMAdr + ram, Target.IVTLen); - translate(ORD(opt.pic), tcount * 4); - epilog; - - fixup(Target.FlashAdr, DataAdr, BssAdr); - - INC(DataSize, BssSize); - CodeSize := CHL.Length(program.code); - - IF CodeSize > rom THEN - ERRORS.Error(203) - END; - - IF DataSize > ram - Target.MinStack THEN - ERRORS.Error(204) - END; - - IF Target.isNXP THEN - BIN.put32le(program.code, 2FCH, 0H); (* code read protection (CRP) *) - (* NXP checksum *) - j := 0; - FOR i := 0 TO 6 DO - INC(j, BIN.get32le(program.code, i * 4)) - END; - BIN.put32le(program.code, 1CH, -j) - END; - - WR.Create(outname); - - HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr)); - HEX.End; - - WR.Close; - - C.Dashes; - C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)"); - C.Ln; - C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)") -END CodeGen; - - -PROCEDURE SetIV* (idx: INTEGER): BOOLEAN; -VAR - res: BOOLEAN; - -BEGIN - res := IVT[idx] = 0; - IVT[idx] := 1 - - RETURN res -END SetIV; - - -PROCEDURE init; -VAR - i: INTEGER; - -BEGIN - FOR i := 0 TO LEN(IVT) - 1 DO - IVT[i] := 0 - END -END init; - - -BEGIN - init +(* + BSD 2-Clause License + + Copyright (c) 2019-2021, Anton Krotov + All rights reserved. +*) + +MODULE THUMB; + +IMPORT PROG, LISTS, CHL := CHUNKLISTS, BIN, REG, IL, C := CONSOLE, + UTILS, WR := WRITER, HEX, ERRORS, TARGETS; + + +CONST + + R0 = 0; R1 = 1; R2 = 2; R3 = 3; R4 = 4; + + SP = 13; LR = 14; PC = 15; + + ACC = R0; + + je = 0; jne = 1; jnb = 2; jb = 3; jge = 10; jl = 11; jg = 12; jle = 13; + + inf = 7F800000H; + + minROM* = 16; maxROM* = 65536; + minRAM* = 4; maxRAM* = 65536; + + maxIVT* = 1023; + + _THUMB2 = 0; _IT = 1; _SDIV = 2; _CBXZ = 3; + + CortexM0 = {}; + CortexM1 = {}; + CortexM3 = {_THUMB2, _IT, _SDIV, _CBXZ}; + CortexM23 = {_SDIV, _CBXZ}; + + +TYPE + + COMMAND = IL.COMMAND; + + ANYCODE = POINTER TO RECORD (LISTS.ITEM) + + offset: INTEGER + + END; + + CODE = POINTER TO RECORD (ANYCODE) + + code: INTEGER + + END; + + LABEL = POINTER TO RECORD (ANYCODE) + + label: INTEGER + + END; + + JUMP = POINTER TO RECORD (ANYCODE) + + label, diff, len, cond: INTEGER; + short: BOOLEAN + + END; + + JMP = POINTER TO RECORD (JUMP) + + END; + + JCC = POINTER TO RECORD (JUMP) + + END; + + CBXZ = POINTER TO RECORD (JUMP) + + reg: INTEGER + + END; + + CALL = POINTER TO RECORD (JUMP) + + END; + + RELOC = POINTER TO RECORD (ANYCODE) + + reg, rel, value: INTEGER + + END; + + RELOCCODE = ARRAY 7 OF INTEGER; + + +VAR + + R: REG.REGS; + + tcount: INTEGER; + + CodeList: LISTS.LIST; + + program: BIN.PROGRAM; + + StkCount: INTEGER; + + Target: RECORD + FlashAdr, + SRAMAdr, + IVTLen, + MinStack, + Reserved: INTEGER; + InstrSet: SET; + isNXP: BOOLEAN + END; + + IVT: ARRAY maxIVT + 1 OF INTEGER; + + sdivProc, trap, genTrap, entry, emptyProc, int0, genInt: INTEGER; + + +PROCEDURE Code (code: INTEGER); +VAR + c: CODE; + +BEGIN + NEW(c); + c.code := code; + LISTS.push(CodeList, c) +END Code; + + +PROCEDURE Label (label: INTEGER); +VAR + L: LABEL; + +BEGIN + NEW(L); + L.label := label; + LISTS.push(CodeList, L) +END Label; + + +PROCEDURE jcc (cond, label: INTEGER); +VAR + j: JCC; + +BEGIN + NEW(j); + j.label := label; + j.cond := cond; + j.short := FALSE; + j.len := 3; + LISTS.push(CodeList, j) +END jcc; + + +PROCEDURE cbxz (cond, reg, label: INTEGER); +VAR + j: CBXZ; + +BEGIN + NEW(j); + j.label := label; + j.cond := cond; + j.reg := reg; + j.short := FALSE; + j.len := 4; + LISTS.push(CodeList, j) +END cbxz; + + +PROCEDURE jmp (label: INTEGER); +VAR + j: JMP; + +BEGIN + NEW(j); + j.label := label; + j.short := FALSE; + j.len := 2; + LISTS.push(CodeList, j) +END jmp; + + +PROCEDURE call (label: INTEGER); +VAR + c: CALL; + +BEGIN + NEW(c); + c.label := label; + c.short := FALSE; + c.len := 2; + LISTS.push(CodeList, c) +END call; + + +PROCEDURE reloc (reg, rel, value: INTEGER); +VAR + r: RELOC; + +BEGIN + NEW(r); + r.reg := reg; + r.rel := rel; + r.value := value; + LISTS.push(CodeList, r) +END reloc; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + BIN.NewLabel(program) + RETURN IL.NewLabel() +END NewLabel; + + +PROCEDURE range (x, n: INTEGER): BOOLEAN; + RETURN (0 <= x) & (x < LSL(1, n)) +END range; + + +PROCEDURE srange (x, n: INTEGER): BOOLEAN; + RETURN (-LSL(1, n - 1) <= x) & (x < LSL(1, n - 1)) +END srange; + + +PROCEDURE gen1 (op, imm, rs, rd: INTEGER); +BEGIN + ASSERT(op IN {0..2}); + ASSERT(range(imm, 5)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(LSL(op, 11) + LSL(imm, 6) + LSL(rs, 3) + rd) +END gen1; + + +PROCEDURE gen2 (i, op: BOOLEAN; imm, rs, rd: INTEGER); +BEGIN + ASSERT(range(imm, 3)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(1800H + LSL(ORD(i), 10) + LSL(ORD(op), 9) + LSL(imm, 6) + LSL(rs, 3) + rd) +END gen2; + + +PROCEDURE gen3 (op, rd, imm: INTEGER); +BEGIN + ASSERT(range(op, 2)); + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(2000H + LSL(op, 11) + LSL(rd, 8) + imm) +END gen3; + + +PROCEDURE gen4 (op, rs, rd: INTEGER); +BEGIN + ASSERT(range(op, 4)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(4000H + LSL(op, 6) + LSL(rs, 3) + rd) +END gen4; + + +PROCEDURE gen5 (op: INTEGER; h1, h2: BOOLEAN; rs, rd: INTEGER); +BEGIN + ASSERT(range(op, 2)); + ASSERT(range(rs, 3)); + ASSERT(range(rd, 3)); + Code(4400H + LSL(op, 8) + LSL(ORD(h1), 7) + LSL(ORD(h2), 6) + LSL(rs, 3) + rd) +END gen5; + + +PROCEDURE gen7 (l, b: BOOLEAN; ro, rb, rd: INTEGER); +BEGIN + ASSERT(range(ro, 3)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(5000H + LSL(ORD(l), 11) + LSL(ORD(b), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) +END gen7; + + +PROCEDURE gen8 (h, s: BOOLEAN; ro, rb, rd: INTEGER); +BEGIN + ASSERT(range(ro, 3)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(5200H + LSL(ORD(h), 11) + LSL(ORD(s), 10) + LSL(ro, 6) + LSL(rb, 3) + rd) +END gen8; + + +PROCEDURE gen9 (b, l: BOOLEAN; imm, rb, rd: INTEGER); +BEGIN + ASSERT(range(imm, 5)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(6000H + LSL(ORD(b), 12) + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) +END gen9; + + +PROCEDURE gen10 (l: BOOLEAN; imm, rb, rd: INTEGER); +BEGIN + ASSERT(range(imm, 5)); + ASSERT(range(rb, 3)); + ASSERT(range(rd, 3)); + Code(8000H + LSL(ORD(l), 11) + LSL(imm, 6) + LSL(rb, 3) + rd) +END gen10; + + +PROCEDURE gen11 (l: BOOLEAN; rd, imm: INTEGER); +BEGIN + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(9000H + LSL(ORD(l), 11) + LSL(rd, 8) + imm) +END gen11; + + +PROCEDURE gen12 (sp: BOOLEAN; rd, imm: INTEGER); +BEGIN + ASSERT(range(rd, 3)); + ASSERT(range(imm, 8)); + Code(0A000H + LSL(ORD(sp), 11) + LSL(rd, 8) + imm) +END gen12; + + +PROCEDURE gen14 (l, r: BOOLEAN; rlist: SET); +VAR + i, n: INTEGER; + +BEGIN + ASSERT(range(ORD(rlist), 8)); + + n := ORD(r); + FOR i := 0 TO 7 DO + IF i IN rlist THEN + INC(n) + END + END; + + IF l THEN + n := -n + END; + + INC(StkCount, n); + + Code(0B400H + LSL(ORD(l), 11) + LSL(ORD(r), 8) + ORD(rlist)) +END gen14; + + +PROCEDURE split16 (imm16: INTEGER; VAR imm4, imm1, imm3, imm8: INTEGER); +BEGIN + ASSERT(range(imm16, 16)); + imm8 := imm16 MOD 256; + imm4 := LSR(imm16, 12); + imm3 := LSR(imm16, 8) MOD 8; + imm1 := LSR(imm16, 11) MOD 2; +END split16; + + +PROCEDURE LslImm (r, imm5: INTEGER); +BEGIN + gen1(0, imm5, r, r) +END LslImm; + + +PROCEDURE LsrImm (r, imm5: INTEGER); +BEGIN + gen1(1, imm5, r, r) +END LsrImm; + + +PROCEDURE AsrImm (r, imm5: INTEGER); +BEGIN + gen1(2, imm5, r, r) +END AsrImm; + + +PROCEDURE AddReg (rd, rs, rn: INTEGER); +BEGIN + gen2(FALSE, FALSE, rn, rs, rd) +END AddReg; + + +PROCEDURE SubReg (rd, rs, rn: INTEGER); +BEGIN + gen2(FALSE, TRUE, rn, rs, rd) +END SubReg; + + +PROCEDURE AddImm8 (rd, imm8: INTEGER); +BEGIN + IF imm8 # 0 THEN + gen3(2, rd, imm8) + END +END AddImm8; + + +PROCEDURE SubImm8 (rd, imm8: INTEGER); +BEGIN + IF imm8 # 0 THEN + gen3(3, rd, imm8) + END +END SubImm8; + + +PROCEDURE AddSubImm12 (r, imm12: INTEGER; sub: BOOLEAN); +VAR + imm4, imm1, imm3, imm8: INTEGER; + +BEGIN + split16(imm12, imm4, imm1, imm3, imm8); + Code(0F200H + LSL(imm1, 10) + r + 0A0H * ORD(sub)); (* addw/subw r, r, imm12 *) + Code(LSL(imm3, 12) + LSL(r, 8) + imm8) +END AddSubImm12; + + +PROCEDURE MovImm8 (rd, imm8: INTEGER); +BEGIN + gen3(0, rd, imm8) +END MovImm8; + + +PROCEDURE CmpImm8 (rd, imm8: INTEGER); +BEGIN + gen3(1, rd, imm8) +END CmpImm8; + + +PROCEDURE Neg (r: INTEGER); +BEGIN + gen4(9, r, r) +END Neg; + + +PROCEDURE Mul (rd, rs: INTEGER); +BEGIN + gen4(13, rs, rd) +END Mul; + + +PROCEDURE Str32 (rs, rb: INTEGER); +BEGIN + gen9(FALSE, FALSE, 0, rb, rs) +END Str32; + + +PROCEDURE Ldr32 (rd, rb: INTEGER); +BEGIN + gen9(FALSE, TRUE, 0, rb, rd) +END Ldr32; + + +PROCEDURE Str16 (rs, rb: INTEGER); +BEGIN + gen10(FALSE, 0, rb, rs) +END Str16; + + +PROCEDURE Ldr16 (rd, rb: INTEGER); +BEGIN + gen10(TRUE, 0, rb, rd) +END Ldr16; + + +PROCEDURE Str8 (rs, rb: INTEGER); +BEGIN + gen9(TRUE, FALSE, 0, rb, rs) +END Str8; + + +PROCEDURE Ldr8 (rd, rb: INTEGER); +BEGIN + gen9(TRUE, TRUE, 0, rb, rd) +END Ldr8; + + +PROCEDURE Cmp (r1, r2: INTEGER); +BEGIN + gen4(10, r2, r1) +END Cmp; + + +PROCEDURE Tst (r: INTEGER); +BEGIN + gen3(1, r, 0) (* cmp r, 0 *) +END Tst; + + +PROCEDURE LdrSp (r, offset: INTEGER); +BEGIN + gen11(TRUE, r, offset) +END LdrSp; + + +PROCEDURE MovImm32 (r, imm32: INTEGER); +BEGIN + MovImm8(r, LSR(imm32, 24) MOD 256); + LslImm(r, 8); + AddImm8(r, LSR(imm32, 16) MOD 256); + LslImm(r, 8); + AddImm8(r, LSR(imm32, 8) MOD 256); + LslImm(r, 8); + AddImm8(r, imm32 MOD 256) +END MovImm32; + + +PROCEDURE low (x: INTEGER): INTEGER; + RETURN x MOD 65536 +END low; + + +PROCEDURE high (x: INTEGER): INTEGER; + RETURN (x DIV 65536) MOD 65536 +END high; + + +PROCEDURE movwt (r, imm16, t: INTEGER); +VAR + imm1, imm3, imm4, imm8: INTEGER; + +BEGIN + ASSERT(range(r, 3)); + ASSERT(range(imm16, 16)); + ASSERT(range(t, 1)); + split16(imm16, imm4, imm1, imm3, imm8); + Code(0F240H + imm1 * 1024 + t * 128 + imm4); + Code(imm3 * 4096 + r * 256 + imm8); +END movwt; + + +PROCEDURE inv0 (cond: INTEGER): INTEGER; + RETURN ORD(BITS(cond) / {0}) +END inv0; + + +PROCEDURE fixup (CodeAdr, DataAdr, BssAdr: INTEGER); +VAR + code: ANYCODE; + count: INTEGER; + shorted: BOOLEAN; + jump: JUMP; + + reloc, i, diff, len: INTEGER; + + RelocCode: RELOCCODE; + + + PROCEDURE genjcc (cond, offset: INTEGER): INTEGER; + BEGIN + ASSERT(range(cond, 4)); + ASSERT(srange(offset, 8)) + RETURN 0D000H + cond * 256 + offset MOD 256 + END genjcc; + + + PROCEDURE genjmp (offset: INTEGER): INTEGER; + BEGIN + ASSERT(srange(offset, 11)) + RETURN 0E000H + offset MOD 2048 + END genjmp; + + + PROCEDURE movwt (r, imm16, t: INTEGER; VAR code: RELOCCODE); + VAR + imm1, imm3, imm4, imm8: INTEGER; + + BEGIN + split16(imm16, imm4, imm1, imm3, imm8); + code[t * 2] := 0F240H + imm1 * 1024 + t * 128 + imm4; + code[t * 2 + 1] := imm3 * 4096 + r * 256 + imm8 + END movwt; + + + PROCEDURE genmovimm32 (r, value: INTEGER; VAR code: RELOCCODE); + BEGIN + IF _THUMB2 IN Target.InstrSet THEN + movwt(r, low(value), 0, code); + movwt(r, high(value), 1, code) + ELSE + code[0] := 2000H + r * 256 + UTILS.Byte(value, 3); (* movs r, imm8 *) + code[1] := 0200H + r * 9; (* lsls r, 8 *) + code[2] := 3000H + r * 256 + UTILS.Byte(value, 2); (* adds r, imm8 *) + code[3] := code[1]; (* lsls r, 8 *) + code[4] := 3000H + r * 256 + UTILS.Byte(value, 1); (* adds r, imm8 *) + code[5] := code[1]; (* lsls r, 8 *) + code[6] := 3000H + r * 256 + UTILS.Byte(value, 0) (* adds r, imm8 *) + END + END genmovimm32; + + + PROCEDURE PutCode (code: INTEGER); + BEGIN + BIN.PutCode16LE(program, code) + END PutCode; + + + PROCEDURE genlongjmp (offset: INTEGER); + BEGIN + ASSERT(srange(offset, 22)); + PutCode(0F000H + ASR(offset, 11) MOD 2048); + PutCode(0F800H + offset MOD 2048) + END genlongjmp; + + + PROCEDURE genbc (code: JUMP); + BEGIN + CASE code.len OF + |1: PutCode(genjcc(code.cond, code.diff)) + |2: PutCode(genjcc(inv0(code.cond), 0)); + PutCode(genjmp(code.diff)) + |3: PutCode(genjcc(inv0(code.cond), 1)); + genlongjmp(code.diff) + END + END genbc; + + + PROCEDURE SetIV (idx, label, CodeAdr: INTEGER); + VAR + l, h: LISTS.ITEM; + + BEGIN + l := CodeList.first; + h := l.next; + WHILE idx > 0 DO + l := h.next; + h := l.next; + DEC(idx) + END; + label := BIN.GetLabel(program, label) * 2 + CodeAdr + 1; + l(CODE).code := low(label); + h(CODE).code := high(label) + END SetIV; + + +BEGIN + + REPEAT + + shorted := FALSE; + count := 0; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + code.offset := count; + + CASE code OF + |CODE: INC(count) + |LABEL: BIN.SetLabel(program, code.label, count) + |JUMP: INC(count, code.len); code.offset := count + ORD(code.short) + |RELOC: INC(count, 7 - ORD(_THUMB2 IN Target.InstrSet) * 3 + code.rel MOD 2) + END; + + code := code.next(ANYCODE) + END; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + + IF code IS JUMP THEN + jump := code(JUMP); + jump.diff := BIN.GetLabel(program, jump.label) - jump.offset; + len := jump.len; + diff := jump.diff; + CASE jump OF + |JMP: + IF (len = 2) & srange(diff, 11) THEN + len := 1 + END + + |JCC: + CASE len OF + |1: + |2: IF srange(diff, 8) THEN DEC(len) END + |3: IF srange(diff, 11) THEN DEC(len) END + END + + |CBXZ: + CASE len OF + |1: + |2: IF range(diff, 6) THEN DEC(len) END + |3: IF srange(diff, 8) THEN DEC(len) END + |4: IF srange(diff, 11) THEN DEC(len) END + END + + |CALL: + + END; + IF len # jump.len THEN + jump.len := len; + jump.short := TRUE; + shorted := TRUE + END + END; + + code := code.next(ANYCODE) + END + + UNTIL ~shorted; + + FOR i := 1 TO Target.IVTLen - 1 DO + SetIV(i, IVT[i], CodeAdr) + END; + + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + + CASE code OF + + |CODE: BIN.PutCode16LE(program, code.code) + + |LABEL: + + |JMP: + IF code.len = 1 THEN + PutCode(genjmp(code.diff)) + ELSE + genlongjmp(code.diff) + END + + |JCC: genbc(code) + + |CBXZ: + IF code.len > 1 THEN + PutCode(2800H + code.reg * 256); (* cmp code.reg, 0 *) + DEC(code.len); + genbc(code) + ELSE + (* cb(n)z code.reg, L *) + PutCode(0B100H + 800H * ORD(code.cond = jne) + 200H * (code.diff DIV 32) + (code.diff MOD 32) * 8 + code.reg) + END + + |CALL: genlongjmp(code.diff) + + |RELOC: + CASE code.rel OF + |BIN.RCODE, BIN.PICCODE: reloc := BIN.GetLabel(program, code.value) * 2 + CodeAdr + |BIN.RDATA, BIN.PICDATA: reloc := code.value + DataAdr + |BIN.RBSS, BIN.PICBSS: reloc := code.value + BssAdr + END; + IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN + DEC(reloc, CodeAdr + 2 * (code.offset - 3 * ORD(_THUMB2 IN Target.InstrSet) + 9)) + END; + genmovimm32(code.reg, reloc, RelocCode); + FOR i := 0 TO 6 - 3 * ORD(_THUMB2 IN Target.InstrSet) DO + PutCode(RelocCode[i]) + END; + IF code.rel IN {BIN.PICCODE, BIN.PICDATA, BIN.PICBSS} THEN + PutCode(4478H + code.reg) (* add code.reg, pc *) + END + END; + + code := code.next(ANYCODE) + END + +END fixup; + + +PROCEDURE push (r: INTEGER); +BEGIN + gen14(FALSE, FALSE, {r}) +END push; + + +PROCEDURE pop (r: INTEGER); +BEGIN + gen14(TRUE, FALSE, {r}) +END pop; + + +PROCEDURE mov (r1, r2: INTEGER); +BEGIN + IF (r1 < 8) & (r2 < 8) THEN + gen1(0, 0, r2, r1) + ELSE + gen5(2, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) + END +END mov; + + +PROCEDURE xchg (r1, r2: INTEGER); +BEGIN + push(r1); + mov(r1, r2); + pop(r2) +END xchg; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE UnOp (VAR r: INTEGER); +BEGIN + REG.UnOp(R, r) +END UnOp; + + +PROCEDURE BinOp (VAR r1, r2: INTEGER); +BEGIN + REG.BinOp(R, r1, r2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE cond (op: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE op OF + |IL.opGT, IL.opGTC: res := jg + |IL.opGE, IL.opGEC: res := jge + |IL.opLT, IL.opLTC: res := jl + |IL.opLE, IL.opLEC: res := jle + |IL.opEQ, IL.opEQC: res := je + |IL.opNE, IL.opNEC: res := jne + END + + RETURN res +END cond; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetRegA; + + +PROCEDURE MovConst (r, c: INTEGER); +BEGIN + IF (0 <= c) & (c <= 255) THEN + MovImm8(r, c) + ELSIF (-255 <= c) & (c < 0) THEN + MovImm8(r, -c); + Neg(r) + ELSIF UTILS.Log2(c) >= 0 THEN + MovImm8(r, 1); + LslImm(r, UTILS.Log2(c)) + ELSIF c = UTILS.min32 THEN + MovImm8(r, 1); + LslImm(r, 31) + ELSE + IF _THUMB2 IN Target.InstrSet THEN + movwt(r, low(c), 0); + IF (c < 0) OR (c > 65535) THEN + movwt(r, high(c), 1) + END + ELSE + MovImm32(r, c) + END + END +END MovConst; + + +PROCEDURE CmpConst (r, c: INTEGER); +VAR + r2: INTEGER; + +BEGIN + IF (0 <= c) & (c <= 255) THEN + CmpImm8(r, c) + ELSE + r2 := GetAnyReg(); + ASSERT(r2 # r); + MovConst(r2, c); + Cmp(r, r2); + drop + END +END CmpConst; + + +PROCEDURE LocalOffset (offset: INTEGER): INTEGER; + RETURN offset + StkCount - ORD(offset > 0) +END LocalOffset; + + +PROCEDURE SetCC (cc, r: INTEGER); +VAR + L1, L2: INTEGER; + +BEGIN + IF _IT IN Target.InstrSet THEN + Code(0BF00H + cc * 16 + ((cc + 1) MOD 2) * 8 + 4); (* ite cc *) + MovConst(r, 1); + MovConst(r, 0) + ELSE + L1 := NewLabel(); + L2 := NewLabel(); + jcc(cc, L1); + MovConst(r, 0); + jmp(L2); + Label(L1); + MovConst(r, 1); + Label(L2) + END +END SetCC; + + +PROCEDURE PushConst (n: INTEGER); +VAR + r: INTEGER; + +BEGIN + r := GetAnyReg(); + MovConst(r, n); + push(r); + drop +END PushConst; + + +PROCEDURE AddConst (r, n: INTEGER); +VAR + r2: INTEGER; + +BEGIN + IF n # 0 THEN + IF (-255 <= n) & (n <= 255) THEN + IF n > 0 THEN + AddImm8(r, n) + ELSE + SubImm8(r, -n) + END + ELSIF (_THUMB2 IN Target.InstrSet) & (-4095 <= n) & (n <= 4095) THEN + AddSubImm12(r, ABS(n), n < 0) + ELSE + r2 := GetAnyReg(); + ASSERT(r2 # r); + IF n > 0 THEN + MovConst(r2, n); + AddReg(r, r, r2) + ELSE + MovConst(r2, -n); + SubReg(r, r, r2) + END; + drop + END + END +END AddConst; + + +PROCEDURE AddHH (r1, r2: INTEGER); +BEGIN + ASSERT((r1 >= 8) OR (r2 >= 8)); + gen5(0, r1 >= 8, r2 >= 8, r2 MOD 8, r1 MOD 8) +END AddHH; + + +PROCEDURE AddSP (n: INTEGER); +BEGIN + IF n > 0 THEN + IF n < 127 THEN + Code(0B000H + n) (* add sp, n*4 *) + ELSE + ASSERT(R2 IN R.regs); + MovConst(R2, n * 4); + AddHH(SP, R2) + END; + DEC(StkCount, n) + END +END AddSP; + + +PROCEDURE cbxz2 (c, r, label: INTEGER); +BEGIN + IF _CBXZ IN Target.InstrSet THEN + cbxz(c, r, label) + ELSE + Tst(r); + jcc(c, label) + END +END cbxz2; + + +PROCEDURE cbz (r, label: INTEGER); +BEGIN + cbxz2(je, r, label) +END cbz; + + +PROCEDURE cbnz (r, label: INTEGER); +BEGIN + cbxz2(jne, r, label) +END cbnz; + + +PROCEDURE Shift (op, r1, r2: INTEGER); +VAR + L: INTEGER; + +BEGIN + LslImm(r2, 27); + LsrImm(r2, 27); + L := NewLabel(); + cbz(r2, L); + CASE op OF + |IL.opLSL, IL.opLSL1: gen4(2, r2, r1) + |IL.opLSR, IL.opLSR1: gen4(3, r2, r1) + |IL.opASR, IL.opASR1: gen4(4, r2, r1) + |IL.opROR, IL.opROR1: gen4(7, r2, r1) + END; + Label(L) +END Shift; + + +PROCEDURE LocAdr (offs: INTEGER); +VAR + r1, n: INTEGER; + +BEGIN + r1 := GetAnyReg(); + n := LocalOffset(offs); + IF n <= 255 THEN + gen12(TRUE, r1, n) + ELSE + MovConst(r1, n * 4); + AddHH(r1, SP) + END +END LocAdr; + + +PROCEDURE CallRTL (proc, par: INTEGER); +BEGIN + call(IL.codes.rtl[proc]); + AddSP(par) +END CallRTL; + + +PROCEDURE divmod; +BEGIN + call(sdivProc); + AddSP(2) +END divmod; + + +PROCEDURE cpsid_i; +BEGIN + Code(0B672H) (* cpsid i *) +END cpsid_i; + + +PROCEDURE cpsie_i; +BEGIN + Code(0B662H) (* cpsie i *) +END cpsie_i; + + +PROCEDURE translate (pic, stroffs: INTEGER); +VAR + cmd, next: COMMAND; + opcode, param1, param2: INTEGER; + + r1, r2, r3: INTEGER; + + a, n, cc, L, L2: INTEGER; + +BEGIN + cmd := IL.codes.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + opcode := cmd.opcode; + + CASE opcode OF + + |IL.opJMP: + jmp(param1) + + |IL.opLABEL: + Label(param1) + + |IL.opHANDLER: + IF param2 = 0 THEN + int0 := param1 + ELSIF param2 = 1 THEN + trap := param1 + ELSE + IVT[param2] := param1 + END + + |IL.opCALL: + call(param1) + + |IL.opCALLP: + UnOp(r1); + AddImm8(r1, 1); (* Thumb mode *) + gen5(3, TRUE, FALSE, r1, 0); (* blx r1 *) + drop; + ASSERT(R.top = -1) + + |IL.opENTER: + ASSERT(R.top = -1); + + Label(param1); + + gen14(FALSE, TRUE, {}); (* push {lr} *) + + n := param2; + IF n >= 5 THEN + MovConst(ACC, 0); + MovConst(R2, n); + L := NewLabel(); + Label(L); + push(ACC); + SubImm8(R2, 1); + Tst(R2); + jcc(jne, L) + ELSIF n > 0 THEN + MovConst(ACC, 0); + WHILE n > 0 DO + push(ACC); + DEC(n) + END + END; + StkCount := param2 + + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode # IL.opLEAVE THEN + UnOp(r1); + IF r1 # ACC THEN + mov(ACC, r1) + END; + drop + END; + + ASSERT(R.top = -1); + ASSERT(StkCount = param1); + + AddSP(param1); + gen14(TRUE, TRUE, {}) (* pop {pc} *) + + |IL.opLEAVEC: + gen5(3, FALSE, TRUE, 6, 0) (* bx lr *) + + |IL.opPRECALL: + PushAll(0) + + |IL.opPARAM: + n := param2; + IF n = 1 THEN + UnOp(r1); + push(r1); + drop + ELSE + ASSERT(R.top + 1 <= n); + PushAll(n) + END + + |IL.opCLEANUP: + AddSP(param2) + + |IL.opRES, IL.opRESF: + ASSERT(R.top = -1); + GetRegA + + |IL.opPUSHC: + PushConst(param2) + + |IL.opONERR: + cpsid_i; + MovConst(R0, param2); + push(R0); + DEC(StkCount); + jmp(param1) + + |IL.opERR: + call(genTrap) + + |IL.opNOP, IL.opAND, IL.opOR: + + |IL.opSADR: + reloc(GetAnyReg(), BIN.RDATA + pic, stroffs + param2) + + |IL.opGADR: + reloc(GetAnyReg(), BIN.RBSS + pic, param2) + + |IL.opLADR: + LocAdr(param2) + + |IL.opGLOAD32: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr32(r1, r1) + + |IL.opGLOAD16: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr16(r1, r1) + + |IL.opGLOAD8: + r1 := GetAnyReg(); + reloc(r1, BIN.RBSS + pic, param2); + Ldr8(r1, r1) + + |IL.opLADR_SAVE: + UnOp(r1); + n := LocalOffset(param2); + IF n <= 255 THEN + gen11(FALSE, r1, n) (* str r1, [sp, n*4] *) + ELSE + LocAdr(param2); + BinOp(r1, r2); + Str32(r1, r2); + drop + END; + drop + + |IL.opLADR_INCC: + n := LocalOffset(param1); + IF n <= 255 THEN + r1 := GetAnyReg(); + LdrSp(r1, n); + AddConst(r1, param2); + gen11(FALSE, r1, n) (* str r1, [sp, n*4] *) + ELSE + LocAdr(param1); + r1 := GetAnyReg(); + BinOp(r2, r1); + Ldr32(r1, r2); + AddConst(r1, param2); + BinOp(r2, r1); + Str32(r1, r2); + drop + END; + drop + + |IL.opLLOAD32, IL.opVADR, IL.opVLOAD32: + r1 := GetAnyReg(); + n := LocalOffset(param2); + IF n <= 255 THEN + LdrSp(r1, n) + ELSE + drop; + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1) + END; + IF opcode = IL.opVLOAD32 THEN + Ldr32(r1, r1) + END + + |IL.opLLOAD16: + LocAdr(param2); + UnOp(r1); + Ldr16(r1, r1) + + |IL.opLLOAD8: + LocAdr(param2); + UnOp(r1); + Ldr8(r1, r1) + + |IL.opLOAD32, IL.opLOADF: + UnOp(r1); + Ldr32(r1, r1) + + |IL.opLOAD16: + UnOp(r1); + Ldr16(r1, r1) + + |IL.opLOAD8: + UnOp(r1); + Ldr8(r1, r1) + + |IL.opVLOAD16: + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1); + Ldr16(r1, r1) + + |IL.opVLOAD8: + LocAdr(param2); + UnOp(r1); + Ldr32(r1, r1); + Ldr8(r1, r1) + + |IL.opSBOOL: + BinOp(r2, r1); + Tst(r2); + SetCC(jne, r2); + Str8(r2, r1); + drop; + drop + + |IL.opSBOOLC: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, ORD(param2 # 0)); + Str8(r2, r1); + drop; + drop + + |IL.opSAVEC: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, param2); + Str32(r2, r1); + drop; + drop + + |IL.opSAVE16C: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, low(param2)); + Str16(r2, r1); + drop; + drop + + |IL.opSAVE8C: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, param2 MOD 256); + Str8(r2, r1); + drop; + drop + + |IL.opSAVE, IL.opSAVE32, IL.opSAVEF: + BinOp(r2, r1); + Str32(r2, r1); + drop; + drop + + |IL.opSAVEFI: + BinOp(r2, r1); + Str32(r1, r2); + drop; + drop + + |IL.opSAVE16: + BinOp(r2, r1); + Str16(r2, r1); + drop; + drop + + |IL.opSAVE8: + BinOp(r2, r1); + Str8(r2, r1); + drop; + drop + + |IL.opSAVEP: + UnOp(r1); + r2 := GetAnyReg(); + reloc(r2, BIN.RCODE + pic, param2); + Str32(r2, r1); + drop; + drop + + |IL.opPUSHP: + reloc(GetAnyReg(), BIN.RCODE + pic, param2) + + |IL.opEQB, IL.opNEB: + BinOp(r1, r2); + drop; + + L := NewLabel(); + cbz(r1, L); + MovConst(r1, 1); + Label(L); + + L := NewLabel(); + cbz(r2, L); + MovConst(r2, 1); + Label(L); + + Cmp(r1, r2); + IF opcode = IL.opEQB THEN + SetCC(je, r1) + ELSE + SetCC(jne, r1) + END + + |IL.opDROP: + UnOp(r1); + drop + + |IL.opJNZ1: + UnOp(r1); + cbnz(r1, param1) + + |IL.opJG: + UnOp(r1); + Tst(r1); + jcc(jg, param1) + + |IL.opJNZ: + UnOp(r1); + cbnz(r1, param1); + drop + + |IL.opJZ: + UnOp(r1); + cbz(r1, param1); + drop + + |IL.opSWITCH: + UnOp(r1); + IF param2 = 0 THEN + r2 := ACC + ELSE + r2 := R2 + END; + IF r1 # r2 THEN + ASSERT(REG.GetReg(R, r2)); + ASSERT(REG.Exchange(R, r1, r2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + GetRegA; + CmpConst(ACC, param1); + jcc(jl, param2); + drop + + |IL.opCASER: + GetRegA; + CmpConst(ACC, param1); + jcc(jg, param2); + drop + + |IL.opCASELR: + GetRegA; + CmpConst(ACC, param1); + IF param2 = cmd.param3 THEN + jcc(jne, param2) + ELSE + jcc(jl, param2); + jcc(jg, cmd.param3) + END; + drop + + |IL.opCODE: + Code(param2) + + |IL.opEQ..IL.opGE, + IL.opEQC..IL.opGEC: + IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN + BinOp(r1, r2); + Cmp(r1, r2); + drop + ELSE + UnOp(r1); + CmpConst(r1, param2) + END; + + drop; + cc := cond(opcode); + next := cmd.next(COMMAND); + + IF next.opcode = IL.opJNZ THEN + jcc(cc, next.param1); + cmd := next + ELSIF next.opcode = IL.opJZ THEN + jcc(inv0(cc), next.param1); + cmd := next + ELSE + SetCC(cc, GetAnyReg()) + END + + |IL.opINCC: + UnOp(r1); + r2 := GetAnyReg(); + Ldr32(r2, r1); + AddConst(r2, param2); + Str32(r2, r1); + drop; + drop + + |IL.opINCCB, IL.opDECCB: + IF opcode = IL.opDECCB THEN + param2 := -param2 + END; + UnOp(r1); + r2 := GetAnyReg(); + Ldr8(r2, r1); + AddConst(r2, param2); + Str8(r2, r1); + drop; + drop + + |IL.opUMINUS: + UnOp(r1); + Neg(r1) + + |IL.opADD: + BinOp(r1, r2); + CASE cmd.next(COMMAND).opcode OF + |IL.opLOAD32, IL.opLOADF: + gen7(TRUE, FALSE, r2, r1, r1); (* ldr r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + |IL.opLOAD8: + gen7(TRUE, TRUE, r2, r1, r1); (* ldrb r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + |IL.opLOAD16: + gen8(TRUE, FALSE, r2, r1, r1); (* ldrh r1, [r1, r2] *) + cmd := cmd.next(COMMAND) + ELSE + AddReg(r1, r1, r2) + END; + drop + + |IL.opADDC: + UnOp(r1); + AddConst(r1, param2) + + |IL.opSUB: + BinOp(r1, r2); + SubReg(r1, r1, r2); + drop + + |IL.opSUBL, IL.opSUBR: + UnOp(r1); + AddConst(r1, -param2); + IF opcode = IL.opSUBL THEN + Neg(r1) + END + + |IL.opMUL: + BinOp(r1, r2); + Mul(r1, r2); + drop + + |IL.opMULC: + UnOp(r1); + + a := param2; + IF a > 1 THEN + n := UTILS.Log2(a) + ELSIF a < -1 THEN + n := UTILS.Log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + Neg(r1) + ELSIF a = 0 THEN + MovConst(r1, 0) + ELSE + IF n > 0 THEN + IF a < 0 THEN + Neg(r1) + END; + LslImm(r1, n) + ELSE + r2 := GetAnyReg(); + MovConst(r2, a); + Mul(r1, r2); + drop + END + END + + |IL.opABS: + UnOp(r1); + Tst(r1); + L := NewLabel(); + jcc(jge, L); + Neg(r1); + Label(L) + + |IL.opNOT: + UnOp(r1); + Tst(r1); + SetCC(je, r1) + + |IL.opORD: + UnOp(r1); + Tst(r1); + SetCC(jne, r1) + + |IL.opCHR: + UnOp(r1); + Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *) + + |IL.opWCHR: + UnOp(r1); + Code(0B280H + r1 * 9) (* uxth r1, r1 *) + + |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: + BinOp(r1, r2); + Shift(opcode, r1, r2); + drop + + |IL.opASR1, IL.opROR1, IL.opLSL1, IL.opLSR1: + MovConst(GetAnyReg(), param2); + BinOp(r2, r1); + Shift(opcode, r1, r2); + INCL(R.regs, r2); + DEC(R.top); + R.stk[R.top] := r1 + + |IL.opASR2, IL.opROR2, IL.opLSL2, IL.opLSR2: + n := param2 MOD 32; + IF n # 0 THEN + UnOp(r1); + CASE opcode OF + |IL.opASR2: AsrImm(r1, n) + |IL.opROR2: r2 := GetAnyReg(); MovConst(r2, n); Shift(IL.opROR, r1, r2); drop + |IL.opLSL2: LslImm(r1, n) + |IL.opLSR2: LsrImm(r1, n) + END + END + + |IL.opCHKBYTE: + BinOp(r1, r2); + CmpConst(r1, 256); + jcc(jb, param1) + + |IL.opCHKIDX: + UnOp(r1); + CmpConst(r1, param2); + jcc(jb, param1) + + |IL.opCHKIDX2: + BinOp(r1, r2); + IF param2 # -1 THEN + Cmp(r2, r1); + jcc(jb, param1) + END; + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opLEN: + n := param2; + UnOp(r1); + drop; + EXCL(R.regs, r1); + + WHILE n > 0 DO + UnOp(r2); + drop; + DEC(n) + END; + + INCL(R.regs, r1); + ASSERT(REG.GetReg(R, r1)) + + |IL.opINF: + MovConst(GetAnyReg(), inf) + + |IL.opPUSHF: + UnOp(r1); + push(r1); + drop + + |IL.opCONST: + MovConst(GetAnyReg(), param2) + + |IL.opEQP, IL.opNEP: + reloc(GetAnyReg(), BIN.RCODE + pic, param1); + BinOp(r1, r2); + Cmp(r1, r2); + drop; + IF opcode = IL.opEQP THEN + SetCC(je, r1) + ELSE + SetCC(jne, r1) + END + + |IL.opPUSHT: + UnOp(r1); + r2 := GetAnyReg(); + mov(r2, r1); + SubImm8(r2, 4); + Ldr32(r2, r2) + + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(r1, r2) + ELSIF opcode = IL.opGETC THEN + UnOp(r2); + r1 := GetAnyReg(); + MovConst(r1, param1) + END; + drop; + drop; + + CASE param2 OF + |1: Ldr8(r1, r1); Str8(r1, r2) + |2: Ldr16(r1, r1); Str16(r1, r2) + |4: Ldr32(r1, r1); Str32(r1, r2) + END + + |IL.opINC, IL.opDEC: + BinOp(r2, r1); + r3 := GetAnyReg(); + Ldr32(r3, r1); + IF opcode = IL.opINC THEN + AddReg(r3, r3, r2) + ELSE + SubReg(r3, r3, r2) + END; + Str32(r3, r1); + drop; + drop; + drop + + |IL.opINCB, IL.opDECB: + BinOp(r2, r1); + r3 := GetAnyReg(); + Ldr8(r3, r1); + IF opcode = IL.opINCB THEN + AddReg(r3, r3, r2) + ELSE + SubReg(r3, r3, r2) + END; + Str8(r3, r1); + drop; + drop; + drop + + |IL.opMIN, IL.opMAX: + BinOp(r1, r2); + Cmp(r1, r2); + L := NewLabel(); + IF opcode = IL.opMIN THEN + cc := jle + ELSE + cc := jge + END; + jcc(cc, L); + mov(r1, r2); + Label(L); + drop + + |IL.opMINC, IL.opMAXC: + UnOp(r1); + CmpConst(r1, param2); + L := NewLabel(); + IF opcode = IL.opMINC THEN + cc := jle + ELSE + cc := jge + END; + jcc(cc, L); + MovConst(r1, param2); + Label(L) + + |IL.opMULS: + BinOp(r1, r2); + gen4(0, r2, r1); (* ands r1, r2 *) + drop + + |IL.opMULSC: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(0, r2, r1); (* ands r1, r2 *) + drop + + |IL.opDIVS: + BinOp(r1, r2); + gen4(1, r2, r1); (* eors r1, r2 *) + drop + + |IL.opDIVSC: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(1, r2, r1); (* eors r1, r2 *) + drop + + |IL.opADDS: + BinOp(r1, r2); + gen4(12, r2, r1); (* orrs r1, r2 *) + drop + + |IL.opSUBS: + BinOp(r1, r2); + gen4(14, r2, r1); (* bics r1, r2 *) + drop + + |IL.opADDSC: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(12, r2, r1); (* orrs r1, r2 *) + drop + + |IL.opSUBSL: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(14, r1, r2); (* bics r2, r1 *) + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opSUBSR: + MovConst(GetAnyReg(), param2); + BinOp(r1, r2); + gen4(14, r2, r1); (* bics r1, r2 *) + drop + + |IL.opUMINS: + UnOp(r1); + gen4(15, r1, r1) (* mvns r1, r1 *) + + |IL.opINCL, IL.opEXCL: + BinOp(r1, r2); + r3 := GetAnyReg(); + MovConst(r3, 1); + CmpConst(r1, 32); + L := NewLabel(); + jcc(jnb, L); + gen4(2, r1, r3); (* lsls r3, r1 *) + Ldr32(r1, r2); + IF opcode = IL.opINCL THEN + gen4(12, r3, r1) (* orrs r1, r3 *) + ELSE + gen4(14, r3, r1) (* bics r1, r3 *) + END; + Str32(r1, r2); + Label(L); + drop; + drop; + drop + + |IL.opINCLC, IL.opEXCLC: + UnOp(r2); + r1 := GetAnyReg(); + r3 := GetAnyReg(); + MovConst(r3, 1); + LslImm(r3, param2); + Ldr32(r1, r2); + IF opcode = IL.opINCLC THEN + gen4(12, r3, r1) (* orrs r1, r3 *) + ELSE + gen4(14, r3, r1) (* bics r1, r3 *) + END; + Str32(r1, r2); + drop; + drop; + drop + + |IL.opLENGTH: + PushAll(2); + CallRTL(IL._length, 2); + GetRegA + + |IL.opLENGTHW: + PushAll(2); + CallRTL(IL._lengthw, 2); + GetRegA + + |IL.opSAVES: + UnOp(r2); + REG.PushAll_1(R); + r1 := GetAnyReg(); + reloc(r1, BIN.RDATA + pic, stroffs + param2); + push(r1); + drop; + push(r2); + drop; + PushConst(param1); + CallRTL(IL._move, 3) + + |IL.opEQS .. IL.opGES: + PushAll(4); + PushConst(opcode - IL.opEQS); + CallRTL(IL._strcmp, 5); + GetRegA + + |IL.opEQSW .. IL.opGESW: + PushAll(4); + PushConst(opcode - IL.opEQSW); + CallRTL(IL._strcmpw, 5); + GetRegA + + |IL.opCOPY: + PushAll(2); + PushConst(param2); + CallRTL(IL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(IL._move, 3) + + |IL.opCOPYA: + PushAll(4); + PushConst(param2); + CallRTL(IL._arrcpy, 5); + GetRegA + + |IL.opCOPYS: + PushAll(4); + PushConst(param2); + CallRTL(IL._strcpy, 5) + + |IL.opDIV: + PushAll(2); + divmod; + GetRegA + + |IL.opDIVL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + divmod; + GetRegA + + |IL.opDIVR: + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(r1); + AsrImm(r1, n) + ELSIF n < 0 THEN + PushAll(1); + PushConst(param2); + divmod; + GetRegA + END + + |IL.opMOD: + PushAll(2); + divmod; + mov(R0, R1); + GetRegA + + |IL.opMODR: + n := UTILS.Log2(param2); + IF n > 0 THEN + UnOp(r1); + IF n = 8 THEN + Code(0B2C0H + r1 * 9) (* uxtb r1, r1 *) + ELSIF n = 16 THEN + Code(0B280H + r1 * 9) (* uxth r1, r1 *) + ELSE + LslImm(r1, 32 - n); + LsrImm(r1, 32 - n) + END + ELSIF n < 0 THEN + PushAll(1); + PushConst(param2); + divmod; + mov(R0, R1); + GetRegA + ELSE + UnOp(r1); + MovConst(r1, 0) + END + + |IL.opMODL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + divmod; + mov(R0, R1); + GetRegA + + |IL.opIN, IL.opINR: + IF opcode = IL.opINR THEN + r2 := GetAnyReg(); + MovConst(r2, param2) + END; + L := NewLabel(); + L2 := NewLabel(); + BinOp(r1, r2); + r3 := GetAnyReg(); + CmpConst(r1, 32); + jcc(jb, L); + MovConst(r1, 0); + jmp(L2); + Label(L); + MovConst(r3, 1); + Shift(IL.opLSL, r3, r1); + gen4(0, r3, r2); (* ands r2, r3 *) + SetCC(jne, r1); + Label(L2); + drop; + drop + + |IL.opINL: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, LSL(1, param2)); + gen4(0, r2, r1); (* ands r1, r2 *) + SetCC(jne, r1); + drop + + |IL.opRSET: + PushAll(2); + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSETR: + PushAll(1); + PushConst(param2); + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSETL: + UnOp(r1); + REG.PushAll_1(R); + PushConst(param2); + push(r1); + drop; + CallRTL(IL._set, 2); + GetRegA + + |IL.opRSET1: + PushAll(1); + CallRTL(IL._set1, 1); + GetRegA + + |IL.opCONSTF: + MovConst(GetAnyReg(), UTILS.d2s(cmd.float)) + + |IL.opMULF: + PushAll(2); + CallRTL(IL._fmul, 2); + GetRegA + + |IL.opDIVF: + PushAll(2); + CallRTL(IL._fdiv, 2); + GetRegA + + |IL.opDIVFI: + PushAll(2); + CallRTL(IL._fdivi, 2); + GetRegA + + |IL.opADDF: + PushAll(2); + CallRTL(IL._fadd, 2); + GetRegA + + |IL.opSUBFI: + PushAll(2); + CallRTL(IL._fsubi, 2); + GetRegA + + |IL.opSUBF: + PushAll(2); + CallRTL(IL._fsub, 2); + GetRegA + + |IL.opEQF..IL.opGEF: + PushAll(2); + PushConst(opcode - IL.opEQF); + CallRTL(IL._fcmp, 3); + GetRegA + + |IL.opFLOOR: + PushAll(1); + CallRTL(IL._floor, 1); + GetRegA + + |IL.opFLT: + PushAll(1); + CallRTL(IL._flt, 1); + GetRegA + + |IL.opUMINF: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, 1); + LslImm(r2, 31); + gen4(1, r2, r1); (* eors r1, r2 *) + drop + + |IL.opFABS: + UnOp(r1); + r2 := GetAnyReg(); + MovConst(r2, 1); + LslImm(r2, 31); + gen4(14, r2, r1); (* bics r1, r2 *) + drop + + |IL.opNEW: + cpsid_i; + PushAll(1); + n := param2 + 4; + ASSERT(UTILS.Align(n, 4)); + PushConst(n); + PushConst(param1); + CallRTL(IL._new, 3); + cpsie_i + + |IL.opTYPEGP: + UnOp(r1); + PushAll(0); + push(r1); + PushConst(param2); + CallRTL(IL._guard, 2); + GetRegA + + |IL.opIS: + PushAll(1); + PushConst(param2); + CallRTL(IL._is, 2); + GetRegA + + |IL.opISREC: + PushAll(2); + PushConst(param2); + CallRTL(IL._guardrec, 3); + GetRegA + + |IL.opTYPEGR: + PushAll(1); + PushConst(param2); + CallRTL(IL._guardrec, 2); + GetRegA + + |IL.opTYPEGD: + UnOp(r1); + PushAll(0); + SubImm8(r1, 4); + Ldr32(r1, r1); + push(r1); + PushConst(param2); + CallRTL(IL._guardrec, 2); + GetRegA + + |IL.opCASET: + push(R2); + push(R2); + PushConst(param2); + CallRTL(IL._guardrec, 2); + pop(R2); + cbnz(ACC, param1) + + |IL.opROT: + PushAll(0); + mov(R2, SP); + push(R2); + PushConst(param2); + CallRTL(IL._rot, 2) + + |IL.opPACK: + PushAll(2); + CallRTL(IL._pack, 2) + + |IL.opPACKC: + PushAll(1); + PushConst(param2); + CallRTL(IL._pack, 2) + + |IL.opUNPK: + PushAll(2); + CallRTL(IL._unpk, 2) + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog (GlobSize, tcount, pic, sp, ivt_len: INTEGER); +VAR + r1, r2, i, dcount: INTEGER; + +BEGIN + entry := NewLabel(); + emptyProc := NewLabel(); + genInt := NewLabel(); + genTrap := NewLabel(); + sdivProc := NewLabel(); + + trap := emptyProc; + int0 := emptyProc; + + IVT[0] := sp; + IVT[1] := entry; + FOR i := 2 TO ivt_len - 1 DO + IVT[i] := genInt + END; + + FOR i := 0 TO ivt_len - 1 DO + Code(low(IVT[i])); + Code(high(IVT[i])) + END; + + Label(entry); + cpsie_i; + + r1 := GetAnyReg(); + r2 := GetAnyReg(); + reloc(r1, BIN.RDATA + pic, 0); + + FOR i := 0 TO tcount - 1 DO + MovConst(r2, CHL.GetInt(IL.codes.types, i)); + Str32(r2, r1); + AddImm8(r1, 4) + END; + + dcount := CHL.Length(IL.codes.data); + FOR i := 0 TO dcount - 1 BY 4 DO + MovConst(r2, BIN.get32le(IL.codes.data, i)); + Str32(r2, r1); + AddImm8(r1, 4) + END; + + drop; + drop; + + r1 := GetAnyReg(); + MovConst(r1, sp); + mov(SP, r1); + reloc(r1, BIN.RDATA + pic, 0); + push(r1); + reloc(r1, BIN.RBSS + pic, 0); + r2 := GetAnyReg(); + MovConst(r2, GlobSize); + AddReg(r1, r1, r2); + drop; + push(r1); + drop; + PushConst(tcount); + CallRTL(IL._init, 3) +END prolog; + + +PROCEDURE epilog; +VAR + L1, L2, L3, L4: INTEGER; + +BEGIN + (* L2: *) + Code(0E7FEH); (* b L2 *) + + Label(genInt); + Code(0F3EFH); Code(08005H); (* mrs r0, ipsr *) + gen14(FALSE, TRUE, {R0}); (* push {lr, r0} *) + call(int0); + gen14(TRUE, TRUE, {R0}); (* pop {pc, r0} *) + + Label(emptyProc); + Code(04770H); (* bx lr *) + + Label(genTrap); + call(trap); + call(entry); + + Label(sdivProc); + IF _SDIV IN Target.InstrSet THEN + Code(09800H); (* ldr r0, [sp] *) + Code(09901H); (* ldr r1, [sp, 4] *) + Code(0FB91H); (* sdiv r2, r1, r0 *) + Code(0F2F0H); + Code(00013H); (* movs r3, r2 *) + Code(04343H); (* muls r3, r0, r3 *) + Code(01AC9H); (* subs r1, r1, r3 *) + Code(0DA01H); (* bge L *) + Code(01809H); (* adds r1, r1, r0 *) + Code(03A01H); (* subs r2, 1 *) + (* L: *) + Code(00010H); (* movs r0, r2 *) + Code(04770H); (* bx lr *) + ELSE + (* a / b; a >= 0 *) + L1 := NewLabel(); + L2 := NewLabel(); + L3 := NewLabel(); + L4 := NewLabel(); + + LdrSp(R1, 1); + LdrSp(R2, 0); + MovConst(R0, 0); + push(R4); + + Label(L4); + Cmp(R1, R2); + jcc(jl, L1); + MovConst(R3, 2); + mov(R4, R2); + LslImm(R4, 1); + Label(L3); + Cmp(R1, R4); + jcc(jl, L2); + CmpConst(R4, 0); + jcc(jle, L2); + LslImm(R4, 1); + LslImm(R3, 1); + jmp(L3); + Label(L2); + LsrImm(R4, 1); + LsrImm(R3, 1); + SubReg(R1, R1, R4); + AddReg(R0, R0, R3); + jmp(L4); + Label(L1); + + (* a / b; a < 0 *) + L1 := NewLabel(); + L2 := NewLabel(); + L3 := NewLabel(); + L4 := NewLabel(); + + Label(L4); + CmpConst(R1, 0); + jcc(jge, L1); + MovConst(R3, 2); + mov(R4, R2); + LslImm(R4, 1); + Neg(R1); + Label(L3); + Cmp(R1, R4); + jcc(jl, L2); + CmpConst(R4, 0); + jcc(jle, L2); + LslImm(R4, 1); + LslImm(R3, 1); + jmp(L3); + Label(L2); + Neg(R1); + LsrImm(R4, 1); + LsrImm(R3, 1); + AddReg(R1, R1, R4); + SubReg(R0, R0, R3); + jmp(L4); + Label(L1); + + pop(R4); + Code(04770H); (* bx lr *) + END + +END epilog; + + +PROCEDURE SetTarget (FlashStart, SRAMStart: INTEGER; InstrSet: SET; isNXP: BOOLEAN); +BEGIN + Target.FlashAdr := FlashStart; + Target.SRAMAdr := SRAMStart; + Target.InstrSet := InstrSet; + Target.isNXP := isNXP; + + Target.IVTLen := 256; (* >= 192 *) + Target.Reserved := 0; + Target.MinStack := 512; +END SetTarget; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +VAR + opt: PROG.OPTIONS; + + ram, rom, i, j: INTEGER; + + DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER; + +BEGIN + ram := MIN(MAX(options.ram, minRAM), maxRAM) * 1024; + rom := MIN(MAX(options.rom, minROM), maxROM) * 1024; + + IF target = TARGETS.STM32CM3 THEN + SetTarget(08000000H, 20000000H, CortexM3, FALSE) + END; + + tcount := CHL.Length(IL.codes.types); + + opt := options; + CodeList := LISTS.create(NIL); + + program := BIN.create(IL.codes.lcount); + + REG.Init(R, push, pop, mov, xchg, {R0, R1, R2, R3}); + + StkCount := 0; + + DataAdr := Target.SRAMAdr + Target.Reserved; + DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved; + WHILE DataSize MOD 4 # 0 DO + CHL.PushByte(IL.codes.data, 0); + INC(DataSize) + END; + BssAdr := DataAdr + DataSize - Target.Reserved; + + IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); + + BssSize := IL.codes.bss; + ASSERT(UTILS.Align(BssSize, 4)); + + prolog(BssSize, tcount, ORD(opt.pic), Target.SRAMAdr + ram, Target.IVTLen); + translate(ORD(opt.pic), tcount * 4); + epilog; + + fixup(Target.FlashAdr, DataAdr, BssAdr); + + INC(DataSize, BssSize); + CodeSize := CHL.Length(program.code); + + IF CodeSize > rom THEN + ERRORS.Error(203) + END; + + IF DataSize > ram - Target.MinStack THEN + ERRORS.Error(204) + END; + + IF Target.isNXP THEN + BIN.put32le(program.code, 2FCH, 0H); (* code read protection (CRP) *) + (* NXP checksum *) + j := 0; + FOR i := 0 TO 6 DO + INC(j, BIN.get32le(program.code, i * 4)) + END; + BIN.put32le(program.code, 1CH, -j) + END; + + WR.Create(outname); + + HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr)); + HEX.End; + + WR.Close; + + C.Dashes; + C.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(rom); C.String(" ("); C.Int(CodeSize * 100 DIV rom); C.StringLn("%)"); + C.Ln; + C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)") +END CodeGen; + + +PROCEDURE SetIV* (idx: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := IVT[idx] = 0; + IVT[idx] := 1 + + RETURN res +END SetIV; + + +PROCEDURE init; +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO LEN(IVT) - 1 DO + IVT[i] := 0 + END +END init; + + +BEGIN + init END THUMB. \ No newline at end of file diff --git a/programs/develop/oberon07/source/UTILS.ob07 b/programs/develop/oberon07/source/UTILS.ob07 index d854e0639f..1261e8df52 100644 --- a/programs/develop/oberon07/source/UTILS.ob07 +++ b/programs/develop/oberon07/source/UTILS.ob07 @@ -23,8 +23,8 @@ CONST max32* = 2147483647; vMajor* = 1; - vMinor* = 52; - Date* = "07-may-2021"; + vMinor* = 53; + Date* = "26-aug-2021"; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL";