mirror of
https://github.com/AntKrotov/oberon-07-compiler.git
synced 2026-10-05 09:45:47 +00:00
v1.35
- улучшеный синтаксис импорта внешних процедур - флаг [oberon] - конкатенация строковых констант
This commit is contained in:
1 parent
0ee4deae01
commit
08ebb99934
24 files changed
+196
-93
No files matched your search
Binary file not shown.
+12
-2
@@ -51,8 +51,9 @@ UTF-8 с BOM-сигнатурой.
|
||||
6. Добавлены однострочные комментарии (начинаются с пары символов "//")
|
||||
7. Разрешено наследование от типа-указателя
|
||||
8. "Строки" можно заключать также в одиночные кавычки: 'строка'
|
||||
9. Добавлены кодовые процедуры
|
||||
10. Не реализована вещественная арифметика
|
||||
9. Добавлена операция конкатенации строковых и символьных констант
|
||||
10. Добавлены кодовые процедуры
|
||||
11. Не реализована вещественная арифметика
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Особенности реализации
|
||||
@@ -167,6 +168,15 @@ UTF-8 с BOM-сигнатурой.
|
||||
необязательна. Если значение x не соответствует ни одному варианту и ELSE
|
||||
отсутствует, то программа прерывается с ошибкой времени выполнения.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Конкатенация строковых и символьных констант
|
||||
|
||||
Допускается конкатенация ("+") константных строк и символов типа CHAR:
|
||||
|
||||
str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
|
||||
|
||||
newline = 0DX + 0AX;
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Проверка и охрана типа нулевого указателя
|
||||
|
||||
|
||||
+11
-1
@@ -54,7 +54,8 @@ UTF-8 с BOM-сигнатурой.
|
||||
7. Разрешено наследование от типа-указателя
|
||||
8. "Строки" можно заключать также в одиночные кавычки: 'строка'
|
||||
9. Добавлен тип WCHAR
|
||||
10. Добавлены кодовые процедуры
|
||||
10. Добавлена операция конкатенации строковых и символьных констант
|
||||
11. Добавлены кодовые процедуры
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Особенности реализации
|
||||
@@ -190,6 +191,15 @@ ARRAY OF CHAR, за исключением встроенной процедур
|
||||
процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
|
||||
исходный код в кодировке UTF-8 c BOM.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Конкатенация строковых и символьных констант
|
||||
|
||||
Допускается конкатенация ("+") константных строк и символов типа CHAR:
|
||||
|
||||
str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
|
||||
|
||||
newline = 0DX + 0AX;
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Проверка и охрана типа нулевого указателя
|
||||
|
||||
|
||||
+18
-5
@@ -71,6 +71,7 @@ UTF-8 с BOM-сигнатурой.
|
||||
9. Добавлен синтаксис для импорта процедур из внешних библиотек
|
||||
10. "Строки" можно заключать также в одиночные кавычки: 'строка'
|
||||
11. Добавлен тип WCHAR
|
||||
12. Добавлена операция конкатенации строковых и символьных констант
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Особенности реализации
|
||||
@@ -193,7 +194,7 @@ UTF-8 с BOM-сигнатурой.
|
||||
|
||||
При объявлении процедурных типов и глобальных процедур, после ключевого
|
||||
слова PROCEDURE может быть указан флаг соглашения о вызове: [stdcall],
|
||||
[ccall], [ccall16], [windows], [linux]. Например:
|
||||
[ccall], [ccall16], [windows], [linux], [oberon]. Например:
|
||||
|
||||
PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER;
|
||||
|
||||
@@ -202,6 +203,8 @@ UTF-8 с BOM-сигнатурой.
|
||||
Флаг [windows] - синоним для [stdcall], [linux] - синоним для [ccall16].
|
||||
Знак "-" после имени флага ([stdcall-], [linux-], ...) означает, что
|
||||
результат процедуры можно игнорировать (не допускается для типа REAL).
|
||||
Если флаг не указан или указан флаг [oberon], то принимается внутреннее
|
||||
соглашение о вызове.
|
||||
|
||||
При объявлении типов-записей, после ключевого слова RECORD может быть
|
||||
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
|
||||
@@ -245,6 +248,15 @@ ARRAY OF CHAR, за исключением встроенной процедур
|
||||
процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
|
||||
исходный код в кодировке UTF-8 c BOM.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Конкатенация строковых и символьных констант
|
||||
|
||||
Допускается конкатенация ("+") константных строк и символов типа CHAR:
|
||||
|
||||
str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
|
||||
|
||||
newline = 0DX + 0AX;
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Проверка и охрана типа нулевого указателя
|
||||
|
||||
@@ -294,15 +306,16 @@ Oberon-реализациях выполнение такой операции
|
||||
|
||||
Синтаксис импорта:
|
||||
|
||||
PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type;
|
||||
PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
|
||||
|
||||
- callconv -- соглашение о вызове
|
||||
- "library" -- имя файла динамической библиотеки
|
||||
- "function" -- имя импортируемой процедуры
|
||||
- library -- имя файла динамической библиотеки (строковая константа)
|
||||
- function -- имя импортируемой процедуры (строковая константа), если
|
||||
указана пустая строка, то имя процедуры = proc_name
|
||||
|
||||
например:
|
||||
|
||||
PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
|
||||
PROCEDURE [windows, "kernel32.dll", ""] ExitProcess (code: INTEGER);
|
||||
|
||||
PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN);
|
||||
|
||||
|
||||
+21
-9
@@ -63,6 +63,7 @@ UTF-8 с BOM-сигнатурой.
|
||||
9. Добавлен синтаксис для импорта процедур из внешних библиотек
|
||||
10. "Строки" можно заключать также в одиночные кавычки: 'строка'
|
||||
11. Добавлен тип WCHAR
|
||||
12. Добавлена операция конкатенации строковых и символьных констант
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Особенности реализации
|
||||
@@ -186,7 +187,7 @@ UTF-8 с BOM-сигнатурой.
|
||||
|
||||
При объявлении процедурных типов и глобальных процедур, после ключевого
|
||||
слова PROCEDURE может быть указан флаг соглашения о вызове: [win64], [systemv],
|
||||
[windows], [linux].
|
||||
[windows], [linux], [oberon].
|
||||
Например:
|
||||
|
||||
PROCEDURE [win64] MyProc (x, y, z: INTEGER): INTEGER;
|
||||
@@ -194,9 +195,9 @@ UTF-8 с BOM-сигнатурой.
|
||||
Флаг [windows] - синоним для [win64], [linux] - синоним для [systemv].
|
||||
Знак "-" после имени флага ([win64-], [linux-], ...) означает, что
|
||||
результат процедуры можно игнорировать (не допускается для типа REAL).
|
||||
Если флаг не указан, то принимается внутреннее соглашение о вызове.
|
||||
[win64] и [systemv] используются для связи с операционной системой и внешними
|
||||
приложениями.
|
||||
Если флаг не указан или указан флаг [oberon], то принимается внутреннее
|
||||
соглашение о вызове. [win64] и [systemv] используются для связи с
|
||||
операционной системой и внешними приложениями.
|
||||
|
||||
При объявлении типов-записей, после ключевого слова RECORD может быть
|
||||
указан флаг [noalign]. Флаг [noalign] означает отсутствие выравнивания полей
|
||||
@@ -240,6 +241,15 @@ ARRAY OF CHAR, за исключением встроенной процедур
|
||||
процедуру WCHR вместо CHR. Для правильной работы с типом, необходимо сохранять
|
||||
исходный код в кодировке UTF-8 c BOM.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Конкатенация строковых и символьных констант
|
||||
|
||||
Допускается конкатенация ("+") константных строк и символов типа CHAR:
|
||||
|
||||
str = CHR(39) + "string" + CHR(39); (* str = "'string'" *)
|
||||
|
||||
newline = 0DX + 0AX;
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Проверка и охрана типа нулевого указателя
|
||||
|
||||
@@ -289,16 +299,18 @@ Oberon-реализациях выполнение такой операции
|
||||
|
||||
Синтаксис импорта:
|
||||
|
||||
PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type;
|
||||
PROCEDURE [callconv, library, function] proc_name (FormalParam): Type;
|
||||
|
||||
- callconv -- соглашение о вызове
|
||||
- "library" -- имя файла динамической библиотеки
|
||||
- "function" -- имя импортируемой процедуры
|
||||
- library -- имя файла динамической библиотеки (строковая константа)
|
||||
- function -- имя импортируемой процедуры (строковая константа), если
|
||||
указана пустая строка, то имя процедуры = proc_name
|
||||
|
||||
например:
|
||||
|
||||
PROCEDURE [win64, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
|
||||
PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER);
|
||||
|
||||
PROCEDURE [windows, "kernel32.dll", ""] GetTickCount (): INTEGER;
|
||||
|
||||
В конце объявления может быть добавлено (необязательно) "END proc_name;"
|
||||
|
||||
@@ -313,7 +325,7 @@ Oberon-реализациях выполнение такой операции
|
||||
соглашения о вызове:
|
||||
|
||||
VAR
|
||||
ExitProcess: PROCEDURE [win64] (code: INTEGER);
|
||||
ExitProcess: PROCEDURE [windows] (code: INTEGER);
|
||||
|
||||
Для Linux, импортированные процедуры не реализованы.
|
||||
|
||||
|
||||
@@ -12,6 +12,8 @@ IMPORT SYSTEM, K := KOSAPI;
|
||||
|
||||
CONST
|
||||
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
MAX_SIZE = 16 * 400H;
|
||||
HEAP_SIZE = 1 * 100000H;
|
||||
|
||||
@@ -35,7 +37,6 @@ VAR
|
||||
|
||||
import*, multi: BOOLEAN;
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
base*: INTEGER;
|
||||
|
||||
|
||||
@@ -284,10 +285,11 @@ PROCEDURE imp_error;
|
||||
BEGIN
|
||||
OutString("import error: ");
|
||||
IF K.imp_error.error = 1 THEN
|
||||
OutString("can't load "); OutString(K.imp_error.lib)
|
||||
OutString("can't load '"); OutString(K.imp_error.lib)
|
||||
ELSIF K.imp_error.error = 2 THEN
|
||||
OutString("not found "); OutString(K.imp_error.proc); OutString(" in "); OutString(K.imp_error.lib)
|
||||
OutString("not found '"); OutString(K.imp_error.proc); OutString("' in '"); OutString(K.imp_error.lib)
|
||||
END;
|
||||
OutString("'");
|
||||
OutLn
|
||||
END imp_error;
|
||||
|
||||
@@ -295,7 +297,6 @@ END imp_error;
|
||||
PROCEDURE init* (_import, code: INTEGER);
|
||||
BEGIN
|
||||
multi := FALSE;
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
base := code - SizeOfHeader;
|
||||
K.sysfunc2(68, 11);
|
||||
InitializeCriticalSection(CriticalSection);
|
||||
|
||||
@@ -14,6 +14,7 @@ CONST
|
||||
|
||||
slash* = "/";
|
||||
OS* = "KOS";
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
bit_depth* = RTL.bit_depth;
|
||||
maxint* = RTL.maxint;
|
||||
@@ -55,8 +56,6 @@ VAR
|
||||
Params: ARRAY MAX_PARAM, 2 OF INTEGER;
|
||||
argc*: INTEGER;
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
@@ -503,7 +502,6 @@ END d2s;
|
||||
|
||||
|
||||
BEGIN
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
Console := API.import;
|
||||
|
||||
@@ -12,6 +12,8 @@ IMPORT SYSTEM;
|
||||
|
||||
CONST
|
||||
|
||||
eol* = 0AX;
|
||||
|
||||
RTLD_LAZY* = 1;
|
||||
BIT_DEPTH* = 32;
|
||||
|
||||
@@ -24,7 +26,6 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
eol*: ARRAY 2 OF CHAR;
|
||||
MainParam*: INTEGER;
|
||||
|
||||
libc*, librt*: INTEGER;
|
||||
@@ -112,7 +113,6 @@ BEGIN
|
||||
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
|
||||
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
|
||||
MainParam := sp;
|
||||
eol := 0AX;
|
||||
|
||||
libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
|
||||
GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc));
|
||||
|
||||
@@ -14,6 +14,7 @@ CONST
|
||||
|
||||
slash* = "/";
|
||||
OS* = "LINUX";
|
||||
eol* = 0AX;
|
||||
|
||||
bit_depth* = RTL.bit_depth;
|
||||
maxint* = RTL.maxint;
|
||||
@@ -24,8 +25,6 @@ VAR
|
||||
|
||||
argc: INTEGER;
|
||||
|
||||
eol*: ARRAY 2 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
@@ -202,7 +201,6 @@ END d2s;
|
||||
|
||||
|
||||
BEGIN
|
||||
eol := 0AX;
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
SYSTEM.GET(API.MainParam, argc)
|
||||
|
||||
@@ -12,6 +12,8 @@ IMPORT SYSTEM;
|
||||
|
||||
CONST
|
||||
|
||||
eol* = 0AX;
|
||||
|
||||
RTLD_LAZY* = 1;
|
||||
BIT_DEPTH* = 64;
|
||||
|
||||
@@ -24,7 +26,6 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
eol*: ARRAY 2 OF CHAR;
|
||||
MainParam*: INTEGER;
|
||||
|
||||
libc*, librt*: INTEGER;
|
||||
@@ -112,7 +113,6 @@ BEGIN
|
||||
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen);
|
||||
SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym);
|
||||
MainParam := sp;
|
||||
eol := 0AX;
|
||||
|
||||
libc := dlopen(SYSTEM.SADR("libc.so.6"), RTLD_LAZY);
|
||||
GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc));
|
||||
|
||||
@@ -14,6 +14,7 @@ CONST
|
||||
|
||||
slash* = "/";
|
||||
OS* = "LINUX";
|
||||
eol* = 0AX;
|
||||
|
||||
bit_depth* = RTL.bit_depth;
|
||||
maxint* = RTL.maxint;
|
||||
@@ -24,8 +25,6 @@ VAR
|
||||
|
||||
argc: INTEGER;
|
||||
|
||||
eol*: ARRAY 2 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
@@ -208,7 +207,6 @@ END d2s;
|
||||
|
||||
|
||||
BEGIN
|
||||
eol := 0AX;
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
SYSTEM.GET(API.MainParam, argc)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2020 Anton Krotov
|
||||
Copyright (c) 2019-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@@ -292,7 +292,7 @@ BEGIN
|
||||
atan := -atan
|
||||
END
|
||||
|
||||
RETURN atan
|
||||
RETURN atan
|
||||
END arctan2;
|
||||
|
||||
|
||||
|
||||
+11
-8
@@ -12,6 +12,8 @@ IMPORT SYSTEM;
|
||||
|
||||
CONST
|
||||
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
SectionAlignment = 1000H;
|
||||
|
||||
DLL_PROCESS_ATTACH = 1;
|
||||
@@ -19,6 +21,9 @@ CONST
|
||||
DLL_THREAD_DETACH = 3;
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
|
||||
KERNEL = "kernel32.dll";
|
||||
USER = "user32.dll";
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
@@ -27,7 +32,6 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
base*: INTEGER;
|
||||
heap: INTEGER;
|
||||
|
||||
@@ -36,13 +40,13 @@ VAR
|
||||
thread_attach: DLL_ENTRY;
|
||||
|
||||
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
|
||||
PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, KERNEL, ""] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
|
||||
|
||||
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
|
||||
@@ -68,7 +72,6 @@ BEGIN
|
||||
process_detach := NIL;
|
||||
thread_detach := NIL;
|
||||
thread_attach := NIL;
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
base := code - SectionAlignment;
|
||||
heap := GetProcessHeap()
|
||||
END init;
|
||||
|
||||
@@ -14,6 +14,7 @@ CONST
|
||||
|
||||
slash* = "\";
|
||||
OS* = "WINDOWS";
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
bit_depth* = RTL.bit_depth;
|
||||
maxint* = RTL.maxint;
|
||||
@@ -80,8 +81,6 @@ VAR
|
||||
Params: ARRAY MAX_PARAM, 2 OF INTEGER;
|
||||
argc: INTEGER;
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
@@ -356,7 +355,6 @@ END d2s;
|
||||
|
||||
|
||||
BEGIN
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
hConsoleOutput := _GetStdHandle(-11);
|
||||
|
||||
+11
-8
@@ -12,6 +12,8 @@ IMPORT SYSTEM;
|
||||
|
||||
CONST
|
||||
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
SectionAlignment = 1000H;
|
||||
|
||||
DLL_PROCESS_ATTACH = 1;
|
||||
@@ -19,6 +21,9 @@ CONST
|
||||
DLL_THREAD_DETACH = 3;
|
||||
DLL_PROCESS_DETACH = 0;
|
||||
|
||||
KERNEL = "kernel32.dll";
|
||||
USER = "user32.dll";
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
@@ -27,7 +32,6 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
base*: INTEGER;
|
||||
heap: INTEGER;
|
||||
|
||||
@@ -36,13 +40,13 @@ VAR
|
||||
thread_attach: DLL_ENTRY;
|
||||
|
||||
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, "kernel32.dll", "GetProcessHeap"] GetProcessHeap (): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapAlloc"] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, "kernel32.dll", "HeapFree"] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] ExitProcess (code: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] ExitThread (code: INTEGER);
|
||||
PROCEDURE [windows-, KERNEL, ""] GetProcessHeap (): INTEGER;
|
||||
PROCEDURE [windows-, KERNEL, ""] HeapAlloc (hHeap, dwFlags, dwBytes: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, KERNEL, ""] HeapFree(hHeap, dwFlags, lpMem: INTEGER);
|
||||
|
||||
PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
PROCEDURE [windows-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
|
||||
|
||||
|
||||
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
|
||||
@@ -68,7 +72,6 @@ BEGIN
|
||||
process_detach := NIL;
|
||||
thread_detach := NIL;
|
||||
thread_attach := NIL;
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
base := code - SectionAlignment;
|
||||
heap := GetProcessHeap()
|
||||
END init;
|
||||
|
||||
@@ -14,6 +14,7 @@ CONST
|
||||
|
||||
slash* = "\";
|
||||
OS* = "WINDOWS";
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
bit_depth* = RTL.bit_depth;
|
||||
maxint* = RTL.maxint;
|
||||
@@ -80,8 +81,6 @@ VAR
|
||||
Params: ARRAY MAX_PARAM, 2 OF INTEGER;
|
||||
argc: INTEGER;
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
@@ -362,7 +361,6 @@ END d2s;
|
||||
|
||||
|
||||
BEGIN
|
||||
eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X;
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 1023);
|
||||
hConsoleOutput := _GetStdHandle(-11);
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2020 Anton Krotov
|
||||
Copyright (c) 2019-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
@@ -292,7 +292,7 @@ BEGIN
|
||||
atan := -atan
|
||||
END
|
||||
|
||||
RETURN atan
|
||||
RETURN atan
|
||||
END arctan2;
|
||||
|
||||
|
||||
|
||||
@@ -761,6 +761,20 @@ BEGIN
|
||||
END setInt;
|
||||
|
||||
|
||||
PROCEDURE concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := LENGTH(s) + LENGTH(s1) < LEN(s);
|
||||
IF res THEN
|
||||
STRINGS.append(s, s1)
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END concat;
|
||||
|
||||
|
||||
PROCEDURE init;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
@@ -144,6 +144,7 @@ BEGIN
|
||||
|114: str := "identifiers 'lib_init' and 'version' are reserved"
|
||||
|115: str := "recursive constant definition"
|
||||
|116: str := "procedure too deep nested"
|
||||
|117: str := "string expected"
|
||||
|
||||
|120: str := "too many formal parameters"
|
||||
|121: str := "multiply defined handler"
|
||||
|
||||
+38
-12
@@ -182,7 +182,6 @@ BEGIN
|
||||
|SCAN.lxSEMI: err := 24
|
||||
|SCAN.lxRETURN: err := 38
|
||||
|SCAN.lxMODULE: err := 21
|
||||
|SCAN.lxSTRING: err := 66
|
||||
END;
|
||||
|
||||
check1(FALSE, parser, err)
|
||||
@@ -501,6 +500,8 @@ BEGIN
|
||||
sf := PROG.sf_linux
|
||||
ELSIF parser.lex.s = "code" THEN
|
||||
sf := PROG.sf_code
|
||||
ELSIF parser.lex.s = "oberon" THEN
|
||||
sf := PROG.sf_oberon
|
||||
ELSIF parser.lex.s = "noalign" THEN
|
||||
sf := PROG.sf_noalign
|
||||
ELSE
|
||||
@@ -530,6 +531,12 @@ BEGIN
|
||||
res := PROG.systemv
|
||||
|PROG.sf_code:
|
||||
res := PROG.code
|
||||
|PROG.sf_oberon:
|
||||
IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
|
||||
res := PROG.default32
|
||||
ELSIF TARGETS.OS IN {TARGETS.osWIN64, TARGETS.osLINUX64} THEN
|
||||
res := PROG.default64
|
||||
END
|
||||
|PROG.sf_windows:
|
||||
IF TARGETS.OS = TARGETS.osWIN32 THEN
|
||||
res := PROG.stdcall
|
||||
@@ -556,8 +563,26 @@ VAR
|
||||
dll, proc: SCAN.LEXSTR;
|
||||
pos: POSITION;
|
||||
|
||||
BEGIN
|
||||
|
||||
PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR);
|
||||
VAR
|
||||
pos: POSITION;
|
||||
str: ARITH.VALUE;
|
||||
|
||||
BEGIN
|
||||
getpos(parser, pos);
|
||||
ConstExpression(parser, str);
|
||||
IF str.typ = ARITH.tSTRING THEN
|
||||
name := str.string(SCAN.IDENT).s
|
||||
ELSIF str.typ = ARITH.tCHAR THEN
|
||||
ARITH.charToStr(str, name)
|
||||
ELSE
|
||||
check(FALSE, pos, 117)
|
||||
END
|
||||
END getStr;
|
||||
|
||||
|
||||
BEGIN
|
||||
import := NIL;
|
||||
|
||||
IF parser.sym = SCAN.lxLSQUARE THEN
|
||||
@@ -570,19 +595,17 @@ BEGIN
|
||||
Next(parser);
|
||||
INC(call)
|
||||
END;
|
||||
IF ~isProc THEN
|
||||
checklex(parser, SCAN.lxRSQUARE)
|
||||
END;
|
||||
IF parser.sym = SCAN.lxCOMMA THEN
|
||||
ExpectSym(parser, SCAN.lxSTRING);
|
||||
dll := parser.lex.s;
|
||||
STRINGS.UpCase(dll);
|
||||
ExpectSym(parser, SCAN.lxCOMMA);
|
||||
ExpectSym(parser, SCAN.lxSTRING);
|
||||
proc := parser.lex.s;
|
||||
|
||||
IF isProc & (parser.sym = SCAN.lxCOMMA) THEN
|
||||
Next(parser);
|
||||
getStr(parser, dll);
|
||||
STRINGS.UpCase(dll);
|
||||
checklex(parser, SCAN.lxCOMMA);
|
||||
Next(parser);
|
||||
getStr(parser, proc);
|
||||
import := IL.AddImp(dll, proc)
|
||||
END;
|
||||
|
||||
checklex(parser, SCAN.lxRSQUARE);
|
||||
Next(parser)
|
||||
ELSE
|
||||
@@ -919,6 +942,9 @@ VAR
|
||||
IF import # NIL THEN
|
||||
proc := IdentDef(parser, PROG.idIMP, name);
|
||||
proc.import := import;
|
||||
IF import.name = "" THEN
|
||||
import.name := name.s
|
||||
END;
|
||||
PROG.program.procs.last(PROG.PROC).import := import
|
||||
ELSE
|
||||
proc := IdentDef(parser, PROG.idPROC, name)
|
||||
|
||||
+12
-12
@@ -42,13 +42,13 @@ CONST
|
||||
sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42;
|
||||
sysDINT* = 43;*)sysGET8* = 44; sysGET16* = 45; sysGET32* = 46;
|
||||
|
||||
default32* = 2;
|
||||
default32* = 2; _default32* = default32 + 1;
|
||||
stdcall* = 4; _stdcall* = stdcall + 1;
|
||||
ccall* = 6; _ccall* = ccall + 1;
|
||||
ccall16* = 8; _ccall16* = ccall16 + 1;
|
||||
win64* = 10; _win64* = win64 + 1;
|
||||
stdcall64* = 12; _stdcall64* = stdcall64 + 1;
|
||||
default64* = 14;
|
||||
default64* = 14; _default64* = default64 + 1;
|
||||
systemv* = 16; _systemv* = systemv + 1;
|
||||
default16* = 18;
|
||||
code* = 20; _code* = code + 1;
|
||||
@@ -57,12 +57,12 @@ CONST
|
||||
|
||||
callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64};
|
||||
|
||||
sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
|
||||
sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
|
||||
sf_code* = 8;
|
||||
sf_noalign* = 9;
|
||||
sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3;
|
||||
sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7;
|
||||
sf_code* = 8; sf_oberon* = 9;
|
||||
sf_noalign* = 10;
|
||||
|
||||
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code};
|
||||
proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code, sf_oberon};
|
||||
rec_flags* = {sf_noalign};
|
||||
|
||||
STACK_FRAME = 2;
|
||||
@@ -1201,11 +1201,11 @@ BEGIN
|
||||
program.options := options;
|
||||
|
||||
CASE TARGETS.OS OF
|
||||
|TARGETS.osWIN32: program.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osLINUX32: program.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osKOS: program.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osWIN64: program.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|
||||
|TARGETS.osLINUX64: program.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|
||||
|TARGETS.osWIN32: program.sysflags := {sf_oberon, sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osLINUX32: program.sysflags := {sf_oberon, sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osKOS: program.sysflags := {sf_oberon, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign}
|
||||
|TARGETS.osWIN64: program.sysflags := {sf_oberon, sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|
||||
|TARGETS.osLINUX64: program.sysflags := {sf_oberon, sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign}
|
||||
|TARGETS.osNONE: program.sysflags := {sf_code}
|
||||
END;
|
||||
|
||||
|
||||
+27
-5
@@ -2038,6 +2038,7 @@ VAR
|
||||
pos: PARS.POSITION;
|
||||
op: INTEGER;
|
||||
e1: PARS.EXPR;
|
||||
s, s1: SCAN.LEXSTR;
|
||||
|
||||
plus, minus: BOOLEAN;
|
||||
|
||||
@@ -2113,13 +2114,34 @@ VAR
|
||||
op := ORD("+")
|
||||
END;
|
||||
|
||||
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
|
||||
PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37);
|
||||
IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
|
||||
|
||||
CASE e.value.typ OF
|
||||
|ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|
||||
|ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|
||||
|ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op))
|
||||
CASE e.value.typ OF
|
||||
|ARITH.tINTEGER:
|
||||
PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
|
||||
|
||||
|ARITH.tREAL:
|
||||
PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
|
||||
|
||||
|ARITH.tSET:
|
||||
ARITH.opSet(e.value, e1.value, CHR(op))
|
||||
|
||||
|ARITH.tCHAR, ARITH.tSTRING:
|
||||
IF e.value.typ = ARITH.tCHAR THEN
|
||||
ARITH.charToStr(e.value, s)
|
||||
ELSE
|
||||
s := e.value.string(SCAN.IDENT).s
|
||||
END;
|
||||
IF e1.value.typ = ARITH.tCHAR THEN
|
||||
ARITH.charToStr(e1.value, s1)
|
||||
ELSE
|
||||
s1 := e1.value.string(SCAN.IDENT).s
|
||||
END;
|
||||
PARS.check(ARITH.concat(s, s1), pos, 5);
|
||||
e.value.string := SCAN.enterid(s);
|
||||
e.value.typ := ARITH.tSTRING;
|
||||
e.type := PROG.program.stTypes.tSTRING
|
||||
END
|
||||
|
||||
ELSE
|
||||
|
||||
+2
-4
@@ -13,6 +13,7 @@ IMPORT HOST;
|
||||
CONST
|
||||
|
||||
slash* = HOST.slash;
|
||||
eol* = HOST.eol;
|
||||
|
||||
bit_depth* = HOST.bit_depth;
|
||||
maxint* = HOST.maxint;
|
||||
@@ -24,7 +25,7 @@ CONST
|
||||
max32* = 2147483647;
|
||||
|
||||
vMajor* = 1;
|
||||
vMinor* = 34;
|
||||
vMinor* = 35;
|
||||
|
||||
FILE_EXT* = ".ob07";
|
||||
RTL_NAME* = "RTL";
|
||||
@@ -41,8 +42,6 @@ VAR
|
||||
|
||||
time*: INTEGER;
|
||||
|
||||
eol*: ARRAY 3 OF CHAR;
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
target*:
|
||||
@@ -291,7 +290,6 @@ END init;
|
||||
|
||||
BEGIN
|
||||
time := GetTickCount();
|
||||
COPY(HOST.eol, eol);
|
||||
maxreal := HOST.maxreal;
|
||||
init(days)
|
||||
END UTILS.
|
||||
Reference in new issue
Block a user