oberon07: lower case by default

git-svn-id: svn://kolibrios.org@9893 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2023-01-21 14:34:25 +00:00
parent bd24d8a01e
commit a1909c89a2
27 changed files with 1530 additions and 2226 deletions

View File

@ -1,5 +1,5 @@
(* (*
Copyright 2021, 2022 Anton Krotov Copyright 2021-2023 Anton Krotov
This file is part of CEdit. This file is part of CEdit.
@ -58,14 +58,14 @@ END GetInf;
PROCEDURE GetImg (ptr, size: INTEGER): INTEGER; PROCEDURE GetImg (ptr, size: INTEGER): INTEGER;
VAR VAR
image_data, dst, x, type: INTEGER; image_data, dst, x, Type: INTEGER;
BEGIN BEGIN
image_data := img_decode(ptr, size, 0); image_data := img_decode(ptr, size, 0);
IF image_data # 0 THEN IF image_data # 0 THEN
SYSTEM.GET(image_data + 4, x); SYSTEM.GET(image_data + 4, x);
ASSERT(x = SIZE); ASSERT(x = SIZE);
SYSTEM.GET(image_data + 20, type); SYSTEM.GET(image_data + 20, Type);
IF type # 3 THEN IF Type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0); dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data); img_destroy(image_data);
image_data := dst image_data := dst

View File

@ -1,6 +1,6 @@
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without

View File

@ -1,312 +0,0 @@
==============================================================================
Библиотека (Windows)
------------------------------------------------------------------------------
MODULE Out - консольный вывод
PROCEDURE Open
открывает консольный вывод
PROCEDURE Int(x, width: INTEGER)
вывод целого числа x;
width - количество знакомест, используемых для вывода
PROCEDURE Real(x: REAL; width: INTEGER)
вывод вещественного числа x в плавающем формате;
width - количество знакомест, используемых для вывода
PROCEDURE Char(x: CHAR)
вывод символа x
PROCEDURE FixReal(x: REAL; width, p: INTEGER)
вывод вещественного числа x в фиксированном формате;
width - количество знакомест, используемых для вывода;
p - количество знаков после десятичной точки
PROCEDURE Ln
переход на следующую строку
PROCEDURE String(s: ARRAY OF CHAR)
вывод строки s (ASCII)
PROCEDURE StringW(s: ARRAY OF WCHAR)
вывод строки s (UTF-16)
------------------------------------------------------------------------------
MODULE In - консольный ввод
VAR Done: BOOLEAN
принимает значение TRUE в случае успешного выполнения
операции ввода и FALSE в противном случае
PROCEDURE Open
открывает консольный ввод,
также присваивает переменной Done значение TRUE
PROCEDURE Int(VAR x: INTEGER)
ввод числа типа INTEGER
PROCEDURE Char(VAR x: CHAR)
ввод символа
PROCEDURE Real(VAR x: REAL)
ввод числа типа REAL
PROCEDURE String(VAR s: ARRAY OF CHAR)
ввод строки
PROCEDURE Ln
ожидание нажатия ENTER
------------------------------------------------------------------------------
MODULE Console - дополнительные процедуры консольного вывода
CONST
Следующие константы определяют цвет консольного вывода
Black = 0 Blue = 1 Green = 2
Cyan = 3 Red = 4 Magenta = 5
Brown = 6 LightGray = 7 DarkGray = 8
LightBlue = 9 LightGreen = 10 LightCyan = 11
LightRed = 12 LightMagenta = 13 Yellow = 14
White = 15
PROCEDURE Cls
очистка окна консоли
PROCEDURE SetColor(FColor, BColor: INTEGER)
установка цвета консольного вывода: FColor - цвет текста,
BColor - цвет фона, возможные значения - вышеперечисленные
константы
PROCEDURE SetCursor(x, y: INTEGER)
установка курсора консоли в позицию (x, y)
PROCEDURE GetCursor(VAR x, y: INTEGER)
записывает в параметры текущие координаты курсора консоли
PROCEDURE GetCursorX(): INTEGER
возвращает текущую x-координату курсора консоли
PROCEDURE GetCursorY(): INTEGER
возвращает текущую y-координату курсора консоли
------------------------------------------------------------------------------
MODULE Math - математические функции
CONST
pi = 3.141592653589793E+00
e = 2.718281828459045E+00
PROCEDURE IsNan(x: REAL): BOOLEAN
возвращает TRUE, если x - не число
PROCEDURE IsInf(x: REAL): BOOLEAN
возвращает TRUE, если x - бесконечность
PROCEDURE sqrt(x: REAL): REAL
квадратный корень x
PROCEDURE exp(x: REAL): REAL
экспонента x
PROCEDURE ln(x: REAL): REAL
натуральный логарифм x
PROCEDURE sin(x: REAL): REAL
синус x
PROCEDURE cos(x: REAL): REAL
косинус x
PROCEDURE tan(x: REAL): REAL
тангенс x
PROCEDURE arcsin(x: REAL): REAL
арксинус x
PROCEDURE arccos(x: REAL): REAL
арккосинус x
PROCEDURE arctan(x: REAL): REAL
арктангенс x
PROCEDURE arctan2(y, x: REAL): REAL
арктангенс y/x
PROCEDURE power(base, exponent: REAL): REAL
возведение числа base в степень exponent
PROCEDURE log(base, x: REAL): REAL
логарифм x по основанию base
PROCEDURE sinh(x: REAL): REAL
гиперболический синус x
PROCEDURE cosh(x: REAL): REAL
гиперболический косинус x
PROCEDURE tanh(x: REAL): REAL
гиперболический тангенс x
PROCEDURE arsinh(x: REAL): REAL
обратный гиперболический синус x
PROCEDURE arcosh(x: REAL): REAL
обратный гиперболический косинус x
PROCEDURE artanh(x: REAL): REAL
обратный гиперболический тангенс x
PROCEDURE round(x: REAL): REAL
округление x до ближайшего целого
PROCEDURE frac(x: REAL): REAL;
дробная часть числа x
PROCEDURE floor(x: REAL): REAL
наибольшее целое число (представление как REAL),
не больше x: floor(1.2) = 1.0
PROCEDURE ceil(x: REAL): REAL
наименьшее целое число (представление как REAL),
не меньше x: ceil(1.2) = 2.0
PROCEDURE sgn(x: REAL): INTEGER
если x > 0 возвращает 1
если x < 0 возвращает -1
если x = 0 возвращает 0
PROCEDURE fact(n: INTEGER): REAL
факториал n
------------------------------------------------------------------------------
MODULE File - работа с файловой системой
CONST
OPEN_R = 0
OPEN_W = 1
OPEN_RW = 2
SEEK_BEG = 0
SEEK_CUR = 1
SEEK_END = 2
PROCEDURE Create(FName: ARRAY OF CHAR): INTEGER
создает новый файл с именем FName (полное имя с путем),
открывет файл для записи и возвращает идентификатор файла
(целое число), в случае ошибки, возвращает -1
PROCEDURE Open(FName: ARRAY OF CHAR; Mode: INTEGER): INTEGER
открывает существующий файл с именем FName (полное имя с
путем) в режиме Mode = (OPEN_R (только чтение), OPEN_W
(только запись), OPEN_RW (чтение и запись)), возвращает
идентификатор файла (целое число), в случае ошибки,
возвращает -1
PROCEDURE Read(F, Buffer, Count: INTEGER): INTEGER
Читает данные из файла в память. F - числовой идентификатор
файла, Buffer - адрес области памяти, Count - количество байт,
которое требуется прочитать из файла; возвращает количество
байт, которое было прочитано из файла
PROCEDURE Write(F, Buffer, Count: INTEGER): INTEGER
Записывает данные из памяти в файл. F - числовой идентификатор
файла, Buffer - адрес области памяти, Count - количество байт,
которое требуется записать в файл; возвращает количество байт,
которое было записано в файл
PROCEDURE Seek(F, Offset, Origin: INTEGER): INTEGER
устанавливает позицию чтения-записи файла с идентификатором F
на Offset, относительно Origin = (SEEK_BEG - начало файла,
SEEK_CUR - текущая позиция, SEEK_END - конец файла),
возвращает позицию относительно начала файла, например:
Seek(F, 0, 2) - устанавливает позицию на конец файла и
возвращает длину файла; при ошибке возвращает -1
PROCEDURE Close(F: INTEGER)
закрывает ранее открытый файл с идентификатором F
PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN
удаляет файл с именем FName (полное имя с путем),
возвращает TRUE, если файл успешно удален
PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN
возвращает TRUE, если файл с именем FName (полное имя)
существует
PROCEDURE Load(FName: ARRAY OF CHAR; VAR Size: INTEGER): INTEGER
загружает в память существующий файл с именем FName (полное имя с
путем), возвращает адрес памяти, куда был загружен файл,
записывает размер файла в параметр Size;
при ошибке возвращает 0
PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN
создает папку с именем DirName, все промежуточные папки
должны существовать. В случае ошибки, возвращает FALSE
PROCEDURE RemoveDir(DirName: ARRAY OF CHAR): BOOLEAN
удаляет пустую папку с именем DirName. В случае ошибки,
возвращает FALSE
PROCEDURE ExistsDir(DirName: ARRAY OF CHAR): BOOLEAN
возвращает TRUE, если папка с именем DirName существует
------------------------------------------------------------------------------
MODULE DateTime - дата, время
CONST ERR = -7.0E5
PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec, MSec: INTEGER)
возвращает в параметрах компоненты текущей системной даты и
времени
PROCEDURE NowEncode(): REAL;
возвращает текущую системную дату и
время (представление REAL)
PROCEDURE Encode(Year, Month, Day,
Hour, Min, Sec, MSec: INTEGER): REAL
возвращает дату, полученную из компонентов
Year, Month, Day, Hour, Min, Sec, MSec;
при ошибке возвращает константу ERR = -7.0E5
PROCEDURE Decode(Date: REAL; VAR Year, Month, Day,
Hour, Min, Sec, MSec: INTEGER): BOOLEAN
извлекает компоненты
Year, Month, Day, Hour, Min, Sec, MSec из даты Date;
при ошибке возвращает FALSE
------------------------------------------------------------------------------
MODULE Args - параметры программы
VAR argc: INTEGER
количество параметров программы, включая имя
исполняемого файла
PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR)
записывает в строку s n-й параметр программы,
нумерация параметров от 0 до argc - 1,
нулевой параметр -- имя исполняемого файла
------------------------------------------------------------------------------
MODULE Utils - разное
PROCEDURE Utf8To16(source: ARRAY OF CHAR;
VAR dest: ARRAY OF CHAR): INTEGER;
преобразует символы строки source из кодировки UTF-8 в
кодировку UTF-16, результат записывает в строку dest,
возвращает количество 16-битных символов, записанных в dest
PROCEDURE PutSeed(seed: INTEGER)
Инициализация генератора случайных чисел целым числом seed
PROCEDURE Rnd(range: INTEGER): INTEGER
Целые случайные числа в диапазоне 0 <= x < range
------------------------------------------------------------------------------
MODULE WINAPI - привязки к некоторым API-функциям Windows

View File

@ -28,7 +28,9 @@ UTF-8 с BOM-сигнатурой.
исходном коде), по умолчанию - 4 исходном коде), по умолчанию - 4
-nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже) -nochk <"ptibcwra"> отключить проверки при выполнении (см. ниже)
-lower разрешить ключевые слова и встроенные идентификаторы в -lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре нижнем регистре (по умолчанию)
-upper только верхний регистр для ключевых слов и встроенных
идентификаторов
-def <имя> задать символ условной компиляции -def <имя> задать символ условной компиляции
-ver <major.minor> версия программы (только для kosdll) -ver <major.minor> версия программы (только для kosdll)
-uses вывести список импортированных модулей -uses вывести список импортированных модулей
@ -81,6 +83,7 @@ UTF-8 с BOM-сигнатурой.
13. Возможен импорт модулей с указанием пути и имени файла 13. Возможен импорт модулей с указанием пути и имени файла
14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt) 14. Добавлен специальный синтаксис для условной компиляции (см. CC.txt)
15. Имя процедуры в конце объявления (после END) необязательно 15. Имя процедуры в конце объявления (после END) необязательно
16. Разрешено использовать нижний регистр для ключевых слов
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
Особенности реализации Особенности реализации
@ -137,6 +140,10 @@ UTF-8 с BOM-сигнатурой.
PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER PROCEDURE WSADR(x: строковая константа (WCHAR)): INTEGER
возвращает адрес x возвращает адрес x
PROCEDURE VAL(v: любой тип; T): T
v - переменная;
интерпретирует v, как переменную типа T
PROCEDURE SIZE(T): INTEGER PROCEDURE SIZE(T): INTEGER
возвращает размер типа T возвращает размер типа T

View File

@ -1,397 +0,0 @@
 Компилятор языка программирования Oberon-07/16 для x86_64
Windows/Linux
------------------------------------------------------------------------------
Параметры командной строки
Вход - текстовые файлы модулей с расширением ".ob07", кодировка ANSI или
UTF-8 с BOM-сигнатурой.
Выход - испоняемый файл формата PE32+ или ELF64.
Параметры:
1) имя главного модуля
2) тип приложения
"win64con" - Windows64 console
"win64gui" - Windows64 GUI
"win64dll" - Windows64 DLL
"linux64exe" - Linux ELF64-EXEC
"linux64so" - Linux ELF64-SO
3) необязательные параметры-ключи
-out <file_name> имя результирующего файла; по умолчанию,
совпадает с именем главного модуля, но с другим расширением
(соответствует типу исполняемого файла)
-stk <size> размер стэка в мегабайтах (по умолчанию 2 Мб,
допустимо от 1 до 32 Мб)
-tab <width> размер табуляции (используется для вычисления координат в
исходном коде), по умолчанию - 4
-nochk <"ptibcwra"> отключить проверки при выполнении
-lower разрешить ключевые слова и встроенные идентификаторы в
нижнем регистре
-def <имя> задать символ условной компиляции
-uses вывести список импортированных модулей
параметр -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-библиотек.

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2013-2014, 2018-2020 Anton Krotov Copyright (c) 2013-2014, 2018-2022 Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -271,8 +271,7 @@ BEGIN
ELSIF x < -15.0 THEN ELSIF x < -15.0 THEN
x := -1.0 x := -1.0
ELSE ELSE
x := exp(2.0 * x); x := 1.0 - 2.0 / (exp(2.0 * x) + 1.0)
x := (x - 1.0) / (x + 1.0)
END END
RETURN x RETURN x

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -1152,14 +1152,13 @@ BEGIN
movrm(reg1, reg1, 0) movrm(reg1, reg1, 0)
|IL.opPARAM: |IL.opPARAM:
n := param2; IF param2 = 1 THEN
IF n = 1 THEN
UnOp(reg1); UnOp(reg1);
push(reg1); push(reg1);
drop drop
ELSE ELSE
ASSERT(R.top + 1 <= n); ASSERT(R.top + 1 <= param2);
PushAll(n) PushAll(param2)
END END
|IL.opJNZ1: |IL.opJNZ1:
@ -1344,8 +1343,8 @@ BEGIN
|IL.opNEW: |IL.opNEW:
PushAll(1); PushAll(1);
n := param2 + 8; n := param2 + 16;
ASSERT(UTILS.Align(n, 8)); ASSERT(UTILS.Align(n, 16));
pushc(n); pushc(n);
pushc(param1); pushc(param1);
CallRTL(IL._new) CallRTL(IL._new)
@ -1787,11 +1786,6 @@ BEGIN
X86._movrm(reg1, reg1, 0, param2 * 8, FALSE); X86._movrm(reg1, reg1, 0, param2 * 8, FALSE);
X86._movrm(reg1, reg2, 0, param2 * 8, TRUE) X86._movrm(reg1, reg2, 0, param2 * 8, TRUE)
|IL.opCHKBYTE:
BinOp(reg1, reg2);
cmprc(reg1, 256);
jcc(jb, param1)
|IL.opCHKIDX: |IL.opCHKIDX:
UnOp(reg1); UnOp(reg1);
cmprc(reg1, param2); cmprc(reg1, param2);
@ -1832,14 +1826,6 @@ BEGIN
INCL(R.regs, reg1); INCL(R.regs, reg1);
ASSERT(REG.GetReg(R, reg1)) ASSERT(REG.GetReg(R, reg1))
|IL.opCHR:
UnOp(reg1);
andrc(reg1, 255)
|IL.opWCHR:
UnOp(reg1);
andrc(reg1, 65535)
|IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP: |IL.opEQP, IL.opNEP, IL.opEQIP, IL.opNEIP:
UnOp(reg1); UnOp(reg1);
reg2 := GetAnyReg(); reg2 := GetAnyReg();
@ -2385,6 +2371,7 @@ VAR
BEGIN BEGIN
Xmm[0] := 0; Xmm[0] := 0;
X86.align16(TRUE);
tcount := CHL.Length(IL.codes.types); tcount := CHL.Length(IL.codes.types);
Win64RegPar[0] := rcx; Win64RegPar[0] := rcx;

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2021, Anton Krotov Copyright (c) 2018-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -217,7 +217,6 @@ END opFloat2;
PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER); PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
VAR VAR
value: REAL; value: REAL;
frac: REAL;
exp10: REAL; exp10: REAL;
i, n, d: INTEGER; i, n, d: INTEGER;
minus: BOOLEAN; minus: BOOLEAN;
@ -225,32 +224,24 @@ VAR
BEGIN BEGIN
error := 0; error := 0;
value := 0.0; value := 0.0;
frac := 0.0;
exp10 := 1.0;
minus := FALSE; minus := FALSE;
n := 0; n := 0;
i := 0; exp10 := 0.0;
WHILE (error = 0) & STRINGS.digit(s[i]) DO WHILE (error = 0) & (STRINGS.digit(s[i]) OR (s[i] = ".")) DO
IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") THEN IF s[i] = "." THEN
exp10 := 1.0;
INC(i)
ELSE
IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") & opFloat2(exp10, 10.0, "*") THEN
INC(i) INC(i)
ELSE ELSE
error := 4 error := 4
END END
END;
INC(i);
WHILE (error = 0) & STRINGS.digit(s[i]) DO
IF opFloat2(frac, 10.0, "*") & opFloat2(frac, FLT(digit[ORD(s[i])]), "+") THEN
exp10 := exp10 * 10.0;
INC(i)
ELSE
error := 4
END END
END; END;
IF ~opFloat2(value, frac / exp10, "+") THEN IF ~opFloat2(value, exp10, "/") THEN
error := 4 error := 4
END; END;

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -48,6 +48,7 @@ VAR
BEGIN BEGIN
options.lower := TRUE;
out := ""; out := "";
checking := options.checking; checking := options.checking;
_end := FALSE; _end := FALSE;
@ -133,6 +134,9 @@ BEGIN
ELSIF param = "-lower" THEN ELSIF param = "-lower" THEN
options.lower := TRUE options.lower := TRUE
ELSIF param = "-upper" THEN
options.lower := FALSE
ELSIF param = "-pic" THEN ELSIF param = "-pic" THEN
options.pic := TRUE options.pic := TRUE
@ -215,7 +219,7 @@ BEGIN
C.Ln; C.Ln;
C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor); C.String("Akron Oberon Compiler v"); C.Int(UTILS.vMajor); C.String("."); C.Int2(UTILS.vMinor);
C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date); C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit) " + UTILS.Date);
C.StringLn("Copyright (c) 2018-2022, Anton Krotov"); C.StringLn("Copyright (c) 2018-2023, Anton Krotov");
IF inname = "" THEN IF inname = "" THEN
C.Ln; C.Ln;
@ -243,7 +247,8 @@ BEGIN
C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln; C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,"); C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,");
C.StringLn(" BYTE, CHR, WCHR)"); C.Ln; C.StringLn(" BYTE, CHR, WCHR)"); C.Ln;
C.StringLn(" -lower allow lower case for keywords"); C.Ln; C.StringLn(" -lower allow lower case for keywords (default)"); C.Ln;
C.StringLn(" -upper only upper case for keywords"); C.Ln;
C.StringLn(" -def <identifier> define conditional compilation symbol"); C.Ln; C.StringLn(" -def <identifier> define conditional compilation symbol"); C.Ln;
C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln; C.StringLn(" -ver <major.minor> set version of program (KolibriOS DLL)"); C.Ln;
C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln; C.StringLn(" -ram <size> set size of RAM in bytes (MSP430) or Kbytes (STM32)"); C.Ln;

View File

@ -1,13 +1,13 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2021, Anton Krotov Copyright (c) 2018-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
MODULE FILES; MODULE FILES;
IMPORT UTILS, C := COLLECTIONS, CONSOLE; IMPORT UTILS, C := COLLECTIONS;
TYPE TYPE

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -24,7 +24,7 @@ CONST
opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11;
opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16;
opADD* = 17; opSUB* = 18; opONERR* = 19; opSUBL* = 20; opADDC* = 21; opSUBR* = 22; opADD* = 17; opSUB* = 18; opONERR* = 19; opSUBL* = 20; opADDC* = 21; opSUBR* = 22;
opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; (*opCHKBYTE* = 27;*) opDROP* = 28;
opNOT* = 29; opNOT* = 29;
opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *); opEQ* = 30; opNE* = opEQ + 1; opLT* = opEQ + 2; opLE* = opEQ + 3; opGT* = opEQ + 4; opGE* = opEQ + 5 (* 35 *);
@ -72,7 +72,7 @@ CONST
opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173;
opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opLENGTHW* = 179; opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opLENGTHW* = 179;
opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; (*opCHR* = 180;*) opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184;
opLSR* = 185; opLSR1* = 186; opLSR2* = 187; opLSR* = 185; opLSR1* = 186; opLSR2* = 187;
opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192; opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opSYSVALIGN16* = 192;
opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198; opEQB* = 193; opNEB* = 194; opINF* = 195; opWIN64ALIGN16* = 196; opVLOAD8* = 197; opGLOAD8* = 198;
@ -80,7 +80,7 @@ CONST
opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; opSAVE16C* = 213; (*opWCHR* = 214;*) opHANDLER* = 215;
opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; opFASTCALL* = 220; opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; opFASTCALL* = 220;
@ -265,12 +265,22 @@ BEGIN
END PutByte; END PutByte;
PROCEDURE AlignData (n: INTEGER);
BEGIN
WHILE CHL.Length(codes.data) MOD n # 0 DO
PutByte(0)
END
END AlignData;
PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER;
VAR VAR
i, n, res: INTEGER; i, n, res: INTEGER;
BEGIN BEGIN
IF TARGETS.WinLin THEN
AlignData(16)
END;
res := CHL.Length(codes.data); res := CHL.Length(codes.data);
i := 0; i := 0;
n := LENGTH(s); n := LENGTH(s);
WHILE i < n DO WHILE i < n DO
@ -290,6 +300,9 @@ VAR
BEGIN BEGIN
IF codes.charoffs[c] = -1 THEN IF codes.charoffs[c] = -1 THEN
IF TARGETS.WinLin THEN
AlignData(16)
END;
res := CHL.Length(codes.data); res := CHL.Length(codes.data);
PutByte(c); PutByte(c);
PutByte(0); PutByte(0);
@ -307,12 +320,12 @@ VAR
i, n, res: INTEGER; i, n, res: INTEGER;
BEGIN BEGIN
res := CHL.Length(codes.data); IF TARGETS.WinLin THEN
AlignData(16)
IF ODD(res) THEN ELSE
PutByte(0); AlignData(2)
INC(res)
END; END;
res := CHL.Length(codes.data);
n := STRINGS.Utf8To16(s, codes.wstr); n := STRINGS.Utf8To16(s, codes.wstr);
@ -341,12 +354,12 @@ VAR
BEGIN BEGIN
IF codes.wcharoffs[c] = -1 THEN IF codes.wcharoffs[c] = -1 THEN
res := CHL.Length(codes.data); IF TARGETS.WinLin THEN
AlignData(16)
IF ODD(res) THEN ELSE
PutByte(0); AlignData(2)
INC(res)
END; END;
res := CHL.Length(codes.data);
IF TARGETS.LittleEndian THEN IF TARGETS.LittleEndian THEN
PutByte(c MOD 256); PutByte(c MOD 256);

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019-2021, Anton Krotov Copyright (c) 2019-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -984,11 +984,6 @@ BEGIN
drop; drop;
Op2(opMOV + bw(param2 = 1), src_x(param1, SR), dst_x(0, reg2)) 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: |IL.opCHKIDX:
UnOp(reg1); UnOp(reg1);
Op2(opCMP, imm(param2), reg1); Op2(opCMP, imm(param2), reg1);
@ -1412,10 +1407,6 @@ BEGIN
Test(ACC); Test(ACC);
jcc(jne, param1) jcc(jne, param1)
|IL.opCHR:
UnOp(reg1);
Op2(opAND, imm(255), reg1)
|IL.opABS: |IL.opABS:
UnOp(reg1); UnOp(reg1);
Test(reg1); Test(reg1);

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -41,6 +41,7 @@ CONST
sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38; sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38;
sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42; sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42;
sysDINT* = 43;*)sysGET8* = 44; sysGET16* = 45; sysGET32* = 46; sysDINT* = 43;*)sysGET8* = 44; sysGET16* = 45; sysGET32* = 46;
sysVAL* = 47;
default32* = 2; _default32* = default32 + 1; default32* = 2; _default32* = default32 + 1;
stdcall* = 4; _stdcall* = stdcall + 1; stdcall* = 4; _stdcall* = stdcall + 1;
@ -239,13 +240,18 @@ END NewIdent;
PROCEDURE getOffset* (varIdent: IDENT): INTEGER; PROCEDURE getOffset* (varIdent: IDENT): INTEGER;
VAR VAR
size: INTEGER; size, glob_align: INTEGER;
BEGIN BEGIN
IF varIdent.offset = -1 THEN IF varIdent.offset = -1 THEN
size := varIdent._type.size; size := varIdent._type.size;
IF varIdent.global THEN IF varIdent.global THEN
IF UTILS.Align(program.bss, varIdent._type.align) THEN IF TARGETS.WinLin THEN
glob_align := 16
ELSE
glob_align := varIdent._type.align
END;
IF UTILS.Align(program.bss, glob_align) THEN
IF UTILS.maxint - program.bss >= size THEN IF UTILS.maxint - program.bss >= size THEN
varIdent.offset := program.bss; varIdent.offset := program.bss;
INC(program.bss, size) INC(program.bss, size)
@ -1109,6 +1115,7 @@ BEGIN
EnterProc(unit, "put8", idSYSPROC, sysPUT8); EnterProc(unit, "put8", idSYSPROC, sysPUT8);
EnterProc(unit, "code", idSYSPROC, sysCODE); EnterProc(unit, "code", idSYSPROC, sysCODE);
EnterProc(unit, "move", idSYSPROC, sysMOVE); EnterProc(unit, "move", idSYSPROC, sysMOVE);
EnterProc(unit, "val", idSYSPROC, sysVAL);
(* (*
IF program.target.sys = mConst.Target_iMSP430 THEN IF program.target.sys = mConst.Target_iMSP430 THEN
EnterProc(unit, "nop", idSYSPROC, sysNOP); EnterProc(unit, "nop", idSYSPROC, sysNOP);
@ -1256,7 +1263,11 @@ BEGIN
IF TARGETS.RealSize # 0 THEN IF TARGETS.RealSize # 0 THEN
program.stTypes.tREAL := enterType(tREAL, TARGETS.RealSize, 0, NIL); program.stTypes.tREAL := enterType(tREAL, TARGETS.RealSize, 0, NIL);
IF TARGETS.OS = TARGETS.osLINUX32 THEN
program.stTypes.tREAL.align := 4
ELSE
program.stTypes.tREAL.align := TARGETS.RealSize program.stTypes.tREAL.align := TARGETS.RealSize
END
END; END;
program.stTypes.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL); program.stTypes.tSTRING := enterType(tSTRING, TARGETS.WordSize, 0, NIL);

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2020-2021, Anton Krotov Copyright (c) 2020-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -790,14 +790,6 @@ BEGIN
UnOp(r1); UnOp(r1);
Emit(opLSRC, r1, param2 MOD (szWord * 8)) 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: |IL.opABS:
UnOp(r1); UnOp(r1);
Emit(opCMPC, r1, 0); Emit(opCMPC, r1, 0);
@ -958,11 +950,6 @@ BEGIN
END; END;
drop drop
|IL.opCHKBYTE:
BinOp(r1, r2);
Emit(opCMPC, r1, 256);
Emit(opJBT, param1, 0)
|IL.opCHKIDX: |IL.opCHKIDX:
UnOp(r1); UnOp(r1);
Emit(opCMPC, r1, param2); Emit(opCMPC, r1, param2);

View File

@ -402,12 +402,6 @@ BEGIN
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
END END
ELSE ELSE
IF chkBYTE IN Options.checking THEN
label := IL.NewLabel();
IL.AddCmd2(IL.opCHKBYTE, label, 0);
IL.OnError(line, errBYTE);
IL.SetLabel(label)
END;
IL.AddCmd0(IL.opSAVE8) IL.AddCmd0(IL.opSAVE8)
END END
END END
@ -1062,7 +1056,7 @@ BEGIN
IF chkCHR IN Options.checking THEN IF chkCHR IN Options.checking THEN
CheckRange(256, pos.line, errCHR) CheckRange(256, pos.line, errCHR)
ELSE ELSE
IL.AddCmd0(IL.opCHR) IL.AddCmd(IL.opMODR, 256)
END END
END END
@ -1077,7 +1071,7 @@ BEGIN
IF chkWCHR IN Options.checking THEN IF chkWCHR IN Options.checking THEN
CheckRange(65536, pos.line, errWCHR) CheckRange(65536, pos.line, errWCHR)
ELSE ELSE
IL.AddCmd0(IL.opWCHR) IL.AddCmd(IL.opMODR, 65536)
END END
END END
@ -1392,6 +1386,8 @@ VAR
field: PROG.FIELD; field: PROG.FIELD;
pos: PARS.POSITION; pos: PARS.POSITION;
t, idx: PARS.EXPR; t, idx: PARS.EXPR;
sysVal: BOOLEAN;
n: INTEGER;
PROCEDURE LoadAdr (e: PARS.EXPR); PROCEDURE LoadAdr (e: PARS.EXPR);
@ -1444,7 +1440,6 @@ VAR
_type: PROG._TYPE; _type: PROG._TYPE;
BEGIN BEGIN
IF chkIDX IN Options.checking THEN IF chkIDX IN Options.checking THEN
label := IL.NewLabel(); label := IL.NewLabel();
IL.AddCmd2(IL.opCHKIDX2, label, 0); IL.AddCmd2(IL.opCHKIDX2, label, 0);
@ -1477,12 +1472,35 @@ VAR
BEGIN BEGIN
qualident(parser, e); qualident(parser, e);
sysVal := (e.obj = eSYSPROC) & (e.stproc = PROG.sysVAL);
IF sysVal THEN
PARS.checklex(parser, SCAN.lxLROUND);
PARS.Next(parser);
getpos(parser, pos);
designator(parser, e);
PARS.check(isVar(e), pos, 93);
IF PROG.isOpenArray(e._type) THEN
n := PROG.Dim(e._type);
WHILE n > 0 DO
IL.drop;
DEC(n)
END
END;
PARS.checklex(parser, SCAN.lxCOMMA);
PARS.Next(parser);
getpos(parser, pos);
qualident(parser, t);
PARS.check(t.obj = eTYPE, pos, 79);
e._type := t._type;
PARS.checklex(parser, SCAN.lxRROUND);
PARS.Next(parser)
END;
IF e.obj IN {ePROC, eIMP} THEN IF e.obj IN {ePROC, eIMP} THEN
PROG.UseProc(parser.unit, e.ident.proc) PROG.UseProc(parser.unit, e.ident.proc)
END; END;
IF isVar(e) THEN IF isVar(e) & ~sysVal THEN
LoadAdr(e) LoadAdr(e)
END; END;
@ -2599,6 +2617,9 @@ BEGIN
NextPos(parser, pos); NextPos(parser, pos);
expression(parser, e1); expression(parser, e1);
IF (e._type.typ = PROG.tBYTE) & (e1.obj # eCONST) & (e1._type.typ = PROG.tINTEGER) & (chkBYTE IN Options.checking) THEN
CheckRange(256, pos.line, errBYTE)
END;
IL.setlast(endcall.prev(IL.COMMAND)); IL.setlast(endcall.prev(IL.COMMAND));

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019-2021, Anton Krotov Copyright (c) 2019-2021, 2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -67,7 +67,7 @@ VAR
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER; target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER;
ComLinePar*, LibDir*, FileExt*: STRING; ComLinePar*, LibDir*, FileExt*: STRING;
Import*, Dispose*, RTL*, Dll*, LittleEndian*: BOOLEAN; Import*, Dispose*, RTL*, Dll*, LittleEndian*, WinLin*: BOOLEAN;
PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING); PROCEDURE Enter (idx, CPU, RealSize, OS: INTEGER; ComLinePar, LibDir, FileExt: STRING);
@ -110,6 +110,7 @@ BEGIN
Dispose := ~(target IN noDISPOSE); Dispose := ~(target IN noDISPOSE);
RTL := ~(target IN noRTL); RTL := ~(target IN noRTL);
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL}; Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
WinLin := OS IN {osWIN32, osLINUX32, osWIN64, osLINUX64};
WordSize := BitDepth DIV 8; WordSize := BitDepth DIV 8;
AdrSize := WordSize AdrSize := WordSize
END END

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2019-2021, Anton Krotov Copyright (c) 2019-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -91,6 +91,10 @@ TYPE
RELOCCODE = ARRAY 7 OF INTEGER; RELOCCODE = ARRAY 7 OF INTEGER;
MEM = RECORD
start, size, startReserve, endReserve: INTEGER
END;
VAR VAR
@ -105,11 +109,9 @@ VAR
StkCount: INTEGER; StkCount: INTEGER;
Target: RECORD Target: RECORD
FlashAdr, flash, sram: MEM;
SRAMAdr,
IVTLen, IVTLen,
MinStack, MinStkSize: INTEGER;
Reserved: INTEGER;
InstrSet: SET; InstrSet: SET;
isNXP: BOOLEAN isNXP: BOOLEAN
END; END;
@ -1151,14 +1153,13 @@ BEGIN
PushAll(0) PushAll(0)
|IL.opPARAM: |IL.opPARAM:
n := param2; IF param2 = 1 THEN
IF n = 1 THEN
UnOp(r1); UnOp(r1);
push(r1); push(r1);
drop drop
ELSE ELSE
ASSERT(R.top + 1 <= n); ASSERT(R.top + 1 <= param2);
PushAll(n) PushAll(param2)
END END
|IL.opCLEANUP: |IL.opCLEANUP:
@ -1587,14 +1588,6 @@ BEGIN
Tst(r1); Tst(r1);
SetCC(jne, 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: |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
BinOp(r1, r2); BinOp(r1, r2);
Shift(opcode, r1, r2); Shift(opcode, r1, r2);
@ -1620,11 +1613,6 @@ BEGIN
END END
END END
|IL.opCHKBYTE:
BinOp(r1, r2);
CmpConst(r1, 256);
jcc(jb, param1)
|IL.opCHKIDX: |IL.opCHKIDX:
UnOp(r1); UnOp(r1);
CmpConst(r1, param2); CmpConst(r1, param2);
@ -2344,33 +2332,36 @@ BEGIN
END epilog; END epilog;
PROCEDURE SetTarget (FlashStart, SRAMStart: INTEGER; InstrSet: SET; isNXP: BOOLEAN); PROCEDURE SetTarget (FlashStart, FlashSize, FlashReserve, SRAMStart, SRAMSize, SRAMReserve: INTEGER; InstrSet: SET; isNXP: BOOLEAN);
BEGIN BEGIN
Target.FlashAdr := FlashStart; Target.flash.start := FlashStart;
Target.SRAMAdr := SRAMStart; Target.flash.size := FlashSize;
(*Target.flash.startReserve := 0;*)
Target.flash.endReserve := FlashReserve;
Target.sram.start := SRAMStart;
Target.sram.size := SRAMSize;
Target.sram.startReserve := 0;
Target.sram.endReserve := SRAMReserve;
Target.InstrSet := InstrSet; Target.InstrSet := InstrSet;
Target.isNXP := isNXP; Target.isNXP := isNXP;
Target.IVTLen := 256; (* >= 192 *) Target.IVTLen := 256; (* >= 192 *)
Target.Reserved := 0; Target.MinStkSize := 256;
Target.MinStack := 512;
END SetTarget; END SetTarget;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR VAR
opt: PROG.OPTIONS; opt: PROG.OPTIONS;
i, j, DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
ram, rom, i, j: INTEGER;
DataAdr, BssAdr, DataSize, BssSize, CodeSize: INTEGER;
BEGIN BEGIN
ram := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
rom := MIN(MAX(options.rom, minROM), maxROM) * 1024;
IF target = TARGETS.STM32CM3 THEN IF target = TARGETS.STM32CM3 THEN
SetTarget(08000000H, 20000000H, CortexM3, FALSE) SetTarget(08000000H, MIN(MAX(options.rom, minROM), maxROM) * 1024, 0,
20000000H, MIN(MAX(options.ram, minRAM), maxRAM) * 1024, 0,
CortexM3, FALSE)
END; END;
tcount := CHL.Length(IL.codes.types); tcount := CHL.Length(IL.codes.types);
@ -2384,33 +2375,33 @@ BEGIN
StkCount := 0; StkCount := 0;
DataAdr := Target.SRAMAdr + Target.Reserved; DataAdr := Target.sram.start + Target.sram.startReserve;
DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved; DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.sram.startReserve;
WHILE DataSize MOD 4 # 0 DO WHILE DataSize MOD 4 # 0 DO
CHL.PushByte(IL.codes.data, 0); CHL.PushByte(IL.codes.data, 0);
INC(DataSize) INC(DataSize)
END; END;
BssAdr := DataAdr + DataSize - Target.Reserved; BssAdr := DataAdr + DataSize - Target.sram.startReserve;
IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4))); IL.set_bss(MAX(IL.codes.bss, MAX(IL.codes.dmin - CHL.Length(IL.codes.data), 4)));
BssSize := IL.codes.bss; BssSize := IL.codes.bss;
ASSERT(UTILS.Align(BssSize, 4)); ASSERT(UTILS.Align(BssSize, 4));
prolog(BssSize, tcount, ORD(opt.pic), Target.SRAMAdr + ram, Target.IVTLen); prolog(BssSize, tcount, ORD(opt.pic), Target.sram.start + Target.sram.size - Target.sram.endReserve, Target.IVTLen);
translate(ORD(opt.pic), tcount * 4); translate(ORD(opt.pic), tcount * 4);
epilog; epilog;
fixup(Target.FlashAdr, DataAdr, BssAdr); fixup(Target.flash.start, DataAdr, BssAdr);
INC(DataSize, BssSize); INC(DataSize, BssSize);
CodeSize := CHL.Length(program.code); CodeSize := CHL.Length(program.code);
IF CodeSize > rom THEN IF CodeSize > Target.flash.size - Target.flash.endReserve THEN
ERRORS.Error(203) ERRORS.Error(203)
END; END;
IF DataSize > ram - Target.MinStack THEN IF DataSize > Target.sram.size - Target.MinStkSize - Target.sram.endReserve THEN
ERRORS.Error(204) ERRORS.Error(204)
END; END;
@ -2426,15 +2417,17 @@ BEGIN
WR.Create(outname); WR.Create(outname);
HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr)); HEX.Data2(program.code, 0, CodeSize, high(Target.flash.start));
HEX.End; HEX.End;
WR.Close; WR.Close;
C.Dashes; 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.String( " rom: "); C.Int(CodeSize); C.String(" of "); C.Int(Target.flash.size - Target.flash.endReserve);
C.String(" ("); C.Int(CodeSize * 100 DIV (Target.flash.size - Target.flash.endReserve)); C.StringLn("%)");
C.Ln; C.Ln;
C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(ram); C.String(" ("); C.Int(DataSize * 100 DIV ram); C.StringLn("%)") C.String( " ram: "); C.Int(DataSize); C.String(" of "); C.Int(Target.sram.size - Target.sram.endReserve);
C.String(" ("); C.Int(DataSize * 100 DIV (Target.sram.size - Target.sram.endReserve)); C.StringLn("%)")
END CodeGen; END CodeGen;

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -23,8 +23,8 @@ CONST
max32* = 2147483647; max32* = 2147483647;
vMajor* = 1; vMajor* = 1;
vMinor* = 57; vMinor* = 63;
Date* = "31-aug-2022"; Date* = "21-jan-2023";
FILE_EXT* = ".ob07"; FILE_EXT* = ".ob07";
RTL_NAME* = "RTL"; RTL_NAME* = "RTL";

View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov Copyright (c) 2018-2023, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -954,14 +954,13 @@ BEGIN
jmp(param1) jmp(param1)
|IL.opPARAM: |IL.opPARAM:
n := param2; IF param2 = 1 THEN
IF n = 1 THEN
UnOp(reg1); UnOp(reg1);
push(reg1); push(reg1);
drop drop
ELSE ELSE
ASSERT(R.top + 1 <= n); ASSERT(R.top + 1 <= param2);
PushAll(n) PushAll(param2)
END END
|IL.opCLEANUP: |IL.opCLEANUP:
@ -1438,11 +1437,6 @@ BEGIN
pushc(param1); pushc(param1);
CallRTL(pic, IL._move) CallRTL(pic, IL._move)
|IL.opCHKBYTE:
BinOp(reg1, reg2);
cmprc(reg1, 256);
jcc(jb, param1)
|IL.opCHKIDX: |IL.opCHKIDX:
UnOp(reg1); UnOp(reg1);
cmprc(reg1, param2); cmprc(reg1, param2);
@ -1557,14 +1551,6 @@ BEGIN
CallRTL(pic, IL._lengthw); CallRTL(pic, IL._lengthw);
GetRegA GetRegA
|IL.opCHR:
UnOp(reg1);
andrc(reg1, 255)
|IL.opWCHR:
UnOp(reg1);
andrc(reg1, 65535)
|IL.opASR, IL.opROR, IL.opLSL, IL.opLSR: |IL.opASR, IL.opROR, IL.opLSL, IL.opLSR:
UnOp(reg1); UnOp(reg1);
IF reg1 # ecx THEN IF reg1 # ecx THEN
@ -1828,8 +1814,17 @@ BEGIN
|IL.opNEW: |IL.opNEW:
PushAll(1); PushAll(1);
CASE TARGETS.OS OF
|TARGETS.osWIN32:
n := param2 + 4;
ASSERT(UTILS.Align(n, 4))
|TARGETS.osLINUX32:
n := param2 + 16;
ASSERT(UTILS.Align(n, 16))
|TARGETS.osKOS:
n := param2 + 8; n := param2 + 8;
ASSERT(UTILS.Align(n, 32)); ASSERT(UTILS.Align(n, 32))
END;
pushc(n); pushc(n);
pushc(param1); pushc(param1);
CallRTL(pic, IL._new) CallRTL(pic, IL._new)
@ -2444,6 +2439,19 @@ BEGIN
END epilog; END epilog;
PROCEDURE align16* (bit64: BOOLEAN);
BEGIN
IF TARGETS.WinLin THEN
WHILE CHL.Length(IL.codes.data) MOD 16 # 0 DO
CHL.PushByte(IL.codes.data, 0)
END;
WHILE CHL.Length(IL.codes.types) MOD (4 - 2*ORD(bit64)) # 0 DO
CHL.PushInt(IL.codes.types, 0)
END
END
END align16;
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
VAR VAR
dllret, dllinit, sofinit: INTEGER; dllret, dllinit, sofinit: INTEGER;
@ -2451,6 +2459,7 @@ VAR
BEGIN BEGIN
FR[0] := 0; FR[0] := 0;
align16(FALSE);
tcount := CHL.Length(IL.codes.types); tcount := CHL.Length(IL.codes.types);
opt := options; opt := options;
@ -2476,7 +2485,6 @@ BEGIN
epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);
BIN.fixup(program); BIN.fixup(program);
IF TARGETS.OS = TARGETS.osWIN32 THEN IF TARGETS.OS = TARGETS.osWIN32 THEN
PE32.write(program, outname, target = TARGETS.Win32C, target = TARGETS.Win32DLL, FALSE) PE32.write(program, outname, target = TARGETS.Win32C, target = TARGETS.Win32DLL, FALSE)
ELSIF target = TARGETS.KolibriOS THEN ELSIF target = TARGETS.KolibriOS THEN
@ -2486,7 +2494,6 @@ BEGIN
ELSIF TARGETS.OS = TARGETS.osLINUX32 THEN ELSIF TARGETS.OS = TARGETS.osLINUX32 THEN
ELF.write(program, outname, sofinit, target = TARGETS.Linux32SO, FALSE) ELF.write(program, outname, sofinit, target = TARGETS.Linux32SO, FALSE)
END END
END CodeGen; END CodeGen;