diff --git a/Compiler b/Compiler index 993ce97..cbc961f 100644 Binary files a/Compiler and b/Compiler differ diff --git a/Compiler.exe b/Compiler.exe index da71b9f..a42d300 100644 Binary files a/Compiler.exe and b/Compiler.exe differ diff --git a/doc/x86.txt b/doc/x86.txt index 53b379f..e26976f 100644 --- a/doc/x86.txt +++ b/doc/x86.txt @@ -333,29 +333,7 @@ Oberon-реализациях выполнение такой операции Все программы неявно используют модуль RTL. Компилятор транслирует некоторые операции (проверка и охрана типа, сравнение строк, сообщения об ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не -следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini -если приложение компилируется как Windows DLL или Linux SO, соответственно: - - PROCEDURE SetDll - (process_detach, thread_detach, thread_attach: DLL_ENTRY); - где TYPE DLL_ENTRY = - PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - -SetDll назначает процедуры process_detach, thread_detach, thread_attach -вызываемыми при -- выгрузке dll-библиотеки (process_detach) -- создании нового потока (thread_attach) -- уничтожении потока (thread_detach) - - - PROCEDURE SetFini (ProcFini: PROC); - где TYPE PROC = PROCEDURE (* без параметров *) - -SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки. - -Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на -поведение программы. - +следует вызывать эти процедуры явно. Сообщения об ошибках времени выполнения выводятся в диалоговых окнах (Windows), в терминал (Linux), на доску отладки (KolibriOS). diff --git a/doc/x86_64.txt b/doc/x86_64.txt index c5cf752..9655412 100644 --- a/doc/x86_64.txt +++ b/doc/x86_64.txt @@ -327,29 +327,7 @@ Oberon-реализациях выполнение такой операции Все программы неявно используют модуль RTL. Компилятор транслирует некоторые операции (проверка и охрана типа, сравнение строк, сообщения об ошибках времени выполнения и др.) как вызовы процедур этого модуля. Не -следует явно вызывать эти процедуры, за исключением процедур SetDll и SetFini -если приложение компилируется как Windows DLL или Linux SO, соответственно: - - PROCEDURE SetDll - (process_detach, thread_detach, thread_attach: DLL_ENTRY); - где TYPE DLL_ENTRY = - PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - -SetDll назначает процедуры process_detach, thread_detach, thread_attach -вызываемыми при -- выгрузке dll-библиотеки (process_detach) -- создании нового потока (thread_attach) -- уничтожении потока (thread_detach) - - - PROCEDURE SetFini (ProcFini: PROC); - где TYPE PROC = PROCEDURE (* без параметров *) - -SetFini назначает процедуру ProcFini вызываемой при выгрузке so-библиотеки. - -Для прочих типов приложений, вызов процедур SetDll и SetFini не влияет на -поведение программы. - +следует вызывать эти процедуры явно. Сообщения об ошибках времени выполнения выводятся в диалоговых окнах (Windows), в терминал (Linux). diff --git a/lib/KolibriOS/API.ob07 b/lib/KolibriOS/API.ob07 index 36c08ac..4f99171 100644 --- a/lib/KolibriOS/API.ob07 +++ b/lib/KolibriOS/API.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2018, Anton Krotov + Copyright (c) 2018, 2020, Anton Krotov All rights reserved. *) @@ -318,4 +318,13 @@ PROCEDURE GetTickCount* (): INTEGER; END GetTickCount; +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + END API. \ No newline at end of file diff --git a/lib/KolibriOS/RTL.ob07 b/lib/KolibriOS/RTL.ob07 index 2ad931e..0929a56 100644 --- a/lib/KolibriOS/RTL.ob07 +++ b/lib/KolibriOS/RTL.ob07 @@ -16,34 +16,15 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; - PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN @@ -442,19 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "bad divisor") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -508,34 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - res := 0; - - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -564,36 +526,8 @@ BEGIN END END; - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - END RTL. \ No newline at end of file diff --git a/lib/Linux32/API.ob07 b/lib/Linux32/API.ob07 index 8e7d6d5..76515a3 100644 --- a/lib/Linux32/API.ob07 +++ b/lib/Linux32/API.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -18,6 +18,7 @@ CONST TYPE TP* = ARRAY 2 OF INTEGER; + SOFINI* = PROCEDURE; VAR @@ -46,6 +47,8 @@ VAR clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + fini: SOFINI; + PROCEDURE putc* (c: CHAR); VAR @@ -103,6 +106,7 @@ END GetProcAdr; PROCEDURE init* (sp, code: INTEGER); BEGIN + fini := NIL; SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); MainParam := sp; @@ -142,4 +146,23 @@ BEGIN END exit_thread; +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END sofinit; + + +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + fini := ProcFini +END SetFini; + + END API. \ No newline at end of file diff --git a/lib/Linux32/LINAPI.ob07 b/lib/Linux32/LINAPI.ob07 index 345cc7d..31348bc 100644 --- a/lib/Linux32/LINAPI.ob07 +++ b/lib/Linux32/LINAPI.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -13,6 +13,7 @@ IMPORT SYSTEM, API; TYPE TP* = API.TP; + SOFINI* = API.SOFINI; VAR @@ -69,12 +70,17 @@ BEGIN END GetEnv; +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + API.SetFini(ProcFini) +END SetFini; + + PROCEDURE init; VAR ptr: INTEGER; BEGIN - IF API.MainParam # 0 THEN envc := -1; SYSTEM.GET(API.MainParam, argc); diff --git a/lib/Linux32/RTL.ob07 b/lib/Linux32/RTL.ob07 index 2ad931e..0929a56 100644 --- a/lib/Linux32/RTL.ob07 +++ b/lib/Linux32/RTL.ob07 @@ -16,34 +16,15 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; - PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN @@ -442,19 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "bad divisor") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -508,34 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - res := 0; - - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -564,36 +526,8 @@ BEGIN END END; - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - END RTL. \ No newline at end of file diff --git a/lib/Linux64/API.ob07 b/lib/Linux64/API.ob07 index 8e7d6d5..76515a3 100644 --- a/lib/Linux64/API.ob07 +++ b/lib/Linux64/API.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -18,6 +18,7 @@ CONST TYPE TP* = ARRAY 2 OF INTEGER; + SOFINI* = PROCEDURE; VAR @@ -46,6 +47,8 @@ VAR clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + fini: SOFINI; + PROCEDURE putc* (c: CHAR); VAR @@ -103,6 +106,7 @@ END GetProcAdr; PROCEDURE init* (sp, code: INTEGER); BEGIN + fini := NIL; SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); MainParam := sp; @@ -142,4 +146,23 @@ BEGIN END exit_thread; +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; + RETURN 0 +END dllentry; + + +PROCEDURE sofinit*; +BEGIN + IF fini # NIL THEN + fini + END +END sofinit; + + +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + fini := ProcFini +END SetFini; + + END API. \ No newline at end of file diff --git a/lib/Linux64/LINAPI.ob07 b/lib/Linux64/LINAPI.ob07 index e4658c2..c7931e2 100644 --- a/lib/Linux64/LINAPI.ob07 +++ b/lib/Linux64/LINAPI.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) @@ -13,6 +13,7 @@ IMPORT SYSTEM, API; TYPE TP* = API.TP; + SOFINI* = API.SOFINI; VAR @@ -69,12 +70,17 @@ BEGIN END GetEnv; +PROCEDURE SetFini* (ProcFini: SOFINI); +BEGIN + API.SetFini(ProcFini) +END SetFini; + + PROCEDURE init; VAR ptr: INTEGER; BEGIN - IF API.MainParam # 0 THEN envc := -1; SYSTEM.GET(API.MainParam, argc); diff --git a/lib/Linux64/RTL.ob07 b/lib/Linux64/RTL.ob07 index 776714c..94a94ea 100644 --- a/lib/Linux64/RTL.ob07 +++ b/lib/Linux64/RTL.ob07 @@ -16,35 +16,16 @@ CONST maxint* = 7FFFFFFFFFFFFFFFH; minint* = 8000000000000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; - PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); BEGIN @@ -420,19 +401,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "bad divisor") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -486,34 +466,16 @@ END _guard; PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - res := 0; - - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall64] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall64] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -547,36 +509,8 @@ BEGIN END END; - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall64] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - END RTL. \ No newline at end of file diff --git a/lib/Windows32/API.ob07 b/lib/Windows32/API.ob07 index a1f4d72..0eaf6c9 100644 --- a/lib/Windows32/API.ob07 +++ b/lib/Windows32/API.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -14,6 +14,16 @@ CONST SectionAlignment = 1000H; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + +TYPE + + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR @@ -21,6 +31,10 @@ VAR base*: INTEGER; heap: INTEGER; + process_detach, + thread_detach, + thread_attach: DLL_ENTRY; + PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); @@ -51,6 +65,9 @@ END _DISPOSE; PROCEDURE init* (reserved, code: INTEGER); BEGIN + process_detach := NIL; + thread_detach := NIL; + thread_attach := NIL; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; base := code - SectionAlignment; heap := GetProcessHeap() @@ -69,4 +86,45 @@ BEGIN END exit_thread; -END API. +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := 0; + + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + IF thread_attach # NIL THEN + thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + IF thread_detach # NIL THEN + thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + IF process_detach # NIL THEN + process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + END + + RETURN res +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); +BEGIN + process_detach := _process_detach; + thread_detach := _thread_detach; + thread_attach := _thread_attach +END SetDll; + + +END API. \ No newline at end of file diff --git a/lib/Windows32/RTL.ob07 b/lib/Windows32/RTL.ob07 index 2ad931e..0929a56 100644 --- a/lib/Windows32/RTL.ob07 +++ b/lib/Windows32/RTL.ob07 @@ -16,34 +16,15 @@ CONST maxint* = 7FFFFFFFH; minint* = 80000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; - PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER); BEGIN @@ -442,19 +423,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "bad divisor") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -508,34 +488,16 @@ END _guard; PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - res := 0; - - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -564,36 +526,8 @@ BEGIN END END; - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - END RTL. \ No newline at end of file diff --git a/lib/Windows32/WINAPI.ob07 b/lib/Windows32/WINAPI.ob07 index 27e2cae..f604343 100644 --- a/lib/Windows32/WINAPI.ob07 +++ b/lib/Windows32/WINAPI.ob07 @@ -1,13 +1,13 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) MODULE WINAPI; -IMPORT SYSTEM; +IMPORT SYSTEM, API; CONST @@ -17,6 +17,8 @@ CONST TYPE + DLL_ENTRY* = API.DLL_ENTRY; + STRING = ARRAY 260 OF CHAR; TCoord* = RECORD @@ -230,4 +232,10 @@ PROCEDURE [windows-, "kernel32.dll", "FreeConsole"] FreeConsole* (): BOOLEAN; +PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + API.SetDll(process_detach, thread_detach, thread_attach) +END SetDllEntry; + + END WINAPI. diff --git a/lib/Windows64/API.ob07 b/lib/Windows64/API.ob07 index a1f4d72..0eaf6c9 100644 --- a/lib/Windows64/API.ob07 +++ b/lib/Windows64/API.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2018-2019, Anton Krotov + Copyright (c) 2018-2020, Anton Krotov All rights reserved. *) @@ -14,6 +14,16 @@ CONST SectionAlignment = 1000H; + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + +TYPE + + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR @@ -21,6 +31,10 @@ VAR base*: INTEGER; heap: INTEGER; + process_detach, + thread_detach, + thread_attach: DLL_ENTRY; + PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); @@ -51,6 +65,9 @@ END _DISPOSE; PROCEDURE init* (reserved, code: INTEGER); BEGIN + process_detach := NIL; + thread_detach := NIL; + thread_attach := NIL; eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; base := code - SectionAlignment; heap := GetProcessHeap() @@ -69,4 +86,45 @@ BEGIN END exit_thread; -END API. +PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := 0; + + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + IF thread_attach # NIL THEN + thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + IF thread_detach # NIL THEN + thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + IF process_detach # NIL THEN + process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + END + + RETURN res +END dllentry; + + +PROCEDURE sofinit*; +END sofinit; + + +PROCEDURE SetDll* (_process_detach, _thread_detach, _thread_attach: DLL_ENTRY); +BEGIN + process_detach := _process_detach; + thread_detach := _thread_detach; + thread_attach := _thread_attach +END SetDll; + + +END API. \ No newline at end of file diff --git a/lib/Windows64/RTL.ob07 b/lib/Windows64/RTL.ob07 index 776714c..94a94ea 100644 --- a/lib/Windows64/RTL.ob07 +++ b/lib/Windows64/RTL.ob07 @@ -16,35 +16,16 @@ CONST maxint* = 7FFFFFFFFFFFFFFFH; minint* = 8000000000000000H; - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_THREAD_DETACH = 3; - DLL_PROCESS_DETACH = 0; - WORD = bit_depth DIV 8; MAX_SET = bit_depth - 1; -TYPE - - DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); - PROC = PROCEDURE; - - VAR name: INTEGER; types: INTEGER; sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; - dll: RECORD - process_detach, - thread_detach, - thread_attach: DLL_ENTRY - END; - - fini: PROC; - PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); BEGIN @@ -420,19 +401,18 @@ VAR s, temp: ARRAY 1024 OF CHAR; BEGIN - s := ""; CASE err OF - | 1: append(s, "assertion failure") - | 2: append(s, "NIL dereference") - | 3: append(s, "bad divisor") - | 4: append(s, "NIL procedure call") - | 5: append(s, "type guard error") - | 6: append(s, "index out of range") - | 7: append(s, "invalid CASE") - | 8: append(s, "array assignment error") - | 9: append(s, "CHR out of range") - |10: append(s, "WCHR out of range") - |11: append(s, "BYTE out of range") + | 1: s := "assertion failure" + | 2: s := "NIL dereference" + | 3: s := "bad divisor" + | 4: s := "NIL procedure call" + | 5: s := "type guard error" + | 6: s := "index out of range" + | 7: s := "invalid CASE" + | 8: s := "array assignment error" + | 9: s := "CHR out of range" + |10: s := "WCHR out of range" + |11: s := "BYTE out of range" END; append(s, API.eol); @@ -486,34 +466,16 @@ END _guard; PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - res := 0; - - CASE fdwReason OF - |DLL_PROCESS_ATTACH: - res := 1 - |DLL_THREAD_ATTACH: - IF dll.thread_attach # NIL THEN - dll.thread_attach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_THREAD_DETACH: - IF dll.thread_detach # NIL THEN - dll.thread_detach(hinstDLL, fdwReason, lpvReserved) - END - |DLL_PROCESS_DETACH: - IF dll.process_detach # NIL THEN - dll.process_detach(hinstDLL, fdwReason, lpvReserved) - END - ELSE - END - - RETURN res + RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) END _dllentry; +PROCEDURE [stdcall64] _sofinit*; +BEGIN + API.sofinit +END _sofinit; + + PROCEDURE [stdcall64] _exit* (code: INTEGER); BEGIN API.exit(code) @@ -547,36 +509,8 @@ BEGIN END END; - name := modname; - - dll.process_detach := NIL; - dll.thread_detach := NIL; - dll.thread_attach := NIL; - - fini := NIL + name := modname END _init; -PROCEDURE [stdcall64] _sofinit*; -BEGIN - IF fini # NIL THEN - fini - END -END _sofinit; - - -PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); -BEGIN - dll.process_detach := process_detach; - dll.thread_detach := thread_detach; - dll.thread_attach := thread_attach -END SetDll; - - -PROCEDURE SetFini* (ProcFini: PROC); -BEGIN - fini := ProcFini -END SetFini; - - END RTL. \ No newline at end of file diff --git a/lib/Windows64/WINAPI.ob07 b/lib/Windows64/WINAPI.ob07 index 06f8855..86d1660 100644 --- a/lib/Windows64/WINAPI.ob07 +++ b/lib/Windows64/WINAPI.ob07 @@ -1,13 +1,13 @@ (* BSD 2-Clause License - Copyright (c) 2019, Anton Krotov + Copyright (c) 2019-2020, Anton Krotov All rights reserved. *) MODULE WINAPI; -IMPORT SYSTEM; +IMPORT SYSTEM, API; CONST @@ -17,6 +17,8 @@ CONST TYPE + DLL_ENTRY* = API.DLL_ENTRY; + STRING = ARRAY 260 OF CHAR; TCoord* = RECORD @@ -159,4 +161,10 @@ PROCEDURE [windows-, "kernel32.dll", "GetLocalTime"] GetLocalTime* (T: TSystemTime); +PROCEDURE SetDllEntry* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + API.SetDll(process_detach, thread_detach, thread_attach) +END SetDllEntry; + + END WINAPI. \ No newline at end of file