ShuriZma
/
FPPS4
mirror of https://github.com/red-prig/fpPS4.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

+

This commit is contained in:
Pavel 2025-02-23 21:07:16 +03:00
parent 470f28a62e
commit 5b47cc263e
16 changed files with 493 additions and 309 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/LFQueue.pas
View File

@ -35,7 +35,7 @@ Const
Type
TIntrusiveMPSCQueue=object
protected
//protected
type
PQNode=^TQNode;
TQNode=record

161
sys/kern/kern_hazard_pointer.pas
View File

@ -25,19 +25,26 @@ type
function Get:Pointer;
function Protect(Var P:Pointer;Func:TFuncGet=nil):Pointer;
Procedure Retire (P:Pointer;FuncFree:TFuncFree); static;
Procedure WaitFor(P:Pointer); static;
Procedure Flush; static;
Procedure FLazy; static;
end;
Procedure tlHpInit;
Procedure tlHpFree;
implementation
uses
atomic,
mqueue,
LFQueue,
g_node_splay,
kern_thr;
kern_thr,
time,
md_sleep;
var
rlist_bs:LIST_HEAD=(lh_first:nil);
rlist_lf:TIntrusiveMPSCQueue=(tail_:@rlist_lf.stub_;stub_:(next_:nil);head_:@rlist_lf.stub_);
rcount :Integer=0;
function AllocGuard:Pointer;
var
@ -91,14 +98,47 @@ begin
Result:=Integer(n1^.P>n2^.P)-Integer(n1^.P<n2^.P);
end;
threadvar
rlist :LIST_HEAD;
rcount:Integer;
procedure WaitForRetire(P:Pointer);
label
_again;
var
p_data:Pointer;
ttd :p_kthread;
i :Byte;
begin
if (P=nil) or (P=Pointer(1)) then Exit;
_again:
threads_lock;
ttd:=TAILQ_FIRST(get_p_threads);
while (ttd<>nil) do
begin
For i:=0 to High(kthread.td_guards) do
begin
p_data:=load_acq_rel(ttd^.td_guards[i]);
if (p_data=P) then
begin
threads_unlock;
msleep_td(hz div 10000);
goto _again;
end;
end;
ttd:=TAILQ_NEXT(ttd,@ttd^.td_plist)
end;
threads_unlock;
end;
type
t_scan_mode=(smLazy,smLazyOne,smForce);
t_scan_mode=(smLazy,smForce);
function Scan(mode:t_scan_mode):Pointer;
Procedure Scan(mode:t_scan_mode);
label
_again;
var
@ -108,16 +148,15 @@ var
r_node:p_r_node;
r_next:p_r_node;
ttd :p_kthread;
f_list:LIST_HEAD;
i :Byte;
begin
Result:=nil;
_again:
r_node:=LIST_FIRST(@rlist);
if (r_node=nil) then Exit;
p_set:=Default(TPointerSet);
p_set :=Default(TPointerSet);
r_node:=nil;
f_list:=Default(LIST_HEAD);
if (mode=smForce) then
begin
@ -127,6 +166,20 @@ begin
if not threads_trylock then Exit;
end;
//flush to base list
while rlist_lf.Pop(r_node) do
begin
LIST_INSERT_HEAD(@rlist_bs,r_node,@r_node^.entry);
end;
r_node:=LIST_FIRST(@rlist_bs);
if (r_node=nil) then
begin
//zero list
threads_unlock;
Exit;
end;
ttd:=TAILQ_FIRST(get_p_threads);
while (ttd<>nil) do
begin
@ -146,8 +199,6 @@ begin
ttd:=TAILQ_NEXT(ttd,@ttd^.td_plist)
end;
threads_unlock;
while (r_node<>nil) do
begin
r_next:=LIST_NEXT(r_node,@r_node^.entry);
@ -158,29 +209,15 @@ begin
begin
//delete node
LIST_REMOVE(r_node,@r_node^.entry);
//free element
if (r_node^.F<>nil) then
begin
r_node^.F(r_node^.P);
end;
//
if (mode=smLazyOne) then
begin
//set result and exit
Dec(rcount);
Result:=r_node;
Break;
end else
begin
//free node
Dec(rcount);
FreeMem(r_node);
end;
//add to free list
LIST_INSERT_HEAD(@f_list,r_node,@r_node^.entry);
end;
//
r_node:=r_next;
end;
threads_unlock;
//free set
p_node:=p_set.Min;
while (p_node<>nil) do
@ -192,29 +229,42 @@ begin
p_node:=p_set.Min;
end;
if (mode=smForce) and
(LIST_FIRST(@rlist)<>nil) then
//free elements
r_node:=LIST_FIRST(@f_list);
while (r_node<>nil) do
begin
LIST_REMOVE(r_node,@r_node^.entry);
//free element
if (r_node^.F<>nil) then
begin
r_node^.F(r_node^.P);
end;
//free node
System.InterlockedDecrement(rcount);
FreeMem(r_node);
//
r_node:=LIST_FIRST(@f_list);
end;
if (mode=smForce) and
(LIST_FIRST(@rlist_bs)<>nil) then
begin
msleep_td(hz div 10000);
goto _again;
end;
end;
Procedure Retire(P:Pointer;FuncFree:TGuard.TFuncFree);
var
node:p_r_node;
begin
node:=Scan(smLazyOne);
//
if (node<>nil) then
begin
node:=AllocMem(SizeOf(t_r_node));
end;
node:=AllocMem(SizeOf(t_r_node));
node^.P:=P;
node^.F:=FuncFree;
//
LIST_INSERT_HEAD(@rlist,node,@node^.entry);
//
Inc(rcount);
rlist_lf.Push(node);
System.InterlockedIncrement(rcount);
//
if rcount>(4*256) then
begin
@ -222,17 +272,6 @@ begin
end;
end;
Procedure tlHpInit; public;
begin
rlist :=Default(LIST_HEAD);
rcount:=0;
end;
Procedure tlHpFree; public;
begin
Scan(smForce);
end;
////////
function TGuard.New:TGuard;
@ -310,11 +349,21 @@ begin
end;
end;
Procedure TGuard.WaitFor(P:Pointer);
begin
WaitForRetire(P);
end;
Procedure TGuard.Flush;
begin
Scan(smForce);
end;
Procedure TGuard.FLazy;
begin
Scan(smLazy);
end;
/////////
end.

8
sys/kern/kern_thread.pas
View File

@ -78,8 +78,7 @@ uses
kern_proc,
kern_rangelock,
sched_ule,
sys_sleepqueue,
kern_hazard_pointer;
sys_sleepqueue;
//
@ -203,7 +202,6 @@ begin
rlqentry_free(td^.td_rlqe);
umtx_thread_fini(td);
cpu_thread_free(td);
tlHpFree;
end;
procedure thread_inc_ref(td:p_kthread); public;
@ -378,8 +376,6 @@ begin
InitThread(td^.td_ustack.stack-td^.td_ustack.sttop);
tlHpInit;
Set8087CW(__INITIAL_FPUCW__);
SetMXCSR (__INITIAL_MXCSR__);
@ -402,8 +398,6 @@ begin
InitThread(td^.td_ustack.stack-td^.td_ustack.sttop);
tlHpInit;
Set8087CW(__INITIAL_FPUCW__);
SetMXCSR (__INITIAL_MXCSR__);

4
sys/md/md_timeout.pas
View File

@ -28,7 +28,7 @@ uses
var
timeout_thr:p_kthread=nil;
timeout_new:TIntrusiveMPSCQueue;
timeout_new:TIntrusiveMPSCQueue=(tail_:@timeout_new.stub_;stub_:(next_:nil);head_:@timeout_new.stub_);
procedure softclock(arg:Pointer); forward;
@ -36,8 +36,6 @@ procedure md_start_softclock();
var
r:Integer;
begin
timeout_new.Create;
r:=kthread_add(@softclock,nil,@timeout_thr,0,'softclock');
Assert(r=0,'softclock');
end;

2
sys/sys_sysinit.pas
View File

@ -27,6 +27,7 @@ uses
kern_synch,
kern_umtx,
kern_namedobj,
kern_hazard_pointer,
vmount,
vfiledesc,
vm_map,
@ -67,6 +68,7 @@ begin
sched_prio(curkthread,1000);
repeat
vnlru_proc;
TGuard.FLazy;
pause('sys_daemon',hz);
until false;
end;

124
vulkan/vBuffer.pas
View File

@ -24,15 +24,12 @@ type
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
procedure UnBindMem(do_free:Boolean);
function Hold(Sender:TObject):Boolean; override;
function Drop(Sender:TObject):Boolean; override;
function is_invalid:Boolean;
procedure FreeHandle;
procedure OnReleaseMem(Sender:TObject); virtual;
function OnReleaseMem(Sender:TObject):Boolean; virtual;
procedure SetObjectName(const name:RawByteString);
//
function _Acquire(Sender:TObject):Boolean;
procedure _Release(Sender:TObject);
function Acquire(Sender:TObject):Boolean; override;
procedure Release(Sender:TObject); override;
end;
function VkBindSparseBufferMemory(queue:TVkQueue;buffer:TVkBuffer;bindCount:TVkUInt32;pBinds:PVkSparseMemoryBind):TVkResult;
@ -179,23 +176,26 @@ begin
end;
function TvBuffer.BindMem(P:TvPointer):TVkResult;
var
B:TvPointer;
begin
if P.Acquire then //try Acquire
B:=P.Acquire;
if (B.FMemory<>nil) then //try Acquire
begin
if ((P.FOffset+self.FSize)>P.FMemory.FSize) then
begin
Assert(False);
end;
//
Result:=vkBindBufferMemory(Device.FHandle,FHandle,P.FMemory.FHandle,P.FOffset);
Result:=vkBindBufferMemory(Device.FHandle,FHandle,B.FMemory.FHandle,B.FOffset);
//
if (Result=VK_SUCCESS) then
begin
FBind:=P;
P.FMemory.AddDependence(@Self.OnReleaseMem);
B.FMemory.AddDependence(@Self.OnReleaseMem);
FBind:=B;
end;
//
P.Release; //release Acquire
B.Release; //release Acquire
end else
begin
Result:=VK_ERROR_UNKNOWN;
@ -205,46 +205,64 @@ end;
procedure TvBuffer.UnBindMem(do_free:Boolean);
var
B:TvPointer;
R:ptruint;
begin
if (FBind.FMemory<>nil) then
B.FMemory:=TvDeviceMemory(System.InterlockedExchange(Pointer(FBind.FMemory),nil));
B.FOffset:=FBind.FOffset;
if (B.FMemory<>nil) then
begin
B:=FBind;
FBind.FMemory:=nil;
//
R:=ptruint(System.InterlockedExchange(Pointer(FBRefs),nil));
while (R<>0) do
begin
B.Release;
Dec(R);
end;
//
if do_free then
begin
B.FMemory.DelDependence(@Self.OnReleaseMem);
MemManager.FreeMemory(B);
end;
end;
end;
function TvBuffer.Hold(Sender:TObject):Boolean;
begin
Result:=FBind.Hold;
if Result then
begin
Result:=inherited;
if not Result then
begin
FBind.Drop;
end;
end;
end;
function TvBuffer.Drop(Sender:TObject):Boolean;
begin
Result:=FBind.Drop;
if Result then
begin
Result:=inherited;
end;
end;
function TvBuffer.is_invalid:Boolean;
begin
Result:=(FHandle=VK_NULL_HANDLE);
end;
procedure TvBuffer.FreeHandle;
var
F:TVkBuffer;
begin
if (FHandle<>VK_NULL_HANDLE) then
F:=System.InterlockedExchange64(FHandle,VK_NULL_HANDLE);
if (F<>VK_NULL_HANDLE) then
begin
vkDestroyBuffer(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
vkDestroyBuffer(Device.FHandle,F,nil);
end;
end;
procedure TvBuffer.OnReleaseMem(Sender:TObject);
Function TvBuffer.OnReleaseMem(Sender:TObject):Boolean;
begin
FreeHandle;
//
UnBindMem(False);
//
Result:=True;
end;
procedure TvBuffer.SetObjectName(const name:RawByteString);
@ -252,58 +270,6 @@ begin
DebugReport.SetObjectName(VK_OBJECT_TYPE_BUFFER,FHandle,PChar(name));
end;
function TvBuffer._Acquire(Sender:TObject):Boolean;
begin
Result:=inherited Acquire(Sender);
end;
procedure TvBuffer._Release(Sender:TObject);
begin
inherited Release(Sender);
end;
function TvBuffer.Acquire(Sender:TObject):Boolean;
begin
if (FBind.FMemory<>nil) then
begin
Result:=FBind.Acquire;
if Result then
begin
System.InterlockedIncrement(Pointer(FBRefs));
inherited Acquire(Sender);
end;
end else
begin
Result:=False;
//Result:=inherited Acquire(Sender);
end;
end;
procedure TvBuffer.Release(Sender:TObject);
var
B:TvPointer;
R:ptruint;
begin
while True do
begin
B:=FBind;
if (B.FMemory<>nil) and (FBRefs<>0) then
begin
R:=FBRefs;
if (System.InterlockedCompareExchange(Pointer(FBRefs),Pointer(R-1),Pointer(R))=Pointer(R)) then
begin
B.Release;
inherited Release(Sender);
Break;
end;
end else
begin
inherited Release(Sender);
Break;
end;
end;
end;
end.

59
vulkan/vDependence.pas
View File

@ -9,7 +9,7 @@ uses
g23tree;
type
TvReleaseCb=procedure(Sender:TObject) of object;
TvReleaseCb=function(Sender:TObject):Boolean of object;
{
TvReleaseCompare=object
@ -33,9 +33,12 @@ type
TvRelease=specialize TNodeSplay<TvReleaseNode>;
TvRefsObject=class
FRefs:ptruint;
FRefs:Integer;
FHold:Integer;
function Acquire(Sender:TObject):Boolean; virtual;
procedure Release(Sender:TObject); virtual;
function Release(Sender:TObject):Boolean; virtual;
function Hold (Sender:TObject):Boolean; virtual;
function Drop (Sender:TObject):Boolean; virtual;
end;
TvDependenciesObject=class(TvRefsObject)
@ -45,9 +48,10 @@ type
function OnAlloc(size:Ptruint):Pointer; virtual;
Procedure OnFree (P:Pointer ); virtual;
function IsLinearAlloc:Boolean; virtual;
Procedure RefTo(obj:TvRefsObject);
function RefTo(obj:TvRefsObject):Boolean;
function AddDependence(cb:TvReleaseCb):Boolean;
function DelDependence(cb:TvReleaseCb):Boolean;
function HasDependence:Boolean;
Procedure ReleaseAllDependencies(Sender:TObject);
Procedure FreeAllDependencies;
Destructor Destroy; override;
@ -109,16 +113,38 @@ end;
function TvRefsObject.Acquire(Sender:TObject):Boolean;
begin
System.InterlockedIncrement(Pointer(FRefs));
System.InterlockedIncrement(FRefs);
Result:=True;
end;
procedure TvRefsObject.Release(Sender:TObject);
function TvRefsObject.Release(Sender:TObject):Boolean;
begin
if System.InterlockedDecrement(Pointer(FRefs))=nil then
if System.InterlockedDecrement(FRefs)=0 then
begin
Free;
end;
Result:=True;
end;
function TvRefsObject.Hold(Sender:TObject):Boolean;
begin
if System.InterlockedIncrement(FHold)=1 then
begin
Result:=Acquire(Sender);
if not Result then
begin
System.InterlockedDecrement(FHold);
end;
end;
end;
function TvRefsObject.Drop(Sender:TObject):Boolean;
begin
Result:=True;
if System.InterlockedDecrement(FHold)=0 then
begin
Result:=Release(Sender);
end;
end;
//
@ -138,12 +164,20 @@ begin
Result:=False;
end;
Procedure TvDependenciesObject.RefTo(obj:TvRefsObject);
function TvDependenciesObject.RefTo(obj:TvRefsObject):Boolean;
begin
Result:=False;
if (Self=nil) or (obj=nil) then Exit;
if AddDependence(@obj.Release) then
if AddDependence(@obj.Drop) then
begin
obj.Acquire(Self);
Result:=obj.Hold(Self);
if not Result then
begin
DelDependence(@obj.Drop)
end;
end else
begin
Result:=True;
end;
end;
@ -188,6 +222,11 @@ begin
rw_wunlock(FDep_lock);
end;
function TvDependenciesObject.HasDependence:Boolean;
begin
Result:=(FDependencies.pRoot<>nil);
end;
Procedure TvDependenciesObject.ReleaseAllDependencies(Sender:TObject);
var
node:PvReleaseNode;

9
vulkan/vDevice.pas
View File

@ -300,6 +300,8 @@ var
VK_AMD_device_coherent_memory :Boolean;
VK_EXT_memory_budget :Boolean;
DeviceFeature:TVkPhysicalDeviceFeatures;
shaderFloat16:TVkBool32;
@ -505,6 +507,8 @@ begin
VK_EXT_DEPTH_CLIP_ENABLE_EXTENSION_NAME :limits.VK_EXT_depth_clip_enable :=True;
VK_AMD_DEVICE_COHERENT_MEMORY_EXTENSION_NAME :limits.VK_AMD_device_coherent_memory :=True;
VK_EXT_MEMORY_BUDGET_EXTENSION_NAME :limits.VK_EXT_memory_budget :=True;
end;
end;
FreeMem(pProperties);
@ -2008,6 +2012,11 @@ begin
DeviceInfo.add_feature(@FCoherent);
end;
if limits.VK_EXT_memory_budget then
begin
DeviceInfo.add_ext(VK_EXT_MEMORY_BUDGET_EXTENSION_NAME);
end;
if limits.VK_EXT_vertex_input_dynamic_state then
begin
DeviceInfo.add_ext(VK_EXT_VERTEX_INPUT_DYNAMIC_STATE_EXTENSION_NAME);

4
vulkan/vHostBufferManager.pas
View File

@ -127,7 +127,7 @@ begin
_delete:
//mem is deleted, free buf
FHostBufferSet.erase(It);
buf._Release(nil); //map ref
buf.Release(nil); //map ref
buf:=nil;
goto _repeat;
end;
@ -263,7 +263,7 @@ begin
if FHostBufferSet.Insert(key) then
begin
key.FBuffer._Acquire(nil); //map ref
key.FBuffer.Acquire(nil); //map ref
end else
begin
//collision?

124
vulkan/vImage.pas
View File

@ -79,13 +79,10 @@ type
function Compile(ext:Pointer):Boolean; virtual;
function BindMem(P:TvPointer):TVkResult;
procedure UnBindMem(do_free:Boolean);
procedure OnReleaseMem(Sender:TObject); virtual;
function Hold(Sender:TObject):Boolean; override;
function Drop(Sender:TObject):Boolean; override;
function OnReleaseMem(Sender:TObject):Boolean; virtual;
procedure SetObjectName(const name:RawByteString);
//
function _Acquire(Sender:TObject):Boolean;
procedure _Release(Sender:TObject);
function Acquire(Sender:TObject):Boolean; override;
procedure Release(Sender:TObject); override;
end;
const
@ -1571,11 +1568,13 @@ begin
end;
procedure TvCustomImage.FreeHandle;
var
F:TVkImage;
begin
if (FHandle<>VK_NULL_HANDLE) then
F:=System.InterlockedExchange64(FHandle,VK_NULL_HANDLE);
if (F<>VK_NULL_HANDLE) then
begin
vkDestroyImage(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
vkDestroyImage(Device.FHandle,F,nil);
end;
end;
@ -1654,19 +1653,22 @@ begin
end;
function TvCustomImage.BindMem(P:TvPointer):TVkResult;
var
B:TvPointer;
begin
if P.Acquire then //try Acquire
B:=P.Acquire;
if (B.FMemory<>nil) then //try Acquire
begin
//
Result:=vkBindImageMemory(Device.FHandle,FHandle,P.FMemory.FHandle,P.FOffset);
Result:=vkBindImageMemory(Device.FHandle,FHandle,B.FMemory.FHandle,B.FOffset);
//
if (Result=VK_SUCCESS) then
begin
FBind:=P;
P.FMemory.AddDependence(@Self.OnReleaseMem);
B.FMemory.AddDependence(@Self.OnReleaseMem);
FBind:=B;
end;
//
P.Release; //release Acquire
B.Release; //release Acquire
end else
begin
Result:=VK_ERROR_UNKNOWN;
@ -1676,32 +1678,48 @@ end;
procedure TvCustomImage.UnBindMem(do_free:Boolean);
var
B:TvPointer;
R:ptruint;
begin
if (FBind.FMemory<>nil) then
B.FMemory:=TvDeviceMemory(System.InterlockedExchange(Pointer(FBind.FMemory),nil));
B.FOffset:=FBind.FOffset;
if (B.FMemory<>nil) then
begin
B:=FBind;
FBind.FMemory:=nil;
//
R:=ptruint(System.InterlockedExchange(Pointer(FBRefs),nil));
while (R<>0) do
begin
B.Release;
Dec(R);
end;
//
if do_free then
begin
B.FMemory.DelDependence(@Self.OnReleaseMem);
MemManager.FreeMemory(B);
end;
end;
end;
procedure TvCustomImage.OnReleaseMem(Sender:TObject);
function TvCustomImage.Hold(Sender:TObject):Boolean;
begin
Result:=FBind.Hold;
if Result then
begin
Result:=inherited;
if not Result then
begin
FBind.Drop;
end;
end;
end;
function TvCustomImage.Drop(Sender:TObject):Boolean;
begin
Result:=FBind.Drop;
if Result then
begin
Result:=inherited;
end;
end;
function TvCustomImage.OnReleaseMem(Sender:TObject):Boolean;
begin
FreeHandle;
//
UnBindMem(False);
//
Result:=True;
end;
procedure TvCustomImage.SetObjectName(const name:RawByteString);
@ -1710,57 +1728,7 @@ begin
DebugReport.SetObjectName(VK_OBJECT_TYPE_IMAGE,FHandle,PChar(name));
end;
function TvCustomImage._Acquire(Sender:TObject):Boolean;
begin
Result:=inherited Acquire(Sender);
end;
procedure TvCustomImage._Release(Sender:TObject);
begin
inherited Release(Sender);
end;
function TvCustomImage.Acquire(Sender:TObject):Boolean;
begin
if (FBind.FMemory<>nil) then
begin
Result:=FBind.Acquire;
if Result then
begin
System.InterlockedIncrement(Pointer(FBRefs));
inherited Acquire(Sender);
end;
end else
begin
Result:=False;
//Result:=inherited Acquire(Sender);
end;
end;
procedure TvCustomImage.Release(Sender:TObject);
var
B:TvPointer;
R:ptruint;
begin
while True do
begin
B:=FBind;
if (B.FMemory<>nil) and (FBRefs<>0) then
begin
R:=FBRefs;
if (System.InterlockedCompareExchange(Pointer(FBRefs),Pointer(R-1),Pointer(R))=Pointer(R)) then
begin
B.Release;
inherited Release(Sender);
Break;
end;
end else
begin
inherited Release(Sender);
Break;
end;
end;
end;
///
procedure _test_and_set_to(var new:TVkFlags;
test:TVkFlags;

34
vulkan/vImageManager.pas
View File

@ -109,7 +109,9 @@ type
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags); override;
function Acquire(Sender:TObject):Boolean; override;
procedure Release(Sender:TObject); override;
function Release(Sender:TObject):Boolean; override;
function Hold (Sender:TObject):Boolean; override;
function Drop (Sender:TObject):Boolean; override;
end;
TvImage2=class(TvCustomImage2)
@ -137,8 +139,8 @@ type
procedure ForceBarrier(dstAccessMask:TVkAccessFlags;
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags); override;
function Acquire(Sender:TObject):Boolean; override;
procedure Release(Sender:TObject); override;
function Hold (Sender:TObject):Boolean; override;
function Drop (Sender:TObject):Boolean; override;
end;
TvDepthStencilImage2=class(TvImage2)
@ -387,9 +389,19 @@ begin
Result:=Parent.Acquire(Sender);
end;
procedure TvChildImage2.Release(Sender:TObject);
function TvChildImage2.Release(Sender:TObject):Boolean;
begin
Parent.Release(Sender);
Result:=Parent.Release(Sender);
end;
function TvChildImage2.Hold(Sender:TObject):Boolean;
begin
Result:=Parent.Hold(Sender);
end;
function TvChildImage2.Drop(Sender:TObject):Boolean;
begin
Result:=Parent.Drop(Sender);
end;
//
@ -798,9 +810,9 @@ begin
rw_wunlock(lock);
end;
function TvImage2.Acquire(Sender:TObject):Boolean;
function TvImage2.Hold(Sender:TObject):Boolean;
begin
Result:=inherited Acquire(Sender);
Result:=inherited;
if Result and (Sender<>nil) then
begin
if FDeps.Insert(Sender) then
@ -813,7 +825,7 @@ begin
end;
end;
procedure TvImage2.Release(Sender:TObject);
function TvImage2.Drop(Sender:TObject):Boolean;
begin
if (Sender<>nil) then
begin
@ -823,7 +835,7 @@ begin
FLastCmd:=nil;
end;
end;
inherited Release(Sender);
Result:=inherited;
end;
//
@ -1002,7 +1014,7 @@ begin
FImage2Set.delete(@t.StencilOnly.key);
end;
t._Release(nil); //map ref
t.Release(nil); //map ref
end;
procedure _DeleteAlias(const F:TvImageKey);
@ -1019,7 +1031,7 @@ function _InsertImage(t:TvCustomImage2):Boolean;
begin
if FImage2Set.Insert(@t.key) then
begin
t._Acquire(nil); //map ref
t.Acquire(nil); //map ref
end else
begin
Exit(False);

23
vulkan/vImageTiling.pas
View File

@ -208,13 +208,14 @@ end;
type
TvTempBuffer=class(TvBuffer)
procedure ReleaseTmp(Sender:TObject); virtual; register;
Function ReleaseTmp(Sender:TObject):Boolean; virtual; register;
end;
procedure TvTempBuffer.ReleaseTmp(Sender:TObject); register;
Function TvTempBuffer.ReleaseTmp(Sender:TObject):Boolean; register;
begin
//force free
Free;
Result:=True;
end;
procedure load_clear(cmd:TvCustomCmdBuffer;image:TvCustomImage2);
@ -559,6 +560,7 @@ begin
//x,y,z
{
if ctype=BufferToImage then
SaveToTGA('shader_dump\texture_a'+IntToStr(a)+
'_mip'+IntToStr(m_level)+
'_'+IntToStr(m_width)+
@ -648,10 +650,10 @@ type
TvTempBufferWriteback=class(TvTempBuffer)
image:TvCustomImage2;
m_full_linear_size:Ptruint;
procedure ReleaseTmp(Sender:TObject); override; register;
function ReleaseTmp(Sender:TObject):Boolean; override; register;
end;
procedure TvTempBufferWriteback.ReleaseTmp(Sender:TObject); register;
function TvTempBufferWriteback.ReleaseTmp(Sender:TObject):Boolean; register;
var
m_base:Pointer;
begin
@ -671,7 +673,7 @@ begin
vkUnmapMemory(Device.FHandle,FBind.FMemory.FHandle);
image.Release(Self);
inherited;
Result:=inherited;
end;
Procedure write_1dThin(cmd:TvCustomCmdBuffer;image:TvCustomImage2);
@ -762,6 +764,17 @@ begin
m_width :=image.key.params.width;
m_height:=image.key.params.height;
{
SaveToTGA('shader_dump\texture_mip'+IntToStr(m_level)+
'_'+IntToStr(m_width)+
'x'+IntToStr(m_height)+
'.tga',
Pointer(image.key.addr),
m_width,
m_height,
32);
}
while (m_level>0) do
begin
BufferImageCopy.imageSubresource.mipLevel:=image.key.params.mipLevels-m_level;

192
vulkan/vMemory.pas
View File

@ -10,7 +10,9 @@ uses
vmparam,
Vulkan,
vDevice,
vDependence;
vDependence,
atomic,
kern_hazard_pointer;
type
TvMemInfo=bitpacked record
@ -46,7 +48,7 @@ type
end;
TvDeviceMemory=class(TvDependenciesObject)
entry:TAILQ_ENTRY;
entry :TAILQ_ENTRY;
//
FHandle :TVkDeviceMemory;
FSize :TVkDeviceSize;
@ -56,6 +58,8 @@ type
Constructor Create(Handle:TVkDeviceMemory;Size:TVkDeviceSize;mem_type:Byte;mem_info:PVkMemoryType);
Destructor Destroy; override;
Procedure Flush;
function Acquire(Sender:TObject):Boolean; override;
function Release(Sender:TObject):Boolean; override;
end;
TvHostMemory=class(TvDeviceMemory)
@ -66,8 +70,10 @@ type
TvPointer=packed object
FMemory:TvDeviceMemory;
FOffset:TVkDeviceSize;
function Acquire:Boolean;
function Release:Boolean;
function Acquire:TvPointer;
function Release:Boolean;
function Hold:Boolean;
function Drop:Boolean;
end;
Const
@ -170,6 +176,9 @@ function vkAllocDedicatedBuffer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkU
function GetHostMappedRequirements:TVkMemoryRequirements;
function GetSparceMemoryTypes:TVkUInt32;
function GetMemoryBudget(var budget:TVkPhysicalDeviceMemoryBudgetPropertiesEXT):Boolean;
procedure PrintMemoryBudget;
implementation
uses
@ -849,6 +858,8 @@ begin
//
gpu_map_remove_all(@FMap);
//
TGuard.WaitFor(Self);
//
if (FHandle<>VK_NULL_HANDLE) then
begin
vkFreeMemory(Device.FHandle,FHandle,nil);
@ -876,32 +887,133 @@ end;
//
function TvPointer.Acquire:Boolean;
function TvDeviceMemory.Acquire(Sender:TObject):Boolean;
const
mark_delete:QWORD=QWORD(1) shl (SizeOf(QWORD)*8-1);
var
i:ptruint;
begin
Result:=False;
if (FMemory=nil) then Exit;
repeat
i:=load_acq_rel(FRefs);
if (i and mark_delete)<>0 then Exit;
until CAS(FRefs,i,i+1);
Result:=True;
end;
//
rw_rlock(global_mem_lock);
//
if (FMemory<>nil) then
function TvDeviceMemory.Release(Sender:TObject):Boolean;
const
mark_delete:QWORD=QWORD(1) shl (SizeOf(QWORD)*8-1);
var
i:ptruint;
begin
Result:=False;
repeat
i:=load_acq_rel(FRefs);
if (i and mark_delete)<>0 then Exit;
if (i=1) then
begin
if CAS(FRefs,i,mark_delete) then Break;
end else
begin
if CAS(FRefs,i,i-1) then Break;
end;
until false;
if (i=1) then
begin
Result:=FMemory.Acquire(nil);
Free;
end;
Result:=True;
end;
//
function TvPointer.Acquire:TvPointer;
var
F:TvDeviceMemory;
Guard:TGuard;
begin
Result:=Default(TvPointer);
Guard:=TGuard.New;
F:=TvDeviceMemory(Guard.Protect(Pointer(FMemory)));
if (F=nil) then
begin
Guard.Free;
Exit;
end;
//
rw_runlock(global_mem_lock);
if F.Acquire(nil) then
begin
Result.FMemory:=F;
Result.FOffset:=FOffset;
end;
Guard.Free;
end;
function TvPointer.Release:Boolean;
var
F:TvDeviceMemory;
Guard:TGuard;
begin
Result:=False;
if (FMemory=nil) then Exit;
FMemory.Release(nil);
Guard:=TGuard.New;
F:=TvDeviceMemory(Guard.Protect(Pointer(FMemory)));
Result:=True;
if (F=nil) then
begin
Guard.Free;
Exit;
end;
Result:=F.Release(nil);
Guard.Free;
end;
function TvPointer.Hold:Boolean;
var
F:TvDeviceMemory;
Guard:TGuard;
begin
Result:=False;
Guard:=TGuard.New;
F:=TvDeviceMemory(Guard.Protect(Pointer(FMemory)));
if (F=nil) then
begin
Guard.Free;
Exit;
end;
Result:=F.Hold(nil);
Guard.Free;
end;
function TvPointer.Drop:Boolean;
var
F:TvDeviceMemory;
Guard:TGuard;
begin
Result:=False;
Guard:=TGuard.New;
F:=TvDeviceMemory(Guard.Protect(Pointer(FMemory)));
if (F=nil) then
begin
Guard.Free;
Exit;
end;
Result:=F.Hold(nil);
Guard.Free;
end;
//
@ -1047,6 +1159,7 @@ begin
LoadMemoryHeaps;
PrintMemoryHeaps;
PrintMemoryBudget;
TAILQ_INIT(@FDevs );
TAILQ_INIT(@FHosts);
@ -1562,7 +1675,7 @@ begin
prev:=TvDeviceMemory(TAILQ_PREV(node,@node.entry));
if (node.FMemInfo.heap_index=heap_index) then
if (node.FRefs<=1) then
if (node.FHold=0) then //lock Hold?
begin
Result:=Result+node.FSize;
//
@ -1589,7 +1702,7 @@ begin
prev:=TvHostMemory(TAILQ_PREV(node,@node.entry));
if (node.FMemInfo.heap_index=heap_index) then
if (node.FRefs<=1) then
if (node.FHold=0) then //lock Hold?
begin
Result:=Result+node.FSize;
//
@ -1686,7 +1799,7 @@ begin
begin
goto _full;
end else
if (node.FRefs<=1) then
if (node.FHold=0) then //lock Hold?
begin
//partial
TAILQ_REMOVE(@FHosts,node,@node.entry);
@ -1785,6 +1898,7 @@ begin
_print_host;
_print_devs;
_print_dmem_fd;
PrintMemoryBudget;
end;
//
@ -1932,7 +2046,7 @@ begin
begin
last_alloc_error:=r;
Writeln(StdErr,'vkAllocateMemory:',r,' Size=0x',HexStr(Size,16),' mtindex=',mtindex);
print_backtrace(StdErr,Get_pc_addr,get_frame,0);
//print_backtrace(StdErr,Get_pc_addr,get_frame,0);
end;
end;
@ -2008,5 +2122,41 @@ begin
end;
end;
function GetMemoryBudget(var budget:TVkPhysicalDeviceMemoryBudgetPropertiesEXT):Boolean;
var
prop:TVkPhysicalDeviceMemoryProperties2;
begin
if (vkGetPhysicalDeviceMemoryProperties2=nil) then Exit(False);
//
prop.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_MEMORY_PROPERTIES_2;
prop.pNext:=@budget;
//
budget.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_MEMORY_BUDGET_PROPERTIES_EXT;
budget.pNext:=nil;
//
vkGetPhysicalDeviceMemoryProperties2(VulkanApp.FPhysicalDevice,@prop);
//
Result:=True;
end;
procedure PrintMemoryBudget;
var
budget:TVkPhysicalDeviceMemoryBudgetPropertiesEXT;
i:Integer;
begin
budget:=Default(TVkPhysicalDeviceMemoryBudgetPropertiesEXT);
if GetMemoryBudget(budget) then
begin
Writeln('[MemoryBudget]');
For i:=0 to VK_MAX_MEMORY_HEAPS-1 do
if (budget.heapBudget[i]<>0) then
begin
Writeln(' [',i,']:0x',HexStr(budget.heapUsage[i],16),'/',HexStr(budget.heapBudget[i],16),':',
(budget.heapUsage[i]/budget.heapBudget[i]*100):0:2,'%'
);
end;
end;
end;
end.

5
vulkan/vSampler.pas
View File

@ -6,10 +6,11 @@ interface
uses
Vulkan,
vDevice;
vDevice,
vDependence;
type
TvSampler=class
TvSampler=class(TvRefsObject)
FHandle:TVkSampler;
function Compile(pInfo:PVkSamplerCreateInfo):Boolean;
Destructor Destroy; override;

27
vulkan/vSamplerManager.pas
View File

@ -28,10 +28,6 @@ type
TvSampler2=class(TvSampler)
key:TSSharpResource4;
//
FRefs:ptruint;
Procedure Acquire;
procedure Release(Sender:TObject);
end;
_TvSampler2Set=specialize T23treeSet<PSSharpResource4,TvSampler2Compare>;
@ -54,19 +50,6 @@ begin
rw_wunlock(lock);
end;
Procedure TvSampler2.Acquire;
begin
System.InterlockedIncrement(Pointer(FRefs));
end;
procedure TvSampler2.Release(Sender:TObject);
begin
if System.InterlockedDecrement(Pointer(FRefs))=nil then
begin
Free;
end;
end;
function TvSampler2Compare.c(a,b:PSSharpResource4):Integer;
begin
Result:=CompareByte(a^,b^,SizeOf(TSSharpResource4));
@ -105,7 +88,7 @@ begin
FreeAndNil(t);
end else
begin
t.Acquire;
t.Acquire(nil);
FSampler2Set.Insert(@t.key);
end;
end;
@ -122,13 +105,7 @@ begin
Result:=_FetchSampler(PS);
if (cmd<>nil) and (Result<>nil) then
begin
if cmd.AddDependence(@TvSampler2(Result).Release) then
begin
TvSampler2(Result).Acquire;
end;
end;
cmd.RefTo(Result);
FSampler2Set.Unlock_wr;
end;

24
vulkan/vSetsPoolManager.pas
View File

@ -26,8 +26,8 @@ type
TvDescriptorGroupNode=class(TvDescriptorGroup)
parent:TvSetsPoolUnbound;
pNext:Pointer;
procedure Release(Sender:TObject); override;
pNext :Pointer;
function Drop(Sender:TObject):Boolean; override;
end;
TvSetsPool2Compare=object
@ -44,9 +44,9 @@ type
TvSetsPoolUnbound=class
FLayout:TvPipelineLayout;
FQueue:TIntrusiveMPSCQueue;
FPools:TvSetsPool2Set;
FLast:TvSetsPool2;
FQueue :TIntrusiveMPSCQueue;
FPools :TvSetsPool2Set;
FLast :TvSetsPool2;
Constructor Create(Layout:TvPipelineLayout);
Procedure NewPool;
function Alloc:TvDescriptorGroupNode;
@ -119,6 +119,8 @@ begin
//
Result.FLayout:=FLayout;
Result.FSets :=FLast.Alloc;
//
Result.Acquire(nil);
end;
procedure TvSetsPoolUnbound.PushNode(N:TvDescriptorGroupNode);
@ -138,12 +140,16 @@ begin
end;
end;
Procedure TvDescriptorGroupNode.Release(Sender:TObject);
function TvDescriptorGroupNode.Drop(Sender:TObject):Boolean;
begin
if System.InterlockedDecrement(Pointer(FRefs))=nil then
if (parent<>nil) then
Result:=True;
if System.InterlockedDecrement(FHold)=0 then
begin
parent.PushNode(Self);
if (parent<>nil) then
begin
parent.PushNode(Self);
end;
Result:=Release(Sender);
end;
end;