(*
    Copyright 2016, 2017 Anton Krotov

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*)

MODULE API;

IMPORT sys := SYSTEM;


CONST

    MAX_SIZE  = 16 * 400H;
    HEAP_SIZE =  1 * 100000H;
    
    _new = 1;
    _dispose = 2;

    
TYPE

    CRITICAL_SECTION = ARRAY 2 OF INTEGER;


VAR

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

    CriticalSection: CRITICAL_SECTION;


PROCEDURE [stdcall] zeromem* (size, adr: INTEGER);
BEGIN
    sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
END zeromem; 


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


PROCEDURE strncmp* (a, b, n: INTEGER): INTEGER;
VAR
    A, B: CHAR;
    Res: INTEGER;
BEGIN
    Res := 0;
    WHILE n > 0 DO
        sys.GET(a, A); INC(a);
        sys.GET(b, B); INC(b);
        DEC(n);
        IF A # B THEN
            Res := ORD(A) - ORD(B);
            n := 0
        ELSIF A = 0X THEN
            n := 0
        END
    END
    RETURN Res
END strncmp;    


PROCEDURE [stdcall] sysfunc1* (arg1: INTEGER): INTEGER;
BEGIN
    sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
    sys.CODE("CD40");             (* int     40h              *)
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C20400");           (* ret     04h              *)
    RETURN 0
END sysfunc1; 


PROCEDURE [stdcall] sysfunc2* (arg1, arg2: INTEGER): INTEGER;
BEGIN
    sys.CODE("53");               (* push    ebx              *)
    sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
    sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
    sys.CODE("CD40");             (* int     40h              *)
    sys.CODE("5B");               (* pop     ebx              *)
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C20800");           (* ret     08h              *)
    RETURN 0
END sysfunc2;    


PROCEDURE [stdcall] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
BEGIN
    sys.CODE("53");               (* push    ebx              *)
    sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
    sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
    sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
    sys.CODE("CD40");             (* int     40h              *)
    sys.CODE("5B");               (* pop     ebx              *)
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C20C00");           (* ret     0Ch              *)
    RETURN 0
END sysfunc3;


PROCEDURE [stdcall] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER;
BEGIN
    sys.CODE("53");               (* push    ebx              *)
    sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
    sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
    sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
    sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
    sys.CODE("CD40");             (* int     40h              *)
    sys.CODE("5B");               (* pop     ebx              *)
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C21000");           (* ret     10h              *)
    RETURN 0
END sysfunc4;    


PROCEDURE [stdcall] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
BEGIN
    sys.CODE("53");               (* push    ebx              *)
    sys.CODE("56");               (* push    esi              *)
    sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
    sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
    sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
    sys.CODE("8B5514");           (* mov     edx, [ebp + 14h] *)
    sys.CODE("8B7518");           (* mov     esi, [ebp + 18h] *)
    sys.CODE("CD40");             (* int     40h              *)
    sys.CODE("5E");               (* pop     esi              *)
    sys.CODE("5B");               (* pop     ebx              *)
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C21400");           (* ret     14h              *)
    RETURN 0
END sysfunc5;


PROCEDURE switch_task;
VAR
    res: INTEGER;
BEGIN
    res := sysfunc2(68, 1)
END switch_task;


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


PROCEDURE futex_wait (futex, value, timeout: INTEGER);
VAR
    res: INTEGER;
BEGIN
    res := sysfunc5(77, 2, futex, value, timeout)
END futex_wait;


PROCEDURE futex_wake (futex, number: INTEGER);
VAR
    res: INTEGER;
BEGIN
    res := 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(sys.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
            sys.GET(res, pockets[idx]);
            sys.PUT(res, size);
            INC(res, 4)
        ELSE
            temp := 0;
            IF heap + size >= endheap THEN
                IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
                    temp := 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
                sys.PUT(heap, size);
                res := heap + 4;
                heap := heap + size
            ELSE
                res := 0
            END
        END
    ELSE
        IF sysfunc2(18, 16) > ASR(size, 10) THEN
            res := sysfunc3(68, 12, size);
            IF res # 0 THEN
                mem_commit(res, size);
                sys.PUT(res, size);
                INC(res, 4)
            END
        ELSE
            res := 0
        END
    END;
    IF res # 0 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);
    sys.GET(ptr, size);
    IF size <= MAX_SIZE THEN
        idx := ASR(size, 5);
        sys.PUT(ptr, pockets[idx]);
        pockets[idx] := ptr
    ELSE
        size := sysfunc3(68, 13, ptr)
    END
    RETURN 0
END __DISPOSE;


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

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

    LeaveCriticalSection(CriticalSection)
    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 ExitProcess* (p1: INTEGER);
BEGIN
  p1 := sysfunc1(-1)
END ExitProcess;  


PROCEDURE ExitThread* (p1: INTEGER);
BEGIN
    p1 := sysfunc1(-1)
END ExitThread;  


PROCEDURE OutChar (c: CHAR);
VAR
    res: INTEGER;
BEGIN
    res := sysfunc3(63, 1, ORD(c))
END OutChar; 


PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
VAR
    c: CHAR;
BEGIN
    IF lpCaption # 0 THEN
        OutChar(0DX);
        OutChar(0AX);
        REPEAT
            sys.GET(lpCaption, c);
            IF c # 0X THEN
                OutChar(c)
            END;
            INC(lpCaption)
        UNTIL c = 0X;
        OutChar(":");
        OutChar(0DX);
        OutChar(0AX)
    END;
    REPEAT
        sys.GET(lpText, c);
        IF c # 0X THEN
            OutChar(c)
        END;
        INC(lpText)
    UNTIL c = 0X;
    IF lpCaption # 0 THEN
        OutChar(0DX);
        OutChar(0AX)
    END
END DebugMsg;  


PROCEDURE init* (p1: INTEGER);
BEGIN
    p1 := sysfunc2(68, 11);
    InitializeCriticalSection(CriticalSection)
END init; 


END API.