XenOn/kolibrios-fun
1
1
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Wiki Activity

oberon07: fix for r7107, NEW/DISPOSE support multi-thread mode

Browse Source 
git-svn-id: svn://kolibrios.org@7110 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2017-11-16 07:01:07 +00:00
parent fbdde8ba84
commit e80f6ad31e
3 changed files with 308 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
programs/develop/oberon07/Compiler.kex
View File

Binary file not shown.

465
programs/develop/oberon07/Lib/KolibriOS/API.ob07
View File

@ -19,197 +19,342 @@ MODULE API;
IMPORT sys := SYSTEM; IMPORT sys := SYSTEM;
CONST CONST
MAX_SIZE = 16 * 400H; MAX_SIZE = 16 * 400H;
HEAP_SIZE = 1 * 100000H; HEAP_SIZE = 1 * 100000H;
_new = 1;
_dispose = 2;
TYPE
CRITICAL_SECTION = ARRAY 2 OF INTEGER;
VAR VAR
heap, endheap: INTEGER; heap, endheap: INTEGER;
pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER; pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
PROCEDURE [stdcall] zeromem*(size, adr: INTEGER); CriticalSection: CRITICAL_SECTION;
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; PROCEDURE [stdcall] zeromem* (size, adr: INTEGER);
VAR A, B: CHAR; Res: INTEGER;
BEGIN BEGIN
Res := 0; sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
WHILE n > 0 DO END zeromem;
sys.GET(a, A); INC(a);
sys.GET(b, B); INC(b);
DEC(n); PROCEDURE mem_commit* (adr, size: INTEGER);
IF A # B THEN VAR
Res := ORD(A) - ORD(B); tmp: INTEGER;
n := 0 BEGIN
ELSIF A = 0X THEN FOR tmp := adr TO adr + size - 1 BY 4096 DO
n := 0 sys.PUT(tmp, 0)
END END
END END mem_commit;
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; PROCEDURE strncmp* (a, b, n: INTEGER): INTEGER;
VAR
A, B: CHAR;
Res: INTEGER;
BEGIN BEGIN
sys.CODE("53"); (* push ebx *) Res := 0;
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) WHILE n > 0 DO
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) sys.GET(a, A); INC(a);
sys.CODE("CD40"); (* int 40h *) sys.GET(b, B); INC(b);
sys.CODE("5B"); (* pop ebx *) DEC(n);
sys.CODE("C9"); (* leave *) IF A # B THEN
sys.CODE("C20800"); (* ret 08h *) Res := ORD(A) - ORD(B);
RETURN 0 n := 0
END sysfunc2; ELSIF A = 0X THEN
n := 0
END
END
RETURN Res
END strncmp;
PROCEDURE [stdcall] sysfunc3*(arg1, arg2, arg3: INTEGER): INTEGER;
PROCEDURE [stdcall] sysfunc1* (arg1: INTEGER): INTEGER;
BEGIN BEGIN
sys.CODE("53"); (* push ebx *) sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) sys.CODE("CD40"); (* int 40h *)
sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) sys.CODE("C9"); (* leave *)
sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) sys.CODE("C20400"); (* ret 04h *)
sys.CODE("CD40"); (* int 40h *) RETURN 0
sys.CODE("5B"); (* pop ebx *) END sysfunc1;
sys.CODE("C9"); (* leave *)
sys.CODE("C20C00"); (* ret 0Ch *)
RETURN 0 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; END sysfunc3;
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; PROCEDURE [stdcall] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER;
VAR size, idx: INTEGER;
BEGIN BEGIN
DEC(ptr, 4); sys.CODE("53"); (* push ebx *)
sys.GET(ptr, size); sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *)
IF size <= MAX_SIZE THEN sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *)
idx := ASR(size, 5); sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *)
sys.PUT(ptr, pockets[idx]); sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *)
pockets[idx] := ptr sys.CODE("CD40"); (* int 40h *)
ELSE sys.CODE("5B"); (* pop ebx *)
size := sysfunc3(68, 13, ptr) sys.CODE("C9"); (* leave *)
END sys.CODE("C21000"); (* ret 10h *)
RETURN 0 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; END _DISPOSE;
PROCEDURE ExitProcess*(p1: INTEGER);
PROCEDURE ExitProcess* (p1: INTEGER);
BEGIN BEGIN
p1 := sysfunc1(-1) p1 := sysfunc1(-1)
END ExitProcess; END ExitProcess;
PROCEDURE ExitThread*(p1: INTEGER);
BEGIN
p1 := sysfunc1(-1)
END ExitThread;
PROCEDURE OutChar(c: CHAR); PROCEDURE ExitThread* (p1: INTEGER);
VAR res: INTEGER;
BEGIN BEGIN
res := sysfunc3(63, 1, ORD(c)) p1 := sysfunc1(-1)
END OutChar; END ExitThread;
PROCEDURE DebugMsg*(lpText, lpCaption: INTEGER);
VAR c: CHAR; PROCEDURE OutChar (c: CHAR);
VAR
res: INTEGER;
BEGIN BEGIN
IF lpCaption # 0 THEN res := sysfunc3(63, 1, ORD(c))
OutChar(0DX); END OutChar;
OutChar(0AX);
REPEAT
sys.GET(lpCaption, c); PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
IF c # 0X THEN VAR
OutChar(c) c: CHAR;
END; BEGIN
INC(lpCaption) IF lpCaption # 0 THEN
UNTIL c = 0X; OutChar(0DX);
OutChar(":"); OutChar(0AX);
OutChar(0DX); REPEAT
OutChar(0AX) sys.GET(lpCaption, c);
END; IF c # 0X THEN
REPEAT OutChar(c)
sys.GET(lpText, c); END;
IF c # 0X THEN INC(lpCaption)
OutChar(c) UNTIL c = 0X;
OutChar(":");
OutChar(0DX);
OutChar(0AX)
END; END;
INC(lpText) REPEAT
UNTIL c = 0X; sys.GET(lpText, c);
IF lpCaption # 0 THEN IF c # 0X THEN
OutChar(0DX); OutChar(c)
OutChar(0AX) END;
END INC(lpText)
END DebugMsg; UNTIL c = 0X;
IF lpCaption # 0 THEN
OutChar(0DX);
OutChar(0AX)
END
END DebugMsg;
PROCEDURE init* (p1: INTEGER); PROCEDURE init* (p1: INTEGER);
BEGIN BEGIN
p1 := sysfunc2(68, 11) p1 := sysfunc2(68, 11);
END init; InitializeCriticalSection(CriticalSection)
END init;
END API. END API.

5
programs/develop/oberon07/Lib/Windows32/RTL.ob07
View File

@ -1,4 +1,4 @@
(* (*
Copyright 2016, 2017 Anton Krotov Copyright 2016, 2017 Anton Krotov
This program is free software: you can redistribute it and/or modify This program is free software: you can redistribute it and/or modify
@ -245,7 +245,8 @@ BEGIN
StrAppend("code "); StrAppend("code ");
Int(code, int); Int(code, int);
StrAppend(int) StrAppend(int)
END; END;
API.DebugMsg(sys.ADR(msg), SelfName);
IF API.GetCurrentThreadId() = main_thread_id THEN IF API.GetCurrentThreadId() = main_thread_id THEN
API.ExitProcess(0) API.ExitProcess(0)
ELSE ELSE