fpPS4/spirv/srConst.pas
2022-09-05 16:30:24 +03:00

798 lines
16 KiB
ObjectPascal

unit srConst;
{$mode objfpc}{$H+}
interface
uses
sysutils,
spirv,
ginodes,
srNode,
srLiteral,
srRefId,
srType,
srTypes,
half16;
type
ntConst=class(TsrNodeVmt)
class Procedure zero_read (node:PsrNode); override;
class Procedure zero_unread (node:PsrNode); override;
class function Next (node:PsrNode):Pointer; override;
class function Prev (node:PsrNode):Pointer; override;
class Function GetPtype (node:PsrNode):PsrNode; override;
class function GetPrintName (node:PsrNode):RawByteString; override;
class function GetRef (node:PsrNode):Pointer; override;
end;
PPsrConst=^PsrConst;
PsrConst=^TsrConst;
TsrConst=packed object(TsrNode)
private
pPrev,pNext,pLeft,pRight:PsrConst;
//--
ID:TsrRefId; //post id
fOpId:WORD;
fCount:WORD;
FType:PsrType;
pData:PPsrNode;
function c(n1,n2:PsrConst):Integer; static;
public
property pType:PsrType read FType;
property OpId:WORD read fOpId;
property ItemCount:WORD read fCount;
Procedure Init; inline;
function dtype:TsrDataType;
function GetItem(i:Word):PsrNode;
function GetLiteral(i:Word):PsrLiteral;
function GetConst(i:Word):PsrConst;
Function AsBool:Boolean; inline;
function AsUint8:Byte; inline;
function AsInt8:Shortint; inline;
function AsUint16:Word; inline;
function AsInt16:Smallint; inline;
Function AsUint32:DWORD; inline;
function AsInt32:Integer; inline;
Function AsUint64:QWORD; inline;
Function AsInt64:Int64; inline;
function AsHalf16:THalf16; inline;
function AsFloat32:Single; inline;
function AsFloat64:Double; inline;
function GetData:QWORD;
Function isZeroVal:Boolean; inline;
Function isBoolVal:Boolean; inline;
function GetPrintName:RawByteString;
end;
PsrConstList=^TsrConstList;
TsrConstList=object
type
TNodeList=specialize TNodeList<PsrConst>;
TNodeFetch=specialize TNodeFetch<PsrConst,TsrConst>;
var
FEmit:TCustomEmit;
FList:TNodeList;
FNTree:TNodeFetch;
Procedure Init(Emit:TCustomEmit); inline;
function _Fetch(node:PsrConst;copy:Boolean):PsrConst;
function _Fetch1(dtype:TsrDataType;OpId:DWORD;value:QWORD):PsrConst;
function _FetchVector(dtype:TsrDataType;value:QWORD):PsrConst;
function Fetch(dtype:TsrDataType;value:QWORD):PsrConst;
function Fetch_b(value:Boolean):PsrConst; inline;
function Fetch_i(dtype:TsrDataType;value:Integer):PsrConst; inline;
Function Fetch_s(dtype:TsrDataType;value:Single):PsrConst; inline;
function FetchVector(pType:PsrType;count:Word;pData:PPsrConst;copy:Boolean):PsrConst;
function FetchVector(dtype:TsrDataType;pData:PPsrConst;copy:Boolean):PsrConst;
function Bitcast(rtype:TsrDataType;old:PsrConst):PsrConst;
function Fetch_ssrc9_const(SSRC:Word;d2:DWORD):PsrConst;
function Fetch_ssrc9_const(SSRC:Word;d2:DWORD;rtype:TsrDataType):PsrConst;
function Fetch_ssrc8_const(SSRC:Byte;d2:DWORD):PsrConst; inline;
function Fetch_ssrc8_const(SSRC:Byte;d2:DWORD;rtype:TsrDataType):PsrConst; inline;
function First:PsrConst; inline;
end;
function get_soffset_const_int(SSRC:Word):Integer;
function is_const_soffset(SSRC:Byte):Boolean; inline;
function is_const_ssrc8(SSRC:Byte):Boolean; inline;
function is_const_ssrc9(SSRC:Word):Boolean; inline;
function CompareConst(r1,r2:PsrConst):Boolean;
implementation
class Procedure ntConst.zero_read(node:PsrNode);
var
i:WORD;
begin
With PsrConst(node)^ do
begin
FType^.mark_read(node);
if (fCount<>0) then
For i:=0 to fCount-1 do
begin
GetItem(i)^.mark_read(node);
end;
end;
end;
class Procedure ntConst.zero_unread(node:PsrNode);
var
i:WORD;
begin
With PsrConst(node)^ do
begin
FType^.mark_unread(node);
if (fCount<>0) then
For i:=0 to fCount-1 do
begin
GetItem(i)^.mark_unread(node);
end;
end;
end;
class function ntConst.Next(node:PsrNode):Pointer;
begin
Result:=PsrConst(node)^.pNext;
end;
class function ntConst.Prev(node:PsrNode):Pointer;
begin
Result:=PsrConst(node)^.pPrev;
end;
class Function ntConst.GetPtype(node:PsrNode):PsrNode;
begin
Result:=PsrConst(node)^.FType;
end;
class function ntConst.GetPrintName(node:PsrNode):RawByteString;
begin
Result:=PsrConst(node)^.GetPrintName;
end;
class function ntConst.GetRef(node:PsrNode):Pointer;
begin
Result:=@PsrConst(node)^.ID;
end;
//
Procedure TsrConst.Init; inline;
begin
fntype:=ntConst;
end;
function TsrConst.c(n1,n2:PsrConst):Integer;
begin
//first FType
Result:=Integer(n1^.FType>n2^.FType)-Integer(n1^.FType<n2^.FType);
if (Result<>0) then Exit;
//second fCount
Result:=Integer(n1^.fCount>n2^.fCount)-Integer(n1^.fCount<n2^.fCount);
if (Result<>0) then Exit;
//third pData
Result:=ComparePtruint(PPtruint(n1^.pData),PPtruint(n2^.pData),n1^.fCount);
end;
function TsrConst.dtype:TsrDataType;
begin
Result:=FType^.dtype;
end;
function TsrConst.GetItem(i:Word):PsrNode;
begin
if (i>fCount) then Exit(nil);
Result:=pData[i];
end;
function TsrConst.GetLiteral(i:Word):PsrLiteral;
begin
Result:=GetItem(i)^.AsType(ntLiteral);
end;
function TsrConst.GetConst(i:Word):PsrConst;
begin
Result:=GetItem(i)^.AsType(ntConst);
end;
Function TsrConst.AsBool:Boolean; inline;
begin
Result:=GetLiteral(0)^.AsBool;
end;
function TsrConst.AsUint8:Byte; inline;
begin
Result:=GetLiteral(0)^.AsUint8;
end;
function TsrConst.AsInt8:Shortint; inline;
begin
Result:=GetLiteral(0)^.AsInt8;
end;
function TsrConst.AsUint16:Word; inline;
begin
Result:=GetLiteral(0)^.AsUint16;
end;
function TsrConst.AsInt16:Smallint; inline;
begin
Result:=GetLiteral(0)^.AsInt16;
end;
Function TsrConst.AsUint32:DWORD; inline;
begin
Result:=GetLiteral(0)^.AsUint32;
end;
function TsrConst.AsInt32:Integer; inline;
begin
Result:=GetLiteral(0)^.AsInt32;
end;
Function TsrConst.AsUint64:QWORD; inline;
begin
Result:=GetLiteral(0)^.AsUint64;
end;
Function TsrConst.AsInt64:Int64; inline;
begin
Result:=GetLiteral(0)^.AsInt64;
end;
function TsrConst.AsHalf16:THalf16; inline;
begin
Result:=GetLiteral(0)^.AsHalf16;
end;
function TsrConst.AsFloat32:Single; inline;
begin
Result:=GetLiteral(0)^.AsFloat32;
end;
function TsrConst.AsFloat64:Double; inline;
begin
Result:=GetLiteral(0)^.AsFloat64;
end;
function TsrConst.GetData:QWORD;
begin
Result:=0;
case dtype of
dtVec2u8,
dtVec2i8:
begin
PBYTE(@Result)[0]:=GetConst(0)^.AsUint8;
PBYTE(@Result)[1]:=GetConst(1)^.AsUint8;
end;
dtVec4u8,
dtVec4i8:
begin
PBYTE(@Result)[0]:=GetConst(0)^.AsUint8;
PBYTE(@Result)[1]:=GetConst(1)^.AsUint8;
PBYTE(@Result)[2]:=GetConst(2)^.AsUint8;
PBYTE(@Result)[3]:=GetConst(3)^.AsUint8;
end;
dtStruct2u,
dtVec2u,
dtVec2i,
dtVec2f:
begin
PDWORD(@Result)[0]:=GetConst(0)^.AsUint32;
PDWORD(@Result)[1]:=GetConst(1)^.AsUint32;
end;
dtVec2u16,
dtVec2i16,
dtVec2h :
begin
PWORD(@Result)[0]:=GetConst(0)^.AsUint16;
PWORD(@Result)[1]:=GetConst(1)^.AsUint16;
end;
dtVec4u16,
dtVec4i16,
dtVec4h :
begin
PWORD(@Result)[0]:=GetConst(0)^.AsUint16;
PWORD(@Result)[1]:=GetConst(1)^.AsUint16;
PWORD(@Result)[2]:=GetConst(2)^.AsUint16;
PWORD(@Result)[3]:=GetConst(3)^.AsUint16;
end;
else
begin
Assert(fCount=1,'fCount<>1');
Result:=AsUint64;
end;
end;
end;
Function TsrConst.isZeroVal:Boolean;
begin
case dtype of
dtInt8,
dtUint8:Result:=(AsUint8=0);
dtHalf16,
dtInt16,
dtUint16:Result:=(AsUint16=0);
dtFloat32,
dtInt32,
dtUint32:Result:=(AsUint32=0);
dtFloat64,
dtInt64,
dtUint64:Result:=(AsUint64=0);
else
Result:=False;
end;
end;
Function TsrConst.isBoolVal:Boolean; inline;
begin
if (fCount<>1) then Exit(False);
Case AsUint64 of
0,1:Result:=True;
else
Result:=False;
end;
end;
function TsrConst.GetPrintName:RawByteString;
var
s:Single;
i:Int64;
ui:qword;
begin
Result:='';
Case dtype of
dtBool:
begin
Case AsBool of
true :Result:='true';
False:Result:='false';
end;
end;
dtHalf16:
begin
s:=Single(AsHalf16);
i:=Trunc(s);
if (s=i) then
begin
Case i of
0..99:Result:='ch'+IntToStr(i);
-9..-1:Result:='chm'+IntToStr(abs(i));
else;
end;
end;
end;
dtFloat32:
begin
s:=AsFloat32;
i:=Trunc(s);
if (s=i) then
begin
Case i of
0..99:Result:='cf'+IntToStr(i);
-9..-1:Result:='cfm'+IntToStr(abs(i));
else;
end;
end;
end;
dtInt32 :
begin
i:=AsInt32;
Case i of
0..99:Result:='ci'+IntToStr(i);
-9..-1:Result:='cim'+IntToStr(abs(i));
else;
end;
end;
dtUint32:
begin
ui:=AsUint32;
Case ui of
0..99:Result:='cu'+IntToStr(ui);
else;
end;
end;
else;
end;
if (Result='') then
begin
Assert(ID.Alloc);
Result:='c'+IntToStr(ID.ID);
end;
end;
//
Procedure TsrConstList.Init(Emit:TCustomEmit); inline;
begin
FEmit:=Emit;
end;
function TsrConstList._Fetch(node:PsrConst;copy:Boolean):PsrConst;
var
size:DWORD;
begin
Result:=FNTree.Find(node);
if (Result=nil) then
begin
Result:=FEmit.Alloc(SizeOf(TsrConst));
Move(node^,Result^,SizeOf(TsrConst));
if copy and (node^.fCount<>0) then
begin
size:=SizeOf(Pointer)*node^.fCount;
Result^.pData:=FEmit.Alloc(size);
Move(node^.pData^,Result^.pData^,Size);
end;
FNTree.Insert(Result);
FList.Push_tail(Result);
end;
end;
function TsrConstList._Fetch1(dtype:TsrDataType;OpId:DWORD;value:QWORD):PsrConst;
var
pLiteralList:PsrLiteralList;
pTypeList:PsrTypeList;
node:TsrConst;
item:array[0..0] of PsrNode;
begin
Result:=nil;
pLiteralList:=FEmit.GetLiteralList;
pTypeList :=FEmit.GetTypeList;
//
item[0]:=pLiteralList^.FetchConst(dtype,value);
//
node:=Default(TsrConst);
node.Init;
node.fOpId :=OpId;
node.fCount:=1;
node.FType :=pTypeList^.Fetch(dtype);
node.pData :=@item;
Result:=_Fetch(@node,True);
end;
function TsrConstList._FetchVector(dtype:TsrDataType;value:QWORD):PsrConst;
var
pTypeList:PsrTypeList;
node:TsrConst;
item:array[0..3] of PsrNode;
Child:TsrDataType;
High:QWORD;
i,BitSize:Byte;
begin
Result:=nil;
pTypeList:=FEmit.GetTypeList;
//
Child :=dtype.Child;
BitSize:=Child.BitSize;
High :=Child.High;
For i:=0 to dtype.Count-1 do
begin
item[i]:=Fetch(Child,value and High);
value:=value shr BitSize;
end;
//
node:=Default(TsrConst);
node.Init;
node.fOpId :=Op.OpConstantComposite;
node.fCount:=dtype.Count;
node.FType :=pTypeList^.Fetch(dtype);
node.pData :=@item;
Result:=_Fetch(@node,True);
end;
function TsrConstList.Fetch(dtype:TsrDataType;value:QWORD):PsrConst;
begin
Result:=nil;
value:=value and dtype.High;
Case dtype of
dtUnknow:
begin
Result:=_Fetch1(dtype,Op.OpNop,value);
end;
dtBool:
begin
if Boolean(value) then
begin
Result:=_Fetch1(dtype,Op.OpConstantTrue ,value);
end else
begin
Result:=_Fetch1(dtype,Op.OpConstantFalse,value);
end;
end;
dtHalf16,
dtFloat32,
dtFloat64,
dtInt8,
dtUint8,
dtInt16,
dtUint16,
dtInt32,
dtUint32,
dtInt64,
dtUint64:
begin
Result:=_Fetch1(dtype,Op.OpConstant,value);
end;
dtStruct2u,
dtVec2u8,
dtVec4u8,
dtVec2i8,
dtVec4i8,
dtVec2u16,
dtVec4u16,
dtVec2i16,
dtVec4i16,
dtVec2u,
dtVec2i,
dtVec2h,
dtVec4h,
dtVec2f:
begin
Result:=_FetchVector(dtype,value);
end;
else
Assert(false);
end;
end;
function TsrConstList.Fetch_b(value:Boolean):PsrConst; inline;
begin
Result:=Fetch(dtBool,QWORD(value));
end;
function TsrConstList.Fetch_i(dtype:TsrDataType;value:Integer):PsrConst; inline;
begin
Result:=Fetch(dtype,PDWORD(@value)^);
end;
Function TsrConstList.Fetch_s(dtype:TsrDataType;value:Single):PsrConst; inline;
begin
Result:=Fetch(dtype,PDWORD(@value)^);
end;
function TsrConstList.FetchVector(pType:PsrType;count:Word;pData:PPsrConst;copy:Boolean):PsrConst;
var
node:TsrConst;
begin
Assert(count<>0);
Assert(pData<>nil);
node:=Default(TsrConst);
node.Init;
node.fOpId :=Op.OpConstantComposite;
node.fCount:=count;
node.FType :=pType;
node.pData :=Pointer(pData);
Result:=_Fetch(@node,copy);
end;
function TsrConstList.FetchVector(dtype:TsrDataType;pData:PPsrConst;copy:Boolean):PsrConst;
var
pTypeList:PsrTypeList;
begin
pTypeList:=FEmit.GetTypeList;
Result:=FetchVector(pTypeList^.Fetch(dtype),dtype.Count,pData,copy);
end;
function TsrConstList.Bitcast(rtype:TsrDataType;old:PsrConst):PsrConst;
var
data:qword;
begin
Result:=nil;
if not old^.IsType(ntConst) then Exit(old);
if (rtype=dtUnknow) or (rtype=old^.dtype) then
begin
Exit(old);
end;
if (old^.dtype=dtUnknow) then
begin
data:=old^.GetData;
Result:=Fetch(rtype,data);
Exit;
end;
if TryBitcastType(rtype,old^.dtype) then
begin
data:=old^.GetData;
Result:=Fetch(rtype,data);
end else
begin
Assert(false,'const bitcast');
end;
end;
function TsrConstList.Fetch_ssrc9_const(SSRC:Word;d2:DWORD):PsrConst;
begin
Case SSRC of
128:Result:=Fetch(dtUnknow,0);
129..192:Result:=Fetch(dtUint32,SSRC-128);
193..208:Result:=Fetch_i(dtInt32,-(SSRC-192));
240:Result:=Fetch_s(dtFloat32, 0.5);
241:Result:=Fetch_s(dtFloat32,-0.5);
242:Result:=Fetch_s(dtFloat32, 1.0);
243:Result:=Fetch_s(dtFloat32,-1.0);
244:Result:=Fetch_s(dtFloat32, 2.0);
245:Result:=Fetch_s(dtFloat32,-2.0);
246:Result:=Fetch_s(dtFloat32, 4.0);
247:Result:=Fetch_s(dtFloat32,-4.0);
255:Result:=Fetch(dtUnknow,d2);
else
Result:=nil;
end;
end;
function TsrConstList.Fetch_ssrc9_const(SSRC:Word;d2:DWORD;rtype:TsrDataType):PsrConst;
begin
Case SSRC of
128:Result:=Fetch(rtype,0);
129..192:
begin
if CompareType(dtUint32,rtype) then
begin
Result:=Fetch(dtUint32,SSRC-128);
end else
begin
Result:=Fetch(rtype,SSRC-128);
end;
end;
193..208:
begin
if CompareType(dtInt32,rtype) then
begin
Result:=Fetch_i(dtInt32,-(SSRC-192));
end else
begin
Result:=Fetch_i(rtype,-(SSRC-192));
end;
end;
240:Result:=Fetch_s(rtype, 0.5);
241:Result:=Fetch_s(rtype,-0.5);
242:Result:=Fetch_s(rtype, 1.0);
243:Result:=Fetch_s(rtype,-1.0);
244:Result:=Fetch_s(rtype, 2.0);
245:Result:=Fetch_s(rtype,-2.0);
246:Result:=Fetch_s(rtype, 4.0);
247:Result:=Fetch_s(rtype,-4.0);
255:Result:=Fetch(rtype,d2);
else
Result:=nil;
end;
end;
function TsrConstList.Fetch_ssrc8_const(SSRC:Byte;d2:DWORD):PsrConst; inline;
begin
Result:=Fetch_ssrc9_const(SSRC,d2);
end;
function TsrConstList.Fetch_ssrc8_const(SSRC:Byte;d2:DWORD;rtype:TsrDataType):PsrConst; inline;
begin
Result:=Fetch_ssrc9_const(SSRC,d2,rtype);
end;
function TsrConstList.First:PsrConst; inline;
begin
Result:=FList.pHead;
end;
function get_soffset_const_int(SSRC:Word):Integer;
type
TRec=packed record
Case byte of
0:(i:Integer);
1:(s:Single);
end;
begin
Case SSRC of
128:Result:=0;
129..192:Result:=SSRC-128;
193..208:Result:=-(SSRC-192);
240:TRec(Result).s:= 0.5;
241:TRec(Result).s:=-0.5;
242:TRec(Result).s:= 1.0;
243:TRec(Result).s:=-1.0;
244:TRec(Result).s:= 2.0;
245:TRec(Result).s:=-2.0;
246:TRec(Result).s:= 4.0;
247:TRec(Result).s:=-4.0;
else
Result:=0;
end;
end;
function is_const_soffset(SSRC:Byte):Boolean; inline;
begin
Case SSRC of
128..192,
193..208,
240..247:Result:=True;
else
Result:=False;
end;
end;
function is_const_ssrc8(SSRC:Byte):Boolean; inline;
begin
Case SSRC of
128..192,
193..208,
240..247,
255:Result:=True;
else
Result:=False;
end;
end;
function is_const_ssrc9(SSRC:Word):Boolean; inline;
begin
Case SSRC of
128..192,
193..208,
240..247,
255:Result:=True;
else
Result:=False;
end;
end;
function CompareConstCount(buf1,buf2:PPsrConst;count:Byte):Boolean;
begin
Result:=true;
While (count<>0) do
begin
Result:=CompareConst(buf1^,buf2^);
if not Result then Exit;
Inc(buf1);
Inc(buf2);
Dec(count);
end;
end;
function CompareConst(r1,r2:PsrConst):Boolean;
begin
Result:=false;
if (r1<>nil) and (r2<>nil) then
begin
Result:=(r1=r2);
if Result then Exit;
if CompareType(r1^.dtype,r2^.dtype) and (r1^.fCount=r2^.fCount) then
begin
if (r1^.fCount=1) then
begin
Result:=(r1^.AsUint64=r2^.AsUint64);
end else
begin
Result:=CompareConstCount(Pointer(r1^.pData),Pointer(r2^.pData),r1^.fCount);
end;
end;
end;
end;
end.