Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018, 2020-2021, Anton Krotov

    All rights reserved.

*)

MODULE API;

IMPORT SYSTEM, K := KOSAPI;

CONST

    eol* = 0DX + 0AX;

    BIT_DEPTH* = 32;

    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;

    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;

    OutString("'");

    OutLn

END imp_error;

PROCEDURE init* (import_, code: INTEGER);

BEGIN

    multi := FALSE;

    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.