KolibriOS/kolibrios
13
4
Fork 11
Code Issues 78 Pull Requests 5 Projects Releases Activity

oberon07: lower case by default

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
programs/develop/cedit/SRC/Icons.ob07
View File

@ -1,5 +1,5 @@
(*
Copyright 2021, 2022 Anton Krotov
Copyright 2021-2023 Anton Krotov
This file is part of CEdit.
@ -20,27 +20,27 @@
MODULE Icons;
IMPORT
Graph, File, SYSTEM, KOSAPI;
Graph, File, SYSTEM, KOSAPI;
CONST
fileName = "/sys/Icons16.png";
SIZE* = 18;
fileName = "/sys/Icons16.png";
SIZE* = 18;
VAR
source: INTEGER;
source: INTEGER;
(*
PROCEDURE copy (src, dst: INTEGER);
VAR
src_width, src_height,
dst_width, dst_height,
src_data, dst_data: INTEGER;
src_width, src_height,
dst_width, dst_height,
src_data, dst_data: INTEGER;
BEGIN
LibImg.GetInf(src, src_width, src_height, src_data);
LibImg.GetInf(dst, dst_width, dst_height, dst_data);
ASSERT(src_width = dst_width);
ASSERT(src_height = dst_height);
SYSTEM.MOVE(src_data, dst_data, src_width*src_height*4)
LibImg.GetInf(src, src_width, src_height, src_data);
LibImg.GetInf(dst, dst_width, dst_height, dst_data);
ASSERT(src_width = dst_width);
ASSERT(src_height = dst_height);
SYSTEM.MOVE(src_data, dst_data, src_width*src_height*4)
END copy;
*)
@ -50,93 +50,93 @@ PROCEDURE [stdcall, "Libimg.obj", ""] img_destroy (img: INTEGER); END;
PROCEDURE GetInf (img: INTEGER; VAR width, height, data: INTEGER);
BEGIN
SYSTEM.GET(img + 4, width);
SYSTEM.GET(img + 8, height);
SYSTEM.GET(img + 24, data);
SYSTEM.GET(img + 4, width);
SYSTEM.GET(img + 8, height);
SYSTEM.GET(img + 24, data);
END GetInf;
PROCEDURE GetImg (ptr, size: INTEGER): INTEGER;
VAR
image_data, dst, x, type: INTEGER;
image_data, dst, x, Type: INTEGER;
BEGIN
image_data := img_decode(ptr, size, 0);
IF image_data # 0 THEN
SYSTEM.GET(image_data + 4, x);
ASSERT(x = SIZE);
SYSTEM.GET(image_data + 20, type);
IF type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data);
image_data := dst
END
END
RETURN image_data
image_data := img_decode(ptr, size, 0);
IF image_data # 0 THEN
SYSTEM.GET(image_data + 4, x);
ASSERT(x = SIZE);
SYSTEM.GET(image_data + 20, Type);
IF Type # 3 THEN
dst := img_convert(image_data, 0, 3, 0, 0);
img_destroy(image_data);
image_data := dst
END
END
RETURN image_data
END GetImg;
PROCEDURE load (): INTEGER;
VAR
size, res, ptr: INTEGER;
size, res, ptr: INTEGER;
BEGIN
res := 0;
ptr := File.Load(fileName, size);
IF ptr # 0 THEN
res := GetImg(ptr, size);
ptr := KOSAPI.free(ptr)
END
RETURN res
res := 0;
ptr := File.Load(fileName, size);
IF ptr # 0 THEN
res := GetImg(ptr, size);
ptr := KOSAPI.free(ptr)
END
RETURN res
END load;
PROCEDURE draw* (icons, n, x, y: INTEGER);
VAR
width, height, data: INTEGER;
width, height, data: INTEGER;
BEGIN
GetInf(icons, width, height, data);
KOSAPI.sysfunc7(65, data + SIZE*SIZE*4*n, SIZE*65536 + SIZE, x*65536 + y, 32, 0, 0)
GetInf(icons, width, height, data);
KOSAPI.sysfunc7(65, data + SIZE*SIZE*4*n, SIZE*65536 + SIZE, x*65536 + y, 32, 0, 0)
END draw;
PROCEDURE iconsBackColor (icons: INTEGER; BackColor: INTEGER);
VAR
width, height, data, x, y, pix: INTEGER;
b, g, r, gr: BYTE;
width, height, data, x, y, pix: INTEGER;
b, g, r, gr: BYTE;
BEGIN
GetInf(icons, width, height, data);
FOR y := 0 TO height - 1 DO
FOR x := 0 TO width - 1 DO
SYSTEM.GET32(data, pix);
Graph.getRGB(pix, r, g, b);
gr := (r + g + b) DIV 3;
IF BackColor = -1 THEN
pix := gr + 256*gr + 65536*gr
ELSIF gr = 255 THEN
pix := BackColor
END;
SYSTEM.PUT32(data, pix);
INC(data, 4)
END
END
GetInf(icons, width, height, data);
FOR y := 0 TO height - 1 DO
FOR x := 0 TO width - 1 DO
SYSTEM.GET32(data, pix);
Graph.getRGB(pix, r, g, b);
gr := (r + g + b) DIV 3;
IF BackColor = -1 THEN
pix := gr + 256*gr + 65536*gr
ELSIF gr = 255 THEN
pix := BackColor
END;
SYSTEM.PUT32(data, pix);
INC(data, 4)
END
END
END iconsBackColor;
PROCEDURE get* (VAR icons, grayIcons: INTEGER; BackColor: INTEGER);
BEGIN
IF source = 0 THEN
source := load();
icons := load();
grayIcons := load();
iconsBackColor(grayIcons, -1);
iconsBackColor(grayIcons, BackColor);
iconsBackColor(icons, BackColor)
(*ELSE
copy(source, icons);
copy(source, grayIcons)*)
END
IF source = 0 THEN
source := load();
icons := load();
grayIcons := load();
iconsBackColor(grayIcons, -1);
iconsBackColor(grayIcons, BackColor);
iconsBackColor(icons, BackColor)
(*ELSE
copy(source, icons);
copy(source, grayIcons)*)
END
END get;
BEGIN
source := 0
source := 0
END Icons.

BIN
programs/develop/oberon07/Compiler.kex
View File

Binary file not shown.

2
programs/develop/oberon07/LICENSE
View File

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

312
programs/develop/oberon07/doc/WinLib.txt
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

17
programs/develop/oberon07/doc/x86.txt
View File

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

397
programs/develop/oberon07/doc/x86_64.txt
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-библиотек.

5
programs/develop/oberon07/lib/KolibriOS/Math.ob07
View File

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

27
programs/develop/oberon07/source/AMD64.ob07
View File

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

31
programs/develop/oberon07/source/ARITH.ob07
View File

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

11
programs/develop/oberon07/source/Compiler.ob07
View File

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov
Copyright (c) 2018-2023, Anton Krotov
All rights reserved.
*)
@ -48,6 +48,7 @@ VAR
BEGIN
options.lower := TRUE;
out := "";
checking := options.checking;
_end := FALSE;
@ -133,6 +134,9 @@ BEGIN
ELSIF param = "-lower" THEN
options.lower := TRUE
ELSIF param = "-upper" THEN
options.lower := FALSE
ELSIF param = "-pic" THEN
options.pic := TRUE
@ -215,7 +219,7 @@ BEGIN
C.Ln;
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.StringLn("Copyright (c) 2018-2022, Anton Krotov");
C.StringLn("Copyright (c) 2018-2023, Anton Krotov");
IF inname = "" THEN
C.Ln;
@ -243,7 +247,8 @@ BEGIN
C.StringLn(" -stk <size> set size of stack in Mbytes (Windows, Linux, KolibriOS)"); C.Ln;
C.StringLn(" -nochk <'ptibcwra'> disable runtime checking (pointers, types, indexes,");
C.StringLn(" BYTE, CHR, WCHR)"); C.Ln;
C.StringLn(" -lower allow lower case for keywords"); C.Ln;
C.StringLn(" -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(" -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;

4
programs/develop/oberon07/source/FILES.ob07
View File

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

43
programs/develop/oberon07/source/IL.ob07
View File

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2018-2022, Anton Krotov
Copyright (c) 2018-2023, Anton Krotov
All rights reserved.
*)
@ -24,7 +24,7 @@ CONST
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;
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 *);
@ -72,7 +72,7 @@ CONST
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;
(*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;
@ -80,7 +80,7 @@ CONST
opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206;
opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212;
opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215;
opSAVE16C* = 213; (*opWCHR* = 214;*) opHANDLER* = 215;
opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; opFASTCALL* = 220;
@ -265,12 +265,22 @@ BEGIN
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;
VAR
i, n, res: INTEGER;
BEGIN
IF TARGETS.WinLin THEN
AlignData(16)
END;
res := CHL.Length(codes.data);
i := 0;
n := LENGTH(s);
WHILE i < n DO
@ -290,6 +300,9 @@ VAR
BEGIN
IF codes.charoffs[c] = -1 THEN
IF TARGETS.WinLin THEN
AlignData(16)
END;
res := CHL.Length(codes.data);
PutByte(c);
PutByte(0);
@ -307,12 +320,12 @@ VAR
i, n, res: INTEGER;
BEGIN
res := CHL.Length(codes.data);
IF ODD(res) THEN
PutByte(0);
INC(res)
IF TARGETS.WinLin THEN
AlignData(16)
ELSE
AlignData(2)
END;
res := CHL.Length(codes.data);
n := STRINGS.Utf8To16(s, codes.wstr);
@ -341,12 +354,12 @@ VAR
BEGIN
IF codes.wcharoffs[c] = -1 THEN
res := CHL.Length(codes.data);
IF ODD(res) THEN
PutByte(0);
INC(res)
IF TARGETS.WinLin THEN
AlignData(16)
ELSE
AlignData(2)
END;
res := CHL.Length(codes.data);
IF TARGETS.LittleEndian THEN
PutByte(c MOD 256);

11
programs/develop/oberon07/source/MSP430.ob07
View File

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

19
programs/develop/oberon07/source/PROG.ob07
View File

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

15
programs/develop/oberon07/source/RVMxI.ob07
View File

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

41
programs/develop/oberon07/source/STATEMENTS.ob07
View File

@ -402,12 +402,6 @@ BEGIN
IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
END
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)
END
END
@ -1062,7 +1056,7 @@ BEGIN
IF chkCHR IN Options.checking THEN
CheckRange(256, pos.line, errCHR)
ELSE
IL.AddCmd0(IL.opCHR)
IL.AddCmd(IL.opMODR, 256)
END
END
@ -1077,7 +1071,7 @@ BEGIN
IF chkWCHR IN Options.checking THEN
CheckRange(65536, pos.line, errWCHR)
ELSE
IL.AddCmd0(IL.opWCHR)
IL.AddCmd(IL.opMODR, 65536)
END
END
@ -1392,6 +1386,8 @@ VAR
field: PROG.FIELD;
pos: PARS.POSITION;
t, idx: PARS.EXPR;
sysVal: BOOLEAN;
n: INTEGER;
PROCEDURE LoadAdr (e: PARS.EXPR);
@ -1444,7 +1440,6 @@ VAR
_type: PROG._TYPE;
BEGIN
IF chkIDX IN Options.checking THEN
label := IL.NewLabel();
IL.AddCmd2(IL.opCHKIDX2, label, 0);
@ -1477,12 +1472,35 @@ VAR
BEGIN
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
PROG.UseProc(parser.unit, e.ident.proc)
END;
IF isVar(e) THEN
IF isVar(e) & ~sysVal THEN
LoadAdr(e)
END;
@ -2599,6 +2617,9 @@ BEGIN
NextPos(parser, pos);
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));

5
programs/develop/oberon07/source/TARGETS.ob07
View File

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2019-2021, Anton Krotov
Copyright (c) 2019-2021, 2023, Anton Krotov
All rights reserved.
*)
@ -67,7 +67,7 @@ VAR
target*, CPU*, BitDepth*, OS*, RealSize*, WordSize*, AdrSize*, InstrSize*: INTEGER;
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);
@ -110,6 +110,7 @@ BEGIN
Dispose := ~(target IN noDISPOSE);
RTL := ~(target IN noRTL);
Dll := target IN {Linux32SO, Linux64SO, Win32DLL, Win64DLL, KolibriOSDLL};
WinLin := OS IN {osWIN32, osLINUX32, osWIN64, osLINUX64};
WordSize := BitDepth DIV 8;
AdrSize := WordSize
END

85
programs/develop/oberon07/source/THUMB.ob07
View File

@ -1,7 +1,7 @@
(*
BSD 2-Clause License
Copyright (c) 2019-2021, Anton Krotov
Copyright (c) 2019-2022, Anton Krotov
All rights reserved.
*)
@ -91,6 +91,10 @@ TYPE
RELOCCODE = ARRAY 7 OF INTEGER;
MEM = RECORD
start, size, startReserve, endReserve: INTEGER
END;
VAR
@ -105,11 +109,9 @@ VAR
StkCount: INTEGER;
Target: RECORD
FlashAdr,
SRAMAdr,
flash, sram: MEM;
IVTLen,
MinStack,
Reserved: INTEGER;
MinStkSize: INTEGER;
InstrSet: SET;
isNXP: BOOLEAN
END;
@ -1151,14 +1153,13 @@ BEGIN
PushAll(0)
|IL.opPARAM:
n := param2;
IF n = 1 THEN
IF param2 = 1 THEN
UnOp(r1);
push(r1);
drop
ELSE
ASSERT(R.top + 1 <= n);
PushAll(n)
ASSERT(R.top + 1 <= param2);
PushAll(param2)
END
|IL.opCLEANUP:
@ -1587,14 +1588,6 @@ BEGIN
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);
@ -1620,11 +1613,6 @@ BEGIN
END
END
|IL.opCHKBYTE:
BinOp(r1, r2);
CmpConst(r1, 256);
jcc(jb, param1)
|IL.opCHKIDX:
UnOp(r1);
CmpConst(r1, param2);
@ -2344,33 +2332,36 @@ BEGIN
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
Target.FlashAdr := FlashStart;
Target.SRAMAdr := SRAMStart;
Target.flash.start := FlashStart;
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.isNXP := isNXP;
Target.IVTLen := 256; (* >= 192 *)
Target.Reserved := 0;
Target.MinStack := 512;
Target.IVTLen := 256; (* >= 192 *)
Target.MinStkSize := 256;
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;
i, j, 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)
SetTarget(08000000H, MIN(MAX(options.rom, minROM), maxROM) * 1024, 0,
20000000H, MIN(MAX(options.ram, minRAM), maxRAM) * 1024, 0,
CortexM3, FALSE)
END;
tcount := CHL.Length(IL.codes.types);
@ -2384,33 +2375,33 @@ BEGIN
StkCount := 0;
DataAdr := Target.SRAMAdr + Target.Reserved;
DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.Reserved;
DataAdr := Target.sram.start + Target.sram.startReserve;
DataSize := CHL.Length(IL.codes.data) + tcount * 4 + Target.sram.startReserve;
WHILE DataSize MOD 4 # 0 DO
CHL.PushByte(IL.codes.data, 0);
INC(DataSize)
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)));
BssSize := IL.codes.bss;
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);
epilog;
fixup(Target.FlashAdr, DataAdr, BssAdr);
fixup(Target.flash.start, DataAdr, BssAdr);
INC(DataSize, BssSize);
CodeSize := CHL.Length(program.code);
IF CodeSize > rom THEN
IF CodeSize > Target.flash.size - Target.flash.endReserve THEN
ERRORS.Error(203)
END;
IF DataSize > ram - Target.MinStack THEN
IF DataSize > Target.sram.size - Target.MinStkSize - Target.sram.endReserve THEN
ERRORS.Error(204)
END;
@ -2426,15 +2417,17 @@ BEGIN
WR.Create(outname);
HEX.Data2(program.code, 0, CodeSize, high(Target.FlashAdr));
HEX.Data2(program.code, 0, CodeSize, high(Target.flash.start));
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.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.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;

6
programs/develop/oberon07/source/UTILS.ob07
View File

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

51
programs/develop/oberon07/source/X86.ob07
View File

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