| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290 |
- (*
- BSD 2-Clause License
- Copyright (c) 2018, 2020-2022, 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;
- 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 OutStr (pchar: INTEGER);
- VAR
- c: CHAR;
- BEGIN
- IF pchar # 0 THEN
- REPEAT
- SYSTEM.GET(pchar, c);
- IF c # 0X THEN
- K.OutChar(c)
- END;
- INC(pchar)
- UNTIL c = 0X
- END
- END OutStr;
- PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
- BEGIN
- IF lpCaption # 0 THEN
- K.OutLn;
- OutStr(lpCaption);
- K.OutChar(":");
- K.OutLn
- END;
- OutStr(lpText);
- IF lpCaption # 0 THEN
- K.OutLn
- END
- END DebugMsg;
- PROCEDURE init* (import_, code: INTEGER);
- BEGIN
- multi := FALSE;
- base := code - SizeOfHeader;
- K.sysfunc2(68, 11);
- InitializeCriticalSection(CriticalSection);
- K._init(import_)
- 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.
|