unit srBuffer; {$mode ObjFPC}{$H+} interface uses spirv, srNodes, srTypes, srVariable, srLayout, srDecorate; type PsrBuffer=^TsrBuffer; PsrField=^TsrField; TsrFieldValue=(frNotFit,frIdent,frVectorAsValue,frValueInVector,frValueInArray); TFieldFetchValue=record fValue:TsrFieldValue; pField:PsrField; end; TFieldEnumCb=procedure(pField:PsrField) of object; TsrField=object type TFieldFetch=specialize TNodeFetch; var pLeft,pRight:PsrField; //---- pBuffer:PsrBuffer; parent:PsrField; offset:PtrUint; size:PtrUint; stride:PtrUint; FCount:PtrUint; dtype:TsrDataType; pType:PsrType; FID:Integer; //alloc late // Alloc:TfnAlloc; FList:TFieldFetch; function c(n1,n2:PsrField):Integer; static; function Cross(o,s:PtrUint):Boolean; function Find_be(o:PtrUint):PsrField; function Find_le(o:PtrUint):PsrField; function First:PsrField; function Last:PsrField; function Next(p:PsrField):PsrField; function Prev(p:PsrField):PsrField; function Fetch(o:PtrUint):PsrField; function FetchValue(_offset,_size:PtrUint;_dtype:TsrDataType):TFieldFetchValue; function FetchRuntimeArray(_offset,_stride:PtrUint):TFieldFetchValue; function IsStructUsedRuntimeArray:Boolean; function IsStructNotUsed:Boolean; function GetStructDecorate:DWORD; procedure FillNode(o,s:PtrUint); function FillSpace:Integer; procedure AllocID; procedure AllocBinding(aType:PsrType;Decorates:PsrDecorateList); end; TsrBufferType=(btStorageBuffer,btUniformBuffer,btPushConstant); TsrBuffer=object(TsrDescriptor) pLeft,pRight:PsrBuffer; //---- key:packed record pLayout:PsrDataLayout; CastNum:PtrInt; end; bType:TsrBufferType; write_count:DWORD; align_offset:DWORD; FTop:TsrField; function c(n1,n2:PsrBuffer):Integer; static; function GetTypeChar:Char; function GetString:RawByteString; function GetStructName:RawByteString; procedure UpdateSize; function GetSize:PtrUint; procedure EnumAllField(cb:TFieldEnumCb); procedure ShiftOffset(Offset:PtrUint); end; TsrBufferCfg=object SpvVersion:PtrUint; maxUniformBufferRange:PtrUint; // $FFFF PushConstantsOffset:PtrUint; // 0 maxPushConstantsSize:PtrUint; // 128 minStorageBufferOffsetAlignment:PtrUint; // $10 minUniformBufferOffsetAlignment:PtrUint; // $100 Procedure Init; Function CanUseStorageBufferClass:Boolean; end; TsrBufferList=object type TNodeFetch=specialize TNodeFetch; var Alloc:TfnAlloc; cfg:TsrBufferCfg; FNTree:TNodeFetch; FPushConstant:PsrBuffer; procedure Init(cb:TfnAlloc); function Fetch(s:PsrDataLayout;n:PtrInt):PsrBuffer; function NextCast(buf:PsrBuffer):PsrBuffer; Function First:PsrBuffer; Function Next(node:PsrBuffer):PsrBuffer; procedure EnumAllField(cb:TFieldEnumCb); procedure OnFillSpace(node:PsrField); procedure FillSpace; procedure OnAllocID(node:PsrField); procedure AllocID; procedure AllocBinding(Var FBinding:Integer;Decorates:PsrDecorateList); procedure AllocSourceExtension(FDebugInfo:PsrDebugInfoList); procedure UpdateStorage(node:PsrChain;pBuffer:PsrBuffer); procedure ApplyBufferType; procedure AlignOffset(node:PsrBuffer;offset:PtrUint); procedure AlignOffset; end; implementation //--- function TsrField.c(n1,n2:PsrField):Integer; begin Result:=Integer(n1^.offset>n2^.offset)-Integer(n1^.offset=offset) and (o=o) and (offsetnil) then begin if not node^.Cross(_offset,_size) then begin node:=Next(node); if (node<>nil) then begin if not node^.Cross(_offset,_size) then begin node:=nil; end; end; end; end; if (node=nil) then begin //new node:=Fetch(_offset); node^.size :=_size; node^.stride:=_stride; node^.dtype :=_dtype; Result.fValue:=frIdent; Result.pField:=node; end else Case node^.dtype of dtTypeArray: begin if (node^.offset>_offset) then Exit; //ident or big than if (node^.offset+node^.size<_offset+_size) then Exit; if (node^.stride<_size) then Exit; //ident or min stride Result.fValue:=frValueInArray; Result.pField:=node; end; dtTypeRuntimeArray: begin if (node^.offset>_offset) then Exit; //ident or big than if (node^.stride<_size) then Exit; //ident or min stride Result.fValue:=frValueInArray; Result.pField:=node; end; else begin if isVector(node^.dtype) then begin //ftVector if isVector(_dtype) then begin if (node^.offset=_offset) and (node^.size =_size) and (node^.stride=_stride) then begin Result.fValue:=frIdent; //ident Result.pField:=node; end; end else begin if (node^.offset>_offset) then Exit; //ident or big than _offset:=_offset-node^.offset; if (node^.stride=_size) and (_offset mod node^.stride=0) then begin Result.fValue:=frValueInVector; //down to vector Result.pField:=node; end; end; end else begin //ftValue if isVector(_dtype) then begin if (node^.offset=_offset) and (node^.size =_size) then begin Result.fValue:=frVectorAsValue; //vector as value? Result.pField:=node; end; end else begin if (node^.offset=_offset) and (node^.size =_size) then begin Result.fValue:=frIdent; //ident Result.pField:=node; end; end; end; end; end; end; function TsrField.FetchRuntimeArray(_offset,_stride:PtrUint):TFieldFetchValue; var node:PsrField; begin Result:=Default(TFieldFetchValue); node:=Find_le(_offset); if (node=nil) then begin //new node:=Fetch(_offset); node^.size :=High(PtrUint)-_offset; node^.stride :=_stride; node^.dtype :=dtTypeRuntimeArray; Result.fValue:=frValueInArray; Result.pField:=node; end else if (node^.stride=_stride) and (node^.dtype =dtTypeRuntimeArray) and (node^.offset<=_offset) then //ident or big than begin Result.fValue:=frValueInArray; Result.pField:=node; end; end; function TsrField.IsStructUsedRuntimeArray:Boolean; var node:PsrField; begin Result:=False; if (dtype=dtTypeStruct) then begin node:=FList.Max; if (node<>nil) then begin size:=node^.offset+node^.size; end; Result:=(size=High(PtrUint)); end; end; function TsrField.IsStructNotUsed:Boolean; begin Result:=(FCount<=1) and (parent<>nil); end; function TsrField.GetStructDecorate:DWORD; begin Result:=DWORD(-1); //dont use if (parent=nil) then //is top if (dtype=dtTypeStruct) then //is struct begin if (pBuffer^.FStorage<>StorageClass.StorageBuffer) and (pBuffer^.bType=btStorageBuffer) then begin Result:=Decoration.BufferBlock; end else begin Result:=Decoration.Block; end; end; end; procedure TsrField.FillNode(o,s:PtrUint); procedure _Pad(p,v:PtrUint;_dtype:TsrDataType); //inline; var node:PsrField; begin if (o mod p<>0) and (s>=v) then begin node:=Fetch(o); Assert(node^.dtype=dtUnknow,'WTF'); node^.size:=v; node^.dtype:=_dtype; o:=o+v; s:=s-v; end; end; procedure _Fill(v:PtrUint;_dtype:TsrDataType); //inline; var count:PtrUint; node:PsrField; begin count:=s div v; While (count<>0) do begin node:=Fetch(o); Assert(node^.dtype=dtUnknow,'WTF'); node^.size:=v; node^.dtype:=_dtype; o:=o+v; s:=s-v; Dec(count); end; end; begin if (s=0) then Exit; _Pad ( 2,1,dtUint8); _Pad ( 4,2,dtHalf16); _Pad ( 8,4,dtFloat32); _Pad (16,8,dtVec2f); _Fill(16,dtVec4f); _Fill(8 ,dtVec2f); _Fill(4 ,dtFloat32); _Fill(2 ,dtHalf16); _Fill(1 ,dtUint8); end; function TsrField.FillSpace:Integer; var pNode:PsrField; Foffset,Fsize:PtrUint; begin Result:=0; pNode:=First; if (pNode=nil) then Exit; Foffset:=0; While (pNode<>nil) do begin if (pNode^.dtype=dtUnknow) then begin Case pNode^.size of 1:pNode^.dtype:=dtUint8; 2:pNode^.dtype:=dtHalf16; 4:pNode^.dtype:=dtFloat32; 8:pNode^.dtype:=dtVec2f; 16:pNode^.dtype:=dtVec4f; else Assert(false); end; end; if (Foffset0) and (dtype in [dtTypeArray,dtTypeRuntimeArray]) then begin pNode:=FList.Max; if (pNode<>nil) then begin Foffset:=pNode^.offset+pNode^.size; Assert(Foffset<=stride); if (Foffsetnil) do begin if IsVector(dtype) then begin ID:=node^.offset div stride; node^.FID:=ID; end else begin node^.FID:=ID; Inc(ID); end; node:=Next(node); end; end; procedure TsrField.AllocBinding(aType:PsrType;Decorates:PsrDecorateList); var node:PsrField; begin if (aType=nil) then Exit; if (Decorates=nil) then Exit; if isVector(dtype) then Exit; node:=First; While (node<>nil) do begin Decorates^.emit_member_decorate(ntType,aType,node^.FID,node^.offset); node:=Next(node); end; end; //-- function TsrBuffer.c(n1,n2:PsrBuffer):Integer; begin //first pLayout Result:=Integer(n1^.key.pLayout>n2^.key.pLayout)-Integer(n1^.key.pLayout0) then Exit; //second CastNum Result:=Integer(n1^.key.CastNum>n2^.key.CastNum)-Integer(n1^.key.CastNumnil) then begin PID:=key.pLayout^.FID; end; Result:='B'+GetTypeChar+ ';PID='+HexStr(PID,8)+ ';BND='+HexStr(FBinding,8)+ ';LEN='+HexStr(GetSize,8)+ ';OFS='+HexStr(align_offset,8); end; function TsrBuffer.GetStructName:RawByteString; begin Result:='TD'+HexStr(FBinding,8); end; procedure TsrBuffer.UpdateSize; var node:PsrField; begin node:=FTop.FList.Max; if (node<>nil) then begin FTop.size:=node^.offset+node^.size; end; end; function TsrBuffer.GetSize:PtrUint; begin UpdateSize; Result:=FTop.size; end; procedure TsrBuffer.EnumAllField(cb:TFieldEnumCb); var curr,node:PsrField; begin if (cb=nil) then Exit; curr:=@FTop; node:=curr^.First; repeat While (node<>nil) do begin if (node^.FList.pRoot<>nil) then //child exist begin curr^.FList._Splay(node); //Move to root curr:=node; node:=curr^.First; //down end else begin cb(node); node:=curr^.Next(node); end; end; cb(curr); curr:=curr^.parent; //up if (curr=nil) then Break; node:=curr^.FList.pRoot; //last find node:=curr^.Next(node); until false; end; procedure TsrBuffer.ShiftOffset(Offset:PtrUint); var node:PsrField; begin if (Offset=0) then Exit; node:=FTop.Last; While (node<>nil) do begin if (node^.offset+node^.size=High(PtrUint)) then begin node^.size:=node^.size-Offset; end; node^.offset:=node^.offset+Offset; node:=FTop.Prev(node); end; end; Procedure TsrBufferCfg.Init; begin SpvVersion:=$10100; maxUniformBufferRange:=$FFFF; maxPushConstantsSize:=128; minStorageBufferOffsetAlignment:=0; minUniformBufferOffsetAlignment:=0; end; Function TsrBufferCfg.CanUseStorageBufferClass:Boolean; begin Result:=(SpvVersion>=$10300); end; procedure TsrBufferList.Init(cb:TfnAlloc); begin Alloc:=cb; cfg.Init; end; function TsrBufferList.Fetch(s:PsrDataLayout;n:PtrInt):PsrBuffer; var node:TsrBuffer; begin node:=Default(TsrBuffer); node.key.pLayout:=s; node.key.CastNum:=n; Result:=FNTree.Find(@node); if (Result=nil) then begin Result:=Alloc(SizeOf(TsrBuffer)); Result^.key.pLayout:=s; Result^.key.CastNum:=n; Result^.bType :=btStorageBuffer; Result^.FStorage:=StorageClass.Uniform; Result^.FBinding:=-1; Result^.FTop.Alloc:=Alloc; Result^.FTop.pBuffer:=Result; Result^.FTop.FID:=-1; Result^.FTop.dtype:=dtTypeStruct; FNTree.Insert(Result); end; end; function TsrBufferList.NextCast(buf:PsrBuffer):PsrBuffer; begin Result:=nil; if (buf=nil) then Exit; Result:=Fetch(buf^.key.pLayout,buf^.key.CastNum+1); end; Function TsrBufferList.First:PsrBuffer; begin Result:=FNTree.Min; end; Function TsrBufferList.Next(node:PsrBuffer):PsrBuffer; begin Result:=FNTree.Next(node); end; procedure TsrBufferList.EnumAllField(cb:TFieldEnumCb); var node:PsrBuffer; begin if (cb=nil) then Exit; node:=First; While (node<>nil) do begin node^.EnumAllField(cb); node:=Next(node); end; end; procedure TsrBufferList.OnFillSpace(node:PsrField); begin node^.FillSpace; end; procedure TsrBufferList.FillSpace; begin EnumAllField(@OnFillSpace); end; procedure TsrBufferList.OnAllocID(node:PsrField); begin node^.AllocID; end; procedure TsrBufferList.AllocID; begin EnumAllField(@OnAllocID); end; procedure TsrBufferList.AllocBinding(Var FBinding:Integer;Decorates:PsrDecorateList); var node:PsrBuffer; pVar:PsrVariable; begin if (Decorates=nil) then Exit; node:=First; While (node<>nil) do begin pVar:=node^.pVar; if (pVar<>nil) then begin if (node^.bType<>btPushConstant) then if (node^.FBinding=-1) then //alloc begin Decorates^.emit_decorate(ntVar,pVar,Decoration.Binding,FBinding); Decorates^.emit_decorate(ntVar,pVar,Decoration.DescriptorSet,Decorates^.FDescriptorSet); node^.FBinding:=FBinding; Inc(FBinding); end; end; node:=Next(node); end; end; procedure TsrBufferList.AllocSourceExtension(FDebugInfo:PsrDebugInfoList); var node:PsrBuffer; pVar:PsrVariable; begin if (FDebugInfo=nil) then Exit; node:=First; While (node<>nil) do begin pVar:=node^.pVar; if (pVar<>nil) then begin FDebugInfo^.emit_source_extension(node^.GetString); end; node:=Next(node); end; end; procedure TsrBufferList.UpdateStorage(node:PsrChain;pBuffer:PsrBuffer); begin if (node=nil) or (pBuffer=nil) then Exit; pBuffer^.write_count:=pBuffer^.write_count+node^.write_count; end; procedure TsrBufferList.ApplyBufferType; var node:PsrBuffer; begin node:=First; While (node<>nil) do begin if (node^.bType=btStorageBuffer) then begin if (FPushConstant=nil) and (node^.write_count=0) and (node^.GetSize<=cfg.maxPushConstantsSize) then begin node^.bType :=btPushConstant; node^.FStorage:=StorageClass.PushConstant; FPushConstant:=node; end else if (node^.write_count=0) and (node^.GetSize<=cfg.maxUniformBufferRange) then begin node^.bType :=btUniformBuffer; node^.FStorage:=StorageClass.Uniform; end else if cfg.CanUseStorageBufferClass then begin node^.FStorage:=StorageClass.StorageBuffer; end else begin node^.FStorage:=StorageClass.Uniform; end; end; node:=Next(node); end; end; function AlignShift(addr:Pointer;alignment:PtrUInt):PtrUInt; inline; begin if (alignment>1) then begin Result:=(PtrUInt(addr) mod alignment); end else begin Result:=0; end; end; procedure TsrBufferList.AlignOffset(node:PsrBuffer;offset:PtrUint); var P:Pointer; begin P:=node^.key.pLayout^.GetData; offset:=AlignShift(P,offset); node^.align_offset:=offset; node^.ShiftOffset(offset); end; procedure TsrBufferList.AlignOffset; var node:PsrBuffer; begin node:=First; While (node<>nil) do begin Case node^.bType of btStorageBuffer: begin AlignOffset(node,cfg.minStorageBufferOffsetAlignment); end; btUniformBuffer: begin AlignOffset(node,cfg.minUniformBufferOffsetAlignment); end; btPushConstant: begin node^.align_offset:=cfg.PushConstantsOffset; node^.ShiftOffset(cfg.PushConstantsOffset); end; end; node:=Next(node); end; end; end.