(* 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.