kolibrios-fun/programs/develop/oberon07/Lib/Windows32/API.ob07
maxcodehack 2f54c7de00 Update oberon07 from akron1's github
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
2020-10-13 07:58:51 +00:00

132 lines
2.6 KiB
Plaintext

(*
BSD 2-Clause License
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
MODULE API;
IMPORT SYSTEM;
CONST
eol* = 0DX + 0AX;
SectionAlignment = 1000H;
DLL_PROCESS_ATTACH = 1;
DLL_THREAD_ATTACH = 2;
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
KERNEL = "kernel32.dll";
USER = "user32.dll";
TYPE
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
VAR
base*: INTEGER;
heap: INTEGER;
process_detach,
thread_detach,
thread_attach: DLL_ENTRY;
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-, USER, ""] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER;
PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN
MessageBoxA(0, lpText, lpCaption, 16)
END DebugMsg;
PROCEDURE _NEW* (size: INTEGER): INTEGER;
RETURN HeapAlloc(heap, 8, size)
END _NEW;
PROCEDURE _DISPOSE* (p: INTEGER): INTEGER;
BEGIN
HeapFree(heap, 0, p)
RETURN 0
END _DISPOSE;
PROCEDURE init* (reserved, code: INTEGER);
BEGIN
process_detach := NIL;
thread_detach := NIL;
thread_attach := NIL;
base := code - SectionAlignment;
heap := GetProcessHeap()
END init;
PROCEDURE exit* (code: INTEGER);
BEGIN
ExitProcess(code)
END exit;
PROCEDURE exit_thread* (code: INTEGER);
BEGIN
ExitThread(code)
END exit_thread;
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.