fpPS4/vulkan/vShader.pas
Kagamma 2e04d5d3fa
Fix cross-compilation on Linux host (#67)
* Unit names should match with file names to avoid case sensitive issue on Unix system

* Explicit state the build is for win64 target
2023-01-21 16:58:38 +03:00

495 lines
11 KiB
ObjectPascal

unit vShader;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
shaders,
Vulkan,
vDevice;
type
TvSupportDescriptorType=array[0..1] of TVkDescriptorType;
{PvShaderBind=^TvShaderBind;
TvShaderBind=packed object
FDVID:DWORD;
FDSET:DWORD;
FBIND:DWORD;
FSCLS:DWORD;
FTYPE:DWORD;
end;}
TvShader=class
FHandle:TVkShaderModule;
FStage:TVkShaderStageFlagBits;
FEntry:RawByteString;
//FBinds:array of TvShaderBind;
Destructor Destroy; override;
procedure ClearInfo; virtual;
procedure LoadFromMemory(data:Pointer;size:Ptruint);
procedure LoadFromStream(Stream:TStream);
procedure LoadFromFile(const FileName:RawByteString);
procedure LoadFromResource(const FileName:RawByteString);
procedure Parse(data:Pointer;size:Ptruint);
procedure OnEntryPoint(Stage:DWORD;P:PChar); virtual;
procedure OnSourceExtension(P:PChar); virtual;
procedure OnLocalSize(var x,y,z:DWORD); virtual;
procedure OnBinding(var Target,id:DWORD); virtual;
procedure OnDescriptorSet(var Target,id:DWORD); virtual;
end;
TvShaderCompute=class(TvShader)
FLocalSize:TVkOffset3D;
procedure OnLocalSize(var x,y,z:DWORD); override;
end;
implementation
Destructor TvShader.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyShaderModule(Device.FHandle,FHandle,nil);
end;
procedure TvShader.ClearInfo;
begin
ord(FStage):=0;
FEntry:='';
//SetLength(FBinds,0);
end;
procedure TvShader.LoadFromMemory(data:Pointer;size:Ptruint);
var
cinfo:TVkShaderModuleCreateInfo;
r:TVkResult;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyShaderModule(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
ClearInfo;
Parse(data,size);
cinfo:=Default(TVkShaderModuleCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO;
cinfo.codeSize:=size;
cinfo.pCode :=data;
r:=vkCreateShaderModule(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateShaderModule:',r);
Exit;
end;
end;
procedure TvShader.LoadFromStream(Stream:TStream);
var
M:TCustomMemoryStream;
begin
if Stream.InheritsFrom(TCustomMemoryStream) then
begin
M:=TCustomMemoryStream(Stream);
end else
begin
M:=TMemoryStream.Create;
TMemoryStream(M).LoadFromStream(Stream);
end;
LoadFromMemory(M.Memory,M.Size);
if (M<>Stream) then
begin
M.Free;
end;
end;
procedure TvShader.LoadFromFile(const FileName:RawByteString);
Var
F:THandle;
data:Pointer;
size:Int64;
begin
F:=FileOpen(FileName,fmOpenRead or fmShareDenyWrite);
if (F=feInvalidHandle) then Exit;
size:=FileSeek(F,0,fsFromEnd);
if (size<0) then
begin
FileClose(F);
Exit;
end;
FileSeek(F,0,fsFromBeginning);
data:=AllocMem(size);
size:=FileRead(F,data^,size);
if (size<0) then
begin
FreeMem(data);
FileClose(F);
Exit;
end;
LoadFromMemory(data,size);
FreeMem(data);
FileClose(F);
end;
procedure TvShader.LoadFromResource(const FileName:RawByteString);
var
Stream:TStream;
begin
Stream:=GetResourceStream(FileName,'SPV');
LoadFromStream(Stream);
end;
type
PSPIRVHeader=^TSPIRVHeader;
TSPIRVHeader=packed record
MAGIC:DWORD;
VERSION_MINOR:WORD;
VERSION_MAJOR:WORD;
TOOL_VERSION:WORD;
TOOL_ID:WORD;
BOUND:DWORD;
RESERVED:DWORD;
end;
PSPIRVInstruction=^TSPIRVInstruction;
TSPIRVInstruction=packed record
OP:WORD;
COUNT:WORD;
end;
Const
MagicNumber = 119734787;
//Operation
OpSourceExtension = 4;
OpEntryPoint = 15;
OpExecutionMode = 16;
OpTypeVoid = 19;
OpTypeBool = 20;
OpTypeInt = 21;
OpTypeFloat = 22;
OpTypeVector = 23;
OpTypeMatrix = 24;
OpTypeImage = 25;
OpTypeSampler = 26;
OpTypeSampledImage = 27;
OpTypeArray = 28;
OpTypeRuntimeArray = 29;
OpTypeStruct = 30;
OpTypeOpaque = 31;
OpTypePointer = 32;
OpTypeFunction = 33;
OpTypeEvent = 34;
OpTypeDeviceEvent = 35;
OpTypeReserveId = 36;
OpTypeQueue = 37;
OpTypePipe = 38;
OpTypeForwardPointer = 39;
OpDecorate = 71;
OpVariable = 59;
//ExecutionMode
LocalSize = 17;
//Decoration
Sample = 17;
Binding = 33;
DescriptorSet = 34;
//StorageClass
UniformConstant = 0;
Uniform = 2;
Image = 11;
StorageBuffer = 12;
//ExecutionModel
Vertex = 0;
TessellationControl = 1;
TessellationEvaluation = 2;
Geometry = 3;
Fragment = 4;
GLCompute = 5;
Kernel = 6;
TaskNV = 5267;
MeshNV = 5268;
RayGenerationKHR = 5313;
IntersectionKHR = 5314;
AnyHitKHR = 5315;
ClosestHitKHR = 5316;
MissKHR = 5317;
CallableKHR = 5318;
function GetStageFlag(FStage:DWORD):TVkShaderStageFlagBits;
begin
case FStage of
Vertex :Result:=VK_SHADER_STAGE_VERTEX_BIT;
TessellationControl :Result:=VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT;
TessellationEvaluation:Result:=VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT;
Geometry :Result:=VK_SHADER_STAGE_GEOMETRY_BIT;
Fragment :Result:=VK_SHADER_STAGE_FRAGMENT_BIT;
GLCompute :Result:=VK_SHADER_STAGE_COMPUTE_BIT;
Kernel :Result:=VK_SHADER_STAGE_COMPUTE_BIT;
TaskNV :Result:=VK_SHADER_STAGE_TASK_BIT_NV;
MeshNV :Result:=VK_SHADER_STAGE_MESH_BIT_NV;
RayGenerationKHR :Result:=VK_SHADER_STAGE_RAYGEN_BIT_KHR;
IntersectionKHR :Result:=VK_SHADER_STAGE_INTERSECTION_BIT_KHR;
AnyHitKHR :Result:=VK_SHADER_STAGE_ANY_HIT_BIT_KHR;
ClosestHitKHR :Result:=VK_SHADER_STAGE_CLOSEST_HIT_BIT_KHR;
MissKHR :Result:=VK_SHADER_STAGE_MISS_BIT_KHR;
CallableKHR :Result:=VK_SHADER_STAGE_CALLABLE_BIT_KHR;
else
ord(Result):=0;
end;
end;
procedure TvShader.Parse(data:Pointer;size:Ptruint);
var
//orig_data:Pointer;
//orig_size:Ptruint;
I:TSPIRVInstruction;
f:Ptruint;
//r:PvShaderBind;
d:dword;
{
function Fetch(ID:DWORD):PvShaderBind;
var
i:Integer;
begin
if Length(FBinds)<>0 then
For i:=0 to High(FBinds) do
if (ID=FBinds[i].FDVID) then
begin
Exit(@FBinds[i]);
end;
i:=Length(FBinds);
SetLength(FBinds,i+1);
FBinds[i]:=Default(TvShaderBind);
FBinds[i].FDVID:=ID;
Result:=@FBinds[i];
end;
function find_pointer_type(data:Pointer;size:Ptruint;var id:DWORD):boolean;
var
I:TSPIRVInstruction;
f:Ptruint;
begin
Result:=false;
repeat
I:=PSPIRVInstruction(data)^;
if (I.OP=OpTypePointer) and (I.COUNT=4) then
if (PDWORD(data)[1]=id) then
begin
id:=PDWORD(data)[3];
Exit(true);
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
function find_type(data:Pointer;size:Ptruint;var id:DWORD):boolean;
var
I:TSPIRVInstruction;
f:Ptruint;
begin
Result:=false;
repeat
I:=PSPIRVInstruction(data)^;
Case I.OP of
OpTypeVoid ,
OpTypeBool ,
OpTypeInt ,
OpTypeFloat ,
OpTypeVector ,
OpTypeMatrix ,
OpTypeImage ,
OpTypeSampler ,
OpTypeSampledImage ,
OpTypeArray ,
OpTypeRuntimeArray ,
OpTypeStruct ,
OpTypeOpaque ,
OpTypePointer ,
OpTypeFunction ,
OpTypeEvent ,
OpTypeDeviceEvent ,
OpTypeReserveId ,
OpTypeQueue ,
OpTypePipe ,
OpTypeForwardPointer:
if (PDWORD(data)[1]=id) then
begin
id:=PDWORD(data)[3];
Exit(true);
end;
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
}
begin
if (size<=SizeOf(TSPIRVHeader)) then Exit;
if (PSPIRVHeader(data)^.MAGIC<>MagicNumber) then Exit;
data:=data+SizeOf(TSPIRVHeader);
size:=size-SizeOf(TSPIRVHeader);
//orig_data:=data;
//orig_size:=size;
repeat
I:=PSPIRVInstruction(data)^;
Case I.OP of
OpSourceExtension:
if (I.COUNT>=2) then
begin
OnSourceExtension(PChar(@PDWORD(data)[1]));
end;
OpEntryPoint:
if (I.COUNT>=4) then
begin
OnEntryPoint(PDWORD(data)[1],PChar(@PDWORD(data)[3]));
FStage:=GetStageFlag(PDWORD(data)[1]);
FEntry:=PChar(@PDWORD(data)[3]);
end;
OpExecutionMode:
if (I.COUNT>=3) then
begin
d:=PDWORD(data)[2];
case d of
LocalSize:
if (I.COUNT>=6) then
begin
OnLocalSize(PDWORD(data)[3],PDWORD(data)[4],PDWORD(data)[5]);
end;
end;
end;
OpDecorate:
if (I.COUNT>=4) then
begin
d:=PDWORD(data)[2];
case d of
{Sample:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FSCLS:=Sample shl 16;
end;}
Binding:
begin
OnBinding(PDWORD(data)[1],PDWORD(data)[3]);
//r:=Fetch(PDWORD(data)[1]);
//r^.FBIND:=PDWORD(data)[3];
end;
DescriptorSet:
begin
OnDescriptorSet(PDWORD(data)[1],PDWORD(data)[3]);
//r:=Fetch(PDWORD(data)[1]);
//r^.FDSET:=PDWORD(data)[3];
end;
end;
end;
{OpVariable:
if (I.COUNT>=4) then
begin
d:=PDWORD(data)[3];
case d of
UniformConstant,
Uniform,
Image,
StorageBuffer:
begin
r:=Fetch(PDWORD(data)[2]);
r^.FSCLS:=d;
d:=PDWORD(data)[1];
if find_pointer_type(orig_data,orig_size,d) then
if find_type(orig_data,orig_size,d) then
begin
r^.FTYPE:=d;
end;
end;
end;
end;}
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
procedure TvShader.OnEntryPoint(Stage:DWORD;P:PChar);
begin
FStage:=GetStageFlag(Stage);
FEntry:=P;
end;
procedure TvShader.OnSourceExtension(P:PChar);
begin
//
end;
procedure TvShader.OnLocalSize(var x,y,z:DWORD);
begin
//
end;
procedure TvShader.OnBinding(var Target,id:DWORD);
begin
//
end;
procedure TvShader.OnDescriptorSet(var Target,id:DWORD);
begin
//
end;
//
procedure TvShaderCompute.OnLocalSize(var x,y,z:DWORD);
begin
if (FLocalSize.x>0) then x:=FLocalSize.x else FLocalSize.x:=x;
if (FLocalSize.y>0) then y:=FLocalSize.y else FLocalSize.y:=y;
if (FLocalSize.z>0) then z:=FLocalSize.z else FLocalSize.z:=z;
end;
// =0,
// VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER=1,
// VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE=2,
// VK_DESCRIPTOR_TYPE_STORAGE_IMAGE=3,
// VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER=4,
// VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER=5,
// VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER=6,
// VK_DESCRIPTOR_TYPE_STORAGE_BUFFER=7,
// VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC=8,
// VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC=9,
// VK_DESCRIPTOR_TYPE_INPUT_ATTACHMENT=10,
// VK_DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK_EXT=1000138000,
// VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR=1000150000,
// VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV=1000165000,
// VK_DESCRIPTOR_TYPE_MUTABLE_VALVE=1000351000
{
function TvShaderBind.GetSupportTypes:TvSupportDescriptorType;
begin
Result:=Default(TvSupportDescriptorType);
case FType of
Sample shl 16 :begin Result[0]:=VK_DESCRIPTOR_TYPE_SAMPLER; end;;
UniformConstant :begin Result[0]:=; end;;
Uniform :begin Result[0]:=; end;;
Workgroup :begin Result[0]:=; end;;
CrossWorkgroup :begin Result[0]:=; end;;
Image :begin Result[0]:=; end;;
StorageBuffer :begin Result[0]:=; end;;
end;
end;}
end.