kolibrios-fun/programs/develop/oberon07/Lib/KolibriOS/API.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018, 2020, Anton Krotov
    All rights reserved.
*)

MODULE API;

IMPORT SYSTEM, K := KOSAPI;


CONST

    MAX_SIZE  = 16 * 400H;
    HEAP_SIZE =  1 * 100000H;

    _new = 1;
    _dispose = 2;

    SizeOfHeader = 36;


TYPE

    CRITICAL_SECTION = ARRAY 2 OF INTEGER;


VAR

    heap, endheap: INTEGER;
    pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;

    CriticalSection: CRITICAL_SECTION;

    import*, multi: BOOLEAN;

    eol*:  ARRAY 3 OF CHAR;
    base*: INTEGER;


PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER);
BEGIN
    SYSTEM.CODE(
    0FCH,               (*  cld                            *)
    031H, 0C0H,         (*  xor     eax, eax               *)
    057H,               (*  push    edi                    *)
    08BH, 07DH, 00CH,   (*  mov     edi, dword [ebp + 12]  *)
    08BH, 04DH, 008H,   (*  mov     ecx, dword [ebp +  8]  *)
    0F3H, 0ABH,         (*  rep     stosd                  *)
    05FH                (*  pop     edi                    *)
    )
END zeromem;


PROCEDURE mem_commit* (adr, size: INTEGER);
VAR
    tmp: INTEGER;
BEGIN
    FOR tmp := adr TO adr + size - 1 BY 4096 DO
        SYSTEM.PUT(tmp, 0)
    END
END mem_commit;


PROCEDURE switch_task;
BEGIN
    K.sysfunc2(68, 1)
END switch_task;


PROCEDURE futex_create (ptr: INTEGER): INTEGER;
    RETURN K.sysfunc3(77, 0, ptr)
END futex_create;


PROCEDURE futex_wait (futex, value, timeout: INTEGER);
BEGIN
    K.sysfunc5(77, 2, futex, value, timeout)
END futex_wait;


PROCEDURE futex_wake (futex, number: INTEGER);
BEGIN
    K.sysfunc4(77, 3, futex, number)
END futex_wake;


PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
    switch_task;
    futex_wait(CriticalSection[0], 1, 10000);
    CriticalSection[1] := 1
END EnterCriticalSection;


PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
    CriticalSection[1] := 0;
    futex_wake(CriticalSection[0], 1)
END LeaveCriticalSection;


PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION);
BEGIN
    CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1]));
    CriticalSection[1] := 0
END InitializeCriticalSection;


PROCEDURE __NEW (size: INTEGER): INTEGER;
VAR
    res, idx, temp: INTEGER;
BEGIN
    IF size <= MAX_SIZE THEN
        idx := ASR(size, 5);
        res := pockets[idx];
        IF res # 0 THEN
            SYSTEM.GET(res, pockets[idx]);
            SYSTEM.PUT(res, size);
            INC(res, 4)
        ELSE
            temp := 0;
            IF heap + size >= endheap THEN
                IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
                    temp := K.sysfunc3(68, 12, HEAP_SIZE)
                ELSE
                    temp := 0
                END;
                IF temp # 0 THEN
                    mem_commit(temp, HEAP_SIZE);
                    heap := temp;
                    endheap := heap + HEAP_SIZE
                ELSE
                    temp := -1
                END
            END;
            IF (heap # 0) & (temp # -1) THEN
                SYSTEM.PUT(heap, size);
                res := heap + 4;
                heap := heap + size
            ELSE
                res := 0
            END
        END
    ELSE
        IF K.sysfunc2(18, 16) > ASR(size, 10) THEN
            res := K.sysfunc3(68, 12, size);
            IF res # 0 THEN
                mem_commit(res, size);
                SYSTEM.PUT(res, size);
                INC(res, 4)
            END
        ELSE
            res := 0
        END
    END;
    IF (res # 0) & (size <= MAX_SIZE) THEN
        zeromem(ASR(size, 2) - 1, res)
    END
    RETURN res
END __NEW;


PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER;
VAR
    size, idx: INTEGER;
BEGIN
    DEC(ptr, 4);
    SYSTEM.GET(ptr, size);
    IF size <= MAX_SIZE THEN
        idx := ASR(size, 5);
        SYSTEM.PUT(ptr, pockets[idx]);
        pockets[idx] := ptr
    ELSE
        size := K.sysfunc3(68, 13, ptr)
    END
    RETURN 0
END __DISPOSE;


PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
VAR
    res: INTEGER;

BEGIN
    IF multi THEN
        EnterCriticalSection(CriticalSection)
    END;

    IF func = _new THEN
        res := __NEW(arg)
    ELSIF func = _dispose THEN
        res := __DISPOSE(arg)
    END;

    IF multi THEN
        LeaveCriticalSection(CriticalSection)
    END

    RETURN res
END NEW_DISPOSE;


PROCEDURE _NEW* (size: INTEGER): INTEGER;
    RETURN NEW_DISPOSE(_new, size)
END _NEW;


PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
    RETURN NEW_DISPOSE(_dispose, ptr)
END _DISPOSE;


PROCEDURE exit* (p1: INTEGER);
BEGIN
    K.sysfunc1(-1)
END exit;


PROCEDURE exit_thread* (p1: INTEGER);
BEGIN
    K.sysfunc1(-1)
END exit_thread;


PROCEDURE OutChar (c: CHAR);
BEGIN
    K.sysfunc3(63, 1, ORD(c))
END OutChar;


PROCEDURE OutLn;
BEGIN
    OutChar(0DX);
    OutChar(0AX)
END OutLn;


PROCEDURE OutStr (pchar: INTEGER);
VAR
    c: CHAR;
BEGIN
    IF pchar # 0 THEN
        REPEAT
            SYSTEM.GET(pchar, c);
            IF c # 0X THEN
                OutChar(c)
            END;
            INC(pchar)
        UNTIL c = 0X
    END
END OutStr;


PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
BEGIN
    IF lpCaption # 0 THEN
        OutLn;
        OutStr(lpCaption);
        OutChar(":");
        OutLn
    END;
    OutStr(lpText);
    IF lpCaption # 0 THEN
        OutLn
    END
END DebugMsg;


PROCEDURE OutString (s: ARRAY OF CHAR);
VAR
    i: INTEGER;
BEGIN
    i := 0;
    WHILE (i < LEN(s)) & (s[i] # 0X) DO
        OutChar(s[i]);
        INC(i)
    END
END OutString;


PROCEDURE imp_error;
BEGIN
    OutString("import error: ");
    IF K.imp_error.error = 1 THEN
        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)
    END;
    OutLn
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);
    K._init;
    import := (K.dll_Load(_import) = 0) & (K.imp_error.error = 0);
    IF ~import THEN
        imp_error
    END
END init;


PROCEDURE SetMultiThr* (value: BOOLEAN);
BEGIN
    multi := value
END SetMultiThr;


PROCEDURE GetTickCount* (): INTEGER;
    RETURN K.sysfunc2(26, 9) * 10
END GetTickCount;


PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
    RETURN 0
END dllentry;


PROCEDURE sofinit*;
END sofinit;


END API.