ruberon/lib/Windows/API.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018-2021, 2023, Anton Krotov
    All rights reserved.
*)

MODULE API;

IMPORT SYSTEM;


CONST

    OS* = "WINDOWS";
    eol* = 0DX + 0AX;
    BIT_DEPTH* = (ORD(LSL(1, 31) > 0) + 1) * 32;

    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.