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

Big update

This commit is contained in:
Pavel 2022-05-31 10:20:10 +03:00
parent d8fcf4da0f
commit c4e23700b4
81 changed files with 22797 additions and 3288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitignore vendored
View File

@ -6,8 +6,8 @@
*.o
*.ini
*.db
*.txt
*.rar
*.tga
*.bat
*.prx
*.sprx
@ -15,5 +15,5 @@
link.res
lib/
backup/
spirv/*
shader_dump/*
savedata/*

4
README.md
View File

@ -4,11 +4,11 @@
This project is at the beginning and started for fun.
### Building
- Free pascal compiler: 3.0.0 and higher, x86_64 only.
- Free pascal compiler: 3.3.1 (use fpcupdeluxe with trunk), x86_64 only.
- Lazarus: 2.0.0 and higher, x86_64 only.
### Minimum system requirements
- OS: Windows 7 x64 and higher
- OS: Windows 7 SP1 x64 and higher
- CPU: x64, AVX2 support
- GPU: Vulkan API support

22
as_only.cmd Normal file
View File

@ -0,0 +1,22 @@
@echo off
cd /D "%~dp0"
Set opt=spirv-opt --eliminate-dead-branches --eliminate-local-multi-store --eliminate-dead-code-aggressive --scalar-replacement --simplify-instructions
call :folder shader_dump
pause
exit
:folder
For /F %%a in ('dir /B %1') do if "%%~xa"==".txt" (call :compil %1\%%~na)
exit /b
:compil
echo %~n1
del %1.spv >nul 2>&1
spirv-as --target-env vulkan1.1 %1.txt -o %1.spv
spirv-val --scalar-block-layout --target-env vulkan1.1 %1.spv
rem %opt% %1.spv -o %1.spv
exit /b

24
as_shader_dump.cmd Normal file
View File

@ -0,0 +1,24 @@
@echo off
cd /D "%~dp0"
Set opt=spirv-opt --eliminate-dead-branches --eliminate-local-multi-store --eliminate-dead-code-aggressive --scalar-replacement --simplify-instructions
call :folder shader_dump
pause
exit
:folder
For /F %%a in ('dir /B %1') do if "%%~xa"==".dump" (call :compil %1\%%~na)
exit /b
:compil
echo %~n1
del %1.txt >nul 2>&1
del %1.spv >nul 2>&1
spirv\pssl-spirv %1.dump -p > %1.txt
spirv\pssl-spirv %1.dump -b %1.spv
spirv-val --target-env vulkan1.1 --scalar-block-layout %1.spv
rem %opt% %1.spv -o %1.spv
exit /b

745
chip/ps4_gpu_regs.pas
View File

@ -8,8 +8,10 @@ uses
Classes,
SysUtils,
vulkan,
vImage,
bittype,
pm4defs,
ps4_shader,
si_ci_vi_merged_offset,
si_ci_vi_merged_enum,
si_ci_vi_merged_registers;
@ -62,16 +64,21 @@ type
TSPI_USER_DATA=array[0..15] of DWORD;
TRT_INFO=record
Addr:Pointer;
//Addr:Pointer;
extend:TVkExtent2D;
//extend:TVkExtent2D;
padded:TVkExtent2D;
cformat:TVkFormat;
TILE_MODE_INDEX:DWORD;
//cformat:TVkFormat;
//TILE_MODE_INDEX:DWORD;
FImageInfo:TvImageKey;
FImageView:TvImageViewKey;
COMP_SWAP :Byte;
FAST_CLEAR:Boolean;
//FAST_CLEAR:Boolean;
IMAGE_USAGE:Byte;
CLEAR_COLOR:TVkClearColorValue;
@ -86,14 +93,14 @@ type
STENCIL_READ_ADDR:Pointer;
STENCIL_WRITE_ADDR:Pointer;
extend:TVkExtent2D;
//extend:TVkExtent2D;
padded:TVkExtent2D;
DEPTH_CLEAR :Boolean;
STENCIL_CLEAR :Boolean;
//DEPTH_CLEAR :Boolean;
//STENCIL_CLEAR :Boolean;
Z_READ_ONLY :Boolean;
STENCIL_READ_ONLY:Boolean;
//Z_READ_ONLY :Boolean;
//STENCIL_READ_ONLY:Boolean;
CLEAR_VALUE:TVkClearValue;
@ -109,12 +116,18 @@ type
minDepthBounds:TVkFloat;
maxDepthBounds:TVkFloat;
dformat:TVkFormat;
DEPTH_USAGE:Byte;
STENCIL_USAGE:Byte;
zorder_stage:TVkPipelineStageFlagBits;
FImageInfo:TvImageKey;
//dformat:TVkFormat;
zorder_stage:TVkPipelineStageFlags;
end;
PGPU_REGS=^TGPU_REGS;
TGPU_REGS=packed object
RENDER_TARGET:array[0..7] of TRENDER_TARGET;
TARGET_MASK:TCB_TARGET_MASK;
@ -164,6 +177,7 @@ type
VGT_PRIMITIVE_TYPE:TVGT_PRIMITIVE_TYPE;
VGT_INDEX_TYPE :TVGT_INDEX_TYPE ;
VGT_NUM_INSTANCES :TVGT_NUM_INSTANCES ;
GRBM_GFX_INDEX :TGRBM_GFX_INDEX;
VGT_DMA:packed record
INDEX_TYPE:TVGT_DMA_INDEX_TYPE;
@ -182,8 +196,7 @@ type
SPI:packed record
PS:packed record
INPUT_CNTL_0:TSPI_PS_INPUT_CNTL_0;
INPUT_CNTL_1:TSPI_PS_INPUT_CNTL_1;
INPUT_CNTL:array[0..31] of TSPI_PS_INPUT_CNTL_0;
LO,HI:DWORD;
RSRC1:TSPI_SHADER_PGM_RSRC1_PS;
@ -291,21 +304,43 @@ type
Procedure ClearDMA;
end;
const
// Provided by VK_EXT_image_view_min_lod
VK_STRUCTURE_TYPE_IMAGE_VIEW_MIN_LOD_CREATE_INFO_EXT = 1000391001;
type
PVkImageViewMinLodCreateInfoEXT=^TVkImageViewMinLodCreateInfoEXT;
TVkImageViewMinLodCreateInfoEXT=record
sType:TVkStructureType; //< Must be VK_STRUCTURE_TYPE_IMAGE_VIEW_MIN_LOD_CREATE_INFO_EXT
pNext:PVkVoid;
minLod:TVkFloat;
end;
function _get_vsharp_cformat(PV:PVSharpResource4):TVkFormat;
function _get_tsharp4_cformat(PT:PTSharpResource4):TVkFormat;
function _get_tsharp4_min_lod(PT:PTSharpResource4):TVkImageViewMinLodCreateInfoEXT;
function _get_tsharp4_image_info(PT:PTSharpResource4):TvImageKey;
function _get_tsharp4_image_view(PT:PTSharpResource4):TvImageViewKey;
function _get_ssharp_info(PS:PSSharpResource4):TVkSamplerCreateInfo;
implementation
Function TGPU_REGS._SHADER_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=(DWORD(SPI.PS.SHADER_MASK) shr i) and 15;
Result:=(DWORD(SPI.PS.SHADER_MASK) shr (i shl 2)) and 15;
end;
Function TGPU_REGS._TARGET_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=(DWORD(TARGET_MASK) shr i) and 15;
Result:=(DWORD(TARGET_MASK) shr (i shl 2)) and 15;
end;
Function TGPU_REGS._COMP_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=((DWORD(SPI.PS.SHADER_MASK) and DWORD(TARGET_MASK)) shr i) and 15;
Result:=((DWORD(SPI.PS.SHADER_MASK) and DWORD(TARGET_MASK)) shr (i shl 2)) and 15;
end;
Function TGPU_REGS.COMP_ENABLE:Boolean; inline;
@ -624,14 +659,82 @@ begin
Result.colorBlendOp:=GetBlendOp(CB_BLEND_CONTROL[i].COLOR_COMB_FCN);
Result.alphaBlendOp:=GetBlendOp(CB_BLEND_CONTROL[i].ALPHA_COMB_FCN);
Assert(CB_BLEND_CONTROL[i].SEPARATE_ALPHA_BLEND=0);
//(CB_BLEND_CONTROL[i].SEPARATE_ALPHA_BLEND=0); //VkPhysicalDeviceFeatures.independentBlend
Assert(CB_BLEND_CONTROL[i].DISABLE_ROP3 =0);
end;
//Assert(CB_COLOR_CONTROL.ROP3 = 204);
//CB_COLOR_CONTROL.MODE //CB_DISABLE
//Assert(CB_COLOR_CONTROL.ROP3 = 204); //CB_DISABLE
{
POSSIBLE VALUES:
00 - 0x00: BLACKNESS
05 - 0x05
10 - 0x0A
15 - 0x0F
17 - 0x11: NOTSRCERASE
34 - 0x22
51 - 0x33: NOTSRCCOPY
68 - 0x44: SRCERASE
80 - 0x50
85 - 0x55: DSTINVERT
90 - 0x5A: PATINVERT
95 - 0x5F
102 - 0x66: SRCINVERT
119 - 0x77
136 - 0x88: SRCAND
153 - 0x99
160 - 0xA0
165 - 0xA5
170 - 0xAA
175 - 0xAF
187 - 0xBB: MERGEPAINT
204 - 0xCC: SRCCOPY
221 - 0xDD
238 - 0xEE: SRCPAINT
240 - 0xF0: PATCOPY
245 - 0xF5
250 - 0xFA
255 - 0xFF: WHITENESS
}
end;
const
// Depth modes (for depth buffers)
kTileModeDepth_2dThin_64 = $00000000; ///< Recommended for depth targets with one fragment per pixel.
kTileModeDepth_2dThin_128 = $00000001; ///< Recommended for depth targets with two or four fragments per pixel, or texture-readable.
kTileModeDepth_2dThin_256 = $00000002; ///< Recommended for depth targets with eight fragments per pixel.
kTileModeDepth_2dThin_512 = $00000003; ///< Recommended for depth targets with 512-byte tiles.
kTileModeDepth_2dThin_1K = $00000004; ///< Recommended for depth targets with 1024-byte tiled.
kTileModeDepth_1dThin = $00000005; ///< Not used; included only for completeness.
kTileModeDepth_2dThinPrt_256 = $00000006; ///< Recommended for partially-resident depth surfaces. Does not support aliasing multiple virtual texture pages to the same physical page.
kTileModeDepth_2dThinPrt_1K = $00000007; ///< Not used; included only for completeness.
// Display modes
kTileModeDisplay_LinearAligned = $00000008; ///< Recommended for any surface to be easily accessed on the CPU.
kTileModeDisplay_1dThin = $00000009; ///< Not used; included only for completeness.
kTileModeDisplay_2dThin = $0000000A; ///< Recommended mode for displayable render targets.
kTileModeDisplay_ThinPrt = $0000000B; ///< Supports aliasing multiple virtual texture pages to the same physical page.
kTileModeDisplay_2dThinPrt = $0000000C; ///< Does not support aliasing multiple virtual texture pages to the same physical page.
// Thin modes (for non-displayable 1D/2D/3D surfaces)
kTileModeThin_1dThin = $0000000D; ///< Recommended for read-only non-volume textures.
kTileModeThin_2dThin = $0000000E; ///< Recommended for non-displayable intermediate render targets and read/write non-volume textures.
kTileModeThin_3dThin = $0000000F; ///< Not used; included only for completeness.
kTileModeThin_ThinPrt = $00000010; ///< Recommended for partially-resident textures (PRTs). Supports aliasing multiple virtual texture pages to the same physical page.
kTileModeThin_2dThinPrt = $00000011; ///< Does not support aliasing multiple virtual texture pages to the same physical page.
kTileModeThin_3dThinPrt = $00000012; ///< Does not support aliasing multiple virtual texture pages to the same physical page.
// Thick modes (for 3D textures)
kTileModeThick_1dThick = $00000013; ///< Recommended for read-only volume textures.
kTileModeThick_2dThick = $00000014; ///< Recommended for volume textures to which pixel shaders will write.
kTileModeThick_3dThick = $00000015; ///< Not used; included only for completeness.
kTileModeThick_ThickPrt = $00000016; ///< Supports aliasing multiple virtual texture pages to the same physical page.
kTileModeThick_2dThickPrt = $00000017; ///< Does not support aliasing multiple virtual texture pages to the same physical page.
kTileModeThick_3dThickPrt = $00000018; ///< Does not support aliasing multiple virtual texture pages to the same physical page.
kTileModeThick_2dXThick = $00000019; ///< Recommended for volume textures to which pixel shaders will write.
kTileModeThick_3dXThick = $0000001A; ///< Not used; included only for completeness.
// Hugely inefficient linear display mode -- do not use!
kTileModeDisplay_LinearGeneral = $0000001F; ///< Unsupported; do not use!
Function TGPU_REGS.GET_RT_INFO(i:Byte):TRT_INFO; //0..7
var
COMP_MAP:TCOMP_MAP;
@ -639,13 +742,25 @@ var
begin
Result:=Default(TRT_INFO);
{
Result.Addr:=Pointer(QWORD(RENDER_TARGET[i].BASE) shl 8);
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL=1) then
begin
Result.Addr:=Pointer(QWORD(Result.Addr) or Byte(RENDER_TARGET[i].VIEW.SLICE_START));
end;
}
Result.extend:=GET_SCREEN_SIZE;
Result.FImageInfo.Addr:=Pointer(QWORD(RENDER_TARGET[i].BASE) shl 8);
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL<>0) then
begin
Result.FImageInfo.Addr:=Pointer(QWORD(Result.FImageInfo.Addr) or Byte(RENDER_TARGET[i].VIEW.SLICE_START));
end;
//Result.extend:=GET_SCREEN_SIZE;
Result.FImageInfo.params.extend.width :=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.FImageInfo.params.extend.height:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
Result.FImageInfo.params.extend.depth :=1;
Result.padded.Width :=(RENDER_TARGET[i].PITCH.TILE_MAX+1)*8;
Result.padded.Height:=(RENDER_TARGET[i].SLICE.TILE_MAX+1)*8 div (RENDER_TARGET[i].PITCH.TILE_MAX+1);
@ -653,6 +768,7 @@ begin
Assert(RENDER_TARGET[i].INFO.ENDIAN=ENDIAN_NONE);
//Assert(RENDER_TARGET[i].INFO.COMPRESSION=0); //FMASK and MSAA
{
Case RENDER_TARGET[i].INFO.FORMAT of
COLOR_8_8_8_8:
Case RENDER_TARGET[i].INFO.NUMBER_TYPE of
@ -664,15 +780,57 @@ begin
else
Assert(false);
end;
}
Result.TILE_MODE_INDEX:=RENDER_TARGET[i].ATTRIB.TILE_MODE_INDEX;
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL=1) then Result.TILE_MODE_INDEX:=8;
Case RENDER_TARGET[i].INFO.FORMAT of
COLOR_8_8_8_8:
Case RENDER_TARGET[i].INFO.NUMBER_TYPE of
NUMBER_UNORM:Result.FImageInfo.cformat:=VK_FORMAT_R8G8B8A8_UNORM;
NUMBER_SRGB :Result.FImageInfo.cformat:=VK_FORMAT_R8G8B8A8_SRGB;
else
Assert(false);
end;
else
Assert(false);
end;
//Result.TILE_MODE_INDEX:=RENDER_TARGET[i].ATTRIB.TILE_MODE_INDEX;
//if (RENDER_TARGET[i].INFO.LINEAR_GENERAL=1) then Result.TILE_MODE_INDEX:=8;
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL<>0) then
Result.FImageInfo.params.tiling_idx:=kTileModeDisplay_LinearGeneral
else
Result.FImageInfo.params.tiling_idx:=RENDER_TARGET[i].ATTRIB.TILE_MODE_INDEX;
Result.FImageInfo.params.itype :=ord(VK_IMAGE_TYPE_2D);
Result.FImageInfo.params.samples :=1{ shl (RENDER_TARGET[i].ATTRIB.NUM_SAMPLES and 3)};
Result.FImageInfo.params.mipLevels :=1;
Result.FImageInfo.params.arrayLayers:=1;
Result.FImageView.cformat :=Result.FImageInfo.cformat;
Result.FImageView.vtype :=ord(VK_IMAGE_VIEW_TYPE_2D);
//Result.FImageView.dstSel:TvDstSel; TODO
//Result.FImageView.base_level:Byte; //first mip level (0..15)
//Result.FImageView.last_level:Byte; //last mip level (0..15)
//Result.FImageView.base_array:Word; //first array index (0..16383)
//Result.FImageView.last_array:Word; //texture height (0..16383)
Result.blend:=GET_RT_BLEND(i);
Result.COMP_SWAP:=RENDER_TARGET[i].INFO.COMP_SWAP;
if (RENDER_TARGET[i].INFO.FAST_CLEAR=1) then
Result.IMAGE_USAGE:=(TM_CLEAR*RENDER_TARGET[i].INFO.FAST_CLEAR);
if (Result.blend.blendEnable<>0) then
begin
Result.FAST_CLEAR:=True;
Result.IMAGE_USAGE:=Result.IMAGE_USAGE or TM_READ;
end;
Result.IMAGE_USAGE:=Result.IMAGE_USAGE or TM_WRITE;
//if (RENDER_TARGET[i].INFO.FAST_CLEAR=1) then
//begin
//Result.FAST_CLEAR:=True;
Case RENDER_TARGET[i].INFO.FORMAT of
COLOR_8_8_8_8:
@ -706,9 +864,7 @@ begin
Assert(false);
end;
end;
Result.blend:=GET_RT_BLEND(i);
//end;
end;
@ -728,17 +884,34 @@ Function TGPU_REGS.GET_DB_INFO:TDB_INFO;
begin
Result:=Default(TDB_INFO);
Result.extend:=GET_SCREEN_SIZE;
//Result.extend:=GET_SCREEN_SIZE;
Result.padded.width :=(DEPTH.DEPTH_SIZE.PITCH_TILE_MAX +1)*8;
Result.padded.height:=(DEPTH.DEPTH_SIZE.HEIGHT_TILE_MAX+1)*8;
Result.DEPTH_USAGE :=((TM_WRITE or TM_CLEAR)*DEPTH.RENDER_CONTROL.DEPTH_CLEAR_ENABLE);
Result.STENCIL_USAGE:=((TM_WRITE or TM_CLEAR)*DEPTH.RENDER_CONTROL.STENCIL_CLEAR_ENABLE);
Result.DEPTH_CLEAR :=DEPTH.RENDER_CONTROL.DEPTH_CLEAR_ENABLE<>0;
Result.STENCIL_CLEAR:=DEPTH.RENDER_CONTROL.STENCIL_CLEAR_ENABLE<>0;
if (Result.DEPTH_USAGE=0) then
begin
Result.DEPTH_USAGE:=Result.DEPTH_USAGE or TM_READ;
end;
Result.Z_READ_ONLY :=DEPTH.DEPTH_VIEW.Z_READ_ONLY<>0;
Result.STENCIL_READ_ONLY:=DEPTH.DEPTH_VIEW.STENCIL_READ_ONLY<>0;
if (DEPTH.DEPTH_VIEW.Z_READ_ONLY=0) then
begin
Result.DEPTH_USAGE:=Result.DEPTH_USAGE or TM_WRITE;
end;
if (DEPTH.DEPTH_VIEW.STENCIL_READ_ONLY=0) then
begin
Result.STENCIL_USAGE:=Result.STENCIL_USAGE or TM_WRITE;
end;
//Result.DEPTH_CLEAR :=DEPTH.RENDER_CONTROL.DEPTH_CLEAR_ENABLE<>0;
//Result.STENCIL_CLEAR:=DEPTH.RENDER_CONTROL.STENCIL_CLEAR_ENABLE<>0;
//Result.Z_READ_ONLY :=DEPTH.DEPTH_VIEW.Z_READ_ONLY<>0;
//Result.STENCIL_READ_ONLY:=DEPTH.DEPTH_VIEW.STENCIL_READ_ONLY<>0;
Assert(DEPTH.RENDER_CONTROL.DEPTH_COPY=0);
Assert(DEPTH.RENDER_CONTROL.STENCIL_COPY=0);
@ -794,31 +967,31 @@ begin
Z_INVALID :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_S8_UINT;
Result.FImageInfo.cformat:=VK_FORMAT_S8_UINT;
end;
Z_16 :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D16_UNORM_S8_UINT;
Result.FImageInfo.cformat:=VK_FORMAT_D16_UNORM_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_D16_UNORM;
Result.FImageInfo.cformat:=VK_FORMAT_D16_UNORM;
end;
Z_24 :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D24_UNORM_S8_UINT;
Result.FImageInfo.cformat:=VK_FORMAT_D24_UNORM_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_X8_D24_UNORM_PACK32;
Result.FImageInfo.cformat:=VK_FORMAT_X8_D24_UNORM_PACK32;
end;
Z_32_FLOAT:
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D32_SFLOAT_S8_UINT;
Result.FImageInfo.cformat:=VK_FORMAT_D32_SFLOAT_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_D32_SFLOAT;
Result.FImageInfo.cformat:=VK_FORMAT_D32_SFLOAT;
end;
end;
@ -832,14 +1005,26 @@ begin
Assert(SPI.PS.SHADER_CONTROL.STENCIL_TEST_VAL_EXPORT_ENABLE=0);
Case SPI.PS.SHADER_CONTROL.Z_ORDER of
LATE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT;
EARLY_Z_THEN_LATE_Z:Result.zorder_stage:=TVkPipelineStageFlagBits(
ord(VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) or
ord(VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT));
RE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT;
EARLY_Z_THEN_RE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT;
LATE_Z,
RE_Z :Result.zorder_stage:=ord(VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT);
EARLY_Z_THEN_LATE_Z,
EARLY_Z_THEN_RE_Z :Result.zorder_stage:=ord(VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) or
ord(VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT);
end;
Result.FImageInfo.Addr:=Result.Z_READ_ADDR;
Result.FImageInfo.params.extend.width :=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.FImageInfo.params.extend.height:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
Result.FImageInfo.params.extend.depth :=1;
Result.FImageInfo.params.tiling_idx:=DEPTH.Z_INFO.TILE_MODE_INDEX;
Result.FImageInfo.params.itype :=ord(VK_IMAGE_TYPE_2D);
Result.FImageInfo.params.samples :=1{ shl (DEPTH.Z_INFO.NUM_SAMPLES and 3)};
Result.FImageInfo.params.mipLevels :=1;
Result.FImageInfo.params.arrayLayers:=1;
end;
function TGPU_REGS.GET_PRIM_TYPE:TVkPrimitiveTopology;
@ -921,6 +1106,476 @@ begin
FillChar(VGT_DMA,SizeOf(VGT_DMA),0);
end;
function _get_vsharp_cformat(PV:PVSharpResource4):TVkFormat;
begin
Result:=Default(TVkFormat);
if (PV=nil) then Exit;
Case PV^.nfmt of
BUF_NUM_FORMAT_UNORM:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_UNORM;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_UNORM;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_UNORM;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_UNORM;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_UNORM;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_SNORM:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SNORM;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SNORM;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SNORM;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SNORM;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SNORM;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_USCALED:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_USCALED;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_USCALED;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_USCALED;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_USCALED;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_USCALED;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_SSCALED:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SSCALED;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SSCALED;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SSCALED;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SSCALED;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SSCALED;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_UINT:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_UINT;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_UINT;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_UINT;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_UINT;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_UINT;
BUF_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_UINT;
BUF_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_UINT;
BUF_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_UINT;
BUF_DATA_FORMAT_32_32_32_32:Result:=VK_FORMAT_R32G32B32A32_UINT;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_SINT:
case PV^.dfmt of
BUF_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SINT;
BUF_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SINT;
BUF_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SINT;
BUF_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SINT;
BUF_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SINT;
BUF_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_SINT;
BUF_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_SINT;
BUF_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_SINT;
BUF_DATA_FORMAT_32_32_32_32:Result:=VK_FORMAT_R32G32B32A32_SINT;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
BUF_NUM_FORMAT_FLOAT:
case PV^.dfmt of
BUF_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_SFLOAT;
BUF_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_SFLOAT;
BUF_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_SFLOAT;
BUF_DATA_FORMAT_32_32_32_32:Result:=VK_FORMAT_R32G32B32A32_SFLOAT;
else
Assert(false,_get_buf_dfmt_str(PV^.dfmt));
end;
else
Assert(false,_get_buf_nfmt_str(PV^.nfmt));
end;
end;
function _img_is_msaa(b:Byte):Boolean; inline;
begin
Case b of
SQ_RSRC_IMG_2D_MSAA ,
SQ_RSRC_IMG_2D_MSAA_ARRAY:Result:=True;
else
Result:=False;
end;
end;
function _get_tsharp4_cformat(PT:PTSharpResource4):TVkFormat;
begin
Result:=Default(TVkFormat);
if (PT=nil) then Exit;
Case PT^.nfmt of
IMG_NUM_FORMAT_UNORM :
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_UNORM;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_UNORM;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_UNORM;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_UNORM;
IMG_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_UNORM;
IMG_DATA_FORMAT_5_6_5 :Result:=VK_FORMAT_R5G6B5_UNORM_PACK16;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_SRGB :
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SRGB;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SRGB;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SRGB;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_SNORM :
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SNORM;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SNORM;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SNORM;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SNORM;
IMG_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SNORM;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_USCALED:
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_USCALED;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_USCALED;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_USCALED;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_USCALED;
IMG_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_USCALED;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_SSCALED:
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SSCALED;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SSCALED;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SSCALED;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SSCALED;
IMG_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SSCALED;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_UINT :
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_UINT;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_UINT;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_UINT;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_UINT;
IMG_DATA_FORMAT_16_16_16_16 :Result:=VK_FORMAT_R16G16B16A16_UINT;
IMG_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_UINT;
IMG_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_UINT;
IMG_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_UINT;
IMG_DATA_FORMAT_32_32_32_32 :Result:=VK_FORMAT_R32G32B32A32_UINT;
IMG_DATA_FORMAT_FMASK8_S8_F1:Result:=VK_FORMAT_R8_UINT;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_SINT :
case PT^.dfmt of
IMG_DATA_FORMAT_8 :Result:=VK_FORMAT_R8_SINT;
IMG_DATA_FORMAT_8_8 :Result:=VK_FORMAT_R8G8_SINT;
IMG_DATA_FORMAT_8_8_8_8 :Result:=VK_FORMAT_R8G8B8A8_SINT;
IMG_DATA_FORMAT_16_16 :Result:=VK_FORMAT_R16_SINT;
IMG_DATA_FORMAT_16_16_16_16:Result:=VK_FORMAT_R16G16B16A16_SINT;
IMG_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_SINT;
IMG_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_SINT;
IMG_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_SINT;
IMG_DATA_FORMAT_32_32_32_32:Result:=VK_FORMAT_R32G32B32A32_SINT;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
IMG_NUM_FORMAT_FLOAT :
case PT^.dfmt of
IMG_DATA_FORMAT_32 :Result:=VK_FORMAT_R32_SFLOAT;
IMG_DATA_FORMAT_32_32 :Result:=VK_FORMAT_R32G32_SFLOAT;
IMG_DATA_FORMAT_32_32_32 :Result:=VK_FORMAT_R32G32B32_SFLOAT;
IMG_DATA_FORMAT_32_32_32_32:Result:=VK_FORMAT_R32G32B32A32_SFLOAT;
else
Assert(false,_get_tex_dfmt_str(PT^.dfmt));
end;
else
Assert(false,_get_tex_nfmt_str(PT^.nfmt));
end;
end;
function _get_tsharp4_image_info(PT:PTSharpResource4):TvImageKey;
begin
Result:=Default(TvImageKey);
if (PT=nil) then Exit;
Result.Addr:=Pointer(PT^.base shl 8);
Result.cformat:=_get_tsharp4_cformat(PT);
Case PT^._type of
SQ_RSRC_IMG_1D :Result.params.itype:=ord(VK_IMAGE_TYPE_1D);
SQ_RSRC_IMG_2D :Result.params.itype:=ord(VK_IMAGE_TYPE_2D);
SQ_RSRC_IMG_3D :Result.params.itype:=ord(VK_IMAGE_TYPE_3D);
SQ_RSRC_IMG_CUBE :Result.params.itype:=ord(VK_IMAGE_TYPE_2D);
SQ_RSRC_IMG_1D_ARRAY :Result.params.itype:=ord(VK_IMAGE_TYPE_1D);
SQ_RSRC_IMG_2D_ARRAY :Result.params.itype:=ord(VK_IMAGE_TYPE_2D);
SQ_RSRC_IMG_2D_MSAA :Result.params.itype:=ord(VK_IMAGE_TYPE_2D);
SQ_RSRC_IMG_2D_MSAA_ARRAY:Result.params.itype:=ord(VK_IMAGE_TYPE_2D);
else;
Assert(false);
end;
Result.params.tiling_idx :=PT^.tiling_idx;
Result.params.extend.width :=PT^.width+1;
Result.params.extend.height:=PT^.height+1;
Result.params.extend.depth :=1;
if _img_is_msaa(PT^._type) then
begin
Result.params.samples :=PT^.last_level;
Result.params.mipLevels:=1;
end else
begin
Result.params.samples :=1;
Result.params.mipLevels:=PT^.last_level-PT^.base_level+1;
end;
Assert(Result.params.mipLevels=1,'TODO');
Result.params.arrayLayers:=1;
end;
function _get_dst_sel_swizzle(b:Byte):Byte;
begin
Case b of
0:Result:=ord(VK_COMPONENT_SWIZZLE_ZERO);
1:Result:=ord(VK_COMPONENT_SWIZZLE_ONE);
4:Result:=ord(VK_COMPONENT_SWIZZLE_R);
5:Result:=ord(VK_COMPONENT_SWIZZLE_G);
6:Result:=ord(VK_COMPONENT_SWIZZLE_B);
7:Result:=ord(VK_COMPONENT_SWIZZLE_A);
else
Result:=ord(VK_COMPONENT_SWIZZLE_IDENTITY);
end;
end;
function _get_lod(w:Word):TVkFloat; forward;
function _get_tsharp4_min_lod(PT:PTSharpResource4):TVkImageViewMinLodCreateInfoEXT;
begin
Result:=Default(TVkImageViewMinLodCreateInfoEXT);
if (PT=nil) then Exit;
ord(Result.sType):=VK_STRUCTURE_TYPE_IMAGE_VIEW_MIN_LOD_CREATE_INFO_EXT;
Result.minLod:=_get_lod(PT^.min_lod);
end;
//perf_mod:bit3; //0=0/16, 1=2/16, 2=5/16, 3=7/16, 4=9/16, 5=11/16, 6=14/16, 7=16/16
//interlaced:bit1; //texture is interlaced
//tiling_idx:bit5; //index into lookup table of surface tiling settings
//pow2pad:bit1; //memory footprint is padded to power of 2 dimensions
function _get_tsharp4_image_view(PT:PTSharpResource4):TvImageViewKey;
var
t:Byte;
begin
Result:=Default(TvImageViewKey);
if (PT=nil) then Exit;
Result.cformat:=_get_tsharp4_cformat(PT);
Case PT^._type of
SQ_RSRC_IMG_1D :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_1D);
SQ_RSRC_IMG_2D :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D);
SQ_RSRC_IMG_3D :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_3D);
SQ_RSRC_IMG_CUBE :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_CUBE);
SQ_RSRC_IMG_1D_ARRAY :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_1D_ARRAY);
SQ_RSRC_IMG_2D_ARRAY :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D_ARRAY);
SQ_RSRC_IMG_2D_MSAA :Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D);
SQ_RSRC_IMG_2D_MSAA_ARRAY:Result.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D_ARRAY);
else;
Assert(false);
end;
Result.dstSel.r:=_get_dst_sel_swizzle(PT^.dst_sel_x);
Result.dstSel.g:=_get_dst_sel_swizzle(PT^.dst_sel_y);
Result.dstSel.b:=_get_dst_sel_swizzle(PT^.dst_sel_z);
Result.dstSel.a:=_get_dst_sel_swizzle(PT^.dst_sel_w);
Case Result.cformat of
VK_FORMAT_R5G6B5_UNORM_PACK16:
begin
t:=Result.dstSel.r;
Result.dstSel.r:=Result.dstSel.b;
Result.dstSel.b:=t;
end;
else;
end;
if not _img_is_msaa(PT^._type) then
begin
Result.base_level:=PT^.base_level;
Result.last_level:=PT^.last_level;
end;
end;
function _get_xy_filter(b:Byte):TVkFilter;
begin
Case b of
TEX_XYFilter_Point :Result:=VK_FILTER_NEAREST;
TEX_XYFilter_Linear :Result:=VK_FILTER_LINEAR;
TEX_XYFilter_AnisoPoint :Result:=VK_FILTER_NEAREST;
TEX_XYFilter_AnisoLinear:Result:=VK_FILTER_LINEAR;
else
Result:=VK_FILTER_NEAREST;
end;
end;
function _get_mip_filter(b:Byte):TVkSamplerMipmapMode;
begin
Case b of
TEX_MipFilter_None :Result:=VK_SAMPLER_MIPMAP_MODE_NEAREST;
TEX_MipFilter_Point :Result:=VK_SAMPLER_MIPMAP_MODE_NEAREST;
TEX_MipFilter_Linear :Result:=VK_SAMPLER_MIPMAP_MODE_LINEAR;
TEX_MipFilter_Point_Aniso_Adj:Result:=VK_SAMPLER_MIPMAP_MODE_NEAREST;
else
Result:=VK_SAMPLER_MIPMAP_MODE_NEAREST;
end;
end;
function _get_clamp(b:Byte):TVkSamplerAddressMode;
begin
Case b of
SQ_TEX_WRAP :Result:=VK_SAMPLER_ADDRESS_MODE_REPEAT;
SQ_TEX_MIRROR :Result:=VK_SAMPLER_ADDRESS_MODE_MIRRORED_REPEAT;
SQ_TEX_CLAMP_LAST_TEXEL :Result:=VK_SAMPLER_ADDRESS_MODE_CLAMP_TO_EDGE;
SQ_TEX_MIRROR_ONCE_LAST_TEXEL :Result:=VK_SAMPLER_ADDRESS_MODE_MIRROR_CLAMP_TO_EDGE;
SQ_TEX_CLAMP_HALF_BORDER :Result:=VK_SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER;
SQ_TEX_MIRROR_ONCE_HALF_BORDER:Result:=VK_SAMPLER_ADDRESS_MODE_MIRROR_CLAMP_TO_EDGE;
SQ_TEX_CLAMP_BORDER :Result:=VK_SAMPLER_ADDRESS_MODE_CLAMP_TO_BORDER;
SQ_TEX_MIRROR_ONCE_BORDER :Result:=VK_SAMPLER_ADDRESS_MODE_MIRROR_CLAMP_TO_EDGE;
else
Result:=VK_SAMPLER_ADDRESS_MODE_REPEAT;
end;
end;
function _get_lod_bias(bias:word;sec:Byte):TVkFloat;
var
b,s:TVkFloat;
begin
b:=(-1*Tlod_bias_bits(bias).sign)+Tlod_bias_bits(bias).int+(Tlod_bias_bits(bias).frac/256);
s:=(-1*Tlod_bias_sec_bits(sec).sign)+Tlod_bias_sec_bits(sec).int+(Tlod_bias_sec_bits(sec).frac/16);
Result:=b+s;
end;
function _is_aniso_enabled(mag_filter,min_filter:Byte):TVkBool32;
begin
Result:=ord((mag_filter=TEX_XYFilter_AnisoPoint) or
(mag_filter=TEX_XYFilter_AnisoLinear) or
(min_filter=TEX_XYFilter_AnisoPoint) or
(min_filter=TEX_XYFilter_AnisoLinear));
end;
function _get_aniso_ratio(max_aniso_ratio:Byte):TVkFloat;
begin
Case max_aniso_ratio of
SQ_TEX_ANISO_RATIO_1 :Result:=1;
SQ_TEX_ANISO_RATIO_2 :Result:=2;
SQ_TEX_ANISO_RATIO_4 :Result:=4;
SQ_TEX_ANISO_RATIO_8 :Result:=8;
SQ_TEX_ANISO_RATIO_16:Result:=16;
else
Result:=0;
end;
end;
function _get_lod(w:Word):TVkFloat;
begin
Result:=Tlod_bits(w).int+(Tlod_bits(w).frac/256);
end;
//aniso_threshold:bit3; //Threshold before sampling anisotropically (enum)
//mc_coord_trunc:bit1;
//force_degamma:bit1; //Force de-gamma after filtering regardless of format
//aniso_bias:bit6; //Anisotropy bias factor; unsigned fixed point 1.5
//trunc_coord:bit1;
//disable_cube_wrap:bit1; //Disable sampling/filtering across face boundaries
//filter_mode:bit2; //LERP, min, or max filter; default: LERP
//perf_mip:bit4; //Bri-linear factor
//perf_z:bit4;
//z_filter:bit2; //Filter in Z coordinate direction for volume textures
//border_color_ptr:bit12; //Offset into global border color buffer
//border_color_type:bit2; //Opaque-black, transparent-black, white, or color ptr
//VkSamplerCustomBorderColorCreateInfoEXT
function _get_border_color(color_type:Byte):TVkBorderColor;
begin
Case color_type of
TEX_BorderColor_TransparentBlack:Result:=VK_BORDER_COLOR_FLOAT_TRANSPARENT_BLACK; //VK_BORDER_COLOR_INT_TRANSPARENT_BLACK
TEX_BorderColor_OpaqueBlack :Result:=VK_BORDER_COLOR_FLOAT_OPAQUE_BLACK; //VK_BORDER_COLOR_INT_OPAQUE_BLACK
TEX_BorderColor_OpaqueWhite :Result:=VK_BORDER_COLOR_FLOAT_OPAQUE_WHITE; //VK_BORDER_COLOR_INT_OPAQUE_WHITE
TEX_BorderColor_Register :Result:=VK_BORDER_COLOR_FLOAT_CUSTOM_EXT; //VK_BORDER_COLOR_INT_CUSTOM_EXT
else
Result:=VK_BORDER_COLOR_FLOAT_TRANSPARENT_BLACK;
end;
end;
function _get_ssharp_info(PS:PSSharpResource4):TVkSamplerCreateInfo;
begin
Result:=Default(TVkSamplerCreateInfo);
if (PS=nil) then Exit;
Result.sType:=VK_STRUCTURE_TYPE_SAMPLER_CREATE_INFO;
Result.magFilter:=_get_xy_filter(PS^.xy_mag_filter);
Result.minFilter:=_get_xy_filter(PS^.xy_min_filter);
Result.mipmapMode:=_get_mip_filter(PS^.mip_filter);
Result.addressModeU:=_get_clamp(PS^.clamp_x);
Result.addressModeV:=_get_clamp(PS^.clamp_y);
Result.addressModeW:=_get_clamp(PS^.clamp_z);
Result.mipLodBias:=_get_lod_bias(PS^.lod_bias,PS^.lod_bias_sec);
Result.anisotropyEnable:=_is_aniso_enabled(PS^.xy_mag_filter,PS^.xy_min_filter);
Result.maxAnisotropy:=_get_aniso_ratio(PS^.max_aniso_ratio);
Result.compareEnable:=ord(PS^.depth_compare_func<>SQ_TEX_DEPTH_COMPARE_NEVER);
Result.compareOp :=TVkCompareOp(PS^.depth_compare_func); //1:1
Result.minLod:=_get_lod(PS^.min_lod);
Result.maxLod:=_get_lod(PS^.max_lod);
Result.borderColor:=_get_border_color(PS^.border_color_type);
Result.unnormalizedCoordinates:=PS^.force_unorm_coords;
end;
end.

150
chip/ps4_tiling.pas
View File

@ -320,6 +320,29 @@ type
procedure getTiledElementByteOffset_2d_32(var outTiledByteOffset:QWORD;x,y,z:DWORD);
end;
Tiler1d=object
m_minGpuMode:DWORD;
m_tileMode:DWORD;
m_arrayMode:DWORD;
m_linearWidth:DWORD;
m_linearHeight:DWORD;
m_linearDepth:DWORD;
m_paddedWidth:DWORD;
m_paddedHeight:DWORD;
m_paddedDepth:DWORD;
m_bitsPerElement:DWORD;
m_linearSizeBytes:DWORD;
m_tiledSizeBytes:DWORD;
m_microTileMode:DWORD;
m_tileThickness:DWORD;
m_tileBytes:DWORD;
m_tilesPerRow:DWORD;
m_tilesPerSlice:DWORD;
function getTiledElementBitOffset(var outTiledBitOffset:QWORD;x,y,z:DWORD):integer;
end;
{
m_minGpuMode:1
m_tileMode:10
@ -356,6 +379,47 @@ type
m_pipeSwizzleMask:0
}
const
Texture2d_32:Tiler1d=(
m_minGpuMode:0 ;
m_tileMode:13 ;
m_arrayMode:2 ;
m_linearWidth:8 ;
m_linearHeight:8 ;
m_linearDepth:1 ;
m_paddedWidth:8 ;
m_paddedHeight:8 ;
m_paddedDepth:1 ;
m_bitsPerElement:32 ;
m_linearSizeBytes:256;
m_tiledSizeBytes:256 ;
m_microTileMode:1 ;
m_tileThickness:1 ;
m_tileBytes:256 ;
m_tilesPerRow:1 ;
m_tilesPerSlice:1 ;
);
Texture2d_8:Tiler1d=(
m_minGpuMode:0 ;
m_tileMode:13 ;
m_arrayMode:2 ;
m_linearWidth:8 ;
m_linearHeight:8 ;
m_linearDepth:1 ;
m_paddedWidth:32 ;
m_paddedHeight:8 ;
m_paddedDepth:1 ;
m_bitsPerElement:8 ;
m_linearSizeBytes:64;
m_tiledSizeBytes:256;
m_microTileMode:1 ;
m_tileThickness:1 ;
m_tileBytes:64 ;
m_tilesPerRow:4 ;
m_tilesPerSlice:4 ;
);
const
Tiler2d_1280_720_32:Tiler2d=(
m_minGpuMode:0 ;
@ -1405,6 +1469,9 @@ const
procedure detile32bppDisplaySse2(dst,src:Pointer;destPitch:DWORD); assembler; MS_ABI_CDecl;
procedure detile32bppBuf(var T:Tiler2d;src,dst:Pointer);
function getMicroTileMode(outMicroTileMode:PByte;tmode:Byte):Integer;
Function computeSurfaceMacroTileMode(outMacroTileMode:PByte;tileMode,bitsPerElement,numFragmentsPerPixel:Byte):Integer;
implementation
function GetTiler2d(Width,m_bitsPerElement:DWORD):Tiler2d;
@ -2128,6 +2195,62 @@ begin
Result:=0;
end;
{
int32_t sce::GpuAddress::TilingParameters::initFromTexture(const Gnm::Texture *texture, uint32_t mipLevel, uint32_t arraySlice)
SCE_GNM_ASSERT_MSG_RETURN(texture != 0, kStatusInvalidArgument, "texture must not be NULL.");
SCE_GNM_ASSERT_MSG_RETURN(mipLevel <= texture->getLastMipLevel(), kStatusInvalidArgument, "mipLevel (%u) is out of range for texture; last level is %u", mipLevel, texture->getLastMipLevel());
bool isCubemap = (texture->getTextureType() == Gnm::kTextureTypeCubemap);
bool isVolume = (texture->getTextureType() == Gnm::kTextureType3d);
// Building surface flags manually is error-prone, but we don't know exactly what type of texture this is.
m_surfaceFlags.m_value = 0;
Gnm::MicroTileMode microTileMode;
int32_t status = getMicroTileMode(&microTileMode, texture->getTileMode());
if (status != kStatusSuccess)
return status;
m_surfaceFlags.m_depthTarget = (!isVolume && (microTileMode == Gnm::kMicroTileModeDepth) && (texture->getDataFormat().getZFormat() != Gnm::kZFormatInvalid)) ? 1 : 0;
m_surfaceFlags.m_stencilTarget = (!isVolume && (microTileMode == Gnm::kMicroTileModeDepth) && (texture->getDataFormat().getStencilFormat() != Gnm::kStencilInvalid)) ? 1 : 0;
m_surfaceFlags.m_cube = isCubemap ? 1 : 0;
m_surfaceFlags.m_volume = isVolume ? 1 : 0;
m_surfaceFlags.m_pow2Pad = texture->isPaddedToPow2() ? 1 : 0;
if (texture->getMinimumGpuMode() == Gnm::kGpuModeNeo)
{
m_surfaceFlags.m_texCompatible = 1;
}
m_tileMode = texture->getTileMode(); // see below, though
m_minGpuMode = texture->getMinimumGpuMode();
Gnm::DataFormat dataFormat = texture->getDataFormat();
m_bitsPerFragment = dataFormat.getTotalBitsPerElement() / dataFormat.getTexelsPerElement();
m_isBlockCompressed = (dataFormat.getTexelsPerElement() > 1);
m_tileSwizzleMask = texture->getTileSwizzleMask();
m_linearWidth = std::max(texture->getWidth() >> mipLevel, 1U);
m_linearHeight = std::max(texture->getHeight() >> mipLevel, 1U);
m_linearDepth = m_surfaceFlags.m_volume ? std::max(texture->getDepth() >> mipLevel, 1U) : 1;
m_numFragmentsPerPixel = 1 << texture->getNumFragments();
m_baseTiledPitch = texture->getPitch();
m_mipLevel = mipLevel;
SCE_GNM_ASSERT_MSG_RETURN(arraySlice == 0 || !m_surfaceFlags.m_volume, kStatusInvalidArgument, "for volume textures, arraySlice must be 0."); // volume textures can't be arrays
uint32_t arraySliceCount = texture->getTotalArraySliceCount();
if (isCubemap)
arraySliceCount *= 6; // Cube maps store 6 faces per array slice
else if (isVolume)
arraySliceCount = 1;
if (texture->isPaddedToPow2())
arraySliceCount = nextPowerOfTwo(arraySliceCount); // array slice counts are padded to a power of two as well
SCE_GNM_ASSERT_MSG_RETURN(arraySlice < arraySliceCount, kStatusInvalidArgument, "arraySlice (%u) is out of range for texture (0x%p) with %u slices.", arraySlice, texture, arraySliceCount);
m_arraySlice = arraySlice;
// Use computeSurfaceInfo() to determine what array mode we REALLY need to use, since it's occasionally not the one the Texture uses.
// (e.g. for a 2D-tiled texture, the smaller mip levels will implicitly use a 1D array mode to cut down on wasted padding space)
SurfaceInfo surfInfoOut = {0};
status = computeSurfaceInfo(&surfInfoOut, this);
if (status != kStatusSuccess)
return status;
status = adjustTileMode(m_minGpuMode, &m_tileMode, m_tileMode, surfInfoOut.m_arrayMode);
if (status != kStatusSuccess)
return status;
return kStatusSuccess;
}
function TilingParameters.initFromRenderTarget(var target:TRENDER_TARGET;arraySlice:DWORD):Integer;
var
@ -2475,6 +2598,33 @@ begin
Result:=bank;
end;
function Tiler1d.getTiledElementBitOffset(var outTiledBitOffset:QWORD;x,y,z:DWORD):integer;
var
element_index:QWORD;
slice_offset:QWORD;
tile_row_index:QWORD;
tile_column_index:QWORD;
tile_offset:QWORD;
element_offset:QWORD;
final_offset:QWORD;
begin
element_index := getElementIndex(x, y, z, m_bitsPerElement, m_microTileMode, m_arrayMode);
slice_offset := (z div m_tileThickness) * m_tilesPerSlice * m_tileBytes;
tile_row_index := y div kMicroTileHeight;
tile_column_index := x div kMicroTileWidth;
tile_offset := ((tile_row_index * m_tilesPerRow) + tile_column_index) * m_tileBytes;
element_offset := element_index * m_bitsPerElement;
final_offset := (slice_offset + tile_offset)*8 + element_offset;
outTiledBitOffset := final_offset;
Result:=0;
end;
function Tiler2d.init(var tp:TilingParameters):integer;
begin
if @tp=nil then Exit(-$7f2d0000);

1582
chip/ps4_videodrv.pas
View File

File diff suppressed because it is too large Load Diff

182
chip/shader_dump.pas
View File

@ -19,9 +19,9 @@ type
Function FastHash(data:PByte;len:DWORD):DWORD;
Procedure DUMP_BLOCK(F:THandle;REG:WORD;P:Pointer;Size:DWORD);
Procedure DumpCS(var GPU_REGS:TGPU_REGS);
Procedure DumpPS(var GPU_REGS:TGPU_REGS);
Procedure DumpVS(var GPU_REGS:TGPU_REGS);
function DumpCS(var GPU_REGS:TGPU_REGS):RawByteString;
function DumpPS(var GPU_REGS:TGPU_REGS):RawByteString;
function DumpVS(var GPU_REGS:TGPU_REGS):RawByteString;
implementation
@ -93,64 +93,109 @@ begin
FileWrite(F,P^,System.Align(Size,4));
end;
function getCodeAddress(lo,hi:DWORD):Pointer;
begin
Result:=Pointer(((QWORD(hi) shl 40) or (QWORD(lo) shl 8)));
end;
function getFetchAddress(P:PDWORD):Pointer;
begin
Result:=Pointer(((QWORD(P[1]) shl 32) or (QWORD(P[0]) and (not 3))));
end;
type
TUSER_DATA_USEAGE=array[0..15] of Byte;
Procedure _calc_usage(info:PShaderBinaryInfo;var USER_DATA:TSPI_USER_DATA;var USEAGE_DATA:TUSER_DATA_USEAGE);
function _calc_usage(info:PShaderBinaryInfo;USER_DATA:PDWORD):TUSER_DATA_USEAGE;
var
i:Integer;
Slots:PInputUsageSlot;
r:Byte;
begin
USEAGE_DATA:=Default(TUSER_DATA_USEAGE);
Result:=Default(TUSER_DATA_USEAGE);
if (info<>nil) then
begin
Slots:=_calc_shader_slot(info);
if (Slots<>nil) then
For i:=0 to info^.numInputUsageSlots-1 do
if (Slots[i].m_usageType=kShaderInputUsageSubPtrFetchShader) then
begin
r:=Slots[i].m_startRegister;
Assert(r<15);
USEAGE_DATA[r]:=2;
USEAGE_DATA[r+1]:=1;
Case Slots[i].m_usageType of
kShaderInputUsageSubPtrFetchShader:
begin
r:=Slots[i].m_startRegister;
Assert(r<15);
Result[r]:=2; //getFetchAddress
Result[r+1]:=1; //skip
end;
kShaderInputUsagePtrResourceTable,
kShaderInputUsagePtrInternalResourceTable,
kShaderInputUsagePtrSamplerTable,
kShaderInputUsagePtrConstBufferTable,
kShaderInputUsagePtrVertexBufferTable,
kShaderInputUsagePtrSoBufferTable,
kShaderInputUsagePtrRwResourceTable,
kShaderInputUsagePtrInternalGlobalTable,
kShaderInputUsagePtrExtendedUserData,
kShaderInputUsagePtrIndirectResourceTable,
kShaderInputUsagePtrIndirectInternalResourceTable,
kShaderInputUsagePtrIndirectRwResourceTable:
begin
r:=Slots[i].m_startRegister;
Assert(r<15);
Result[r]:=3; //getBufferAddress
Result[r+1]:=1; //skip
end;
end;
end;
For i:=0 to 15 do
if (USEAGE_DATA[i]=0) and (USER_DATA[i]=0) then
if (Result[i]=0) and (USER_DATA[i]=0) then
begin
USEAGE_DATA[i]:=1;
Result[i]:=1;
end;
end;
Procedure DumpCS(var GPU_REGS:TGPU_REGS);
Procedure DUMP_USER_DATA(F:THandle;base:Pointer;REG:WORD;USER_DATA:PDWORD);
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
F:THandle;
fname:RawByteString;
buf:Pointer;
size:DWORD;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
USEAGE_DATA:=_calc_usage(_calc_shader_info(base),USER_DATA);
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,REG+i,@USER_DATA[i],SizeOf(DWORD));
2:
begin
buf:=getFetchAddress(USER_DATA[i],USER_DATA[i+1]);
if (buf<>nil) then
begin
size:=_calc_shader_size(buf,0,True);
DUMP_BLOCK(F,REG+i,buf,size);
end;
end;
3:
begin
buf:=getBufferAddress(USER_DATA[i],USER_DATA[i+1]);
if (buf<>nil) then
begin
size:=256; //size is unknow
DUMP_BLOCK(F,REG+i,buf,size);
end;
end;
end;
end;
end;
function DumpCS(var GPU_REGS:TGPU_REGS):RawByteString;
var
size,hash:DWORD;
base:Pointer;
F:THandle;
fname:RawByteString;
begin
Result:='';
base:=getCodeAddress(GPU_REGS.SPI.CS.LO,GPU_REGS.SPI.CS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.CS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_cs_'+HexStr(hash,8)+'.dump';
Result:=fname;
if FileExists(fname) then Exit;
CreateDir('shader_dump');
F:=FileCreate(fname);
@ -163,21 +208,7 @@ begin
DUMP_BLOCK(F,mmCOMPUTE_NUM_THREAD_Y,@GPU_REGS.SPI.CS.NUM_THREAD_Y,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_NUM_THREAD_Z,@GPU_REGS.SPI.CS.NUM_THREAD_Z,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmCOMPUTE_USER_DATA_0+i,@GPU_REGS.SPI.CS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.CS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmCOMPUTE_USER_DATA_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_USER_DATA(F,base,mmCOMPUTE_USER_DATA_0,@GPU_REGS.SPI.CS.USER_DATA);
DUMP_BLOCK(F,mmCOMPUTE_STATIC_THREAD_MGMT_SE0,@GPU_REGS.SPI.CS.STATIC_THREAD_MGMT_SE0,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_STATIC_THREAD_MGMT_SE1,@GPU_REGS.SPI.CS.STATIC_THREAD_MGMT_SE1,SizeOf(DWORD));
@ -188,24 +219,25 @@ begin
end;
end;
Procedure DumpPS(var GPU_REGS:TGPU_REGS);
function DumpPS(var GPU_REGS:TGPU_REGS):RawByteString;
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
base:Pointer;
F:THandle;
fname:RawByteString;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
Result:='';
base:=getCodeAddress(GPU_REGS.SPI.PS.LO,GPU_REGS.SPI.PS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.PS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_ps_'+HexStr(hash,8)+'.dump';
Result:=fname;
if FileExists(fname) then Exit;
CreateDir('shader_dump');
F:=FileCreate(fname);
@ -227,48 +259,36 @@ begin
DUMP_BLOCK(F,mmDB_SHADER_CONTROL ,@GPU_REGS.SPI.PS.SHADER_CONTROL,SizeOf(DWORD));
DUMP_BLOCK(F,mmCB_SHADER_MASK ,@GPU_REGS.SPI.PS.SHADER_MASK ,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_PS_0+i,@GPU_REGS.SPI.PS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.PS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_PS_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_USER_DATA(F,base,mmSPI_SHADER_USER_DATA_PS_0,@GPU_REGS.SPI.PS.USER_DATA);
DUMP_BLOCK(F,mmSPI_PS_INPUT_CNTL_0,@GPU_REGS.SPI.PS.INPUT_CNTL_0,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_PS_INPUT_CNTL_1,@GPU_REGS.SPI.PS.INPUT_CNTL_1,SizeOf(DWORD));
For i:=0 to 31 do
begin
DUMP_BLOCK(F,mmSPI_PS_INPUT_CNTL_0+i,@GPU_REGS.SPI.PS.INPUT_CNTL[i],SizeOf(DWORD));
end;
FileClose(F);
end;
end;
Procedure DumpVS(var GPU_REGS:TGPU_REGS);
function DumpVS(var GPU_REGS:TGPU_REGS):RawByteString;
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
base:Pointer;
F:THandle;
fname:RawByteString;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
Result:='';
base:=getCodeAddress(GPU_REGS.SPI.VS.LO,GPU_REGS.SPI.VS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.VS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_vs_'+HexStr(hash,8)+'.dump';
Result:=fname;
if FileExists(fname) then Exit;
CreateDir('shader_dump');
F:=FileCreate(fname);
@ -282,21 +302,7 @@ begin
DUMP_BLOCK(F,mmSPI_SHADER_POS_FORMAT,@GPU_REGS.SPI.VS.POS_FORMAT,SizeOf(DWORD));
DUMP_BLOCK(F,mmPA_CL_VS_OUT_CNTL ,@GPU_REGS.SPI.VS.OUT_CNTL ,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_VS_0+i,@GPU_REGS.SPI.VS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.VS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_VS_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_USER_DATA(F,base,mmSPI_SHADER_USER_DATA_VS_0,@GPU_REGS.SPI.VS.USER_DATA);
DUMP_BLOCK(F,mmVGT_NUM_INSTANCES ,@GPU_REGS.VGT_NUM_INSTANCES,SizeOf(DWORD));

106
fpPS4.lpi
View File

@ -1,16 +1,16 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpPS4"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
@ -24,14 +24,13 @@
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="15">
<Units Count="35">
<Unit0>
<Filename Value="fpPS4.lpr"/>
<IsPartOfProject Value="True"/>
@ -97,6 +96,89 @@
<Filename Value="vulkan\vRender.pas"/>
<IsPartOfProject Value="True"/>
</Unit14>
<Unit15>
<Filename Value="ps4_libkernel\ps4_event_flag.pas"/>
<IsPartOfProject Value="True"/>
</Unit15>
<Unit16>
<Filename Value="shaderext.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ShaderExt"/>
</Unit16>
<Unit17>
<Filename Value="vSetLayoutPool.pas"/>
<IsPartOfProject Value="True"/>
</Unit17>
<Unit18>
<Filename Value="vpipelinelayoutpool.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="vPipelineLayoutPool"/>
</Unit18>
<Unit19>
<Filename Value="vulkan\vSetsPool.pas"/>
<IsPartOfProject Value="True"/>
</Unit19>
<Unit20>
<Filename Value="vulkan\vCmdBuffer.pas"/>
<IsPartOfProject Value="True"/>
</Unit20>
<Unit21>
<Filename Value="vulkan\vHostBufferPool.pas"/>
<IsPartOfProject Value="True"/>
</Unit21>
<Unit22>
<Filename Value="vulkan\vImagePool.pas"/>
<IsPartOfProject Value="True"/>
</Unit22>
<Unit23>
<Filename Value="vulkan\vBuffer.pas"/>
<IsPartOfProject Value="True"/>
</Unit23>
<Unit24>
<Filename Value="vulkan\vSamplerPool.pas"/>
<IsPartOfProject Value="True"/>
</Unit24>
<Unit25>
<Filename Value="vulkan\vSampler.pas"/>
<IsPartOfProject Value="True"/>
</Unit25>
<Unit26>
<Filename Value="vulkan\vShaderManager.pas"/>
<IsPartOfProject Value="True"/>
</Unit26>
<Unit27>
<Filename Value="vulkan\vImageTiling.pas"/>
<IsPartOfProject Value="True"/>
</Unit27>
<Unit28>
<Filename Value="trace_manager.pas"/>
<IsPartOfProject Value="True"/>
</Unit28>
<Unit29>
<Filename Value="ps4_libkernel\ps4_signal.pas"/>
<IsPartOfProject Value="True"/>
</Unit29>
<Unit30>
<Filename Value="ps4_libkernel\regs_context.pas"/>
<IsPartOfProject Value="True"/>
</Unit30>
<Unit31>
<Filename Value="ps4_libkernel\kernel.pas"/>
<IsPartOfProject Value="True"/>
</Unit31>
<Unit32>
<Filename Value="ps4_libkernel\pthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="sys_pthread"/>
</Unit32>
<Unit33>
<Filename Value="ps4_libkernel\sys_signal.pas"/>
<IsPartOfProject Value="True"/>
</Unit33>
<Unit34>
<Filename Value="sys\sys_time.pas"/>
<IsPartOfProject Value="True"/>
</Unit34>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -107,7 +189,8 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="ps4_libkernel;vulkan;chip"/>
<Libraries Value="static"/>
<OtherUnitFiles Value="rtl;sys;ps4_libkernel;vulkan;chip;spirv"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
@ -119,13 +202,20 @@
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<TargetCPU Value="x86_64"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2Set"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-dUSE_STATIC_PORTAUDIO
-CfAVX
-CpCOREAVX
-OpCOREAVX
-Sv"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">

178
fpPS4.lpr
View File

@ -4,10 +4,15 @@ uses
cmem,
cthreads,
{$ENDIF}
windows,
seh64,
Classes,sysutils,
Classes,
sysutils,
stub_manager,
sys_types,
sys_pthread,
ps4libdoc,
ps4_libSceAppContent,
ps4_libSceNet,
ps4_libSceHttp,
ps4_libSceGnmDriver,
@ -22,11 +27,12 @@ uses
ps4_libSceVideoOut,
ps4_libScePad,
ps4_libkernel,
ps4_types,
ps4_elf,
ps4_pthread,
ps4_program,
ps4_elf_tls;
ps4_elf_tls,
trace_manager;
function ParseCmd:Boolean;
var
@ -129,10 +135,11 @@ asm
xor %rax,%rax
end;
procedure print_stub(nid:QWORD;lib:PLIBRARY);
procedure print_stub(nid:QWORD;lib:PLIBRARY); MS_ABI_Default;
begin
Writeln('nop nid:',lib^.strName,':',HexStr(nid,16),':',ps4libdoc.GetFunctName(nid));
writeln;
DebugBreak;
Sleep(INFINITE);
//readln;
//Print_libs(ps4_app.GetFile('libc.prx'));
end;
@ -143,6 +150,47 @@ begin
Result:=3;
end;
function ps4_sceNpWebApiInitialize(libHttpCtxId:Integer;poolSize:size_t):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpWebApiInitialize:',libHttpCtxId,':',poolSize);
Result:=4;
end;
const
SCE_DISC_MAP_ERROR_INVALID_ARGUMENT=-2129657855; //0x81100001
function ps4_sceDiscMapIsRequestOnHDD(param1:PChar;param2,param3:Int64;param4:PInteger):Integer; SysV_ABI_CDecl;
begin
if (param1=nil) or (param4=nil) then Exit(SCE_DISC_MAP_ERROR_INVALID_ARGUMENT);
param4^:=1;
Result:=0;
end;
function ps4_8A828CAEE7EDD5E9(param1:PChar;param2,param3:Int64;param4,param5,param6:PInt64):Integer; SysV_ABI_CDecl;
begin
param4^:=0;
param5^:=0;
param6^:=0;
Result:=0;
end;
function ps4_sceMoveInit:Integer; SysV_ABI_CDecl;
begin
Writeln('sceMoveInit');
Result:=0;
end;
function ps4_sceScreenShotSetOverlayImageWithOrigin(
filePath:PChar;
marginX:Integer;
marginY:Integer;
origin:Integer //SceScreenShotOrigin
):Integer; SysV_ABI_CDecl;
begin
Writeln('sceScreenShotSetOverlayImageWithOrigin:',filePath);
Result:=0;
end;
function ResolveImport(elf:Telf_file;Info:PResolveImportInfo;data:Pointer):Pointer;
var
lib:PLIBRARY;
@ -163,18 +211,56 @@ begin
Result:=lib^.get_proc(Info^.Nid);
end;
//if (lib<>nil) then
//if (lib^.strName='mono-ps4') then
//begin
// Writeln(Info^.pName);
//
// if Info^.nid=$4FCEF2B219D790C5 then
// begin
// writeln;
// end;
//
//end;
if (Result=nil) then
begin
Case Info^.lib^.strName of
'libSceSsl':
Case Info^.nid of
$85DA551140C55B7B:Result:=@ps4_sceSslInit;
QWORD($85DA551140C55B7B):Result:=@ps4_sceSslInit;
end;
'libSceNpWebApi':
Case Info^.nid of
QWORD($1B70272CD7510631):Result:=@ps4_sceNpWebApiInitialize;
end;
'libSceDiscMap':
Case Info^.nid of
QWORD($95B40AAAC11186D1):Result:=@ps4_sceDiscMapIsRequestOnHDD;
QWORD($8A828CAEE7EDD5E9):Result:=@ps4_8A828CAEE7EDD5E9;
end;
'libSceMove':
Case Info^.nid of
QWORD($8F521313F1282661):Result:=@ps4_sceMoveInit;
end;
'libSceScreenShot':
Case Info^.nid of
QWORD($EF7590E098F49C92):Result:=@ps4_sceScreenShotSetOverlayImageWithOrigin;
end;
end;
end;
//if (Result<>nil) and (Info^.sType=STT_FUN) then //trace
//begin
// Result:=TStubMemoryTrace(Stub).NewTraceStub(Info^.Nid,Info^.lib,Result,@_trace_enter,@_trace_exit);
//end;
if (Result=nil) then
begin
if (Info^.sType=STT_FUN) then
@ -201,6 +287,38 @@ begin
end;
end;
function ReloadImport(elf:Telf_file;Info:PResolveImportInfo;data:Pointer):Pointer;
var
node:Telf_file;
lib:PLIBRARY;
begin
//prev
Result:=Info^.lib^.get_proc(Info^.nid);
node:=Telf_file(data);
lib:=ps4_app.GetLib(Info^.lib^.strName);
if (lib=nil) then Exit;
//if (lib^.strName='mono-ps4') then
//begin
// Writeln(Info^.pName);
//
// if Info^.nid=$4FCEF2B219D790C5 then
// begin
// writeln;
// end;
//
//end;
if (lib^.parent<>node) then Exit;
Result:=lib^.get_proc(Info^.Nid);
//cache
Info^.lib^.set_proc(Info^.nid,Result);
end;
var
elf:Telf_file;
//i:Integer;
@ -208,6 +326,8 @@ var
main:pthread;
//label
// _lab;
begin
DefaultSystemCodePage:=CP_UTF8;
@ -230,6 +350,15 @@ begin
//ps4_app.app_path:='..\samples\tutorial_graphics_programming\basic_quad\';
//ps4_app.app_file:='..\samples\tutorial_graphics_programming\basic_quad\basic_quad_debug.elf';
//ps4_app.app_path:='..\samples\tutorial_anti-aliasing\';
//ps4_app.app_file:='..\samples\tutorial_anti-aliasing\tutorial_anti-aliasing_debug.elf';
//ps4_app.app_path:='..\samples\tutorial_graphics_programming\basic-compute\';
//ps4_app.app_file:='..\samples\tutorial_graphics_programming\basic-compute\basic-compute_debug.elf';
//ps4_app.app_path:='..\samples\api_gnm';
//ps4_app.app_file:='..\samples\api_gnm\drawindirect-sample\drawindirect-sample_debug.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_cursor.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_flip.elf';
@ -238,15 +367,41 @@ begin
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic3.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic5.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic_1d.elf';
//ps4_app.app_path:='..\samples\http_get\';
//ps4_app.app_file:='..\samples\http_get\simple4.elf';
//ps4_app.app_path:='G:\Games\MOMODORA\CUSA05694\';
//ps4_app.app_file:='G:\Games\MOMODORA\CUSA05694\eboot.bin';
//ps4_app.app_path:='C:\Users\User\Desktop\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\';
//ps4_app.app_file:='C:\Users\User\Desktop\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\eboot.bin';
//ps4_app.app_path:='G:\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\';
//ps4_app.app_file:='G:\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\eboot.elf';
//ps4_app.app_file:='G:\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\eboot.bin';
//Writeln(_parse_filename('/app0/data/system_ps4/flatShader_vv.sb'));
//ps4_app.app_path:='C:\Users\User\Desktop\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\';
//ps4_app.app_file:='C:\Users\User\Desktop\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\eboot.bin';
//Writeln(_parse_filename('savedata0/11/../app.prf'));
//ps4_app.app_path:='C:\Users\User\Desktop\Games\Organ.Trail.Complete.Edition\CUSA02791\';
//ps4_app.app_file:='C:\Users\User\Desktop\Games\Organ.Trail.Complete.Edition\CUSA02791\eboot.bin';
//ps4_app.app_path:='G:\Games\Organ.Trail.Complete.Edition\CUSA02791\';
//ps4_app.app_file:='G:\Games\Organ.Trail.Complete.Edition\CUSA02791\eboot.bin';
//ps4_app.app_path:='G:\Games\Bloodborne Game of the Year Edition v1.09 [RUS]\';
//ps4_app.app_file:='G:\Games\Bloodborne Game of the Year Edition v1.09 [RUS]\eboot.bin';
//ps4_app.app_path:='G:\Games\BLAZING_CHROME\CUSA14656\';
//ps4_app.app_file:='G:\Games\BLAZING_CHROME\CUSA14656\eboot.bin';
//ps4_app.app_path:='G:\Games\Sonic Mania\CUSA07023\';
//ps4_app.app_file:='G:\Games\Sonic Mania\CUSA07023\eboot.bin';
ps4_app.app_path:='C:\Users\User\Desktop\Games\Sonic Mania\CUSA07023\';
ps4_app.app_file:='C:\Users\User\Desktop\Games\Sonic Mania\CUSA07023\eboot.bin';
//elf:=Telf_file(LoadPs4ElfFromFile('libSceLibcInternal.sprx'));
//elf.Prepare;
@ -256,17 +411,20 @@ begin
//FileClose(F);
//FreeAndNil(elf);
ps4_app.resolve_cb:=@ResolveImport;
ps4_app.reload_cb :=@ReloadImport;
elf:=Telf_file(LoadPs4ElfFromFile(ps4_app.app_file));
elf.Prepare;
ps4_app.prog:=elf;
ps4_app.RegistredElf(elf);
ps4_app.ResolveDepended(elf);
ps4_app.LoadSymbolImport(@ResolveImport,nil);
ps4_app.LoadSymbolImport(nil);
Stub.FinStub;
ps4_app.InitProt;
ps4_app.InitThread;
ps4_app.InitThread(1);
_pthread_run_entry(@main);

332
ps4_elf.pas
View File

@ -6,9 +6,9 @@ interface
uses
Windows,
hamt,
sha1,
ps4_types,
sys_types,
sys_kernel,
ps4libdoc,
ps4_program,
ps4_elf_tls,
@ -173,10 +173,15 @@ type
offset:QWORD;
stub:TMemChunk;
//hTls:DWORD;
end;
//pModule:packed record
// pStart:QWORD;
// pStop:QWORD;
//end;
dtInit:QWORD;
pInit:packed record
dt_preinit_array,
dt_preinit_array_count:QWORD;
@ -184,7 +189,7 @@ type
dt_init_array_count:QWORD;
end;
pFiniProc:Pointer;
dtFini:QWORD;
pSceDynLib:TMemChunk; //mElf
@ -237,15 +242,23 @@ type
function SavePs4ElfToFile(Const name:RawByteString):Boolean;
function Prepare:Boolean; override;
Procedure LoadSymbolImport(cbs,data:Pointer); override;
Procedure ReLoadSymbolImport(cbs,data:Pointer); override;
function DympSymbol(F:THandle):Boolean;
procedure InitThread; override;
procedure InitThread(is_static:QWORD); override;
Procedure InitProt; override;
Procedure InitCode; override;
function module_start(argc:size_t;argp:PPointer):Integer; override;
function GetCodeFrame:TMemChunk; override;
function GetEntryPoint:Pointer; override;
Function GetModuleInfo:TKernelModuleInfo; override;
procedure mapCodeEntry;
end;
type
TinitProc =function(argc:Integer;argv,environ:PPchar):Integer; SysV_ABI_CDecl; //preinit_array/init_array
TEntryPoint =procedure(pEnv:Pointer;pfnExitHandler:Pointer); SysV_ABI_CDecl; //EntryPoint
TmoduleStart=function(argc:size_t;argp:Pointer):Integer; SysV_ABI_CDecl; //module_start/module_stop
function LoadPs4ElfFromFile(Const name:RawByteString):TElf_node;
function ps4_nid_hash(const name:RawByteString):QWORD;
@ -262,35 +275,41 @@ implementation
type
Ppatch_ld=^Tpatch_ld;
Tpatch_ld=packed record
_movabs_rax:array[0..1] of Byte; // $48 $B8 //2
//_movabs_rax:array[0..1] of Byte; // $48 $B8 //2
_addr:Pointer; //8
_jmp_rax:array[0..1] of Byte; // $FF $E0 //2 = 14
//_jmp_rax:array[0..1] of Byte; // $FF $E0 //2 = 14
end;
Ppatch_fs=^Tpatch_fs;
Tpatch_fs=packed record
_push_rdx:Byte; // $52 //1
_push_rcx:Byte; // $51 //1
_call_32:Byte; // $E8 //1
_call_rip:array[0..1] of Byte; //$ff $15
//_push_rdx:Byte; // $52 //1
//_push_rcx:Byte; // $51 //1
//_call_32:Byte; // $E8 //1
_ofs:Integer; //4
_pop_rcx:Byte; // $59 //1
_pop_rdx:Byte; // $5a //1 = 9
//_pop_rcx:Byte; // $59 //1
//_pop_rdx:Byte; // $5a //1 = 9
_nop:array[0..2] of Byte; //$90 $90 $90
end;
//ff 15 [d3 ff ff ff]
Const
_patch_ld:Tpatch_ld=(
_movabs_rax:($48,$B8);
//_movabs_rax:($48,$B8);
_addr:nil;
_jmp_rax:($FF,$E0);
//_jmp_rax:($FF,$E0);
);
_patch_fs:Tpatch_fs=(
_push_rdx:$52;
_push_rcx:$51;
_call_32:$E8;
_call_rip:($ff,$15);
//_push_rcx:$51;
//_push_rdx:$52;
//_call_32:$E8;
_ofs:0;
_pop_rcx:$59;
_pop_rdx:$5a;
//_pop_rdx:$5a;
//_pop_rcx:$59;
_nop:($90,$90,$90);
);
Procedure Telf_file.ClearElfFile;
@ -677,7 +696,13 @@ begin
begin
end;
PT_GNU_EH_FRAME:
begin
end;
else
Writeln('PHDR:',HexStr(elf_phdr[i].p_type,16));
end;
@ -733,6 +758,7 @@ begin
DT_INIT:
begin
dtInit:=entry.d_un.d_ptr;
Writeln('INIT addr:',entry.d_un.d_ptr);
end;
DT_INIT_ARRAY:
@ -748,7 +774,7 @@ begin
DT_FINI:
begin
pFiniProc:=Pointer(entry.d_un.d_ptr);
dtFini:=entry.d_un.d_ptr;
Writeln('FINI addr:',HexStr(entry.d_un.d_ptr,16));
end;
DT_SCE_SYMTAB:
@ -1455,11 +1481,11 @@ begin
if (Info.shndx<>SHN_UNDEF) then
case Info.sType of
STT_NOTYPE :;
//STT_NOTYPE :;
STT_OBJECT :cbs(Self,@Info,data);
STT_FUN :cbs(Self,@Info,data);
STT_SECTION:;
STT_FILE :;
//STT_SECTION:;
//STT_FILE :;
STT_COMMON :cbs(Self,@Info,data);
STT_TLS :cbs(Self,@Info,data);
else
@ -1470,6 +1496,26 @@ begin
Result:=True;
end;
function _on_module_start_stop(pName:PChar):Integer;
begin
Result:=-1;
if (PQWORD(pName)^=$735F656C75646F6D) then //module_s
begin
Case PDWORD(@pName[8])^ of
$74726174: //tart
if (pName[$C]=#0) then
begin //module_start
Result:=0;
end;
$00706F74: //top0
begin //module_stop
Result:=1;
end;
else;
end;
end;
end;
Procedure OnLoadRelaExport(elf:Telf_file;Info:PRelaInfo;data:Pointer);
procedure _do_set(nSymVal:Pointer); inline;
@ -1492,6 +1538,31 @@ Procedure OnLoadRelaExport(elf:Telf_file;Info:PRelaInfo;data:Pointer);
begin
Import:=(Info^.shndx=SHN_UNDEF); //
case _on_module_start_stop(Info^.pName) of
0:begin //module_start
nSymVal:=elf.mMap.pAddr+elf.dtInit;
_do_set(nSymVal);
//IInfo.nid:=ps4_nid_hash(Info^.pName);
//IInfo.lib:=elf._get_lib(0);
//IInfo.lib^.set_proc(IInfo.nid,nSymVal);
Exit;
end;
1:begin //module_stop
nSymVal:=elf.mMap.pAddr+elf.dtFini;
_do_set(nSymVal);
//IInfo.nid:=ps4_nid_hash(Info^.pName);
//IInfo.lib:=elf._get_lib(0);
//IInfo.lib^.set_proc(IInfo.nid,nSymVal);
Exit;
end;
else;
end;
if Import then Exit;
IInfo:=Default(TResolveImportInfo);
@ -1613,6 +1684,20 @@ Procedure OnLoadRelaImport(elf:Telf_file;Info:PRelaInfo;data:Pointer);
begin
Import:=(Info^.shndx=SHN_UNDEF); //
if (_on_module_start_stop(Info^.pName)<>-1) then Exit;
//case _on_module_start_stop(Info^.pName) of
// 0:begin //module_start
// Writeln('module_start:',HexStr(PPointer(elf.mMap.pAddr+Info^.Offset)^));
// Exit;
// end;
// 1:begin //module_stop
// Exit;
// end;
// else;
//end;
if not Import then Exit;
IInfo:=Default(TResolveImportInfo);
@ -1727,10 +1812,14 @@ const
nModuleId,nLibraryId:Word;
Import:Boolean;
mss:Integer;
begin
Import:=(Info^.shndx=SHN_UNDEF);
mss:=_on_module_start_stop(Info^.pName);
if (mss<>-1) then Import:=False;
IInfo:=Default(TResolveImportInfo);
nModuleId:=0;
@ -1758,7 +1847,7 @@ const
Exit;
end;
if (IInfo.lib^.Import<>Import) then
if (IInfo.lib^.Import<>Import) and (mss=-1) then
begin
FWriteln('Wrong library ref:'+IInfo.lib^.strName+':'+BoolToStr(IInfo._md^.Import)+'<>'+BoolToStr(Import));
Exit;
@ -1861,10 +1950,86 @@ begin
FLoadImport:=True;
end;
Procedure Telf_file.ReLoadSymbolImport(cbs,data:Pointer);
var
_data:array[0..1] of Pointer;
begin
if (Self=nil) then Exit;
if not FLoadImport then Exit;
if (mMap.pAddr=nil) or (mMap.nSize=0) then Exit;
_data[0]:=cbs;
_data[1]:=data;
RelocateRelaEnum(@OnLoadRelaImport,@_data);
RelocatePltRelaEnum(@OnLoadRelaImport,@_data);
ParseSymbolsEnum(@OnLoadRelaImport,@_data);
end;
Procedure OnDumpInitProc(elf:Telf_file;F:THandle);
const
NL=#13#10;
procedure FWrite(Const str:RawByteString); inline;
begin
FileWrite(F,PChar(str)^,Length(str))
end;
procedure FWriteln(Const str:RawByteString); inline;
begin
FWrite(str+NL);
end;
var
i,c,o:SizeInt;
base:Pointer;
P:PPointer;
begin
FWriteln('e_entry:' +HexStr(elf.pEntryPoint,16));
base:=elf.mMap.pAddr;
FWriteln('dtInit:'+HexStr(elf.dtInit,16));
c:=elf.pInit.dt_preinit_array_count;
if (c<>0) then
Case Int64(elf.pInit.dt_preinit_array) of
-1,0,1:;//skip
else
begin
P:=base+elf.pInit.dt_preinit_array;
dec(c);
For i:=0 to c do
begin
o:=SizeInt(P[i])-SizeInt(base);
FWriteln('dt_preinit['+IntToStr(i)+']:' +HexStr(o,16));
end;
end;
end;
c:=elf.pInit.dt_init_array_count;
if (c<>0) then
Case Int64(elf.pInit.dt_init_array) of
-1,0,1:;//skip
else
begin
P:=base+elf.pInit.dt_init_array;
dec(c);
For i:=0 to c do
begin
o:=SizeInt(P[i])-SizeInt(base);
FWriteln('dt_init['+IntToStr(i)+']:' +HexStr(o,16));
end;
end;
end;
FWriteln('dtFini:'+HexStr(elf.dtFini,16));
end;
function Telf_file.DympSymbol(F:THandle):Boolean;
begin
Result:=False;
if (Self=nil) then Exit;
OnDumpInitProc(Self,F);
Result:=RelocateRelaEnum(@OnDumpRela,Pointer(F));
Result:=RelocatePltRelaEnum(@OnDumpRela,Pointer(F));
Result:=ParseSymbolsEnum(@OnDumpRela,Pointer(F));
@ -2071,7 +2236,7 @@ var
procedure do_patch(p:PByte); inline;
begin
_call._ofs:=Integer(PtrInt(Stub)-PtrInt(P)-PtrInt(@Tpatch_fs(nil^)._pop_rcx));
_call._ofs:=Integer(PtrInt(Stub)-PtrInt(P)-PtrInt(@Tpatch_fs(nil^).{_pop_rcx}_nop));
Ppatch_fs(p)^:=_call;
end;
@ -2107,6 +2272,7 @@ begin
Stub:=pTls.stub.pAddr;
do_find(@Addr[0],Size-0);
//Writeln('patch_tls_count=',c);
//do_find(@Addr[1],Size-1);
//Writeln('patch_tls_count=',c);
@ -2138,7 +2304,7 @@ begin
end;
end;
function _static_get_tls_adr:Pointer;
function _static_get_tls_adr:Pointer; MS_ABI_Default;
var
elf:Telf_file;
begin
@ -2150,6 +2316,8 @@ end;
function __static_get_tls_adr:Pointer; assembler; nostackframe;
asm
push %rcx
push %rdx
push %r8
push %r9
push %R10
@ -2161,12 +2329,14 @@ asm
pop %R10
pop %r9
pop %r8
pop %rdx
pop %rcx
end;
//R8, R9 R10
//, and R12–R15
//-not need:RCX,RAX,RBP,RSP
//-not need:
//-RAX:result
////-RCX,RDX:Tpatch_fs
//-other:win call save
//The registers RAX, RCX, RDX, R8, R9, R10, R11 are considered volatile (вызывающий сохраняет)
//The registers RBX, RBP, RDI, RSI, RSP, R12, R13, R14, and R15 are considered nonvolatile (вызываемый сохраняет)
@ -2213,12 +2383,42 @@ begin
end;
end;
procedure Telf_file.InitThread;
procedure Telf_file.InitThread(is_static:QWORD);
begin
if (Self=nil) then Exit;
if FInitThread then Exit;
if (pTls.full_size=0) then Exit;
if (_get_tls_tcb(Handle)<>nil) then Exit;
_init_tls(1);
_init_tls(is_static);
FInitThread:=True;
end;
function __map_segment_prot(prot:Integer):DWORD;
begin
Result:=0;
if (prot=0) then Exit(PAGE_NOACCESS);
if (prot and PF_X)<>0 then
begin
if (prot and PF_W)<>0 then
begin
Result:=PAGE_EXECUTE_READWRITE;
end else
if (prot and PF_R)<>0 then
begin
Result:=PAGE_EXECUTE_READ;
end else
begin
Result:=PAGE_EXECUTE;
end;
end else
if (prot and PF_W)<>0 then
begin
Result:=PAGE_READWRITE;
end else
begin
Result:=PAGE_READONLY;
end;
end;
procedure Telf_file.mapProt;
@ -2240,7 +2440,8 @@ begin
begin
R:=VirtualProtect(ModuleInfo.segmentInfo[i].address,
ModuleInfo.segmentInfo[i].Size,
PAGE_EXECUTE_READ,@dummy);
__map_segment_prot(ModuleInfo.segmentInfo[i].prot),
@dummy);
FlushInstructionCache(GetCurrentProcess,
ModuleInfo.segmentInfo[i].address,
@ -2258,8 +2459,15 @@ begin
//extra tls stub
if (pTls.stub.nSize=PHYSICAL_PAGE_SIZE) then
begin
R:=VirtualProtect(pTls.stub.pAddr,pTls.stub.nSize,PAGE_EXECUTE_READ,@dummy);
FlushInstructionCache(GetCurrentProcess,pTls.stub.pAddr,pTls.stub.nSize);
R:=VirtualProtect(pTls.stub.pAddr,
pTls.stub.nSize,
{PAGE_EXECUTE_READ}PAGE_EXECUTE_READWRITE,
@dummy);
FlushInstructionCache(GetCurrentProcess,
pTls.stub.pAddr,
pTls.stub.nSize);
Writeln('STUB:',HexStr(pTls.stub.pAddr),'..',HexStr(pTls.stub.pAddr+pTls.stub.nSize),':',R);
end else
//inline stub
@ -2270,8 +2478,6 @@ begin
end;
function call_dt_preinit_array(Params:PPS4StartupParams;Proc:Pointer):Integer;
type
TinitProc=function(argc:Integer;argv,environ:PPchar):Integer; SysV_ABI_CDecl;
begin
Result:=0;
if (Proc<>nil) then
@ -2282,8 +2488,6 @@ begin
end;
function call_dt_init_array(Params:PPS4StartupParams;Proc:Pointer):Integer;
type
TinitProc=function(argc:Integer;argv,environ:PPchar):Integer; SysV_ABI_CDecl;
begin
Result:=0;
if (Proc<>nil) then
@ -2305,7 +2509,7 @@ begin
Prog:=Telf_file(ps4_app.prog);
if (Prog=nil) then Exit;
Writeln('pFileName:',Prog.pFileName);
Writeln('mapCodeInit:',pFileName);
StartupParams:=Default(TPS4StartupParams);
StartupParams.argc:=1;
@ -2313,6 +2517,12 @@ begin
base:=mMap.pAddr;
//if (Prog<>Self) then
//begin
// //dt_Init
// TinitProc(base+dtInit)(StartupParams.argc,@StartupParams.argv,nil);
//end;
c:=pInit.dt_preinit_array_count;
if (c<>0) then
Case Int64(pInit.dt_preinit_array) of
@ -2347,7 +2557,7 @@ end;
Procedure Telf_file.InitProt;
begin
if FInitProt then Exit;
ClearElfFile;
//ClearElfFile;
mapProt;
FInitProt:=True;
end;
@ -2359,6 +2569,31 @@ begin
FInitCode:=True;
end;
function Telf_file.module_start(argc:size_t;argp:PPointer):Integer;
var
P:TmoduleStart;
begin
Result:=0;
Pointer(P):=Pointer(mMap.pAddr+dtInit);
Writeln('module_start');
Result:=P(argc,argp);
//Pointer(P):=Pointer(pModule.pStart);
//Case Int64(P) of
// -1,0,1:;//skip
// else
// begin
// Pointer(P):=Pointer(mMap.pAddr+QWORD(P));
//
// Writeln('module_start');
//
// Result:=P(argc,argp);
//
// end;
//end;
end;
function Telf_file.GetCodeFrame:TMemChunk;
begin
Result:=Default(TMemChunk);
@ -2376,11 +2611,18 @@ begin
end;
end;
Function Telf_file.GetModuleInfo:TKernelModuleInfo;
begin
if (ModuleInfo.name[0]=#0) then
begin
MoveChar0(PChar(pFileName)^,ModuleInfo.name,SCE_DBG_MAX_NAME_LENGTH);
end;
Result:=ModuleInfo;
end;
procedure Telf_file.mapCodeEntry;
type
Ps4_EntryPoint=procedure(pEnv:Pointer;pfnExitHandler:Pointer); SysV_ABI_CDecl;
var
P:Ps4_EntryPoint;
P:TEntryPoint;
StartupParams:TPS4StartupParams;
begin

3
ps4_elf_tls.pas
View File

@ -5,7 +5,8 @@ unit ps4_elf_tls;
interface
uses
Classes, SysUtils,
Classes,
SysUtils,
Hamt;
type

211
ps4_libkernel/ps4_cond.pas
View File

@ -6,11 +6,12 @@ interface
uses
Windows,
ps4_mutex,
ps4_types;
ntapi,
sys_types,
ps4_mutex;
type
Ppthread_condattr=^pthread_condattr_t;
p_pthread_condattr=^pthread_condattr_t;
pthread_condattr_t=bitpacked record
_shared:0..1; //1
_clock:0..31; //5
@ -18,7 +19,7 @@ type
_align2:Integer; //32
end;
Ppthread_cond=^pthread_cond;
p_pthread_cond=^pthread_cond;
pthread_cond=^pthread_cond_t;
pthread_cond_t=record
valid:DWORD;
@ -36,31 +37,31 @@ type
name:array[0..31] of AnsiChar;
end;
PScePthreadCond=Ppthread_cond;
PScePthreadCond=p_pthread_cond;
Const
PTHREAD_COND_INITIALIZER=nil;
function ps4_pthread_condattr_init(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_destroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getclock(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setclock(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getpshared(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setpshared(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_init(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_destroy(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getclock(pAttr:p_pthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setclock(pAttr:p_pthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getpshared(pAttr:p_pthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setpshared(pAttr:p_pthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_init(pCond:Ppthread_cond;pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_destroy(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_init(pCond:p_pthread_cond;pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_destroy(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_signal(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_broadcast(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_signal(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_broadcast(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_wait(pCond:Ppthread_cond;pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_timedwait(pCond:Ppthread_cond;pMutex:Ppthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_wait(pCond:p_pthread_cond;pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_timedwait(pCond:p_pthread_cond;pMutex:p_pthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrInit(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrDestroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrInit(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrDestroy(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:Ppthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:p_pthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondDestroy(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondSignal(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
@ -72,32 +73,34 @@ implementation
Uses
spinlock,
sys_kernel,
sys_signal,
sys_time,
ps4_sema,
ps4_libkernel,
ps4_time;
function ps4_pthread_condattr_init(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_init(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_pthread_condattr_destroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_destroy(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_pthread_condattr_getclock(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getclock(pAttr:p_pthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._clock;
Result:=0;
end;
function ps4_pthread_condattr_setclock(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setclock(pAttr:p_pthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -126,14 +129,14 @@ begin
Result:=0;
end;
function ps4_pthread_condattr_getpshared(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getpshared(pAttr:p_pthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_condattr_setpshared(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setpshared(pAttr:p_pthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -160,12 +163,12 @@ Const
var
cond_locked:Pointer=nil;
function STATIC_COND_INITIALIZER(x:Ppthread_cond):Boolean; inline;
function STATIC_COND_INITIALIZER(x:p_pthread_cond):Boolean; inline;
begin
Result:=(x^=PTHREAD_COND_INITIALIZER);
end;
function pthread_cond_init(c:Ppthread_cond;a:Ppthread_condattr;str:PChar):Integer;
function pthread_cond_init(c:p_pthread_cond;a:p_pthread_condattr;str:PChar):Integer;
var
_c:pthread_cond;
begin
@ -175,8 +178,8 @@ begin
if (_c=nil) then Exit(ENOMEM);
_c^.valid:=DEAD_COND;
_c^.sema_q:=CreateSemaphore(nil,0,$7fffffff,nil);
if (_c^.sema_q=0) then
begin
FreeMem(_c);
@ -184,6 +187,7 @@ begin
Exit(EAGAIN);
end;
_c^.sema_b:=CreateSemaphore(nil,0,$7fffffff,nil);
if (_c^.sema_b=0) then
begin
CloseHandle(_c^.sema_q);
@ -195,6 +199,7 @@ begin
System.InitCriticalSection(_c^.waiters_count_lock_);
System.InitCriticalSection(_c^.waiters_b_lock_);
System.InitCriticalSection(_c^.waiters_q_lock_);
_c^.value_q:=0;
_c^.value_b:=1;
_c^.valid:=LIFE_COND;
@ -205,7 +210,7 @@ begin
Result:=0;
end;
function cond_static_init(c:Ppthread_cond):Integer;
function cond_static_init(c:p_pthread_cond):Integer;
var
r:Integer;
begin
@ -215,19 +220,16 @@ begin
if STATIC_COND_INITIALIZER(c) then
begin
_sig_lock;
r:=pthread_cond_init(c,nil,nil);
_sig_unlock;
end;
spin_unlock(cond_locked);
Result:=r;
end;
function ps4_pthread_cond_init(pCond:Ppthread_cond;pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_cond_init(pCond,pAttr,nil);
end;
function ps4_pthread_cond_destroy(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function pthread_cond_destroy(pCond:p_pthread_cond):Integer;
var
r:Integer;
_c:pthread_cond;
@ -249,7 +251,7 @@ begin
end;
_c:=pCond^;
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
r:=do_sema_b_wait(_c^.sema_b,nil,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
@ -279,10 +281,11 @@ begin
System.DoneCriticalSection(_c^.waiters_q_lock_);
_c^.valid:=DEAD_COND;
FreeMem(_c);
Result:=0;
end;
function ps4_pthread_cond_signal(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function pthread_cond_signal(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
var
r:Integer;
_c:pthread_cond;
@ -293,10 +296,10 @@ begin
if (_c=PTHREAD_COND_INITIALIZER) then
Exit(0)
else
if (_c^.valid<>LIFE_COND) then
if not safe_test(_c^.valid,LIFE_COND) then
Exit(EINVAL);
System.EnterCriticalSection(_c^.waiters_count_lock_);
SwEnterCriticalSection(_c^.waiters_count_lock_);
//mingw implement is wrong
if true {(_c^.waiters_count_unblock_<>0)} then
@ -312,7 +315,8 @@ begin
if false {(_c^.waiters_count_>_c^.waiters_count_gone_)} then
begin
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
r:=do_sema_b_wait(_c^.sema_b,nil,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then
begin
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
@ -338,10 +342,11 @@ begin
end;
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Result:=do_sema_b_release(_c^.sema_q,1,_c^.waiters_q_lock_,_c^.value_q);
end;
function ps4_pthread_cond_broadcast(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function pthread_cond_broadcast(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
var
r,relCnt:Integer;
_c:pthread_cond;
@ -353,10 +358,10 @@ begin
if (_c=PTHREAD_COND_INITIALIZER) then
Exit(0)
else
if (_c^.valid<>LIFE_COND) then
if not safe_test(_c^.valid,LIFE_COND) then
Exit(EINVAL);
System.EnterCriticalSection(_c^.waiters_count_lock_);
SwEnterCriticalSection(_c^.waiters_count_lock_);
//mingw implement is wrong
if true {(_c^.waiters_count_unblock_<>0)} then
@ -372,7 +377,9 @@ begin
end else
if false {(_c^.waiters_count_>_c^.waiters_count_gone_)} then
begin
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
r:=do_sema_b_wait(_c^.sema_b,nil,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then
begin
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
@ -398,10 +405,11 @@ begin
end;
LeaveCriticalSection(_c^.waiters_count_lock_);
Result:=do_sema_b_release(_c^.sema_q,relCnt,_c^.waiters_q_lock_,_c^.value_q);
end;
function ps4_pthread_cond_wait(pCond:Ppthread_cond;pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function pthread_cond_wait(pCond:p_pthread_cond;pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
var
//ch:sCondWaitHelper;
r:Integer;
@ -418,24 +426,25 @@ begin
if (r<>0) and (r<>EBUSY) then Exit(r);
_c:=pCond^;
end else
if (_c^.valid<>LIFE_COND) then
if not safe_test(_c^.valid,LIFE_COND) then
Exit(EINVAL);
tryagain:
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
r:=do_sema_b_wait(_c^.sema_b,nil,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
begin
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
System.ThreadSwitch;
NtYieldExecution;
goto tryagain;
end;
Inc(_c^.waiters_count_);
LeaveCriticalSection(_c^.waiters_count_lock_);
r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
@ -448,7 +457,7 @@ begin
//Writeln('ps4_pthread_mutex_unlock:',HexStr(pMutex),':',HexStr(r,8));
if (r=0) then
begin
r:=do_sema_b_wait(_c^.sema_q,INFINITE,_c^.waiters_q_lock_,_c^.value_q);
r:=do_sema_b_wait(_c^.sema_q,nil,_c^.waiters_q_lock_,_c^.value_q);
end;
ps4_pthread_mutex_lock(pMutex); //WHY IT NO IN MINGW
@ -457,7 +466,7 @@ begin
Result:=r;
end;
function pthread_cond_timedwait_impl(c:Ppthread_cond;m:Ppthread_mutex;t:DWORD):Integer;
function pthread_cond_timedwait_impl(c:p_pthread_cond;m:p_pthread_mutex;pTimeout:PQWORD):Integer;
var
//ch:sCondWaitHelper;
r:Integer;
@ -474,23 +483,25 @@ begin
if (r<>0) and (r<>EBUSY) then Exit(r);
_c:=c^;
end else
if (_c^.valid<>LIFE_COND) then
if not safe_test(_c^.valid,LIFE_COND) then
Exit(EINVAL);
tryagain:
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
r:=do_sema_b_wait(_c^.sema_b,nil,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
begin
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
System.ThreadSwitch;
NtYieldExecution;
goto tryagain;
end;
Inc(_c^.waiters_count_);
System.LeaveCriticalSection(_c^.waiters_count_lock_);
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
@ -503,7 +514,7 @@ begin
//Writeln('ps4_pthread_mutex_unlock:',HexStr(m),':',HexStr(r,8));
if (r=0) then
begin
r:=do_sema_b_wait(_c^.sema_q,t,_c^.waiters_q_lock_,_c^.value_q);
r:=do_sema_b_wait(_c^.sema_q,pTimeout,_c^.waiters_q_lock_,_c^.value_q);
end;
ps4_pthread_mutex_lock(m); //WHY IT NO IN MINGW
@ -513,75 +524,119 @@ begin
Result:=r;
end;
function ps4_pthread_cond_init(pCond:p_pthread_cond;pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=pthread_cond_init(pCond,pAttr,nil);
_sig_unlock;
end;
function ps4_pthread_cond_timedwait(pCond:Ppthread_cond;pMutex:Ppthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_destroy(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=pthread_cond_destroy(pCond);
_sig_unlock;
end;
function ps4_pthread_cond_signal(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=pthread_cond_signal(pCond);
_sig_unlock;
end;
function ps4_pthread_cond_broadcast(pCond:p_pthread_cond):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=pthread_cond_broadcast(pCond);
_sig_unlock;
end;
function ps4_pthread_cond_wait(pCond:p_pthread_cond;pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=pthread_cond_wait(pCond,pMutex);
_sig_unlock;
end;
function ps4_pthread_cond_timedwait(pCond:p_pthread_cond;pMutex:p_pthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
var
t:DWORD;
t:QWORD;
begin
if (ptime=nil) then
begin
Result:=ps4_pthread_cond_wait(pCond,pMutex);
_sig_lock;
Result:=pthread_cond_wait(pCond,pMutex);
_sig_unlock;
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ptime^));
Result:=pthread_cond_timedwait_impl(pCond,pMutex,t);
t:=_pthread_rel_time_in_ns(ptime^);
_sig_lock;
Result:=pthread_cond_timedwait_impl(pCond,pMutex,@t);
_sig_unlock;
end;
end;
///////////////////////
function ps4_scePthreadCondattrInit(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrInit(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_scePthreadCondattrDestroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrDestroy(pAttr:p_pthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:Ppthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:p_pthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=px2sce(pthread_cond_init(pCond,pAttr,name));
_sig_unlock;
end;
function ps4_scePthreadCondDestroy(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_cond_destroy(pCond));
_sig_lock;
Result:=px2sce(pthread_cond_destroy(pCond));
_sig_unlock;
end;
function ps4_scePthreadCondSignal(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondSignal:',HexStr(pCond));
Result:=px2sce(ps4_pthread_cond_signal(pCond));
//Writeln('<scePthreadCondSignal:',HexStr(pCond),':',HexStr(Result,8));
_sig_lock;
Result:=px2sce(pthread_cond_signal(pCond));
_sig_unlock;
end;
function ps4_scePthreadCondWait(pCond:PScePthreadCond;pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondWait:',HexStr(pCond),':',HexStr(pMutex));
Result:=px2sce(ps4_pthread_cond_wait(pCond,pMutex));
//Writeln('<scePthreadCondWait:',HexStr(pCond),':',HexStr(pMutex),':',HexStr(Result,8));
//Result:=0;
_sig_lock;
Result:=px2sce(pthread_cond_wait(pCond,pMutex));
_sig_unlock;
end;
//Time to wait (microseconds)
function ps4_scePthreadCondTimedwait(pCond:PScePthreadCond;pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
var
t:QWORD;
begin
//Writeln('>scePthreadCondTimedwait:',HexStr(pCond),':',HexStr(pMutex));
Result:=px2sce(pthread_cond_timedwait_impl(pCond,pMutex,_usec2msec(usec)));
//if Result=SCE_KERNEL_ERROR_ETIMEDOUT then Writeln('SCE_KERNEL_ERROR_ETIMEDOUT');
t:=_usec2nsec(usec);
_sig_lock;
Result:=px2sce(pthread_cond_timedwait_impl(pCond,pMutex,@t));
_sig_unlock;
end;
function ps4_scePthreadCondBroadcast(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondBroadcast:',HexStr(pCond));
Result:=px2sce(ps4_pthread_cond_broadcast(pCond));
//Writeln('<scePthreadCondBroadcast:',HexStr(pCond),':',HexStr(Result,8));
_sig_lock;
Result:=px2sce(pthread_cond_broadcast(pCond));
_sig_unlock;
end;
end.

513
ps4_libkernel/ps4_event_flag.pas Normal file
View File

@ -0,0 +1,513 @@
unit ps4_event_flag;
{$mode objfpc}{$H+}
interface
uses
windows,
Classes,
SysUtils,
spinlock;
const
SCE_KERNEL_EVF_ATTR_TH_FIFO=$01;
SCE_KERNEL_EVF_ATTR_TH_PRIO=$02;
SCE_KERNEL_EVF_ATTR_SINGLE =$10;
SCE_KERNEL_EVF_ATTR_MULTI =$20;
SCE_KERNEL_EVF_WAITMODE_AND =$01;
SCE_KERNEL_EVF_WAITMODE_OR =$02;
SCE_KERNEL_EVF_WAITMODE_CLEAR_ALL=$10;
SCE_KERNEL_EVF_WAITMODE_CLEAR_PAT=$20;
SCE_KERNEL_EVF_ID_INVALID=High(QWORD)-1;
type
PSceKernelEventFlagOptParam=^SceKernelEventFlagOptParam;
SceKernelEventFlagOptParam=packed record
size:QWORD;
end;
pwef_node=^wef_node;
wef_node=record
pNext,pPrev:pwef_node;
pParent:Pointer;
//
thread:THandle;
bitPattern:QWORD;
ResultPat:QWORD;
waitMode:DWORD;
end;
wef_list=object
pHead,pTail:pwef_node;
procedure Insert(Node:pwef_node);
procedure Remove(node:pwef_node);
end;
PSceKernelEventFlag=^SceKernelEventFlag;
SceKernelEventFlag=^SceKernelEventFlag_t;
SceKernelEventFlag_t=packed record
valid:DWORD;
attr:DWORD;
bitPattern:QWORD;
lock_sing:r_spin_lock;
lock_list:r_spin_lock;
list:wef_list;
thread:THandle;
name:array[0..31] of AnsiChar;
end;
function ps4_sceKernelCreateEventFlag(
ef:PSceKernelEventFlag;
pName:PChar;
attr:DWORD;
initPattern:QWORD;
pOptParam:PSceKernelEventFlagOptParam):Integer; SysV_ABI_CDecl;
function ps4_sceKernelWaitEventFlag(
ef:SceKernelEventFlag;
bitPattern:QWORD;
waitMode:DWORD;
pResultPat:PQWORD;
pTimeout:PDWORD):Integer; SysV_ABI_CDecl;
function ps4_sceKernelSetEventFlag(ef:SceKernelEventFlag;bitPattern:QWORD):Integer; SysV_ABI_CDecl;
function ps4_sceKernelClearEventFlag(ef:SceKernelEventFlag;bitPattern:QWORD):Integer; SysV_ABI_CDecl;
implementation
uses
atomic,
ntapi,
sys_kernel,
sys_pthread,
sys_signal,
sys_time;
const
LIFE_EQ=$BAB1F00D;
DEAD_EQ=$DEADBEEF;
EVF_TH_PRIO=SCE_KERNEL_EVF_ATTR_TH_FIFO or SCE_KERNEL_EVF_ATTR_TH_PRIO;
EVF_TH_LOCK=SCE_KERNEL_EVF_ATTR_SINGLE or SCE_KERNEL_EVF_ATTR_MULTI;
WOP_MODES =SCE_KERNEL_EVF_WAITMODE_AND or SCE_KERNEL_EVF_WAITMODE_OR;
function ps4_sceKernelCreateEventFlag(
ef:PSceKernelEventFlag;
pName:PChar;
attr:DWORD;
initPattern:QWORD;
pOptParam:PSceKernelEventFlagOptParam):Integer; SysV_ABI_CDecl;
var
data:SceKernelEventFlag;
begin
Writeln('sceKernelCreateEventFlag:',pName);
if (ef=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
data:=SwAllocMem(SizeOf(SceKernelEventFlag_t));
if (data=nil) then
begin
Exit(SCE_KERNEL_ERROR_ENOMEM);
end;
if ((attr and EVF_TH_PRIO)=0) then
begin
attr:=attr or SCE_KERNEL_EVF_ATTR_TH_FIFO;
end;
if ((attr and EVF_TH_LOCK)=0) then
begin
attr:=attr or SCE_KERNEL_EVF_ATTR_SINGLE;
end;
data^.valid :=LIFE_EQ;
data^.attr :=attr;
data^.bitPattern:=initPattern;
if (pName<>nil) then MoveChar0(pName^,data^.name,32);
ef^:=data;
Result:=0;
end;
procedure wef_list.Insert(Node:pwef_node);
begin
if (pTail=nil) then
begin
pHead:=node;
node^.pPrev:=nil;
end else
begin
pTail^.pNext:=node;
node^.pPrev:=pTail;
end;
node^.pNext:=nil;
pTail:=node;
end;
procedure wef_list.Remove(node:pwef_node);
begin
if (node^.pPrev=nil) then
begin
if (pHead=node) then
begin
pHead:=node^.pNext;
end;
end else
begin
node^.pPrev^.pNext:=node^.pNext;
end;
if (node^.pNext=nil) then
begin
if (pTail=node) then
begin
pTail:=node^.pPrev;
end;
end else
begin
node^.pNext^.pPrev:=node^.pPrev;
end;
end;
function _test_by_mode(var bits:QWORD;bitPattern:QWORD;waitMode:DWORD):Boolean; inline;
begin
Result:=False;
Case (waitMode and WOP_MODES) of
SCE_KERNEL_EVF_WAITMODE_AND:Result:=((bits and bitPattern)=bitPattern);
SCE_KERNEL_EVF_WAITMODE_OR :Result:=((bits and bitPattern)<>0)
else;
end;
end;
function _change_by_mode(var bits:QWORD;bitPattern:QWORD;waitMode:DWORD):Boolean; inline;
var
prev:QWORD;
begin
Result:=False;
if ((waitMode and SCE_KERNEL_EVF_WAITMODE_CLEAR_ALL)<>0) then
begin
prev:=bits;
bits:=0;
Result:=(prev<>bits);
end else
if ((waitMode and SCE_KERNEL_EVF_WAITMODE_CLEAR_PAT)<>0) then
begin
prev:=bits;
bits:=bits and (not bitPattern);
Result:=(prev<>bits);
end;
end;
function _test_and_set(ef:SceKernelEventFlag;bitPattern:QWORD;waitMode:DWORD;pOut:PQWORD):Boolean;
var
bits:QWORD;
begin
Result:=False;
bits:=load_acq_rel(ef^.bitPattern);
if _test_by_mode(bits,bitPattern,waitMode) then
begin
Result:=True;
if _change_by_mode(bits,bitPattern,waitMode) then
begin
store_seq_cst(ef^.bitPattern,bits);
end;
end;
if Result and (pOut<>nil) then
begin
pOut^:=bits;
end;
end;
function _is_single(attr:DWORD):Boolean;
begin
Result:=(attr and SCE_KERNEL_EVF_ATTR_MULTI)=0;
end;
function ps4_sceKernelWaitEventFlag(
ef:SceKernelEventFlag;
bitPattern:QWORD;
waitMode:DWORD;
pResultPat:PQWORD;
pTimeout:PDWORD):Integer; SysV_ABI_CDecl;
var
t:pthread;
attr:DWORD;
timeout:Int64;
passed :Int64;
START:QWORD;
QTIME:QWORD;
node:wef_node;
begin
Result:=0;
if (ef=nil) then Exit(SCE_KERNEL_ERROR_ESRCH);
if (ef^.valid<>LIFE_EQ) then Exit(SCE_KERNEL_ERROR_EACCES);
if (bitPattern=0) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case (waitMode and WOP_MODES) of
SCE_KERNEL_EVF_WAITMODE_AND:;
SCE_KERNEL_EVF_WAITMODE_OR :;
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
t:=_get_curthread;
if (t=nil) then Exit(SCE_KERNEL_ERROR_ESRCH);
_sig_lock;
Writeln('>sceKernelWaitEventFlag:',HexStr(ef),':',ef^.name,':',HexStr(bitPattern,16),':',ThreadID);
if (pTimeout<>nil) then
begin
timeout:=(pTimeout^ div 100);
SwSaveTime(START);
end else
begin
timeout:=NT_INFINITE;
end;
attr:=ef^.attr;
if _is_single(attr) then
begin
spin_lock(ef^.lock_list);
if not spin_trylock(ef^.lock_sing) then
begin
spin_unlock(ef^.lock_list);
_sig_unlock;
Exit(SCE_KERNEL_ERROR_EPERM);
end;
ef^.thread:=t^.handle;
spin_unlock(ef^.lock_list);
end else
begin
node:=Default(wef_node);
node.pParent :=ef;
node.thread :=t^.handle;
node.bitPattern:=bitPattern;
node.waitMode :=waitMode;
spin_lock(ef^.lock_list);
ef^.list.Insert(@node);
spin_unlock(ef^.lock_list);
end;
repeat
if _is_single(attr) then
begin
if _test_and_set(ef,bitPattern,waitMode,pResultPat) then
begin
Break;
end;
end else
begin
if (node.pParent=nil) then //is signaled
begin
if (pResultPat<>nil) then
begin
pResultPat^:=node.ResultPat;
end;
Break;
end;
spin_lock(ef^.lock_list);
if _test_and_set(ef,bitPattern,waitMode,pResultPat) then
begin
spin_unlock(ef^.lock_list);
Break;
end;
spin_unlock(ef^.lock_list);
end;
if (pTimeout<>nil) then
begin
if (timeout=0) then
begin
Result:=SCE_KERNEL_ERROR_ETIMEDOUT;
Break;
end;
SwSaveTime(QTIME);
timeout:=-timeout;
SwDelayExecution(True,@timeout);
timeout:=-timeout;
passed:=SwTimePassedUnits(QTIME);
if (passed>=timeout) then
begin
Result:=SCE_KERNEL_ERROR_ETIMEDOUT;
Break;
end else
begin
timeout:=timeout-passed;
end;
end else
begin
//timeout:=-10000;
SwDelayExecution(True,@timeout);
end;
until false;
if (pTimeout<>nil) then
begin
if (Result=SCE_KERNEL_ERROR_ETIMEDOUT) then
begin
pTimeout^:=0;
end else
begin
passed:=SwTimePassedUnits(QTIME);
pTimeout^:=passed*100;
end;
end;
if _is_single(attr) then
begin
ef^.thread:=0;
spin_unlock(ef^.lock_sing);
end else
begin
spin_lock(ef^.lock_list);
ef^.list.Remove(@node);
spin_unlock(ef^.lock_list);
end;
Writeln('<sceKernelWaitEventFlag:',HexStr(ef),':',ef^.name,':',HexStr(bitPattern,16),':',ThreadID);
_sig_unlock;
end;
procedure _apc_null(dwParam:PTRUINT); stdcall;
begin
end;
function ps4_sceKernelSetEventFlag(ef:SceKernelEventFlag;bitPattern:QWORD):Integer; SysV_ABI_CDecl;
var
node:pwef_node;
prev,bits,count:QWORD;
AllPattern:QWORD;
AllwaitMode:DWORD;
attr:DWORD;
begin
if (ef=nil) then Exit(SCE_KERNEL_ERROR_ESRCH);
if (ef^.valid<>LIFE_EQ) then Exit(SCE_KERNEL_ERROR_ESRCH);
_sig_lock;
Writeln('>sceKernelSetEventFlag:',HexStr(ef),':',ef^.name,':',HexStr(bitPattern,16),':',ThreadID);
count:=0;
AllPattern:=0;
AllwaitMode:=0;
attr:=ef^.attr;
spin_lock(ef^.lock_list);
if _is_single(attr) then
begin
fetch_or(ef^.bitPattern,bitPattern);
NtQueueApcThread(ef^.thread,@_apc_null,0,nil,0);
end else
begin
Writeln('!sceKernelSetEventFlag:',HexStr(ef),':',ef^.name,':',HexStr(bitPattern,16),':',ThreadID);
bits:=load_acq_rel(ef^.bitPattern) or bitPattern;
node:=ef^.list.pHead;
While (node<>nil) do
begin
if (node^.pParent<>nil) then
if _test_by_mode(bits,node^.bitPattern,node^.waitMode) then
begin
AllPattern :=AllPattern or node^.bitPattern;
AllwaitMode:=AllwaitMode or node^.waitMode;
Inc(count);
end;
node:=node^.pNext;
end;
if (count<>0) then
begin
prev:=bits;
_change_by_mode(bits,AllPattern,AllwaitMode);
store_seq_cst(ef^.bitPattern,bits);
node:=ef^.list.pHead;
While (node<>nil) do
begin
if (node^.pParent<>nil) then
if _test_by_mode(prev,node^.bitPattern,node^.waitMode) then
begin
node^.ResultPat:=bits;
node^.pParent :=nil;
NtQueueApcThread(node^.thread,@_apc_null,0,nil,0);
end;
node:=node^.pNext;
end;
end else
begin
store_seq_cst(ef^.bitPattern,bits);
end;
end;
spin_unlock(ef^.lock_list);
_sig_unlock;
Result:=0;
end;
function ps4_sceKernelClearEventFlag(ef:SceKernelEventFlag;bitPattern:QWORD):Integer; SysV_ABI_CDecl;
var
t:Int64;
//pt:pthread;
begin
if (ef=nil) then Exit(SCE_KERNEL_ERROR_ESRCH);
if (ef^.valid<>LIFE_EQ) then Exit(SCE_KERNEL_ERROR_ESRCH);
Writeln('sceKernelClearEventFlag:',HexStr(ef),':',ef^.name,':',HexStr(bitPattern,16),':',ThreadID);
//pt:=ps4_pthread_self;
//if pt^.name='main' then
//begin
// DebugBreak;
//end;
//t:=-10000;
//SwDelayExecution(False,@t); //100ms
spin_lock(ef^.lock_list);
fetch_and(ef^.bitPattern,bitPattern);
spin_unlock(ef^.lock_list);
Result:=0;
end;
{
int sceKernelDeleteEventFlag(SceKernelEventFlag ef);
int sceKernelPollEventFlag(SceKernelEventFlag ef, uint64_t bitPattern,
uint32_t waitMode, uint64_t *pResultPat);
int sceKernelCancelEventFlag(SceKernelEventFlag ef, uint64_t setPattern,
int *pNumWaitThreads);
}
end.

618
ps4_libkernel/ps4_kernel_file.pas
View File

@ -6,12 +6,13 @@ interface
uses
windows,
ps4_types,
sys_types,
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
const
NAME_MAX =255; // max bytes in a file name
NAME_MAX =255; // max bytes in a file name
PATH_MAX =1024; // max bytes in pathname
IOV_MAX =1024; // max elements in i/o vector
MAXNAMLEN =255;
@ -35,24 +36,30 @@ const
O_DIRECTORY =$00020000; // Fail if not directory
O_EXEC =$00040000; // Open for execute only
S_IRWXU =0000700; // RWX mask for owner
S_IRUSR =0000400; // R for owner
S_IWUSR =0000200; // W for owner
S_IXUSR =0000100; // X for owner
S_IRWXU =&0000700; // RWX mask for owner
S_IRUSR =&0000400; // R for owner
S_IWUSR =&0000200; // W for owner
S_IXUSR =&0000100; // X for owner
S_IRWXG =0000070; // RWX mask for group
S_IRGRP =0000040; // R for group
S_IWGRP =0000020; // W for group
S_IXGRP =0000010; // X for group
S_IRWXG =&0000070; // RWX mask for group
S_IRGRP =&0000040; // R for group
S_IWGRP =&0000020; // W for group
S_IXGRP =&0000010; // X for group
S_IRWXO =0000007; // RWX mask for other
S_IROTH =0000004; // R for other
S_IWOTH =0000002; // W for other
S_IXOTH =0000001; // X for other
S_IRWXO =&0000007; // RWX mask for other
S_IROTH =&0000004; // R for other
S_IWOTH =&0000002; // W for other
S_IXOTH =&0000001; // X for other
S_IFMT =0170000; // type of file mask
S_IFDIR =0040000; // directory
S_IFREG =0100000; // regular
S_IFMT =&0170000; // type of file mask
S_IFIFO =&0010000; // named pipe (fifo)
S_IFCHR =&0020000; // character special
S_IFDIR =&0040000; // directory
S_IFBLK =&0060000; // block special
S_IFREG =&0100000; // regular
S_IFLNK =&0120000; // symbolic link
S_IFSOCK =&0140000; // socket
S_ISVTX =&0001000; // save swapped text even after use
F_GETFL =3; // get file status flags
F_SETFL =4; // set file status flags
@ -109,7 +116,7 @@ const
SCE_KERNEL_S_IRU =(SCE_KERNEL_S_IRUSR);
// 00555, R
SCE_KERNEL_S_INONE =0000000;
SCE_KERNEL_S_INONE =&0000000;
//SCE_KERNEL_S_ISDIR(m) =S_ISDIR(m);
//SCE_KERNEL_S_ISREG(m) =S_ISREG(m);
@ -145,48 +152,53 @@ const
SCE_KERNEL_LWFS_ENABLE =(1);
type
P_ps4_stat=^T_ps4_stat;
T_ps4_stat=packed object
type
__dev_t=DWORD;
ino_t =DWORD;
mode_t =Word;
nlink_t=Word;
uid_t =DWORD;
gid_t =DWORD;
off_t =Int64;
blkcnt_t=Int64;
blksize_t=DWORD;
fflags_t =DWORD;
var
st_dev :__dev_t ; // inode's device
st_ino :ino_t ; // inode's number
st_mode :mode_t ; // inode protection mode
st_nlink :nlink_t ; // number of hard links
st_uid :uid_t ; // user ID of the file's owner
st_gid :gid_t ; // group ID of the file's group
st_rdev :__dev_t ; // device type
st_atim :timespec ; // time of last access
st_mtim :timespec ; // time of last data modification
st_ctim :timespec ; // time of last file status change
st_size :off_t ; // file size, in bytes
st_blocks :blkcnt_t ; // blocks allocated for file
st_blksize :blksize_t ; // optimal blocksize for I/O
st_flags :fflags_t ; // user defined flags for file
st_gen :DWORD ; // file generation number
st_lspare :DWORD ;
st_birthtim:timespec ; // time of file creation
PSceKernelStat=^SceKernelStat;
SceKernelStat=packed object
type
__dev_t =DWORD;
ino_t =DWORD;
mode_t =Word;
nlink_t =Word;
uid_t =DWORD;
gid_t =DWORD;
off_t =Int64;
blkcnt_t =Int64;
blksize_t=DWORD;
fflags_t =DWORD;
var
st_dev :__dev_t ; // inode's device
st_ino :ino_t ; // inode's number
st_mode :mode_t ; // inode protection mode S_IFMT.....
st_nlink :nlink_t ; // number of hard links
st_uid :uid_t ; // user ID of the file's owner S_IRWXU....
st_gid :gid_t ; // group ID of the file's group S_IRWXG....
st_rdev :__dev_t ; // device type
st_atim :timespec ; // time of last access
st_mtim :timespec ; // time of last data modification
st_ctim :timespec ; // time of last file status change
st_size :off_t ; // file size, in bytes
st_blocks :blkcnt_t ; // blocks allocated for file
st_blksize :blksize_t ; // optimal blocksize for I/O
st_flags :fflags_t ; // user defined flags for file
st_gen :DWORD ; // file generation number
st_lspare :DWORD ;
st_birthtim:timespec ; // time of file creation
end;
function ps4_open(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelOpen(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelLseek(fd:Integer;offset:Int64;whence:Integer):Int64; SysV_ABI_CDecl;
function ps4_sceKernelWrite(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
function ps4_sceKernelRead(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
function ps4_sceKernelPread(fd:Integer;buf:Pointer;nbytes,offset:Int64):Int64; SysV_ABI_CDecl;
function ps4_close(fd:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelClose(fd:Integer):Integer; SysV_ABI_CDecl;
function ps4_stat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_sceKernelStat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_stat(path:PChar;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
function ps4_sceKernelStat(path:PChar;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
function ps4_fstat(fd:Integer;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
function ps4_sceKernelFstat(fd:Integer;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
function ps4_write(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
function ps4_read(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
@ -197,21 +209,71 @@ function ps4_mkdir(path:PChar):Integer; SysV_ABI_CDecl;
implementation
uses
ps4_libkernel;
sys_kernel,
sys_signal,
sys_time;
function _open_osfhandle(h:THandle;flags:Integer):Integer; cdecl; external 'msvcrt';
function _get_osfhandle(fd:Integer):THandle; cdecl; external 'msvcrt';
function _close(fd:Integer):Integer; cdecl; external 'msvcrt';
Function get_DesiredAccess(flags:Integer):DWORD;
begin
Result:=0;
if (flags and SCE_KERNEL_O_RDWR)<>0 then
begin
Result:=GENERIC_READ or GENERIC_WRITE;
end else
if (flags and SCE_KERNEL_O_WRONLY)<>0 then
begin
Result:=GENERIC_WRITE;
end else
begin
Result:=GENERIC_READ;
end;
if (flags and SCE_KERNEL_O_APPEND)<>0 then
begin
Result:=Result or FILE_APPEND_DATA;
end;
end;
Function get_CreationDisposition(flags:Integer):DWORD;
const
CREAT_EXCL=SCE_KERNEL_O_CREAT or SCE_KERNEL_O_EXCL;
begin
Result:=0;
if (flags and CREAT_EXCL)=CREAT_EXCL then
begin
Result:=CREATE_NEW;
end else
if (flags and SCE_KERNEL_O_CREAT)<>0 then
begin
Result:=CREATE_ALWAYS;
end else
if (flags and SCE_KERNEL_O_TRUNC)<>0 then
begin
Result:=TRUNCATE_EXISTING;
end else
begin
Result:=OPEN_EXISTING;
end;
end;
function ps4_open(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=_set_errno(sce2px(ps4_sceKernelOpen(path,flags,mode)));
end;
function ps4_sceKernelOpen(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
const
WR_RDWR=SCE_KERNEL_O_WRONLY or SCE_KERNEL_O_RDWR;
CREAT_EXCL=SCE_KERNEL_O_CREAT or SCE_KERNEL_O_EXCL;
O_OFS=O_RDONLY or O_WRONLY or O_RDWR or O_APPEND;
WR_RDWR=SCE_KERNEL_O_WRONLY or SCE_KERNEL_O_RDWR;
O_OFS=O_RDONLY or O_WRONLY or O_RDWR or O_APPEND;
var
h:THandle;
err:DWORD;
dwDesiredAccess:DWORD;
dwCreationDisposition:DWORD;
@ -228,43 +290,22 @@ begin
end;
if (path[0]=#0) then Exit(SCE_KERNEL_ERROR_ENOENT);
_sig_lock;
rp:=_parse_filename(path);
_sig_unlock;
if (rp='') then Exit(SCE_KERNEL_ERROR_EACCES);
_sig_lock;
wp:=UTF8Decode(rp);
_sig_unlock;
if (flags and SCE_KERNEL_O_RDWR)<>0 then
begin
dwDesiredAccess:=GENERIC_READ or GENERIC_WRITE;
end else
if (flags and SCE_KERNEL_O_WRONLY)<>0 then
begin
dwDesiredAccess:=GENERIC_WRITE;
end else
begin
dwDesiredAccess:=GENERIC_READ;
end;
if (flags and SCE_KERNEL_O_APPEND)<>0 then
begin
dwDesiredAccess:=dwDesiredAccess or FILE_APPEND_DATA;
end;
if (flags and CREAT_EXCL)=CREAT_EXCL then
begin
dwCreationDisposition:=CREATE_NEW;
end else
if (flags and SCE_KERNEL_O_CREAT)<>0 then
begin
dwCreationDisposition:=CREATE_ALWAYS;
end else
if (flags and SCE_KERNEL_O_TRUNC)<>0 then
begin
dwCreationDisposition:=TRUNCATE_EXISTING;
end else
begin
dwCreationDisposition:=OPEN_EXISTING;
end;
dwDesiredAccess:=get_DesiredAccess(flags);
dwCreationDisposition:=get_CreationDisposition(flags);
_sig_lock;
h:=CreateFileW(
PWideChar(wp),
dwDesiredAccess,
@ -274,22 +315,29 @@ begin
FILE_ATTRIBUTE_NORMAL,
0
);
err:=GetLastError;
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then
begin
Writeln(GetLastError);
Case GetLastError of
Writeln('GetLastError:',err{,' ',ps4_pthread_self^.sig._lock});
Case err of
ERROR_INVALID_DRIVE,
ERROR_PATH_NOT_FOUND,
ERROR_FILE_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_ACCESS_DENIED :Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_FILE_EXISTS :Exit(SCE_KERNEL_ERROR_EEXIST);
ERROR_FILE_NOT_FOUND :Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_ACCESS_DENIED :Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_BUFFER_OVERFLOW :Exit(SCE_KERNEL_ERROR_ENAMETOOLONG);
ERROR_NOT_ENOUGH_MEMORY:Exit(SCE_KERNEL_ERROR_ENOMEM);
ERROR_FILE_EXISTS :Exit(SCE_KERNEL_ERROR_EEXIST);
ERROR_DISK_FULL: Exit(SCE_KERNEL_ERROR_ENOSPC);
else
Exit(SCE_KERNEL_ERROR_EIO);
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
_sig_lock;
Result:=_open_osfhandle(h,flags and O_OFS);
_sig_unlock;
if (Result=-1) then
begin
@ -302,16 +350,21 @@ function ps4_sceKernelLseek(fd:Integer;offset:Int64;whence:Integer):Int64; SysV_
var
h:THandle;
begin
_sig_lock;
h:=_get_osfhandle(fd);
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
_sig_lock;
case whence of
SCE_KERNEL_SEEK_SET:Result:=FileSeek(h,offset,fsFromBeginning);
SCE_KERNEL_SEEK_CUR:Result:=FileSeek(h,offset,fsFromCurrent);
SCE_KERNEL_SEEK_END:Result:=FileSeek(h,offset,fsFromEnd);
else
Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=SCE_KERNEL_ERROR_EINVAL;
end;
_sig_unlock;
if (Result=-1) then Result:=SCE_KERNEL_ERROR_EOVERFLOW;
end;
@ -321,20 +374,25 @@ var
h:THandle;
N:DWORD;
begin
_sig_lock;
h:=_get_osfhandle(fd);
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) then Exit(SCE_KERNEL_ERROR_EINVAL);
N:=0;
_sig_lock;
if WriteFile(h,buf^,nbytes,N,nil) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
Result:=SCE_KERNEL_ERROR_EIO;
end;
_sig_unlock;
end;
function ps4_sceKernelRead(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
@ -342,20 +400,25 @@ var
h:THandle;
N:DWORD;
begin
_sig_lock;
h:=_get_osfhandle(fd);
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) then Exit(SCE_KERNEL_ERROR_EINVAL);
N:=0;
_sig_lock;
if ReadFile(h,buf^,nbytes,N,nil) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
Result:=SCE_KERNEL_ERROR_EIO;
end;
_sig_unlock;
end;
function ps4_sceKernelPread(fd:Integer;buf:Pointer;nbytes,offset:Int64):Int64; SysV_ABI_CDecl;
@ -367,103 +430,219 @@ begin
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) or (offset<0) then Exit(SCE_KERNEL_ERROR_EINVAL);
_sig_lock;
h:=_get_osfhandle(fd);
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
O:=Default(TOVERLAPPED);
PInt64(@O.Offset)^:=offset;
N:=0;
_sig_lock;
if ReadFile(h,buf^,nbytes,N,@O) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
Result:=SCE_KERNEL_ERROR_EIO;
end;
_sig_unlock;
end;
function ps4_close(fd:Integer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=_close(fd);
_sig_unlock;
if (Result<>0) then Result:=_set_errno(EBADF);
end;
function ps4_sceKernelClose(fd:Integer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=_close(fd);
_sig_unlock;
if (Result<>0) then Result:=SCE_KERNEL_ERROR_EBADF;
end;
type
P_ms_stat64=^T_ms_stat64;
T_ms_stat64=packed object
type
_dev_t=DWORD;
_ino_t=WORD;
__time64_t=QWORD;
var
st_dev:_dev_t; //4
st_ino:_ino_t; //2
st_mode:WORD; //2 4
st_nlink:WORD; //2
st_uid:WORD; //2 4
st_gid:WORD; //2
a1:Word; //2 4
st_rdev:_dev_t; //4
a2:DWORD; //4
st_size:Int64; //8
st_atime:__time64_t;
st_mtime:__time64_t;
st_ctime:__time64_t;
end;
function file_attr_to_st_mode(attr:DWORD):Word;
begin
Result:=S_IRUSR;
if ((attr and FILE_ATTRIBUTE_DIRECTORY)<>0) then
Result:=Result or S_IFDIR
else
Result:=Result or S_IFREG;
function _wstat64(path:PWideChar;stat:P_ms_stat64):Integer; cdecl; external 'msvcrt';
if ((attr and FILE_ATTRIBUTE_READONLY)=0) then
Result:=Result or S_IWUSR;
end;
function ps4_stat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_stat(path:PChar;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
begin
Result:=_set_errno(sce2px(ps4_sceKernelStat(path,stat)));
end;
function GetFileAttributesU(Const lpFileName:RawByteString;lpFileInformation:LPVOID):DWORD;
var
stat_os:T_ms_stat64;
rp:RawByteString;
wp:WideString;
begin
//_wstat64(path:PWideChar;stat:P_ms_stat64)
writeln('stat:',path);
if (path=nil) then Exit(EINVAL);
if (path[0]=#0) then Exit(ENOENT);
rp:=_parse_filename(path);
if (rp='') then Exit(EACCES);
wp:=UTF8Decode(rp);
stat_os:=Default(T_ms_stat64);
Result:=_wstat64(PWideChar(wp),@stat_os);
if (Result<>0) then
Result:=0;
_sig_lock;
wp:=UTF8Decode(lpFileName);
if not GetFileAttributesExW(PWideChar(wp),GetFileExInfoStandard,lpFileInformation) then
begin
Writeln(GetLastError);
Case GetLastError of
ERROR_FILE_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_PATH_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOTDIR);
Result:=GetLastError;
end;
_sig_unlock;
end;
function ps4_sceKernelStat(path:PChar;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
var
rp:RawByteString;
hfi:WIN32_FILE_ATTRIBUTE_DATA;
err:DWORD;
begin
if (path=nil) or (stat=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if (path[0]=#0) then Exit(SCE_KERNEL_ERROR_ENOENT);
stat^:=Default(SceKernelStat);
_sig_lock;
rp:=_parse_filename(path);
_sig_unlock;
if (rp='') then Exit(SCE_KERNEL_ERROR_EACCES);
hfi:=Default(WIN32_FILE_ATTRIBUTE_DATA);
err:=GetFileAttributesU(rp,@hfi);
if (err<>0) then
begin
Writeln('GetLastError:',err{,' ',ps4_pthread_self^.sig._lock});
Case err of
ERROR_ACCESS_DENIED,
ERROR_SHARING_VIOLATION,
ERROR_LOCK_VIOLATION,
ERROR_SHARING_BUFFER_EXCEEDED:
Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_BUFFER_OVERFLOW:
Exit(SCE_KERNEL_ERROR_ENAMETOOLONG);
ERROR_NOT_ENOUGH_MEMORY:
Exit(SCE_KERNEL_ERROR_ENOMEM);
else
Exit(SCE_KERNEL_ERROR_EIO);
Exit(SCE_KERNEL_ERROR_ENOENT);
end;
end;
if (stat<>nil) then
begin
stat^:=Default(T_ps4_stat);
stat^.st_dev :=stat_os.st_dev;
stat^.st_ino :=stat_os.st_ino;
stat^.st_mode :=stat_os.st_mode;
stat^.st_nlink :=stat_os.st_nlink;
stat^.st_uid :=stat_os.st_uid;
stat^.st_gid :=stat_os.st_gid;
stat^.st_rdev :=stat_os.st_rdev;
stat^.st_atim.tv_sec:=stat_os.st_atime;
stat^.st_mtim.tv_sec:=stat_os.st_mtime;
stat^.st_ctim.tv_sec:=stat_os.st_ctime;
stat^.st_size :=stat_os.st_size;
end;
stat^.st_mode :=file_attr_to_st_mode(hfi.dwFileAttributes);
stat^.st_size :=hfi.nFileSizeLow or (QWORD(hfi.nFileSizeHigh) shl 32);
stat^.st_atim:=filetime_to_timespec(hfi.ftLastAccessTime);
stat^.st_mtim:=filetime_to_timespec(hfi.ftLastWriteTime);
stat^.st_ctim:=stat^.st_mtim;
stat^.st_birthtim:=filetime_to_timespec(hfi.ftCreationTime);
Result:=0;
end;
function ps4_sceKernelStat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_fstat(fd:Integer;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_stat(path,stat));
Result:=_set_errno(sce2px(ps4_sceKernelFstat(fd,stat)));
end;
function _GetFileType(hFile:HANDLE):DWORD;
begin
_sig_lock;
Result:=GetFileType(hFile);
_sig_unlock;
end;
function _GetFileInformationByHandle(hFile:HANDLE;lpFileInformation:LPBY_HANDLE_FILE_INFORMATION):DWORD;
begin
Result:=0;
_sig_lock;
if not GetFileInformationByHandle(hFile,lpFileInformation) then
begin
Result:=GetLastError;
end;
_sig_unlock;
end;
function ps4_sceKernelFstat(fd:Integer;stat:PSceKernelStat):Integer; SysV_ABI_CDecl;
var
h:THandle;
hfi:TByHandleFileInformation;
err:DWORD;
begin
if (stat=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
stat^:=Default(SceKernelStat);
_sig_lock;
h:=_get_osfhandle(fd);
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
Case _GetFileType(h) of
FILE_TYPE_PIPE:
begin
stat^.st_dev :=fd;
stat^.st_rdev :=fd;
stat^.st_mode :=S_IFIFO;
stat^.st_nlink:=1;
end;
FILE_TYPE_CHAR:
begin
stat^.st_dev :=fd;
stat^.st_rdev :=fd;
stat^.st_mode :=S_IFCHR;
stat^.st_nlink:=1;
end;
FILE_TYPE_DISK:
begin
err:=_GetFileInformationByHandle(h,@hfi);
if (err<>0) then
begin
Writeln('GetLastError:',err{,' ',ps4_pthread_self^.sig._lock});
Case err of
ERROR_ACCESS_DENIED,
ERROR_SHARING_VIOLATION,
ERROR_LOCK_VIOLATION,
ERROR_SHARING_BUFFER_EXCEEDED:
Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_BUFFER_OVERFLOW:
Exit(SCE_KERNEL_ERROR_ENAMETOOLONG);
ERROR_NOT_ENOUGH_MEMORY:
Exit(SCE_KERNEL_ERROR_ENOMEM);
else
Exit(SCE_KERNEL_ERROR_ENOENT);
end;
end;
stat^.st_mode :=file_attr_to_st_mode(hfi.dwFileAttributes);
stat^.st_size :=hfi.nFileSizeLow or (QWORD(hfi.nFileSizeHigh) shl 32);
stat^.st_nlink:=Word(hfi.nNumberOfLinks);
stat^.st_gen :=hfi.nFileIndexLow;
stat^.st_atim:=filetime_to_timespec(hfi.ftLastAccessTime);
stat^.st_mtim:=filetime_to_timespec(hfi.ftLastWriteTime);
stat^.st_ctim:=stat^.st_mtim;
stat^.st_birthtim:=filetime_to_timespec(hfi.ftCreationTime);
end;
else
Exit(SCE_KERNEL_ERROR_EBADF);
end;
Result:=0;
end;
function GetStr(p:Pointer;L:SizeUint):RawByteString;
@ -476,20 +655,25 @@ var
h:THandle;
N:DWORD;
begin
if (data=nil) then Exit(lc_set_errno(EFAULT));
if (size>High(Integer)) then Exit(lc_set_errno(EINVAL));
if (data=nil) then Exit(_set_errno(EFAULT));
if (size>High(Integer)) then Exit(_set_errno(EINVAL));
_sig_lock;
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(lc_set_errno(EBADF));
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(_set_errno(EBADF));
N:=0;
_sig_lock;
if WriteFile(h,data^,size,N,nil) then
begin
Result:=N;
end else
begin
Exit(lc_set_errno(EIO));
Result:=_set_errno(EIO);
end;
_sig_unlock;
end;
function ps4_read(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
@ -497,32 +681,86 @@ var
h:THandle;
N:DWORD;
begin
if (data=nil) then Exit(lc_set_errno(EFAULT));
if (size>High(Integer)) then Exit(lc_set_errno(EINVAL));
if (data=nil) then Exit(_set_errno(EFAULT));
if (size>High(Integer)) then Exit(_set_errno(EINVAL));
_sig_lock;
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(lc_set_errno(EBADF));
_sig_unlock;
if (h=INVALID_HANDLE_VALUE) then Exit(_set_errno(EBADF));
N:=0;
_sig_lock;
if ReadFile(h,data^,size,N,nil) then
begin
Result:=N;
end else
begin
Exit(lc_set_errno(EIO));
Result:=_set_errno(EIO);
end;
_sig_unlock;
end;
// nop nid:libkernel:0D1B81B76A6F2029:_read ps4_write
Function _CreateDir(Const NewDir:RawByteString):Boolean;
var
err:DWORD;
begin
_sig_lock;
Result:=CreateDir(NewDir);
err:=GetLastError;
_sig_unlock;
SetLastError(err);
end;
function ps4_sceKernelMkdir(path:PChar;mode:Integer):Integer; SysV_ABI_CDecl;
var
fn:RawByteString;
begin
Result:=0;
if (path=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if (path[0]=#0) then Exit(SCE_KERNEL_ERROR_ENOENT);
Writeln('sceKernelMkdir:',path,'(',OctStr(mode,3),')');
_sig_lock;
fn:=_parse_filename(path);
if not CreateDir(fn) then Result:=-1;
_sig_unlock;
if (fn='') then Exit(SCE_KERNEL_ERROR_EACCES);
if not _CreateDir(fn) then
begin
Case GetLastError() of
ERROR_INVALID_DRIVE,
ERROR_PATH_NOT_FOUND,
ERROR_FILE_NOT_FOUND:
Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_ACCESS_DENIED,
ERROR_SHARING_VIOLATION,
ERROR_LOCK_VIOLATION,
ERROR_SHARING_BUFFER_EXCEEDED:
Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_BUFFER_OVERFLOW:
Exit(SCE_KERNEL_ERROR_ENAMETOOLONG);
ERROR_NOT_ENOUGH_MEMORY:
Exit(SCE_KERNEL_ERROR_ENOMEM);
ERROR_FILE_EXISTS:
Exit(SCE_KERNEL_ERROR_EEXIST);
ERROR_DISK_FULL:
Exit(SCE_KERNEL_ERROR_ENOSPC);
else
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
end;
function ps4_mkdir(path:PChar):Integer; SysV_ABI_CDecl;
@ -530,9 +768,49 @@ var
fn:RawByteString;
begin
Result:=0;
if (path=nil) then Exit(_set_errno(EINVAL));
if (path[0]=#0) then Exit(_set_errno(ENOENT));
Writeln('mkdir:',path);
_sig_lock;
fn:=_parse_filename(path);
if not CreateDir(fn) then Result:=-1;
_sig_unlock;
if (fn='') then Exit(_set_errno(EACCES));
if not _CreateDir(fn) then
begin
Case GetLastError() of
ERROR_INVALID_DRIVE,
ERROR_PATH_NOT_FOUND,
ERROR_FILE_NOT_FOUND:
Exit(_set_errno(ENOENT));
ERROR_ACCESS_DENIED,
ERROR_SHARING_VIOLATION,
ERROR_LOCK_VIOLATION,
ERROR_SHARING_BUFFER_EXCEEDED:
Exit(_set_errno(EACCES));
ERROR_BUFFER_OVERFLOW:
Exit(_set_errno(ENAMETOOLONG));
ERROR_NOT_ENOUGH_MEMORY:
Exit(_set_errno(ENOMEM));
ERROR_FILE_EXISTS:
Exit(_set_errno(EEXIST));
ERROR_DISK_FULL:
Exit(_set_errno(ENOSPC));
else
Exit(_set_errno(EIO));
end;
end;
end;
end.

602
ps4_libkernel/ps4_libkernel.pas
View File

@ -6,10 +6,11 @@ interface
uses
Windows,
ps4_map_mm,
RWLock,
ps4_types,
sys_types,
ps4_map_mm,
ps4_pthread,
ps4_signal,
ps4_mutex,
ps4_cond,
ps4_sema,
@ -17,147 +18,35 @@ uses
ps4_time,
ps4_kernel_file,
ps4_queue,
ps4_event_flag,
ps4_elf,
ps4_program,
Classes, SysUtils;
{$I sce_errno.inc}
{$I errno.inc}
//trace_manager,
function px2sce(e:Integer):Integer;
function lc_set_errno(r:Integer):Integer;
Classes,
SysUtils;
function ps4_sceKernelIsNeoMode:Integer; SysV_ABI_CDecl;
implementation
function px2sce(e:Integer):Integer;
begin
case e of
0:Result:=0;
EPERM :Result:=SCE_KERNEL_ERROR_EPERM ;
ENOENT :Result:=SCE_KERNEL_ERROR_ENOENT ;
ESRCH :Result:=SCE_KERNEL_ERROR_ESRCH ;
EINTR :Result:=SCE_KERNEL_ERROR_EINTR ;
EIO :Result:=SCE_KERNEL_ERROR_EIO ;
ENXIO :Result:=SCE_KERNEL_ERROR_ENXIO ;
E2BIG :Result:=SCE_KERNEL_ERROR_E2BIG ;
ENOEXEC :Result:=SCE_KERNEL_ERROR_ENOEXEC ;
EBADF :Result:=SCE_KERNEL_ERROR_EBADF ;
ECHILD :Result:=SCE_KERNEL_ERROR_ECHILD ;
EDEADLK :Result:=SCE_KERNEL_ERROR_EDEADLK ;
ENOMEM :Result:=SCE_KERNEL_ERROR_ENOMEM ;
EACCES :Result:=SCE_KERNEL_ERROR_EACCES ;
EFAULT :Result:=SCE_KERNEL_ERROR_EFAULT ;
ENOTBLK :Result:=SCE_KERNEL_ERROR_ENOTBLK ;
EBUSY :Result:=SCE_KERNEL_ERROR_EBUSY ;
EEXIST :Result:=SCE_KERNEL_ERROR_EEXIST ;
EXDEV :Result:=SCE_KERNEL_ERROR_EXDEV ;
ENODEV :Result:=SCE_KERNEL_ERROR_ENODEV ;
ENOTDIR :Result:=SCE_KERNEL_ERROR_ENOTDIR ;
EISDIR :Result:=SCE_KERNEL_ERROR_EISDIR ;
EINVAL :Result:=SCE_KERNEL_ERROR_EINVAL ;
ENFILE :Result:=SCE_KERNEL_ERROR_ENFILE ;
EMFILE :Result:=SCE_KERNEL_ERROR_EMFILE ;
ENOTTY :Result:=SCE_KERNEL_ERROR_ENOTTY ;
ETXTBSY :Result:=SCE_KERNEL_ERROR_ETXTBSY ;
EFBIG :Result:=SCE_KERNEL_ERROR_EFBIG ;
ENOSPC :Result:=SCE_KERNEL_ERROR_ENOSPC ;
ESPIPE :Result:=SCE_KERNEL_ERROR_ESPIPE ;
EROFS :Result:=SCE_KERNEL_ERROR_EROFS ;
EMLINK :Result:=SCE_KERNEL_ERROR_EMLINK ;
EPIPE :Result:=SCE_KERNEL_ERROR_EPIPE ;
EDOM :Result:=SCE_KERNEL_ERROR_EDOM ;
ERANGE :Result:=SCE_KERNEL_ERROR_ERANGE ;
EAGAIN :Result:=SCE_KERNEL_ERROR_EAGAIN ;
EINPROGRESS :Result:=SCE_KERNEL_ERROR_EINPROGRESS ;
EALREADY :Result:=SCE_KERNEL_ERROR_EALREADY ;
ENOTSOCK :Result:=SCE_KERNEL_ERROR_ENOTSOCK ;
EDESTADDRREQ :Result:=SCE_KERNEL_ERROR_EDESTADDRREQ ;
EMSGSIZE :Result:=SCE_KERNEL_ERROR_EMSGSIZE ;
EPROTOTYPE :Result:=SCE_KERNEL_ERROR_EPROTOTYPE ;
ENOPROTOOPT :Result:=SCE_KERNEL_ERROR_ENOPROTOOPT ;
EPROTONOSUPPORT:Result:=SCE_KERNEL_ERROR_EPROTONOSUPPORT;
ESOCKTNOSUPPORT:Result:=SCE_KERNEL_ERROR_ESOCKTNOSUPPORT;
EOPNOTSUPP :Result:=SCE_KERNEL_ERROR_EOPNOTSUPP ;
EPFNOSUPPORT :Result:=SCE_KERNEL_ERROR_EPFNOSUPPORT ;
EAFNOSUPPORT :Result:=SCE_KERNEL_ERROR_EAFNOSUPPORT ;
EADDRINUSE :Result:=SCE_KERNEL_ERROR_EADDRINUSE ;
EADDRNOTAVAIL :Result:=SCE_KERNEL_ERROR_EADDRNOTAVAIL ;
ENETDOWN :Result:=SCE_KERNEL_ERROR_ENETDOWN ;
ENETUNREACH :Result:=SCE_KERNEL_ERROR_ENETUNREACH ;
ENETRESET :Result:=SCE_KERNEL_ERROR_ENETRESET ;
ECONNABORTED :Result:=SCE_KERNEL_ERROR_ECONNABORTED ;
ECONNRESET :Result:=SCE_KERNEL_ERROR_ECONNRESET ;
ENOBUFS :Result:=SCE_KERNEL_ERROR_ENOBUFS ;
EISCONN :Result:=SCE_KERNEL_ERROR_EISCONN ;
ENOTCONN :Result:=SCE_KERNEL_ERROR_ENOTCONN ;
ESHUTDOWN :Result:=SCE_KERNEL_ERROR_ESHUTDOWN ;
ETOOMANYREFS :Result:=SCE_KERNEL_ERROR_ETOOMANYREFS ;
ETIMEDOUT :Result:=SCE_KERNEL_ERROR_ETIMEDOUT ;
ECONNREFUSED :Result:=SCE_KERNEL_ERROR_ECONNREFUSED ;
ELOOP :Result:=SCE_KERNEL_ERROR_ELOOP ;
ENAMETOOLONG :Result:=SCE_KERNEL_ERROR_ENAMETOOLONG ;
EHOSTDOWN :Result:=SCE_KERNEL_ERROR_EHOSTDOWN ;
EHOSTUNREACH :Result:=SCE_KERNEL_ERROR_EHOSTUNREACH ;
ENOTEMPTY :Result:=SCE_KERNEL_ERROR_ENOTEMPTY ;
EPROCLIM :Result:=SCE_KERNEL_ERROR_EPROCLIM ;
EUSERS :Result:=SCE_KERNEL_ERROR_EUSERS ;
EDQUOT :Result:=SCE_KERNEL_ERROR_EDQUOT ;
ESTALE :Result:=SCE_KERNEL_ERROR_ESTALE ;
EREMOTE :Result:=SCE_KERNEL_ERROR_EREMOTE ;
EBADRPC :Result:=SCE_KERNEL_ERROR_EBADRPC ;
ERPCMISMATCH :Result:=SCE_KERNEL_ERROR_ERPCMISMATCH ;
EPROGUNAVAIL :Result:=SCE_KERNEL_ERROR_EPROGUNAVAIL ;
EPROGMISMATCH :Result:=SCE_KERNEL_ERROR_EPROGMISMATCH ;
EPROCUNAVAIL :Result:=SCE_KERNEL_ERROR_EPROCUNAVAIL ;
ENOLCK :Result:=SCE_KERNEL_ERROR_ENOLCK ;
ENOSYS :Result:=SCE_KERNEL_ERROR_ENOSYS ;
EFTYPE :Result:=SCE_KERNEL_ERROR_EFTYPE ;
EAUTH :Result:=SCE_KERNEL_ERROR_EAUTH ;
ENEEDAUTH :Result:=SCE_KERNEL_ERROR_ENEEDAUTH ;
EIDRM :Result:=SCE_KERNEL_ERROR_EIDRM ;
ENOMSG :Result:=SCE_KERNEL_ERROR_ENOMSG ;
EOVERFLOW :Result:=SCE_KERNEL_ERROR_EOVERFLOW ;
ECANCELED :Result:=SCE_KERNEL_ERROR_ECANCELED ;
EILSEQ :Result:=SCE_KERNEL_ERROR_EILSEQ ;
ENOATTR :Result:=SCE_KERNEL_ERROR_ENOATTR ;
EDOOFUS :Result:=SCE_KERNEL_ERROR_EDOOFUS ;
EBADMSG :Result:=SCE_KERNEL_ERROR_EBADMSG ;
EMULTIHOP :Result:=SCE_KERNEL_ERROR_EMULTIHOP ;
ENOLINK :Result:=SCE_KERNEL_ERROR_ENOLINK ;
EPROTO :Result:=SCE_KERNEL_ERROR_EPROTO ;
ENOTCAPABLE :Result:=SCE_KERNEL_ERROR_ENOTCAPABLE ;
ECAPMODE :Result:=SCE_KERNEL_ERROR_ECAPMODE ;
ENOBLK :Result:=SCE_KERNEL_ERROR_ENOBLK ;
EICV :Result:=SCE_KERNEL_ERROR_EICV ;
ENOPLAYGOENT :Result:=SCE_KERNEL_ERROR_ENOPLAYGOENT ;
EREVOKE :Result:=SCE_KERNEL_ERROR_EREVOKE ;
ESDKVERSION :Result:=SCE_KERNEL_ERROR_ESDKVERSION ;
ESTART :Result:=SCE_KERNEL_ERROR_ESTART ;
ESTOP :Result:=SCE_KERNEL_ERROR_ESTOP ;
else
Result:=SCE_KERNEL_ERROR_UNKNOWN;
end;
end;
var
_error:QWORD;
function lc_set_errno(r:Integer):Integer;
begin
if (r<>0) then
begin
_error:=r;
Exit(-1);
end;
Result:=r;
end;
uses
sys_kernel,
sys_pthread,
sys_signal;
function ps4___error:Pointer; SysV_ABI_CDecl;
begin
//Writeln('___error');
Result:=@_error;
Result:=_error;
end;
function ps4_sceKernelError(i:Integer):Integer; SysV_ABI_CDecl;
begin
if (i=0) then
Result:=0
else
Result:=i-$7ffe0000;
end;
Const
@ -167,19 +56,32 @@ Const
procedure ps4_stack_chk_fail; SysV_ABI_CDecl;
begin
Writeln('Stack overflow detected! Aborting program.');
DebugBreak;
end;
{$I StopNotificationReason.inc}
// eStopNotificationReason
procedure ps4_sceKernelDebugRaiseException(dwStopReason,dwStopId:DWORD); SysV_ABI_CDecl;
var
t:pthread;
begin
t:=_get_curthread;
if (t<>nil) then
Writeln('RaiseThread=',t^.name);
Writeln(StdErr,'RaiseException:',HexStr(dwStopReason,8),':',HexStr(dwStopId,8),':',GetStopReasonInfo(dwStopReason));
DebugBreak;
end;
procedure ps4_sceKernelDebugRaiseExceptionOnReleaseMode; assembler;
asm
xor %rax,%rax
procedure ps4_sceKernelDebugRaiseExceptionOnReleaseMode(dwStopReason,dwStopId:DWORD); SysV_ABI_CDecl;
var
t:pthread;
begin
t:=_get_curthread;
if (t<>nil) then
Writeln('RaiseThread=',t^.name);
Writeln(StdErr,'RaiseException:',HexStr(dwStopReason,8),':',HexStr(dwStopId,8),':',GetStopReasonInfo(dwStopReason));
DebugBreak;
end;
//ps4 neo mode is support? (Ps4 Pro)
@ -198,76 +100,41 @@ end;
// void *memblock
//);
const
_SIG_WORDS =4;
_SIG_MAXSIG =128;
//_SIG_IDX(sig) ((sig) - 1)
//_SIG_WORD(sig) (_SIG_IDX(sig) >> 5)
//_SIG_BIT(sig) (1U << (_SIG_IDX(sig) & 31))
//_SIG_VALID(sig) ((sig) <= _SIG_MAXSIG && (sig) > 0)
SIG_BLOCK =1;
SIG_UNBLOCK =2;
SIG_SETMASK =3;
SIGPROCMASK_OLD =$0001;
SIGPROCMASK_PROC_LOCKED =$0002;
SIGPROCMASK_PS_LOCKED =$0004;
SIGPROCMASK_FASTBLK =$0008;
type
P__sigset_t=^__sigset_t;
__sigset_t=packed record
__bits:array[0.._SIG_WORDS-1] of DWORD;
end;
//function sigfillset(_set:P__sigset_t):Integer;
procedure ps4_sigfillset; assembler; nostackframe;
label
_end;
asm
xor %eax, %eax
dec %eax
test %rdi,%rdi
je _end
xor %rax, %rax
mov %rax, (%rdi) //0+1
mov %rax, 0x8(%rdi) //2+3
_end:
end;
function ps4_sigprocmask(how:Integer;_set,oldset:P__sigset_t):Integer; SysV_ABI_CDecl;
begin
//Writeln('sigprocmask:',how);
//if (_set<>nil) and (oldset<>nil) then oldset^:=_set^;
Result:=0;
end;
function ps4__sigprocmask(how:QWORD;_set,oldset:P__sigset_t):Integer; cdecl; SysV_ABI_CDecl;
begin
//Writeln('_sigprocmask:',how);
if (_set<>nil) and (oldset<>nil) then oldset^:=_set^;
Result:=0;
end;
function ps4_is_signal_return(P:Pointer):Integer; SysV_ABI_CDecl;
begin
Writeln('_is_signal_return:',HexStr(P));
Result:=1;
end;
function ps4_sceKernelGetModuleInfoFromAddr(Addr:Pointer;P2:Integer;pOut:PKernelModuleInfo):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetModuleInfoFromAddr(Addr:Pointer;P2:Integer;info:PKernelModuleInfo):Integer; SysV_ABI_CDecl;
var
node:TElf_node;
begin
Writeln('GetModuleInfoFromAddr:',HexStr(Addr),':',P2,':',HexStr(pOut));
node:=ps4_app.FindFileByCodeAdr(Addr);
if (node=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if pOut<>nil then
if (info=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
_sig_lock;
Writeln('GetModuleInfoFromAddr:',HexStr(Addr),':',P2,':',HexStr(info));
node:=ps4_app.AcqureFileByCodeAdr(Addr);
if (node=nil) then
begin
pOut^:=Telf_file(node).ModuleInfo;
_sig_unlock;
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
info^:=node.GetModuleInfo;
node.Release;
_sig_unlock;
Result:=0;
end;
function ps4_sceKernelGetModuleInfo(handle:Integer;info:PKernelModuleInfo):Integer; SysV_ABI_CDecl;
var
node:TElf_node;
begin
if (info=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
_sig_lock;
Writeln('sceKernelGetModuleInfo:',handle,':',HexStr(info));
node:=ps4_app.AcqureFileByHandle(handle);
if (node=nil) then
begin
_sig_unlock;
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
info^:=node.GetModuleInfo;
node.Release;
_sig_unlock;
Result:=0;
end;
@ -287,17 +154,9 @@ begin
end;
function ps4_sceKernelGetProcParam:Pointer; SysV_ABI_CDecl;
var
elf:Telf_file;
Param:PSceProcParam;
begin
Result:=nil;
Writeln('KernelGetProcParam');
elf:=Telf_file(ps4_program.ps4_app.prog);
if (elf=nil) then Exit;
if (elf.pProcParam=0) then Exit;
Param:=elf.mMap.pAddr+elf.pProcParam;
Result:=Param;
Result:=GetProcParam;
end;
type
@ -309,8 +168,8 @@ type
procedure ps4_sceKernelRtldSetApplicationHeapAPI(heap_api:PAppHeapAPI); SysV_ABI_CDecl;
begin
Writeln('SetApplicationHeapAPI:',HexStr(heap_api));
Writeln(HexStr(heap_api^._malloc)); //__malloc
Writeln(HexStr(heap_api^._free)); //__free
Writeln(' __malloc:',HexStr(heap_api^._malloc)); //__malloc
Writeln(' __free:',HexStr(heap_api^._free)); //__free
end;
//registred destroy proc?
@ -320,8 +179,11 @@ begin
Result:=0;
end;
type
TKernelAtexitFunc=function(param:Integer):Integer;
function ps4___cxa_atexit(func:atexit_func;arg:Pointer;dso_handle:Pointer):Integer; SysV_ABI_CDecl;
begin
Writeln('__cxa_atexit:',HexStr(func));
Result:=0;
end;
//registred thread atexit proc?
function ps4_sceKernelSetThreadAtexitCount(proc:TKernelAtexitFunc):Integer; SysV_ABI_CDecl;
@ -330,9 +192,6 @@ begin
Result:=0;
end;
type
TKernelAtexitReportFunc=procedure(param:Integer);
function ps4_sceKernelSetThreadAtexitReport(proc:TKernelAtexitReportFunc):Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelSetThreadAtexitReport:',HexStr(proc));
@ -361,46 +220,143 @@ begin
Result:=nil;
end;
function ps4_sceKernelIsAddressSanitizerEnabled({name:Pchar}):Integer; SysV_ABI_CDecl;
function ps4_sceKernelIsAddressSanitizerEnabled():Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelIsAddressSanitizerEnabled:'{,name});
Writeln('sceKernelIsAddressSanitizerEnabled');
Result:=0;
end;
type
SceKernelModule=Integer;
PSceKernelLoadModuleOpt=^SceKernelLoadModuleOpt;
SceKernelLoadModuleOpt=packed record
size:size_t;
end;
function ps4_sceKernelGetCompiledSdkVersion(sdkVersion:PDWORD):Integer; SysV_ABI_CDecl;
begin
if (sdkVersion=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
sdkVersion^:=$FFFFFFFF;
Result:=0;
end;
//dynamic load????
function ps4_sceKernelLoadStartModule(moduleFileName:Pchar;
argc:size_t;
argp:PPchar;
argp:PPointer;
flags:DWORD;
pOpt:PSceKernelLoadModuleOpt;
pRes:PInteger):SceKernelModule; SysV_ABI_CDecl;
var
node:TElf_node;
fn:RawByteString;
i:Integer;
begin
Result:=0;
_sig_lock;
Writeln('Load Lib:',moduleFileName);
Result:=1;
fn:=_parse_filename(moduleFileName);
Writeln('Load File:',fn);
node:=LoadPs4ElfFromFile(fn);
if (node<>nil) then
begin
node.Acqure;
node.Prepare;
ps4_app.RegistredElf(node);
ps4_app.ResolveDepended(node);
ps4_app.LoadSymbolImport(nil);
ps4_app.ReLoadSymbolImport(Pointer(node));
ps4_app.InitProt;
ps4_app.InitThread(0);
Result:=node.Handle;
i:=node.module_start(argc,argp);
node.Release;
if (pRes<>nil) then pRes^:=i;
if (i<0) then Result:=SCE_KERNEL_ERROR_EINVAL;
end else
begin
Result:=SCE_KERNEL_ERROR_ENOENT;
end;
_sig_unlock;
end;
function ps4_memset(ptr:Pointer;value:Integer;num:size_t):Pointer; assembler; nostackframe;
asm
//mov %rdx , %rdx //3->2
mov %rsi , %r8 //2->3
mov %rdi , %rcx //1
jmp FillByte
Function ps4_sceKernelDlsym(handle:Integer;symbol:PChar;addrp:PPointer):Integer; SysV_ABI_CDecl;
var
node:TElf_node;
p:Pointer;
begin
Result:=0;
if (addrp=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
_sig_lock;
Writeln('sceKernelDlsym:',symbol);
node:=ps4_app.AcqureFileByHandle(handle);
if (node=nil) then
begin
_sig_unlock;
Exit(SCE_KERNEL_ERROR_ESRCH);
end;
p:=node.get_proc_by_name(symbol);
if (p<>nil) then
begin
addrp^:=p;
end else
begin
Result:=SCE_KERNEL_ERROR_EFAULT;
end;
node.Release;
_sig_unlock;
end;
function ps4_memcmp(buf1,buf2:Pointer;count:size_t):Integer; assembler; nostackframe;
asm
mov %rdx , %r8 //3
mov %rsi , %rdx //2
mov %rdi , %rcx //1
jmp CompareByte
Function ps4_sceKernelGetModuleList(list:PInteger;numArray:QWORD;actualNum:PQWORD):Integer; SysV_ABI_CDecl;
var
i:QWORD;
node:TElf_node;
begin
Result:=0;
if (list=nil) or (actualNum=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
_sig_lock;
ps4_app.LockRd;
i:=0;
node:=ps4_app.FirstFile;
While (node<>nil) do
begin
if (i<numArray) then
begin
list[i]:=node.Handle;
end;
Inc(i);
node:=node.Next;
end;
ps4_app.Unlock;
_sig_unlock;
actualNum^:=i;
if (i>numArray) then Result:=SCE_KERNEL_ERROR_ENOMEM;
Writeln('sceKernelGetModuleList:',HexStr(list),' ',numArray,' ',i);
end;
function ps4_memset(ptr:Pointer;value:Integer;num:size_t):Pointer; SysV_ABI_CDecl;
begin
FillByte(ptr^,num,Byte(value));
Result:=ptr;
end;
function ps4_memcmp(buf1,buf2:Pointer;count:size_t):Integer; SysV_ABI_CDecl;
begin
Result:=CompareByte(buf1^,buf2^,count);
end;
function ps4_memcpy_s(dst:Pointer;dstSize:size_t;src:Pointer;count:size_t):Integer; SysV_ABI_CDecl;
@ -410,14 +366,14 @@ begin
if (dst=nil) or (src=nil) then
begin
if (dst<>nil) then FillChar(dst^,dstSize,0);
lc_set_errno(EINVAL);
_set_errno(EINVAL);
Exit(EINVAL);
end;
if (dstSize<count) then
begin
FillChar(dst^,dstSize,0);
lc_set_errno(ERANGE);
_set_errno(ERANGE);
Exit(ERANGE);
end;
@ -432,7 +388,7 @@ begin
if (dst=nil) or (src=nil) then
begin
if (dst<>nil) then dst[0]:=#0;
lc_set_errno(EINVAL);
_set_errno(EINVAL);
Exit(EINVAL);
end;
@ -440,7 +396,7 @@ begin
if (count>destSize) then
begin
dst[0]:=#0;
lc_set_errno(ERANGE);
_set_errno(ERANGE);
Exit(ERANGE);
end;
@ -448,12 +404,10 @@ begin
Result:=0;
end;
function ps4_memmove(dst,src:Pointer;len:size_t):Pointer; assembler; nostackframe;
asm
mov %rdx, %r8 //3
mov %rsi, %rcx //2->1
mov %rdi, %rdx //1->2
call Move
function ps4_memcpy(dst,src:Pointer;len:size_t):Pointer; SysV_ABI_CDecl;
begin
Move(src^,dst^,len);
Result:=dst;
end;
const
@ -477,22 +431,29 @@ begin
if (capacity<=1440) then Exit;
Writeln('sceLibcMspaceCreate:',name,':',HexStr(base),'..',HexStr(base+capacity));
Result:=AllocMem(SizeOf(TSceLibcMspace));
Result:=SwAllocMem(SizeOf(TSceLibcMspace));
Result^.base:=base;
Result^.capacity:=capacity;
Result^.count:=1440;
_sig_lock;
rwlock_init(Result^.lock);
_sig_unlock;
end;
function ps4_sceLibcMspaceMalloc(msp:SceLibcMspace;size:size_t):Pointer; SysV_ABI_CDecl;
begin
Result:=nil;
if (msp=nil) then Exit;
_sig_lock;
rwlock_wrlock(msp^.lock);
if (msp^.count+size)>msp^.capacity then Exit;
Result:=msp^.base+msp^.count;
msp^.count:=msp^.count+size;
if ((msp^.count+size)<=msp^.capacity) then
begin
Result:=msp^.base+msp^.count;
msp^.count:=msp^.count+size;
end;
rwlock_unlock(msp^.lock);
_sig_unlock;
end;
function ps4_expf(x:Single):Single; SysV_ABI_CDecl;
@ -541,7 +502,7 @@ begin
end;
const
__progname:PChar='progname.elf';
__progname:PChar='eboot.bin'; //argv[0]
Const
Need_sceLibcInternal:QWORD=1;
@ -550,6 +511,23 @@ Const
_Stdout:QWORD=1;
_Stderr:QWORD=2;
function _get_proc_libSceLibcInternal(src:PLIBRARY;nid:QWORD):Pointer;
var
lib:PLIBRARY;
begin
Result:=nil;
lib:=ps4_app.GetLib('libc');
if (lib<>nil) then
begin
Result:=lib^.get_proc(Nid);
end;
if (Result=nil) then
begin
Result:=src^._get_proc(nid);
end;
end;
{
function _get_proc_libSceLibcInternal(src:PLIBRARY;nid:QWORD):Pointer;
var
lib:PLIBRARY;
@ -578,6 +556,22 @@ begin
Result:=@ps4_expf;
end;
end;
$DC63E98D0740313C: //__cxa_guard_acquire
begin
lib:=ps4_app.GetLib('libc');
if (lib<>nil) then
begin
Result:=lib^.get_proc(Nid);
end;
end;
$F6B01E00D4F6B721: //__cxa_guard_release
begin
lib:=ps4_app.GetLib('libc');
if (lib<>nil) then
begin
Result:=lib^.get_proc(Nid);
end;
end;
end;
if (Result<>nil) then
begin
@ -585,6 +579,7 @@ begin
end;
end;
end;
}
function Load_libSceLibcInternal(Const name:RawByteString):TElf_node;
var
@ -607,10 +602,12 @@ begin
lib^.set_proc($0DF8AF3C0AE1B9C8,@ps4_memcmp);
lib^.set_proc($3452ECF9D44918D8,@ps4_memcpy_s);
lib^.set_proc($E576B600234409DA,@ps4_strcpy_s);
lib^.set_proc($437541C425E1507B,@ps4_memmove);//memcpy
lib^.set_proc($437541C425E1507B,@ps4_memcpy);
lib^.set_proc($FE19F5B5C547AB94,@ps4_sceLibcMspaceCreate);
lib^.set_proc($3898E6FD03881E52,@ps4_sceLibcMspaceMalloc);
lib^.set_proc($B6CBC49A77A7CF8F,@ps4___cxa_atexit);
lib:=Result._add_lib('libSceLibcInternalExt');
lib^.set_proc($356B53375D1C2731,@ps4_sceLibcHeapGetTraceInfo);
@ -643,24 +640,33 @@ begin
lib^.set_proc($763C713A65BAFDAC,@__progname);
lib^.set_proc($F41703CA43E6A352,@ps4___error);
lib^.set_proc($0F8CA56B7BF1E2D6,@ps4_sceKernelError);
lib^.set_proc($7FBB8EC58F663355,@ps4_stack_chk_guard);
lib^.set_proc($3AEDE22F569BBE78,@ps4_stack_chk_fail);
lib^.set_proc($91BC385071D2632D,@ps4_pthread_cxa_finalize);
//signal
lib^.set_proc($38C0D128A019F08E,@ps4_sceKernelDebugRaiseException);
lib^.set_proc($CC4FF05C86632E83,@ps4_sceKernelDebugRaiseExceptionOnReleaseMode);
lib^.set_proc($5644C0B2B643709D,@ps4_sigfillset);
lib^.set_proc($68F732A6D6CE899B,@ps4_sigprocmask);
lib^.set_proc($EB1569CB415DABE2,@ps4__sigprocmask);
lib^.set_proc($EB1569CB415DABE2,@ps4_sigprocmask);
lib^.set_proc($72B6F98FB9A49357,@ps4_is_signal_return);
//signal
lib^.set_proc($93E017AAEDBF7817,@ps4_getpagesize);
lib^.set_proc($04F13DB3DBD0417A,@ps4_mmap);
lib^.set_proc($52A0C68D7039C943,@ps4_munmap);
lib^.set_proc($B59638F9264D1610,@ps4_msync);
lib^.set_proc($61039FC4BE107DE5,@ps4_mprotect);
lib^.set_proc($FD84D6FAA5DCDC24,@ps4_sceKernelInternalMemoryGetModuleSegmentInfo);
lib^.set_proc($7FB28139A7F2B17A,@ps4_sceKernelGetModuleInfoFromAddr);
lib^.set_proc($914A60AD722BCFB4,@ps4_sceKernelGetModuleInfo);
lib^.set_proc($F79F6AADACCF22B8,@ps4_sceKernelGetProcParam);
lib^.set_proc($A7911C41E11E2401,@ps4_sceKernelRtldSetApplicationHeapAPI);
lib^.set_proc($ACD856CFE96F38C5,@ps4_sceKernelSetThreadDtors);
@ -668,8 +674,11 @@ begin
lib^.set_proc($5A109CD70DC48522,@ps4_sceKernelSetThreadAtexitReport);
lib^.set_proc($6E7671620005780D,@ps4_sceKernelGetSanitizerNewReplaceExternal);
lib^.set_proc($8E1FBC5E22B82DE1,@ps4_sceKernelIsAddressSanitizerEnabled);
lib^.set_proc($581EBA7AFBBC6EC5,@ps4_sceKernelGetCompiledSdkVersion);
lib^.set_proc($C33BEA4F852A297F,@ps4_sceKernelLoadStartModule);
lib^.set_proc($22EC6752E5E4E818,@ps4_sceKernelGetModuleList);
lib^.set_proc($2F01BC8379E2AB00,@ps4_sceKernelDlsym);
//mutex
@ -758,14 +767,29 @@ begin
//cond
lib^.set_proc($98AA13C74DC74560,@ps4_pthread_condattr_init);
lib^.set_proc($74972E4159FAFC8C,@ps4_pthread_condattr_destroy);
lib^.set_proc($7130D8C5350D3E13,@ps4_pthread_condattr_getclock);
lib^.set_proc($123965680A803D9A,@ps4_pthread_condattr_setclock);
lib^.set_proc($874A94A92B8E982F,@ps4_pthread_condattr_getpshared);
lib^.set_proc($DC1A4FF39D21053E,@ps4_pthread_condattr_setpshared);
lib^.set_proc($D13C959383122EDD,@ps4_pthread_cond_init);
lib^.set_proc($9A4C767D584D32C8,@ps4_pthread_cond_broadcast);
lib^.set_proc($D8C3B2FAB51FBA14,@ps4_pthread_cond_signal);
lib^.set_proc($9A4C767D584D32C8,@ps4_pthread_cond_broadcast);
lib^.set_proc($3A9F130466392878,@ps4_pthread_cond_wait);
lib^.set_proc($DBB6C08222663A1D,@ps4_pthread_cond_timedwait);
lib^.set_proc($9B9FF66EC35FBFBB,@ps4_scePthreadCondattrInit);
lib^.set_proc($C1A3DCC58891DD60,@ps4_scePthreadCondattrDestroy);
lib^.set_proc($D936FDDAABA9AE5D,@ps4_scePthreadCondInit);
lib^.set_proc($83E3D977686269C8,@ps4_scePthreadCondDestroy);
lib^.set_proc($90387F35FC6032D1,@ps4_scePthreadCondSignal);
lib^.set_proc($58A0172785C13D0E,@ps4_scePthreadCondWait);
lib^.set_proc($06632363199EC35C,@ps4_scePthreadCondTimedwait);
@ -777,27 +801,71 @@ begin
lib^.set_proc($9EC628351CB0C0D8,@ps4_scePthreadAttrInit);
lib^.set_proc($EB6282C04326CDC3,@ps4_scePthreadAttrDestroy);
lib^.set_proc($C2D92DFED791D6CA,@ps4_pthread_attr_init);
lib^.set_proc($CC772163C7EDE699,@ps4_pthread_attr_destroy);
lib^.set_proc($5135F325B5A18531,@ps4_scePthreadAttrSetstacksize);
lib^.set_proc($D90D33EAB9C1AD31,@ps4_pthread_attr_setstacksize);
lib^.set_proc($FD6ADEA6BB6ED10B,@ps4_scePthreadAttrSetdetachstate);
lib^.set_proc($E3E87D133C0A1782,@ps4_scePthreadAttrSetschedpolicy);
lib^.set_proc($0F3112F61405E1FE,@ps4_scePthreadAttrSetschedparam);
lib^.set_proc($DEAC603387B31130,@ps4_scePthreadAttrSetaffinity);
lib^.set_proc($F3EB39073663C528,@ps4_scePthreadAttrGetaffinity);
lib^.set_proc($7976D44A911A4EC0,@ps4_scePthreadAttrSetinheritsched);
lib^.set_proc($46EDFA7E24ED2730,@ps4_scePthreadAttrGetstackaddr);
lib^.set_proc($FDF03EED99460D0B,@ps4_scePthreadAttrGetstacksize);
lib^.set_proc($FEAB8F6B8484254C,@ps4_scePthreadAttrGetstack);
lib^.set_proc($25A44CCBE41CA5E5,@ps4_scePthreadAttrGetdetachstate);
lib^.set_proc($5544F5652AC74F42,@ps4_pthread_attr_getdetachstate);
lib^.set_proc($C755FBE9AAD83315,@ps4_scePthreadAttrGet);
lib^.set_proc($E9482DC15FB4CDBE,@ps4_scePthreadCreate);
lib^.set_proc($3B184807C2C1FCF4,@ps4_pthread_create);
lib^.set_proc($E2A1AB47A7A83FD6,@ps4_scePthreadDetach);
lib^.set_proc($F94D51E16B57BE87,@ps4_pthread_detach);
lib^.set_proc($A27358F41CA7FD6F,@ps4_scePthreadJoin);
lib^.set_proc($678428B15B80B00D,@ps4_pthread_once);
lib^.set_proc($D786CE00200D4C1A,@ps4_scePthreadOnce);
lib^.set_proc($DCFB55EA9DD0357E,@ps4_scePthreadEqual);
lib^.set_proc($ED7976E7B33854D2,@ps4_pthread_equal);
lib^.set_proc($DE483BAD3D0D408B,@ps4_scePthreadExit);
lib^.set_proc($149AD3E4BB940405,@ps4_pthread_exit);
lib^.set_proc($128B51F1ADC049FE,@ps4_pthread_self);
lib^.set_proc($688F8E782CFCC6B4,@ps4_scePthreadSelf);
lib^.set_proc($1E82D558D6A70417,@ps4_getpid);
lib^.set_proc($1E8C3B07C39EB7A9,@ps4_scePthreadGetname);
lib^.set_proc($181518EF2C1D50B1,@ps4_scePthreadRename);
lib^.set_proc($6EDDC24C12A61B22,@ps4_scePthreadSetaffinity);
lib^.set_proc($ADCAD5149B105916,@ps4_scePthreadGetaffinity);
lib^.set_proc($D6D2B21BB465309A,@ps4_scePthreadGetprio);
lib^.set_proc($5B41E99B65F4B8F1,@ps4_scePthreadSetprio);
lib^.set_proc($3F8D644D6512DC42,@ps4_scePthreadGetschedparam);
lib^.set_proc($A084454E3A082DB8,@ps4_scePthreadSetschedparam);
lib^.set_proc($08136D5CEA1E7FF1,@ps4_sched_get_priority_max);
lib^.set_proc($9B4892EA336C5DDB,@ps4_sched_get_priority_min);
lib^.set_proc($4FBDA1CFA7DFAB4F,@ps4_scePthreadYield);
lib^.set_proc($0791A65432B0A67D,@ps4_pthread_yield);
lib^.set_proc($E1979959C32C015D,@ps4_pthread_cleanup_push);
lib^.set_proc($455C5BD12B1AE6DD,@ps4_pthread_cleanup_pop);
lib^.set_proc($D71BED515C75FD28,@ps4___pthread_cleanup_push_imp);
lib^.set_proc($896B0595831FDCAC,@ps4___pthread_cleanup_pop_imp);
lib^.set_proc($9AA50B35D8A64E7D,@ps4_pthread_key_create);
lib^.set_proc($E81A4466E0D3ED82,@ps4_pthread_key_delete);
lib^.set_proc($D3F297692EF4C72E,@ps4_pthread_getspecific);
lib^.set_proc($5AB38BBC7534C903,@ps4_pthread_setspecific);
//thread
@ -819,10 +887,21 @@ begin
//queue
//event_flag
lib^.set_proc($0691686E8509A195,@ps4_sceKernelCreateEventFlag);
lib^.set_proc($253BC17E58586B34,@ps4_sceKernelWaitEventFlag);
lib^.set_proc($20E9D2BC7CEABBA0,@ps4_sceKernelSetEventFlag);
lib^.set_proc($EEE8411564404BAD,@ps4_sceKernelClearEventFlag);
//event_flag
//time
lib^.set_proc($9FCF2FC770B99D6F,@ps4_gettimeofday);
lib^.set_proc($B26223EDEAB3644F,@ps4_clock_getres);
lib^.set_proc($94B313F6F240724D,@ps4_clock_gettime);
lib^.set_proc($7A37A471A35036AD,@ps4_sceKernelGettimeofday);
lib^.set_proc($D63DD2DE7FED4D6E,@ps4_sceKernelGetTscFrequency);
lib^.set_proc($FF62115023BFFCF3,@ps4_sceKernelReadTsc);
lib^.set_proc($4018BB1C22B4DE1C,@ps4_sceKernelClockGettime);
@ -842,12 +921,18 @@ begin
lib^.set_proc($FABDEB305C08B55E,@ps4_sceKernelPread);
lib^.set_proc($50AD939760D6527B,@ps4_sceKernelClose);
lib^.set_proc($C2E0ABA081A3B768,@ps4_open);
lib^.set_proc($6D8FCF3BA261CE14,@ps4_close);
lib^.set_proc($171559A81000EE4B,@ps4_write);
lib^.set_proc($0D1B81B76A6F2029,@ps4_read);
lib^.set_proc($D7F2C52E6445C713,@ps4_sceKernelMkdir);
lib^.set_proc($795F70003DAB8880,@ps4_sceKernelStat);
lib^.set_proc($13A6A8DF8C0FC3E5,@ps4_stat);
lib^.set_proc($901C023EC617FE6E,@ps4_sceKernelFstat);
lib^.set_proc($9AA40C875CCF3D3F,@ps4_fstat);
lib^.set_proc($D7F2C52E6445C713,@ps4_sceKernelMkdir);
lib^.set_proc($246322A3EDB52F87,@ps4_mkdir);
//file
@ -855,6 +940,11 @@ begin
px:=Result._add_lib('libScePosix');
px^.MapSymbol:=lib^.MapSymbol;
lib:=Result._add_lib('libkernel_unity');
lib^.set_proc($5A4C0477737BC346,@ps4_sceKernelInstallExceptionHandler);
lib^.set_proc($8A5D379E5B8A7CC9,@ps4_sceKernelRaiseException);
end;
initialization

218
ps4_libkernel/ps4_map_mm.pas
View File

@ -8,8 +8,9 @@ uses
Windows,
g23tree,
RWLock,
ps4_types,
Classes, SysUtils;
sys_types,
Classes,
SysUtils;
Const
SCE_KERNEL_MAIN_DMEM_SIZE=$180000000;
@ -83,6 +84,7 @@ function ps4_sceKernelQueryMemoryProtection(addr:Pointer;pStart,pEnd:PPointer;pP
function ps4_mmap(addr:Pointer;len:size_t;prot,flags:Integer;fd:Integer;offset:size_t):Pointer; SysV_ABI_CDecl;
function ps4_munmap(addr:Pointer;len:size_t):Integer; SysV_ABI_CDecl;
function ps4_msync(addr:Pointer;len:size_t;flags:Integer):Integer; SysV_ABI_CDecl;
function ps4_mprotect(addr:Pointer;len:size_t;prot:Integer):Integer; SysV_ABI_CDecl;
type
TGpuMemAlloc=function(addr:Pointer;len:size_t):Pointer;
@ -109,7 +111,8 @@ Procedure UnRegistredStack;
implementation
uses
ps4_libkernel;
sys_kernel,
sys_signal;
const
INVALID_DIRECT=QWORD(-1);
@ -160,6 +163,18 @@ type
info:TnodeInfo;
end;
PBlockBig=^TBlockBig;
TBlockBig=object(TBlock)
direct:QWORD;
Handle:Pointer;
prot:Byte;
end;
PBlock64k=^TBlock64k;
TBlock64k=object(TBlock)
nodes:array[0..3] of TdnodeAdr;
end;
function IsPowerOfTwo(x:QWORD):Boolean; inline;
begin
Result:=(x and (x - 1))=0;
@ -173,6 +188,8 @@ end;
function __map_sce_prot_page(prot:LongInt):DWORD;
begin
Result:=0;
if (prot=0) then Exit(PAGE_NOACCESS);
if (prot and SCE_KERNEL_PROT_CPU_EXEC)<>0 then
begin
if (prot and (SCE_KERNEL_PROT_CPU_WRITE or SCE_KERNEL_PROT_GPU_WRITE) )<>0 then
@ -199,7 +216,7 @@ end;
function __map_mmap_prot_page(prot:LongInt):DWORD;
begin
Result:=0;
if (prot=PROT_NONE) then Exit;
if (prot=PROT_NONE) then Exit(PAGE_NOACCESS);
if (prot and PROT_EXEC)<>0 then
begin
@ -224,6 +241,28 @@ begin
end;
end;
function str_mem_type(memoryType:Integer):RawByteString;
begin
Result:='';
Case memoryType of
SCE_KERNEL_WB_ONION :Result:='WB_ONION';
SCE_KERNEL_WC_GARLIC:Result:='WC_GARLIC';
SCE_KERNEL_WB_GARLIC:Result:='WB_GARLIC';
else
Result:=IntToStr(memoryType);
end;
end;
function test_KP_flags(flags:Integer):RawByteString;
begin
Result:='';
if (flags and SCE_KERNEL_PROT_CPU_READ) <>0 then Result:=Result+' CPU_READ';
if (flags and SCE_KERNEL_PROT_CPU_WRITE)<>0 then Result:=Result+' CPU_WRIT';
if (flags and SCE_KERNEL_PROT_CPU_EXEC) <>0 then Result:=Result+' CPU_EXEC';
if (flags and SCE_KERNEL_PROT_GPU_READ) <>0 then Result:=Result+' GPU_READ';
if (flags and SCE_KERNEL_PROT_GPU_WRITE)<>0 then Result:=Result+' GPU_WRIT';
end;
//
function Get16kBlockCount(len:PTRUINT):PTRUINT; inline;
@ -360,18 +399,6 @@ begin
end;
type
PBlockBig=^TBlockBig;
TBlockBig=object(TBlock)
direct:QWORD;
Handle:Pointer;
prot:Byte;
end;
PBlock64k=^TBlock64k;
TBlock64k=object(TBlock)
nodes:array[0..3] of TdnodeAdr;
end;
TBlockCompare=object
function c(const a,b:PBlock):Integer; static;
end;
@ -660,13 +687,85 @@ end;
function TPageMM._TryGetMapBlockByAddr(addr:Pointer;var _pblock:PBlock):Boolean;
var
It:TBlockSet.Iterator;
i:Integer;
begin
Result:=False;
It:=FMapBlockSet.find_le(@addr);
if (It.Item=nil) then Exit;
//if (It.Item=nil) then Exit;
if (It.Item=nil) then
begin
Writeln('Memory dump:',HexStr(addr));
It:=FMapBlockSet.cbegin;
While (It.Item<>nil) do
begin
_pblock:=It.Item^;
if (_pblock<>nil) then
begin
Case _pblock^.bType of
BT_STACK:
begin
Writeln('[BT_STACK]');
Writeln(' pAddr:',HexStr(_pblock^.pAddr));
Writeln(' nSize:',HexStr(_pblock^.nSize,16));
end;
BT_DIRECT_BIG:
begin
Writeln('[BT_DIRECT_BIG]');
Writeln(' pAddr:',HexStr(_pblock^.pAddr));
Writeln(' nSize:',HexStr(_pblock^.nSize,16));
Writeln(' direct:',HexStr(PBlockBig(_pblock)^.direct,16));
Writeln(' Handle:',HexStr(PBlockBig(_pblock)^.Handle));
Writeln(' prot:',test_KP_flags(PBlockBig(_pblock)^.prot));
end;
BT_DIRECT_64K:
begin
Writeln('[BT_DIRECT_64K]');
Writeln(' pAddr:',HexStr(_pblock^.pAddr));
Writeln(' nSize:',HexStr(_pblock^.nSize,16));
For i:=0 to 3 do
begin
Writeln(' [node]:',i);
Writeln(' direct:' ,HexStr(PBlock64k(_pblock)^.nodes[i].direct,16));
Writeln(' info.id:' ,HexStr(PBlock64k(_pblock)^.nodes[i].info.id,2));
Writeln(' info.prot:' ,test_KP_flags(PBlock64k(_pblock)^.nodes[i].info.prot));
Writeln(' info.state:',PBlock64k(_pblock)^.nodes[i].info.state);
Writeln(' info.len:' ,PBlock64k(_pblock)^.nodes[i].info.len);
end;
end;
BT_PHYSIC_BIG:
begin
Writeln('[BT_PHYSIC_BIG]');
Writeln(' pAddr:',HexStr(_pblock^.pAddr));
Writeln(' nSize:',HexStr(_pblock^.nSize,16));
end;
BT_PHYSIC_64K:
begin
Writeln('[BT_PHYSIC_64K]');
Writeln(' pAddr:',HexStr(_pblock^.pAddr));
Writeln(' nSize:',HexStr(_pblock^.nSize,16));
end;
else;
end;
end;
It.Next;
end;
Writeln('------------');
Assert(false);
Exit;
end;
_pblock:=It.Item^;
if (_pblock=nil) then Exit;
if (_pblock^.pAddr>addr) or (_pblock^.pAddr+_pblock^.nSize<=addr) then Exit;
if (_pblock^.pAddr>addr) or (_pblock^.pAddr+_pblock^.nSize<=addr) then
begin
_pblock:=nil;
Exit;
end;
Result:=True;
end;
@ -1066,18 +1165,6 @@ end;
//function sceKernelReleaseDirectMemory(physicalAddr:Pointer;length:Int64):Int64; cdecl;
function str_mem_type(memoryType:Integer):RawByteString;
begin
Result:='';
Case memoryType of
SCE_KERNEL_WB_ONION :Result:='WB_ONION';
SCE_KERNEL_WC_GARLIC:Result:='WC_GARLIC';
SCE_KERNEL_WB_GARLIC:Result:='WB_GARLIC';
else
Result:=IntToStr(memoryType);
end;
end;
function ps4_sceKernelAllocateDirectMemory(
searchStart:QWORD;
searchEnd:QWORD;
@ -1105,6 +1192,7 @@ begin
Adr.bType:=memoryType;
Result:=0;
_sig_lock;
rwlock_wrlock(PageMM.FLock);
repeat
@ -1128,6 +1216,7 @@ begin
if (Adr.pAddr>=Pointer(searchEnd)) then
begin
rwlock_unlock(PageMM.FLock);
_sig_unlock;
Exit(SCE_KERNEL_ERROR_EAGAIN);
end;
@ -1136,22 +1225,13 @@ begin
PageMM.FDirectAdrSet.Insert(Adr);
rwlock_unlock(PageMM.FLock);
_sig_unlock;
physicalAddrDest^:=QWORD(Adr.pAddr);
Result:=0;
end;
function test_KP_flags(flags:Integer):RawByteString;
begin
Result:='';
if (flags and SCE_KERNEL_PROT_CPU_READ) <>0 then Result:=Result+' CPU_READ';
if (flags and SCE_KERNEL_PROT_CPU_WRITE)<>0 then Result:=Result+' CPU_WRIT';
if (flags and SCE_KERNEL_PROT_CPU_EXEC) <>0 then Result:=Result+' CPU_EXEC';
if (flags and SCE_KERNEL_PROT_GPU_READ) <>0 then Result:=Result+' GPU_READ';
if (flags and SCE_KERNEL_PROT_GPU_WRITE)<>0 then Result:=Result+' GPU_WRIT';
end;
{
SCE_KERNEL_MAP_FIXED
0x0010
@ -1204,7 +1284,9 @@ begin
R:=nil;
end;
_sig_lock;
R:=PageMM.mmap_d(R,length,alignment,physicalAddr,protections,(flags and SCE_KERNEL_MAP_NO_OVERWRITE)=0);
_sig_unlock;
//Writeln('alloc:',HexStr(R),'..',HexStr(R+length));
virtualAddrDest^:=R;
@ -1242,10 +1324,11 @@ begin
//Writeln('AddrSrc:',HexStr(virtualAddrDest^));
Writeln(length,' ',
Writeln('length:',HexStr(length,16),' ',
test_KP_flags(protections),' ',
flags,' ',
name);
'flags:',flags);
Writeln('length:',HexStr(length,16),' ',
'name:',name);
if not IsAlign(virtualAddrDest^,LOGICAL_PAGE_SIZE) then Exit;
if not IsAlign(length,LOGICAL_PAGE_SIZE) then Exit;
@ -1258,7 +1341,9 @@ begin
R:=nil;
end;
_sig_lock;
R:=PageMM.mmap_d(R,length,0,INVALID_DIRECT,protections,(flags and SCE_KERNEL_MAP_NO_OVERWRITE)=0);
_sig_unlock;
Writeln('alloc:',HexStr(R),'..',HexStr(R+length));
virtualAddrDest^:=R;
@ -1292,9 +1377,10 @@ begin
//Writeln('AddrSrc:',HexStr(virtualAddrDest^));
Writeln(length,' ',
Writeln('length:',HexStr(length,16),' ',
test_KP_flags(protections),' ',
flags);
'flags:',flags);
Writeln('length:',HexStr(length,16));
if not IsAlign(virtualAddrDest^,LOGICAL_PAGE_SIZE) then Exit;
if not IsAlign(length,LOGICAL_PAGE_SIZE) then Exit;
@ -1307,7 +1393,10 @@ begin
R:=nil;
end;
_sig_lock;
R:=PageMM.mmap_d(R,length,0,INVALID_DIRECT,protections,(flags and SCE_KERNEL_MAP_NO_OVERWRITE)=0);
_sig_unlock;
//Writeln('alloc:',HexStr(R),'..',HexStr(R+length));
virtualAddrDest^:=R;
@ -1343,7 +1432,9 @@ begin
if not IsAlign(addr,LOGICAL_PAGE_SIZE) then Exit;
if not IsAlign(len,LOGICAL_PAGE_SIZE) then Exit;
_sig_lock;
if PageMM.unmap(addr,len) then Result:=0;
_sig_unlock;
end;
//flex
@ -1352,7 +1443,9 @@ begin
Result:=SCE_KERNEL_ERROR_EACCES;
//Writeln(HexStr(addr));
//addr:=AlignDw(addr,LOGICAL_PAGE_SIZE);
_sig_lock;
if PageMM.QueryProt(addr,pStart,pEnd,pProt) then Result:=0;
_sig_unlock;
end;
function ps4_mmap(addr:Pointer;len:size_t;prot,flags:Integer;fd:Integer;offset:size_t):Pointer; SysV_ABI_CDecl;
@ -1393,7 +1486,9 @@ begin
Exit;
end;
_sig_lock;
map:=VirtualAlloc(addr,len,MEM_COMMIT or MEM_RESERVE,Protect);
_sig_unlock;
if (map=nil) then
begin
@ -1414,24 +1509,30 @@ begin
if not IsAlign(len,PHYSICAL_PAGE_SIZE) then Exit;
Info:=Default(TMemoryBasicInformation);
_sig_lock;
if (VirtualQuery(addr,Info,len)=0) then
begin
Writeln(GetLastError);
_sig_unlock;
Writeln('GetLastError:',GetLastError);
Exit;
end;
_sig_unlock;
if (Info._Type=MEM_FREE) then
begin
Writeln(GetLastError);
Writeln('GetLastError:',GetLastError);
Exit;
end;
Assert((Info.BaseAddress=Info.AllocationBase) and (Info.RegionSize=len),'partial unmap not impliment!');
_sig_lock;
if not VirtualFree(addr,0,MEM_RELEASE) then
begin
Writeln(GetLastError);
_sig_unlock;
Writeln('GetLastError:',GetLastError);
Exit;
end;
_sig_unlock;
Result:=0;
end;
@ -1443,6 +1544,27 @@ begin
Result:=0;
end;
function ps4_mprotect(addr:Pointer;len:size_t;prot:Integer):Integer; SysV_ABI_CDecl;
Var
newprotect,oldprotect:DWORD;
begin
newprotect:=__map_mmap_prot_page(prot);
oldprotect:=0;
_sig_lock;
if not VirtualProtect(addr,len,newprotect,oldprotect) then
begin
_sig_unlock;
Writeln('GetLastError:',GetLastError);
Exit;
end;
_sig_unlock;
Result:=0;
end;
initialization
PageMM.init;

215
ps4_libkernel/ps4_mutex.pas
View File

@ -7,10 +7,10 @@ interface
uses
Windows,
sysutils,
ps4_types;
sys_types;
type
Ppthread_mutex_attr=^pthread_mutex_attr_t;
p_pthread_mutex_attr=^pthread_mutex_attr_t;
pthread_mutex_attr_t=bitpacked record
_type:0..7; //3
_shared:0..1; //1
@ -19,7 +19,7 @@ type
_prioceiling:Integer; //32
end;
Ppthread_mutex=^pthread_mutex;
p_pthread_mutex=^pthread_mutex;
pthread_mutex=^pthread_mutex_t;
pthread_mutex_t=packed record
valid:DWORD;
@ -32,7 +32,7 @@ type
end;
ScePthreadMutex=pthread_mutex;
PScePthreadMutex=Ppthread_mutex;
PScePthreadMutex=p_pthread_mutex;
const
SCE_PTHREAD_MUTEX_ERRORCHECK = 1; // Default POSIX mutex
@ -57,34 +57,34 @@ const
PTHREAD_MUTEX_INITIALIZER =0;
PTHREAD_ADAPTIVE_MUTEX_INITIALIZER_NP=1;
function ps4_pthread_mutexattr_init(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_destroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_gettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_settype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getpshared(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setpshared(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_init(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_destroy(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_gettype(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_settype(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getpshared(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setpshared(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprotocol(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprotocol(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprioceiling(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprioceiling(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_lock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_timedlock(pMutex:Ppthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_trylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_unlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_init(pMutex:Ppthread_mutex;pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_destroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_lock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_timedlock(pMutex:p_pthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_trylock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_unlock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_init(pMutex:p_pthread_mutex;pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_destroy(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrInit(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrDestroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSettype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrInit(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrDestroy(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGettype(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSettype(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprotocol(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprotocol(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:Ppthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:p_pthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexLock(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexTimedlock(pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexTrylock(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
@ -96,12 +96,14 @@ function ps4_scePthreadMutexDestroy(pMutex:PScePthreadMutex):Integer; SysV_ABI_C
implementation
Uses
spinlock,
atomic,
sys_kernel,
sys_signal,
sys_time,
ps4_sema,
ps4_libkernel,
ps4_time;
function ps4_pthread_mutexattr_init(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_init(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_mutex_attr_t);
@ -109,20 +111,20 @@ begin
Result:=0;
end;
function ps4_pthread_mutexattr_destroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_destroy(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Result:=0;
end;
function ps4_pthread_mutexattr_gettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_gettype(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_pthread_mutexattr_settype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_settype(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -137,14 +139,14 @@ begin
Result:=0;
end;
function ps4_pthread_mutexattr_getpshared(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getpshared(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_mutexattr_setpshared(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setpshared(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -157,14 +159,14 @@ begin
Result:=0;
end;
function ps4_pthread_mutexattr_getprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprotocol(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._protocol;
Result:=0;
end;
function ps4_pthread_mutexattr_setprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprotocol(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -178,14 +180,14 @@ begin
Result:=0;
end;
function ps4_pthread_mutexattr_getprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprioceiling(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._prioceiling;
Result:=0;
end;
function ps4_pthread_mutexattr_setprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprioceiling(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^._prioceiling:=t;
@ -211,36 +213,11 @@ begin
end;
end;
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:SizeUInt;Comp,New:SizeUInt):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(Pointer(addr),Pointer(New),Pointer(Comp))=Pointer(Comp);
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function XCHG(Var addr:DWORD;New:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function mutex_impl_init(m:Ppthread_mutex;mi:pthread_mutex;_type:Integer):pthread_mutex;
function mutex_impl_init(m:p_pthread_mutex;mi:pthread_mutex;_type:Integer):pthread_mutex;
var
new_mi:pthread_mutex;
begin
new_mi:=AllocMem(SizeOf(pthread_mutex_t));
new_mi:=SwAllocMem(SizeOf(pthread_mutex_t));
if (new_mi=nil) then Exit(new_mi);
new_mi^.valid:=LIFE_MUTEX;
@ -253,12 +230,12 @@ begin
Result:=new_mi;
end else
begin
FreeMem(new_mi);
SwFreeMem(new_mi);
Result:=m^;
end;
end;
function mutex_impl(m:Ppthread_mutex;var mi:pthread_mutex;default:Integer):Integer;
function mutex_impl(m:p_pthread_mutex;var mi:pthread_mutex;default:Integer):Integer;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
@ -267,11 +244,11 @@ begin
PTHREAD_ADAPTIVE_MUTEX_INITIALIZER_NP:mi:=mutex_impl_init(m,mi,PTHREAD_MUTEX_ADAPTIVE);
end;
if (mi=nil) then Exit(ENOMEM);
if (mi^.valid<>LIFE_MUTEX) then Exit(EINVAL);
if not safe_test(mi^.valid,LIFE_MUTEX) then Exit(EINVAL);
Result:=0;
end;
function pthread_mutex_lock_intern(m:Ppthread_mutex;timeout:DWORD;default:Integer):Integer;
function pthread_mutex_lock_intern(m:p_pthread_mutex;pTimeout:PQWORD;default:Integer):Integer;
var
mi:pthread_mutex;
old_state:DWORD;
@ -315,7 +292,7 @@ begin
While (XCHG(mi^.state,MS_Waiting)<>MS_Unlocked) do
begin
Result:=do_sema_b_wait_intern(mi^.event,timeout);
Result:=do_sema_b_wait_intern(mi^.event,pTimeout);
if (Result<>0) then Exit;
end;
end;
@ -328,26 +305,32 @@ begin
Result:=0;
end;
function ps4_pthread_mutex_lock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_lock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_lock_intern(pMutex,INFINITE,PTHREAD_MUTEX_DEFAULT);
_sig_lock;
Result:=pthread_mutex_lock_intern(pMutex,nil,PTHREAD_MUTEX_DEFAULT);
_sig_unlock;
end;
function ps4_pthread_mutex_timedlock(pMutex:Ppthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_timedlock(pMutex:p_pthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
var
t:DWORD;
t:QWORD;
begin
if (ts=nil) then
begin
t:=INFINITE;
_sig_lock;
Result:=pthread_mutex_lock_intern(pMutex,nil,PTHREAD_MUTEX_DEFAULT);
_sig_unlock;
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ts^));
t:=_pthread_rel_time_in_ns(ts^);
_sig_lock;
Result:=pthread_mutex_lock_intern(pMutex,@t,PTHREAD_MUTEX_DEFAULT);
_sig_unlock;
end;
Result:=pthread_mutex_lock_intern(pMutex,t,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_unlock(m:Ppthread_mutex;default:Integer):Integer;
function pthread_mutex_unlock(m:p_pthread_mutex;default:Integer):Integer;
var
mi:pthread_mutex;
begin
@ -369,18 +352,19 @@ begin
if XCHG(mi^.state,MS_Unlocked)=MS_Waiting then
begin
if not SetEvent(mi^.event) then Exit(EPERM);
_sig_lock;
if not SetEvent(mi^.event) then Result:=EPERM;
_sig_unlock;
end;
Result:=0;
end;
function ps4_pthread_mutex_unlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_unlock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_unlock(pMutex,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_trylock(m:Ppthread_mutex;default:Integer):Integer;
function pthread_mutex_trylock(m:p_pthread_mutex;default:Integer):Integer;
var
mi:pthread_mutex;
begin
@ -405,12 +389,12 @@ begin
end;
end;
function ps4_pthread_mutex_trylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_trylock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_trylock(pMutex,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_init(m:Ppthread_mutex;a:Ppthread_mutex_attr;str:PChar;default:Integer):Integer;
function pthread_mutex_init(m:p_pthread_mutex;a:p_pthread_mutex_attr;str:PChar;default:Integer):Integer;
var
mi:pthread_mutex;
begin
@ -424,19 +408,19 @@ begin
mi:=mutex_impl_init(m,mi,default);
end;
if (mi=nil) then Exit(ENOMEM);
if (mi^.valid<>LIFE_MUTEX) then Exit(EINVAL);
if not safe_test(mi^.valid,LIFE_MUTEX) then Exit(EINVAL);
if (str<>nil) then MoveChar0(str^,mi^.name,32);
Result:=0;
end;
function ps4_pthread_mutex_init(pMutex:Ppthread_mutex;pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_init(pMutex:p_pthread_mutex;pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_init(pMutex,pAttr,nil,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_destroy(m:Ppthread_mutex):Integer;
function pthread_mutex_destroy(m:p_pthread_mutex):Integer;
var
mi:pthread_mutex;
begin
@ -447,13 +431,15 @@ begin
mi:=XCHG(m^,nil);
if STATIC_INITIALIZER(mi) then Exit(0);
if not CAS(mi^.valid,LIFE_MUTEX,DEAD_MUTEX) then Exit(EINVAL);
_sig_lock;
if (mi^.event<>0) then CloseHandle(mi^.event);
FreeMem(mi);
_sig_unlock;
end;
Result:=0;
end;
function ps4_pthread_mutex_destroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_destroy(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_destroy(pMutex);
end;
@ -461,7 +447,7 @@ end;
//---------------------------------------------------------
//sce
function ps4_scePthreadMutexattrInit(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrInit(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_mutex_attr_t);
@ -469,20 +455,20 @@ begin
Result:=0;
end;
function ps4_scePthreadMutexattrDestroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrDestroy(pAttr:p_pthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=0;
end;
function ps4_scePthreadMutexattrGettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGettype(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_scePthreadMutexattrSettype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSettype(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
@ -497,14 +483,14 @@ begin
Result:=0;
end;
function ps4_scePthreadMutexattrGetprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprotocol(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._protocol;
Result:=0;
end;
function ps4_scePthreadMutexattrSetprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprotocol(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
@ -518,14 +504,14 @@ begin
Result:=0;
end;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:p_pthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._prioceiling;
Result:=0;
end;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:p_pthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^._prioceiling:=t;
@ -534,42 +520,39 @@ end;
//////////////
function ps4_scePthreadMutexLock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexLock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexLock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_lock_intern(pMutex,INFINITE,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexLock:',HexStr(pMutex),':',HexStr(Result,8));
_sig_lock;
Result:=px2sce(pthread_mutex_lock_intern(pMutex,nil,SCE_PTHREAD_MUTEX_DEFAULT));
_sig_unlock;
end;
function ps4_scePthreadMutexTimedlock(pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
var
t:QWORD;
begin
//Writeln('scePthreadMutexTimedlock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_lock_intern(pMutex,_usec2msec(usec),SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexTimedlock:',HexStr(pMutex),':',HexStr(Result,8));
t:=_usec2nsec(usec);
_sig_lock;
Result:=px2sce(pthread_mutex_lock_intern(pMutex,@t,SCE_PTHREAD_MUTEX_DEFAULT));
_sig_unlock;
end;
function ps4_scePthreadMutexUnlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexUnlock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexUnlock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_unlock(pMutex,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexUnlock:',HexStr(pMutex),':',pMutex^^.name,':',HexStr(Result,8));
end;
function ps4_scePthreadMutexTrylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexTrylock(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexTrylock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_trylock(pMutex,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexTrylock:',HexStr(pMutex),':',HexStr(Result,8));
end;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:Ppthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:p_pthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
begin
//if str='NP CVariable Mutex' then
// writeln;
Result:=px2sce(pthread_mutex_init(pMutex,pAttr,str,SCE_PTHREAD_MUTEX_DEFAULT));
end;
function ps4_scePthreadMutexDestroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexDestroy(pMutex:p_pthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(pthread_mutex_destroy(pMutex));
end;

779
ps4_libkernel/ps4_pthread.pas
View File

File diff suppressed because it is too large Load Diff

29
ps4_libkernel/ps4_queue.pas
View File

@ -6,7 +6,8 @@ interface
uses
windows,
Classes, SysUtils;
Classes,
SysUtils;
const
EVFILT_READ =(-1) ;
@ -136,9 +137,11 @@ function _trigger_kevent_node(node:PKEventNode;after:TKAfterEvent;data:Pointer)
implementation
uses
atomic,
spinlock,
ps4_time,
ps4_libkernel;
sys_kernel,
sys_signal,
sys_time;
const
LIFE_EQ=$BAB1F00D;
@ -148,7 +151,7 @@ function _alloc_kevent_node(eq:SceKernelEqueue;size:qword):Pointer;
begin
eq:=_acqure_equeue(eq);
if (eq=nil) then Exit(Pointer(1));
Result:=AllocMem(size);
Result:=SwAllocMem(size);
if (Result=nil) then
begin
_release_equeue(eq);
@ -164,7 +167,7 @@ begin
_release_equeue(System.InterlockedExchange(node^.eq,nil));
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
SwFreeMem(node);
end;
end;
@ -178,7 +181,7 @@ begin
spin_unlock(node^.lock);
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
SwFreeMem(node);
Exit;
end;
ev^:=tmp;
@ -203,7 +206,7 @@ begin
spin_unlock(node^.lock);
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
SwFreeMem(node);
Exit;
end;
end;
@ -218,12 +221,14 @@ begin
Writeln('sceKernelCreateEqueue:',name);
if (outEq=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
data:=AllocMem(SizeOf(SceKernelEqueue_t));
data:=SwAllocMem(SizeOf(SceKernelEqueue_t));
if (data=nil) then
begin
Exit(SCE_KERNEL_ERROR_ENOMEM);
end;
_sig_lock;
hIOCP:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,High(Integer));
_sig_unlock;
if (hIOCP=0) then
begin
Exit(SCE_KERNEL_ERROR_EMFILE);
@ -243,7 +248,9 @@ begin
Result:=False;
if (eq=nil) then Exit;
if (eq^.valid<>LIFE_EQ) then Exit;
_sig_lock;
Result:=PostQueuedCompletionStatus(eq^.hIOCP,1,ULONG_PTR(cb),node);
_sig_unlock;
end;
function _acqure_equeue(eq:SceKernelEqueue):SceKernelEqueue;
@ -260,7 +267,7 @@ begin
if (eq=nil) then Exit;
if System.InterlockedDecrement(eq^.FRefs)=0 then
begin
FreeMem(eq);
SwFreeMem(eq);
end;
end;
@ -318,11 +325,15 @@ begin
CTXProc:=nil;
Repeat
ulNum:=0;
_sig_lock;
if (LTIME<>INFINITE) then QTIME:=Windows.GetTickCount;
Q:=GetQueuedCompletionStatusEX(eq^.hIOCP,@OE,num,ulNum,LTIME,True);
_sig_unlock;
if (LTIME<>INFINITE) then
begin
_sig_lock;
QTIME:=Windows.GetTickCount-QTIME;
_sig_unlock;
if (QTIME>LTIME) then
LTIME:=0
else

157
ps4_libkernel/ps4_rwlock.pas
View File

@ -5,8 +5,7 @@ unit ps4_rwlock;
interface
uses
RWLock,
ps4_types;
RWLock;
const
PTHREAD_RWLOCK_INITIALIZER=nil;
@ -15,7 +14,7 @@ const
SCE_PTHREAD_RWLOCK_PREFER_READER = 2; // Reader preferred rwlock
type
Ppthread_rwlock=^pthread_rwlock;
p_pthread_rwlock=^pthread_rwlock;
pthread_rwlock=^pthread_rwlock_t;
pthread_rwlock_t=record
valid:DWORD;
@ -23,7 +22,7 @@ type
name:array[0..31] of AnsiChar;
end;
Ppthread_rwlockattr=^pthread_rwlockattr_t;
p_pthread_rwlockattr=^pthread_rwlockattr_t;
pthread_rwlockattr_t=packed record
_type:0..3; //2
_shared:0..1; //1
@ -31,43 +30,44 @@ type
_align2:Integer; //32
end;
function ps4_pthread_rwlockattr_init(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_destroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_gettype_np(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_settype_np(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_getpshared(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_setpshared(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_init(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_destroy(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_gettype_np(pAttr:p_pthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_settype_np(pAttr:p_pthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_getpshared(pAttr:p_pthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_setpshared(pAttr:p_pthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_init(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_destroy(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_rdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_wrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_tryrdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_trywrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_unlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_init(pRwlock:p_pthread_rwlock;pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_destroy(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_rdlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_wrlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_tryrdlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_trywrlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_unlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrInit(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrDestroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrGettype(pAttr:Ppthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrSettype(pAttr:Ppthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrInit(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrDestroy(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrGettype(pAttr:p_pthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrSettype(pAttr:p_pthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockInit(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockDestroy(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockRdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockWrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTryrdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTrywrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockUnlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockInit(pRwlock:p_pthread_rwlock;pAttr:p_pthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockDestroy(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockRdlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockWrlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTryrdlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTrywrlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockUnlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedrdlock(pRwlock:Ppthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedwrlock(pRwlock:Ppthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedrdlock(pRwlock:p_pthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedwrlock(pRwlock:p_pthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
implementation
Uses
spinlock,
ps4_mutex,
ps4_libkernel;
atomic,
sys_kernel,
sys_signal,
ps4_mutex;
//int pthread_rwlock_timedrdlock(pthread_rwlock_t *,const struct timespec *);
//int pthread_rwlock_timedwrlock(pthread_rwlock_t *,const struct timespec *);
@ -75,7 +75,7 @@ Uses
//int pthread_rwlockattr_getkind_np(const pthread_rwlockattr_t *,int *);
//int pthread_rwlockattr_setkind_np(pthread_rwlockattr_t *, int);
function ps4_pthread_rwlockattr_init(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_init(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_rwlockattr_t);
@ -83,20 +83,20 @@ begin
Result:=0;
end;
function ps4_pthread_rwlockattr_destroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_destroy(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Result:=0;
end;
function ps4_pthread_rwlockattr_gettype_np(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_gettype_np(pAttr:p_pthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_pthread_rwlockattr_settype_np(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_settype_np(pAttr:p_pthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -109,14 +109,14 @@ begin
Result:=0;
end;
function ps4_pthread_rwlockattr_getpshared(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_getpshared(pAttr:p_pthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_rwlockattr_setpshared(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_setpshared(pAttr:p_pthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
@ -138,43 +138,35 @@ begin
Result:=(x=PTHREAD_RWLOCK_INITIALIZER);
end;
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function rwlock_impl_init(m:Ppthread_rwlock;mi:pthread_rwlock):pthread_rwlock;
function rwlock_impl_init(m:p_pthread_rwlock;mi:pthread_rwlock):pthread_rwlock;
var
new_mi:pthread_rwlock;
begin
new_mi:=AllocMem(SizeOf(pthread_rwlock_t));
new_mi:=SwAllocMem(SizeOf(pthread_rwlock_t));
if (new_mi=nil) then Exit(new_mi);
new_mi^.valid:=LIFE_RWLOCK;
_sig_lock;
rwlock_init(new_mi^.Lock);
_sig_unlock;
if CAS(m^,mi,new_mi) then
begin
Result:=new_mi;
end else
begin
_sig_lock;
rwlock_destroy(new_mi^.Lock);
FreeMem(new_mi);
_sig_unlock;
Result:=m^;
end;
end;
function rwlock_impl(m:Ppthread_rwlock;var mi:pthread_rwlock):Integer;
function rwlock_impl(m:p_pthread_rwlock;var mi:pthread_rwlock):Integer;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
@ -184,9 +176,10 @@ begin
if (mi=nil) then Exit(ENOMEM);
end;
if (mi^.valid<>LIFE_RWLOCK) then Exit(EINVAL);
Result:=0;
end;
function pthread_rwlock_init(m:Ppthread_rwlock;a:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
function pthread_rwlock_init(m:p_pthread_rwlock;a:p_pthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
@ -195,12 +188,12 @@ begin
if (str<>nil) then MoveChar0(str^,mi^.name,32);
end;
function ps4_pthread_rwlock_init(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_init(pRwlock:p_pthread_rwlock;pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_rwlock_init(pRwlock,pAttr,nil);
end;
function ps4_pthread_rwlock_destroy(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_destroy(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
@ -211,60 +204,72 @@ begin
mi:=XCHG(m^,nil);
if STATIC_RWL_INITIALIZER(mi) then Exit(0);
if not CAS(mi^.valid,LIFE_RWLOCK,DEAD_RWLOCK) then Exit(EINVAL);
_sig_lock;
rwlock_destroy(mi^.Lock);
FreeMem(mi);
_sig_unlock;
end;
Result:=0;
end;
function ps4_pthread_rwlock_rdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_rdlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
_sig_lock;
rwlock_rdlock(mi^.Lock);
_sig_unlock;
end;
function ps4_pthread_rwlock_wrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_wrlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
_sig_lock;
rwlock_wrlock(mi^.Lock);
_sig_unlock;
end;
function ps4_pthread_rwlock_tryrdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_tryrdlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
_sig_lock;
if not rwlock_tryrdlock(mi^.Lock) then Result:=EBUSY;
_sig_unlock;
end;
function ps4_pthread_rwlock_trywrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_trywrlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
_sig_lock;
if not rwlock_trywrlock(mi^.Lock) then Result:=EBUSY;
_sig_unlock;
end;
function ps4_pthread_rwlock_unlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_unlock(m:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
_sig_lock;
rwlock_unlock(mi^.Lock);
_sig_unlock;
end;
///////////
function ps4_scePthreadRwlockattrInit(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrInit(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_rwlockattr_t);
@ -272,20 +277,20 @@ begin
Result:=0;
end;
function ps4_scePthreadRwlockattrDestroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrDestroy(pAttr:p_pthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=0;
end;
function ps4_scePthreadRwlockattrGettype(pAttr:Ppthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrGettype(pAttr:p_pthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_scePthreadRwlockattrSettype(pAttr:Ppthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrSettype(pAttr:p_pthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
@ -300,37 +305,37 @@ end;
//
function ps4_scePthreadRwlockInit(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockInit(pRwlock:p_pthread_rwlock;pAttr:p_pthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(pthread_rwlock_init(pRwlock,pAttr,str));
end;
function ps4_scePthreadRwlockDestroy(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockDestroy(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_destroy(pRwlock));
end;
function ps4_scePthreadRwlockRdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockRdlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_rdlock(pRwlock));
end;
function ps4_scePthreadRwlockWrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockWrlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_wrlock(pRwlock));
end;
function ps4_scePthreadRwlockTryrdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTryrdlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_tryrdlock(pRwlock));
end;
function ps4_scePthreadRwlockTrywrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTrywrlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_trywrlock(pRwlock));
end;
function ps4_scePthreadRwlockUnlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockUnlock(pRwlock:p_pthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_unlock(pRwlock));
end;

299
ps4_libkernel/ps4_sema.pas
View File

@ -6,7 +6,7 @@ interface
uses
windows,
ps4_types;
sys_types;
const
SCE_KERNEL_SEMA_ATTR_TH_FIFO=$01;
@ -55,103 +55,229 @@ function ps4_sceKernelSignalSema(sem:SceKernelSema;Count:Integer):Integer; SysV_
function ps4_sceKernelPollSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelCancelSema(sem:SceKernelSema;count:Integer;threads:PInteger):Integer; SysV_ABI_CDecl;
function do_sema_b_wait(sema:THandle;timeout:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
function do_sema_b_wait_intern(sema:THandle;timeout:DWORD):Integer;
//function do_sema_b_wait(sema:THandle;timeout:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
//function do_sema_b_wait_intern(sema:THandle;timeout:DWORD):Integer;
function do_sema_b_wait(sema:THandle;pTimeout:PQWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
function do_sema_b_wait_intern(sema:THandle;pTimeout:PQWORD):Integer; inline;
function do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
procedure SwEnterCriticalSection(var cs:TRTLCriticalSection);
implementation
//int sem_unlink(const char *);
uses
atomic,
spinlock,
ps4_time,
ps4_libkernel;
sys_kernel,
sys_signal,
sys_time,
ps4_time;
const
LIFE_SEM=$BAB1F00D;
DEAD_SEM=$DEADBEEF;
function SwTryEnterCriticalSection(var cs:TRTLCriticalSection):longint;
begin
_sig_lock;
Result:=System.TryEnterCriticalSection(cs);
_sig_unlock;
end;
procedure SwEnterCriticalSection(var cs:TRTLCriticalSection);
var
ft:TLargeInteger;
begin
ft:=-10000;
While (SwTryEnterCriticalSection(cs)=0) do
begin
SwDelayExecution(True,@ft);
end;
end;
function do_sema_b_wait(sema:THandle;pTimeout:PQWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
v:Integer;
begin
_sig_lock;
SwEnterCriticalSection(cs);
System.InterlockedDecrement(val);
v:=val;
System.LeaveCriticalSection(cs);
if (v>=0) then
begin
_sig_unlock;
Exit(0);
end;
Result:=SwWaitFor(sema,pTimeout);
SwEnterCriticalSection(cs);
if (Result<>0) then
begin
System.InterlockedIncrement(val);
end;
System.LeaveCriticalSection(cs);
_sig_unlock;
end;
function do_sema_b_wait_intern(sema:THandle;pTimeout:PQWORD):Integer; inline;
begin
Result:=SwWaitFor(sema,pTimeout);
end;
{
function do_sema_b_wait(sema:THandle;timeout:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
r:Integer;
v:Integer;
begin
System.EnterCriticalSection(cs);
_sig_lock;
SwEnterCriticalSection(cs);
System.InterlockedDecrement(val);
v:=val;
System.LeaveCriticalSection(cs);
if (v>=0) then Exit(0);
if (v>=0) then
begin
_sig_unlock;
Exit(0);
end;
r:=do_sema_b_wait_intern(sema,timeout);
System.EnterCriticalSection(cs);
SwEnterCriticalSection(cs);
if (r<>0) then
begin
System.InterlockedIncrement(val);
end;
System.LeaveCriticalSection(cs);
Result:=r;
_sig_unlock;
end;
}
{
function do_sema_b_wait_intern(sema:THandle;timeout:DWORD):Integer;
var
r:Integer;
res:DWORD;
QTIME:DWORD;
begin
res:=WaitForSingleObject(sema,timeout);
case res of
WAIT_TIMEOUT :r:=ETIMEDOUT;
WAIT_ABANDONED:r:=EPERM;
WAIT_OBJECT_0 :r:=0;
else
r:=EINVAL;
if (timeout<>INFINITE) then
begin
_sig_lock;
QTIME:=Windows.GetTickCount;
_sig_unlock;
end;
if (r<>0) and (r<>EINVAL) and (WaitForSingleObject(sema,0)=WAIT_OBJECT_0) then
r:=0;
repeat
_sig_lock(True);
res:=WaitForSingleObjectEx(sema,timeout,True);
_sig_unlock;
case res of
WAIT_IO_COMPLETION:
begin
if (timeout<>INFINITE) then
begin
_sig_lock;
QTIME:=Windows.GetTickCount-QTIME;
_sig_unlock;
if (QTIME>timeout) then
timeout:=0
else
timeout:=timeout-QTIME;
if (timeout=0) then
begin
r:=0;
Break;
end;
end;
end;
WAIT_TIMEOUT:
begin
r:=ETIMEDOUT;
Break;
end;
WAIT_ABANDONED:
begin
r:=EPERM;
Break;
end;
WAIT_OBJECT_0:
begin
r:=0;
Break;
end;
else
begin
r:=EINVAL;
Break;
end;
end;
until false;
//if (r<>0) and (r<>EINVAL) and (WaitForSingleObject(sema,0)=WAIT_OBJECT_0) then
// r:=0;
Result:=r;
end;
}
function do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
wc,s:Integer;
function _rel_wait_count(waiters_count,count:Integer):Integer; inline;
begin
System.EnterCriticalSection(cs);
if (waiters_count<count) then
Result:=waiters_count
else
Result:=count;
end;
function __do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
waiters_count:Integer;
begin
SwEnterCriticalSection(cs);
if (Int64(val)+Int64(count))>$7fffffff then
begin
System.LeaveCriticalSection(cs);
Exit(EINVAL);
end;
wc:=-val;
//if (wc=0) then wc:=1;
waiters_count:=-val;
System.InterlockedExchangeAdd(val,count);
if (wc<count) then s:=wc else s:=count;
if ((wc<=0) or ReleaseSemaphore(sema,s,nil)) then
if (waiters_count<=0) then
begin
LeaveCriticalSection(cs);
Exit(0);
end;
if ReleaseSemaphore(sema,_rel_wait_count(waiters_count,count),nil) then
begin
LeaveCriticalSection(cs);
Exit(0);
end;
System.InterlockedExchangeAdd(val, -count);
System.LeaveCriticalSection(cs);
Exit(EINVAL);
end;
function do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
begin
_sig_lock;
Result:=__do_sema_b_release(sema,count,cs,val);
_sig_unlock;
end;
/////
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function sem_impl_init(m,mi:PSceKernelSema;max,value:Integer):Integer;
var
new_mi:SceKernelSema;
@ -164,6 +290,7 @@ begin
new_mi^.value:=value;
new_mi^.s:=CreateSemaphore(nil,0,SEM_VALUE_MAX,nil);
if (new_mi^.s=0) then
begin
FreeMem(new_mi);
@ -180,6 +307,8 @@ begin
FreeMem(new_mi);
mi^:=m^;
end;
Result:=0;
end;
function _sem_init(sem:PSceKernelSema;value:Integer):Integer;
@ -188,7 +317,9 @@ var
begin
if (sem=nil) or (value<0) then Exit(EINVAL);
sv:=sem^;
_sig_lock;
Result:=sem_impl_init(sem,@sv,SEM_VALUE_MAX,value);
_sig_unlock;
end;
function _sem_destroy(sem:PSceKernelSema):Integer;
@ -200,8 +331,8 @@ begin
sv:=XCHG(sem^,nil);
if (sv=nil) then Exit(EINVAL);
if not safe_test(sv^.valid,LIFE_SEM) then Exit(EINVAL);
spin_lock(sv^.lock);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
if not CloseHandle(sv^.s) then
begin
@ -232,10 +363,9 @@ begin
if (sem=nil) then Exit(EINVAL);
sv:=sem^;
if (sv=nil) then Exit(EINVAL);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
if not safe_test(sv^.valid,LIFE_SEM) then Exit(EINVAL);
spin_lock(sv^.lock);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
if (sem^=nil) then
begin
@ -266,7 +396,7 @@ begin
Result:=0;
end;
function _sem_wait(sem:PSceKernelSema;count:Integer;t:DWORD):Integer;
function _sem_wait(sem:PSceKernelSema;count:Integer;pTimeout:PQWORD):Integer;
var
sv:SceKernelSema;
cur_v:Integer;
@ -276,6 +406,10 @@ begin
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
//if (sv^.name='SuspendSemaphore') or
// (sv^.name='ResumeSemaphore') then
// Writeln('>sem_wait:',sv^.name,' count:',count,' value:',sv^.value);
if (count>sv^.max) then
begin
spin_unlock(sv^.lock);
@ -292,36 +426,44 @@ begin
//pthread_cleanup_push (clean_wait_sem, (void *) &arg);
System.InterlockedIncrement(sv^.num);
Result:=do_sema_b_wait_intern(semh,t);
Result:=do_sema_b_wait_intern(semh,pTimeout);
System.InterlockedDecrement(sv^.num);
//if (sv^.name='SuspendSemaphore') or
// (sv^.name='ResumeSemaphore') then
// Writeln('<sem_wait:',sv^.name,' count:',count,' value:',sv^.value);
//pthread_cleanup_pop (ret);
if (Result=EINVAL) then Result:=0;
end;
function _sem_timedwait(sem:PSceKernelSema;ts:Ptimespec):Integer;
var
t:DWORD;
t:QWORD;
begin
if (ts=nil) then
begin
t:=INFINITE;
Result:=_sem_wait(sem,1,nil);
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ts^));
t:=_pthread_rel_time_in_ns(ts^);
Result:=_sem_wait(sem,1,@t);
end;
Result:=_sem_wait(sem,1,t);
end;
function _sem_post(sem:PSceKernelSema;count:Integer):Integer;
var
sv:SceKernelSema;
waiters_count,w:Integer;
waiters_count:Integer;
begin
if (count<=0) then Exit(EINVAL);
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
//if (sv^.name='SuspendSemaphore') or
// (sv^.name='ResumeSemaphore') then
// Writeln('>sem_post:',sv^.name,' count:',count,' value:',sv^.value);
if (count>sv^.max) or (sv^.value>(sv^.max-count)) then
begin
spin_unlock(sv^.lock);
@ -331,9 +473,13 @@ begin
waiters_count:=-sv^.value;
Inc(sv^.value,count);
if (waiters_count<count) then w:=waiters_count else w:=count;
if (waiters_count<=0) then
begin
spin_unlock(sv^.lock);
Exit(0);
end;
if (waiters_count<=0) or ReleaseSemaphore(sv^.s,w,nil) then
if ReleaseSemaphore(sv^.s,_rel_wait_count(waiters_count,count),nil) then
begin
spin_unlock(sv^.lock);
Exit(0);
@ -360,37 +506,41 @@ end;
function ps4_sem_init(sem:PSceKernelSema;value:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_init(sem,value));
Result:=_set_errno(_sem_init(sem,value));
end;
function ps4_sem_destroy(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_destroy(sem));
_sig_lock;
Result:=_set_errno(_sem_destroy(sem));
_sig_unlock;
end;
function ps4_sem_getvalue(sem:PSceKernelSema;sval:PInteger):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_getvalue(sem,sval));
Result:=_set_errno(_sem_getvalue(sem,sval));
end;
function ps4_sem_post(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_post(sem,1));
_sig_lock;
Result:=_set_errno(_sem_post(sem,1));
_sig_unlock;
end;
function ps4_sem_timedwait(sem:PSceKernelSema;ts:Ptimespec):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_timedwait(sem,ts));
Result:=_set_errno(_sem_timedwait(sem,ts));
end;
function ps4_sem_trywait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_trywait(sem));
Result:=_set_errno(_sem_trywait(sem));
end;
function ps4_sem_wait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_wait(sem,1,INFINITE));
Result:=_set_errno(_sem_wait(sem,1,nil));
end;
////
@ -406,31 +556,36 @@ var
begin
if (sem=nil) or (max<=0) or (init<0) then Exit(SCE_KERNEL_ERROR_EINVAL);
sv:=sem^;
_sig_lock;
Result:=px2sce(sem_impl_init(sem,@sv,max,init));
_sig_unlock;
if (Result<>0) then Exit;
if (name<>nil) then MoveChar0(name^,sv^.name,32);
end;
function ps4_sceKernelDeleteSema(sem:SceKernelSema):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=px2sce(_sem_destroy(@sem));
_sig_unlock;
end;
//typedef unsigned int SceKernelUseconds;
function ps4_sceKernelWaitSema(sem:SceKernelSema;Count:Integer;pTimeout:PDWORD):Integer; SysV_ABI_CDecl;
var
q:QWORD;
t:DWORD;
t:QWORD;
begin
if (pTimeout=nil) then
begin
t:=INFINITE;
Result:=px2sce(_sem_wait(@sem,Count,nil));
end else
begin
t:=_usec2msec(pTimeout^);
q:=_pthread_time_in_ms;
t:=_usec2nsec(pTimeout^);
q:=_pthread_time_in_ns;
Result:=px2sce(_sem_wait(@sem,Count,@t));
end;
Result:=px2sce(_sem_wait(@sem,Count,t));
if (pTimeout<>nil) then
begin
if (Result=SCE_KERNEL_ERROR_ETIMEDOUT) then
@ -438,16 +593,24 @@ begin
pTimeout^:=0;
end else
begin
q:=_pthread_time_in_ms-q;
q:=q*1000;
pTimeout^:=dwMilliSecs(q);
t:=_pthread_time_in_ns;
if (t>q) then
begin
q:=t-q;
end else
begin
q:=0;
end;
pTimeout^:=dwMilliSecs(_nsec2usec(q));
end;
end;
end;
function ps4_sceKernelSignalSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=px2sce(_sem_post(@sem,Count));
_sig_unlock;
end;
function ps4_sceKernelPollSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
@ -495,7 +658,9 @@ begin
if (waiters_count>0) then
begin
_sig_lock;
ReleaseSemaphore(sv^.s,waiters_count,nil);
_sig_unlock;
end;
if (count<0) then

146
ps4_libkernel/ps4_signal.pas Normal file
View File

@ -0,0 +1,146 @@
unit ps4_signal;
{$mode objfpc}{$H+}
interface
uses
Windows,
sys_signal;
function ps4_sigfillset(_set:P_sigset_t):Integer; SysV_ABI_CDecl;
function ps4_sigaddset(_set:p_sigset_t;signum:Integer):Integer; SysV_ABI_CDecl;
function ps4_sigprocmask(how:Integer;_set,oldset:P_sigset_t):Integer; SysV_ABI_CDecl;
function ps4_pthread_sigmask(how:Integer;_set,oldset:P_sigset_t):Integer; SysV_ABI_CDecl;
function ps4_is_signal_return(param:PQWORD):Integer; SysV_ABI_CDecl;
type
TsceKernelExceptionHandler=procedure(signum:Integer;context:Pointer); SysV_ABI_CDecl;
function ps4_sceKernelInstallExceptionHandler(signum:Integer;callback:TsceKernelExceptionHandler):Integer; SysV_ABI_CDecl;
function ps4_sceKernelRaiseException(_pthread:Pointer;sig:Integer):Integer; SysV_ABI_CDecl;
implementation
uses
atomic,
sys_kernel;
function ps4_sigfillset(_set:p_sigset_t):Integer; SysV_ABI_CDecl;
begin
if (_set=nil) then Exit(_set_errno(EINVAL));
_set^.qwords[0]:=QWORD(-1);
_set^.qwords[1]:=QWORD(-1);
Result:=0;
end;
function ps4_sigaddset(_set:p_sigset_t;signum:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=_set_errno(_sigaddset(_set,signum));
end;
function ps4_sigprocmask(how:Integer;_set,oldset:p_sigset_t):Integer; SysV_ABI_CDecl;
begin
Result:=_set_errno(__sigprocmask(how,_set,oldset));
end;
function ps4_pthread_sigmask(how:Integer;_set,oldset:p_sigset_t):Integer; SysV_ABI_CDecl;
begin
Result:=__sigprocmask(how,_set,oldset);
end;
//wtf this do?
function ps4_is_signal_return(param:PQWORD):Integer; SysV_ABI_CDecl;
begin
Result:=1;
if (param[0]<>$48006a40247c8d48) or
(param[1]<>$050f000001a1c0c7) or
((param[2] and $ffffff)<>$fdebf4) then
begin
Result:=ord((PQWORD(PByte(param)-5)^ and $ffffffffff)=$50fca8949)*2;
end;
end;
function ps4_sigaction(signum:Integer;act,oldact:p_sigaction_t):Integer; SysV_ABI_CDecl;
begin
Exit(_set_errno(__sigaction(signum,act,oldact)));
end;
function ps4_signal(sig:Integer;func:sig_t):sig_t; SysV_ABI_CDecl;
var
act,old:sigaction_t;
ret:Integer;
begin
act:=Default(sigaction_t);
old:=Default(sigaction_t);
act.__sigaction_u.__sa_handler:=func;
act.sa_flags:=SA_RESTART;
ret:=__sigaction(sig,@act,@old);
if (ret<>0) then
begin
_set_errno(ret);
Exit(sig_t(SIG_ERR));
end;
Result:=old.__sigaction_u.__sa_handler;
end;
var
EX_HANDLERS:array[0..31] of TsceKernelExceptionHandler;
procedure __ex_handler(sig,code:Integer;ctx:Pointer); SysV_ABI_CDecl;
var
cb:TsceKernelExceptionHandler;
begin
if not _SIG_VALID_32(sig) then Exit;
cb:=EX_HANDLERS[_SIG_IDX(sig)];
if (cb<>nil) then
begin
cb(sig,ctx);
end;
end;
function ps4_sceKernelInstallExceptionHandler(signum:Integer;callback:TsceKernelExceptionHandler):Integer; SysV_ABI_CDecl;
var
act:sigaction_t;
begin
if not _SIG_VALID_32(signum) then Exit(SCE_KERNEL_ERROR_EINVAL);
if CAS(Pointer(EX_HANDLERS[_SIG_IDX(signum)]),nil,Pointer(callback)) then
begin
act:=Default(sigaction_t);
act.__sigaction_u.__sa_handler:=@__ex_handler;
act.sa_flags:=SA_RESTART;
Result:=px2sce(__sigaction(signum,@act,nil));
end else
begin
Result:=SCE_KERNEL_ERROR_EAGAIN;
end;
end;
function ps4_sceKernelRaiseException(_pthread:Pointer;sig:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=EINVAL;
if (sig=SIGUSR1) then
begin
Result:=_pthread_kill(_pthread,SIGUSR1);
end;
Result:=px2sce(Result);
end;
end.

386
ps4_libkernel/ps4_time.pas
View File

@ -5,10 +5,7 @@ unit ps4_time;
interface
uses
spinlock,
windows,
ps4_types,
Classes, SysUtils;
sys_types;
const
CLOCK_REALTIME =0;
@ -30,60 +27,48 @@ const
CLOCK_EXT_AD_NETWORK =18; // ORBIS only
CLOCK_EXT_RAW_NETWORK =19; // ORBIS only
function _usec2msec(usec:DWORD):DWORD;
function _pthread_time_in_ms_from_timespec(const ts:timespec):QWORD; inline;
function _pthread_time_in_ms:QWORD; inline;
function _pthread_rel_time_in_ms(const ts:timespec):QWORD;
function dwMilliSecs(ms:QWORD):DWORD; inline;
function _pthread_time_in_ms:QWORD; //Milisecond
function _pthread_rel_time_in_ms(const ts:timespec):QWORD; //Milisecond
function _pthread_time_in_ns:QWORD; //Nanosecond
function _pthread_rel_time_in_ns(const ts:timespec):QWORD; //Nanosecond
function ps4_gettimeofday(tv:Ptimeval;tz:Ptimezone):Integer; SysV_ABI_CDecl;
function ps4_clock_getres(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_clock_gettime(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGettimeofday(tv:Ptimeval):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetTscFrequency():QWORD; SysV_ABI_CDecl;
function ps4_sceKernelReadTsc():QWORD; SysV_ABI_CDecl;
function ps4_sceKernelClockGettime(clockId:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetProcessTime:QWORD; SysV_ABI_CDecl; //microseconds
function ps4_nanosleep(req,rem:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_usleep(usec:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelUsleep(usec:DWORD):Integer; SysV_ABI_CDecl;
Const
FILETIME_1970 =116444736000000000;
HECTONANOSEC_PER_SEC =10000000;
DELTA_EPOCH_IN_100NS =116444736000000000;
POW10_7 =10000000;
POW10_9 =1000000000;
function ps4_usleep(usec:DWORD):Integer; SysV_ABI_CDecl; //microseconds
function ps4_sceKernelUsleep(usec:DWORD):Integer; SysV_ABI_CDecl; //microseconds
implementation
Uses
ps4_libkernel;
Windows,
ntapi,
sys_kernel,
sys_signal,
sys_time;
function _usec2msec(usec:DWORD):DWORD;
begin
Result:=(usec+999) div 1000;
end;
function _pthread_time_in_ms_from_timespec(const ts:timespec):QWORD; inline;
begin
Result:=QWORD(ts.tv_sec)*1000+QWORD(ts.tv_nsec+999999) div 1000000;
end;
function _pthread_time_in_ms:QWORD; inline;
function _pthread_time_in_ms:QWORD; //Milisecond
var
ts:timespec;
begin
ts:=Default(timespec);
ps4_clock_gettime(CLOCK_REALTIME,@ts);
Result:=_pthread_time_in_ms_from_timespec(ts);
Result:=_time_in_ms_from_timespec(ts);
end;
function _pthread_rel_time_in_ms(const ts:timespec):QWORD;
function _pthread_rel_time_in_ms(const ts:timespec):QWORD; //Milisecond
var
t1,t2:QWORD;
begin
t1:=_pthread_time_in_ms_from_timespec(ts);
t1:=_time_in_ms_from_timespec(ts);
t2:=_pthread_time_in_ms;
if (t1<t2) then
Result:=0
@ -91,96 +76,126 @@ begin
Result:=t1-t2;
end;
function dwMilliSecs(ms:QWORD):DWORD; inline;
function _pthread_time_in_ns:QWORD; //Nanosecond
var
ts:timespec;
begin
if (ms>=$ffffffff) then
Result:=$ffffffff
ts:=Default(timespec);
ps4_clock_gettime(CLOCK_REALTIME,@ts);
Result:=_time_in_ms_from_timespec(ts);
end;
function _pthread_rel_time_in_ns(const ts:timespec):QWORD; //Nanosecond
var
t1,t2:QWORD;
begin
t1:=_time_in_ns_from_timespec(ts);
t2:=_pthread_time_in_ns;
if (t1<t2) then
Result:=0
else
Result:=DWORD(ms);
end;
type
TGetSystemTimeAsFileTime=procedure(var lpSystemTimeAsFileTime:TFILETIME); stdcall;
var
_GetSystemTimeAsFileTime:TGetSystemTimeAsFileTime;
procedure GetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME);
var
h:HMODULE;
begin
if (_GetSystemTimeAsFileTime=nil) then
begin
h:=GetModuleHandle('kernel32.dll');
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimePreciseAsFileTime');
if (_GetSystemTimeAsFileTime=nil) then
begin
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimeAsFileTime');
end;
end;
_GetSystemTimeAsFileTime(lpSystemTimeAsFileTime);
end;
procedure gettimezone(z:Ptimezone);
var
TZInfo:TTimeZoneInformation;
tzi:DWORD;
begin
if (z<>nil) then
begin
tzi:=GetTimeZoneInformation(@TZInfo);
if (tzi<>TIME_ZONE_ID_INVALID) then
begin
z^.tz_minuteswest:=TZInfo.Bias;
if (tzi=TIME_ZONE_ID_DAYLIGHT) then
z^.tz_dsttime:=1
else
z^.tz_dsttime:=0;
end else
begin
z^.tz_minuteswest:=0;
z^.tz_dsttime :=0;
end;
end;
end;
function getntptimeofday(tp:Ptimespec;z:Ptimezone):Integer;
var
_now:TFILETIME;
begin
gettimezone(z);
if (tp<>nil) then
begin
GetSystemTimeAsFileTime(_now);
QWORD(_now):=QWORD(_now)-FILETIME_1970;
tp^.tv_sec :=QWORD(_now) div HECTONANOSEC_PER_SEC;
tp^.tv_nsec:=(QWORD(_now) mod HECTONANOSEC_PER_SEC)*100;
end;
Result:=0;
Result:=t1-t2;
end;
function ps4_gettimeofday(tv:Ptimeval;tz:Ptimezone):Integer; SysV_ABI_CDecl;
Var
tp:timespec;
begin
Result:=getntptimeofday(@tp,tz);
if (tv<>nil) then
Result:=_set_errno(Swgetntptimeofday(@tp,tz));
if (Result=0) and (tv<>nil) then
begin
tv^.tv_sec :=tp.tv_sec;
tv^.tv_usec:=(tp.tv_nsec div 1000);
end;
end;
function ps4_sceKernelGettimeofday(tv:Ptimeval):Integer; SysV_ABI_CDecl;
Var
tp:timespec;
begin
Result:=px2sce(Swgetntptimeofday(@tp,nil));
if (Result=0) and (tv<>nil) then
begin
tv^.tv_sec :=tp.tv_sec;
tv^.tv_usec:=(tp.tv_nsec div 1000);
end;
end;
function ps4_clock_getres(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
var
FPerformanceFrequency:TLargeInteger=1;
pc,pf:QWORD;
TimeAdjustment,TimeIncrement:DWORD;
TimeAdjustmentDisabled:BOOL;
begin
if (tp=nil) then Exit(_set_errno(EINVAL));
Result:=0;
case clock_id of
CLOCK_SECOND:
begin
tp^.tv_sec :=1;
tp^.tv_nsec:=0;
end;
CLOCK_PROCTIME,
CLOCK_THREAD_CPUTIME_ID,
CLOCK_REALTIME,
CLOCK_REALTIME_PRECISE,
CLOCK_REALTIME_FAST:
begin
TimeAdjustment:=0;
TimeIncrement:=0;
TimeAdjustmentDisabled:=false;
_sig_lock;
GetSystemTimeAdjustment(TimeAdjustment,TimeIncrement,TimeAdjustmentDisabled);
_sig_unlock;
tp^.tv_sec :=0;
tp^.tv_nsec:=TimeIncrement*100;
if (tp^.tv_nsec<1) then
begin
tp^.tv_nsec:=1;
end;
end;
CLOCK_MONOTONIC,
CLOCK_MONOTONIC_PRECISE,
CLOCK_MONOTONIC_FAST:
begin
SwQueryPerformanceCounter(pc,pf);
tp^.tv_sec :=0;
tp^.tv_nsec:=(POW10_9+(pf shr 1)) div pf;
if (tp^.tv_nsec<1) then
begin
tp^.tv_nsec:=1;
end;
end;
else
Result:=_set_errno(EINVAL);
end;
end;
//var
// old_tp:timespec;
function ps4_clock_gettime(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
var
ct,et,kt,ut:TFILETIME;
pf,pc,tc:TLargeInteger;
pc,pf:QWORD;
begin
if (tp=nil) then Exit(-1);
if (tp=nil) then Exit(_set_errno(EINVAL));
Result:=0;
case clock_id of
@ -208,12 +223,11 @@ begin
CLOCK_MONOTONIC_FAST:
begin
System.ThreadSwitch; //this stabilize timers, why? idk
System.ThreadSwitch;
//this stabilize timers, why? idk
//Int64(pc):=-100*100;
//SwDelayExecution(False,@pc); //100ms
pf:=FPerformanceFrequency;
pc:=0;
QueryPerformanceCounter(pc);
SwQueryPerformanceCounter(pc,pf);
tp^.tv_sec :=pc div pf;
tp^.tv_nsec:=((pc mod pf)*POW10_9+(pf shr 1)) div pf;
@ -224,41 +238,74 @@ begin
Dec(tp^.tv_nsec,POW10_9);
end;
//tp^.tv_nsec:=(tp^.tv_nsec shr 8) shl 8;
//tp^.tv_nsec:=tp^.tv_nsec shr 2;
{
if (old_tp.tv_sec=tp^.tv_sec) then
begin
if (old_tp.tv_nsec>tp^.tv_nsec) then
begin
DebugBreak;
end;
end else
if (old_tp.tv_sec>tp^.tv_sec) then
begin
DebugBreak;
end;
old_tp:=tp^;
}
end;
CLOCK_PROCTIME:
begin
if not GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then Exit(lc_set_errno(EINVAL));
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
_sig_lock;
if not GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then Result:=_set_errno(EINVAL);
_sig_unlock;
if (Result=0) then
begin
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
end;
end;
CLOCK_THREAD_CPUTIME_ID:
begin
if not GetThreadTimes(GetCurrentProcess,ct,et,kt,ut) then Exit(lc_set_errno(EINVAL));
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
_sig_lock;
if not GetThreadTimes(GetCurrentProcess,ct,et,kt,ut) then Result:=_set_errno(EINVAL);
_sig_unlock;
if (Result=0) then
begin
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
end;
end
else
Result:=lc_set_errno(EINVAL);
Result:=_set_errno(EINVAL);
end;
end;
function ps4_sceKernelGetTscFrequency():QWORD; SysV_ABI_CDecl;
var
pc:QWORD;
begin
Result:=FPerformanceFrequency;
SwQueryPerformanceCounter(pc,Result);
end;
function ps4_sceKernelReadTsc():QWORD; SysV_ABI_CDecl;
var
pf:QWORD;
begin
System.ThreadSwitch; //this stabilize timers, why? idk
System.ThreadSwitch;
Result:=0;
QueryPerformanceCounter(TLargeInteger(Result));
//this stabilize timers, why? idk
//Int64(pf):=-100*100;
//SwDelayExecution(False,@pf); //100ms
SwQueryPerformanceCounter(Result,pf);
end;
function ps4_sceKernelClockGettime(clockId:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
@ -270,14 +317,16 @@ function ps4_sceKernelGetProcessTime:QWORD; SysV_ABI_CDecl; //microseconds
var
ct,et,kt,ut:TFileTime;
begin
_sig_lock;
if GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then
begin
Result:=(QWORD(kt)+QWORD(ut)) div 10;
end else
begin
lc_set_errno(EINVAL);
_set_errno(EINVAL);
Result:=0;
end;
_sig_unlock;
end;
//1sec=10 000 000
@ -287,51 +336,90 @@ end;
function ps4_nanosleep(req,rem:Ptimespec):Integer; SysV_ABI_CDecl;
var
timer:THandle;
ft:TLargeInteger;
timeout:Int64;
passed :Int64;
START:QWORD;
begin
if (req=nil) then Exit(EINVAL);
ft:=req^.tv_nsec+req^.tv_sec*1000000000;
ft:=-(ft div 100);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
timeout:=_time_in_ns_from_timespec(req^);
//
//timeout:=((timeout+99999999) div 100000000)*100000000;
//
timeout:=-((timeout+99) div 100); //in 100ns
if (rem<>nil) then
begin
rem^:=Default(timespec);
SwSaveTime(START);
end;
Result:=0;
Case SwDelayExecution(True,@timeout) of
STATUS_USER_APC,
STATUS_KERNEL_APC,
STATUS_ALERTED:
begin
if (rem<>nil) then
begin
timeout:=-timeout;
passed:=SwTimePassedUnits(START);
if (passed>=timeout) then
begin
rem^:=Default(timespec);
end else
begin
timeout:=timeout-passed;
timeout:=timeout*100; //100ns to ns
rem^.tv_sec :=timeout div POW10_9;
rem^.tv_nsec:=timeout mod POW10_9;
end;
end;
Result:=_set_errno(EINVAL);
end;
else
begin
if (rem<>nil) then
begin
rem^:=Default(timespec);
end;
Result:=0;
end;
end;
end;
function ps4_usleep(usec:Integer):Integer; SysV_ABI_CDecl;
function ps4_usleep(usec:DWORD):Integer; SysV_ABI_CDecl; //microseconds
var
timer:THandle;
ft:TLargeInteger;
begin
ft:=-(10*usec);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
Result:=0;
//usec:=((usec+99999) div 100000)*100000;
//
ft:=-(10*usec); //in 100ns
Case SwDelayExecution(True,@ft) of
STATUS_USER_APC,
STATUS_KERNEL_APC,
STATUS_ALERTED:
begin
Result:=_set_errno(EINVAL);
end;
else
Result:=0;
end;
end;
function ps4_sceKernelUsleep(usec:DWORD):Integer; SysV_ABI_CDecl;
var
timer:THandle;
ft:TLargeInteger;
begin
ft:=-(10*usec);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
//usec:=((usec+99999) div 100000)*100000;
//
ft:=-(10*usec); //in 100ns
SwDelayExecution(False,@ft);
Result:=0;
end;
initialization
QueryPerformanceFrequency(FPerformanceFrequency);
end.

187
ps4_libkernel/spinlock.pas
View File

@ -1,187 +0,0 @@
unit spinlock;
{$mode objfpc}{$H+}
interface
type
backoff_exp=object
private
Const
lower_bound = 16; ///< Minimum spinning limit
upper_bound = 16*1024; ///< Maximum spinning limit
Var
m_nExpCur:SizeUInt; //=lower_bound
public
Procedure Wait;
Procedure Reset;
end;
function spin_trylock(Var P:Pointer):Boolean; inline;
function spin_trylock(Var P:DWORD):Boolean; inline;
function spin_tryunlock(Var P:Pointer):Boolean; inline;
function spin_tryunlock(Var P:DWORD):Boolean; inline;
procedure spin_lock(Var P:Pointer);
procedure spin_lock(Var P:DWORD);
procedure spin_unlock(Var P:Pointer);
procedure spin_unlock(Var P:DWORD);
function event_try_enable(Var P:Pointer):Boolean;
function event_try_enable(Var P:DWORD):Boolean;
function event_try_disable(Var P:Pointer):Boolean;
function event_try_disable(Var P:DWORD):Boolean;
procedure event_disable(Var P:Pointer);
procedure event_disable(Var P:DWORD);
implementation
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function XCHG(Var addr:DWORD;New:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
Procedure store_release(Var addr:Pointer;v:Pointer); inline;
begin
WriteBarrier;
addr:=v;
end;
Procedure store_release(Var addr:DWORD;v:DWORD); inline;
begin
WriteBarrier;
addr:=v;
end;
procedure spin_pause; assembler; nostackframe;
asm
pause
end;
Procedure backoff_exp.Wait;
Var
n:SizeUInt;
begin
if (m_nExpCur<=upper_bound) then
begin
For n:=0 to m_nExpCur-1 do
begin
spin_pause;
end;
m_nExpCur:=m_nExpCur*2;
end else
begin
System.ThreadSwitch;
end;
end;
Procedure backoff_exp.Reset;
begin
m_nExpCur:=lower_bound;
end;
function spin_trylock(Var P:Pointer):Boolean; inline;
begin
Result:=XCHG(P,Pointer(1))=nil;
end;
function spin_trylock(Var P:DWORD):Boolean; inline;
begin
Result:=XCHG(P,1)=0;
end;
function spin_tryunlock(Var P:Pointer):Boolean; inline;
begin
Result:=XCHG(P,nil)=Pointer(1);
end;
function spin_tryunlock(Var P:DWORD):Boolean; inline;
begin
Result:=XCHG(P,0)=1;
end;
procedure spin_lock(Var P:Pointer);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (XCHG(P,Pointer(1))<>nil) do bkoff.Wait;
end;
procedure spin_lock(Var P:DWORD);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (XCHG(P,1)<>0) do bkoff.Wait;
end;
procedure spin_unlock(Var P:Pointer);
begin
store_release(P,nil);
end;
procedure spin_unlock(Var P:DWORD);
begin
store_release(P,0);
end;
const
EVL_DIS=0; //disable
EVL_NEW=1; //new
EVL_ENB=2; //enable
function event_try_enable(Var P:Pointer):Boolean;
begin
Result:=(XCHG(P,Pointer(EVL_NEW))=Pointer(EVL_DIS));
if Result then
begin
store_release(P,Pointer(EVL_ENB));
end;
end;
function event_try_enable(Var P:DWORD):Boolean;
begin
Result:=(XCHG(P,EVL_NEW)=EVL_DIS);
if Result then
begin
store_release(P,EVL_ENB);
end;
end;
function event_try_disable(Var P:Pointer):Boolean;
begin
Result:=CAS(P,Pointer(EVL_ENB),Pointer(EVL_DIS));
end;
function event_try_disable(Var P:DWORD):Boolean;
begin
Result:=CAS(P,EVL_ENB,EVL_DIS);
end;
procedure event_disable(Var P:Pointer);
begin
store_release(P,Pointer(EVL_DIS));
end;
procedure event_disable(Var P:DWORD);
begin
store_release(P,EVL_DIS);
end;
end.

73
ps4_libsceappcontent.pas Normal file
View File

@ -0,0 +1,73 @@
unit ps4_libSceAppContent;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes,
SysUtils;
implementation
type
PSceAppContentInitParam=^SceAppContentInitParam;
SceAppContentInitParam=packed record
reserved:array[0..31] of Byte;
end;
PSceAppContentBootParam=^SceAppContentBootParam;
SceAppContentBootParam=packed record
reserved1:array[0..3] of Byte;
attr:DWORD;
reserved2:array[0..31] of Byte;
end;
function ps4_sceAppContentInitialize(initParam:PSceAppContentInitParam;bootParam:PSceAppContentBootParam):Integer; SysV_ABI_CDecl;
begin
Writeln('sceAppContentInitialize');
Result:=0;
end;
Const
SCE_APP_CONTENT_APPPARAM_ID_SKU_FLAG=0;
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_1=1;
SCE_APP_CONTENT_APPPARAM_ID_USER_DEFINED_PARAM_4=4;
SCE_APP_CONTENT_ERROR_PARAMETER=-2133262334;//0x80D90002
SCE_APP_CONTENT_APPPARAM_SKU_FLAG_TRIAL=1;
SCE_APP_CONTENT_APPPARAM_SKU_FLAG_FULL =2;
SCE_APP_CONTENT_ADDCONT_DOWNLOAD_STATUS_INSTALLED=4;
function ps4_sceAppContentAppParamGetInt(paramId:DWORD;value:PInteger):Integer; SysV_ABI_CDecl;
begin
Writeln('sceAppContentAppParamGetInt:',paramId);
Case SCE_APP_CONTENT_APPPARAM_ID_SKU_FLAG of
SCE_APP_CONTENT_APPPARAM_ID_SKU_FLAG:Result:=SCE_APP_CONTENT_APPPARAM_SKU_FLAG_FULL;
1..4:Result:=SCE_APP_CONTENT_ADDCONT_DOWNLOAD_STATUS_INSTALLED;
else
Result:=SCE_APP_CONTENT_ERROR_PARAMETER;
end;
end;
function Load_libSceAppContent(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceAppContent');
lib^.set_proc($47D940F363AB68DB,@ps4_sceAppContentInitialize);
lib^.set_proc($F7D6FCD88297A47E,@ps4_sceAppContentAppParamGetInt);
end;
initialization
ps4_app.RegistredPreLoad('libSceAppContent.prx',@Load_libSceAppContent);
end.

118
ps4_libsceaudioout.pas
View File

@ -7,15 +7,18 @@ unit ps4_libSceAudioOut;
interface
uses
atomic,
spinlock,
libportaudio,
ps4_handles,
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
implementation
uses
ps4_libkernel;
sys_signal;
const
SCE_AUDIO_OUT_ERROR_NOT_OPENED =-2144993279; // 0x80260001
@ -89,15 +92,19 @@ var
function ps4_sceAudioOutInit():Integer; SysV_ABI_CDecl;
begin
if System.InterlockedExchange(_lazy_init,1)=0 then
if XCHG(_lazy_init,1)=0 then
begin
_sig_lock;
Result:=Pa_Initialize();
_sig_unlock;
if (Result<>0) then Exit(SCE_AUDIO_OUT_ERROR_TRANS_EVENT);
_sig_lock;
HAudioOuts:=TIntegerHandles.Create;
System.InterLockedExchangeAdd(_lazy_wait,1);
_sig_unlock;
fetch_add(_lazy_wait,1);
end else
begin
While (System.InterLockedExchangeAdd(_lazy_wait,0)=0) do System.ThreadSwitch;
wait_until_equal(_lazy_wait,0);
Result:=SCE_AUDIO_OUT_ERROR_ALREADY_INIT;
end;
@ -147,8 +154,11 @@ type
Destructor TAudioOutHandle.Destroy;
begin
Pa_StopStream(pstream);
Pa_CloseStream(pstream);
if (pstream<>nil) then
begin
Pa_StopStream(pstream);
Pa_CloseStream(pstream);
end;
FreeMem(buf);
inherited;
end;
@ -244,22 +254,41 @@ begin
Exit(SCE_AUDIO_OUT_ERROR_INVALID_FORMAT);
end;
_sig_lock;
err:=Pa_OpenDefaultStream(@pstream,
0,
pnumOutputChannels,
psampleFormat,
freq,
paFramesPerBufferUnspecified,nil,nil);
_sig_unlock;
if (err<>0) and (pnumOutputChannels>2) then
begin
pnumOutputChannels:=2;
_sig_lock;
err:=Pa_OpenDefaultStream(@pstream,
0,
pnumOutputChannels,
psampleFormat,
freq,
paFramesPerBufferUnspecified,nil,nil);
_sig_unlock;
end;
if (err<>0) then
begin
Writeln('Pa_GetErrorText:',Pa_GetErrorText(err));
//Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
pstream:=nil;
end;
err:=0;
if (pstream<>nil) then
begin
_sig_lock;
err:=Pa_StartStream(pstream);
_sig_unlock;
end;
if (err<>0) then
@ -267,14 +296,10 @@ begin
Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
end;
err:=Pa_StartStream(pstream);
if (err<>0) then
begin
Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
end;
_sig_lock;
H:=TAudioOutHandle.Create;
_sig_unlock;
H.userId:=userId;
H._type :=_type ;
H.index :=index ;
@ -289,13 +314,18 @@ begin
H.pnumOutputChannels:=pnumOutputChannels;
H.psampleFormat :=psampleFormat;
_sig_lock;
if not HAudioOuts.New(H,Result) then Result:=SCE_AUDIO_OUT_ERROR_PORT_FULL;
_sig_unlock;
Case QWORD(psampleFormat) of
QWORD(paInt16 ):H.bufsize:=2*pnumOutputChannels*len;
QWORD(paFloat32):H.bufsize:=4*pnumOutputChannels*len;
end;
_sig_lock;
H.buf:=GetMem(H.bufsize);
_sig_unlock;
H.Release;
@ -304,9 +334,11 @@ end;
function ps4_sceAudioOutClose(handle:Integer):Integer; SysV_ABI_CDecl;
begin
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
if not HAudioOuts.Delete(handle) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
Result:=0;
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
_sig_lock;
if not HAudioOuts.Delete(handle) then Result:=SCE_AUDIO_OUT_ERROR_INVALID_PORT;
_sig_unlock;
end;
function ps4_sceAudioOutSetVolume(handle,flag:Integer;vol:PInteger):Integer; SysV_ABI_CDecl;
@ -322,7 +354,10 @@ begin
{$ifdef silent}if (i>800) then i:=800;{$endif}
_sig_lock;
H:=TAudioOutHandle(HAudioOuts.Acqure(handle));
_sig_unlock;
if (H=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
if (flag and SCE_AUDIO_VOLUME_FLAG_L_CH <>0) then H.volume[0]:=i;
@ -484,21 +519,29 @@ begin
if (ptr=nil) then Exit(0);
err:=0;
_sig_lock;
H:=TAudioOutHandle(HAudioOuts.Acqure(handle));
_sig_unlock;
if (H=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
count:=H.len;
if (H.pstream<>nil) then
case (H.param and SCE_AUDIO_OUT_PARAM_FORMAT_MASK) of
SCE_AUDIO_OUT_PARAM_FORMAT_S16_MONO:
begin
_VecMulI16M(ptr,H.buf,count,H.volume[0]);
_sig_lock;
err:=Pa_WriteStream(H.pstream,H.buf,count);
_sig_unlock;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_STEREO:
begin
_VecMulI16S(ptr,H.buf,count,@H.volume);
_sig_lock;
err:=Pa_WriteStream(H.pstream,H.buf,count);
_sig_unlock;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH:
begin
@ -507,12 +550,16 @@ begin
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_MONO:
begin
_VecMulF32M(ptr,H.buf,count,H.volume[0]);
_sig_lock;
err:=Pa_WriteStream(H.pstream,H.buf,count);
_sig_unlock;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_STEREO:
begin
_VecMulF32S(ptr,H.buf,count,@H.volume);
_sig_lock;
err:=Pa_WriteStream(H.pstream,H.buf,count);
_sig_unlock;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH:
begin
@ -520,7 +567,9 @@ begin
if H.pnumOutputChannels=2 then
begin
_VecMulF32CH8ToS(ptr,H.buf,count,@H.volume);
_sig_lock;
err:=Pa_WriteStream(H.pstream,H.buf,count);
_sig_unlock;
end else
begin
Assert(false);
@ -538,42 +587,15 @@ begin
end;
if err<>0 then
case PaErrorCode(err) of
paNotInitialized :Writeln('paNotInitialized ');
paUnanticipatedHostError :Writeln('paUnanticipatedHostError ');
paInvalidChannelCount :Writeln('paInvalidChannelCount ');
paInvalidSampleRate :Writeln('paInvalidSampleRate ');
paInvalidDevice :Writeln('paInvalidDevice ');
paInvalidFlag :Writeln('paInvalidFlag ');
paSampleFormatNotSupported :Writeln('paSampleFormatNotSupported ');
paBadIODeviceCombination :Writeln('paBadIODeviceCombination ');
paInsufficientMemory :Writeln('paInsufficientMemory ');
paBufferTooBig :Writeln('paBufferTooBig ');
paBufferTooSmall :Writeln('paBufferTooSmall ');
paNullCallback :Writeln('paNullCallback ');
paBadStreamPtr :Writeln('paBadStreamPtr ');
paTimedOut :Writeln('paTimedOut ');
paInternalError :Writeln('paInternalError ');
paDeviceUnavailable :Writeln('paDeviceUnavailable ');
paIncompatibleHostApiSpecificStreamInfo:Writeln('paIncompatibleHostApiSpecificStreamInfo');
paStreamIsStopped :Writeln('paStreamIsStopped ');
paStreamIsNotStopped :Writeln('paStreamIsNotStopped ');
paInputOverflowed :Writeln('paInputOverflowed ');
paOutputUnderflowed :Writeln('paOutputUnderflowed ');
paHostApiNotFound :Writeln('paHostApiNotFound ');
paInvalidHostApi :Writeln('paInvalidHostApi ');
paCanNotReadFromACallbackStream :Writeln('paCanNotReadFromACallbackStream ');
paCanNotWriteToACallbackStream :Writeln('paCanNotWriteToACallbackStream ');
paCanNotReadFromAnOutputOnlyStream :Writeln('paCanNotReadFromAnOutputOnlyStream ');
paCanNotWriteToAnInputOnlyStream :Writeln('paCanNotWriteToAnInputOnlyStream ');
paIncompatibleStreamHostApi :Writeln('paIncompatibleStreamHostApi ');
paBadBufferPtr :Writeln('paBadBufferPtr ');
end;
if (err<>0) then
Writeln('Pa_GetErrorText:',Pa_GetErrorText(err));
//Writeln('sceAudioOutOutput:',handle,':',HexStr(ptr));
_sig_lock;
H.Release;
_sig_unlock;
Result:=0;
end;

46
ps4_libscedialogs.pas
View File

@ -6,7 +6,9 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils,
ps4_libSceSaveData;
implementation
@ -42,10 +44,24 @@ end;
function ps4_sceSaveDataDialogUpdateStatus():Integer; SysV_ABI_CDecl;
begin
Writeln('sceSaveDataDialogUpdateStatus');
//Writeln('sceSaveDataDialogUpdateStatus');
Result:=SCE_COMMON_DIALOG_STATUS_NONE;
end;
type
pSceSaveDataDialogResult=^SceSaveDataDialogResult;
SceSaveDataDialogResult=packed record
mode:Integer;//SceSaveDataDialogMode; //Mode of function
result:Integer; //Result of executing function
buttonId:Integer;//SceSaveDataDialogButtonId; //Id of button user selected
_align:Integer;
dirName:pSceSaveDataDirName; //savedata directory name
param:pSceSaveDataParam; //Buffer to receive savedata information ( can be set NULL if you don't need it)
userData:Pointer; //Userdata specified at calling function
reserved:array[0..31] of Byte; //Reserved range (must be filled by zero)
end;
function ps4_sceSaveDataDialogProgressBarSetValue(target:Integer;rate:DWORD):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSaveDataDialogProgressBarSetValue:',rate);
@ -58,6 +74,20 @@ begin
Result:=0;
end;
const
SCE_COMMON_DIALOG_ERROR_NOT_FINISHED=-2135425019;//0x80B80005
function ps4_sceSaveDataDialogGetResult(_result:pSceSaveDataDialogResult):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_COMMON_DIALOG_ERROR_NOT_FINISHED;
end;
function ps4_sceMsgDialogInitialize():Integer; SysV_ABI_CDecl;
begin
Writeln('sceMsgDialogInitialize');
Result:=0;
end;
function Load_libSceCommonDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
@ -104,6 +134,17 @@ begin
lib^.set_proc($28ADC1760D5158AD,@ps4_sceSaveDataDialogUpdateStatus);
lib^.set_proc($85ACB509F4E62F20,@ps4_sceSaveDataDialogProgressBarSetValue);
lib^.set_proc($62E1F6140EDACEA4,@ps4_sceSaveDataDialogTerminate);
lib^.set_proc($C84889FEAAABE828,@ps4_sceSaveDataDialogGetResult);
end;
function Load_libSceMsgDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceMsgDialog');
lib^.set_proc($943AB1698D546C4A,@ps4_sceMsgDialogInitialize);
end;
initialization
@ -111,6 +152,7 @@ initialization
ps4_app.RegistredPreLoad('libSceErrorDialog.prx',@Load_libSceErrorDialog);
ps4_app.RegistredPreLoad('libSceNpProfileDialog.prx',@Load_libSceNpProfileDialog);
ps4_app.RegistredPreLoad('libSceSaveDataDialog.prx',@Load_libSceSaveDataDialog);
ps4_app.RegistredPreLoad('libSceMsgDialog.prx',@Load_libSceMsgDialog);
end.

39
ps4_libscegnmdriver.pas
View File

@ -5,7 +5,9 @@ unit ps4_libSceGnmDriver;
interface
uses
Classes, SysUtils, bittype, ps4_videodrv;
Classes,
SysUtils,
ps4_videodrv;
procedure post_event_eop;
@ -14,6 +16,8 @@ implementation
uses
hamt,
ps4_program,
sys_signal,
sys_kernel,
ps4_queue,
ps4_libkernel,
ps4_libSceVideoOut{, ps4_pssl};
@ -376,12 +380,17 @@ var
begin
Result:=-1;
if (numDwords<>7) then Exit;
//sceVideoOutGetBufferLabelAddress(videoOutHandle,&base);
//addr = base + (ulong)(uint)displayBufferIndex * 8;
_sig_lock;
addr:=_VideoOutGetBufferAdr(videoOutHandle,displayBufferIndex);
_sig_unlock;
if (addr=nil) then Exit;
cmdBuffer[0]:=$c0053c00;
cmdBuffer[0]:=$c0053c00; //IT_WAIT_REG_MEM
cmdBuffer[1]:=$13;
cmdBuffer[2]:=QWORD(addr) and $fffffffc;
cmdBuffer[3]:=(QWORD(addr) shr $20) and $ffff;
cmdBuffer[2]:=QWORD(addr);
cmdBuffer[3]:=(QWORD(addr) shr $20);
cmdBuffer[4]:=0;
cmdBuffer[5]:=$ffffffff;
cmdBuffer[6]:=10;
@ -391,11 +400,6 @@ end;
const
kAlignmentOfShaderInBytes=256;
function getCodeAddress(PgmHi,PgmLo:DWORD):Pointer;
begin
Result:=Pointer(((QWORD(PgmHi) shl 40) or (QWORD(PgmLo) shl 8)));
end;
procedure patchShaderGpuAddress(gpuAddress:Pointer;var PgmHi,PgmLo:DWORD);
begin
Assert(gpuAddress<>nil,'gpuAddress must not be NULL.');
@ -1041,7 +1045,9 @@ function ps4_sceGnmSubmitCommandBuffers(
begin
//exit(0);
_sig_lock;
vSubmitCommandBuffers(count,dcbGpuAddrs,dcbSizesInBytes,ccbGpuAddrs,ccbSizesInBytes,nil);
_sig_unlock;
Result:=0;
end;
@ -1065,7 +1071,9 @@ begin
Flip.flipMode :=flipMode;
Flip.flipArg :=flipArg;
_sig_lock;
vSubmitCommandBuffers(count,dcbGpuAddrs,dcbSizesInBytes,ccbGpuAddrs,ccbSizesInBytes,@Flip);
_sig_unlock;
Result:=0;
end;
@ -1075,7 +1083,9 @@ begin
//exit(0);
//Writeln('SubmitDone');
_sig_lock;
vSubmitDone;
_sig_unlock;
Result:=0;
end;
@ -1120,7 +1130,7 @@ const
var
EopEvents:Thamt64locked;
function ps4_sceGnmAddEqEvent(eq:SceKernelEqueue;id:Integer;udata:Pointer):Integer; SysV_ABI_CDecl;
function _sceGnmAddEqEvent(eq:SceKernelEqueue;id:Integer;udata:Pointer):Integer;
var
P:PPointer;
node:PKEventNode;
@ -1157,6 +1167,13 @@ begin
Result:=0;
end;
function ps4_sceGnmAddEqEvent(eq:SceKernelEqueue;id:Integer;udata:Pointer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=_sceGnmAddEqEvent(eq,id,udata);
_sig_unlock;
end;
procedure _on_trigger_eop(data,userdata:Pointer);
var
node:PKEventNode;
@ -1168,9 +1185,11 @@ end;
procedure post_event_eop;
begin
_sig_lock;
EopEvents.LockRd;
HAMT_traverse64(@EopEvents.hamt,@_on_trigger_eop,nil);
EopEvents.Unlock;
_sig_unlock;
end;
function Load_libSceGnmDriver(Const name:RawByteString):TElf_node;

27
ps4_libscenet.pas
View File

@ -6,7 +6,8 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
implementation
@ -68,7 +69,7 @@ function ps4_sceNetCtlCheckCallback():Integer; SysV_ABI_CDecl;
begin
if (NetCtlCb.func<>nil) then
begin
NetCtlCb.func(SCE_NET_CTL_EVENT_TYPE_DISCONNECTED,NetCtlCb.arg);
//NetCtlCb.func(SCE_NET_CTL_EVENT_TYPE_DISCONNECTED,NetCtlCb.arg);
end;
Result:=0;
end;
@ -83,6 +84,23 @@ begin
Result:=0;
end;
function ps4_sceNetCtlRegisterCallbackForNpToolkit(func:SceNetCtlCallback;arg:Pointer;cid:PInteger):Integer; SysV_ABI_CDecl;
begin
NetCtlCb.func:=func;
NetCtlCb.arg:=arg;
if (cid<>nil) then cid^:=0;
Result:=0;
end;
function ps4_sceNetCtlCheckCallbackForNpToolkit():Integer; SysV_ABI_CDecl;
begin
if (NetCtlCb.func<>nil) then
begin
//NetCtlCb.func(SCE_NET_CTL_EVENT_TYPE_DISCONNECTED,NetCtlCb.arg);
end;
Result:=0;
end;
function Load_libSceNet(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
@ -106,6 +124,11 @@ begin
lib^.set_proc($509F99ED0FB8724D,@ps4_sceNetCtlRegisterCallback);
lib^.set_proc($890C378903E1BD44,@ps4_sceNetCtlCheckCallback);
lib^.set_proc($D1C06076E3D147E3,@ps4_sceNetCtlGetResult);
lib:=Result._add_lib('libSceNetCtlForNpToolkit');
lib^.set_proc($C08B0ACBE4DF78BB,@ps4_sceNetCtlRegisterCallbackForNpToolkit);
lib^.set_proc($BB9A2AB6520FF85C,@ps4_sceNetCtlCheckCallbackForNpToolkit);
end;
initialization

77
ps4_libscenpmanager.pas
View File

@ -6,9 +6,8 @@ interface
uses
ps4_program,
Classes, SysUtils;
implementation
Classes,
SysUtils;
Const
SCE_NP_COUNTRY_CODE_LENGTH=2;
@ -36,17 +35,12 @@ type
ageRestriction:SceNpAgeRestriction;
end;
function ps4_sceNpSetContentRestriction(pRestriction:PSceNpContentRestriction):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpSetContentRestriction:',HexStr(pRestriction));
Result:=0;
end;
const
SCE_NP_ONLINEID_MIN_LENGTH=3;
SCE_NP_ONLINEID_MAX_LENGTH=16;
type
pSceNpOnlineId=^SceNpOnlineId;
SceNpOnlineId=packed record
data:array[0..SCE_NP_ONLINEID_MAX_LENGTH-1] of AnsiChar;
term:AnsiChar;
@ -60,14 +54,6 @@ type
reserved:array[0..7] of Byte;
end;
function ps4_sceNpGetNpId(userId:Integer;npId:PSceNpId):Integer; SysV_ABI_CDecl;
begin
npId^:=Default(SceNpId);
npId^.handle.data:='user';
Result:=0;
end;
const
SCE_NP_TITLE_ID_LEN=12;
@ -85,22 +71,6 @@ type
PSceNpTitleSecret=^SceNpTitleSecret;
SceNpTitleSecret=array[0..SCE_NP_TITLE_SECRET_SIZE-1] of Byte;
function GetStr(p:Pointer;L:SizeUint):RawByteString; inline;
begin
SetString(Result,P,L);
end;
function ps4_sceNpSetNpTitleId(titleId:PSceNpTitleId;titleSecret:PSceNpTitleSecret):Integer; SysV_ABI_CDecl;
begin
Writeln(GetStr(@titleId^.id,StrLen(@titleId^.id)));
Result:=0;
end;
function ps4_sceNpCheckCallback():Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
const
SCE_NP_STATE_UNKNOWN =0;
SCE_NP_STATE_SIGNED_OUT =1;
@ -119,6 +89,44 @@ const
SCE_NP_ERROR_INVALID_ARGUMENT=$80550003;
SCE_NP_ERROR_CALLBACK_ALREADY_REGISTERED=$80550008;
implementation
function ps4_sceNpSetContentRestriction(pRestriction:PSceNpContentRestriction):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpSetContentRestriction:',HexStr(pRestriction));
Result:=0;
end;
function ps4_sceNpGetNpId(userId:Integer;npId:PSceNpId):Integer; SysV_ABI_CDecl;
begin
npId^:=Default(SceNpId);
npId^.handle.data:='user';
Result:=0;
end;
function ps4_sceNpGetOnlineId(userId:Integer;onlineId:pSceNpOnlineId):Integer; SysV_ABI_CDecl;
begin
onlineId^:=Default(SceNpOnlineId);
onlineId^.data:='user';
Result:=0;
end;
function GetStr(p:Pointer;L:SizeUint):RawByteString; inline;
begin
SetString(Result,P,L);
end;
function ps4_sceNpSetNpTitleId(titleId:PSceNpTitleId;titleSecret:PSceNpTitleSecret):Integer; SysV_ABI_CDecl;
begin
Writeln(GetStr(@titleId^.id,StrLen(@titleId^.id)));
Result:=0;
end;
function ps4_sceNpCheckCallback():Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
var
Cb4Toolkit:packed record
callback:SceNpStateCallbackA;
@ -132,6 +140,8 @@ begin
Result:=0;
end;
//nop nid:libSceNpManager:55F45298F9A3F10F:sceNpRegisterStateCallback
function ps4_sceNpCheckCallbackForLib():Integer; SysV_ABI_CDecl;
begin
if (Cb4Toolkit.callback<>nil) then
@ -150,6 +160,7 @@ begin
lib:=Result._add_lib('libSceNpManager');
lib^.set_proc($036090DE4812A294,@ps4_sceNpSetContentRestriction);
lib^.set_proc($A7FA3BE029E83736,@ps4_sceNpGetNpId);
lib^.set_proc($5C39DC5D02095129,@ps4_sceNpGetOnlineId);
lib^.set_proc($11CEB7CB9F65F6DC,@ps4_sceNpSetNpTitleId);
lib^.set_proc($DD997C05E3D387D6,@ps4_sceNpCheckCallback);

12
ps4_libscenpscore.pas
View File

@ -6,11 +6,18 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils,
ps4_libSceNpManager;
implementation
function ps4_sceNpScoreCreateNpTitleCtx(npServiceLabel:Integer;selfId:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceNpScoreCreateNpTitleCtx(npServiceLabel:Integer;selfNpId:PSceNpId):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNpScoreCreateNpTitleCtxA(npServiceLabel:Integer;selfId:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
@ -138,6 +145,7 @@ begin
Result.pFileName:=name;
lib:=Result._add_lib('libSceNpScore');
lib^.set_proc($2A7340D53120B412,@ps4_sceNpScoreCreateNpTitleCtx);
lib^.set_proc($1969D640D5D91F93,@ps4_sceNpScoreCreateNpTitleCtxA);
lib^.set_proc($816F2ACA362B51B9,@ps4_sceNpScoreCreateRequest);
lib^.set_proc($74AF3F4A061FEABE,@ps4_sceNpScoreDeleteRequest);
lib^.set_proc($F24B88CD4C3ABAD4,@ps4_sceNpScoreGetFriendsRanking);

92
ps4_libscenptrophy.pas
View File

@ -6,14 +6,63 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
const
SCE_NP_TROPHY_NUM_MAX =(128);
SCE_NP_TROPHY_SCREENSHOT_TARGET_NUM_MAX=(4);
SCE_NP_TROPHY_GAME_TITLE_MAX_SIZE =(128);
SCE_NP_TROPHY_GAME_DESCR_MAX_SIZE =(1024);
SCE_NP_TROPHY_GROUP_TITLE_MAX_SIZE=(128);
SCE_NP_TROPHY_GROUP_DESCR_MAX_SIZE=(1024);
SCE_NP_TROPHY_NAME_MAX_SIZE =(128);
SCE_NP_TROPHY_DESCR_MAX_SIZE =(1024);
// grade
SCE_NP_TROPHY_GRADE_UNKNOWN =(0);
SCE_NP_TROPHY_GRADE_PLATINUM=(1);
SCE_NP_TROPHY_GRADE_GOLD =(2);
SCE_NP_TROPHY_GRADE_SILVER =(3);
SCE_NP_TROPHY_GRADE_BRONZE =(4);
type
SceNpTrophyHandle =Integer;
SceNpTrophyContext =Integer;
SceNpTrophyId =Integer;
SceNpTrophyGroupId =Integer;
SceNpTrophyGrade =Integer;
SceNpTrophyFlagMask=DWORD;
const
SCE_NP_TROPHY_INVALID_HANDLE =(-1);
SCE_NP_TROPHY_INVALID_CONTEXT =(-1);
SCE_NP_TROPHY_INVALID_TROPHY_ID =(-1);
SCE_NP_TROPHY_INVALID_GROUP_ID =(-2);
SCE_NP_TROPHY_BASE_GAME_GROUP_ID=(-1);
// trophy flag array
SCE_NP_TROPHY_FLAG_SETSIZE =(128);
SCE_NP_TROPHY_FLAG_BITS =(sizeof(SceNpTrophyFlagMask) * 8);
SCE_NP_TROPHY_FLAG_BITS_ALL =(High(SceNpTrophyFlagMask));
SCE_NP_TROPHY_FLAG_BITS_SHIFT=(5);
SCE_NP_TROPHY_FLAG_BITS_MASK =(SCE_NP_TROPHY_FLAG_BITS - 1);
SCE_NP_TROPHY_FLAG_BITS_MAX =(SCE_NP_TROPHY_FLAG_SETSIZE - 1);
type
pSceNpTrophyFlagArray=^SceNpTrophyFlagArray;
SceNpTrophyFlagArray=packed record
flagBits:array[0..(SCE_NP_TROPHY_FLAG_SETSIZE shr SCE_NP_TROPHY_FLAG_BITS_SHIFT)-1] of SceNpTrophyFlagMask;
end;
implementation
function ps4_sceNpTrophyCreateContext(context:PInteger;
userId:Integer;
serviceLabel:DWORD;
options:QWORD):Integer; SysV_ABI_CDecl;
userId:Integer;
serviceLabel:DWORD;
options:QWORD):Integer; SysV_ABI_CDecl;
begin
context^:=543;
Result:=0;
@ -25,18 +74,41 @@ begin
Result:=0;
end;
function ps4_sceNpTrophyRegisterContext(context:Integer;
handle:Integer;
options:QWORD):Integer; SysV_ABI_CDecl;
function ps4_sceNpTrophyDestroyHandle(handle:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNpTrophyDestroyHandle(handle:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceNpTrophyRegisterContext(context:Integer;
handle:Integer;
options:QWORD):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNpTrophyGetTrophyUnlockState(context:Integer;
handle:Integer;
flags:pSceNpTrophyFlagArray;
count:PDWORD):Integer; SysV_ABI_CDecl;
begin
Result:=0;
flags^:=Default(SceNpTrophyFlagArray);
count^:=0;
end;
function ps4_sceNpTrophyUnlockTrophy(context:Integer;
handle:Integer;
trophyId:Integer;
platinumId:PInteger):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpTrophyUnlockTrophy:',trophyId);
if (platinumId<>nil) then
begin
platinumId^:=SCE_NP_TROPHY_INVALID_TROPHY_ID;
end;
Result:=0;
end;
function Load_libSceNpTrophy(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
@ -46,8 +118,10 @@ begin
lib:=Result._add_lib('libSceNpTrophy');
lib^.set_proc($5DB9236E86D99426,@ps4_sceNpTrophyCreateContext);
lib^.set_proc($ABB53AB440107FB7,@ps4_sceNpTrophyCreateHandle);
lib^.set_proc($4C9080C6DA3D4845,@ps4_sceNpTrophyRegisterContext);
lib^.set_proc($18D705E2889D6346,@ps4_sceNpTrophyDestroyHandle);
lib^.set_proc($4C9080C6DA3D4845,@ps4_sceNpTrophyRegisterContext);
lib^.set_proc($2C7B9298EDD22DDF,@ps4_sceNpTrophyGetTrophyUnlockState);
lib^.set_proc($DBCC6645415AA3AF,@ps4_sceNpTrophyUnlockTrophy);
end;
initialization

34
ps4_libscepad.pas
View File

@ -7,7 +7,9 @@ interface
uses
windows,
ps4_program,
Classes, SysUtils;
sys_signal,
Classes,
SysUtils;
implementation
@ -34,6 +36,11 @@ begin
Result:=222;
end;
function ps4_scePadClose(handle:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
const
ORBIS_PAD_PORT_TYPE_STANDARD=0;
@ -70,7 +77,7 @@ type
end;
ScePadAnalogButtons=packed record
l2,r2:Byte;
padding :Word;
padding:Word;
end;
ScePadTouch=packed record
@ -140,6 +147,8 @@ begin
//Writeln(SizeOf(TPadData)); //184
data^:=Default(ScePadData);
_sig_lock;
//FillChar(data^,SizeOf(ScePadData),1);
data^.connected:=True;
@ -151,6 +160,8 @@ begin
data^.rightStick.x:=$80;
data^.rightStick.y:=$80;
//
if GetAsyncKeyState(VK_W)<>0 then
data^.leftStick.y:=0;
@ -163,6 +174,22 @@ begin
if GetAsyncKeyState(VK_D)<>0 then
data^.leftStick.x:=$FF;
//
if GetAsyncKeyState(VK_I)<>0 then
data^.rightStick.y:=0;
if GetAsyncKeyState(VK_K)<>0 then
data^.rightStick.y:=$FF;
if GetAsyncKeyState(VK_J)<>0 then
data^.rightStick.x:=0;
if GetAsyncKeyState(VK_L)<>0 then
data^.rightStick.x:=$FF;
//
if GetAsyncKeyState(VK_RETURN)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_OPTIONS;
@ -191,6 +218,8 @@ begin
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_SQUARE;
//data^.buttons:=not data^.buttons;
_sig_unlock;
Result:=0;
end;
@ -291,6 +320,7 @@ begin
lib:=Result._add_lib('libScePad');
lib^.set_proc($86FD65BA226BA903,@ps4_scePadInit);
lib^.set_proc($EA77207B9FA5E50B,@ps4_scePadClose);
lib^.set_proc($C64D0071AACFDD5E,@ps4_scePadOpen);
lib^.set_proc($6277605EA41557B7,@ps4_scePadReadState);
lib^.set_proc($AB570735F1B270B2,@ps4_scePadRead);

27
ps4_libscesavedata.pas
View File

@ -6,7 +6,8 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
Const
SCE_SAVE_DATA_TITLE_MAXSIZE =128;
@ -84,16 +85,21 @@ type
implementation
uses
ps4_libkernel;
sys_signal;
function ps4_sceSaveDataInitialize(params:Pointer):Integer; assembler; nostackframe;
asm
xor %rax,%rax
function ps4_sceSaveDataInitialize(params:Pointer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceSaveDataInitialize3(params:Pointer):Integer; assembler; nostackframe;
asm
xor %rax,%rax
function ps4_sceSaveDataInitialize3(params:Pointer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceSaveDataTerminate:Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceSaveDataSetupSaveDataMemory(userId:Integer;
@ -135,12 +141,16 @@ const
function ps4_sceSaveDataMount2(mount:PSceSaveDataMount2;mountResult:PSceSaveDataMountResult):Integer; SysV_ABI_CDecl;
begin
if (mount=nil) or (mountResult=nil) then Exit(SCE_SAVE_DATA_ERROR_PARAMETER);
_sig_lock;
Result:=FetchMount(PChar(mount^.dirName),@mountResult^.mountPoint);
_sig_unlock;
end;
function ps4_sceSaveDataUmount(mountPoint:PSceSaveDataMountPoint):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=UnMountPath(PChar(mountPoint));
_sig_unlock;
end;
type
@ -165,6 +175,7 @@ begin
lib^.set_proc($664661B2408F5C5C,@ps4_sceSaveDataInitialize);
lib^.set_proc($4F2C2B14A0A82C66,@ps4_sceSaveDataInitialize3);
lib^.set_proc($C8A0F2F12E722C0D,@ps4_sceSaveDataTerminate);
lib^.set_proc($BFB00000CA342F3E,@ps4_sceSaveDataSetupSaveDataMemory);
lib^.set_proc($EC1B79A410BF01CA,@ps4_sceSaveDataGetSaveDataMemory);
lib^.set_proc($8776144735C64954,@ps4_sceSaveDataSetSaveDataMemory);

5
ps4_libscesystemservice.pas
View File

@ -6,12 +6,13 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
implementation
uses
ps4_libkernel;
sys_kernel;
const
SCE_SYSTEM_SERVICE_PARAM_ID_LANG =1;

52
ps4_libsceuserservice.pas
View File

@ -6,13 +6,10 @@ interface
uses
ps4_program,
Classes, SysUtils;
Classes,
SysUtils;
const
SCE_KERNEL_PRIO_FIFO_LOWEST =$2FF;
SCE_KERNEL_PRIO_FIFO_NORMAL =$2BC;
SCE_KERNEL_PRIO_FIFO_HIGHEST=$100;
SCE_USER_SERVICE_MAX_LOGIN_USERS=4;
SCE_USER_SERVICE_USER_ID_INVALID=Integer($FFFFFFFF);
@ -27,11 +24,30 @@ type
userId:array[0..SCE_USER_SERVICE_MAX_LOGIN_USERS-1] of Integer;
end;
const
//SceUserServiceEventType
SCE_USER_SERVICE_EVENT_TYPE_LOGIN =0;
SCE_USER_SERVICE_EVENT_TYPE_LOGOUT =1;
type
pSceUserServiceEvent=^SceUserServiceEvent;
SceUserServiceEvent=packed record
eventType:Integer; //SceUserServiceEventType
userId:Integer; //SceUserServiceUserId
end;
TUserServiceEventCallback=procedure(event:pSceUserServiceEvent;arg:Pointer); SysV_ABI_CDecl;
implementation
function ps4_sceUserServiceInitialize(params:PUserServiceInitializeParams):Integer; assembler; nostackframe;
asm
xor %rax,%rax
function ps4_sceUserServiceInitialize(params:PUserServiceInitializeParams):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceUserServiceTerminate:Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceUserServiceGetLoginUserIdList(List:PUserServiceLoginUserIdList):Integer; SysV_ABI_CDecl;
@ -62,6 +78,20 @@ begin
Result:=0;
end;
function ps4_sceUserServiceRegisterEventCallback(func:TUserServiceEventCallback;arg:Pointer):Integer; SysV_ABI_CDecl;
begin
Writeln('sceUserServiceRegisterEventCallback:',HexStr(func));
Result:=0;
end;
const
SCE_USER_SERVICE_ERROR_NO_EVENT=-2137653241; //0x80960007
function ps4_sceUserServiceGetEvent(event:pSceUserServiceEvent):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_USER_SERVICE_ERROR_NO_EVENT;
end;
function Load_libSceUserService(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
@ -72,9 +102,15 @@ begin
lib:=Result._add_lib('libSceUserService');
lib^.set_proc($8F760CBB531534DA,@ps4_sceUserServiceInitialize);
lib^.set_proc($6F01634BE6D7F660,@ps4_sceUserServiceTerminate);
lib^.set_proc($7CF87298A36F2BF0,@ps4_sceUserServiceGetLoginUserIdList);
lib^.set_proc($09D5A9D281D61ABD,@ps4_sceUserServiceGetInitialUser);
lib^.set_proc($D71C5C3221AED9FA,@ps4_sceUserServiceGetUserName);
lib^.set_proc($C87D7B43A356B558,@ps4_sceUserServiceGetEvent);
lib:=Result._add_lib('libSceUserServiceForNpToolkit');
lib^.set_proc($C2E23B73B50D9340,@ps4_sceUserServiceRegisterEventCallback);
end;
initialization

265
ps4_libscevideoout.pas
View File

@ -5,7 +5,8 @@ unit ps4_libSceVideoOut;
interface
uses
Classes, SysUtils,
Classes,
SysUtils,
Controls,
ExtCtrls,
Interfaces,
@ -15,7 +16,7 @@ uses
LFQueue,
ps4_program,
ps4_types,
sys_types,
ps4_queue,
ps4_handles,
@ -232,6 +233,8 @@ implementation
uses
vFlip,
sys_signal,
sys_time,
ps4_time,
spinlock,
hamt;
@ -245,6 +248,7 @@ type
public
lock:Pointer;
Parent:TOnParent;
wait:SizeUint;
u:record
Case Byte of
0:(bufferIndex:Integer;
@ -505,6 +509,8 @@ var
H:TVideoOut;
node:PQNode;
begin
_sig_lock;
H:=TVideoOut.Create;
node:=H.alloc_node;
@ -518,12 +524,16 @@ begin
H.Release;
Writeln('sceVideoOutOpen:',userID,' ',busType);
_sig_unlock;
end;
function ps4_sceVideoOutClose(handle:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
_sig_lock;
if not FVideoOutMap.Delete(handle) then Result:=SCE_VIDEO_OUT_ERROR_INVALID_HANDLE;
_sig_unlock;
end;
procedure ps4_sceVideoOutSetBufferAttribute; assembler; nostackframe;
@ -551,14 +561,14 @@ end;
// udata:Pointer; //udata
//end;
function ps4_sceVideoOutGetEventCount(ev:PSceKernelEvent):Integer;
function ps4_sceVideoOutGetEventCount(ev:PSceKernelEvent):Integer; SysV_ABI_CDecl;
begin
if (ev=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_ADDRESS);
if (ev^.filter<>SCE_KERNEL_EVFILT_VIDEO_OUT) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT);
Result:=(ev^.data shr 12) and $F;
end;
function ps4_sceVideoOutGetEventData(ev:PSceKernelEvent;data:Pint64):Integer;
function ps4_sceVideoOutGetEventData(ev:PSceKernelEvent;data:Pint64):Integer; SysV_ABI_CDecl;
var
ret:int64;
begin
@ -575,7 +585,7 @@ begin
Result:=0;
end;
function ps4_sceVideoOutGetEventId(ev:PSceKernelEvent):Integer;
function ps4_sceVideoOutGetEventId(ev:PSceKernelEvent):Integer; SysV_ABI_CDecl;
begin
if (ev=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_ADDRESS);
if (ev^.filter<>SCE_KERNEL_EVFILT_VIDEO_OUT) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT);
@ -595,9 +605,14 @@ var
node:PKEventNode;
begin
if (eq=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT_QUEUE);
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
_sig_lock;
H.FlipEvents.LockWr;
P:=HAMT_search64(@H.FlipEvents.hamt,QWORD(eq));
if (P<>nil) then
@ -611,6 +626,7 @@ begin
begin
H.FlipEvents.Unlock;
H.Release;
_sig_unlock;
Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT_QUEUE);
end;
node^.ev.ident :=SCE_VIDEO_OUT_EVENT_FLIP;
@ -624,6 +640,7 @@ begin
Result:=0;
H.Release;
_sig_unlock;
end;
function ps4_sceVideoOutAddVblankEvent(eq:SceKernelEqueue;hVideo:Integer;udata:Pointer):Integer; SysV_ABI_CDecl;
@ -633,9 +650,14 @@ var
node:PKEventNode;
begin
if (eq=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT_QUEUE);
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
_sig_lock;
H.VblankEvents.LockWr;
P:=HAMT_search64(@H.VblankEvents.hamt,QWORD(eq));
if (P<>nil) then
@ -649,6 +671,7 @@ begin
begin
H.VblankEvents.Unlock;
H.Release;
_sig_unlock;
Exit(SCE_VIDEO_OUT_ERROR_INVALID_EVENT_QUEUE);
end;
node^.ev.ident :=SCE_VIDEO_OUT_EVENT_VBLANK;
@ -662,6 +685,52 @@ begin
Result:=0;
H.Release;
_sig_unlock;
end;
function __sceVideoOutRegisterBuffers(hVideo:Integer;
index:Integer;
addr:PPointer;
num:Integer;
attr:PSceVideoOutBufferAttribute
):Integer;
var
H:TVideoOut;
buf:TvPointer;
i,s:Integer;
begin
For i:=0 to num-1 do
begin
if not TryGetHostPointerByAddr(addr[i],buf) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_MEMORY);
end;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
spin_lock(H.FBuffers.lock);
s:=index+num-1;
For i:=index to s do
begin
if (H.FBuffers.addr[i]<>nil) then
begin
spin_unlock(H.FBuffers.lock);
H.Release;
Exit(SCE_VIDEO_OUT_ERROR_SLOT_OCCUPIED);
end;
end;
For i:=index to s do
begin
H.FBuffers.addr[i]:=addr[i-index];
H.FBuffers.attr[i]:=attr^;
end;
spin_unlock(H.FBuffers.lock);
H.Release;
Result:=0;
end;
function ps4_sceVideoOutRegisterBuffers(hVideo:Integer;
@ -670,10 +739,6 @@ function ps4_sceVideoOutRegisterBuffers(hVideo:Integer;
num:Integer;
attr:PSceVideoOutBufferAttribute
):Integer; SysV_ABI_CDecl;
var
H:TVideoOut;
buf:TvPointer;
i,s:Integer;
begin
if (addr=nil) or (attr=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_VALUE);
@ -720,39 +785,13 @@ begin
Exit(SCE_VIDEO_OUT_ERROR_INVALID_OPTION);
end;}
For i:=0 to num-1 do
begin
//if not IsAlign(addr[i],16*1024) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_ADDRESS);
if not TryGetHostPointerByAddr(addr[i],buf) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_MEMORY);
end;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
spin_lock(H.FBuffers.lock);
s:=index+num-1;
For i:=index to s do
begin
if (H.FBuffers.addr[i]<>nil) then
begin
spin_unlock(H.FBuffers.lock);
H.Release;
Exit(SCE_VIDEO_OUT_ERROR_SLOT_OCCUPIED);
end;
end;
For i:=index to s do
begin
H.FBuffers.addr[i]:=addr[i-index];
H.FBuffers.attr[i]:=attr^;
end;
spin_unlock(H.FBuffers.lock);
H.Release;
Result:=0;
_sig_lock;
Result:=__sceVideoOutRegisterBuffers(hVideo,
index,
addr,
num,
attr);
_sig_unlock;
end;
function ps4_sceVideoOutColorSettingsSetGamma_(P:PSceVideoOutColorSettings;
@ -776,8 +815,6 @@ end;
function ps4_sceVideoOutAdjustColor_(handle:Integer;
pSettings:PSceVideoOutColorSettings;
sizeOfSettings:DWORD):Integer; SysV_ABI_CDecl;
const
Single1:Single=1;
var
H:TVideoOut;
begin
@ -787,7 +824,10 @@ begin
if (sizeOfSettings>3) then sizeOfSettings:=3;
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(handle));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
Move(pSettings^.gamma,H.Fgamma,sizeOfSettings*SizeOf(Single));
@ -796,7 +836,9 @@ begin
H.FGpuFlip.SetGamma(H.Fgamma);
end;
_sig_lock;
H.Release;
_sig_unlock;
//Writeln('AdjustColor:',handle,' ',HexStr(pSettings),' ',sizeOfSettings);
Result:=0;
@ -837,7 +879,9 @@ begin
case rate of
0..2:
begin
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
H.FlipRate:=rateTable[rate];
H.Release;
@ -853,7 +897,9 @@ function ps4_sceVideoOutGetFlipStatus(hVideo:Integer;status:PSceVideoOutFlipStat
var
H:TVideoOut;
begin
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
status^:=Default(SceVideoOutFlipStatus);
@ -870,6 +916,20 @@ begin
H.Release;
end;
function ps4_sceVideoOutIsFlipPending(hVideo:Integer):Integer; SysV_ABI_CDecl;
var
H:TVideoOut;
begin
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
Result:=H.FflipPendingNum;
H.Release;
end;
function _VideoOutGetBufferAdr(hVideo:Integer;bufferIndex:Integer):Pointer;
var
H:TVideoOut;
@ -931,13 +991,18 @@ var
addr:Pointer;
attr:TSceVideoOutBufferAttribute;
buf:TvPointer;
//buf:TvPointer;
elap:QWORD;
time:DWORD;
begin
bufferIndex:=node^.u.bufferIndex;
flipMode :=node^.u.flipMode ;
flipArg :=node^.u.flipArg ;
_type :=node^.u._type ;
free_node(node);
//node^.wait:=1;
//free_node(node);
//Writeln('sceVideoOutSubmitFlip:',bufferIndex);
@ -947,17 +1012,17 @@ begin
FflipArg :=flipArg;
ps4_usleep(150);
//ps4_usleep(150);
if (bufferIndex=SCE_VIDEO_OUT_BUFFER_INDEX_BLANK) then
begin
ps4_usleep(150);
post_event_vblank(flipArg);
//ps4_usleep(150);
//post_event_vblank(flipArg);
end else
begin
if (FGpuFlip=nil) then
begin
ps4_usleep(150);
//ps4_usleep(150);
end else
begin
spin_lock(FBuffers.lock);
@ -994,8 +1059,8 @@ begin
end;
post_event_vblank(flipArg);
post_event_flip(flipArg);
//post_event_vblank(flipArg);
//post_event_flip(flipArg);
end;
Case _type of
@ -1008,6 +1073,51 @@ begin
end;
end;
//FlipRate:=20;
if (flipMode=SCE_VIDEO_OUT_FLIP_MODE_VSYNC) then
if (FlipRate<>0) then
begin
time:=(1000000 div (FlipRate+5)); //+5 selected empirically
//time:=time-1300;
//time:=time-1300;
elap:=SwTimePassedUnits(Ftsc_flips);
elap:=(elap+9) div 10;
//elap:=elap+(elap div 100)*14;
if (elap<time) then
begin
time:=time-elap;
end else
begin
time:=0;
end;
ps4_usleep(time);
//Sleep(_usec2msec(time));
if (FGpuFlip<>nil) then
begin
//FGpuFlip.IsComplite(FcurrentBuffer);
While (not FGpuFlip.IsComplite(FcurrentBuffer)) do
begin
ps4_usleep(150);
end;
end;
end;
if (bufferIndex=SCE_VIDEO_OUT_BUFFER_INDEX_BLANK) then
begin
post_event_vblank(flipArg);
end else
begin
post_event_vblank(flipArg);
post_event_flip(flipArg);
end;
Fcount_flips:=Fcount_flips+1; //Number of flips completed after opening the port self
FprocessTime:=ps4_sceKernelGetProcessTime; //Process time upon completion of the last flip
Ftsc_flips :=ps4_sceKernelReadTsc; //System timestamp counter value when the last flip completed
@ -1027,6 +1137,9 @@ begin
end;
end;
node^.wait:=1;
free_node(node);
end;
function ps4_sceVideoOutSubmitFlip(hVideo:Integer;bufferIndex,flipMode:Integer;flipArg:Int64):Integer; SysV_ABI_CDecl;
@ -1043,10 +1156,15 @@ begin
Exit(SCE_VIDEO_OUT_ERROR_INVALID_INDEX);
end;
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
_sig_lock;
node:=H.alloc_node;
_sig_unlock;
if (node=nil) then
begin
H.Release;
@ -1058,15 +1176,22 @@ begin
node^.u.flipMode :=flipMode;
node^.u.flipArg :=flipArg;
node^.u._type :=0;
node^.wait :=0;
System.InterlockedIncrement(H.FflipPendingNum);
H.FsubmitTsc:=ps4_sceKernelReadTsc; //Timestamp counter value when the last completed flip is requested
//Writeln('submit_event_flip');
_sig_lock;
Push2VideoOut(node);
wait_until_equal(node^.wait,0);
H.FsubmitTsc:=ps4_sceKernelReadTsc; //Timestamp counter value when the last completed flip is requested
H.Release;
_sig_unlock;
end;
function _qc_sceVideoOutSubmitFlip(Flip:PqcFlipInfo):Integer;
@ -1099,6 +1224,7 @@ begin
node^.u.flipMode :=Flip^.flipMode;
node^.u.flipArg :=Flip^.flipArg;
node^.u._type :=1;
node^.wait :=0;
System.InterlockedIncrement(H.FgcQueueNum);
System.InterlockedIncrement(H.FflipPendingNum);
@ -1108,6 +1234,10 @@ begin
//Writeln('submit_event_flip');
Push2VideoOut(node);
wait_until_equal(node^.wait,0);
H.FsubmitTsc:=ps4_sceKernelReadTsc; //Timestamp counter value when the last completed flip is requested
H.Release;
end;
@ -1118,14 +1248,18 @@ var
begin
Result:=0;
if (index<0) or (index>=SCE_VIDEO_OUT_CURSOR_NUM_MAX) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_INDEX);
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
P.X:=posX; P.Y:=posY;
System.InterlockedExchange64(QWORD(H.FCursors[index].Pos),QWORD(P));
_sig_lock;
H.Release;
_sig_unlock;
end;
function ps4_sceVideoOutCursorEnable(hVideo:Integer;index:Integer;address:Pointer):Integer; SysV_ABI_CDecl;
function __sceVideoOutCursorEnable(hVideo:Integer;index:Integer;address:Pointer):Integer;
var
H:TVideoOut;
buf:TvPointer;
@ -1147,7 +1281,14 @@ begin
H.Release;
end;
function ps4_sceVideoOutCursorSetImageAddress(hVideo:Integer;index:Integer;address:Pointer):Integer; SysV_ABI_CDecl;
function ps4_sceVideoOutCursorEnable(hVideo:Integer;index:Integer;address:Pointer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=__sceVideoOutCursorEnable(hVideo,index,address);
_sig_unlock;
end;
function __sceVideoOutCursorSetImageAddress(hVideo:Integer;index:Integer;address:Pointer):Integer;
var
H:TVideoOut;
buf:TvPointer;
@ -1167,13 +1308,22 @@ begin
H.Release;
end;
function ps4_sceVideoOutCursorSetImageAddress(hVideo:Integer;index:Integer;address:Pointer):Integer; SysV_ABI_CDecl;
begin
_sig_lock;
Result:=__sceVideoOutCursorSetImageAddress(hVideo,index,address);
_sig_unlock;
end;
function ps4_sceVideoOutCursorIsUpdatePending(hVideo:Integer;index:Integer;_type:DWORD):Integer; SysV_ABI_CDecl;
var
H:TVideoOut;
begin
Result:=0;
if (index<0) or (index>=SCE_VIDEO_OUT_CURSOR_NUM_MAX) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_INDEX);
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
Case _type of
@ -1183,14 +1333,18 @@ begin
Result:=SCE_VIDEO_OUT_ERROR_INVALID_VALUE;
end;
_sig_lock;
H.Release;
_sig_unlock;
end;
function ps4_sceVideoOutGetVblankStatus(hVideo:Integer;status:PSceVideoOutVblankStatus):Integer; SysV_ABI_CDecl;
var
H:TVideoOut;
begin
_sig_lock;
H:=TVideoOut(FVideoOutMap.Acqure(hVideo));
_sig_unlock;
if (H=nil) then Exit(SCE_VIDEO_OUT_ERROR_INVALID_HANDLE);
status^:=Default(SceVideoOutVblankStatus);
@ -1200,7 +1354,9 @@ begin
status^.flags :=0;
Result:=0;
_sig_lock;
H.Release;
_sig_unlock;
end;
function ps4_sceVideoOutSetWindowModeMargins(hVideo:Integer;top,bottom:Integer):Integer; SysV_ABI_CDecl;
@ -1230,6 +1386,7 @@ begin
lib^.set_proc($EA43E78F9D53EB66,@ps4_sceVideoOutGetResolutionStatus);
lib^.set_proc($0818AEE26084D430,@ps4_sceVideoOutSetFlipRate);
lib^.set_proc($49B537770A7CD254,@ps4_sceVideoOutGetFlipStatus);
lib^.set_proc($CE05E27C74FD12B6,@ps4_sceVideoOutIsFlipPending);
lib^.set_proc($538E8DC0E889A72B,@ps4_sceVideoOutSubmitFlip);
lib^.set_proc($375EC02BCF0D743D,@ps4_sceVideoOutCursorSetPosition);
lib^.set_proc($50F656087F2A4CCE,@ps4_sceVideoOutCursorEnable);

245
ps4_program.pas
View File

@ -6,10 +6,12 @@ interface
uses
Windows,
Classes, SysUtils,
Classes,
SysUtils,
RWLock,
hamt,
ps4_types,
sys_types,
sys_kernel,
ps4_handles;
type
@ -25,7 +27,10 @@ type
T_set_proc_cb=function(lib:PLIBRARY;nid:QWORD;value:Pointer):Boolean;
T_get_proc_cb=function(lib:PLIBRARY;nid:QWORD):Pointer;
TElf_node=class;
TLIBRARY=packed object
parent:TElf_node;
MapSymbol:THAMT;
attr:DWORD;
Import:Boolean;
@ -46,6 +51,7 @@ type
FPrepared:Boolean;
FLoadImport:Boolean;
FInitProt:Boolean;
FInitThread:Boolean;
FInitCode:Boolean;
aNeed:array of RawByteString;
aMods:array of TMODULE;
@ -61,6 +67,7 @@ type
public
pFileName:RawByteString;
property Handle:Integer read FHandle;
property Next:TElf_node read pNext;
function _add_lib(const strName:RawByteString):PLIBRARY;
function ModuleNameFromId(id:WORD):RawByteString;
function LibraryNameFromId(id:WORD):RawByteString;
@ -68,12 +75,17 @@ type
Procedure Clean; virtual;
function Prepare:Boolean; virtual;
Procedure LoadSymbolImport(cbs,data:Pointer); virtual;
Procedure InitThread; virtual;
Procedure ReLoadSymbolImport(cbs,data:Pointer); virtual;
Procedure InitThread(is_static:QWORD); virtual;
Procedure FreeThread; virtual;
Procedure InitProt; virtual;
Procedure InitCode; virtual;
function module_start(argc:size_t;argp:PPointer):Integer; virtual;
function GetCodeFrame:TMemChunk; virtual;
function GetEntryPoint:Pointer; virtual;
Function GetModuleInfo:TKernelModuleInfo; virtual;
Function get_proc(nid:QWORD):Pointer;
Function get_proc_by_name(const name:RawByteString):Pointer;
end;
TOnElfLoadCb=function(Const name:RawByteString):TElf_node;
@ -105,6 +117,8 @@ type
Tps4_program=object
public
resolve_cb:Pointer;
reload_cb:Pointer;
prog:TElf_node;
app_file:RawByteString;
app_path:RawByteString;
@ -120,7 +134,10 @@ type
Procedure RegistredFile(node:TElf_node);
Procedure RegistredMod(node:TElf_node;const strName:RawByteString);
public
function GetFile(const strName:RawByteString):TElf_node;
Procedure LockRd;
Procedure Unlock;
function FirstFile:TElf_node;
function AcqureFileByName(const strName:RawByteString):TElf_node;
procedure PopupFile(node:TElf_node);
Procedure SetLib(lib:PLIBRARY);
function GetLib(const strName:RawByteString):PLIBRARY;
@ -129,12 +146,14 @@ type
Procedure RegistredFinLoad(const strName:RawByteString;cb:TOnElfLoadCb);
function Loader(Const name:RawByteString):TElf_node;
Procedure ResolveDepended(node:TElf_node);
Procedure LoadSymbolImport(cbs,data:Pointer);
Procedure LoadSymbolImport(data:Pointer);
Procedure ReLoadSymbolImport(data:Pointer);
Procedure InitProt;
Procedure InitCode;
Procedure InitThread;
Procedure InitThread(is_static:QWORD);
Procedure FreeThread;
function FindFileByCodeAdr(Adr:Pointer):TElf_node;
function AcqureFileByCodeAdr(Adr:Pointer):TElf_node;
function AcqureFileByHandle(handle:Integer):TElf_node;
end;
var
@ -147,10 +166,7 @@ Function UnMountPath(path:PChar):Integer;
function _parse_filename(filename:PChar):RawByteString;
Function safe_move(const src;var dst;count:QWORD):QWORD;
procedure safe_move_ptr(const src;var dst);
function safe_str(P:PChar):shortstring;
function GetProcParam:Pointer;
Function get_dev_progname:RawByteString;
implementation
@ -184,7 +200,7 @@ Var
Procedure _c; inline;
begin
Case (i-CF) of
2:if (PWORD(@Path[CF])^=$2E2E) then
2:if (PWORD(@Path[CF])^=$2E2E) then //..
begin
i:=i-PF+1;
L:=L-i;
@ -192,12 +208,12 @@ Var
CF:=PF;
i:=PF-1;
end;
1:if (Path[CF]='.') then
1:if (Path[CF]='.') then //.
begin
L:=L-1;
Delete(Path,CF,1);
CF:=PF;
i:=PF-1;
Delete(Path,1,CF);
L:=Length(Path);
CF:=1;
i:=1;
end;
end;
PF:=CF;
@ -410,6 +426,7 @@ var
pp,fp:PChar;
begin
Result:='';
//Writeln(filename);
if (filename=nil) then Exit;
Path:=filename;
DoFixRelative(Path);
@ -692,6 +709,7 @@ begin
plib:=aLibs[id];
if (plib=nil) then plib:=AllocMem(SizeOf(TLIBRARY));
plib^:=lib;
plib^.parent:=Self;
aLibs[id]:=plib;
end;
@ -709,6 +727,7 @@ begin
plib:=aLibs[u.id];
if (plib=nil) then plib:=AllocMem(SizeOf(TLIBRARY));
plib^.attr:=u.name_offset;
plib^.parent:=Self;
aLibs[u.id]:=plib;
end;
@ -728,6 +747,7 @@ begin
i:=Length(aLibs);
SetLength(aLibs,i+1);
Result:=AllocMem(SizeOf(TLIBRARY));
Result^.parent:=Self;
Result^.strName:=strName;
aLibs[i]:=Result;
end;
@ -768,9 +788,12 @@ begin
For i:=0 to Length(aLibs)-1 do
begin
lib:=aLibs[i];
HAMT_destroy64(lib^.MapSymbol,@_free_map_cb,nil);
lib^.strName:='';
FreeMem(lib);
if (lib<>nil) then
begin
HAMT_destroy64(lib^.MapSymbol,@_free_map_cb,nil);
lib^.strName:='';
FreeMem(lib);
end;
end;
end;
pFileName:='';
@ -796,7 +819,12 @@ begin
FLoadImport:=True;
end;
Procedure TElf_node.InitThread;
Procedure TElf_node.ReLoadSymbolImport(cbs,data:Pointer);
begin
end;
Procedure TElf_node.InitThread(is_static:QWORD);
begin
end;
@ -816,6 +844,11 @@ begin
FInitCode:=True;
end;
function TElf_node.module_start(argc:size_t;argp:PPointer):Integer;
begin
Result:=0;
end;
function TElf_node.GetCodeFrame:TMemChunk;
begin
Result:=Default(TMemChunk);
@ -826,22 +859,68 @@ begin
Result:=nil;
end;
Function TElf_node.GetModuleInfo:TKernelModuleInfo;
begin
Result:=Default(TKernelModuleInfo);
Result.size:=SizeOf(TKernelModuleInfo);
MoveChar0(PChar(pFileName)^,Result.name,SCE_DBG_MAX_NAME_LENGTH);
//segmentInfo:array[0..SCE_DBG_MAX_SEGMENTS-1] of TKernelModuleSegmentInfo;
//segmentCount:DWORD;
//fingerprint:array[0..SCE_DBG_NUM_FINGERPRINT-1] of Byte;
end;
Function TElf_node.get_proc(nid:QWORD):Pointer;
var
i:Integer;
begin
Result:=nil;
if Length(aLibs)<>0 then
begin
For i:=0 to Length(aLibs)-1 do
if (aLibs[i]<>nil) then
if (not aLibs[i]^.Import) then
begin
Result:=aLibs[i]^.get_proc(nid);
if (Result<>nil) then Exit;
end;
end;
end;
Function TElf_node.get_proc_by_name(const name:RawByteString):Pointer;
begin
Result:=get_proc(ps4_nid_hash(name));
end;
function TLIBRARY._set_proc(nid:QWORD;value:Pointer):Boolean;
var
data:PPointer;
PP:PPointer;
begin
if (MapSymbol=nil) then MapSymbol:=HAMT_create64;
data:=GetMem(SizeOf(Pointer)*2);
data[0]:=value;
data[1]:=Pointer(nid);
PP:=HAMT_insert64(MapSymbol,nid,data);
Assert(PP<>nil);
Result:=(PP^=data);
if not Result then
data:=nil;
PP:=HAMT_search64(MapSymbol,nid);
if (PP<>nil) then data:=PP^;
if (data=nil) then
begin
FreeMem(data);
data:=GetMem(SizeOf(Pointer)*2);
data[0]:=value;
data[1]:=Pointer(nid);
PP:=HAMT_insert64(MapSymbol,nid,data);
Assert(PP<>nil);
Result:=(PP^=data);
if not Result then
begin
FreeMem(data);
end;
end else
begin
data[0]:=value;
end;
end;
function TLIBRARY._get_proc(nid:QWORD):Pointer;
@ -889,16 +968,36 @@ begin
files.Unlock;
end;
function Tps4_program.GetFile(const strName:RawByteString):TElf_node;
Procedure Tps4_program.LockRd;
begin
files.LockRd;
end;
Procedure Tps4_program.Unlock;
begin
files.Unlock;
end;
function Tps4_program.FirstFile:TElf_node;
begin
Result:=files.pHead;
end;
function Tps4_program.AcqureFileByName(const strName:RawByteString):TElf_node;
var
nid:QWORD;
PP:PPointer;
begin
Result:=nil;
nid:=ps4_nid_hash(strName);
files.LockRd;
PP:=HAMT_search64(@files.hamt,nid);
if (PP<>nil) then Result:=TElf_node(PP^);
if (Result<>nil) then Result.Acqure;
files.Unlock;
end;
@ -1117,15 +1216,34 @@ begin
end;
Result:=LoadPs4ElfFromFile(IncludeTrailingPathDelimiter(app_path)+'sce_module'+DirectorySeparator+name);
if (Result<>nil) then //is default load app_path
if (Result<>nil) then //is default load app_path\sce_module
begin
Result.Prepare;
ps4_app.RegistredElf(Result);
Exit;
end;
//
//Result:=LoadPs4ElfFromFile(IncludeTrailingPathDelimiter(app_path)+'Media'+DirectorySeparator+'Modules'+DirectorySeparator+name);
//if (Result<>nil) then //is app_path\Media\Modules
//begin
// Result.Prepare;
// ps4_app.RegistredElf(Result);
// Exit;
//end;
//
//Result:=LoadPs4ElfFromFile(IncludeTrailingPathDelimiter(app_path)+'Media'+DirectorySeparator+'Plugins'+DirectorySeparator+name);
//if (Result<>nil) then //is app_path\Media\Plugins
//begin
// Result.Prepare;
// ps4_app.RegistredElf(Result);
// Exit;
//end;
//
Result:=LoadPs4ElfFromFile(IncludeTrailingPathDelimiter(GetCurrentDir)+'sce_module'+DirectorySeparator+name);
if (Result<>nil) then //is default load current dir
if (Result<>nil) then //is default load current_dir\sce_module
begin
Result.Prepare;
ps4_app.RegistredElf(Result);
@ -1180,7 +1298,7 @@ begin
end;
end;
Procedure Tps4_program.LoadSymbolImport(cbs,data:Pointer);
Procedure Tps4_program.LoadSymbolImport(data:Pointer);
var
Node:TElf_node;
begin
@ -1188,7 +1306,21 @@ begin
Node:=files.pHead;
While (Node<>nil) do
begin
Node.LoadSymbolImport(cbs,data);
Node.LoadSymbolImport(resolve_cb,data);
Node:=Node.pNext;
end;
files.Unlock;
end;
Procedure Tps4_program.ReLoadSymbolImport(data:Pointer);
var
Node:TElf_node;
begin
files.LockRd;
Node:=files.pHead;
While (Node<>nil) do
begin
Node.ReLoadSymbolImport(reload_cb,data);
Node:=Node.pNext;
end;
files.Unlock;
@ -1214,16 +1346,18 @@ var
begin
Assert(ps4_app.prog<>nil);
files.LockRd;
Node:=files.pHead;
While (Node<>nil) do
begin
Node.InitCode;
Node:=Node.pNext;
end;
files.Unlock;
end;
Procedure Tps4_program.InitThread;
Procedure Tps4_program.InitThread(is_static:QWORD);
var
Node:TElf_node;
begin
@ -1231,7 +1365,7 @@ begin
Node:=files.pHead;
While (Node<>nil) do
begin
Node.InitThread;
Node.InitThread(is_static);
Node:=Node.pNext;
end;
files.Unlock;
@ -1252,7 +1386,7 @@ begin
_free_tls_tcb_all;
end;
function Tps4_program.FindFileByCodeAdr(Adr:Pointer):TElf_node;
function Tps4_program.AcqureFileByCodeAdr(Adr:Pointer):TElf_node;
var
tmp:TElfNodeList;
Node:TElf_node;
@ -1262,6 +1396,7 @@ begin
tmp:=Default(TElfNodeList);
if safe_move(files,tmp,SizeOf(TElfNodeList))<>SizeOf(TElfNodeList) then Exit;
files.LockRd;
Node:=tmp.pHead;
While (Node<>nil) do
begin
@ -1271,15 +1406,23 @@ begin
if (Adr>=Mem.pAddr) and (Adr<(Mem.pAddr+Mem.nSize)) then
begin
Result:=Node;
Result.Acqure;
files.Unlock;
Exit;
end;
end;
safe_move_ptr(Node.pNext,Node);
end;
files.Unlock;
end;
function Tps4_program.AcqureFileByHandle(handle:Integer):TElf_node;
begin
Result:=TElf_node(elfs.Acqure(handle));
end;
Procedure Thamt64locked.Init;
begin
FillChar(Self,SizeOf(Self),0);
@ -1301,29 +1444,15 @@ begin
rwlock_unlock(lock);
end;
Function safe_move(const src;var dst;count:QWORD):QWORD;
begin
if not ReadProcessMemory(GetCurrentProcess,@src,@dst,count,Result) then Result:=0;
end;
procedure safe_move_ptr(const src;var dst);
begin
if safe_move(src,dst,SizeOf(Pointer))<>SizeOf(Pointer) then Pointer(dst):=nil;
end;
function safe_str(P:PChar):shortstring;
function GetProcParam:Pointer;
var
ch:Char;
elf:Telf_file;
begin
Result:='';
repeat
ch:=#0;
safe_move(P^,ch,SizeOf(Char));
if (ch=#0) then Exit;
Result:=Result+ch;
if (Result[0]=#255) then Exit;
Inc(P);
until false;
Result:=nil;
elf:=Telf_file(ps4_program.ps4_app.prog);
if (elf=nil) then Exit;
if (elf.pProcParam=0) then Exit;
Result:=elf.mMap.pAddr+elf.pProcParam;
end;
Function get_dev_progname:RawByteString;

5170
ps4libdoc.pas
View File

File diff suppressed because it is too large Load Diff

461
rtl/LFQueue.pas Normal file
View File

@ -0,0 +1,461 @@
{ Implimentation of Dmitry Vyukov Intrusive MPSC node-based queue on free pascal
Copyright (C) 2018-2020 Red_prig
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
}
unit LFQueue;
{$mode objfpc}{$H+}
interface
Const
CacheLineSize=64;
Type
TIntrusiveMPSCQueue=object
protected
type
PQNode=^TQNode;
TQNode=record
next_:PQNode;
//some data
end;
Var
tail_:PQNode;
stub_:TQNode;
head_:PQNode;
public
Procedure Create;
Function Push(Node:Pointer):Boolean;
Function Pop(Var Node:Pointer):Boolean;
Function IsEmpty:Boolean; inline;
end;
TIntrusiveMPSCQueueA=object
protected
type
PQNode=^TQNode;
TQNode=record
next_:PQNode;
//some data
end;
Var
tail_:record
Case Byte of
0:(Pad:Array[0..CacheLineSize-1] of Byte);
1:(VAL:PQNode;stub:TQNode);
end;
head_:record
Case Byte of
0:(Pad:Array[0..CacheLineSize-1] of Byte);
1:(VAL:PQNode);
end;
public
Procedure Create;
Function Push(Node:Pointer):Boolean;
Function Pop(Var Node:Pointer):Boolean;
Function IsEmpty:Boolean; inline;
end;
generic TLFQueue<TItem,Allocator,back_off>=object(TIntrusiveMPSCQueue)
type
PNode=^TNode;
TNode=record
next_:PNode;
Item:TItem;
end;
Function push_front(Const val:TItem):Boolean;
Function pop_back(Var val:TItem):Boolean;
end;
generic TLFQueueA<TItem,Allocator,back_off>=object(TIntrusiveMPSCQueueA)
type
PNode=^TNode;
TNode=record
next_:PNode;
Item:TItem;
end;
Function push_front(Const val:TItem):Boolean;
Function pop_back(Var val:TItem):Boolean;
end;
function load_consume(Var addr:Pointer):Pointer; inline;
function load_consume(Var addr:PtrUInt):PtrUInt; inline;
Procedure store_release(Var addr:Pointer;v:Pointer); inline;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
implementation
function load_consume(Var addr:Pointer):Pointer; inline;
begin
ReadDependencyBarrier;
Result:=addr;
end;
function load_consume(Var addr:PtrUInt):PtrUInt; inline;
begin
ReadDependencyBarrier;
Result:=addr;
end;
Procedure store_release(Var addr:Pointer;v:Pointer); inline;
begin
WriteBarrier;
addr:=v;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
//
Procedure TIntrusiveMPSCQueue.Create;
begin
FillChar(Self,SizeOf(Self),0);
head_:=@stub_;
tail_:=@stub_;
ReadWriteBarrier;
end;
Function TIntrusiveMPSCQueue.Push(Node:Pointer):Boolean;
Var
prev:PQNode;
begin
if not Assigned(Node) then Exit(False);
store_release(PQNode(Node)^.next_,nil);
prev:=XCHG(head_,Node);
store_release(prev^.next_,Node);
Result:=True;
end;
Function TIntrusiveMPSCQueue.Pop(Var Node:Pointer):Boolean;
Var
tail,n,head:PQNode;
begin
Node:=nil;
Result:=False;
tail:=tail_;
n:=load_consume(tail^.next_);
if tail=@stub_ then
begin
if n=nil then Exit;
store_release(tail_,n);
tail:=n;
n:=load_consume(n^.next_);
end;
if n<>nil then
begin
store_release(tail_,n);
Node:=tail;
store_release(tail^.next_,nil);
Exit(True);
end;
head:=head_;
if tail<>head then Exit;
stub_.next_:=nil;
n:=XCHG(head_,@stub_);
store_release(n^.next_,@stub_);
n:=load_consume(tail^.next_);
if n<>nil then
begin
store_release(tail_,n);
Node:=tail;
store_release(tail^.next_,nil);
Exit(True);
end;
end;
Function TIntrusiveMPSCQueue.IsEmpty:Boolean; inline;
begin
Result:=head_=@stub_;
end;
//
Procedure TIntrusiveMPSCQueueA.Create;
begin
FillChar(Self,SizeOf(Self),0);
head_.VAL:=@tail_.stub;
tail_.VAL:=@tail_.stub;
ReadWriteBarrier;
end;
Function TIntrusiveMPSCQueueA.Push(Node:Pointer):Boolean;
Var
prev:PQNode;
begin
if not Assigned(Node) then Exit(False);
store_release(PQNode(Node)^.next_,nil);
prev:=XCHG(head_.VAL,Node);
store_release(prev^.next_,Node);
Result:=True;
end;
Function TIntrusiveMPSCQueueA.Pop(Var Node:Pointer):Boolean;
Var
tail,n,head:PQNode;
begin
Node:=nil;
Result:=False;
tail:=tail_.VAL;
n:=load_consume(tail^.next_);
if tail=@tail_.stub then
begin
if n=nil then Exit;
store_release(tail_.VAL,n);
tail:=n;
n:=load_consume(n^.next_);
end;
if n<>nil then
begin
store_release(tail_.VAL,n);
Node:=tail;
store_release(tail^.next_,nil);
Exit(True);
end;
head:=head_.VAL;
if tail<>head then Exit;
tail_.stub.next_:=nil;
n:=XCHG(head_.VAL,@tail_.stub);
store_release(n^.next_,@tail_.stub);
n:=load_consume(tail^.next_);
if n<>nil then
begin
store_release(tail_.VAL,n);
Node:=tail;
store_release(tail^.next_,nil);
Exit(True);
end;
end;
Function TIntrusiveMPSCQueueA.IsEmpty:Boolean; inline;
begin
Result:=head_.VAL=@tail_.stub;
end;
//
Function TLFQueue.push_front(Const val:TItem):Boolean;
Var
Node:PNode;
begin
Node:=Allocator.AllocMem(SizeOf(TNode));
Result:=Push(Node);
end;
Function TLFQueue.pop_back(Var val:TItem):Boolean;
Var
tail,n,head:PQNode;
bkoff:back_off;
begin
Result:=False;
bkoff.Reset;
repeat
tail:=XCHG(tail_,nil);
if (tail<>nil) then
begin
Break;
end else
begin
bkoff.Wait;
end;
until false;
n:=load_consume(tail^.next_);
if tail=@stub_ then
begin
if n=nil then
begin
if tail=nil then tail:=@stub_;
store_release(tail_,tail); //unlock
Exit;
end;
tail:=n;
n:=load_consume(n^.next_);
end;
if n<>nil then
begin
val:=PNode(tail)^.Item;
FreeMem(tail);
if n=nil then n:=@stub_;
store_release(tail_,n); //unlock
Exit(True);
end;
head:=head_;
if tail<>head then
begin
if tail=nil then tail:=@stub_;
store_release(tail_,tail); //unlock
Exit;
end;
stub_.next_:=nil;
n:=XCHG(head_,@stub_);
store_release(n^.next_,@stub_);
n:=load_consume(tail^.next_);
if n<>nil then
begin
val:=PNode(tail)^.Item;
FreeMem(tail);
if n=nil then n:=@stub_;
store_release(tail_,n); //unlock
Exit(True);
end;
if tail=nil then tail:=@stub_;
store_release(tail_,tail); //unlock
end;
//
Function TLFQueueA.push_front(Const val:TItem):Boolean;
Var
Node:PNode;
begin
Node:=Allocator.AllocMem(SizeOf(TNode));
Result:=Push(Node);
end;
Function TLFQueueA.pop_back(Var val:TItem):Boolean;
Var
tail,n,head:PQNode;
bkoff:back_off;
begin
Result:=False;
bkoff.Reset;
repeat
tail:=XCHG(tail_.VAL,nil);
if (tail<>nil) then
begin
Break;
end else
begin
bkoff.Wait;
end;
until false;
n:=load_consume(tail^.next_);
if tail=@tail_.stub then
begin
if n=nil then
begin
if tail=nil then tail:=@tail_.stub;
store_release(tail_.VAL,tail); //unlock
Exit;
end;
tail:=n;
n:=load_consume(n^.next_);
end;
if n<>nil then
begin
val:=PNode(tail)^.Item;
FreeMem(tail);
if n=nil then n:=@tail_.stub;
store_release(tail_.VAL,n); //unlock
Exit(True);
end;
head:=head_.VAL;
if tail<>head then
begin
if tail=nil then tail:=@tail_.stub;
store_release(tail_.VAL,tail); //unlock
Exit;
end;
tail_.stub.next_:=nil;
n:=XCHG(head_.VAL,@tail_.stub);
store_release(n^.next_,@tail_.stub);
n:=load_consume(tail^.next_);
if n<>nil then
begin
val:=PNode(tail)^.Item;
FreeMem(tail);
if n=nil then n:=@tail_.stub;
store_release(tail_.VAL,n); //unlock
Exit(True);
end;
if tail=nil then tail:=@tail_.stub;
store_release(tail_.VAL,tail); //unlock
end;
end.

0
RWLock.pas → rtl/RWLock.pas
View File

553
rtl/atomic.pas Normal file
View File

@ -0,0 +1,553 @@
{ atomic utils
Copyright (C) 2018-2022 Red_prig
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
}
unit atomic;
{$mode objfpc}{$H+}
interface
Const
CacheLineSize=64;
function load_consume(Var addr:Pointer):Pointer; inline;
function load_consume(Var addr:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function load_consume(Var addr:DWORD):DWORD; inline;
{$ENDIF}
function load_acquire(Var addr:Pointer):Pointer; inline;
function load_acquire(Var addr:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function load_acquire(Var addr:DWORD):DWORD; inline;
{$ENDIF}
function load_acq_rel(Var addr:Pointer):Pointer; inline;
function load_acq_rel(Var addr:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function load_acq_rel(Var addr:DWORD):DWORD; inline;
function load_acq_rel(Var addr:Integer):Integer; inline;
{$ENDIF}
Procedure store_release(Var addr:Pointer;v:Pointer); inline;
Procedure store_release(Var addr:SizeUInt;v:SizeUInt); inline;
{$IF defined(CPUX86_64)}
Procedure store_release(Var addr:DWORD;v:DWORD); inline;
Procedure store_release(Var addr:Integer;v:Integer); inline;
{$ENDIF}
Procedure store_seq_cst(Var addr:Pointer;v:Pointer); inline;
Procedure store_seq_cst(Var addr:SizeUInt;v:SizeUInt); inline;
{$IF defined(CPUX86_64)}
Procedure store_seq_cst(Var addr:DWORD;v:DWORD); inline;
Procedure store_seq_cst(Var addr:Integer;v:Integer); inline;
{$ENDIF}
function _CAS(Var addr:Pointer;Comp,New:Pointer):Pointer; inline;
function _CAS(Var addr:SizeUInt;Comp,New:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function _CAS(Var addr:DWORD;Comp,New:DWORD):DWORD; inline;
{$ENDIF}
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
function CAS(Var addr:SizeUInt;Comp,New:SizeUInt):Boolean; inline;
{$IF defined(CPUX86_64)}
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
function CAS(Var addr:Integer;Comp,New:Integer):Boolean; inline;
{$ENDIF}
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
function XCHG(Var addr:SizeUInt;New:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function XCHG(Var addr:DWORD;New:DWORD):DWORD; inline;
function XCHG(Var addr:Integer;New:Integer):Integer; inline;
{$ENDIF}
function fetch_add(Var addr:SizeUInt;i:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function fetch_add(Var addr:DWORD;i:DWORD):DWORD; inline;
function fetch_add(Var addr:Integer;i:Integer):Integer; inline;
{$ENDIF}
function fetch_sub(Var addr:SizeUInt;i:SizeUInt):SizeUInt; inline;
{$IF defined(CPUX86_64)}
function fetch_sub(Var addr:DWORD;i:DWORD):DWORD; inline;
function fetch_sub(Var addr:Integer;i:Integer):Integer; inline;
{$ENDIF}
function fetch_xor(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
{$IFDEF CPUX86_64}
function fetch_xor(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default;
{$ENDIF}
function fetch_or(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
{$IFDEF CPUX86_64}
function fetch_or(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default;
{$ENDIF}
function fetch_and(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
{$IFDEF CPUX86_64}
function fetch_and(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default;
{$ENDIF}
function test_and_set(var Target:SizeUInt;bit:byte):Boolean; ms_abi_default;
{$IFDEF CPUX86_64}
function test_and_set(var Target:DWORD;bit:byte):Boolean; ms_abi_default;
{$ENDIF}
function test_and_reset(var Target:qword;bit:byte):Boolean; ms_abi_default;
{$IFDEF CPUX86_64}
function test_and_reset(var Target:DWORD;bit:byte):Boolean; ms_abi_default;
{$ENDIF}
function marked_ptr(P:Pointer;B:SizeUInt=0):Pointer; inline;
function ptr1(P:Pointer):Pointer; inline;
function bits1(P:Pointer):SizeUInt; inline;
function bits1(P:SizeUInt):SizeUInt; inline;
procedure spin_pause;
implementation
function load_consume(Var addr:Pointer):Pointer; inline;
begin
ReadDependencyBarrier;
Result:=addr;
end;
function load_consume(Var addr:SizeUInt):SizeUInt; inline;
begin
ReadDependencyBarrier;
Result:=addr;
end;
{$IF defined(CPUX86_64)}
function load_consume(Var addr:DWORD):DWORD; inline;
begin
ReadDependencyBarrier;
Result:=addr;
end;
{$ENDIF}
function load_acquire(Var addr:Pointer):Pointer; inline;
begin
ReadBarrier;
Result:=addr;
end;
function load_acquire(Var addr:SizeUInt):SizeUInt; inline;
begin
ReadBarrier;
Result:=addr;
end;
{$IF defined(CPUX86_64)}
function load_acquire(Var addr:DWORD):DWORD; inline;
begin
ReadBarrier;
Result:=addr;
end;
{$ENDIF}
function load_acq_rel(Var addr:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchangeAdd(Pointer(addr),nil);
end;
function load_acq_rel(Var addr:SizeUInt):SizeUInt; //inline;
begin
Result:=SizeUInt(load_acq_rel(Pointer(addr)));
end;
{$IF defined(CPUX86_64)}
function load_acq_rel(Var addr:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchangeAdd(addr,0);
end;
function load_acq_rel(Var addr:Integer):Integer; inline;
begin
Result:=System.InterLockedExchangeAdd(addr,0);
end;
{$ENDIF}
Procedure store_release(Var addr:Pointer;v:Pointer); inline;
begin
WriteBarrier;
addr:=v;
end;
Procedure store_release(Var addr:SizeUInt;v:SizeUInt); inline;
begin
WriteBarrier;
addr:=v;
end;
{$IF defined(CPUX86_64)}
Procedure store_release(Var addr:DWORD;v:DWORD); inline;
begin
WriteBarrier;
addr:=v;
end;
Procedure store_release(Var addr:Integer;v:Integer); inline;
begin
WriteBarrier;
addr:=v;
end;
{$ENDIF}
Procedure store_seq_cst(Var addr:Pointer;v:Pointer); inline;
begin
System.InterLockedExchange(addr,v);
end;
Procedure store_seq_cst(Var addr:SizeUInt;v:SizeUInt); inline;
begin
store_seq_cst(Pointer(addr),Pointer(v));
end;
{$IF defined(CPUX86_64)}
Procedure store_seq_cst(Var addr:DWORD;v:DWORD); inline;
begin
System.InterLockedExchange(addr,v);
end;
Procedure store_seq_cst(Var addr:Integer;v:Integer); inline;
begin
System.InterLockedExchange(addr,v);
end;
{$ENDIF}
function _CAS(Var addr:Pointer;Comp,New:Pointer):Pointer; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp);
end;
function _CAS(Var addr:SizeUInt;Comp,New:SizeUInt):SizeUInt; inline;
begin
Result:=SizeUInt(system.InterlockedCompareExchange(Pointer(addr),Pointer(New),Pointer(Comp)));
end;
{$IF defined(CPUX86_64)}
function _CAS(Var addr:DWORD;Comp,New:DWORD):DWORD; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp);
end;
function _CAS(Var addr:Integer;Comp,New:Integer):Integer; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp);
end;
{$ENDIF}
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:SizeUInt;Comp,New:SizeUInt):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(Pointer(addr),Pointer(New),Pointer(Comp))=Pointer(Comp);
end;
{$IF defined(CPUX86_64)}
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:Integer;Comp,New:Integer):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
{$ENDIF}
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function XCHG(Var addr:SizeUInt;New:SizeUInt):SizeUInt; inline;
begin
Result:=SizeUInt(System.InterLockedExchange(Pointer(addr),Pointer(New)));
end;
{$IF defined(CPUX86_64)}
function XCHG(Var addr:DWORD;New:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function XCHG(Var addr:Integer;New:Integer):Integer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
{$ENDIF}
function fetch_add(Var addr:SizeUInt;i:SizeUInt):SizeUInt; inline;
begin
Result:=SizeUInt(System.InterLockedExchangeAdd(Pointer(addr),Pointer(i)));
end;
{$IF defined(CPUX86_64)}
function fetch_add(Var addr:DWORD;i:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchangeAdd(addr,i);
end;
function fetch_add(Var addr:Integer;i:Integer):Integer; inline;
begin
Result:=System.InterLockedExchangeAdd(addr,i);
end;
{$ENDIF}
function fetch_sub(Var addr:SizeUInt;i:SizeUInt):SizeUInt; inline;
begin
Result:=fetch_add(addr,SizeUInt(-SizeInt(i)));
end;
{$IF defined(CPUX86_64)}
function fetch_sub(Var addr:DWORD;i:DWORD):DWORD; inline;
begin
Result:=fetch_add(addr,DWORD(-Integer(i)));
end;
function fetch_sub(Var addr:Integer;i:Integer):Integer; inline;
begin
Result:=fetch_add(addr,-i);
end;
{$ENDIF}
//xor
{$IFDEF CPU386}
function fetch_xor(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock xor %edx,(%ecx)
setz %al
end;
{$ELSE}
{$IFDEF CPUX86_64}
function fetch_xor(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock xor %rdx,(%rcx)
setz %al
end;
function fetch_xor(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock xor %edx,(%rcx)
setz %al
end;
{$ELSE}
function fetch_xor(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
Var
P,N:SizeUInt;
begin
repeat
P:=load_consume(Target);
N:=P xor mask;
until CAS(Target,P,N);
Result:=(N=0);
end;
{$ENDIF}
{$ENDIF}
//or
{$IFDEF CPU386}
function fetch_or(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock or %edx,(%ecx)
setz %al
end;
{$ELSE}
{$IFDEF CPUX86_64}
function fetch_or(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock or %rdx,(%rcx)
setz %al
end;
function fetch_or(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock or %edx,(%rcx)
setz %al
end;
{$ELSE}
function fetch_or(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
Var
P,N:SizeUInt;
begin
repeat
P:=load_consume(Target);
N:=P or mask;
until CAS(Target,P,N);
Result:=(N=0);
end;
{$ENDIF}
{$ENDIF}
//and
{$IFDEF CPU386}
function fetch_and(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock and %edx,(%ecx)
setz %al
end;
{$ELSE}
{$IFDEF CPUX86_64}
function fetch_and(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock and %rdx,(%rcx)
setz %al
end;
function fetch_and(var Target:DWORD;mask:DWORD):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock and %edx,(%rcx)
setz %al
end;
{$ELSE}
function fetch_and(var Target:SizeUInt;mask:SizeUInt):Boolean; ms_abi_default;
Var
P,N:SizeUInt;
begin
repeat
P:=load_consume(Target);
N:=P and mask;
until CAS(Target,P,N);
Result:=(N=0);
end;
{$ENDIF}
{$ENDIF}
//bts
{$IFDEF CPU386}
function test_and_set(var Target:SizeUInt;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock bts %edx,(%ecx)
setc %al
end;
{$ELSE}
{$IFDEF CPUX86_64}
function test_and_set(var Target:SizeUInt;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock bts %rdx,(%rcx)
setc %al
end;
function test_and_set(var Target:DWORD;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock bts %edx,(%rcx)
setc %al
end;
{$ELSE}
function test_and_set(var Target:SizeUInt;bit:byte):Boolean; ms_abi_default;
Var
P,N,M:SizeUInt;
begin
M:=1 shl bit;
repeat
P:=load_consume(Target);
N:=P or M;
until CAS(Target,P,N);
Result:=(P and M)<>0;
end;
{$ENDIF}
{$ENDIF}
//btr
{$IFDEF CPU386}
function test_and_reset(var Target:qword;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock btr %edx,(%ecx)
setc %al
end;
{$ELSE}
{$IFDEF CPUX86_64}
function test_and_reset(var Target:qword;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock btr %rdx,(%rcx)
setc %al
end;
function test_and_reset(var Target:DWORD;bit:byte):Boolean; ms_abi_default; assembler; nostackframe;
asm
lock btr %edx,(%rcx)
setc %al
end;
{$ELSE}
function test_and_reset(var Target:SizeUInt;bit:byte):Boolean; ms_abi_default;
Var
P,N,M:SizeUInt;
begin
M:=not (1 shl bit);
repeat
P:=load_consume(Target);
N:=P and M;
until CAS(Target,P,N);
Result:=(P and M)<>0;
end;
{$ENDIF}
{$ENDIF}
function marked_ptr(P:Pointer;B:SizeUInt=0):Pointer; inline;
begin
Result:=Pointer(SizeUInt(P) or B);
end;
function ptr1(P:Pointer):Pointer; inline;
begin
Result:=Pointer(SizeUInt(P) and (not SizeUInt(1)));
end;
function bits1(P:Pointer):SizeUInt; inline;
begin
Result:=SizeUInt(P) and SizeUInt(1);
end;
function bits1(P:SizeUInt):SizeUInt; inline;
begin
Result:=SizeUInt(P) and SizeUInt(1);
end;
{$if defined(CPU386) or defined(CPUX86_64)}
procedure spin_pause; assembler; nostackframe;
asm
pause
end;
{$ELSE}
procedure spin_pause; inline;
begin
end;
{$ENDIF}
end.

0
bittype.pas → rtl/bittype.pas
View File

2
g23tree.pas → rtl/g23tree.pas
View File

@ -506,8 +506,6 @@ begin
Result:=False;
SI:=Default(TSplitInfo);
//Writeln(k);
if (pRoot=nil) then
begin
pRoot:=TStuff.new_Node;

0
hamt.pas → rtl/hamt.pas
View File

87
rtl/ntapi.pas Normal file
View File

@ -0,0 +1,87 @@
unit ntapi;
{$mode objfpc}{$H+}
interface
uses
Windows;
const
STATUS_SUCCESS =$00000000;
STATUS_WAIT_0 =$00000000;
STATUS_ABANDONED =$00000080;
STATUS_ABANDONED_WAIT_0 =$00000080;
STATUS_USER_APC =$000000C0;
STATUS_KERNEL_APC =$00000100;
STATUS_ALERTED =$00000101;
STATUS_TIMEOUT =$00000102;
STATUS_PENDING =$00000103;
STATUS_NO_YIELD_PERFORMED=$40000024;
STATUS_ACCESS_VIOLATION =$C0000005;
NT_INFINITE=$8000000000000000;
function NtAlertThread(hThread:THandle):DWORD; stdcall; external 'ntdll';
function NtTestAlert():DWORD; stdcall; external 'ntdll';
function NtQueueApcThread(
hThread:THandle;
ApcRoutine:Pointer;
ApcRoutineContext:PTRUINT;
ApcStatusBlock:Pointer;
ApcReserved:ULONG
):DWORD; stdcall; external 'ntdll';
function NtYieldExecution():DWORD; stdcall; external 'ntdll';
function NtDelayExecution(
Alertable:BOOL;
DelayInterval:PLARGE_INTEGER
):DWORD; stdcall; external 'ntdll';
function NtWaitForSingleObject(
ObjectHandle:THandle;
Alertable:BOOL;
TimeOut:PLARGE_INTEGER
):DWORD; stdcall; external 'ntdll';
function NtGetContextThread(
ThreadHandle:THandle;
Context:PCONTEXT
):DWORD; stdcall; external 'ntdll';
function NtSetContextThread(
ThreadHandle:THandle;
Context:PCONTEXT
):DWORD; stdcall; external 'ntdll';
function NtAlertResumeThread(
ThreadHandle:THandle;
SuspendCount:PULONG
):DWORD; stdcall; external 'ntdll';
function NtResumeThread(
ThreadHandle:THandle;
SuspendCount:PULONG
):DWORD; stdcall; external 'ntdll';
function NtSuspendThread(
ThreadHandle:THandle;
SuspendCount:PULONG
):DWORD; stdcall; external 'ntdll';
function NtContinue(
Context:PCONTEXT;
RaiseAlert:BOOL
):DWORD; stdcall; external 'ntdll';
function NtQueryPerformanceCounter(
Counter,
Frequency:PLARGE_INTEGER
):DWORD; stdcall; external 'ntdll';
implementation
end.

5
stub_manager.pas → rtl/stub_manager.pas
View File

@ -98,7 +98,7 @@ begin
if (Stub_va<>nil) then
begin
Push(Stub_va);
VirtualProtect(Stub_va,VA_SIZE,PAGE_EXECUTE_READ,@dummy);
//VirtualProtect(Stub_va,VA_SIZE,PAGE_EXECUTE_READ,@dummy);
FlushInstructionCache(GetCurrentProcess,Stub_va,VA_SIZE);
Stub_va:=nil;
Stub_pos:=0;
@ -112,7 +112,7 @@ begin
if (Stub_va=nil) then
begin
Stub_va:=VirtualAlloc(nil,VA_SIZE,MEM_COMMIT or MEM_RESERVE,PAGE_READWRITE);
Stub_va:=VirtualAlloc(nil,VA_SIZE,MEM_COMMIT or MEM_RESERVE,{PAGE_READWRITE}PAGE_EXECUTE_READWRITE);
end;
Result:=Stub_va+Stub_pos;
@ -179,6 +179,5 @@ begin
Result:=NewStub(@nopstub,SizeOf(Tnopstub));
end;
end.

11
seh64.pas
View File

@ -12,7 +12,8 @@ uses
SysUtils,
hamt,
ps4libdoc,
ps4_types,
sys_types,
sys_kernel,
ps4_program;
function AddVectoredExceptionHandler(FirstHandler: DWORD; VectoredHandler: pointer): pointer; stdcall;
@ -337,6 +338,7 @@ begin
Report:=Report+#13#10;
WriteErr(Report);
print_adr;
if (node<>nil) then node.Release;
top:=Pointer(ContextRecord^.Rbp);
//if (top>StackBottom) and (top<StackTop) then
begin
@ -346,10 +348,11 @@ begin
safe_move_ptr(rbp[0],rbp);
if (ExceptAddr<>nil) then
begin
node:=ps4_app.FindFileByCodeAdr(ExceptAddr);
node:=ps4_app.AcqureFileByCodeAdr(ExceptAddr);
if (node<>nil) then
begin
print_adr;
node.Release;
end else
begin
print_adr2;
@ -371,7 +374,9 @@ begin
if (p^.ExceptionRecord^.ExceptionCode=FPC_EXCEPTION_CODE) then Exit(EXCEPTION_CONTINUE_SEARCH);
node:=ps4_app.FindFileByCodeAdr(p^.ExceptionRecord^.ExceptionAddress);
//DumpException(nil,0,p^.ExceptionRecord^.ExceptionAddress,P^.ContextRecord);
node:=ps4_app.AcqureFileByCodeAdr(p^.ExceptionRecord^.ExceptionAddress);
if (node=nil) and
(GetModuleByAdr(p^.ExceptionRecord^.ExceptionAddress)<>GetModuleByAdr(@ProcessException)) then
Exit(EXCEPTION_CONTINUE_SEARCH);

BIN
shader_dump/simplet-single-triangle_debug_ps_FBCA196D.spv
View File

Binary file not shown.

BIN
shader_dump/simplet-single-triangle_debug_vs_78EF9008.spv
View File

Binary file not shown.

12
ps4_libkernel/errno.inc → sys/errno.inc
View File

@ -55,10 +55,10 @@ const
EMSGSIZE =40 ;// Message too long */
EPROTOTYPE =41 ;// Protocol wrong type for socket */
ENOPROTOOPT =42 ;// Protocol not available */
EPROTONOSUPPORT =43 ;// Protocol not supported */
ESOCKTNOSUPPORT =44 ;// Socket type not supported */
EPROTONOSUPPORT=43 ;// Protocol not supported */
ESOCKTNOSUPPORT=44 ;// Socket type not supported */
EOPNOTSUPP =45 ;// Operation not supported */
ENOTSUP =EOPNOTSUPP ;// Operation not supported */
ENOTSUP =EOPNOTSUPP ;// Operation not supported */
EPFNOSUPPORT =46 ;// Protocol family not supported */
EAFNOSUPPORT =47 ;// Address family not supported by protocol family */
EADDRINUSE =48 ;// Address already in use */
@ -70,8 +70,8 @@ const
ENETRESET =52 ;// Network dropped connection on reset */
ECONNABORTED =53 ;// Software caused connection abort */
ECONNRESET =54 ;// Connection reset by peer */
ENOBUFS =55 ;// No buffer space available */
EISCONN =56 ;// Socket is already connected */
ENOBUFS =55 ;// No buffer space available */
EISCONN =56 ;// Socket is already connected */
ENOTCONN =57 ;// Socket is not connected */
ESHUTDOWN =58 ;// Can't send after socket shutdown */
ETOOMANYREFS =59 ;// Too many references: can't splice */
@ -134,7 +134,7 @@ const
ELAST =101 ;// Must be equal largest errno */
EADHOC =160 ;// adhoc mode */
EADHOC =160 ;// adhoc mode */
// 161 reserved */
// 162 reserved */
EINACTIVEDISABLED =163 ;// IP address was changed */

0
ps4_libkernel/sce_errno.inc → sys/sce_errno.inc
View File

331
sys/signal.inc Normal file
View File

@ -0,0 +1,331 @@
const
_SIG_WORDS =4;
_SIG_MAXSIG =128;
const
SIG_BLOCK =1;
SIG_UNBLOCK =2;
SIG_SETMASK =3;
SIGPROCMASK_OLD =$0001;
SIGPROCMASK_PROC_LOCKED =$0002;
SIGPROCMASK_PS_LOCKED =$0004;
SIGPROCMASK_FASTBLK =$0008;
const
SIGHUP =1; // hangup
SIGINT =2; // interrupt
SIGQUIT =3; // quit
SIGILL =4; // illegal instr. (not reset when caught)
SIGTRAP =5; // trace trap (not reset when caught)
SIGABRT =6; // abort()
SIGIOT =SIGABRT; // compatibility
SIGEMT =7; // EMT instruction
SIGFPE =8; // floating point exception
SIGKILL =9; // kill (cannot be caught or ignored)
SIGBUS =10; // bus error
SIGSEGV =11; // segmentation violation
SIGSYS =12; // non-existent system call invoked
SIGPIPE =13; // write on a pipe with no one to read it
SIGALRM =14; // alarm clock
SIGTERM =15; // software termination signal from kill
SIGURG =16; // urgent condition on IO channel
SIGSTOP =17; // sendable stop signal not from tty
SIGTSTP =18; // stop signal from tty
SIGCONT =19; // continue a stopped process
SIGCHLD =20; // to parent on child stop or exit
SIGTTIN =21; // to readers pgrp upon background tty read
SIGTTOU =22; // like TTIN if (tp->t_local&LTOSTOP)
SIGIO =23; // input/output possible signal
SIGXCPU =24; // exceeded CPU time limit
SIGXFSZ =25; // exceeded file size limit
SIGVTALRM=26; // virtual time alarm
SIGPROF =27; // profiling time alarm
SIGWINCH =28; // window size changes
SIGINFO =29; // information request
SIGUSR1 =30; // user defined signal 1
SIGUSR2 =31; // user defined signal 2
SIGTHR =32; // reserved by thread library.
SIGLWP =SIGTHR;
SIGCANCEL=SIGTHR;
SIGRTMIN=65;
SIGRTMAX=126;
SIG_DFL = 0; //default
SIG_IGN = 1; //ignore
SIG_ERR =-1;
SIG_CATCH= 2; //See signalvar.h
SIG_HOLD = 3;
SA_ONSTACK =$0001; // take signal on signal stack
SA_RESTART =$0002; // restart system call on signal return
SA_RESETHAND =$0004; // reset to SIG_DFL when taking signal
SA_NODEFER =$0010; // don't mask the signal we're delivering
SA_NOCLDWAIT =$0020; // don't keep zombies around
SA_SIGINFO =$0040; // signal handler with SA_SIGINFO args
SI_NOINFO =0; // No signal info besides si_signo.
SI_USER =$10001; // Signal sent by kill().
SI_QUEUE =$10002; // Signal sent by the sigqueue().
SI_TIMER =$10003; // Signal generated by expiration of a timer set by timer_settime().
SI_ASYNCIO=$10004; // Signal generated by completion of an asynchronous I/O request.
SI_MESGQ =$10005; // Signal generated by arrival of a message on an empty message queue.
SI_KERNEL =$10006;
SI_LWP =$10007; // Signal sent by thr_kill
_MC_FPFMT_XMM =$10002;
_MC_FPOWNED_FPU=$20001; // FP state came from FPU
//mc_flags bits. Shall be in sync with TF_XXX.
_MC_HASSEGS =$1;
_MC_HASBASES =$2;
_MC_HASFPXSTATE=$4;
_MC_FLAG_MASK =(_MC_HASSEGS or _MC_HASBASES or _MC_HASFPXSTATE);
type
p_sigset_t=^sigset_t;
sigset_t=packed record
Case Byte of
0:(bits:array[0.._SIG_WORDS-1] of DWORD);
1:(qwords:array[0..(_SIG_WORDS div 2)-1] of QWORD);
end;
sigval=packed record
Case Byte of
// Members as suggested by Annex C of POSIX 1003.1b.
0:(sival_int:Integer);
1:(sival_ptr:Pointer);
//6.0 compatibility
2:(sigval_int:Integer);
3:(sigval_ptr:Pointer);
end;
sigevent=packed record
sigev_notify:Integer; //Notification type
sigev_signo :Integer; //Signal number
sigev_value :sigval; //Signal value
_sigev_un:packed record
Case Byte of
0:(_threadid:Integer); //__lwpid_t
1:(_sigev_thread:packed record
_function :Pointer; //void (*_function)(union sigval);
_attribute:Pointer; //pthread_attr_t
end);
2:(__spare__:array[0..7] of QWORD);
end;
end;
p_siginfo_t=^siginfo_t;
siginfo_t=packed record
si_signo:Integer; //signal number
si_errno:Integer; //errno association
{
* Cause of signal, one of the SI_ macros or signal-specific
* values, i.e. one of the FPE_... values for SIGFPE. This
* value is equivalent to the second argument to an old-style
* FreeBSD signal handler.
}
si_code :Integer; // signal code SI_USER
si_pid :Integer; // sending process
si_uid :DWORD; // sender's ruid
si_status:Integer; // exit value
si_addr :Pointer; // faulting instruction
si_value :sigval; // signal value
_reason:packed record
Case Byte of
0:(_fault:packed record
_trapno:Integer; // machine specific trap code
end);
1:(_timer:packed record
_timerid:Integer;
_overrun:Integer;
end);
2:(_mesgq:packed record
_mqd:Integer;
end);
3:(_poll:packed record
_band:QWORD; // band event for SIGPOLL
end);
4:(__spare__:packed record
__spare1__:QWORD;
__spare2__:array[0..6] of Integer;
end);
end;
end;
sa_handler =procedure(sig,code:Integer;ctx:Pointer); SysV_ABI_CDecl;
sa_sigaction=procedure(sig:Integer;info:p_siginfo_t;ctx:Pointer); SysV_ABI_CDecl;
sig_t=sa_handler;
p_sigaction_t=^sigaction_t;
sigaction_t=packed record
__sigaction_u:packed record // signal handler
Case Byte of
0:(__code:Ptrint); //SIG_DFL
1:(__sa_handler:sa_handler); //void (*__sa_handler)(int);
2:(__sa_sigaction:sa_sigaction); //void (*__sa_sigaction)(int, struct __siginfo *, void *); (sa_flags and SA_SIGINFO)<>0
end;
sa_flags:Integer; //SA_SIGINFO
sa_mask:sigset_t; //signal mask to apply (signal mask inside signal)
_align:Integer;
end;
sigcontext=packed record //0x490(1168)
sc_mask:sigset_t; //signal mask to restore =1 if (SS_ONSTACK)
sc_onstack:QWORD; //sigstack state to restore
sc_rdi:QWORD; //machine state (struct trapframe)
sc_rsi:QWORD;
sc_rdx:QWORD;
sc_rcx:QWORD;
sc_r8 :QWORD;
sc_r9 :QWORD;
sc_rax:QWORD;
sc_rbx:QWORD;
sc_rbp:QWORD;
sc_r10:QWORD;
sc_r11:QWORD;
sc_r12:QWORD;
sc_r13:QWORD;
sc_r14:QWORD;
sc_r15:QWORD;
sc_trapno:Integer;
sc_fs:Word;
sc_gs:Word;
sc_addr:QWORD;
sc_flags:Integer; //_MC_HASSEGS
sc_es:Word;
sc_ds:Word;
sc_err :QWORD; //errno
sc_rip :QWORD;
sc_cs :QWORD;
sc_rflags:QWORD; //EFlags
sc_rsp :QWORD;
sc_ss :QWORD;
sc_len :QWORD; //sizeof(mcontext_t)
{
* XXX - See <machine/ucontext.h> and <machine/fpu.h> for
* the following fields.
}
sc_fpformat:QWORD; //_MC_FPFMT_XMM
sc_ownedfp :QWORD; //_MC_FPOWNED_FPU
sc_lbrfrom :QWORD; //LastBranchFromRip
sc_lbrto :QWORD; //LastBranchToRip
sc_aux1 :QWORD;
sc_aux2 :QWORD;
sc_fpstate:array[0..103] of QWORD; //__aligned(16); =XMM_SAVE_AREA32+XSTATE
sc_fsbase:QWORD;
sc_gsbase:QWORD;
sc_spare:array[0..5] of QWORD; //6(qword) 12(int)
end;
p_mcontext_t=^mcontext_t;
mcontext_t=packed record
mc_onstack:QWORD; //sigstack state to restore =1 if (SS_ONSTACK)
mc_rdi:QWORD; //machine state (struct trapframe)
mc_rsi:QWORD;
mc_rdx:QWORD;
mc_rcx:QWORD;
mc_r8 :QWORD;
mc_r9 :QWORD;
mc_rax:QWORD;
mc_rbx:QWORD;
mc_rbp:QWORD;
mc_r10:QWORD;
mc_r11:QWORD;
mc_r12:QWORD;
mc_r13:QWORD;
mc_r14:QWORD;
mc_r15:QWORD;
mc_trapno:Integer;
mc_fs:Word;
mc_gs:Word;
mc_addr:QWORD;
mc_flags:Integer; //_MC_HASSEGS
mc_es:Word;
mc_ds:Word;
mc_err :QWORD; //errno
mc_rip :QWORD;
mc_cs :QWORD;
mc_rflags:QWORD; //EFlags
mc_rsp :QWORD;
mc_ss :QWORD;
mc_len :QWORD; //sizeof(mcontext_t)
{
* XXX - See <machine/ucontext.h> and <machine/fpu.h> for
* the following fields.
}
mc_fpformat:QWORD; //_MC_FPFMT_XMM
mc_ownedfp :QWORD; //_MC_FPOWNED_FPU
mc_lbrfrom :QWORD; //LastBranchFromRip
mc_lbrto :QWORD; //LastBranchToRip
mc_aux1 :QWORD;
mc_aux2 :QWORD;
mc_fpstate:array[0..103] of QWORD; //__aligned(16); =XMM_SAVE_AREA32+XSTATE
mc_fsbase:QWORD;
mc_gsbase:QWORD;
mc_spare:array[0..5] of QWORD; //6(qword) 12(int)
end;
sigaltstack=packed record
ss_sp:Pointer; //signal stack base
ss_size:size_t; //signal stack length SIGSTKSZ
ss_flags:Integer; //SS_DISABLE and/or SS_ONSTACK
end;
const
SS_ONSTACK =$0001; // take signal on alternate stack
SS_DISABLE =$0004; // disable taking signals on alternate stack
MINSIGSTKSZ =(512*4); // minimum stack size
SIGSTKSZ =(MINSIGSTKSZ+32768); // recommended stack size
// uc_flags
_UC_SIGMASK=$01; // valid uc_sigmask
_UC_STACK =$02; // valid uc_stack
_UC_CPU =$04; // valid GPR context in uc_mcontext
_UC_FPU =$08; // valid FPU context in uc_mcontext
type
p_ucontext_t=^_ucontext_t;
_ucontext_t=packed record //size=0x500(1280)
uc_sigmask:sigset_t; //2(qword) 4(int)
uc_mcontext:mcontext_t;
uc_link:Pointer; //__ucontext
uc_stack:sigaltstack; //__stack_t
uc_flags:Integer;
//fix me
_unknow_data:array[0..9] of QWORD; //10(qword) 20(int)
end;

302
sys/spinlock.pas Normal file
View File

@ -0,0 +1,302 @@
unit spinlock;
{$mode objfpc}{$H+}
interface
type
backoff_exp=object
private
Const
lower_bound = 16; ///< Minimum spinning limit
upper_bound = 16*1024; ///< Maximum spinning limit
Var
m_nExpCur:SizeUInt; //=lower_bound
public
Procedure Wait;
Procedure Reset;
end;
r_spin_lock=record
_lock:DWORD;
count:DWORD;
owner:DWORD;
end;
function spin_trylock(Var P:Pointer):Boolean;
function spin_trylock(Var P:SizeUint):Boolean;
{$IF defined(CPUX86_64)}
function spin_trylock(Var P:DWORD):Boolean;
{$ENDIF}
function spin_tryunlock(Var P:Pointer):Boolean;
function spin_tryunlock(Var P:SizeUint):Boolean;
{$IF defined(CPUX86_64)}
function spin_tryunlock(Var P:DWORD):Boolean;
{$ENDIF}
procedure spin_lock(Var P:Pointer);
procedure spin_lock(Var P:SizeUint);
{$IF defined(CPUX86_64)}
procedure spin_lock(Var P:DWORD);
{$ENDIF}
procedure spin_unlock(Var P:Pointer);
procedure spin_unlock(Var P:SizeUint);
{$IF defined(CPUX86_64)}
procedure spin_unlock(Var P:DWORD);
{$ENDIF}
function spin_trylock(var t:r_spin_lock):Boolean;
procedure spin_lock(var t:r_spin_lock);
procedure spin_unlock(var t:r_spin_lock);
Procedure wait_until_equal(Var P:Pointer;V:Pointer);
Procedure wait_until_equal(Var P:SizeUint;V:SizeUint);
{$IF defined(CPUX86_64)}
Procedure wait_until_equal(Var P:DWORD;V:DWORD);
Procedure wait_until_equal(Var P:Integer;V:Integer);
{$ENDIF}
const
EVL_DIS=0; //disable
EVL_NEW=1; //new
EVL_ENB=2; //enable
function event_try_enable(Var P:Pointer):Boolean;
function event_try_enable(Var P:DWORD):Boolean;
function event_try_disable(Var P:Pointer):Boolean;
function event_try_disable(Var P:DWORD):Boolean;
procedure event_disable(Var P:Pointer);
procedure event_disable(Var P:DWORD);
implementation
Uses
atomic,
sys_kernel;
Procedure backoff_exp.Wait;
Var
n:SizeUInt;
begin
if (m_nExpCur<=upper_bound) then
begin
For n:=0 to m_nExpCur-1 do
begin
spin_pause;
end;
m_nExpCur:=m_nExpCur*2;
end else
begin
SwYieldExecution;
end;
end;
Procedure backoff_exp.Reset;
begin
m_nExpCur:=lower_bound;
end;
function spin_trylock(Var P:Pointer):Boolean;
begin
Result:=XCHG(P,Pointer(1))=nil;
end;
function spin_trylock(Var P:SizeUint):Boolean;
begin
Result:=XCHG(P,1)=0;
end;
{$IF defined(CPUX86_64)}
function spin_trylock(Var P:DWORD):Boolean;
begin
Result:=XCHG(P,1)=0;
end;
{$ENDIF}
function spin_tryunlock(Var P:Pointer):Boolean;
begin
Result:=XCHG(P,nil)=Pointer(1);
end;
function spin_tryunlock(Var P:SizeUint):Boolean;
begin
Result:=XCHG(P,0)=1;
end;
{$IF defined(CPUX86_64)}
function spin_tryunlock(Var P:DWORD):Boolean;
begin
Result:=XCHG(P,0)=1;
end;
{$ENDIF}
procedure spin_lock(Var P:Pointer);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (XCHG(P,Pointer(1))<>nil) do bkoff.Wait;
end;
procedure spin_lock(Var P:SizeUint);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (XCHG(P,1)<>0) do bkoff.Wait;
end;
{$IF defined(CPUX86_64)}
procedure spin_lock(Var P:DWORD);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (XCHG(P,1)<>0) do bkoff.Wait;
end;
{$ENDIF}
procedure spin_unlock(Var P:Pointer);
begin
store_release(P,nil);
end;
procedure spin_unlock(Var P:SizeUint);
begin
store_release(P,0);
end;
{$IF defined(CPUX86_64)}
procedure spin_unlock(Var P:DWORD);
begin
store_release(P,0);
end;
{$ENDIF}
//recrusive spin lock
function spin_trylock(var t:r_spin_lock):Boolean;
begin
Result:=True;
if spin_trylock(t._lock) then
begin
t.count:=0;
t.owner:=GetCurrentThreadId;
end else
if (t.owner=GetCurrentThreadId) then
begin
Inc(t.count);
end else
begin
Result:=False;
end;
end;
procedure spin_lock(var t:r_spin_lock);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (not spin_trylock(t)) do bkoff.Wait;
end;
procedure spin_unlock(var t:r_spin_lock);
begin
if (t.count<=1) then
begin
t.count:=0;
t.owner:=DWORD(-1);
spin_unlock(t._lock);
end else
begin
Dec(t.count);
end;
end;
//
Procedure wait_until_equal(Var P:Pointer;V:Pointer);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (load_acq_rel(P)=V) do bkoff.Wait;
end;
Procedure wait_until_equal(Var P:SizeUint;V:SizeUint);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (load_acq_rel(P)=V) do bkoff.Wait;
end;
{$IF defined(CPUX86_64)}
Procedure wait_until_equal(Var P:DWORD;V:DWORD);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (load_acq_rel(P)=V) do bkoff.Wait;
end;
Procedure wait_until_equal(Var P:Integer;V:Integer);
Var
bkoff:backoff_exp;
begin
bkoff.Reset;
While (load_acq_rel(P)=V) do bkoff.Wait;
end;
{$ENDIF}
function event_try_enable(Var P:Pointer):Boolean;
begin
Result:=(XCHG(P,Pointer(EVL_NEW))=Pointer(EVL_DIS));
if Result then
begin
store_release(P,Pointer(EVL_ENB));
end;
end;
function event_try_enable(Var P:DWORD):Boolean;
begin
Result:=(XCHG(P,EVL_NEW)=EVL_DIS);
if Result then
begin
store_release(P,EVL_ENB);
end;
end;
function event_try_disable(Var P:Pointer):Boolean;
begin
Result:=False;
Case SizeUint(_CAS(P,Pointer(EVL_ENB),Pointer(EVL_DIS))) of
EVL_DIS,
EVL_ENB:Result:=True;
EVL_NEW:store_release(P,Pointer(EVL_ENB));
else;
end;
end;
function event_try_disable(Var P:DWORD):Boolean;
begin
Result:=False;
Case _CAS(P,EVL_ENB,EVL_DIS) of
EVL_DIS,
EVL_ENB:Result:=True;
EVL_NEW:store_release(P,EVL_ENB);
else;
end;
end;
procedure event_disable(Var P:Pointer);
begin
store_release(P,Pointer(EVL_DIS));
end;
procedure event_disable(Var P:DWORD);
begin
store_release(P,EVL_DIS);
end;
end.

206
sys/sys_context.pas Normal file
View File

@ -0,0 +1,206 @@
unit sys_context;
{$mode objfpc}{$H+}
interface
uses
Windows;
const
XSTATE_LEGACY_FLOATING_POINT=0;
XSTATE_LEGACY_SSE =1;
XSTATE_GSSE =2;
XSTATE_AVX =XSTATE_GSSE;
XSTATE_MPX_BNDREGS =3;
XSTATE_MPX_BNDCSR =4;
XSTATE_AVX512_KMASK =5;
XSTATE_AVX512_ZMM_H =6;
XSTATE_AVX512_ZMM =7;
XSTATE_IPT =8;
XSTATE_CET_U =11;
XSTATE_LWP =62;
MAXIMUM_XSTATE_FEATURES =64;
XSTATE_MASK_LEGACY_FLOATING_POINT=(1 shl XSTATE_LEGACY_FLOATING_POINT);
XSTATE_MASK_LEGACY_SSE =(1 shl XSTATE_LEGACY_SSE);
XSTATE_MASK_LEGACY =(XSTATE_MASK_LEGACY_FLOATING_POINT or XSTATE_MASK_LEGACY_SSE);
XSTATE_MASK_GSSE =(1 shl XSTATE_GSSE);
XSTATE_MASK_AVX =(XSTATE_MASK_GSSE);
const
CONTEXT_XSTATE =(CONTEXT_AMD64 or $0040);
CONTEXT_ALLX =(CONTEXT_ALL or CONTEXT_XSTATE);
type
PYMMCONTEXT=^TYMMCONTEXT;
TYMMCONTEXT=packed record
Ymm0 :M128A;
Ymm1 :M128A;
Ymm2 :M128A;
Ymm3 :M128A;
Ymm4 :M128A;
Ymm5 :M128A;
Ymm6 :M128A;
Ymm7 :M128A;
Ymm8 :M128A;
Ymm9 :M128A;
Ymm10:M128A;
Ymm11:M128A;
Ymm12:M128A;
Ymm13:M128A;
Ymm14:M128A;
Ymm15:M128A;
end;
PXSTATE=^TXSTATE;
TXSTATE=packed record
Mask:QWORD;
CompactionMask:QWORD;
Reserved:array[0..5] of QWORD;
YmmContext:TYMMCONTEXT;
end;
PCONTEXT_CHUNK=^TCONTEXT_CHUNK;
TCONTEXT_CHUNK=packed record
Offset:LONG;
Length:ULONG;
end;
PCONTEXT_EX=^TCONTEXT_EX;
TCONTEXT_EX=packed record
All :TCONTEXT_CHUNK;
Legacy:TCONTEXT_CHUNK;
XState:TCONTEXT_CHUNK;
_align:QWORD;
end;
PPCONTEXT=^PCONTEXT;
const
CONTEXT_STUB_SIZE=SizeOf(TCONTEXT)+SizeOf(TCONTEXT_EX)+SizeOf(TXSTATE)+64;
type
TCONTEXT_STUB=array[0..CONTEXT_STUB_SIZE-1] of Byte;
PCONTEXT_EXTENDED=^TCONTEXT_EXTENDED;
TCONTEXT_EXTENDED=packed record
CONTEXT:PCONTEXT;
STUB:TCONTEXT_STUB;
end;
function GetEnabledXStateFeatures:QWORD; stdcall external 'kernel32';
function InitializeContext(
Buffer:Pointer;
ContextFlags:DWORD;
Context:PPCONTEXT;
ContextLength:PDWORD
):BOOL; stdcall external 'kernel32';
function GetXStateFeaturesMask(
Context:PCONTEXT;
FeatureMask:PQWORD
):BOOL; stdcall external 'kernel32';
function LocateXStateFeature(
Context:PCONTEXT;
FeatureId:DWORD;
Length:PDWORD
):Pointer; stdcall external 'kernel32';
function SetXStateFeaturesMask(
Context:PCONTEXT;
FeatureMask:QWORD
):BOOL; stdcall external 'kernel32';
function CopyContext(
Destination:PCONTEXT;
ContextFlags:DWORD;
Source:PCONTEXT
):BOOL; stdcall external 'kernel32';
Function GetContextXSize:DWORD;
function InitializeContextExtended(lpContext:PCONTEXT_EXTENDED):Boolean;
function CopyContextExtended(src,dst:PCONTEXT_EXTENDED):Boolean;
function IS_SYSCALL(rip:qword):Boolean;
implementation
Function GetContextXSize:DWORD;
begin
Result:=0;
InitializeContext(nil,
CONTEXT_ALLX,
nil,
@Result);
end;
function InitializeContextExtended(lpContext:PCONTEXT_EXTENDED):Boolean;
var
ContextSize:DWORD;
FeatureMask:QWORD;
begin
Result:=False;
if (lpContext=nil) then
begin
SetLastError(ERROR_INVALID_PARAMETER);
Exit(False);
end;
ContextSize:=GetContextXSize;
if (ContextSize=0) then Exit(False);
if (ContextSize>SizeOf(TCONTEXT_EXTENDED)) then
begin
Assert(false);
SetLastError(ERROR_NOT_ENOUGH_MEMORY);
Exit(False);
end;
lpContext^:=Default(TCONTEXT_EXTENDED);
if not InitializeContext(@lpContext^.STUB,
CONTEXT_ALLX,
@lpContext^.CONTEXT,
@ContextSize) then
begin
Exit(False);
end;
FeatureMask:=GetEnabledXStateFeatures;
if ((FeatureMask and XSTATE_MASK_AVX)<>0) then
if not SetXStateFeaturesMask(lpContext^.CONTEXT,XSTATE_MASK_AVX) then
begin
Exit(False);
end;
Result:=True;
end;
function CopyContextExtended(src,dst:PCONTEXT_EXTENDED):Boolean;
begin
if (src=nil) or (dst=nil) then Exit(False);
if (src^.CONTEXT=nil) then Exit(False);
if not InitializeContextExtended(dst) then Exit(False);
Result:=CopyContext(dst^.CONTEXT,src^.CONTEXT^.ContextFlags,src^.CONTEXT);
end;
function IS_SYSCALL(rip:qword):Boolean;
var
w:Word;
n:ptruint;
begin
Result:=False;
if (rip<>0) then
begin
w:=0;
ReadProcessMemory(GetCurrentProcess,@PWord(Rip)[-1],@w,SizeOf(Word),@n);
Result:=(w=$050F);
end;
end;
end.

260
sys/sys_kernel.pas Normal file
View File

@ -0,0 +1,260 @@
unit sys_kernel;
{$mode ObjFPC}{$H+}
interface
Uses
Windows;
{$I sce_errno.inc}
{$I errno.inc}
type
SceKernelModule=Integer;
PSceKernelLoadModuleOpt=^SceKernelLoadModuleOpt;
SceKernelLoadModuleOpt=packed record
size:size_t;
end;
atexit_func=function(param:Pointer):Integer;SysV_ABI_CDecl;
TKernelAtexitFunc=function(param:Integer):Integer;SysV_ABI_CDecl;
TKernelAtexitReportFunc=procedure(param:Integer);
function px2sce(e:Integer):Integer;
function sce2px(e:Integer):Integer;
function _set_errno(r:Integer):Integer;
function _error:Pointer;
function SwFreeMem(p:pointer):ptruint;
function SwAllocMem(Size:ptruint):pointer;
Procedure SwYieldExecution; inline;
function SwDelayExecution(Alertable:Boolean;DelayInterval:PQWORD):DWORD;
function SwWaitForSingleObject(
ObjectHandle:THandle;
TimeOut:PQWORD;
Alertable:LONGBOOL):DWORD;
function SwWaitFor(Handle:THandle;pTimeout:PQWORD):Integer; //pTimeout in 100ns
Function safe_move(const src;var dst;count:QWORD):QWORD;
procedure safe_move_ptr(const src;var dst);
function safe_test(var src:DWORD;value:DWORD):Boolean;
function safe_str(P:PChar):shortstring;
implementation
uses
ntapi,
sys_pthread,
sys_signal,
sys_time;
function px2sce(e:Integer):Integer;
begin
if (e=0) then
Result:=0
else
Result:=e-$7ffe0000;
end;
function sce2px(e:Integer):Integer;
begin
if (e=0) then
Result:=0
else
Result:=e+$7ffe0000;
end;
function _set_errno(r:Integer):Integer;
var
t:pthread;
begin
if (r<>0) then
begin
t:=tcb_thread;
if (t<>nil) then t^.errno:=r;
Exit(-1);
end;
Result:=r;
end;
function _error:Pointer;
var
t:pthread;
begin
Result:=nil;
t:=tcb_thread;
if (t<>nil) then Result:=@t^.errno;
end;
function SwFreeMem(p:pointer):ptruint;
begin
_sig_lock;
Result:=FreeMem(p);
_sig_unlock;
end;
function SwAllocMem(Size:ptruint):pointer;
begin
_sig_lock;
Result:=AllocMem(Size);
_sig_unlock;
end;
Procedure SwYieldExecution; inline;
begin
_sig_lock;
NtYieldExecution;
_sig_unlock;
end;
function SwDelayExecution(Alertable:Boolean;DelayInterval:PQWORD):DWORD;
begin
_sig_lock(Alertable);
Result:=NtDelayExecution(Alertable,Pointer(DelayInterval));
_sig_unlock;
end;
function SwWaitForSingleObject(
ObjectHandle:THandle;
TimeOut:PQWORD;
Alertable:LONGBOOL):DWORD;
begin
_sig_lock(Alertable);
Result:=NtWaitForSingleObject(ObjectHandle,Alertable,Pointer(TimeOut));
_sig_unlock;
end;
function SwWaitFor(Handle:THandle;pTimeout:PQWORD):Integer;
var
timeout:Int64;
passed :Int64;
START:QWORD;
QTIME:QWORD;
res:DWORD;
begin
Result:=0;
if (pTimeout<>nil) then
begin
timeout:=(pTimeout^ div 100);
SwSaveTime(START);
end else
begin
timeout:=NT_INFINITE;
end;
repeat
if (pTimeout<>nil) then
begin
if (timeout=0) then
begin
Result:=ETIMEDOUT;
Break;
end;
SwSaveTime(QTIME);
timeout:=-timeout;
_sig_lock(True);
res:=NtWaitForSingleObject(Handle,True,@timeout);
_sig_unlock;
timeout:=-timeout;
passed:=SwTimePassedUnits(QTIME);
if (passed>=timeout) then
begin
timeout:=0;
end else
begin
timeout:=timeout-passed;
end;
end else
begin
_sig_lock(True);
res:=NtWaitForSingleObject(Handle,True,@timeout);
_sig_unlock;
end;
case res of
STATUS_ALERTED,
STATUS_USER_APC:
begin
//continue
end;
STATUS_TIMEOUT:
begin
Result:=ETIMEDOUT;
Break;
end;
STATUS_ABANDONED:
begin
Result:=EPERM;
Break;
end;
STATUS_SUCCESS:
begin
Result:=0;
Break;
end;
else
begin
Result:=EINVAL;
Break;
end;
end;
until false;
end;
Function safe_move(const src;var dst;count:QWORD):QWORD;
begin
_sig_lock;
if not ReadProcessMemory(GetCurrentProcess,@src,@dst,count,Result) then Result:=0;
_sig_unlock;
end;
procedure safe_move_ptr(const src;var dst);
begin
if safe_move(src,dst,SizeOf(Pointer))<>SizeOf(Pointer) then Pointer(dst):=nil;
end;
function safe_test(var src:DWORD;value:DWORD):Boolean;
var
t:DWORD;
begin
Result:=False;
t:=0;
if (safe_move(src,t,SizeOf(DWORD))=SizeOf(DWORD)) then
begin
Result:=(t=value);
end;
end;
function safe_str(P:PChar):shortstring;
var
ch:Char;
begin
Result:='';
repeat
ch:=#0;
safe_move(P^,ch,SizeOf(Char));
if (ch=#0) then Exit;
Result:=Result+ch;
if (Result[0]=#255) then Exit;
Inc(P);
until false;
end;
end.

250
sys/sys_pthread.pas Normal file
View File

@ -0,0 +1,250 @@
unit sys_pthread;
{$mode ObjFPC}{$H+}
interface
uses
sys_signal;
const
//Run-time invariant values:
PTHREAD_STACK_MIN=16384;
PTHREAD_DETACHED =$1;
PTHREAD_SCOPE_SYSTEM =$2;
PTHREAD_INHERIT_SCHED=$4;
PTHREAD_NOFLOAT =$8;
PTHREAD_CREATE_DETACHED=PTHREAD_DETACHED;
PTHREAD_CREATE_JOINABLE=0;
SCE_PTHREAD_DESTRUCTOR_ITERATIONS =4;
SCE_PTHREAD_KEYS_MAX =256;
SCE_PTHREAD_STACK_MIN =PTHREAD_STACK_MIN;
SCE_PTHREAD_THREADS_MAX =High(DWORD);
SCE_PTHREAD_BARRIER_SERIAL_THREAD =-1;
//Flags for threads and thread attributes.
SCE_PTHREAD_DETACHED =$1;
SCE_PTHREAD_INHERIT_SCHED =$4;
SCE_PTHREAD_NOFLOAT =$8;
SCE_PTHREAD_CREATE_DETACHED =SCE_PTHREAD_DETACHED;
SCE_PTHREAD_CREATE_JOINABLE =0;
SCE_PTHREAD_EXPLICIT_SCHED =0;
//Flags for read/write lock attributes
SCE_PTHREAD_PROCESS_PRIVATE =0;
SCE_PTHREAD_PROCESS_SHARED =1;
//POSIX scheduling policies
SCHED_FIFO =1;
SCHED_OTHER =2;
SCHED_RR =3;
// for sceKernelMsync()
SCE_KERNEL_MS_SYNC =$0;
SCE_KERNEL_MS_ASYNC =$1;
SCE_KERNEL_MS_INVALIDATE =$2;
// for sceKernelSchedGetPriorityMax()/Min()
SCE_KERNEL_SCHED_FIFO =SCHED_FIFO;
SCE_KERNEL_SCHED_RR =SCHED_RR;
SCE_KERNEL_PRIO_FIFO_DEFAULT =700;
SCE_KERNEL_PRIO_FIFO_HIGHEST =256;
SCE_KERNEL_PRIO_FIFO_LOWEST =767;
// for SceKernelCpumask
SCE_KERNEL_CPUMASK_6CPU_ALL =$3f;
SCE_KERNEL_CPUMASK_7CPU_ALL =$7f;
SCE_KERNEL_CPUMASK_USER_ALL =$3f; // obsolete
type
p_pthread_attr_t=^pthread_attr_t;
pthread_attr_t=^tthread_attr_t;
tthread_attr_t=packed record
policy:Integer;
sched_priority:Integer;
//prio :Integer;
suspend :Integer;
flags :Integer;
stackaddr_attr:Pointer;
stacksize_attr:size_t;
cpuset:QWORD;
//guardsize_attr:size_t;
//cpuset :Pointer;//cpuset_t
//cpusetsize :size_t;
detachstate:Integer;
end;
//struct pthread_attr {
//#define pthread_attr_start_copy sched_policy
// int sched_policy;
// int sched_inherit;
// int prio;
// int suspend;
//#define THR_STACK_USER 0x100 /* 0xFF reserved for <pthread.h> */
// int flags; //((*attr)->flags & PTHREAD_DETACHED)
// void *stackaddr_attr;
// size_t stacksize_attr;
// size_t guardsize_attr;
//#define pthread_attr_end_copy cpuset
// cpuset_t *cpuset;
// size_t cpusetsize;
//};
p_pthread_once_t=^pthread_once_t;
pthread_once_t=packed record
state:Integer;
_align:Integer;
mutex:Pointer; //pthread_mutex
end;
const
//Flags for once initialization.
PTHREAD_NEEDS_INIT=0;
PTHREAD_DONE_INIT =1;
//Static once initialization values.
PTHREAD_ONCE_INIT:pthread_once_t=(state:PTHREAD_NEEDS_INIT;_align:0;mutex:nil);
type
p_pthread_key_data=^_pthread_key_data;
_pthread_key_data=packed record
version_:ptruint;
data_:Pointer;
end;
p_pthread=^pthread;
pthread=^pthread_t;
pthread_t=record
entry:Pointer;
arg:Pointer;
handle:TThreadID;
ThreadId:TThreadID;
detachstate:Integer;
Attr:tthread_attr_t;
name:array[0..31] of AnsiChar;
//
errno:QWORD;
//
keys:array[0..SCE_PTHREAD_KEYS_MAX-1] of _pthread_key_data;
//
sig:sigqueue_t;
end;
t_init_routine_proc=procedure; SysV_ABI_CDecl;
t_cb_proc=procedure(data:Pointer); SysV_ABI_CDecl;
Ppthread_key_t=^pthread_key_t;
pthread_key_t=DWORD;
p_pthread_cleanup_info=^_pthread_cleanup_info;
_pthread_cleanup_info=packed record
pthread_cleanup_pad:array[0..7] of qword;
end;
PSceKernelSchedParam=^SceKernelSchedParam;
SceKernelSchedParam=packed record
sched_priority:Integer;
end;
threadvar
tcb_thread:pthread;
function _get_curthread:pthread; inline;
function sysv_wrapper(arg,proc:Pointer):Pointer; SysV_ABI_CDecl;
function SysBeginThread(sa:Pointer;
stacksize:ptruint;
ThreadMain:Pointer; //function ThreadMain(param : pointer) : Longint; stdcall;
p:pointer;
creationFlags:dword;
var ThreadId:TThreadID):TThreadID;
implementation
uses
Windows;
function _get_curthread:pthread; inline;
begin
Result:=tcb_thread;
end;
var
TLSKey:PDword; external name '_FPC_TlsKey';
procedure SysAllocateThreadVars; external name '_FPC_SysAllocateThreadVars';
function SysRelocateThreadVar(offset : dword) : pointer;
var
dataindex : pointer;
errorsave : dword;
begin
errorsave:=GetLastError;
dataindex:=TlsGetValue(tlskey^);
if (dataindex=nil) then
begin
SysAllocateThreadVars;
dataindex:=TlsGetValue(tlskey^);
InitThread($1000000);
end;
SetLastError(errorsave);
Result:=DataIndex+Offset;
end;
procedure SysInitTLS;
begin
if (TLSKey^=$ffffffff) then
begin
{ We're still running in single thread mode, setup the TLS }
TLSKey^:=TlsAlloc;
InitThreadVars(@SysRelocateThreadVar);
end;
end;
//rdi,rsi:rax
function sysv_wrapper(arg,proc:Pointer):Pointer; SysV_ABI_CDecl; assembler; nostackframe;
asm
subq $40, %rsp
.seh_stackalloc 40
.seh_endprologue
call %rsi
nop { this nop is critical for exception handling }
addq $40, %rsp
.seh_handler __FPC_default_handler,@except,@unwind
end;
function SysBeginThread(sa:Pointer;
stacksize:ptruint;
ThreadMain:Pointer; //function ThreadMain(param : pointer) : Longint; stdcall;
p:pointer;
creationFlags:dword;
var ThreadId:TThreadID):TThreadID;
var
_threadid : dword;
begin
_sig_lock;
{ Initialize multithreading if not done }
SysInitTLS;
if not IsMultiThread then
begin
{ lazy initialize thread support }
LazyInitThreading;
IsMultiThread:=true;
end;
_threadid:=0;
Result:=CreateThread(sa,stacksize,ThreadMain,p,creationflags,_threadid);
_sig_unlock;
ThreadID:=_threadid;
end;
end.

1154
sys/sys_signal.pas Normal file
View File

File diff suppressed because it is too large Load Diff

235
sys/sys_time.pas Normal file
View File

@ -0,0 +1,235 @@
unit sys_time;
{$mode ObjFPC}{$H+}
interface
uses
windows,
ntapi,
sys_types,
sys_kernel;
function _usec2msec(usec:QWORD):QWORD; //Microsecond to Milisecond
function _msec2usec(msec:QWORD):QWORD; //Milisecond to Microsecond
function _usec2nsec(usec:QWORD):QWORD; //Microsecond to Nanosecond
function _nsec2usec(nsec:QWORD):QWORD; //Nanosecond to Microsecond
function _msec2nsec(msec:QWORD):QWORD; //Milisecond to Nanosecond
function _nsec2msec(nsec:QWORD):QWORD; //Nanosecond to Milisecond
function _time_in_ms_from_timespec(const ts:timespec):QWORD; inline; //Milisecond
function _time_in_ns_from_timespec(const ts:timespec):QWORD; inline; //Nanosecond
function dwMilliSecs(ms:QWORD):DWORD;
function filetime_to_hnsec(ft:TFILETIME):QWORD; inline;
function filetime_to_timespec(ft:TFILETIME):timespec;
procedure SwQueryPerformanceCounter(var pc,pf:QWORD);
procedure SwSaveTime(var pc:QWORD);
function SwTimePassedUnits(ot:QWORD):QWORD;
function SwGetTimeUnits:Int64;
procedure SwGetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME);
procedure Swgettimezone(z:Ptimezone);
function Swgetntptimeofday(tp:Ptimespec;z:Ptimezone):Integer;
Const
FILETIME_1970 =116444736000000000;
HECTONANOSEC_PER_SEC =10000000;
DELTA_EPOCH_IN_100NS =116444736000000000;
POW10_7 =10000000;
POW10_9 =1000000000;
//POW10_11 =100000000000;
implementation
uses
sys_signal;
function _usec2msec(usec:QWORD):QWORD; //Microsecond to Milisecond
begin
Result:=(usec+999) div 1000;
end;
function _msec2usec(msec:QWORD):QWORD; //Milisecond to Microsecond
begin
Result:=msec*1000;
end;
function _usec2nsec(usec:QWORD):QWORD; //Microsecond to Nanosecond
begin
Result:=usec*1000;
end;
function _nsec2usec(nsec:QWORD):QWORD; //Nanosecond to Microsecond
begin
Result:=(nsec+999) div 1000;
end;
function _msec2nsec(msec:QWORD):QWORD; //Milisecond to Nanosecond
begin
Result:=msec*1000000;
end;
function _nsec2msec(nsec:QWORD):QWORD; //Nanosecond to Milisecond
begin
Result:=(nsec+999999) div 1000000;
end;
function _time_in_ms_from_timespec(const ts:timespec):QWORD; inline; //Milisecond
begin
Result:=QWORD(ts.tv_sec)*1000+QWORD(ts.tv_nsec+999999) div 1000000;
end;
function _time_in_ns_from_timespec(const ts:timespec):QWORD; inline; //Nanosecond
begin
Result:=QWORD(ts.tv_sec)*POW10_9+QWORD(ts.tv_nsec);
end;
function dwMilliSecs(ms:QWORD):DWORD;
begin
if (ms>=$ffffffff) then
Result:=$ffffffff
else
Result:=DWORD(ms);
end;
function filetime_to_hnsec(ft:TFILETIME):QWORD; inline;
begin
Result:=QWORD(ft)-FILETIME_1970;
end;
function filetime_to_timespec(ft:TFILETIME):timespec;
begin
QWORD(ft):=filetime_to_hnsec(ft);
Result.tv_sec :=QWORD(ft) div HECTONANOSEC_PER_SEC;
Result.tv_nsec:=(QWORD(ft) mod HECTONANOSEC_PER_SEC)*100;
end;
procedure SwQueryPerformanceCounter(var pc,pf:QWORD);
begin
pc:=0;
pf:=1;
_sig_lock;
NtQueryPerformanceCounter(@pc,@pf);
_sig_unlock;
end;
procedure SwSaveTime(var pc:QWORD);
var
pf:QWORD;
begin
pc:=0;
pf:=1;
_sig_lock;
NtQueryPerformanceCounter(@pc,@pf);
_sig_unlock;
end;
function SwTimePassedUnits(ot:QWORD):QWORD;
var
pc:QWORD;
pf:QWORD;
sec:QWORD;
uec:QWORD;
begin
pc:=0;
pf:=1;
_sig_lock;
NtQueryPerformanceCounter(@pc,@pf);
_sig_unlock;
if (pc>ot) then
pc:=pc-ot
else
pc:=(ot+High(QWORD))+pc;
sec:=pc div pf;
uec:=((pc mod pf)*POW10_7{POW10_11}+(pf shr 1)) div pf;
Result:=sec*POW10_7{POW10_11}+uec;
end;
function SwGetTimeUnits:Int64;
var
pc:QWORD;
pf:QWORD;
sec:QWORD;
uec:QWORD;
begin
pc:=0;
pf:=1;
_sig_lock;
NtQueryPerformanceCounter(@pc,@pf);
_sig_unlock;
sec:=pc div pf;
uec:=((pc mod pf)*POW10_7{POW10_11}+(pf shr 1)) div pf;
Result:=sec*POW10_7{POW10_11}+uec;
end;
type
TGetSystemTimeAsFileTime=procedure(var lpSystemTimeAsFileTime:TFILETIME); stdcall;
var
_GetSystemTimeAsFileTime:TGetSystemTimeAsFileTime;
procedure SwGetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME);
var
h:HMODULE;
begin
if (_GetSystemTimeAsFileTime=nil) then
begin
h:=GetModuleHandle('kernel32.dll');
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimePreciseAsFileTime');
if (_GetSystemTimeAsFileTime=nil) then
begin
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimeAsFileTime');
end;
end;
_sig_lock;
_GetSystemTimeAsFileTime(lpSystemTimeAsFileTime);
_sig_unlock;
end;
procedure Swgettimezone(z:Ptimezone);
var
TZInfo:TTimeZoneInformation;
tzi:DWORD;
begin
if (z<>nil) then
begin
_sig_lock;
tzi:=GetTimeZoneInformation(@TZInfo);
_sig_unlock;
if (tzi<>TIME_ZONE_ID_INVALID) then
begin
z^.tz_minuteswest:=TZInfo.Bias;
if (tzi=TIME_ZONE_ID_DAYLIGHT) then
z^.tz_dsttime:=1
else
z^.tz_dsttime:=0;
end else
begin
z^.tz_minuteswest:=0;
z^.tz_dsttime :=0;
end;
end;
end;
function Swgetntptimeofday(tp:Ptimespec;z:Ptimezone):Integer;
var
_now:TFILETIME;
begin
Swgettimezone(z);
if (tp<>nil) then
begin
GetSystemTimeAsFileTime(_now);
QWORD(_now):=filetime_to_hnsec(_now);
tp^.tv_sec :=QWORD(_now) div HECTONANOSEC_PER_SEC;
tp^.tv_nsec:=(QWORD(_now) mod HECTONANOSEC_PER_SEC)*100;
end;
Result:=0;
end;
end.

501
sys/sys_types.pas Normal file
View File

@ -0,0 +1,501 @@
unit sys_types;
{$mode objfpc}{$H+}
interface
uses ctypes;
Const
ET_NONE =0;
ET_REL =1;
ET_EXEC =2;
ET_DYN =3;
ET_CORE =4;
ET_LOPROC=$ff00;
ET_HIPROC=$ffff;
EI_MAG0 = 0; // e_ident[] indexes
EI_MAG1 = 1;
EI_MAG2 = 2;
EI_MAG3 = 3;
EI_CLASS = 4;
EI_DATA = 5;
EI_VERSION = 6;
EI_OSABI = 7;
EI_PAD = 8;
ELFMAG =$464C457F;
SELFMAG=4;
ET_SCE_DYNEXEC=$FE10;
ET_SCE_DYNAMIC=$FE18;
EM_X86_64 =62; // AMD x86-64
EI_NIDENT=16;
PT_NULL =0;
PT_LOAD =1;
PT_DYNAMIC=2;
PT_INTERP =3;
PT_NOTE =4;
PT_SHLIB =5;
PT_PHDR =6;
PT_TLS =7; // Thread local storage segment
PT_LOOS =$60000000; // OS-specific
PT_HIOS =$6fffffff; // OS-specific
PT_LOPROC =$70000000;
PT_HIPROC =$7fffffff;
PT_GNU_EH_FRAME=$6474e550;
PT_GNU_STACK =$6474E551;
PT_SCE_RELA = $60000000;
PT_SCE_DYNLIBDATA = $61000000;
PT_SCE_PROCPARAM = $61000001;
PT_SCE_MODULE_PARAM = $61000002;
PT_SCE_RELRO = $61000010;
PT_SCE_COMMENT = $6FFFFF00;
PT_SCE_VERSION = $6FFFFF01;
// This is the info that is needed to parse the dynamic section of the file
DT_NULL = 0;
DT_NEEDED = 1;
DT_PLTRELSZ = 2;
DT_PLTGOT = 3;
DT_HASH = 4;
DT_STRTAB = 5;
DT_SYMTAB = 6;
DT_RELA = 7;
DT_RELASZ = 8;
DT_RELAENT = 9;
DT_STRSZ =10;
DT_SYMENT =11;
DT_INIT =12;
DT_FINI =13;
DT_SONAME =14;
DT_RPATH =15;
DT_SYMBOLIC =16;
DT_REL =17;
DT_RELSZ =18;
DT_RELENT =19;
DT_PLTREL =20;
DT_DEBUG =21;
DT_TEXTREL =22;
DT_JMPREL =23;
DT_BIND_NOW =24;
DT_INIT_ARRAY =25;
DT_FINI_ARRAY =26;
DT_INIT_ARRAYSZ =27;
DT_FINI_ARRAYSZ =28;
DT_RUNPATH =29;
DT_FLAGS =30;
DT_ENCODING =32;
DT_PREINIT_ARRAY =32;
DT_PREINIT_ARRAYSZ =33;
// Dynamic Section Types
DT_SCE_IDTABENTSZ =$61000005;
DT_SCE_FINGERPRINT =$61000007;
DT_SCE_FILENAME =$61000009;
DT_SCE_MODULE_INFO =$6100000D;
DT_SCE_NEEDED_MODULE =$6100000F;
DT_SCE_MODULE_ATTR =$61000011;
DT_SCE_EXPORT_LIB =$61000013;
DT_SCE_IMPORT_LIB =$61000015;
DT_SCE_EXPORT_LIB_ATTR =$61000017;
DT_SCE_IMPORT_LIB_ATTR =$61000019;
DT_SCE_STUB_MODULE_NAME =$6100001D;
DT_SCE_STUB_MODULE_VERSION =$6100001F;
DT_SCE_STUB_LIBRARY_NAME =$61000021;
DT_SCE_STUB_LIBRARY_VERSION =$61000023;
DT_SCE_HASH =$61000025;
DT_SCE_PLTGOT =$61000027;
DT_SCE_JMPREL =$61000029;
DT_SCE_PLTREL =$6100002B;
DT_SCE_PLTRELSZ =$6100002D;
DT_SCE_RELA =$6100002F;
DT_SCE_RELASZ =$61000031;
DT_SCE_RELAENT =$61000033;
DT_SCE_STRTAB =$61000035;
DT_SCE_STRSZ =$61000037;
DT_SCE_SYMTAB =$61000039;
DT_SCE_SYMENT =$6100003B;
DT_SCE_HASHSZ =$6100003D;
DT_SCE_SYMTABSZ =$6100003F;
DT_SCE_HIOS =$6FFFF000;
DF_ORIGIN =$1;
DF_SYMBOLIC =$2;
DF_TEXTREL =$4;
DF_BIND_NOW =$8;
DF_STATIC_TLS=$10;
SHT_SYMTAB=2;
SHT_STRTAB=3;
// Relocation types for AMD x86-64 architecture
R_X86_64_NONE = 0; // No reloc
R_X86_64_64 = 1; // Direct 64 bit
R_X86_64_PC32 = 2; // PC relative 32 bit signed
R_X86_64_GOT32 = 3; // 32 bit GOT entry
R_X86_64_PLT32 = 4; // 32 bit PLT address
R_X86_64_COPY = 5; // Copy symbol at runtime
R_X86_64_GLOB_DAT = 6; // Create GOT entry
R_X86_64_JUMP_SLOT = 7; // Create PLT entry
R_X86_64_RELATIVE = 8; // Adjust by program base
R_X86_64_GOTPCREL = 9; // 32 bit signed pc relative offset to GOT
R_X86_64_32 =10; // Direct 32 bit zero extended
R_X86_64_32S =11; // Direct 32 bit sign extended
R_X86_64_16 =12; // Direct 16 bit zero extended
R_X86_64_PC16 =13; // 16 bit sign extended pc relative
R_X86_64_8 =14; // Direct 8 bit sign extended
R_X86_64_PC8 =15; // 8 bit sign extended pc relative
R_X86_64_DTPMOD64 =16; // ID of module containing symbol
R_X86_64_DTPOFF64 =17; // Offset in module's TLS block
R_X86_64_TPOFF64 =18; // Offset in initial TLS block
R_X86_64_TLSGD =19; // 32 bit signed PC relative offset
//to two GOT entries for GD symbol
R_X86_64_TLSLD =20; // 32 bit signed PC relative offset
//to two GOT entries for LD symbol
R_X86_64_DTPOFF32 =21; // Offset in TLS block
R_X86_64_GOTTPOFF =22; // 32 bit signed PC relative offset
//to GOT entry for IE symbol
R_X86_64_TPOFF32 =23; // Offset in initial TLS block
R_X86_64_PC64 =24; // PC relative 64 bit
R_X86_64_GOTOFF64 =25; // 64 bit offset to GOT
R_X86_64_GOTPC32 =26; // 32 bit signed pc relative offset to GOT
R_X86_64_GOT64 =27; // 64-bit GOT entry offset
R_X86_64_GOTPCREL64 =28; // 64-bit PC relative offset to GOT entry
R_X86_64_GOTPC64 =29; // 64-bit PC relative offset to GOT
R_X86_64_GOTPLT64 =30; // like GOT64, says PLT entry needed
R_X86_64_PLTOFF64 =31; // 64-bit GOT relative offset to PLT entry
R_X86_64_SIZE32 =32; // Size of symbol plus 32-bit addend
R_X86_64_SIZE64 =33; // Size of symbol plus 64-bit addend
R_X86_64_GOTPC32_TLSDESC =34; // GOT offset for TLS descriptor
R_X86_64_TLSDESC_CALL =35; // Marker for call through TLS descriptor
R_X86_64_TLSDESC =36; // TLS descriptor
R_X86_64_IRELATIVE =37; // Adjust indirectly by program base
R_X86_64_RELATIVE64 =38; // 64bit adjust by program base
R_X86_64_ORBIS_GOTPCREL_LOAD =40;
type
Elf64_Addr =cuint64;
Elf64_Half =cuint16;
Elf64_SHalf =cint64 ;
Elf64_Off =cuint64;
Elf64_Sword =cint32 ;
Elf64_Word =cuint32;
Elf64_Xword =cuint64;
Elf64_Sxword=cint64 ;
Pelf64_hdr=^elf64_hdr;
elf64_hdr=packed record
e_ident:Array[0..EI_NIDENT-1] of Byte; // ELF "magic number"
e_type :Elf64_Half;
e_machine :Elf64_Half;
e_version :Elf64_Word;
e_entry :Elf64_Addr; // Entry point virtual address from where the process starts executing.
e_phoff :Elf64_Off ; // Program header table file offset
e_shoff :Elf64_Off ; // Section header table file offset
e_flags :Elf64_Word;
e_ehsize :Elf64_Half;
e_phentsize:Elf64_Half;
e_phnum :Elf64_Half;
e_shentsize:Elf64_Half;
e_shnum :Elf64_Half;
e_shstrndx :Elf64_Half;
end;
const
PF_W=$2;
PF_R=$4;
PF_X=$1;
type
Pelf64_phdr=^elf64_phdr;
elf64_phdr=packed record
p_type :Elf64_Word ;
p_flags :Elf64_Word ;
p_offset:Elf64_Off ; // Segment file offset
p_vaddr :Elf64_Addr ; // Segment virtual address
p_paddr :Elf64_Addr ; // Segment physical address
p_filesz:Elf64_Xword; // Segment size in file
p_memsz :Elf64_Xword; // Segment size in memory
p_align :Elf64_Xword; // Segment alignment, file & memory
end;
elf64_shdr=packed record
sh_name :Elf64_Word ; // Section name, index in string tbl
sh_type :Elf64_Word ; // Type of section
sh_flags :Elf64_Xword; // Miscellaneous section attributes
sh_addr :Elf64_Addr ; // Section virtual addr at execution
sh_offset :Elf64_Off ; // Section file offset
sh_size :Elf64_Xword; // Size of section in bytes
sh_link :Elf64_Word ; // Index of another section
sh_info :Elf64_Word ; // Additional section information
sh_addralign:Elf64_Xword; // Section alignment
sh_entsize :Elf64_Xword; // Entry size if section holds table
end;
PElf64_Dyn=^Elf64_Dyn;
Elf64_Dyn=packed record
d_tag:Elf64_Sxword; // entry tag value
d_un:packed record
Case Byte of
0:(d_val:Elf64_Xword);
1:(d_ptr:Elf64_Addr);
end;
end;
Pelf64_rela=^elf64_rela;
elf64_rela=packed record
r_offset:Elf64_Addr; // Location at which to apply the action
r_info:Elf64_Xword; // index and type of relocation
r_addend:Elf64_Sxword; // Constant addend used to compute value
end;
Pelf64_sym=^elf64_sym;
elf64_sym=packed record
st_name :Elf64_Word; // Symbol name, index in string tbl
st_info :Byte; // Type and binding attributes
st_other:Byte; // No defined meaning, 0
st_shndx:Elf64_Half; // Associated section index
st_value:Elf64_Addr; // Value of the symbol
st_size :Elf64_Xword; // Associated symbol size
end;
const
self_magic=$1D3D154F;
type
Pself_header=^Tself_header;
Tself_header=packed record
Magic:DWORD; //Magic 4F 15 3D 1D
Unknown:DWORD; //Unknown Always 00 01 01 12
Content_Type:Byte; //Content Type 1 on Self, 4 on PUP Entry
Program_Type:Byte; //Program Type
Padding:Word; //Padding
Header_Size:Word; //Header Size
Sign_Size:Word; //Signature Size Metadata Size?
Size_of:DWORD; //Size of SELF
Padding2:DWORD; //Padding
Num_Segments:Word; //Number of Segments
Unknown2:Word; //Unknown Always 0x22
Padding3:DWORD; //Padding
end;
const
SF_ORDR = $1; // ordered?
SF_ENCR = $2; // encrypted
SF_SIGN = $4; // signed
SF_DFLG = $8; // deflated
SF_BFLG = $800; // block segment
type
Pself_segment=^Tself_segment;
Tself_segment=packed record
flags,
offset,
encrypted_compressed_size, //fileSz
decrypted_decompressed_size:QWORD; //memSz
end;
Tself_spec=packed record
AuthorityID:QWORD;
Program_Type:QWORD;
Version1:QWORD;
Version2:QWORD;
Content_ID:array[0..31] of Byte;
Digest_SHA_256:array[0..31] of Byte;
end;
const
SCE_DBG_MAX_NAME_LENGTH = 256;
SCE_DBG_MAX_SEGMENTS = 4;
SCE_DBG_NUM_FINGERPRINT = 20;
type
TKernelModuleSegmentInfo=packed record
address:Pointer;
size:DWORD;
prot:Integer; //PF_
end;
PKernelModuleInfo=^TKernelModuleInfo;
TKernelModuleInfo=packed record
size:QWORD; //Size of this structure
name:array[0..SCE_DBG_MAX_NAME_LENGTH-1] of AnsiChar; //module name
segmentInfo:array[0..SCE_DBG_MAX_SEGMENTS-1] of TKernelModuleSegmentInfo;
segmentCount:DWORD;
fingerprint:array[0..SCE_DBG_NUM_FINGERPRINT-1] of Byte;
end;
TModuleValue=packed record
case Byte of
0:(value:Int64);
1:(name_offset:DWORD;
version_minor:Byte;
version_major:Byte;
id:Word);
end;
TLibraryValue=packed record
case Byte of
0:(value:Int64);
1:(name_offset:DWORD;
version_minor:Byte;
version_major:Byte;
id:Word);
end;
PsceModuleParam=^TsceModuleParam;
TsceModuleParam=packed record
Size:QWORD;
Magic:QWORD;
SDK_version:QWORD;
end;
PTLS_index=^TLS_index;
TLS_index=packed record
ti_moduleid :QWORD;
ti_tlsoffset:QWORD;
end;
PPS4StartupParams=^TPS4StartupParams;
TPS4StartupParams=packed record
argc:Integer;
align:Integer;
argv:array[0..1] of Pointer;
end;
Const
PHYSICAL_PAGE_SIZE=$1000;
GRANULAR_PAGE_SIZE=$10000;
LOGICAL_PAGE_SIZE =$4000;
SCE_KERNEL_PAGE_SIZE=$4000;
STB_LOCAL =0;
STB_GLOBAL=1;
STB_WEAK =2;
STT_NOTYPE =0 ;
STT_OBJECT =1 ;
STT_FUN =2 ;
STT_SECTION =3 ;
STT_FILE =4 ;
STT_COMMON =5 ;
STT_TLS =6;
STT_LOOS =10;
STT_HIOS =12;
STT_LOPRO =13;
STT_SPARC_REGISTER=13;
STT_HIPROC =15;
STV_DEFAULT =0;
STV_INTERNAL =1;
STV_HIDDEN =2;
STV_PROTECTED =3;
SHN_UNDEF=0;
function ELF64_R_SYM(i:QWORD):DWORD; inline;
function ELF64_R_TYPE(i:QWORD):DWORD; inline;
function ELF64_ST_BIND(i:Byte):Byte; inline;
function ELF64_ST_TYPE(i:Byte):Byte; inline;
function ELF64_ST_VISIBILITY(i:Byte):Byte; inline;
function AlignUp(addr:PtrUInt;alignment:PtrUInt):PtrUInt; inline;
function AlignUp(addr:Pointer;alignment:PtrUInt):Pointer; inline;
function AlignDw(addr:PtrUInt;alignment:PtrUInt):PtrUInt; inline;
function AlignDw(addr:Pointer;alignment:PtrUInt):Pointer; inline;
function IsAlign(Addr:Pointer;Alignment:PtrUInt):Boolean; inline;
function IsAlign(Addr:PtrUInt;Alignment:PtrUInt):Boolean; inline;
type
Ptimespec=^timespec;
timespec=packed record
tv_sec:Int64; /// seconds
tv_nsec:Int64; /// nanoseconds
end;
timeval = record
tv_sec: int64;
tv_usec: int64; //microsecond
end;
Ptimeval=^timeval;
timezone = record
tz_minuteswest:Integer;
tz_dsttime:Integer;
end;
Ptimezone=^timezone;
TMemChunk=packed record
pAddr:Pointer;
nSize:Int64;
end;
implementation
function ELF64_R_SYM(i:QWORD):DWORD; inline;
begin
Result:=i shr 32;
end;
function ELF64_R_TYPE(i:QWORD):DWORD; inline;
begin
Result:=i and $ffffffff;
end;
function ELF64_ST_BIND(i:Byte):Byte; inline;
begin
Result:=i shr 4;
end;
function ELF64_ST_TYPE(i:Byte):Byte; inline;
begin
Result:=i and $f;
end;
function ELF64_ST_VISIBILITY(i:Byte):Byte; inline;
begin
Result:=i and 3;
end;
function AlignUp(addr:PtrUInt;alignment:PtrUInt):PtrUInt; inline;
var
tmp:PtrUInt;
begin
if (alignment=0) then Exit(addr);
tmp:=addr+PtrUInt(alignment-1);
Result:=tmp-(tmp mod alignment)
end;
function AlignUp(addr:Pointer;alignment:PtrUInt):Pointer; inline;
begin
Result:=Pointer(Align(PtrUInt(addr),alignment));
end;
function AlignDw(addr:PtrUInt;alignment:PtrUInt):PtrUInt; inline;
begin
Result:=addr-(addr mod alignment);
end;
function AlignDw(addr:Pointer;alignment:PtrUInt):Pointer; inline;
begin
Result:=Pointer(AlignDw(PtrUInt(addr),alignment));
end;
function IsAlign(Addr:Pointer;Alignment:PtrUInt):Boolean; inline;
begin
Result:=(PtrUInt(addr) mod alignment)=0;
end;
function IsAlign(Addr:PtrUInt;Alignment:PtrUInt):Boolean; inline;
begin
Result:=(addr mod alignment)=0;
end;
end.

252
trace_manager.pas Normal file
View File

@ -0,0 +1,252 @@
unit trace_manager;
{$mode objfpc}{$H+}
interface
uses
stub_manager,
ps4_program,
ps4libdoc;
type
PTraceInfo=^TTraceInfo;
TTraceInfo=packed record
nid:QWORD;
lib:PLIBRARY;
origin:Pointer;
trace_enter:Pointer;
trace_exit:Pointer;
end;
TStubMemoryTrace=object(TStubMemory)
function NewTraceStub(nid:QWORD;lib,proc,trace_enter,trace_exit:Pointer):Pointer;
end;
procedure _set_trace_local_print(enable:Boolean);
procedure _trace_enter(info:PTraceInfo;src:Pointer); MS_ABI_Default;
function _trace_exit(info:PTraceInfo):Pointer; MS_ABI_Default;
implementation
type
P_trace_cb_stub=^T_trace_cb_stub;
T_trace_cb_stub=packed record
info:TTraceInfo;
stub:array[0..96] of Byte;
end;
const
_trace_cb_stub:T_trace_cb_stub=(
info:(
nid:0;
lib:nil;
origin:nil;
trace_enter:nil;
trace_exit:nil);
stub:(
$50, //push %rax
$51, //push %rcx
$52, //push %rdx
$41,$50, //push %r8
$41,$51, //push %r9
$41,$52, //push %r10
$41,$53, //push %r11
$48,$8b,$54,$24,$38, //mov 0x38(%rsp),%rdx
$48,$8d,$0d,$c1,$ff,$ff,$ff, //lea -0x3f(%rip),%rcx
$ff,$15,$d3,$ff,$ff,$ff, //callq *-0x2d(%rip)
$41,$5b, //pop %r11
$41,$5a, //pop %r10
$41,$59, //pop %r9
$41,$58, //pop %r8
$5a, //pop %rdx
$59, //pop %rcx
$58, //pop %rax
$48,$8d,$64,$24,$08, //lea 0x8(%rsp),%rsp
$ff,$15,$b5,$ff,$ff,$ff, //callq *-0x4b(%rip)
$48,$8d,$64,$24,$f8, //lea -0x8(%rsp),%rsp
$50, //push %rax
$51, //push %rcx
$52, //push %rdx
$41,$50, //push %r8
$41,$51, //push %r9
$41,$52, //push %r10
$41,$53, //push %r11
$48,$8d,$0d,$8e,$ff,$ff,$ff, //lea -0x72(%rip),%rcx
$ff,$15,$a8,$ff,$ff,$ff, //callq *-0x58(%rip)
$48,$89,$44,$24,$38, //mov %rax,0x38(%rsp)
$41,$5b, //pop %r11
$41,$5a, //pop %r10
$41,$59, //pop %r9
$41,$58, //pop %r8
$5a, //pop %rdx
$59, //pop %rcx
$58, //pop %rax
$c3 //retq
);
);
{
.quad 0 //nid:QWORD; //-40
.quad 0 //lib:PLIBRARY; //-32
.quad 0 //origin //-24
.quad 0 //trace_enter //-16
.quad 0 //trace_exit //-8
50 push %rax
51 push %rcx
52 push %rdx
4150 push %r8
4151 push %r9
4152 push %r10
4153 push %r11
488b542438 mov 0x38(%rsp),%rdx
488d0dc1ffffff lea -0x3f(%rip),%rcx
ff15d3ffffff callq *-0x2d(%rip)
415b pop %r11
415a pop %r10
4159 pop %r9
4158 pop %r8
5a pop %rdx
59 pop %rcx
58 pop %rax
488d642408 lea 0x8(%rsp),%rsp
ff15b5ffffff callq *-0x4b(%rip)
488d6424f8 lea -0x8(%rsp),%rsp
50 push %rax
51 push %rcx
52 push %rdx
4150 push %r8
4151 push %r9
4152 push %r10
4153 push %r11
488d0d8effffff lea -0x72(%rip),%rcx
ff15a8ffffff callq *-0x58(%rip)
4889442438 mov %rax,0x38(%rsp)
415b pop %r11
415a pop %r10
4159 pop %r9
4158 pop %r8
5a pop %rdx
59 pop %rcx
58 pop %rax
c3 retq
}
{
asm
.quad 0 //nid:QWORD; //-40
.quad 0 //lib:PLIBRARY; //-32
.quad 0 //origin //-24
.quad 0 //trace_enter //-16
.quad 0 //trace_exit //-8
push %rax //[1] +8
push %rcx //[1] +16
push %rdx //[1] +24
push %r8 //[2] +32
push %r9 //[2] +40
push %r10 //[2] +48
push %r11 //[2] +56
mov 0x38(%rsp),%rdx //[5] [param 2] load call src:+56
lea -0x3F(%rip),%rcx //[7] [param 1] func info:-40 offset:-23
callq -0x2D(%rip) //[6] trace_enter:-16 offset:-29
pop %r11 //[2]
pop %r10 //[2]
pop %r9 //[2]
pop %r8 //[2]
pop %rdx //[1]
pop %rcx //[1]
pop %rax //[1]
lea 0x8(%rsp),%rsp //[5] move stack back
callq -0x4B(%rip) //[6] call origin:-24 offset:-51
lea -0x8(%rsp),%rsp //[5] move stack forward
push %rax //[1] +8
push %rcx //[1] +16
push %rdx //[1] +24
push %r8 //[2] +32
push %r9 //[2] +40
push %r10 //[2] +48
push %r11 //[2] +56
lea -0x72(%rip),%rcx //[7] [param 1] func info:-40 offset:-74
callq -0x58(%rip) //[6] trace_exit:-8 offset:-80
mov %rax,0x38(%rsp) //[5] [result] store call src:+56
pop %r11 //[2]
pop %r10 //[2]
pop %r9 //[2]
pop %r8 //[2]
pop %rdx //[1]
pop %rcx //[1]
pop %rax //[1]
ret
end;
}
function TStubMemoryTrace.NewTraceStub(nid:QWORD;lib,proc,trace_enter,trace_exit:Pointer):Pointer;
var
buf:T_trace_cb_stub;
begin
if (trace_enter=nil) or (trace_exit=nil) then Exit(proc);
buf:=_trace_cb_stub;
buf.info.nid :=nid;
buf.info.lib :=lib;
buf.info.origin :=proc;
buf.info.trace_enter:=trace_enter;
buf.info.trace_exit :=trace_exit;
Result:=NewStub(@buf,SizeOf(T_trace_cb_stub));
Result:=Result+SizeOf(TTraceInfo);
end;
threadvar
trace_local:record
enable:Boolean;
stack:array of Pointer;
end;
procedure _set_trace_local_print(enable:Boolean);
begin
trace_local.enable:=enable;
end;
procedure _trace_enter(info:PTraceInfo;src:Pointer); MS_ABI_Default;
var
i:Integer;
begin
//if trace_local.enable then
Writeln(GetCurrentThreadId,':>',info^.lib^.strName,':',ps4libdoc.GetFunctName(info^.nid));
i:=Length(trace_local.stack);
SetLength(trace_local.stack,i+1);
trace_local.stack[i]:=src;
end;
function _trace_exit(info:PTraceInfo):Pointer; MS_ABI_Default;
var
i:Integer;
begin
//if trace_local.enable then
Writeln(GetCurrentThreadId,':<',info^.lib^.strName,':',ps4libdoc.GetFunctName(info^.nid));
i:=Length(trace_local.stack);
Assert(i<>0);
i:=i-1;
Result:=trace_local.stack[i];
SetLength(trace_local.stack,i);
end;
end.

86
vulkan/vBuffer.pas Normal file
View File

@ -0,0 +1,86 @@
unit vBuffer;
{$mode objfpc}{$H+}
interface
uses
vulkan,
vDevice,
vMemory;
type
TvBuffer=class
FHandle:TVkBuffer;
FSize:TVkDeviceSize;
FUsage:TVkFlags;
Constructor Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
Destructor Destroy; override;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
end;
implementation
Constructor TvBuffer.Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
var
cinfo:TVkBufferCreateInfo;
r:TVkResult;
begin
FSize:=size;
FUsage:=usage;
cinfo:=Default(TVkBufferCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_BUFFER_CREATE_INFO;
cinfo.size :=size;
cinfo.usage:=usage;
cinfo.sharingMode:=VK_SHARING_MODE_EXCLUSIVE;
cinfo.pNext:=ext;
r:=vkCreateBuffer(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateBuffer:',r);
Exit;
end;
end;
Destructor TvBuffer.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyBuffer(Device.FHandle,FHandle,nil);
end;
function TvBuffer.GetRequirements:TVkMemoryRequirements;
begin
Result:=Default(TVkMemoryRequirements);
vkGetBufferMemoryRequirements(Device.FHandle,FHandle,@Result);
end;
function TvBuffer.GetDedicatedAllocation:Boolean;
var
info:TVkBufferMemoryRequirementsInfo2;
rmem:TVkMemoryRequirements2;
rded:TVkMemoryDedicatedRequirements;
begin
Result:=false;
if Pointer(vkGetImageMemoryRequirements2)=nil then Exit;
info:=Default(TVkBufferMemoryRequirementsInfo2);
info.sType:=VK_STRUCTURE_TYPE_BUFFER_MEMORY_REQUIREMENTS_INFO_2;
info.buffer:=FHandle;
rmem:=Default(TVkMemoryRequirements2);
rmem.sType:=VK_STRUCTURE_TYPE_MEMORY_REQUIREMENTS_2;
rded:=Default(TVkMemoryDedicatedRequirements);
rded.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS;
rmem.pNext:=@rded;
vkGetBufferMemoryRequirements2(Device.FHandle,@info,@rmem);
Result:=(rded.requiresDedicatedAllocation<>VK_FALSE) or
(rded.prefersDedicatedAllocation <>VK_FALSE);
end;
function TvBuffer.BindMem(P:TvPointer):TVkResult;
begin
Result:=vkBindBufferMemory(Device.FHandle,FHandle,P.FHandle,P.FOffset);
end;
end.

860
vulkan/vCmdBuffer.pas Normal file
View File

@ -0,0 +1,860 @@
unit vCmdBuffer;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
RWLock,
//ps4_types,
g23tree,
//ps4_libSceVideoOut,
si_ci_vi_merged_enum,
vulkan,
vDevice,
vMemory,
//vShader,
//vShaderExt,
vImage,
vPipeline,
//vSetsPools,
vRender;
type
TvCmdBuffer=class;
TvReleaseCb=procedure(Sender:TObject) of object;
TvReleaseCompare=object
function c(a,b:TvReleaseCb):Integer; static;
end;
TvRelease=specialize T23treeSet<TvReleaseCb,TvReleaseCompare>;
TObjectCompare=object
function c(a,b:TObject):Integer; static;
end;
TObjectSet=specialize T23treeSet<TObject,TObjectCompare>;
TObjectSetLock=object(TObjectSet)
lock:TRWLock;
Procedure Init;
Procedure Lock_rd;
Procedure Lock_wr;
Procedure Unlock;
function Insert(Const K:TObject):Boolean;
Function Contains(Const K:TObject):Boolean;
Function delete(Const R:TObject):Boolean;
Function Release(Const R:TObject):Boolean;
end;
TvSemaphoreWait=record
FSemaphore:TvSemaphore;
FWaitStage:TVkPipelineStageFlags;
end;
TvSemaphoreWaitCompare=object
function c(a,b:TvSemaphoreWait):Integer; static;
end;
TvSemaphoreWaitSet=specialize T23treeSet<TvSemaphoreWait,TvSemaphoreWaitCompare>;
TvImageBarrierCompare=object
function c(a,b:TvImageBarrier):Integer; static;
end;
TvImageBarrierSet=specialize T23treeSet<TvImageBarrier,TvImageBarrierCompare>;
TvCustomCmdBuffer=class
parent:TvCmdPool;
FQueue:TvQueue;
cmdbuf:TVkCommandBuffer;
FCurrPipeline:array[0..1] of TVkPipeline;
FCurrLayout:array[0..1] of TVkPipelineLayout;
FRenderPass:TVkRenderPass;
FDependence:TvRelease;
FWaitSemaphores:TvSemaphoreWaitSet;
SignalSemaphore:TvSemaphore;
Fence:TvFence;
FCBState:Boolean;
FImageBarriers:TvImageBarrierSet;
Constructor Create(pool:TvCmdPool;Queue:TvQueue);
Destructor Destroy; override;
function BeginCmdBuffer:Boolean;
Procedure EndCmdBuffer;
Procedure BindPipeline(BindPoint:TVkPipelineBindPoint;F:TVkPipeline);
Function IsRenderPass:Boolean;
Procedure EndRenderPass;
Procedure QueueSubmit;
Procedure ReleaseResource;
function AddDependence(cb:TvReleaseCb):Boolean;
Procedure AddWaitSemaphore(S:TvSemaphore;W:TVkPipelineStageFlags);
Procedure SetImageBarrier(image:TVkImage;
range:TVkImageSubresourceRange;
AccessMask:TVkAccessFlags;
ImageLayout:TVkImageLayout;
StageMask:TVkPipelineStageFlags);
Procedure PushImageBarrier(image:TVkImage;
range:TVkImageSubresourceRange;
dstAccessMask:TVkAccessFlags;
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags);
Procedure BindLayout(BindPoint:TVkPipelineBindPoint;F:TvPipelineLayout);
Procedure BindSet(BindPoint:TVkPipelineBindPoint;fset:TVkUInt32;FHandle:TVkDescriptorSet);
Procedure PushConstant(BindPoint:TVkPipelineBindPoint;stageFlags:TVkShaderStageFlags;offset,size:TVkUInt32;const pValues:PVkVoid);
Procedure DispatchDirect(X,Y,Z:TVkUInt32);
end;
TvCmdBuffer=class(TvCustomCmdBuffer)
emulate_primtype:Integer;
function BeginRenderPass(RT:TvRenderTargets):Boolean;
Procedure BindSets(BindPoint:TVkPipelineBindPoint;F:TvDescriptorGroup);
Procedure dmaData(src,dst:Pointer;byteCount:DWORD;isBlocking:Boolean);
Procedure dmaData(src:DWORD;dst:Pointer;byteCount:DWORD;isBlocking:Boolean);
Procedure writeAtEndOfShader(eventType:Byte;dst:Pointer;value:DWORD);
Procedure DrawIndex2(Addr:Pointer;INDICES:DWORD;INDEX_TYPE:TVkIndexType);
Procedure DrawIndexAuto(INDICES:DWORD);
end;
implementation
uses
vBuffer,
vHostBufferManager;
function TvReleaseCompare.c(a,b:TvReleaseCb):Integer;
begin
Result:=Integer(TMethod(a).Code>TMethod(b).Code)-Integer(TMethod(a).Code<TMethod(b).Code);
if (Result<>0) then Exit;
Result:=Integer(TMethod(a).Data>TMethod(b).Data)-Integer(TMethod(a).Data<TMethod(b).Data);
end;
function TObjectCompare.c(a,b:TObject):Integer;
begin
Result:=Integer(Pointer(a)>Pointer(b))-Integer(Pointer(a)<Pointer(b));
end;
function TvSemaphoreWaitCompare.c(a,b:TvSemaphoreWait):Integer;
begin
Result:=Integer(Pointer(a.FSemaphore)>Pointer(b.FSemaphore))-Integer(Pointer(a.FSemaphore)<Pointer(b.FSemaphore));
end;
function TvImageBarrierCompare.c(a,b:TvImageBarrier):Integer;
begin
//1 image
Result:=Integer(a.image>b.image)-Integer(a.image<b.image);
if (Result<>0) then Exit;
//2 range
Result:=CompareByte(a.range,b.range,SizeOf(TVkImageSubresourceRange));
end;
Procedure TObjectSetLock.Init;
begin
rwlock_init(lock);
end;
Procedure TObjectSetLock.Lock_rd;
begin
rwlock_rdlock(lock);
end;
Procedure TObjectSetLock.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TObjectSetLock.Unlock;
begin
rwlock_unlock(lock);
end;
function TObjectSetLock.Insert(Const K:TObject):Boolean;
begin
Lock_wr;
Result:=inherited;
Unlock;
end;
Function TObjectSetLock.Contains(Const K:TObject):Boolean;
begin
Lock_rd;
Result:=inherited;
Unlock;
end;
Function TObjectSetLock.delete(Const R:TObject):Boolean;
begin
Lock_wr;
Result:=inherited;
Unlock;
end;
Function TObjectSetLock.Release(Const R:TObject):Boolean;
begin
Lock_wr;
inherited;
Result:=(Size=0);
Unlock;
end;
Constructor TvCustomCmdBuffer.Create(pool:TvCmdPool;Queue:TvQueue);
begin
parent:=pool;
FQueue:=Queue;
cmdbuf:=pool.Alloc;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
Fence:=TvFence.Create(true);
FCBState:=False;
end;
Destructor TvCustomCmdBuffer.Destroy;
begin
if (parent<>nil) and (cmdbuf<>VK_NULL_HANDLE) then
begin
parent.Free(cmdbuf);
end;
ReleaseResource;
FreeAndNil(Fence);
inherited;
end;
function TvCustomCmdBuffer.BeginCmdBuffer:Boolean;
var
r:TVkResult;
Info:TVkCommandBufferBeginInfo;
begin
Result:=False;
if (Self=nil) then Exit;
if FCBState then Exit(True);
if (cmdbuf=VK_NULL_HANDLE) then Exit;
Info:=Default(TVkCommandBufferBeginInfo);
Info.sType:=VK_STRUCTURE_TYPE_COMMAND_BUFFER_BEGIN_INFO;
Info.flags:=ord(VK_COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT);
Info.pInheritanceInfo:=nil;
r:=vkBeginCommandBuffer(cmdbuf,@Info);
if (r<>VK_SUCCESS) then
begin
Writeln('vkBeginCommandBuffer:',r);
Exit;
end;
FCBState:=True;
Result:=True;
end;
Procedure TvCustomCmdBuffer.EndCmdBuffer;
var
r:TVkResult;
begin
if (Self=nil) then Exit;
if FCBState then
begin
EndRenderPass;
FCurrLayout[0]:=VK_NULL_HANDLE;
FCurrLayout[1]:=VK_NULL_HANDLE;
FCurrPipeline[0]:=VK_NULL_HANDLE;
FCurrPipeline[1]:=VK_NULL_HANDLE;
r:=vkEndCommandBuffer(cmdbuf);
if (r<>VK_SUCCESS) then
begin
Writeln('vkEndCommandBuffer:',r);
end;
FCBState:=False;
end;
end;
Procedure TvCustomCmdBuffer.BindPipeline(BindPoint:TVkPipelineBindPoint;F:TVkPipeline);
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FCurrPipeline[ord(BindPoint)]=F) then Exit;
if (not BeginCmdBuffer) then Exit;
vkCmdBindPipeline(cmdbuf,BindPoint,F);
FCurrPipeline[ord(BindPoint)]:=F;
end;
function TvCmdBuffer.BeginRenderPass(RT:TvRenderTargets):Boolean;
var
info:TVkRenderPassBeginInfo;
begin
Result:=False;
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (RT=nil) then
begin
EndRenderPass;
Exit(True);
end;
if (RT.FRenderPass=nil) then Exit;
if (RT.FPipeline=nil) then Exit;
if (RT.FFramebuffer=nil) then Exit;
if (not RT.FRenderPass.Compile) then Exit;
if (not RT.FPipeline.Compile) then Exit;
if (not RT.FFramebuffer.Compile) then Exit;
if (RT.FRenderPass.FHandle=FRenderPass) then Exit(True);
if (not BeginCmdBuffer) then Exit;
EndRenderPass;
info:=RT.GetInfo;
FCurrPipeline[0]:=RT.FPipeline.FHandle;
FCurrLayout [0]:=RT.FPipeline.FShaderGroup.FLayout.FHandle;
emulate_primtype:=RT.FPipeline.emulate_primtype;
vkCmdBeginRenderPass(cmdbuf,@info,VK_SUBPASS_CONTENTS_INLINE);
vkCmdBindPipeline (cmdbuf,VK_PIPELINE_BIND_POINT_GRAPHICS,FCurrPipeline[0]);
AddDependence(@RT.Release);
FRenderPass:=info.renderPass;
Result:=True;
end;
Function TvCustomCmdBuffer.IsRenderPass:Boolean;
begin
Result:=False;
if (Self=nil) then Exit;
Result:=(FRenderPass<>VK_NULL_HANDLE);
end;
Procedure TvCustomCmdBuffer.EndRenderPass;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FRenderPass<>VK_NULL_HANDLE) then
begin
vkCmdEndRenderPass(cmdbuf);
FRenderPass:=VK_NULL_HANDLE;
end;
end;
Procedure TvCustomCmdBuffer.QueueSubmit;
var
r:TVkResult;
info:TVkSubmitInfo;
FFence:TVkFence;
FHandles:array of TVkSemaphore;
FStages:array of TVkPipelineStageFlags;
i:Integer;
t:TvSemaphoreWaitSet.Iterator;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
EndCmdBuffer;
info:=Default(TVkSubmitInfo);
info.sType :=VK_STRUCTURE_TYPE_SUBMIT_INFO;
info.commandBufferCount :=1;
info.pCommandBuffers :=@cmdbuf;
if (FWaitSemaphores.Size<>0) then
begin
FHandles:=nil;
SetLength(FHandles,FWaitSemaphores.Size);
SetLength(FStages ,FWaitSemaphores.Size);
i:=0;
t:=FWaitSemaphores.cbegin;
While (t.Item<>nil) do
begin
FHandles[i]:=t.Item^.FSemaphore.FHandle;
FStages [i]:=t.Item^.FWaitStage;
Inc(i);
t.Next;
end;
info.waitSemaphoreCount:=i;
info.pWaitSemaphores :=@FHandles[0];
info.pWaitDstStageMask :=@FStages[0];
end;
if (SignalSemaphore<>nil) then
begin
info.signalSemaphoreCount:=1;
info.pSignalSemaphores :=@SignalSemaphore.FHandle;
end;
FFence:=VK_NULL_HANDLE;
if (Fence<>nil) then
begin
FFence:=Fence.FHandle;
end;
r:=FQueue.QueueSubmit(1,@info,FFence);
if (r<>VK_SUCCESS) then
begin
Writeln('vkQueueSubmit');
exit;
end;
end;
Procedure TvCustomCmdBuffer.ReleaseResource;
var
It:TvRelease.Iterator;
begin
if (Self=nil) then Exit;
It:=FDependence.cbegin;
if (It.Item<>nil) then
repeat
TvReleaseCb(It.Item^)(Self);
until not It.Next;
//repeat
// It:=FDependence.cbegin;
// if (It.Item=nil) then Break;
// FDependence.erase(It);
//until false;
FDependence.Free;
FWaitSemaphores.Free;
FImageBarriers .Free;
end;
function TvCustomCmdBuffer.AddDependence(cb:TvReleaseCb):Boolean;
begin
Result:=False;
if (cb=nil) then Exit;
Result:=FDependence.Insert(cb);
end;
Procedure TvCustomCmdBuffer.AddWaitSemaphore(S:TvSemaphore;W:TVkPipelineStageFlags);
Var
I:TvSemaphoreWaitSet.Iterator;
F:TvSemaphoreWait;
begin
if (S=nil) then Exit;
F:=Default(TvSemaphoreWait);
F.FSemaphore:=S;
F.FWaitStage:=W;
I:=FWaitSemaphores.find(F);
if (i.Item<>nil) then
begin
i.Item^.FWaitStage:=i.Item^.FWaitStage or W;
end else
begin
FWaitSemaphores.Insert(F);
end;
end;
Procedure TvCustomCmdBuffer.SetImageBarrier(image:TVkImage;
range:TVkImageSubresourceRange;
AccessMask:TVkAccessFlags;
ImageLayout:TVkImageLayout;
StageMask:TVkPipelineStageFlags);
var
i:TvImageBarrierSet.Iterator;
t:TvImageBarrier;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
t:=Default(TvImageBarrier);
t.image :=image;
t.range :=range;
t.AccessMask:=AccessMask;
t.ImgLayout :=ImageLayout;
t.StageMask :=StageMask;
i:=FImageBarriers.find(t);
if (i.Item=nil) then
begin
FImageBarriers.Insert(t);
end;
end;
Procedure TvCustomCmdBuffer.PushImageBarrier(image:TVkImage;
range:TVkImageSubresourceRange;
dstAccessMask:TVkAccessFlags;
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags);
var
i:TvImageBarrierSet.Iterator;
t:TvImageBarrier;
p:PvImageBarrier;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
t:=Default(TvImageBarrier);
t.Init(image,range);
i:=FImageBarriers.find(t);
p:=i.Item;
if (p=nil) then
begin
FImageBarriers.Insert(t);
i:=FImageBarriers.find(t);
p:=i.Item;
end;
P^.Push(cmdbuf,
dstAccessMask,
newImageLayout,
dstStageMask);
end;
Procedure TvCustomCmdBuffer.BindLayout(BindPoint:TVkPipelineBindPoint;F:TvPipelineLayout);
begin
if (Self=nil) then Exit;
if (F=nil) then Exit;
FCurrLayout[ord(BindPoint)]:=F.FHandle;
end;
Procedure TvCustomCmdBuffer.BindSet(BindPoint:TVkPipelineBindPoint;fset:TVkUInt32;FHandle:TVkDescriptorSet);
begin
if (Self=nil) then Exit;
if (FHandle=VK_NULL_HANDLE) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FCurrLayout[ord(BindPoint)]=VK_NULL_HANDLE) then Exit;
vkCmdBindDescriptorSets(cmdbuf,
BindPoint,
FCurrLayout[ord(BindPoint)],
fset,1,
@FHandle,
0,nil);
end;
Procedure TvCustomCmdBuffer.PushConstant(BindPoint:TVkPipelineBindPoint;stageFlags:TVkShaderStageFlags;offset,size:TVkUInt32;const pValues:PVkVoid);
begin
if (Self=nil) then Exit;
if (pValues=nil) or (size=0) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FCurrLayout[ord(BindPoint)]=VK_NULL_HANDLE) then Exit;
vkCmdPushConstants(cmdbuf,
FCurrLayout[ord(BindPoint)],
stageFlags,
offset,size,
pValues);
end;
Procedure TvCustomCmdBuffer.DispatchDirect(X,Y,Z:TVkUInt32);
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FCurrPipeline[1]=VK_NULL_HANDLE) then Exit;
vkCmdDispatch(cmdbuf,X,Y,Z);
end;
Procedure TvCmdBuffer.BindSets(BindPoint:TVkPipelineBindPoint;F:TvDescriptorGroup);
var
i:Integer;
begin
if (F=nil) then Exit;
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FCurrLayout[ord(BindPoint)]=VK_NULL_HANDLE) then Exit;
if (Length(F.FSets)=0) then Exit;
For i:=0 to High(F.FSets) do
if F.FSets[i].IsValid then
begin
vkCmdBindDescriptorSets(cmdbuf,
BindPoint,
FCurrLayout[ord(BindPoint)],
i,1,
@F.FSets[i].FHandle,
0,nil);
end;
end;
Const
VK_ACCESS_ANY=
ord(VK_ACCESS_INDIRECT_COMMAND_READ_BIT ) or
ord(VK_ACCESS_INDEX_READ_BIT ) or
ord(VK_ACCESS_VERTEX_ATTRIBUTE_READ_BIT ) or
ord(VK_ACCESS_UNIFORM_READ_BIT ) or
ord(VK_ACCESS_INPUT_ATTACHMENT_READ_BIT ) or
ord(VK_ACCESS_SHADER_READ_BIT ) or
ord(VK_ACCESS_SHADER_WRITE_BIT ) or
ord(VK_ACCESS_COLOR_ATTACHMENT_READ_BIT ) or
ord(VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT ) or
ord(VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_READ_BIT ) or
ord(VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT) or
ord(VK_ACCESS_TRANSFER_READ_BIT ) or
ord(VK_ACCESS_TRANSFER_WRITE_BIT ) or
ord(VK_ACCESS_HOST_READ_BIT ) or
ord(VK_ACCESS_HOST_WRITE_BIT ) or
ord(VK_ACCESS_MEMORY_READ_BIT ) or
ord(VK_ACCESS_MEMORY_WRITE_BIT );
Procedure TvCmdBuffer.dmaData(src,dst:Pointer;byteCount:DWORD;isBlocking:Boolean);
var
srcb,dstb:TvHostBuffer;
info:TVkBufferCopy;
begin
if (Self=nil) then Exit;
EndRenderPass;
BeginCmdBuffer;
srcb:=FetchHostBuffer(Self,src,byteCount,ord(VK_BUFFER_USAGE_TRANSFER_SRC_BIT));
Assert(srcb<>nil);
dstb:=FetchHostBuffer(Self,dst,byteCount,ord(VK_BUFFER_USAGE_TRANSFER_DST_BIT));
Assert(dstb<>nil);
vkBufferMemoryBarrier(cmdbuf,
srcb.FHandle,
VK_ACCESS_ANY,
ord(VK_ACCESS_TRANSFER_READ_BIT),
srcb.Foffset,byteCount,
ord(VK_PIPELINE_STAGE_ALL_COMMANDS_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
vkBufferMemoryBarrier(cmdbuf,
dstb.FHandle,
VK_ACCESS_ANY,
ord(VK_ACCESS_TRANSFER_WRITE_BIT),
dstb.Foffset,byteCount,
ord(VK_PIPELINE_STAGE_ALL_COMMANDS_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
info:=Default(TVkBufferCopy);
info.srcOffset:=srcb.Foffset;
info.dstOffset:=dstb.Foffset;
info.size :=byteCount;
vkCmdCopyBuffer(cmdbuf,
srcb.FHandle,
dstb.FHandle,
1,@info);
if isBlocking then
begin
vkBarrier(cmdbuf,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT),
ord(VK_PIPELINE_STAGE_ALL_COMMANDS_BIT));
end;
end;
Procedure TvCmdBuffer.dmaData(src:DWORD;dst:Pointer;byteCount:DWORD;isBlocking:Boolean);
var
dstb:TvHostBuffer;
begin
if (Self=nil) then Exit;
EndRenderPass;
BeginCmdBuffer;
dstb:=FetchHostBuffer(Self,dst,byteCount,ord(VK_BUFFER_USAGE_TRANSFER_DST_BIT));
Assert(dstb<>nil);
vkBufferMemoryBarrier(cmdbuf,
dstb.FHandle,
VK_ACCESS_ANY,
ord(VK_ACCESS_TRANSFER_WRITE_BIT),
dstb.Foffset,byteCount,
ord(VK_PIPELINE_STAGE_ALL_COMMANDS_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
vkCmdFillBuffer(cmdbuf,
dstb.FHandle,
dstb.Foffset,
byteCount div 4,src);
if isBlocking then
begin
vkBarrier(cmdbuf,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT),
ord(VK_PIPELINE_STAGE_ALL_COMMANDS_BIT));
end;
end;
Procedure TvCmdBuffer.writeAtEndOfShader(eventType:Byte;dst:Pointer;value:DWORD);
var
rb:TvHostBuffer;
begin
if (Self=nil) then Exit;
EndRenderPass;
BeginCmdBuffer;
Case eventType of
CS_DONE:
begin
vkBarrier(cmdbuf,
ord(VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
rb:=FetchHostBuffer(Self,dst,4,ord(VK_BUFFER_USAGE_TRANSFER_DST_BIT));
Assert(rb<>nil);
vkCmdFillBuffer(cmdbuf,
rb.FHandle,
rb.Foffset,
4,value);
end;
PS_DONE:
begin
vkBarrier(cmdbuf,
ord(VK_PIPELINE_STAGE_FRAGMENT_SHADER_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
rb:=FetchHostBuffer(Self,dst,4,ord(VK_BUFFER_USAGE_TRANSFER_DST_BIT));
Assert(rb<>nil);
vkCmdFillBuffer(cmdbuf,
rb.FHandle,
rb.Foffset,
4,value);
end;
else
Assert(False);
end;
end;
function GET_INDEX_TYPE_SIZE(INDEX_TYPE:TVkIndexType):Byte;
begin
Case INDEX_TYPE of
VK_INDEX_TYPE_UINT16 :Result:=16;
VK_INDEX_TYPE_UINT32 :Result:=32;
VK_INDEX_TYPE_UINT8_EXT:Result:=8;
else Result:=0;
end;
end;
Procedure TvCmdBuffer.DrawIndex2(Addr:Pointer;INDICES:DWORD;INDEX_TYPE:TVkIndexType);
var
//rb:TURHostBuffer;
rb:TvHostBuffer;
Size:TVkDeviceSize;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FRenderPass=VK_NULL_HANDLE) then Exit;
if (FCurrPipeline[0]=VK_NULL_HANDLE) then Exit;
if (emulate_primtype<>0) then Assert(false,'TODO');
Size:=INDICES*GET_INDEX_TYPE_SIZE(INDEX_TYPE);
rb:=FetchHostBuffer(Self,Addr,Size,ord(VK_BUFFER_USAGE_INDEX_BUFFER_BIT));
//rb:=FetchHostBuffer(Addr,Size,ord(VK_BUFFER_USAGE_INDEX_BUFFER_BIT));
Assert(rb<>nil);
vkCmdBindIndexBuffer(
cmdbuf,
rb{.FHostBuf}.FHandle,
rb.Foffset,
INDEX_TYPE);
vkCmdDrawIndexed(
cmdbuf,
INDICES,
1,0,0,0);
end;
Procedure TvCmdBuffer.DrawIndexAuto(INDICES:DWORD);
var
i,h:DWORD;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (FRenderPass=VK_NULL_HANDLE) then Exit;
if (FCurrPipeline[0]=VK_NULL_HANDLE) then Exit;
Case emulate_primtype of
0:
begin
vkCmdDraw(
cmdbuf,
INDICES,
1,0,0);
end;
DI_PT_RECTLIST :
begin
{
0 3
1 2
}
//0 1 2
//0 2 3
h:=INDICES div 3;
if (h>0) then h:=h-1;
For i:=0 to h do
begin
vkCmdDraw(
cmdbuf,
4,
1,
0,
0);
end;
end;
//DI_PT_LINELOOP :;
DI_PT_QUADLIST :
begin
h:=INDICES div 4;
if (h>0) then h:=h-1;
For i:=0 to h do
begin
vkCmdDraw(
cmdbuf,
4,
1,
i*4,
0);
end;
end;
//DI_PT_QUADSTRIP:;
//DI_PT_POLYGON :;
else
begin
Assert(false,'TODO');
end;
end;
end;
end.

570
vulkan/vDevice.pas
View File

@ -7,17 +7,25 @@ interface
uses
SysUtils,
Math,
atomic,
spinlock,
Vulkan;
type
TVulkanApp=class
FInstance:TVkInstance;
FPhysicalDevice:TVkPhysicalDevice;
//
FGFamily:TVkUInt32;
FCFamily:TVkUInt32;
FTFamily:TVkUInt32;
//
FGFamilyCount:TVkUInt32;
FCFamilyCount:TVkUInt32;
FTFamilyCount:TVkUInt32;
//
FDeviceFeature:TVkPhysicalDeviceFeatures;
Constructor Create(debug,validate:Boolean);
Constructor Create(debug,printf,validate:Boolean);
Destructor Destroy; override;
Procedure LoadFamily; virtual;
function InstanceLayersIsExist(P:PChar):Boolean;
@ -32,10 +40,9 @@ type
procedure ReportCallback(flags:TVkDebugReportFlagsEXT;
objectType:TVkDebugReportObjectTypeEXT;
object_:TVkUInt64;
location:TVkSize;
messageCode:TVkInt32;
const pLayerPrefix:PVkChar;
const pMessage:PVkChar); virtual;
location:DWORD;
pLayerPrefix:PVkChar;
pMessage:PVkChar); virtual;
end;
TvSurface=class
@ -56,11 +63,19 @@ type
pQueue:PVkQueue;
end;
PAbstractFeature=^TAbstractFeature;
TAbstractFeature=record
sType:TVkStructureType;
pNext:PVkVoid;
end;
TvDeviceQueues=class
data:array of TSortQueueRec;
exts:array of Pchar;
pFeature:PVkVoid;
procedure add_queue(Index:TVkUInt32;Queue:PVkQueue);
procedure add_ext(P:Pchar);
procedure add_feature(P:PVkVoid);
end;
TvDevice=class
@ -69,7 +84,15 @@ type
Destructor Destroy; override;
end;
TCmdPool=class
TvQueue=class
FHandle:TVkQueue;
FLock:Pointer;
function QueueSubmit(submitCount:TVkUInt32;const pSubmits:PVkSubmitInfo;fence:TVkFence):TVkResult;
function QueueWaitIdle:TVkResult;
function QueuePresentKHR(const pPresentInfo:PVkPresentInfoKHR):TVkResult;
end;
TvCmdPool=class
FHandle:TVkCommandPool;
Constructor Create(FFamily:TVkUInt32);
Destructor Destroy; override;
@ -92,7 +115,15 @@ type
Destructor Destroy; override;
end;
procedure PrintPhysicalDeviceProperties(physicalDevice:TVkPhysicalDevice);
TvEvent=class
FHandle:TVkEvent;
Constructor Create;
Destructor Destroy; override;
function SetEvent:TVkResult;
function ResetEvent:TVkResult;
function Status:TVkResult;
end;
procedure PrintInstanceExtension;
procedure PrintDeviceExtension(physicalDevice:TVkPhysicalDevice);
procedure PrintQueueFamily(physicalDevice:TVkPhysicalDevice);
@ -126,30 +157,108 @@ procedure vkBufferMemoryBarrier(
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
procedure vkMemoryBarrier(
cmdbuffer:TVkCommandBuffer;
srcAccessMask:TVkAccessFlags;
dstAccessMask:TVkAccessFlags;
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
procedure vkBarrier(
cmdbuffer:TVkCommandBuffer;
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
var
VulkanApp:TVulkanApp;
DebugReport:TVDebugReport;
Device:TvDevice;
FlipQueue:TVkQueue;
RenderQueue:TVkQueue;
FlipQueue:TvQueue;
RenderQueue:TvQueue;
Procedure InitVulkan;
function IsInitVulkan:Boolean;
function shaderStorageImageExtendedFormats:Boolean;
function shaderStorageImageReadWithoutFormat:Boolean;
function shaderStorageImageWriteWithoutFormat:Boolean;
function shaderInt64:Boolean;
function shaderInt16:Boolean;
var
limits:record
VK_KHR_swapchain :Boolean;
VK_EXT_external_memory_host :Boolean;
VK_KHR_16bit_storage :Boolean;
VK_KHR_8bit_storage :Boolean;
VK_KHR_push_descriptor :Boolean;
VK_KHR_shader_non_semantic_info:Boolean;
VK_EXT_index_type_uint8 :Boolean;
VK_EXT_scalar_block_layout :Boolean;
VK_AMD_device_coherent_memory :Boolean;
maxUniformBufferRange:TVkUInt32;
maxStorageBufferRange:TVkUInt32;
maxPushConstantsSize:TVkUInt32;
maxSamplerLodBias:TVkFloat;
maxSamplerAnisotropy:TVkFloat;
minMemoryMapAlignment:TVkSize;
minTexelBufferOffsetAlignment:TVkDeviceSize;
minUniformBufferOffsetAlignment:TVkDeviceSize;
minStorageBufferOffsetAlignment:TVkDeviceSize;
framebufferColorSampleCounts:TVkSampleCountFlags;
framebufferDepthSampleCounts:TVkSampleCountFlags;
framebufferStencilSampleCounts:TVkSampleCountFlags;
sampledImageColorSampleCounts:TVkSampleCountFlags;
sampledImageIntegerSampleCounts:TVkSampleCountFlags;
sampledImageDepthSampleCounts:TVkSampleCountFlags;
sampledImageStencilSampleCounts:TVkSampleCountFlags;
storageImageSampleCounts:TVkSampleCountFlags;
maxComputeWorkGroupInvocations:TVkUInt32;
maxComputeWorkGroupSize:TVkOffset3D;
minImportedHostPointerAlignment:TVkDeviceSize;
end;
implementation
uses
vMemory;
type
TSortIndex=object
max:Integer;
data:array of TVkDeviceQueueCreateInfo;
procedure add(Index:TVkUInt32);
end;
function shaderStorageImageExtendedFormats:Boolean;
begin
Result:=Boolean(VulkanApp.FDeviceFeature.shaderStorageImageExtendedFormats);
end;
procedure PrintPhysicalDeviceProperties(physicalDevice:TVkPhysicalDevice);
function shaderStorageImageReadWithoutFormat:Boolean;
begin
Result:=Boolean(VulkanApp.FDeviceFeature.shaderStorageImageReadWithoutFormat);
end;
function shaderStorageImageWriteWithoutFormat:Boolean;
begin
Result:=Boolean(VulkanApp.FDeviceFeature.shaderStorageImageWriteWithoutFormat);
end;
function shaderInt64:Boolean;
begin
Result:=Boolean(VulkanApp.FDeviceFeature.shaderInt64);
end;
function shaderInt16:Boolean;
begin
Result:=Boolean(VulkanApp.FDeviceFeature.shaderInt16);
end;
procedure FillDeviceProperties(physicalDevice:TVkPhysicalDevice);
var
prop:TVkPhysicalDeviceProperties2;
memh:TVkPhysicalDeviceExternalMemoryHostPropertiesEXT;
@ -163,10 +272,71 @@ begin
vkGetPhysicalDeviceProperties2(physicalDevice,@prop);
Writeln('minImportedHostPointerAlignment=',memh.minImportedHostPointerAlignment);
limits.maxUniformBufferRange :=prop.properties.limits.maxUniformBufferRange;
limits.maxStorageBufferRange :=prop.properties.limits.maxStorageBufferRange;
limits.maxPushConstantsSize :=prop.properties.limits.maxPushConstantsSize;
limits.maxSamplerLodBias :=prop.properties.limits.maxSamplerLodBias;
limits.maxSamplerAnisotropy :=prop.properties.limits.maxSamplerAnisotropy;
limits.minMemoryMapAlignment :=prop.properties.limits.minMemoryMapAlignment;
limits.minTexelBufferOffsetAlignment :=prop.properties.limits.minTexelBufferOffsetAlignment;
limits.minUniformBufferOffsetAlignment:=prop.properties.limits.minUniformBufferOffsetAlignment;
limits.minStorageBufferOffsetAlignment:=prop.properties.limits.minStorageBufferOffsetAlignment;
limits.framebufferColorSampleCounts :=prop.properties.limits.framebufferColorSampleCounts;
limits.framebufferDepthSampleCounts :=prop.properties.limits.framebufferDepthSampleCounts;
limits.framebufferStencilSampleCounts :=prop.properties.limits.framebufferStencilSampleCounts;
limits.sampledImageColorSampleCounts :=prop.properties.limits.sampledImageColorSampleCounts;
limits.sampledImageIntegerSampleCounts:=prop.properties.limits.sampledImageIntegerSampleCounts;
limits.sampledImageDepthSampleCounts :=prop.properties.limits.sampledImageDepthSampleCounts;
limits.sampledImageStencilSampleCounts:=prop.properties.limits.sampledImageStencilSampleCounts;
limits.storageImageSampleCounts :=prop.properties.limits.storageImageSampleCounts;
limits.maxComputeWorkGroupInvocations :=prop.properties.limits.maxComputeWorkGroupInvocations;
limits.maxComputeWorkGroupSize :=TVkOffset3D(prop.properties.limits.maxComputeWorkGroupSize);
limits.minImportedHostPointerAlignment:=memh.minImportedHostPointerAlignment;
end;
procedure FillDeviceExtension(physicalDevice:TVkPhysicalDevice);
var
i,count:TVkUInt32;
pProperties:PVkExtensionProperties;
begin
Writeln;
count:=0;
vkEnumerateDeviceExtensionProperties(physicalDevice,nil,@count,nil);
if (count<>0) then
begin
pProperties:=GetMem(count*SizeOf(TVkExtensionProperties));
vkEnumerateDeviceExtensionProperties(physicalDevice,nil,@count,pProperties);
For i:=0 to count-1 do
begin
Case String(pProperties[i].extensionName) of
VK_KHR_SWAPCHAIN_EXTENSION_NAME :limits.VK_KHR_swapchain :=True;
VK_EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME :limits.VK_EXT_external_memory_host :=True;
VK_KHR_16BIT_STORAGE_EXTENSION_NAME :limits.VK_KHR_16bit_storage :=True;
VK_KHR_8BIT_STORAGE_EXTENSION_NAME :limits.VK_KHR_8bit_storage :=True;
VK_KHR_PUSH_DESCRIPTOR_EXTENSION_NAME :limits.VK_KHR_push_descriptor :=True;
VK_KHR_SHADER_NON_SEMANTIC_INFO_EXTENSION_NAME:limits.VK_KHR_shader_non_semantic_info:=True;
VK_EXT_INDEX_TYPE_UINT8_EXTENSION_NAME :limits.VK_EXT_index_type_uint8 :=True;
VK_EXT_SCALAR_BLOCK_LAYOUT_EXTENSION_NAME :limits.VK_EXT_scalar_block_layout :=True;
VK_AMD_DEVICE_COHERENT_MEMORY_EXTENSION_NAME :limits.VK_AMD_device_coherent_memory :=True;
end;
end;
FreeMem(pProperties);
end;
end;
type
TSortIndex=object
max:Integer;
data:array of TVkDeviceQueueCreateInfo;
procedure add(Index:TVkUInt32);
end;
procedure PrintInstanceExtension;
var
i,count:TVkUInt32;
@ -257,7 +427,7 @@ function MyDebugReportCallback(flags:TVkDebugReportFlagsEXT;
pUserData:PVkVoid):TVkBool32; {$ifdef Windows}stdcall;{$else}{$ifdef Android}{$ifdef cpuarm}hardfloat;{$else}cdecl;{$endif}{$else}cdecl;{$endif}{$endif}
begin
TVDebugReport(pUserData).ReportCallback(
flags,objectType,object_,location,messageCode,pLayerPrefix,pMessage);
flags,objectType,object_,location,pLayerPrefix,pMessage);
Result:=TVkBool32(False);
end;
@ -281,6 +451,9 @@ begin
ord(VK_DEBUG_REPORT_ERROR_BIT_EXT ){ or
ord(VK_DEBUG_REPORT_DEBUG_BIT_EXT )};
cinfo.pfnCallback:=@MyDebugReportCallback;
cinfo.pUserData:=Pointer(Self);
r:=FCreateDebugReportCallback(VulkanApp.FInstance,@cinfo,nil,@FHandle);
@ -303,13 +476,50 @@ end;
procedure TVDebugReport.ReportCallback(flags:TVkDebugReportFlagsEXT;
objectType:TVkDebugReportObjectTypeEXT;
object_:TVkUInt64;
location:TVkSize;
messageCode:TVkInt32;
const pLayerPrefix:PVkChar;
const pMessage:PVkChar);
location:DWORD;
pLayerPrefix:PVkChar;
pMessage:PVkChar);
var
i:Integer;
begin
if Pos('which is greater than buffer size (4)',pMessage)=0 then
Writeln({objectType,':',pLayerPrefix,':',}pMessage);
Case objectType of
VK_DEBUG_REPORT_OBJECT_TYPE_SHADER_MODULE_EXT:
Case DWORD(location) of
$0609A13B:
begin
if Pos('not consumed by fragment shader',pMessage)<>0 then Exit;
if Pos('fragment shader writes to output location 0 with no matching attachment',pMessage)<>0 then Exit;
end;
end;
VK_DEBUG_REPORT_OBJECT_TYPE_DEVICE_EXT:
Case DWORD(location) of
$A7BB8DB6:if Pos('(Float16)',pMessage)<>0 then Exit;
$92394C89:
begin
i:=Pos('|',pMessage);
if (i<>0) then
begin
pMessage:=@pMessage[i];
i:=Pos('|',pMessage);
if (i<>0) then
begin
pMessage:=@pMessage[i-1];
end;
end;
end;
else;
end;
else;
end;
Writeln(pMessage);
end;
function vkGetPhysicalDevice4Type(pPhysicalDevices:PVkPhysicalDevice;count:TVkUInt32;deviceType:TVkPhysicalDeviceType):TVkPhysicalDevice;
@ -347,6 +557,7 @@ begin
Writeln('apiVersion:',VK_VERSION_MAJOR(deviceProperties.apiVersion),'.',
VK_VERSION_MINOR(deviceProperties.apiVersion),'.',
VK_VERSION_PATCH(deviceProperties.apiVersion));
Writeln('-----------');
end;
Result:=vkGetPhysicalDevice4Type(pPhysicalDevices,count,VK_PHYSICAL_DEVICE_TYPE_DISCRETE_GPU);
if (Result=VK_NULL_HANDLE) then
@ -358,9 +569,23 @@ begin
Result:=pPhysicalDevices[0];
end;
FreeMem(pPhysicalDevices);
Writeln('Select GPU:');
deviceProperties:=Default(TVkPhysicalDeviceProperties);
vkGetPhysicalDeviceProperties(Result,@deviceProperties);
Writeln(deviceProperties.deviceName);
Writeln('apiVersion:',VK_VERSION_MAJOR(deviceProperties.apiVersion),'.',
VK_VERSION_MINOR(deviceProperties.apiVersion),'.',
VK_VERSION_PATCH(deviceProperties.apiVersion));
end;
Constructor TVulkanApp.Create(debug,validate:Boolean);
function VK_MAKE_API_VERSION(const variant,major,minor,patch:longint):longint;
begin
result:=(variant shl 29) or (major shl 22) or (minor shl 12) or (patch);
end;
Constructor TVulkanApp.Create(debug,printf,validate:Boolean);
const
dlayer='VK_LAYER_KHRONOS_validation';
var
@ -368,6 +593,8 @@ var
vkExtList:array[0..2] of PChar;
vkLayer:array[0..0] of PChar;
vkCInfo:TVkInstanceCreateInfo;
vkPrintf:TVkValidationFeaturesEXT;
vkFeature:TVkValidationFeatureEnableEXT;
r:TVkResult;
begin
vkApp:=Default(TVkApplicationInfo);
@ -376,7 +603,7 @@ begin
vkApp.applicationVersion:=VK_MAKE_VERSION(1, 0, 0);
vkApp.pEngineName :=nil;
vkApp.engineVersion :=VK_MAKE_VERSION(1, 0, 0);
vkApp.apiVersion :=VK_API_VERSION_1_1;
vkApp.apiVersion :={VK_API_VERSION_1_1;} VK_MAKE_API_VERSION(0, 1, 1, 0);
vkExtList[0]:=VK_KHR_SURFACE_EXTENSION_NAME;
vkExtList[1]:=VK_KHR_WIN32_SURFACE_EXTENSION_NAME;
@ -400,6 +627,18 @@ begin
end;
vkCInfo.ppEnabledExtensionNames:=@vkExtList;
if debug and printf then
begin
vkFeature:=VK_VALIDATION_FEATURE_ENABLE_DEBUG_PRINTF_EXT;
vkPrintf:=Default(TVkValidationFeaturesEXT);
vkPrintf.sType:=VK_STRUCTURE_TYPE_VALIDATION_FEATURES_EXT;
vkPrintf.enabledValidationFeatureCount:=1;
vkPrintf.pEnabledValidationFeatures:=@vkFeature;
vkCInfo.pNext:=@vkPrintf;;
end;
r:=vkCreateInstance(@vkCInfo,nil,@FInstance);
if (r<>VK_SUCCESS) then
begin
@ -470,6 +709,7 @@ begin
if not (gLoad in bLoaded) then
begin
FGFamily:=i;
FGFamilyCount:=pQueue[i].queueCount;
bLoaded:=bLoaded+[gLoad];
end;
end else
@ -478,6 +718,7 @@ begin
if not (cLoad in bLoaded) then
begin
FCFamily:=i;
FCFamilyCount:=pQueue[i].queueCount;
bLoaded:=bLoaded+[cLoad];
end;
end else
@ -486,6 +727,7 @@ begin
if not (tLoad in bLoaded) then
begin
FTFamily:=i;
FTFamilyCount:=pQueue[i].queueCount;
bLoaded:=bLoaded+[tLoad];
end;
end;
@ -496,6 +738,7 @@ begin
if (pQueue[i].queueFlags and ord(VK_QUEUE_COMPUTE_BIT))<>0 then
begin
FCFamily:=i;
FCFamilyCount:=pQueue[i].queueCount;
Break;
end;
end;
@ -505,6 +748,7 @@ begin
if (pQueue[i].queueFlags and ord(VK_QUEUE_TRANSFER_BIT))<>0 then
begin
FTFamily:=i;
FTFamilyCount:=pQueue[i].queueCount;
Break;
end;
end;
@ -686,6 +930,12 @@ begin
exts[i]:=P;
end;
procedure TvDeviceQueues.add_feature(P:PVkVoid);
begin
PAbstractFeature(P)^.pNext:=pFeature;
pFeature:=P;
end;
procedure TSortIndex.add(Index:TVkUInt32);
var
i,count:Integer;
@ -722,6 +972,7 @@ begin
DeviceInfo:=Default(TVkDeviceCreateInfo);
DeviceInfo.sType:=VK_STRUCTURE_TYPE_DEVICE_CREATE_INFO;
DeviceInfo.pEnabledFeatures:=@DeviceFeature;
DeviceInfo.pNext:=Queues.pFeature;
DeviceInfo.enabledExtensionCount:=Length(Queues.exts);
if (DeviceInfo.enabledExtensionCount<>0) then
@ -770,7 +1021,30 @@ end;
//
Constructor TCmdPool.Create(FFamily:TVkUInt32);
function TvQueue.QueueSubmit(submitCount:TVkUInt32;const pSubmits:PVkSubmitInfo;fence:TVkFence):TVkResult;
begin
spin_lock(FLock);
Result:=vkQueueSubmit(FHandle,submitCount,pSubmits,fence);
spin_unlock(FLock);
end;
function TvQueue.QueueWaitIdle:TVkResult;
begin
spin_lock(FLock);
Result:=vkQueueWaitIdle(FHandle);
spin_unlock(FLock);
end;
function TvQueue.QueuePresentKHR(const pPresentInfo:PVkPresentInfoKHR):TVkResult;
begin
spin_lock(FLock);
Result:=vkQueuePresentKHR(FHandle,pPresentInfo);
spin_unlock(FLock);
end;
//
Constructor TvCmdPool.Create(FFamily:TVkUInt32);
var
cinfo:TVkCommandPoolCreateInfo;
r:TVkResult;
@ -787,12 +1061,12 @@ begin
end;
end;
Destructor TCmdPool.Destroy;
Destructor TvCmdPool.Destroy;
begin
vkDestroyCommandPool(Device.FHandle,FHandle,nil);
end;
function TCmdPool.Alloc:TVkCommandBuffer;
function TvCmdPool.Alloc:TVkCommandBuffer;
var
ainfo:TVkCommandBufferAllocateInfo;
r:TVkResult;
@ -811,11 +1085,13 @@ begin
end;
end;
procedure TCmdPool.Free(cmd:TVkCommandBuffer);
procedure TvCmdPool.Free(cmd:TVkCommandBuffer);
begin
vkFreeCommandBuffers(Device.FHandle,FHandle,1,@cmd);
end;
//
Constructor TvFence.Create(signaled:Boolean);
var
cinfo:TVkFenceCreateInfo;
@ -852,6 +1128,8 @@ begin
Result:=vkGetFenceStatus(Device.FHandle,FHandle);
end;
//
Constructor TvSemaphore.Create;
var
cinfo:TVkSemaphoreCreateInfo;
@ -866,6 +1144,39 @@ begin
vkDestroySemaphore(Device.FHandle,FHandle,nil);
end;
//
Constructor TvEvent.Create;
var
cinfo:TVkEventCreateInfo;
begin
cinfo:=Default(TVkEventCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_EVENT_CREATE_INFO;
vkCreateEvent(Device.FHandle,@cinfo,nil,@FHandle);
end;
Destructor TvEvent.Destroy;
begin
vkDestroyEvent(Device.FHandle,FHandle,nil);
end;
function TvEvent.SetEvent:TVkResult;
begin
Result:=vkSetEvent(Device.FHandle,FHandle);
end;
function TvEvent.ResetEvent:TVkResult;
begin
Result:=vkResetEvent(Device.FHandle,FHandle);
end;
function TvEvent.Status:TVkResult;
begin
Result:=vkGetEventStatus(Device.FHandle,FHandle);
end;
//
procedure vkImageMemoryBarrier(
cmdbuffer:TVkCommandBuffer;
image:TVkImage;
@ -877,16 +1188,16 @@ procedure vkImageMemoryBarrier(
dstStageMask:TVkPipelineStageFlags;
subresourceRange:TVkImageSubresourceRange);
var
imageMemoryBarrier:TVkImageMemoryBarrier;
info:TVkImageMemoryBarrier;
begin
imageMemoryBarrier:=Default(TVkImageMemoryBarrier);
imageMemoryBarrier.sType :=VK_STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER;
imageMemoryBarrier.srcAccessMask :=srcAccessMask;
imageMemoryBarrier.dstAccessMask :=dstAccessMask;
imageMemoryBarrier.oldLayout :=oldImageLayout;
imageMemoryBarrier.newLayout :=newImageLayout;
imageMemoryBarrier.image :=image;
imageMemoryBarrier.subresourceRange:=subresourceRange;
info:=Default(TVkImageMemoryBarrier);
info.sType :=VK_STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER;
info.srcAccessMask :=srcAccessMask;
info.dstAccessMask :=dstAccessMask;
info.oldLayout :=oldImageLayout;
info.newLayout :=newImageLayout;
info.image :=image;
info.subresourceRange:=subresourceRange;
vkCmdPipelineBarrier(
cmdbuffer,
@ -895,7 +1206,7 @@ begin
0,
0, nil,
0, nil,
1, @imageMemoryBarrier);
1, @info);
end;
procedure vkBufferMemoryBarrier(
@ -907,17 +1218,17 @@ procedure vkBufferMemoryBarrier(
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
var
MemoryBarrier:TVkBufferMemoryBarrier;
info:TVkBufferMemoryBarrier;
begin
MemoryBarrier:=Default(TVkBufferMemoryBarrier);
MemoryBarrier.sType:=VK_STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER;
MemoryBarrier.srcAccessMask:=srcAccessMask;
MemoryBarrier.dstAccessMask:=dstAccessMask;
//MemoryBarrier.srcQueueFamilyIndex:TVkUInt32;
//MemoryBarrier.dstQueueFamilyIndex:TVkUInt32;
MemoryBarrier.buffer:=buffer;
MemoryBarrier.offset:=offset;
MemoryBarrier.size:=size;
info:=Default(TVkBufferMemoryBarrier);
info.sType:=VK_STRUCTURE_TYPE_BUFFER_MEMORY_BARRIER;
info.srcAccessMask:=srcAccessMask;
info.dstAccessMask:=dstAccessMask;
//info.srcQueueFamilyIndex:TVkUInt32;
//info.dstQueueFamilyIndex:TVkUInt32;
info.buffer:=buffer;
info.offset:=offset;
info.size:=size;
vkCmdPipelineBarrier(
cmdbuffer,
@ -925,18 +1236,61 @@ begin
dstStageMask,
0,
0, nil,
1, @MemoryBarrier,
1, @info,
0, nil);
end;
procedure vkMemoryBarrier(
cmdbuffer:TVkCommandBuffer;
srcAccessMask:TVkAccessFlags;
dstAccessMask:TVkAccessFlags;
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
var
info:TVkMemoryBarrier;
begin
info:=Default(TVkMemoryBarrier);
info.sType:=VK_STRUCTURE_TYPE_MEMORY_BARRIER;
info.srcAccessMask:=dstAccessMask;
info.dstAccessMask:=dstAccessMask;
vkCmdPipelineBarrier(cmdbuffer,
srcStageMask,
dstStageMask,
0,
1,
@info,
0,
nil,
0,
nil);
end;
procedure vkBarrier(
cmdbuffer:TVkCommandBuffer;
srcStageMask:TVkPipelineStageFlags;
dstStageMask:TVkPipelineStageFlags);
begin
vkCmdPipelineBarrier(cmdbuffer,
srcStageMask,
dstStageMask,
0,
0,
nil,
0,
nil,
0,
nil);
end;
var
_lazy_init:Integer=0;
_lazy_wait:Integer=0;
function IsInitVulkan:Boolean;
begin
Result:=(System.InterLockedExchangeAdd(_lazy_wait,0)<>0);
Result:=(load_acq_rel(_lazy_wait)<>0);
end;
Function TestFFF(F:TVkFormatFeatureFlags):RawByteString;
@ -964,22 +1318,122 @@ Procedure InitVulkan;
var
DeviceQueues:TvDeviceQueues;
//ImgProp:TVkFormatProperties;
features_Shader8 :TVkPhysicalDeviceShaderFloat16Int8Features;
features_Storage8:TVkPhysicalDevice8BitStorageFeaturesKHR;
features_Storage16:TVkPhysicalDevice16BitStorageFeatures;
features_Scalar:TVkPhysicalDeviceScalarBlockLayoutFeatures;
features_Coherent:TVkPhysicalDeviceCoherentMemoryFeaturesAMD;
begin
if System.InterlockedExchange(_lazy_init,1)=0 then
if XCHG(_lazy_init,1)=0 then
begin
VulkanApp:=TVulkanApp.Create(true,true);
VulkanApp:=TVulkanApp.Create(true,true,true);
DebugReport:=TVDebugReport.Create;
MemManager:=TvMemManager.Create;
FillDeviceExtension(VulkanApp.FPhysicalDevice);
FillDeviceProperties(VulkanApp.FPhysicalDevice);
if not limits.VK_KHR_swapchain then
begin
raise Exception.Create('VK_KHR_swapchain not support!');
end;
if not limits.VK_EXT_external_memory_host then
begin
raise Exception.Create('VK_EXT_external_memory_host not support!');
end;
DeviceQueues:=TvDeviceQueues.Create;
DeviceQueues.add_queue(VulkanApp.FGFamily,@FlipQueue);
DeviceQueues.add_queue(VulkanApp.FGFamily,@RenderQueue);
if (VulkanApp.FGFamilyCount>1) then
begin
FlipQueue :=TvQueue.Create;
RenderQueue:=TvQueue.Create;
DeviceQueues.add_queue(VulkanApp.FGFamily,@FlipQueue .FHandle);
DeviceQueues.add_queue(VulkanApp.FGFamily,@RenderQueue.FHandle);
end else
begin
FlipQueue :=TvQueue.Create;
RenderQueue:=FlipQueue;
DeviceQueues.add_queue(VulkanApp.FGFamily,@FlipQueue .FHandle);
end;
DeviceQueues.add_ext(VK_KHR_SWAPCHAIN_EXTENSION_NAME);
DeviceQueues.add_ext(VK_EXT_EXTERNAL_MEMORY_HOST_EXTENSION_NAME);
if limits.VK_AMD_device_coherent_memory then
begin
DeviceQueues.add_ext(VK_AMD_DEVICE_COHERENT_MEMORY_EXTENSION_NAME);
features_Coherent:=Default(TVkPhysicalDeviceCoherentMemoryFeaturesAMD);
features_Coherent.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_COHERENT_MEMORY_FEATURES_AMD;
features_Coherent.deviceCoherentMemory:=VK_TRUE;
DeviceQueues.add_feature(@features_Coherent);
end;
//if limits.VK_KHR_push_descriptor then
//begin
// DeviceQueues.add_ext(VK_KHR_PUSH_DESCRIPTOR_EXTENSION_NAME);
//end;
if limits.VK_KHR_shader_non_semantic_info then
begin
DeviceQueues.add_ext(VK_KHR_SHADER_NON_SEMANTIC_INFO_EXTENSION_NAME);
end;
if limits.VK_EXT_scalar_block_layout then
begin
DeviceQueues.add_ext(VK_EXT_SCALAR_BLOCK_LAYOUT_EXTENSION_NAME);
features_Scalar:=Default(TVkPhysicalDeviceScalarBlockLayoutFeatures);
features_Scalar.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_SCALAR_BLOCK_LAYOUT_FEATURES;
features_Scalar.scalarBlockLayout:=VK_TRUE;
DeviceQueues.add_feature(@features_Scalar);
end;
if limits.VK_KHR_8bit_storage then
begin
DeviceQueues.add_ext(VK_KHR_8BIT_STORAGE_EXTENSION_NAME);
features_Shader8:=Default(TVkPhysicalDeviceShaderFloat16Int8Features);
features_Shader8.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_SHADER_FLOAT16_INT8_FEATURES;
features_Shader8.shaderInt8:=VK_TRUE;
features_Storage8:=Default(TVkPhysicalDevice8BitStorageFeaturesKHR);
features_Storage8.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_8BIT_STORAGE_FEATURES;
features_Storage8.storageBuffer8BitAccess:=VK_TRUE;
features_Storage8.uniformAndStorageBuffer8BitAccess:=VK_TRUE;
//features_Storage8.storagePushConstant8:=VK_TRUE;
DeviceQueues.add_feature(@features_Shader8);
DeviceQueues.add_feature(@features_Storage8);
end;
if limits.VK_KHR_16bit_storage then
begin
DeviceQueues.add_ext(VK_KHR_16BIT_STORAGE_EXTENSION_NAME);
features_Storage16:=Default(TVkPhysicalDevice16BitStorageFeatures);
features_Storage16.sType:=VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_16BIT_STORAGE_FEATURES;
features_Storage16.storageBuffer16BitAccess:=VK_TRUE;
features_Storage16.uniformAndStorageBuffer16BitAccess:=VK_TRUE;
//features_Storage16.storagePushConstant16:=VK_TRUE;
DeviceQueues.add_feature(@features_Storage16);
end;
Device:=TvDevice.Create(DeviceQueues);
DeviceQueues.Free;
System.InterLockedExchangeAdd(_lazy_wait,1);
XCHG(_lazy_wait,1);
//ImgProp:=Default(TVkFormatProperties);
//vkGetPhysicalDeviceFormatProperties(VulkanApp.FPhysicalDevice,VK_FORMAT_R8G8B8A8_UNORM,@ImgProp);
@ -1006,7 +1460,7 @@ begin
end else
begin
While (System.InterLockedExchangeAdd(_lazy_wait,0)=0) do System.ThreadSwitch;
wait_until_equal(_lazy_wait,0);
end;
end;

751
vulkan/vFlip.pas
View File

File diff suppressed because it is too large Load Diff

199
vulkan/vHostBufferManager.pas Normal file
View File

@ -0,0 +1,199 @@
unit vHostBufferManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
sys_types,
g23tree,
Vulkan,
vMemory,
vBuffer,
vCmdBuffer;
type
TvHostBuffer=class(TvBuffer)
FAddr:Pointer;
Fhost:TvPointer;
Foffset:TVkDeviceSize; //offset inside buffer
//
FRefs:ptruint;
//FDeps:TObjectSetLock;
Procedure Acquire(Sender:TObject);
procedure Release(Sender:TObject);
end;
function FetchHostBuffer(cmd:TvCustomCmdBuffer;Addr:Pointer;Size:TVkDeviceSize;usage:TVkFlags):TvHostBuffer;
implementation
const
buf_ext:TVkExternalMemoryBufferCreateInfo=(
sType:VK_STRUCTURE_TYPE_EXTERNAL_MEMORY_BUFFER_CREATE_INFO;
pNext:nil;
handleTypes:ord(VK_EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT);
);
type
TvAddrCompare=object
function c(a,b:PPointer):Integer; static;
end;
_TvHostBufferPool=specialize T23treeSet<PPointer,TvAddrCompare>;
TvHostBufferPool=object(_TvHostBufferPool)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FHostBufferPool:TvHostBufferPool;
Procedure TvHostBufferPool.Init;
begin
rwlock_init(lock);
end;
Procedure TvHostBufferPool.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvHostBufferPool.Unlock;
begin
rwlock_unlock(lock);
end;
function TvAddrCompare.c(a,b:PPointer):Integer;
begin
Result:=Integer(a^>b^)-Integer(a^<b^);
end;
function _Find(Addr:Pointer):TvHostBuffer;
var
i:TvHostBufferPool.Iterator;
begin
Result:=nil;
i:=FHostBufferPool.find(@Addr);
if (i.Item<>nil) then
begin
Result:=TvHostBuffer(ptruint(i.Item^)-ptruint(@TvHostBuffer(nil).FAddr));
end;
end;
function _New(host:TvPointer;Size:TVkDeviceSize;usage:TVkFlags):TvHostBuffer;
var
t:TvHostBuffer;
mr:TVkMemoryRequirements;
pAlign:TVkDeviceSize;
Foffset:TVkDeviceSize;
begin
t:=TvHostBuffer.Create(Size,usage,@buf_ext);
mr:=t.GetRequirements;
Foffset:=0;
if not IsAlign(host.FOffset,mr.alignment) then
begin
pAlign:=AlignDw(host.FOffset,mr.alignment);
Foffset:=(host.FOffset-pAlign);
host.FOffset:=pAlign;
Size:=Size+Foffset;
FreeAndNil(t);
t:=TvHostBuffer.Create(Size,usage,@buf_ext);
//t.FDeps.Init;
end;
t.Fhost:=host;
t.Foffset:=Foffset;
t.BindMem(host);
Result:=t;
end;
function FetchHostBuffer(cmd:TvCustomCmdBuffer;Addr:Pointer;Size:TVkDeviceSize;usage:TVkFlags):TvHostBuffer;
var
t:TvHostBuffer;
host:TvPointer;
label
_exit;
begin
Result:=nil;
FHostBufferPool.Lock_wr;
t:=_Find(Addr);
if (t<>nil) then
begin
if (t.FSize<Size) or
((t.FUsage and usage)<>usage) then
begin
usage:=usage or t.FUsage;
end;
FHostBufferPool.delete(@t.FAddr);
t.Release(nil);
t:=nil;
end;
if (t=nil) then
begin
host:=Default(TvPointer);
if not TryGetHostPointerByAddr(addr,host) then
begin
Goto _exit;
end;
t:=_New(host,Size,usage);
FHostBufferPool.Insert(@t.FAddr);
t.Acquire(nil);
end;
if (cmd<>nil) and (t<>nil) then
begin
if cmd.AddDependence(@t.Release) then
begin
t.Acquire(cmd);
end;
end;
_exit:
FHostBufferPool.Unlock;
Result:=t;
end;
Procedure TvHostBuffer.Acquire(Sender:TObject);
begin
System.InterlockedIncrement(Pointer(FRefs));
//if (Sender<>nil) then
//begin
// FDeps.Insert(Sender);
//end;
end;
procedure TvHostBuffer.Release(Sender:TObject);
begin
//if (Sender<>nil) then
//begin
// FDeps.delete(Sender);
//end;
if System.InterlockedDecrement(Pointer(FRefs))=nil then
begin
Free;
end;
end;
initialization
FHostBufferPool.Init;
end.

453
vulkan/vImage.pas
View File

@ -24,73 +24,142 @@ type
TvImageView=class
FHandle:TVkImageView;
FRefs:ptruint;
Procedure Acquire;
Procedure Release;
Destructor Destroy; override;
end;
TvImage=class
TvCustomImage=class
FHandle:TVkImage;
Destructor Destroy; override;
function GetImageInfo:TVkImageCreateInfo; virtual; abstract;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
function Compile(ext:Pointer):Boolean;
end;
const
//useage image
TM_READ =1;
TM_WRITE=2;
TM_CLEAR=4;
type
TvExtent3D=packed record
width:Word; //(0..16383)
height:Word; //(0..16383)
depth:Word; //(0..8192)
end;
TvDstSel=bitpacked record
r,g,b,a:0..15; //(0..6)
end;
PvImageKey=^TvImageKey;
TvImageKey=packed object
Addr:Pointer;
cformat:TVkFormat;
params:packed record
itype:Byte; //TVkImageType 0..2
tiling_idx:Byte; //0..31
extend:TvExtent3D;
samples:Byte; //TVkSampleCountFlagBits 1..4
mipLevels:Byte; //(0..15)
arrayLayers:Word; //(0..16383)
end;
end;
PvImageViewKey=^TvImageViewKey;
TvImageViewKey=packed record
cformat:TVkFormat;
vtype:Word; //TVkImageViewType 0..6
dstSel:TvDstSel;
base_level:Byte; //first mip level (0..15)
last_level:Byte; //last mip level (0..15)
base_array:Word; //first array index (0..16383)
last_array:Word; //texture height (0..16383)
end;
TvImage=class(TvCustomImage)
FFormat:TVkFormat;
FUsage:TVkFlags;
FExtent:TVkExtent3D;
Constructor Create(format:TVkFormat;extent:TVkExtent3D;usage:TVkFlags;ext:Pointer=nil);
Destructor Destroy; override;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
function GetCInfo:TVkImageCreateInfo; virtual; abstract;
function GetIVCInfo:TVkImageViewCreateInfo; virtual; abstract;
function GetImageInfo:TVkImageCreateInfo; override;
function GetViewInfo:TVkImageViewCreateInfo; virtual; abstract;
function NewView:TvImageView;
function NewViewF(Format:TVkFormat):TvImageView;
//function NewViewF(Format:TVkFormat):TvImageView;
end;
TvHostImage1D=class(TvImage)
function GetImageInfo:TVkImageCreateInfo; override;
end;
TvHostImage2D=class(TvImage)
function GetCInfo:TVkImageCreateInfo; override;
function GetImageInfo:TVkImageCreateInfo; override;
end;
TvDeviceImage1D=class(TvImage)
function GetViewInfo:TVkImageViewCreateInfo; override;
function GetImageInfo:TVkImageCreateInfo; override;
end;
TvDeviceImage2D=class(TvImage)
function GetIVCInfo:TVkImageViewCreateInfo; override;
function GetCInfo:TVkImageCreateInfo; override;
function GetViewInfo:TVkImageViewCreateInfo; override;
function GetImageInfo:TVkImageCreateInfo; override;
end;
TvBuffer=class
FHandle:TVkBuffer;
FSize:TVkDeviceSize;
FUsage:TVkFlags;
Constructor Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
Destructor Destroy; override;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
end;
//_TvImageViewCompare=object
// function c(const a,b:TvImageView):Integer; static;
//end;
_TvImageViewCompare=object
function c(const a,b:TvImageView):Integer; static;
end;
//_TvImageViewSet=specialize T23treeSet<TvImageView,_TvImageViewCompare>;
_TvImageViewSet=specialize T23treeSet<TvImageView,_TvImageViewCompare>;
AvFramebufferImages=array[0..8] of TvImageView;
AvImageViews=array[0..8] of TVkImageView;
TvFramebuffer=class
FHandle:TVkFramebuffer;
FEdit,FCompile:ptruint;
FRenderPass:TvRenderPass;
FSize:TVkExtent2D;
FImages:_TvImageViewSet;
//FImages:_TvImageViewSet;
FImages:AvFramebufferImages;
FImagesCount:ptruint;
Procedure SetRenderPass(r:TvRenderPass);
Procedure SetSize(Size:TVkExtent2D);
Procedure AddImageView(v:TvImageView);
Procedure ClearImageViews;
Procedure FreeImageViews;
function IsEdit:Boolean;
function Compile:Boolean;
Destructor Destroy; override;
end;
PvImageBarrier=^TvImageBarrier;
TvImageBarrier=object
image:TVkImage;
range:TVkImageSubresourceRange;
//
AccessMask:TVkAccessFlags;
ImgLayout:TVkImageLayout;
StageMask:TVkPipelineStageFlags;
Procedure Init(_image:TVkImage;_sub:TVkImageSubresourceRange);
procedure Push(cmd:TVkCommandBuffer;
dstAccessMask:TVkAccessFlags;
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags);
end;
Function GetAspectMaskByFormat(cformat:TVkFormat):DWORD;
implementation
function _TvImageViewCompare.c(const a,b:TvImageView):Integer;
begin
Result:=CompareByte(a,b,SizeOf(TvImageView));
end;
//function _TvImageViewCompare.c(const a,b:TvImageView):Integer;
//begin
// Result:=Integer(Pointer(a)>Pointer(b))-Integer(Pointer(a)<Pointer(b));
//end;
Procedure TvFramebuffer.SetRenderPass(r:TvRenderPass);
begin
@ -109,27 +178,36 @@ end;
Procedure TvFramebuffer.AddImageView(v:TvImageView);
begin
if (v=nil) then Exit;
if FImages.Contains(v) then Exit;
FImages.Insert(v);
Inc(FEdit);
end;
Procedure TvFramebuffer.ClearImageViews;
begin
FImages.Free;
if (FImagesCount>=Length(AvFramebufferImages)) then Exit;
FImages[FImagesCount]:=v;
Inc(FImagesCount);
v.Acquire;
//if FImages.Contains(v) then Exit;
//v.Acquire;
//FImages.Insert(v);
Inc(FEdit);
end;
Procedure TvFramebuffer.FreeImageViews;
var
It:_TvImageViewSet.Iterator;
// It:_TvImageViewSet.Iterator;
i:Integer;
begin
It:=FImages.cbegin;
if (It.Item<>nil) then
repeat
TvImageView(It.Item^).Free;
until not It.Next;
FImages.Free;
if (FImagesCount<>0) then
For i:=0 to FImagesCount-1 do
if (FImages[i]<>nil) then
begin
FImages[i].Release;
FImages[i]:=nil;
end;
FImagesCount:=0;
//It:=FImages.cbegin;
//if (It.Item<>nil) then
//repeat
// TvImageView(It.Item^).Release;
//until not It.Next;
//FImages.Free;
Inc(FEdit);
end;
@ -141,26 +219,44 @@ end;
function TvFramebuffer.Compile:Boolean;
var
i:TVkUInt32;
It:_TvImageViewSet.Iterator;
v:TvImageView;
//It:_TvImageViewSet.Iterator;
//v:TvImageView;
r:TVkResult;
info:TVkFramebufferCreateInfo;
FImageViews:AvImageViews;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) and (not IsEdit) then Exit(true);
if (not IsEdit) then Exit(true);
if (FRenderPass=nil) then Exit;
if (FRenderPass.FHandle=VK_NULL_HANDLE) then Exit;
if (FSize.width=0) or (FSize.height=0) then Exit;
if (FHandle<>VK_NULL_HANDLE) then
begin
vkDestroyFramebuffer(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
info:=Default(TVkFramebufferCreateInfo);
info.sType :=VK_STRUCTURE_TYPE_FRAMEBUFFER_CREATE_INFO;
info.renderPass :=FRenderPass.FHandle;
info.attachmentCount:=FImages.Size;
info.attachmentCount:={FImages.Size}FImagesCount;
info.width :=FSize.width;
info.height:=FSize.height;
info.layers:=1;
if (info.attachmentCount<>0) then
begin
FImageViews:=Default(AvImageViews);
For i:=0 to FImagesCount-1 do
if (FImages[i]<>nil) then
begin
FImageViews[i]:=FImages[i].FHandle;
end;
info.pAttachments:=@FImageViews;
{
info.pAttachments:=AllocMem(info.attachmentCount*SizeOf(TVkImageView));
i:=0;
It:=FImages.cbegin;
@ -174,6 +270,7 @@ begin
end;
until not It.Next;
info.attachmentCount:=i;
}
end;
if (info.attachmentCount=0) then
@ -190,14 +287,15 @@ begin
Writeln('vkCreateFramebuffer');
end;
if (info.pAttachments<>nil) then
FreeMem(info.pAttachments);
//if (info.pAttachments<>nil) then
// FreeMem(info.pAttachments);
Result:=(r=VK_SUCCESS);
end;
Destructor TvFramebuffer.Destroy;
begin
FreeImageViews;
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyFramebuffer(Device.FHandle,FHandle,nil);
inherited;
@ -312,39 +410,20 @@ begin
vkDestroySwapchainKHR(Device.FHandle,FHandle,nil);
end;
Constructor TvImage.Create(format:TVkFormat;extent:TVkExtent3D;usage:TVkFlags;ext:Pointer=nil);
var
cinfo:TVkImageCreateInfo;
r:TVkResult;
Destructor TvCustomImage.Destroy;
begin
FFormat:=format;
FUsage:=usage;
FExtent:=extent;
cinfo:=GetCInfo;
cinfo.format:=format;
cinfo.extent:=extent;
cinfo.usage :=usage;
cinfo.pNext:=ext;
r:=vkCreateImage(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImage:',r);
Exit;
end;
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyImage(Device.FHandle,FHandle,nil);
inherited;
end;
Destructor TvImage.Destroy;
begin
vkDestroyImage(Device.FHandle,FHandle,nil);
end;
function TvImage.GetRequirements:TVkMemoryRequirements;
function TvCustomImage.GetRequirements:TVkMemoryRequirements;
begin
Result:=Default(TVkMemoryRequirements);
vkGetImageMemoryRequirements(Device.FHandle,FHandle,@Result);
end;
function TvImage.GetDedicatedAllocation:Boolean;
function TvCustomImage.GetDedicatedAllocation:Boolean;
var
info:TVkImageMemoryRequirementsInfo2;
rmem:TVkMemoryRequirements2;
@ -365,11 +444,51 @@ begin
(rded.prefersDedicatedAllocation <>VK_FALSE);
end;
function TvImage.BindMem(P:TvPointer):TVkResult;
function TvCustomImage.BindMem(P:TvPointer):TVkResult;
begin
Result:=vkBindImageMemory(Device.FHandle,FHandle,P.FHandle,P.FOffset);
end;
function TvCustomImage.Compile(ext:Pointer):Boolean;
var
cinfo:TVkImageCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) then
begin
vkDestroyImage(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
cinfo:=GetImageInfo;
cinfo.pNext:=ext;
r:=vkCreateImage(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImage:',r);
Exit;
end;
Result:=True;
end;
Constructor TvImage.Create(format:TVkFormat;extent:TVkExtent3D;usage:TVkFlags;ext:Pointer=nil);
begin
FFormat:=format;
FUsage:=usage;
FExtent:=extent;
Compile(ext);
end;
function TvImage.GetImageInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result.format:=FFormat;
Result.extent:=FExtent;
Result.usage :=FUsage;
end;
function TvImage.NewView:TvImageView;
var
cinfo:TVkImageViewCreateInfo;
@ -377,7 +496,7 @@ var
r:TVkResult;
begin
Result:=nil;
cinfo:=GetIVCInfo;
cinfo:=GetViewInfo;
cinfo.image:=FHandle;
FImg:=VK_NULL_HANDLE;
r:=vkCreateImageView(Device.FHandle,@cinfo,nil,@FImg);
@ -390,6 +509,7 @@ begin
Result.FHandle:=FImg;
end;
{
function TvImage.NewViewF(Format:TVkFormat):TvImageView;
var
cinfo:TVkImageViewCreateInfo;
@ -397,7 +517,7 @@ var
r:TVkResult;
begin
Result:=nil;
cinfo:=GetIVCInfo;
cinfo:=GetViewInfo;
cinfo.image :=FHandle;
cinfo.format:=Format;
FImg:=VK_NULL_HANDLE;
@ -410,15 +530,42 @@ begin
Result:=TvImageView.Create;
Result.FHandle:=FImg;
end;
}
Procedure TvImageView.Acquire;
begin
System.InterlockedIncrement(Pointer(FRefs));
end;
Procedure TvImageView.Release;
begin
if System.InterlockedDecrement(Pointer(FRefs))=nil then
begin
Free;
end;
end;
Destructor TvImageView.Destroy;
begin
vkDestroyImageView(Device.FHandle,FHandle,nil);
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyImageView(Device.FHandle,FHandle,nil);
end;
function TvHostImage2D.GetCInfo:TVkImageCreateInfo;
function TvHostImage1D.GetImageInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result:=inherited;
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_1D;
Result.arrayLayers :=1;
Result.mipLevels :=1;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
Result.samples :=VK_SAMPLE_COUNT_1_BIT;
Result.tiling :=VK_IMAGE_TILING_LINEAR;
end;
function TvHostImage2D.GetImageInfo:TVkImageCreateInfo;
begin
Result:=inherited;
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_2D;
Result.arrayLayers :=1;
@ -430,11 +577,11 @@ end;
//
function TvDeviceImage2D.GetCInfo:TVkImageCreateInfo;
function TvDeviceImage1D.GetImageInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result:=inherited;
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_2D;
Result.imageType :=VK_IMAGE_TYPE_1D;
Result.arrayLayers :=1;
Result.mipLevels :=1;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
@ -442,11 +589,11 @@ begin
Result.tiling :=VK_IMAGE_TILING_OPTIMAL;
end;
function TvDeviceImage2D.GetIVCInfo:TVkImageViewCreateInfo;
function TvDeviceImage1D.GetViewInfo:TVkImageViewCreateInfo;
begin
Result:=Default(TVkImageViewCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO;
Result.viewType :=VK_IMAGE_VIEW_TYPE_2D;
Result.viewType :=VK_IMAGE_VIEW_TYPE_1D;
Result.format :=FFormat;
Result.components.r:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.g:=VK_COMPONENT_SWIZZLE_IDENTITY;
@ -477,62 +624,100 @@ begin
Result.subresourceRange.layerCount :=1;
end;
Constructor TvBuffer.Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
var
cinfo:TVkBufferCreateInfo;
r:TVkResult;
//
function TvDeviceImage2D.GetImageInfo:TVkImageCreateInfo;
begin
FSize:=size;
FUsage:=usage;
cinfo:=Default(TVkBufferCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_BUFFER_CREATE_INFO;
cinfo.size :=size;
cinfo.usage:=usage;
cinfo.sharingMode:=VK_SHARING_MODE_EXCLUSIVE;
cinfo.pNext:=ext;
r:=vkCreateBuffer(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateBuffer:',r);
Exit;
Result:=inherited;
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_2D;
Result.arrayLayers :=1;
Result.mipLevels :=1;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
Result.samples :=VK_SAMPLE_COUNT_1_BIT;
Result.tiling :=VK_IMAGE_TILING_OPTIMAL;
end;
function TvDeviceImage2D.GetViewInfo:TVkImageViewCreateInfo;
begin
Result:=Default(TVkImageViewCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO;
Result.viewType :=VK_IMAGE_VIEW_TYPE_2D;
Result.format :=FFormat;
Result.components.r:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.g:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.b:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.a:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.subresourceRange.aspectMask :=GetAspectMaskByFormat(FFormat);
Result.subresourceRange.baseMipLevel :=0;
Result.subresourceRange.levelCount :=1;
Result.subresourceRange.baseArrayLayer:=0;
Result.subresourceRange.layerCount :=1;
end;
Function GetAspectMaskByFormat(cformat:TVkFormat):DWORD;
begin
Case cformat of
VK_FORMAT_S8_UINT:
Result :=ord(VK_IMAGE_ASPECT_STENCIL_BIT);
VK_FORMAT_D16_UNORM,
VK_FORMAT_X8_D24_UNORM_PACK32,
VK_FORMAT_D32_SFLOAT:
Result :=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
VK_FORMAT_D16_UNORM_S8_UINT,
VK_FORMAT_D24_UNORM_S8_UINT,
VK_FORMAT_D32_SFLOAT_S8_UINT:
Result :=ord(VK_IMAGE_ASPECT_DEPTH_BIT) or ord(VK_IMAGE_ASPECT_STENCIL_BIT);
else
Result :=ord(VK_IMAGE_ASPECT_COLOR_BIT);
end;
end;
Destructor TvBuffer.Destroy;
Procedure TvImageBarrier.Init(_image:TVkImage;_sub:TVkImageSubresourceRange);
begin
vkDestroyBuffer(Device.FHandle,FHandle,nil);
image :=_image;
range :=_sub;
AccessMask:=ord(VK_ACCESS_NONE_KHR);
ImgLayout :=VK_IMAGE_LAYOUT_UNDEFINED;
StageMask :=ord(VK_PIPELINE_STAGE_TOP_OF_PIPE_BIT);
end;
function TvBuffer.GetRequirements:TVkMemoryRequirements;
begin
Result:=Default(TVkMemoryRequirements);
vkGetBufferMemoryRequirements(Device.FHandle,FHandle,@Result);
end;
function TvBuffer.GetDedicatedAllocation:Boolean;
procedure TvImageBarrier.Push(cmd:TVkCommandBuffer;
dstAccessMask:TVkAccessFlags;
newImageLayout:TVkImageLayout;
dstStageMask:TVkPipelineStageFlags);
var
info:TVkBufferMemoryRequirementsInfo2;
rmem:TVkMemoryRequirements2;
rded:TVkMemoryDedicatedRequirements;
info:TVkImageMemoryBarrier;
begin
Result:=false;
if Pointer(vkGetImageMemoryRequirements2)=nil then Exit;
info:=Default(TVkBufferMemoryRequirementsInfo2);
info.sType:=VK_STRUCTURE_TYPE_BUFFER_MEMORY_REQUIREMENTS_INFO_2;
info.buffer:=FHandle;
rmem:=Default(TVkMemoryRequirements2);
rmem.sType:=VK_STRUCTURE_TYPE_MEMORY_REQUIREMENTS_2;
rded:=Default(TVkMemoryDedicatedRequirements);
rded.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS;
rmem.pNext:=@rded;
vkGetBufferMemoryRequirements2(Device.FHandle,@info,@rmem);
Result:=(rded.requiresDedicatedAllocation<>VK_FALSE) or
(rded.prefersDedicatedAllocation <>VK_FALSE);
end;
info:=Default(TVkImageMemoryBarrier);
info.sType :=VK_STRUCTURE_TYPE_IMAGE_MEMORY_BARRIER;
info.srcAccessMask :=AccessMask;
info.dstAccessMask :=dstAccessMask;
info.oldLayout :=ImgLayout;
info.newLayout :=newImageLayout;
info.image :=image;
info.subresourceRange:=range;
function TvBuffer.BindMem(P:TvPointer):TVkResult;
begin
Result:=vkBindBufferMemory(Device.FHandle,FHandle,P.FHandle,P.FOffset);
if (AccessMask<>dstAccessMask) or
(ImgLayout <>newImageLayout) or
(StageMask <>dstStageMask) then
begin
vkCmdPipelineBarrier(cmd,
StageMask,
dstStageMask,
0,
0, nil,
0, nil,
1, @info);
AccessMask:=dstAccessMask;
ImgLayout :=newImageLayout;
StageMask :=dstStageMask;
end;
end;
end.

563
vulkan/vImageManager.pas Normal file
View File

@ -0,0 +1,563 @@
unit vImageManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
g23tree,
Vulkan,
vDevice,
vMemory,
vImage,
vCmdBuffer,
vImageTiling;
type
TvImageView2Compare=object
function c(a,b:PvImageViewKey):Integer; static;
end;
TvImageView2=class(TvImageView)
key:TvImageViewKey;
procedure Release(Sender:TObject);
Function GetSubresRange:TVkImageSubresourceRange;
Function GetSubresLayer:TVkImageSubresourceLayers;
end;
TvImageView2Set=specialize T23treeSet<PvImageViewKey,TvImageView2Compare>;
TvImage2=class;
TvHostImage2=class(TvCustomImage)
parent:TvImage2;
FUsage:TVkFlags;
function GetImageInfo:TVkImageCreateInfo; override;
end;
TvImage2=class(TvCustomImage)
key:TvImageKey;
FUsage:TVkFlags;
FViews:TvImageView2Set;
//
FHostImage:TvHostImage2;
//
Fdevc:TvPointer;
//
FRefs:ptruint;
FDeps:TObjectSetLock;
//
data_usage:Byte;
Destructor Destroy; override;
function GetImageInfo:TVkImageCreateInfo; override;
Function GetSubresRange:TVkImageSubresourceRange;
Function GetSubresLayer:TVkImageSubresourceLayers;
function FetchView(cmd:TvCustomCmdBuffer;var F:TvImageViewKey):TvImageView2;
function FetchView(cmd:TvCustomCmdBuffer):TvImageView2;
function FetchHostImage(cmd:TvCustomCmdBuffer;usage:TVkFlags):TvHostImage2;
Procedure Acquire(Sender:TObject);
procedure Release(Sender:TObject);
end;
function FetchImage(cmd:TvCustomCmdBuffer;var F:TvImageKey;usage:TVkFlags;data_usage:Byte):TvImage2;
function FindImage(cmd:TvCustomCmdBuffer;Addr:Pointer;cformat:TVkFormat):TvImage2;
const
img_ext:TVkExternalMemoryImageCreateInfo=(
sType:VK_STRUCTURE_TYPE_EXTERNAL_MEMORY_IMAGE_CREATE_INFO;
pNext:nil;
handleTypes:ord(VK_EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT);
);
implementation
type
TvImageKeyCompare=object
function c(a,b:PvImageKey):Integer; static;
end;
_TvImage2Set=specialize T23treeSet<PvImageKey,TvImageKeyCompare>;
TvImage2Set=object(_TvImage2Set)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FImage2Set:TvImage2Set;
Procedure TvImage2Set.Init;
begin
rwlock_init(lock);
end;
Procedure TvImage2Set.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvImage2Set.Unlock;
begin
rwlock_unlock(lock);
end;
function TvImageKeyCompare.c(a,b:PvImageKey):Integer;
begin
//1 Addr
Result:=Integer(a^.Addr>b^.Addr)-Integer(a^.Addr<b^.Addr);
if (Result<>0) then Exit;
//2 cformat
Result:=Integer(a^.cformat>b^.cformat)-Integer(a^.cformat<b^.cformat);
if (Result<>0) then Exit;
//3 params
Result:=CompareByte(a^.params,b^.params,SizeOf(TvImageKey.params));
end;
function TvImageView2Compare.c(a,b:PvImageViewKey):Integer;
begin
Result:=CompareByte(a^,b^,SizeOf(TvImageViewKey));
end;
procedure TvImageView2.Release(Sender:TObject);
begin
inherited Release;
end;
Function TvImageView2.GetSubresRange:TVkImageSubresourceRange;
begin
Result:=Default(TVkImageSubresourceRange);
Result.aspectMask :=GetAspectMaskByFormat(key.cformat);
Result.baseMipLevel :=key.base_level;
Result.levelCount :=key.last_level-key.base_level+1;
Result.baseArrayLayer:=key.base_array;
Result.layerCount :=key.last_array-key.base_array+1;
end;
Function TvImageView2.GetSubresLayer:TVkImageSubresourceLayers;
begin
Result:=Default(TVkImageSubresourceLayers);
Result.aspectMask :=GetAspectMaskByFormat(key.cformat);
Result.mipLevel :=key.base_level;
Result.baseArrayLayer:=key.base_array;
Result.layerCount :=key.last_array-key.base_array+1;
end;
Destructor TvImage2.Destroy;
var
i:TvImageView2Set.Iterator;
t:TvImageView2;
begin
i:=FViews.cbegin;
While (i.Item<>nil) do
begin
t:=TvImageView2(ptruint(i.Item^)-ptruint(@TvImageView2(nil).key));
t.Release(nil);
i.Next;
end;
FViews.Free;
MemManager.Free(Fdevc);
inherited;
end;
function TvImage2.GetImageInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=TVkImageType(key.params.itype);
Result.format :=key.cformat;
Result.extent.Create(key.params.extend.width,key.params.extend.height,key.params.extend.depth);
Result.mipLevels :=key.params.mipLevels;
Result.arrayLayers :=key.params.arrayLayers;
Result.samples :=TVkSampleCountFlagBits(key.params.samples);
Result.tiling :=VK_IMAGE_TILING_OPTIMAL;
Result.usage :=FUsage;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
end;
function TvHostImage2.GetImageInfo:TVkImageCreateInfo;
begin
Result:=parent.GetImageInfo;
Result.tiling:=VK_IMAGE_TILING_LINEAR;
Result.usage :=FUsage;
end;
Function TvImage2.GetSubresRange:TVkImageSubresourceRange;
begin
Result:=Default(TVkImageSubresourceRange);
Result.aspectMask:=GetAspectMaskByFormat(key.cformat);
Result.levelCount:=key.params.mipLevels;
Result.layerCount:=key.params.arrayLayers;
end;
Function TvImage2.GetSubresLayer:TVkImageSubresourceLayers;
begin
Result:=Default(TVkImageSubresourceLayers);
Result.aspectMask :=GetAspectMaskByFormat(key.cformat);
Result.mipLevel :=0;
Result.baseArrayLayer:=0;
Result.layerCount :=key.params.arrayLayers;
end;
function TvImage2.FetchView(cmd:TvCustomCmdBuffer;var F:TvImageViewKey):TvImageView2;
var
i:TvImageView2Set.Iterator;
t:TvImageView2;
cinfo:TVkImageViewCreateInfo;
FView:TVkImageView;
r:TVkResult;
begin
Result:=nil;
if (FHandle=VK_NULL_HANDLE) then Exit;
t:=nil;
i:=FViews.find(@F);
if (i.Item<>nil) then
begin
t:=TvImageView2(ptruint(i.Item^)-ptruint(@TvImageView2(nil).key));
end else
begin
cinfo:=Default(TVkImageViewCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO;
cinfo.image :=FHandle;
cinfo.viewType :=TVkImageViewType(F.vtype);
cinfo.format :=key.cformat;
cinfo.components.r:=TVkComponentSwizzle(F.dstSel.r);
cinfo.components.g:=TVkComponentSwizzle(F.dstSel.g);
cinfo.components.b:=TVkComponentSwizzle(F.dstSel.b);
cinfo.components.a:=TVkComponentSwizzle(F.dstSel.a);
cinfo.subresourceRange.aspectMask :=GetAspectMaskByFormat(F.cformat);
cinfo.subresourceRange.baseMipLevel :=F.base_level;
cinfo.subresourceRange.levelCount :=F.last_level-F.base_level+1;
cinfo.subresourceRange.baseArrayLayer:=F.base_array;
cinfo.subresourceRange.layerCount :=F.last_array-F.base_array+1;
FView:=VK_NULL_HANDLE;
r:=vkCreateImageView(Device.FHandle,@cinfo,nil,@FView);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImageView:',r);
Exit;
end;
t:=TvImageView2.Create;
t.FHandle:=FView;
t.key :=F;
t.Acquire;
FViews.Insert(@t.key);
end;
if (cmd<>nil) and (t<>nil) then
begin
if cmd.AddDependence(@t.Release) then
begin
t.Acquire;
end;
end;
Result:=t;
end;
function TvImage2.FetchView(cmd:TvCustomCmdBuffer):TvImageView2;
var
F:TvImageViewKey;
begin
F:=Default(TvImageViewKey);
F.cformat:=key.cformat;
Case TVkImageType(key.params.itype) of
VK_IMAGE_TYPE_1D:
begin
if (key.params.arrayLayers>1) then
F.vtype:=ord(VK_IMAGE_VIEW_TYPE_1D_ARRAY)
else
F.vtype:=ord(VK_IMAGE_VIEW_TYPE_1D);
end;
VK_IMAGE_TYPE_2D:
begin
if (key.params.arrayLayers>1) then
F.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D_ARRAY)
else
F.vtype:=ord(VK_IMAGE_VIEW_TYPE_2D);
//VK_IMAGE_VIEW_TYPE_CUBE
//VK_IMAGE_VIEW_TYPE_CUBE_ARRAY
end;
VK_IMAGE_TYPE_3D:F.vtype:=ord(VK_IMAGE_VIEW_TYPE_3D);
end;
F.last_level:=key.params.mipLevels-1;
F.last_array:=key.params.arrayLayers-1;
Result:=FetchView(cmd,F);
end;
function TvImage2.FetchHostImage(cmd:TvCustomCmdBuffer;usage:TVkFlags):TvHostImage2;
var
t:TvHostImage2;
Fhost:TvPointer;
begin
Result:=nil;
t:=FHostImage;
if (t<>nil) then
begin
if ((t.FUsage and usage)<>usage) then
begin
Assert(false,'TODO');
end;
Exit(t);
end;
t:=TvHostImage2.Create;
t.parent:=Self;
t.FUsage:=usage;
if not t.Compile(@img_ext) then
begin
t.Free;
Exit;
end;
if TryGetHostPointerByAddr(key.Addr,Fhost) then
begin
if (t.BindMem(Fhost)<>VK_SUCCESS) then
begin
t.Free;
Exit;
end;
end else
begin
t.Free;
Exit;
end;
FHostImage:=t;
Result:=t;
if (cmd<>nil) and (Self<>nil) then
begin
if cmd.AddDependence(@Self.Release) then
begin
Self.Acquire(cmd);
end;
end;
end;
Procedure TvImage2.Acquire(Sender:TObject);
begin
System.InterlockedIncrement(Pointer(FRefs));
if (Sender<>nil) then
begin
FDeps.Insert(Sender);
end;
end;
procedure TvImage2.Release(Sender:TObject);
begin
if (Sender<>nil) then
begin
FDeps.delete(Sender);
end;
if System.InterlockedDecrement(Pointer(FRefs))=nil then
begin
Free;
end;
end;
function _Find(var F:TvImageKey):TvImage2;
var
i:TvImage2Set.Iterator;
begin
Result:=nil;
i:=FImage2Set.find(@F);
if (i.Item<>nil) then
begin
Result:=TvImage2(ptruint(i.Item^)-ptruint(@TvImage2(nil).key));
end;
end;
function _FetchImage(var F:TvImageKey;usage:TVkFlags):TvImage2;
var
t:TvImage2;
begin
Result:=nil;
t:=_Find(F);
if (t<>nil) then
begin
if ((t.FUsage and usage)<>usage) then
begin
Assert(false,'TODO');
end;
end else
begin
t:=TvImage2.Create;
t.key :=F;
t.FUsage:=Usage;
if not t.Compile(nil) then
begin
FreeAndNil(t);
end else
begin
t.Fdevc:=MemManager.Alloc(
t.GetRequirements,
ord(VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT)
);
t.BindMem(t.Fdevc);
t.Acquire(nil);
FImage2Set.Insert(@t.key);
end;
end;
Result:=t;
end;
function _FindImage(Addr:Pointer;cformat:TVkFormat):TvImage2;
var
i:TvImage2Set.Iterator;
t:TvImage2;
F:TvImageKey;
begin
F:=Default(TvImageKey);
F.Addr:=Addr;
F.cformat:=cformat;
t:=nil;
i:=FImage2Set.find_be(@F);
if (i.Item<>nil) then
begin
t:=TvImage2(ptruint(i.Item^)-ptruint(@TvImage2(nil).key));
if (t.key.Addr<>Addr) then t:=nil;
end;
Result:=t;
end;
function FetchImage(cmd:TvCustomCmdBuffer;var F:TvImageKey;usage:TVkFlags;data_usage:Byte):TvImage2;
begin
FImage2Set.Lock_wr;
Result:=_FetchImage(F,usage);
if (cmd<>nil) and (Result<>nil) then
begin
if cmd.AddDependence(@Result.Release) then
begin
Result.Acquire(cmd);
end;
if not cmd.IsRenderPass then
if ((Result.data_usage and TM_READ)=0) and
((data_usage and TM_READ)<>0) and
((data_usage and TM_CLEAR)=0) then
begin
Result.data_usage:=Result.data_usage or TM_READ;
LoadFromBuffer(cmd,Result);
end;
Result.data_usage:=Result.data_usage or (data_usage and TM_WRITE);
end;
FImage2Set.Unlock;
end;
function FindImage(cmd:TvCustomCmdBuffer;Addr:Pointer;cformat:TVkFormat):TvImage2;
begin
FImage2Set.Lock_wr;
Result:=_FindImage(Addr,cformat);
if (cmd<>nil) and (Result<>nil) then
begin
if cmd.AddDependence(@Result.Release) then
begin
Result.Acquire(cmd);
end;
end;
FImage2Set.Unlock;
end;
{
function _FetchImageView2D(cmd:TvCustomCmdBuffer;
Addr:Pointer;
tiling_idx:Byte;
cformat:TVkFormat;
extend:TVkExtent2D;
usage:TVkFlags):TvImageView2;
var
FImageKey:TvImageKey;
FImageViewKey:TvImageViewKey;
Image:TvImage2;
begin
Result:=nil;
FImageKey:=Default(TvImageKey);
FImageKey.Addr:=Addr;
FImageKey.cformat:=cformat;
FImageKey.params.itype :=ord(VK_IMAGE_TYPE_2D);
FImageKey.params.tiling_idx :=tiling_idx;
FImageKey.params.extend.width :=extend.width;
FImageKey.params.extend.height:=extend.height;
FImageKey.params.extend.depth :=1;
FImageKey.params.samples :=1;
FImageKey.params.mipLevels :=1;
FImageKey.params.arrayLayers :=1;
FImageViewKey:=Default(TvImageViewKey);
FImageViewKey.cformat:=cformat;
FImageViewKey.vtype :=ord(VK_IMAGE_VIEW_TYPE_2D);
//FImageViewKey.dstSel
//FImageViewKey.base_level:Byte;
//FImageViewKey.last_level:Byte;
//FImageViewKey.base_array:Word;
//FImageViewKey.last_array:Word;
FImage2Set.Lock_wr;
Image:=_FetchImage(FImageKey,usage);
if (cmd<>nil) and (Image<>nil) then
begin
if cmd.AddDependence(@Image.Release) then
begin
Image.Acquire(cmd);
end;
end;
if (Image<>nil) then
begin
Result:=Image.FetchView(cmd,FImageViewKey);
end;
FImage2Set.Unlock;
end;
}
initialization
FImage2Set.Init;
end.

415
vulkan/vImageTiling.pas Normal file
View File

@ -0,0 +1,415 @@
unit vImageTiling;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
g23tree,
ps4_tiling,
Vulkan,
vDevice,
vMemory,
vBuffer,
vImage,
vHostBufferManager,
vCmdBuffer;
Procedure LoadFromBuffer(cmd:TvCustomCmdBuffer;image:TObject); //TvImage2
implementation
uses
vImageManager;
Function getFormatSize(cformat:TVkFormat):Byte;
begin
Result:=0;
Case cformat of
VK_FORMAT_R8G8B8A8_SRGB :Result:=4;
VK_FORMAT_R8G8B8A8_UNORM :Result:=4;
VK_FORMAT_R8G8_UNORM :Result:=2;
VK_FORMAT_R8_UNORM :Result:=1;
VK_FORMAT_R8_UINT :Result:=4;
VK_FORMAT_R5G6B5_UNORM_PACK16:Result:=2;
else
Assert(false,'TODO');
end;
end;
{
Procedure _Load_Linear(cmd:TvCustomCmdBuffer;image:TvImage2);
var
buf:TvHostBuffer;
BufferImageCopy:TVkBufferImageCopy;
size:Ptruint;
begin
size:=image.key.params.extend.width*
image.key.params.extend.height*
image.key.params.extend.depth*
getFormatSize(image.key.cformat);
cmd.PushImageBarrier(image.FHandle,
image.GetSubresRange,
ord(VK_ACCESS_TRANSFER_WRITE_BIT),
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
buf:=FetchHostBuffer(cmd,
image.key.Addr,
size,
ord(VK_BUFFER_USAGE_TRANSFER_SRC_BIT));
vkBufferMemoryBarrier(cmd.cmdbuf,
buf.FHandle,
ord(VK_ACCESS_SHADER_WRITE_BIT),
ord(VK_ACCESS_MEMORY_READ_BIT),
buf.Foffset,size,
ord(VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT)
);
BufferImageCopy:=Default(TVkBufferImageCopy);
BufferImageCopy.bufferOffset:=buf.Foffset;
BufferImageCopy.bufferRowLength:=0;
BufferImageCopy.bufferImageHeight:=0;
BufferImageCopy.imageSubresource:=image.GetSubresLayer;
BufferImageCopy.imageExtent.Create(image.key.params.extend.width,
image.key.params.extend.height,
image.key.params.extend.depth);
Case image.key.cformat of
VK_FORMAT_D16_UNORM_S8_UINT,
VK_FORMAT_D24_UNORM_S8_UINT,
VK_FORMAT_D32_SFLOAT_S8_UINT:
BufferImageCopy.imageSubresource.aspectMask:=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
else;
end;
//image.data_usage:=image.data_usage and (not TM_READ);
vkCmdCopyBufferToImage(cmd.cmdbuf,
buf.FHandle,
image.FHandle,
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
1,
@BufferImageCopy);
end;
}
Procedure _Load_Linear(cmd:TvCustomCmdBuffer;image:TvImage2);
var
buf:TvHostImage2;
ImageCopy:TVkImageCopy;
begin
buf:=image.FetchHostImage(cmd,ord(VK_IMAGE_USAGE_TRANSFER_SRC_BIT) or
ord(VK_IMAGE_USAGE_TRANSFER_DST_BIT));
Assert(buf<>nil,'FetchHostImage');
cmd.PushImageBarrier(image.FHandle,
image.GetSubresRange,
ord(VK_ACCESS_TRANSFER_WRITE_BIT),
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
cmd.PushImageBarrier(buf.FHandle,
image.GetSubresRange,
ord(VK_ACCESS_TRANSFER_READ_BIT),
VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
ImageCopy:=Default(TVkImageCopy);
ImageCopy.srcSubresource:=image.GetSubresLayer;
ImageCopy.dstSubresource:=image.GetSubresLayer;
ImageCopy.extent.Create(image.key.params.extend.width,
image.key.params.extend.height,
image.key.params.extend.depth);
Case image.key.cformat of
VK_FORMAT_D16_UNORM_S8_UINT,
VK_FORMAT_D24_UNORM_S8_UINT,
VK_FORMAT_D32_SFLOAT_S8_UINT:
begin
ImageCopy.srcSubresource.aspectMask:=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
ImageCopy.dstSubresource.aspectMask:=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
end
else;
end;
vkCmdCopyImage(cmd.cmdbuf,
buf.FHandle,
VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL,
image.FHandle,
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
1,@ImageCopy);
end;
type
TvTempBuffer=class(TvBuffer)
Fhost:TvPointer;
procedure Release(Sender:TObject);
end;
procedure TvTempBuffer.Release(Sender:TObject);
begin
MemManager.Free(Fhost);
Free;
end;
Procedure _Copy_Linear(cmd:TvCustomCmdBuffer;buf:TvTempBuffer;image:TvImage2);
var
BufferImageCopy:TVkBufferImageCopy;
size:Ptruint;
begin
cmd.AddDependence(@buf.Release);
size:=image.key.params.extend.width*
image.key.params.extend.height*
image.key.params.extend.depth*
getFormatSize(image.key.cformat);
cmd.PushImageBarrier(image.FHandle,
image.GetSubresRange,
ord(VK_ACCESS_TRANSFER_WRITE_BIT),
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
ord(VK_PIPELINE_STAGE_TRANSFER_BIT));
vkBufferMemoryBarrier(cmd.cmdbuf,
buf.FHandle,
ord(VK_ACCESS_SHADER_WRITE_BIT),
ord(VK_ACCESS_MEMORY_READ_BIT),
0,size,
ord(VK_PIPELINE_STAGE_COMPUTE_SHADER_BIT),
ord(VK_PIPELINE_STAGE_TRANSFER_BIT)
);
BufferImageCopy:=Default(TVkBufferImageCopy);
BufferImageCopy.bufferOffset:=0;
BufferImageCopy.bufferRowLength:=0;
BufferImageCopy.bufferImageHeight:=0;
BufferImageCopy.imageSubresource:=image.GetSubresLayer;
BufferImageCopy.imageExtent.Create(image.key.params.extend.width,
image.key.params.extend.height,
image.key.params.extend.depth);
Case image.key.cformat of
VK_FORMAT_D16_UNORM_S8_UINT,
VK_FORMAT_D24_UNORM_S8_UINT,
VK_FORMAT_D32_SFLOAT_S8_UINT:
BufferImageCopy.imageSubresource.aspectMask:=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
else;
end;
vkCmdCopyBufferToImage(cmd.cmdbuf,
buf.FHandle,
image.FHandle,
VK_IMAGE_LAYOUT_TRANSFER_DST_OPTIMAL,
1,
@BufferImageCopy);
end;
type
TTGAHeader=packed record
idlength :Byte;
colourmaptype :Byte;
datatypecode :Byte;
colourmaporigin:Word;
colourmaplength:Word;
colourmapdepth :Byte;
x_origin :Word;
y_origin :Word;
width :Word;
height :Word;
bitsperpixel :Byte;
imagedescriptor:Byte;
end;
Procedure _Load_Thin_1dThin(cmd:TvCustomCmdBuffer;image:TvImage2);
var
buf:TvTempBuffer;
//tp:TilingParameters;
tiler:Tiler1d;
//mtm:Byte;
size,i,x,y:QWORD;
m_bitsPerElement:Word;
//m_macroTileWidth :DWORD;
//m_macroTileHeight:DWORD;
pData,pSrc,pDst:Pointer;
F:THandle;
Header:TTGAHeader;
begin
//tp:=Default(TilingParameters);
//mtm:=$FF; //2 kMacroTileMode_1x1_16
//bankWidth=1 bankHeight=1 macroTileAspect=2 numBanks=16 altBankHeight=2 altNumBanks= 8 altMacroTileAspect=1
//computeSurfaceMacroTileMode(@mtm,13,32,1);
//tp.m_tileMode:=image.key.params.tiling_idx;
//tp.m_minGpuMode:=0; //PS4 NEO
//
//tp.m_linearWidth :=image.key.params.extend.width;
//tp.m_linearHeight :=image.key.params.extend.height;
//tp.m_linearDepth :=image.key.params.extend.depth;
//tp.m_numFragmentsPerPixel:=32;
//tp.m_baseTiledPitch :=0;
//
//tp.m_mipLevel :=0;
//tp.m_arraySlice :=0;
////tp.m_surfaceFlags :SurfaceFlags;
//tp.m_bitsPerFragment :=32;
//tp.m_isBlockCompressed :=False;
//tp.m_tileSwizzleMask :=0;
//
//tiler:=Default(Tiler2d);
//tiler.init(tp);
tiler:=Texture2d_32;
m_bitsPerElement:=getFormatSize(image.key.cformat)*8;
tiler.m_bitsPerElement:=m_bitsPerElement;
tiler.m_linearWidth :=image.key.params.extend.width;
tiler.m_linearHeight:=image.key.params.extend.height;
tiler.m_linearDepth :=image.key.params.extend.depth;
tiler.m_linearSizeBytes:=tiler.m_linearWidth*tiler.m_linearHeight*tiler.m_linearDepth*(m_bitsPerElement div 8);
tiler.m_tileBytes := (kMicroTileWidth * kMicroTileHeight * tiler.m_tileThickness * m_bitsPerElement + 7) div 8;
Case m_bitsPerElement of
32:begin
tiler.m_paddedWidth :=((tiler.m_linearWidth +7) div 8)*8;
tiler.m_paddedHeight:=((tiler.m_linearHeight+7) div 8)*8;
end;
8:begin
tiler.m_paddedWidth :=((tiler.m_linearWidth +31) div 32)*32;
tiler.m_paddedHeight:=((tiler.m_linearHeight+7) div 8)*8;
end;
else
Assert(false);
end;
tiler.m_paddedDepth :=tiler.m_linearDepth;
tiler.m_tiledSizeBytes:=tiler.m_paddedWidth*tiler.m_paddedHeight*tiler.m_paddedDepth*(m_bitsPerElement div 8);
tiler.m_tilesPerRow:=tiler.m_paddedWidth div kMicroTileWidth;
tiler.m_tilesPerSlice:= tiler.m_tilesPerRow * (tiler.m_paddedHeight div kMicroTileHeight);
///buf^.PITCH:=(width+127) div 128;
///buf^.SIZE :=buf^.PITCH*128*((height+63) div 64)*64*4;
//m_tilesPerRow = m_paddedWidth / kMicroTileWidth;
//m_tilesPerSlice = std::max(m_tilesPerRow * (m_paddedHeight / kMicroTileHeight), 1U);
size:=image.key.params.extend.width*
image.key.params.extend.height*(m_bitsPerElement div 8);
buf:=TvTempBuffer.Create(size,ord(VK_BUFFER_USAGE_TRANSFER_SRC_BIT),nil);
buf.Fhost:=MemManager.Alloc(buf.GetRequirements,ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT));
buf.BindMem(buf.Fhost);
pData:=nil;
vkMapMemory(Device.FHandle,
buf.Fhost.FHandle,
buf.Fhost.FOffset,
size,
0,
@pData);
//pData:=AllocMem(size);
Assert(image.key.params.extend.depth=1);
For y:=0 to image.key.params.extend.height-1 do
For x:=0 to image.key.params.extend.width-1 do
begin
i:=0;
tiler.getTiledElementBitOffset(i,x,y,0);
i:=i div 8;
pSrc:=@PByte(image.key.Addr)[i];
pDst:=@PByte(pData)[(y*image.key.params.extend.width+x)*(m_bitsPerElement div 8)];
Move(pSrc^,pDst^,(m_bitsPerElement div 8));
//i:=i div 4;
//pData[y*image.key.params.extend.width+x]:={Random($FFFFFFFF);}PDWORD(image.key.Addr)[i];
end;
//Move(pData^,image.key.Addr^,size);
//FreeMem(pData);
Case m_bitsPerElement of
8:begin
//image.data_usage:=image.data_usage and (not TM_READ);
//Header:=Default(TTGAHeader);
//
//Header.datatypecode :=3;
//
//Header.width :=image.key.params.extend.width;
//Header.height :=image.key.params.extend.height;
//Header.bitsperpixel :=8;
//Header.imagedescriptor:=32;
//
//F:=FileCreate('texture.tga');
//FileWrite(F,Header,SizeOf(TTGAHeader));
//FileWrite(F,pData^,size);
//FileClose(F);
end;
end;
//image.data_usage:=image.data_usage and (not TM_READ);
vkUnmapMemory(Device.FHandle,buf.Fhost.FHandle);
_Copy_Linear(cmd,buf,image);
//_Load_Linear(cmd,image);
//writeln;
end;
Procedure LoadFromBuffer(cmd:TvCustomCmdBuffer;image:TObject);
begin
if (cmd=nil) then Exit;
Case TvImage2(image).key.params.tiling_idx of
kTileModeDisplay_LinearAligned,
kTileModeDisplay_LinearGeneral:
_Load_Linear(cmd,TvImage2(image));
kTileModeDisplay_2dThin: //render target tiling todo
_Load_Linear(cmd,TvImage2(image));
kTileModeDepth_2dThin_64: //depth tiling todo
_Load_Linear(cmd,TvImage2(image));
kTileModeThin_1dThin: //texture
_Load_Thin_1dThin(cmd,TvImage2(image));
kTileModeThin_2dThin:
_Load_Linear(cmd,TvImage2(image)); //TODO
else
Assert(false,'TODO');
end;
end;
end.

85
vulkan/vMemory.pas
View File

@ -5,7 +5,6 @@ unit vMemory;
interface
uses
bittype,
g23tree,
vulkan,
vDevice;
@ -51,7 +50,7 @@ type
TvMemManager=class
FProperties:TVkPhysicalDeviceMemoryProperties;
FHostVisibMt:TVkUInt32;
FHostCacheMt:TVkUInt32;
//FHostCacheMt:TVkUInt32;
lock:Pointer;
@ -96,6 +95,15 @@ uses
//free: [FmType]|[FSize]|[FBlockId]
function TFreeCompare.c(const a,b:TDevNode):Integer;
begin
//1 FmType
Result:=Integer(a.FmType>b.FmType)-Integer(a.FmType<b.FmType);
if (Result<>0) then Exit;
//2 FSize
Result:=Integer(a.FSize>b.FSize)-Integer(a.FSize<b.FSize);
if (Result<>0) then Exit;
//3 FBlockId
Result:=Integer(a.FBlockId>b.FBlockId)-Integer(a.FBlockId<b.FBlockId);
{
if (a.FmType=b.FmType) then
begin
if (a.FSize=b.FSize) then
@ -116,12 +124,18 @@ begin
if (a.FmType<b.FmType) then
Result:=-1
else
Result:=1;
Result:=1;}
end;
//alloc: [FBlockId]|[FOffset]
function TAllcCompare.c(const a,b:TDevNode):Integer;
begin
//1 FBlockId
Result:=Integer(a.FBlockId>b.FBlockId)-Integer(a.FBlockId<b.FBlockId);
if (Result<>0) then Exit;
//2 FBlockId
Result:=Integer(a.FOffset>b.FOffset)-Integer(a.FOffset<b.FOffset);
{
if (a.FBlockId=b.FBlockId) then
begin
if (a.FOffset=b.FOffset) then
@ -135,31 +149,44 @@ begin
if (a.FBlockId<b.FBlockId) then
Result:=-1
else
Result:=1;
Result:=1;}
end;
Constructor TvMemManager.Create;
begin
FProperties:=Default(TVkPhysicalDeviceMemoryProperties);
vkGetPhysicalDeviceMemoryProperties(VulkanApp.FPhysicalDevice,@FProperties);
FHostVisibMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_COHERENT_BIT));
ord(VK_MEMORY_PROPERTY_HOST_COHERENT_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_CACHED_BIT)
);
if (FHostVisibMt=DWORD(-1)) then
begin
FHostVisibMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT));
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_COHERENT_BIT)
);
end;
FHostCacheMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_CACHED_BIT));
if (FHostCacheMt=DWORD(-1)) then
if (FHostVisibMt=DWORD(-1)) then
begin
FHostCacheMt:=FHostVisibMt;
FHostVisibMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT)
);
end;
//FHostCacheMt:=findMemoryType($FFFFFFFF,
// ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
// ord(VK_MEMORY_PROPERTY_HOST_CACHED_BIT));
//if (FHostCacheMt=DWORD(-1)) then
//begin
// FHostCacheMt:=FHostVisibMt;
//end;
end;
function TvMemManager.findMemoryType(Filter:TVkUInt32;prop:TVkMemoryPropertyFlags):Integer;
@ -271,8 +298,12 @@ begin
//shrink
c:=Length(FDevBlocks);
While (c<>0) do
begin
if (FDevBlocks[c-1].FHandle=VK_NULL_HANDLE) then
Dec(c);
Dec(c)
else
Break;
end;
SetLength(FDevBlocks,c);
end;
@ -497,19 +528,25 @@ end;
function vkAllocMemory(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
r:TVkResult;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
ainfo.allocationSize :=Size;
ainfo.memoryTypeIndex:=mtindex;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
r:=vkAllocateMemory(device,@ainfo,nil,@Result);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateMemory:',r);
end;
end;
function vkAllocHostPointer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;adr:Pointer):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
import:TVkImportMemoryHostPointerInfoEXT;
r:TVkResult;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
@ -521,13 +558,18 @@ begin
import.handleType:=VK_EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT;
import.pHostPointer:=adr;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
r:=vkAllocateMemory(device,@ainfo,nil,@Result);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateMemory:',r);
end;
end;
function vkAllocDedicatedImage(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkImage):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
dinfo:TVkMemoryDedicatedAllocateInfo;
r:TVkResult;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
@ -538,13 +580,18 @@ begin
dinfo.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_ALLOCATE_INFO;
dinfo.image:=FHandle;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
r:=vkAllocateMemory(device,@ainfo,nil,@Result);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateMemory:',r);
end;
end;
function vkAllocDedicatedBuffer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkBuffer):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
dinfo:TVkMemoryDedicatedAllocateInfo;
r:TVkResult;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
@ -555,13 +602,17 @@ begin
dinfo.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_ALLOCATE_INFO;
dinfo.buffer:=FHandle;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
r:=vkAllocateMemory(device,@ainfo,nil,@Result);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateMemory:',r);
end;
end;
function OnGpuMemAlloc(addr:Pointer;len:size_t):TVkDeviceMemory;
begin
InitVulkan;
Result:=vkAllocHostPointer(Device.FHandle,len,MemManager.FHostCacheMt,addr);
Result:=vkAllocHostPointer(Device.FHandle,len,MemManager.FHostVisibMt{FHostCacheMt},addr);
Assert(Result<>VK_NULL_HANDLE);
end;

564
vulkan/vPipeline.pas
View File

@ -6,28 +6,55 @@ interface
uses
g23tree,
vulkan,vDevice,vShader;
vulkan,
vDevice,
vShader;
type
AVkDescriptorSetLayoutBinding=array of TVkDescriptorSetLayoutBinding;
PvSetLayoutKey=^TvSetLayoutKey;
TvSetLayoutKey=record
FStage:TVkShaderStageFlags;
FFlags:TVkUInt32;
FBinds:AVkDescriptorSetLayoutBinding;
end;
TvSetLayout=class
FHandle:TVkDescriptorSetLayout;
FEdit,FCompile:ptruint;
FBinds:array of TVkDescriptorSetLayoutBinding;
key:TvSetLayoutKey;
Procedure SetUsePushDescriptor(b:Boolean);
function GetUsePushDescriptor:Boolean;
Destructor Destroy; override;
Procedure Add(aBind:TVkUInt32;dType:TVkDescriptorType;Flags:TVkShaderStageFlags;count:TVkUInt32=1);
Procedure SetBinds(const A:AVkDescriptorSetLayoutBinding);
Function IsSpace:Boolean; inline;
procedure Clear;
function Compile:Boolean;
function IsEdit:Boolean;
end;
AvSetLayout=array of TvSetLayout;
AvPushConstantRange=array of TVkPushConstantRange;
PvPipelineLayoutKey=^TvPipelineLayoutKey;
TvPipelineLayoutKey=record
FLayouts :AvSetLayout;
FPushConsts:AvPushConstantRange;
end;
TvPipelineLayout=class
FHandle:TVkPipelineLayout;
FEdit,FCompile:ptruint;
FLayouts:array of TvSetLayout;
FPushConsts:array of TVkPushConstantRange;
FBinds:ptruint;
key:TvPipelineLayoutKey;
Destructor Destroy; override;
Procedure Add(F:TvSetLayout);
Procedure AddLayout(F:TvSetLayout);
Procedure SetLayouts(const A:AvSetLayout);
Procedure AddPushConst(offset,size:TVkUInt32;Flags:TVkShaderStageFlags);
Procedure SetPushConst(const A:AvPushConstantRange);
Function isSpace:Boolean;
procedure Clear;
function Compile:Boolean;
function IsEdit:Boolean;
@ -62,11 +89,8 @@ type
procedure _AllocDesc;
procedure _FreeDesc;
Destructor Destroy; override;
Procedure BindUB (aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSB (aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindUBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSTI(aBind,aElem:TVkUInt32;const img:TVkImageView);
Procedure BindBuf(aBind,aElem:TVkUInt32;dtype:TVkDescriptorType;buffer:TVkBuffer;offset,range:TVkDeviceSize);
Procedure BindSTI(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
end;
_TvSetLayoutKey=object
@ -83,6 +107,9 @@ type
_TvDescriptorSetSet=specialize T23treeSet<TvDescriptorSet,_TvDescriptorSetCompare>;
TvCountsGroup=array[0..14] of TVkUInt32;
AvDescriptorPoolSize=array of TVkDescriptorPoolSize;
TvSetsPool=class
FHandle:TVkDescriptorPool;
FEdit,FCompile:ptruint;
@ -99,6 +126,50 @@ type
function IsEdit:Boolean;
end;
///////
TvDescriptorSet2=object
FHandle:TVkDescriptorSet;
Function IsValid:Boolean;
Procedure BindBuf(aBind,aElem:TVkUInt32;dtype:TVkDescriptorType;buffer:TVkBuffer;offset,range:TVkDeviceSize);
Procedure BindSTI(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
Procedure BindImg(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
Procedure BindSmp(aBind,aElem:TVkUInt32;smp:TVkSampler);
end;
AvDescriptorSet2=Array of TvDescriptorSet2;
TvDescriptorGroup=class
//lock:Ptruint;
FSets:AvDescriptorSet2;
//Procedure Release;
end;
AvDescriptorGroup=Array of TvDescriptorGroup;
//PvSetsPoolKey=^TvSetsPoolKey;
//TvSetsPoolKey=record
// FPipeline:TvPipelineLayout;
// FNumber :PtrUint;
//end;
TvSetsPool2=class
FHandle:TVkDescriptorPool;
//key:TvSetsPoolKey;
FPipeline:TvPipelineLayout;
FmaxGroup:TVkUInt32;
FmaxSets :TVkUInt32;
FAlcGroup:TVkUInt32;
//FGroups :AvDescriptorGroup;
Constructor Create(Pipeline:TvPipelineLayout;maxGroup:TVkUInt32);
Destructor Destroy; override;
function Compile:Boolean;
function Alloc(L:TvSetLayout):TvDescriptorSet2;
//function Alloc:TvDescriptorGroup;
function IsFull:Boolean;
function Alloc:AvDescriptorSet2;
end;
implementation
function _TvSetLayoutKey.c(const a,b:_TvSetLayoutKey):Integer;
@ -115,19 +186,31 @@ Procedure TvSetLayout.Add(aBind:TVkUInt32;dType:TVkDescriptorType;Flags:TVkShade
var
i:Integer;
begin
i:=Length(FBinds);
SetLength(FBinds,i+1);
FBinds[i]:=Default(TVkDescriptorSetLayoutBinding);
FBinds[i].binding:=aBind;
FBinds[i].descriptorType:=dType;
FBinds[i].descriptorCount:=count;
FBinds[i].stageFlags:=Flags;
i:=Length(key.FBinds);
SetLength(key.FBinds,i+1);
key.FBinds[i]:=Default(TVkDescriptorSetLayoutBinding);
key.FBinds[i].binding:=aBind;
key.FBinds[i].descriptorType:=dType;
key.FBinds[i].descriptorCount:=count;
key.FBinds[i].stageFlags:=Flags;
Inc(FEdit);
end;
Procedure TvSetLayout.SetBinds(const A:AVkDescriptorSetLayoutBinding);
begin
key.FBinds:=A;
Inc(FEdit);
end;
Function TvSetLayout.IsSpace:Boolean; inline;
begin
Result:=Length(key.FBinds)=0;
end;
Procedure TvSetLayout.Clear;
begin
SetLength(FBinds,0);
SetLength(key.FBinds,0);
key.FFlags:=0;
Inc(FEdit);
end;
@ -145,10 +228,11 @@ begin
end;
cinfo:=Default(TVkDescriptorSetLayoutCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_LAYOUT_CREATE_INFO;
cinfo.bindingCount:=Length(FBinds);
cinfo.flags:=key.FFlags;
cinfo.bindingCount:=Length(key.FBinds);
if (cinfo.bindingCount<>0) then
begin
cinfo.pBindings:=@FBinds[0];
cinfo.pBindings:=@key.FBinds[0];
end;
r:=vkCreateDescriptorSetLayout(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
@ -171,20 +255,49 @@ begin
Result:=FEdit<>FCompile;
end;
Procedure TvSetLayout.SetUsePushDescriptor(b:Boolean);
begin
Case b of
True:
if (key.FFlags<>ord(VK_DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR)) then
begin
key.FFlags:=ord(VK_DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR);
Inc(FEdit);
end;
False:
if (key.FFlags=ord(VK_DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR)) then
begin
key.FFlags:=0;
Inc(FEdit);
end;
end;
end;
function TvSetLayout.GetUsePushDescriptor:Boolean;
begin
Result:=(key.FFlags=ord(VK_DESCRIPTOR_SET_LAYOUT_CREATE_PUSH_DESCRIPTOR_BIT_KHR));
end;
Destructor TvPipelineLayout.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyPipelineLayout(Device.FHandle,FHandle,nil);
end;
Procedure TvPipelineLayout.Add(F:TvSetLayout);
Procedure TvPipelineLayout.AddLayout(F:TvSetLayout);
var
i:Integer;
begin
if (F=nil) then Exit;
i:=Length(FLayouts);
SetLength(FLayouts,i+1);
FLayouts[i]:=F;
i:=Length(key.FLayouts);
SetLength(key.FLayouts,i+1);
key.FLayouts[i]:=F;
Inc(FEdit);
end;
Procedure TvPipelineLayout.SetLayouts(const A:AvSetLayout);
begin
key.FLayouts:=A;
Inc(FEdit);
end;
@ -192,18 +305,30 @@ Procedure TvPipelineLayout.AddPushConst(offset,size:TVkUInt32;Flags:TVkShaderSta
var
i:Integer;
begin
i:=Length(FPushConsts);
SetLength(FPushConsts,i+1);
FPushConsts[i].stageFlags:=Flags;
FPushConsts[i].offset :=offset;
FPushConsts[i].size :=size;
i:=Length(key.FPushConsts);
SetLength(key.FPushConsts,i+1);
key.FPushConsts[i].stageFlags:=Flags;
key.FPushConsts[i].offset :=offset;
key.FPushConsts[i].size :=size;
Inc(FEdit);
end;
Procedure TvPipelineLayout.SetPushConst(const A:AvPushConstantRange);
begin
key.FPushConsts:=A;
Inc(FEdit);
end;
Function TvPipelineLayout.isSpace:Boolean;
begin
Result:=FBinds=0;
end;
procedure TvPipelineLayout.Clear;
begin
SetLength(FLayouts,0);
SetLength(FPushConsts,0);
SetLength(key.FLayouts,0);
SetLength(key.FPushConsts,0);
FBinds:=0;
Inc(FEdit);
end;
@ -221,14 +346,16 @@ begin
vkDestroyPipelineLayout(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
if (Length(FLayouts)<>0) then
FBinds:=0;
if (Length(key.FLayouts)<>0) then
begin
_data_set:=nil;
SetLength(_data_set,Length(FLayouts));
For i:=0 to High(FLayouts) do
SetLength(_data_set,Length(key.FLayouts));
For i:=0 to High(key.FLayouts) do
begin
if not FLayouts[i].Compile then Exit;
_data_set[i]:=FLayouts[i].FHandle;
if not key.FLayouts[i].Compile then Exit;
_data_set[i]:=key.FLayouts[i].FHandle;
FBinds:=FBinds+Length(key.FLayouts[i].key.FBinds);
end;
end;
cinfo:=Default(TVkPipelineLayoutCreateInfo);
@ -238,10 +365,10 @@ begin
begin
cinfo.pSetLayouts:=@_data_set[0];
end;
cinfo.pushConstantRangeCount:=Length(FPushConsts);
cinfo.pushConstantRangeCount:=Length(key.FPushConsts);
if (cinfo.pushConstantRangeCount<>0) then
begin
cinfo.pPushConstantRanges:=@FPushConsts[0];
cinfo.pPushConstantRanges:=@key.FPushConsts[0];
end;
r:=vkCreatePipelineLayout(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
@ -259,9 +386,9 @@ var
begin
Result:=FEdit<>FCompile;
if not Result then
if (Length(FLayouts)<>0) then
For i:=0 to High(FLayouts) do
if FLayouts[i].IsEdit then Exit(true);
if (Length(key.FLayouts)<>0) then
For i:=0 to High(key.FLayouts) do
if key.FLayouts[i].IsEdit then Exit(true);
end;
Destructor TvPipeline.Destroy;
@ -375,6 +502,7 @@ begin
12:Result:=VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR;
13:Result:=VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV ;
14:Result:=VK_DESCRIPTOR_TYPE_MUTABLE_VALVE ;
else;
end;
end;
@ -397,6 +525,7 @@ begin
VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR:Result:=12;
VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV :Result:=13;
VK_DESCRIPTOR_TYPE_MUTABLE_VALVE :Result:=14;
else;
end;
end;
@ -406,28 +535,28 @@ var
It:_TvSetLayoutSet.Iterator;
Ik:_TvSetLayoutKey;
Id:_TvDescriptorSetSet.Iterator;
FCounts:array[0..14] of TVkUInt32;
FSize:array of TVkDescriptorPoolSize;
FCounts:TvCountsGroup;
FSizes:AvDescriptorPoolSize;
cinfo:TVkDescriptorPoolCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) and (not IsEdit) then Exit(true);
if (FLayouts.Size=0) then Exit;
FSize:=nil;
FSizes:=Default(AvDescriptorPoolSize);
FmaxSets:=0;
FillChar(FCounts,SizeOf(FCounts),0);
FCounts:=Default(TvCountsGroup);
It:=FLayouts.cbegin;
repeat
Ik:=It.Item^;
if (Ik.Layout<>nil) and (Ik.fcount<>0) then
if (Length(Ik.Layout.FBinds)<>0) then
if (Length(Ik.Layout.key.FBinds)<>0) then
begin
FmaxSets:=FmaxSets+Ik.fcount;
For i:=0 to Ik.fcount-1 do
For b:=0 to High(Ik.Layout.FBinds) do
with Ik.Layout.FBinds[b] do
For b:=0 to High(Ik.Layout.key.FBinds) do
with Ik.Layout.key.FBinds[b] do
begin
Inc(FCounts[_GetIdByType(descriptorType)],descriptorCount);
end;
@ -437,12 +566,12 @@ begin
For i:=0 to 14 do
if (FCounts[i]<>0) then
begin
L:=Length(FSize);
SetLength(FSize,L+1);
FSize[L].type_:=_GetTypeById(i);
FSize[L].descriptorCount:=FCounts[i];
L:=Length(FSizes);
SetLength(FSizes,L+1);
FSizes[L].type_ :=_GetTypeById(i);
FSizes[L].descriptorCount:=FCounts[i];
end;
if (Length(FSize)=0) then Exit;
if (Length(FSizes)=0) then Exit;
Id:=FSets.cbegin;
if (Id.Item<>nil) then
@ -467,8 +596,9 @@ begin
cinfo:=Default(TVkDescriptorPoolCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_POOL_CREATE_INFO;
cinfo.poolSizeCount:=Length(FSize);
cinfo.pPoolSizes :=@FSize[0];
cinfo.flags :=ord(VK_DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT);
cinfo.poolSizeCount:=Length(FSizes);
cinfo.pPoolSizes :=@FSizes[0];
cinfo.maxSets :=FmaxSets;
r:=vkCreateDescriptorPool(Device.FHandle,@cinfo,nil,@FHandle);
@ -547,10 +677,10 @@ var
i:Integer;
begin
if (L=nil) then Exit;
if (Length(L.FLayouts)<>0) then
For i:=0 to High(L.FLayouts) do
if (Length(L.key.FLayouts)<>0) then
For i:=0 to High(L.key.FLayouts) do
begin
AddLayout(L.FLayouts[i],count);
AddLayout(L.key.FLayouts[i],count);
end;
end;
@ -564,7 +694,7 @@ begin
if (L=nil) then Exit;
if not _FindLayout(L) then Exit;
if not Compile then Exit;
if (FSets.Size>=FmaxSets) then Exit;
if (FSets.Size>=FmaxSets) then Exit;
ainfo:=Default(TVkDescriptorSetAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_ALLOCATE_INFO;
ainfo.descriptorPool :=FHandle;
@ -633,75 +763,41 @@ begin
inherited;
end;
Procedure TvDescriptorSet.BindUB(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
//VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER
//VK_DESCRIPTOR_TYPE_STORAGE_BUFFER
//VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
//VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC
Procedure TvDescriptorSet.BindBuf(aBind,aElem:TVkUInt32;dtype:TVkDescriptorType;buffer:TVkBuffer;offset,range:TVkDeviceSize);
var
dwrite:TVkWriteDescriptorSet;
buf:TVkDescriptorBufferInfo;
begin
buf:=Default(TVkDescriptorBufferInfo);
buf.buffer:=buffer;
buf.offset:=offset;
buf.range :=range ;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER;
dwrite.descriptorType :=dtype;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSB(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindUBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSTI(aBind,aElem:TVkUInt32;const img:TVkImageView);
Procedure TvDescriptorSet.BindSTI(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
var
dwrite:TVkWriteDescriptorSet;
dimg:TVkDescriptorImageInfo;
begin
dimg:=Default(TVkDescriptorImageInfo);
dimg.imageView:=img;
dimg.imageLayout:=VK_IMAGE_LAYOUT_GENERAL;
dimg.imageView :=img;
dimg.imageLayout:=Layout;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
@ -713,5 +809,253 @@ begin
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
//
Function TvDescriptorSet2.IsValid:Boolean;
begin
Result:=FHandle<>VK_NULL_HANDLE;
end;
Procedure TvDescriptorSet2.BindBuf(aBind,aElem:TVkUInt32;dtype:TVkDescriptorType;buffer:TVkBuffer;offset,range:TVkDeviceSize);
var
dwrite:TVkWriteDescriptorSet;
buf:TVkDescriptorBufferInfo;
begin
buf:=Default(TVkDescriptorBufferInfo);
buf.buffer:=buffer;
buf.offset:=offset;
buf.range :=range ;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=dtype;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet2.BindSTI(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
var
dwrite:TVkWriteDescriptorSet;
dimg:TVkDescriptorImageInfo;
begin
dimg:=Default(TVkDescriptorImageInfo);
dimg.imageView :=img;
dimg.imageLayout:=Layout;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_IMAGE;
dwrite.descriptorCount:=1;
dwrite.pImageInfo :=@dimg;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet2.BindImg(aBind,aElem:TVkUInt32;img:TVkImageView;Layout:TVkImageLayout);
var
dwrite:TVkWriteDescriptorSet;
dimg:TVkDescriptorImageInfo;
begin
dimg:=Default(TVkDescriptorImageInfo);
dimg.imageView :=img;
dimg.imageLayout:=Layout;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE;
dwrite.descriptorCount:=1;
dwrite.pImageInfo :=@dimg;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet2.BindSmp(aBind,aElem:TVkUInt32;smp:TVkSampler);
var
dwrite:TVkWriteDescriptorSet;
dimg:TVkDescriptorImageInfo;
begin
dimg:=Default(TVkDescriptorImageInfo);
dimg.sampler:=smp;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_SAMPLER;
dwrite.descriptorCount:=1;
dwrite.pImageInfo :=@dimg;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Constructor TvSetsPool2.Create(Pipeline:TvPipelineLayout;maxGroup:TVkUInt32);
begin
FPipeline:=Pipeline;
FmaxGroup:=maxGroup;
end;
Destructor TvSetsPool2.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyDescriptorPool(Device.FHandle,FHandle,nil);
end;
function TvSetsPool2.Compile:Boolean;
var
i,b,L:Integer;
FCounts:TvCountsGroup;
FSizes:AvDescriptorPoolSize;
cinfo:TVkDescriptorPoolCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) then Exit(true);
if ({key.}FPipeline=nil) then Exit;
if (FmaxGroup=0) then Exit;
if (not {key.}FPipeline.Compile) then Exit;
FSizes:=Default(AvDescriptorPoolSize);
FmaxSets:=0;
FCounts:=Default(TvCountsGroup);
if Length({key.}FPipeline.key.FLayouts)<>0 then
For i:=0 to High({key.}FPipeline.key.FLayouts) do
With {key.}FPipeline.key.FLayouts[i] do
if (Length(key.FBinds)<>0) then
begin
Inc(FmaxSets,FmaxGroup);
For b:=0 to High(key.FBinds) do
with key.FBinds[b] do
begin
Inc(FCounts[_GetIdByType(descriptorType)],descriptorCount*FmaxGroup);
end;
end;
For i:=0 to 14 do
if (FCounts[i]<>0) then
begin
L:=Length(FSizes);
SetLength(FSizes,L+1);
FSizes[L].type_ :=_GetTypeById(i);
FSizes[L].descriptorCount:=FCounts[i];
end;
if (Length(FSizes)=0) then Exit;
cinfo:=Default(TVkDescriptorPoolCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_POOL_CREATE_INFO;
//cinfo.flags :=ord(VK_DESCRIPTOR_POOL_CREATE_FREE_DESCRIPTOR_SET_BIT);
cinfo.poolSizeCount:=Length(FSizes);
cinfo.pPoolSizes :=@FSizes[0];
cinfo.maxSets :=FmaxSets;
r:=vkCreateDescriptorPool(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateDescriptorPool:',r);
Exit;
end;
//FGroups:=Default(AvDescriptorGroup);
//SetLength(FGroups,FmaxGroup);
Result:=True;
end;
function TvSetsPool2.Alloc(L:TvSetLayout):TvDescriptorSet2;
var
ainfo:TVkDescriptorSetAllocateInfo;
FResult:TVkDescriptorSet;
r:TVkResult;
begin
Result:=Default(TvDescriptorSet2);
if (L=nil) then Exit;
if L.IsSpace then Exit;
if not Compile then Exit;
ainfo:=Default(TVkDescriptorSetAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_ALLOCATE_INFO;
ainfo.descriptorPool :=FHandle;
ainfo.descriptorSetCount:=1;
ainfo.pSetLayouts:=@L.FHandle;
r:=vkAllocateDescriptorSets(Device.FHandle,@ainfo,@FResult);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateDescriptorSets:',r);
Exit;
end;
Result.FHandle:=FResult;
end;
{
function TvSetsPool2.Alloc:TvDescriptorGroup;
var
i,s:Integer;
begin
Result:=nil;
if Length(FGroups)<>0 then
For i:=0 to High(FGroups) do
begin
if (FGroups[i]=nil) then
begin
Result:=TvDescriptorGroup.Create;
Result.lock:=1;
SetLength(Result.FSets,Length(key.FPipeline.key.FLayouts));
If (Length(Result.FSets)<>0) then
For s:=0 to High(Result.FSets) do
begin
Result.FSets[s]:=Alloc(key.FPipeline.key.FLayouts[s]);
end;
FGroups[i]:=Result;
end else
if (FGroups[i].lock=0) then
begin
Result:=FGroups[i];
Result.lock:=1;
Exit;
end;
end;
end;
}
function TvSetsPool2.IsFull:Boolean;
begin
Result:=(FAlcGroup>=FmaxGroup);
end;
function TvSetsPool2.Alloc:AvDescriptorSet2;
var
i:Integer;
begin
Result:=nil;
if IsFull then Exit;
SetLength(Result,Length(FPipeline.key.FLayouts));
If (Length(Result)<>0) then
For i:=0 to High(Result) do
begin
Result[i]:=Alloc(FPipeline.key.FLayouts[i]);
end;
Inc(FAlcGroup);
end;
{
Procedure TvDescriptorGroup.Release;
begin
lock:=0;
end;
}
end.

140
vulkan/vPipelineLayoutManager.pas Normal file
View File

@ -0,0 +1,140 @@
unit vPipelineLayoutManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
g23tree,
Vulkan,
vPipeline;
Function FetchPipelineLayout(const A:AvSetLayout;
const B:AvPushConstantRange):TvPipelineLayout;
implementation
type
TvPipelineLayoutCompare=class
class function c(a,b:PvPipelineLayoutKey):Integer; static;
end;
_TvPipelineLayoutPool=specialize T23treeSet<PvPipelineLayoutKey,TvPipelineLayoutCompare>;
TvPipelineLayoutPool=object(_TvPipelineLayoutPool)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FPipelineLayoutPool:TvPipelineLayoutPool;
Procedure TvPipelineLayoutPool.Init;
begin
rwlock_init(lock);
end;
Procedure TvPipelineLayoutPool.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvPipelineLayoutPool.Unlock;
begin
rwlock_unlock(lock);
end;
Function FetchPipelineLayout(const A:AvSetLayout;
const B:AvPushConstantRange):TvPipelineLayout;
var
key:TvPipelineLayoutKey;
t:TvPipelineLayout;
i:TvPipelineLayoutPool.Iterator;
begin
key:=Default(TvPipelineLayoutKey);
key.FLayouts :=A;
key.FPushConsts:=B;
FPipelineLayoutPool.Lock_wr;
i:=FPipelineLayoutPool.find(@key);
if (i.Item=nil) then
begin
t:=TvPipelineLayout.Create;
t.key:=key;
FPipelineLayoutPool.Insert(@t.key);
Result:=t;
end else
begin
t:=TvPipelineLayout(ptruint(i.Item^)-ptruint(@TvPipelineLayout(nil).key));
Result:=t;
end;
FPipelineLayoutPool.Unlock;
t.Compile;
end;
function ComparePtruint(buf1,buf2:PPtruint;count:PtrUint):Integer;
begin
Result:=0;
While (count<>0) do
begin
Result:=Integer(buf1^>buf2^)-Integer(buf1^<buf2^);
if (Result<>0) then Exit;
Inc(buf1);
Inc(buf2);
Dec(count);
end;
end;
function ComparePushRange(var a,b:TVkPushConstantRange):Integer;
begin
//1 stageFlags
Result:=Integer(a.stageFlags>b.stageFlags)-Integer(a.stageFlags<b.stageFlags);
if (Result<>0) then Exit;
//2 offset
Result:=Integer(a.offset>b.offset)-Integer(a.offset<b.offset);
if (Result<>0) then Exit;
//3 size
Result:=Integer(a.size>b.size)-Integer(a.size<b.size);
end;
function ComparePushRanges(var buf1,buf2:AvPushConstantRange;count:PtrUint):Integer;
var
i:PtrUint;
begin
Result:=0;
if (count<>0) then
For i:=0 to count-1 do
begin
Result:=ComparePushRange(buf1[i],buf2[i]);
if (Result<>0) then Exit;
end;
end;
class function TvPipelineLayoutCompare.c(a,b:PvPipelineLayoutKey):Integer;
begin
//1 Length(FLayouts)
Result:=Integer(Length(a^.FLayouts)>Length(b^.FLayouts))-Integer(Length(a^.FLayouts)<Length(b^.FLayouts));
if (Result<>0) then Exit;
//2 Length(FPushConsts)
Result:=Integer(Length(a^.FPushConsts)>Length(b^.FPushConsts))-Integer(Length(a^.FPushConsts)<Length(b^.FPushConsts));
if (Result<>0) then Exit;
//3 FLayouts
Result:=ComparePtruint(@a^.FLayouts[0],@b^.FLayouts[0],Length(a^.FLayouts));
if (Result<>0) then Exit;
//4 FPushConsts
Result:=ComparePushRanges(a^.FPushConsts,b^.FPushConsts,Length(a^.FPushConsts));
end;
initialization
FPipelineLayoutPool.Init;
end.

819
vulkan/vRender.pas
View File

File diff suppressed because it is too large Load Diff

50
vulkan/vSampler.pas Normal file
View File

@ -0,0 +1,50 @@
unit vSampler;
{$mode objfpc}{$H+}
interface
uses
Vulkan,
vDevice;
type
TvSampler=class
FHandle:TVkSampler;
function Compile(pInfo:PVkSamplerCreateInfo):Boolean;
Destructor Destroy; override;
end;
implementation
function TvSampler.Compile(pInfo:PVkSamplerCreateInfo):Boolean;
var
r:TVkResult;
begin
Result:=False;
if (pInfo=nil) then Exit;
if (FHandle<>VK_NULL_HANDLE) then
begin
vkDestroySampler(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
r:=vkCreateSampler(Device.FHandle,pInfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImage:',r);
Exit;
end;
Result:=True;
end;
Destructor TvSampler.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroySampler(Device.FHandle,FHandle,nil);
inherited;
end;
end.

144
vulkan/vSamplerManager.pas Normal file
View File

@ -0,0 +1,144 @@
unit vSamplerManager;
{$mode objfpc}{$H+}
interface
uses
ps4_shader,
ps4_gpu_regs,
SysUtils,
RWLock,
g23tree,
Vulkan,
vDevice,
vSampler,
vCmdBuffer;
function FetchSampler(cmd:TvCustomCmdBuffer;PS:PSSharpResource4):TvSampler;
implementation
type
TvSampler2Compare=object
function c(a,b:PSSharpResource4):Integer; static;
end;
TvSampler2=class(TvSampler)
key:TSSharpResource4;
//
FRefs:ptruint;
Procedure Acquire;
procedure Release(Sender:TObject);
end;
_TvSampler2Set=specialize T23treeSet<PSSharpResource4,TvSampler2Compare>;
TvSampler2Set=object(_TvSampler2Set)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FSampler2Set:TvSampler2Set;
Procedure TvSampler2Set.Init;
begin
rwlock_init(lock);
end;
Procedure TvSampler2Set.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvSampler2Set.Unlock;
begin
rwlock_unlock(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));
end;
function _Find(PS:PSSharpResource4):TvSampler2;
var
i:TvSampler2Set.Iterator;
begin
Result:=nil;
i:=FSampler2Set.find(PS);
if (i.Item<>nil) then
begin
Result:=TvSampler2(ptruint(i.Item^)-ptruint(@TvSampler2(nil).key));
end;
end;
function _FetchSampler(PS:PSSharpResource4):TvSampler2;
var
t:TvSampler2;
info:TVkSamplerCreateInfo;
begin
Result:=nil;
t:=_Find(PS);
if (t=nil) then
begin
info:=_get_ssharp_info(PS);
t:=TvSampler2.Create;
t.key:=PS^;
if not t.Compile(@info) then
begin
FreeAndNil(t);
end else
begin
t.Acquire;
FSampler2Set.Insert(@t.key);
end;
end;
Result:=t;
end;
function FetchSampler(cmd:TvCustomCmdBuffer;PS:PSSharpResource4):TvSampler;
begin
if (PS=nil) then Exit;
FSampler2Set.Lock_wr;
Result:=_FetchSampler(PS);
if (cmd<>nil) and (Result<>nil) then
begin
if cmd.AddDependence(@TvSampler2(Result).Release) then
begin
TvSampler2(Result).Acquire;
end;
end;
FSampler2Set.Unlock;
end;
initialization
FSampler2Set.Init;
end.

171
vulkan/vSetLayoutManager.pas Normal file
View File

@ -0,0 +1,171 @@
unit vSetLayoutManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
g23tree,
Vulkan,
vPipeline;
Function FetchSetLayout(FStage:TVkShaderStageFlags;
FFlags:TVkUInt32;
const A:AVkDescriptorSetLayoutBinding):TvSetLayout;
implementation
type
TvSetLayoutCompare=class
class function c(a,b:PvSetLayoutKey):Integer; static;
end;
_TvSetLayoutsPool=specialize T23treeSet<PvSetLayoutKey,TvSetLayoutCompare>;
TvSetLayoutsPool=object(_TvSetLayoutsPool)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FSetLayoutsPool:TvSetLayoutsPool;
Procedure TvSetLayoutsPool.Init;
begin
rwlock_init(lock);
end;
Procedure TvSetLayoutsPool.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvSetLayoutsPool.Unlock;
begin
rwlock_unlock(lock);
end;
function CompareBind(var a,b:TVkDescriptorSetLayoutBinding):Integer; forward;
procedure BubbleSort(Var A:AVkDescriptorSetLayoutBinding);
var
n,w,i:Integer;
procedure Swap(var A,B:TVkDescriptorSetLayoutBinding); inline;
var
T:TVkDescriptorSetLayoutBinding;
begin
T:=A;
A:=B;
B:=T;
end;
begin
if (Length(A)=0) then Exit;
n:=High(A);
repeat
w:=0;
for i:=1 to n do
begin
if (CompareBind(A[i-1],A[i])>0) then
begin
Swap(A[i-1],A[i]);
w:=i;
end;
end;
n:=w;
until (n=0);
end;
Function FetchSetLayout(FStage:TVkShaderStageFlags;
FFlags:TVkUInt32;
const A:AVkDescriptorSetLayoutBinding):TvSetLayout;
var
key:TvSetLayoutKey;
t:TvSetLayout;
i:TvSetLayoutsPool.Iterator;
begin
key:=Default(TvSetLayoutKey);
key.FStage:=FStage;
key.FFlags:=FFlags;
key.FBinds:=A;
BubbleSort(key.FBinds);
FSetLayoutsPool.Lock_wr;
i:=FSetLayoutsPool.find(@key);
if (i.Item=nil) then
begin
t:=TvSetLayout.Create;
t.key:=key;
FSetLayoutsPool.Insert(@t.key);
Result:=t;
end else
begin
t:=TvSetLayout(ptruint(i.Item^)-ptruint(@TvSetLayout(nil).key));
Result:=t;
end;
FSetLayoutsPool.Unlock;
t.Compile;
end;
function CompareBind(var a,b:TVkDescriptorSetLayoutBinding):Integer;
begin
//1 binding
Result:=Integer(a.binding>b.binding)-Integer(a.binding<b.binding);
if (Result<>0) then Exit;
//2 descriptorType
Result:=Integer(a.descriptorType>b.descriptorType)-Integer(a.descriptorType<b.descriptorType);
if (Result<>0) then Exit;
//3 descriptorCount
Result:=Integer(a.descriptorCount>b.descriptorCount)-Integer(a.descriptorCount<b.descriptorCount);
if (Result<>0) then Exit;
//4 stageFlags
Result:=Integer(a.stageFlags>b.stageFlags)-Integer(a.stageFlags<b.stageFlags);
if (Result<>0) then Exit;
//5 pImmutableSamplers
Result:=Integer(a.pImmutableSamplers>b.pImmutableSamplers)-Integer(a.pImmutableSamplers<b.pImmutableSamplers);
end;
function CompareBinds(var buf1,buf2:AVkDescriptorSetLayoutBinding;count:PtrUint):Integer;
var
i:PtrUint;
begin
Result:=0;
if (count<>0) then
For i:=0 to count-1 do
begin
Result:=CompareBind(buf1[i],buf2[i]);
if (Result<>0) then Exit;
end;
end;
class function TvSetLayoutCompare.c(a,b:PvSetLayoutKey):Integer;
begin
//1 FStage
Result:=Integer(a^.FStage>b^.FStage)-Integer(a^.FStage<b^.FStage);
if (Result<>0) then Exit;
//2 FFlag
Result:=Integer(a^.FFlags>b^.FFlags)-Integer(a^.FFlags<b^.FFlags);
if (Result<>0) then Exit;
//3 Length(FBinds)
Result:=Integer(Length(a^.FBinds)>Length(b^.FBinds))-Integer(Length(a^.FBinds)<Length(b^.FBinds));
if (Result<>0) then Exit;
//4 FBinds
Result:=CompareBinds(a^.FBinds,b^.FBinds,Length(a^.FBinds));
end;
initialization
FSetLayoutsPool.Init;
end.

205
vulkan/vSetsPoolManager.pas Normal file
View File

@ -0,0 +1,205 @@
unit vSetsPoolManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
RWLock,
LFQueue,
g23tree,
Vulkan,
vPipeline,
vCmdBuffer;
Function FetchDescriptorGroup(cmd:TvCustomCmdBuffer;Pipeline:TvPipelineLayout):TvDescriptorGroup;
implementation
type
TvSetsPoolUnbound=class;
TvDescriptorGroupNode=class(TvDescriptorGroup)
parent:TvSetsPoolUnbound;
pNext:Pointer;
Procedure Release(Sender:TObject);
end;
TvSetsPool2Compare=object
function c(a,b:TvSetsPool2):Integer; static;
end;
TvSetsPool2Set=specialize T23treeSet<TvSetsPool2,TvSetsPool2Compare>;
PvPipelineLayout=^TvPipelineLayout;
TvSetsPoolUnboundCompare=object
function c(a,b:PvPipelineLayout):Integer; static;
end;
TvSetsPoolUnbound=class
FPipeline:TvPipelineLayout;
FQueue:TIntrusiveMPSCQueue;
FPools:TvSetsPool2Set;
FLast:TvSetsPool2;
Constructor Create(Pipeline:TvPipelineLayout);
Procedure NewPool;
function Alloc:TvDescriptorGroupNode;
procedure PushNode(N:TvDescriptorGroupNode);
function PopNode:TvDescriptorGroupNode;
end;
_TvSetsPoolUnbounds=specialize T23treeSet<PvPipelineLayout,TvSetsPoolUnboundCompare>;
TvSetsPoolUnbounds=object(_TvSetsPoolUnbounds)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FSetsPoolUnbounds:TvSetsPoolUnbounds;
Procedure TvSetsPoolUnbounds.Init;
begin
rwlock_init(lock);
end;
Procedure TvSetsPoolUnbounds.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TvSetsPoolUnbounds.Unlock;
begin
rwlock_unlock(lock);
end;
function TvSetsPool2Compare.c(a,b:TvSetsPool2):Integer;
begin
Result:=Integer(Pointer(a)>Pointer(b))-Integer(Pointer(a)<Pointer(b));
end;
function TvSetsPoolUnboundCompare.c(a,b:PvPipelineLayout):Integer;
begin
Result:=Integer(Pointer(a^)>Pointer(b^))-Integer(Pointer(a^)<Pointer(b^));
end;
Constructor TvSetsPoolUnbound.Create(Pipeline:TvPipelineLayout);
begin
FPipeline:=Pipeline;
FQueue.Create;
end;
Procedure TvSetsPoolUnbound.NewPool;
var
N:TvSetsPool2;
begin
N:=TvSetsPool2.Create(FPipeline,2);
if N.Compile then
begin
FPools.Insert(N);
FLast:=N;
end else
begin
Assert(False,'NewPool');
N.Free;
end;
end;
function TvSetsPoolUnbound.Alloc:TvDescriptorGroupNode;
begin
Result:=PopNode;
if (Result<>nil) then Exit;
if (FLast=nil) then NewPool;
if FLast.IsFull then NewPool;
Result:=TvDescriptorGroupNode.Create;
Result.parent:=Self;
Result.FSets:=FLast.Alloc;
end;
procedure TvSetsPoolUnbound.PushNode(N:TvDescriptorGroupNode);
begin
FQueue.Push(@N.pNext);
end;
function TvSetsPoolUnbound.PopNode:TvDescriptorGroupNode;
var
Node:PPointer;
begin
Result:=nil;
Node:=nil;
if FQueue.Pop(Node) then
begin
Result:=TvDescriptorGroupNode(ptruint(Node)-ptruint(@TvDescriptorGroupNode(nil).pNext));
end;
end;
Procedure TvDescriptorGroupNode.Release(Sender:TObject);
begin
if (parent<>nil) then
begin
parent.PushNode(Self);
end;
end;
function _Find(Pipeline:TvPipelineLayout):TvSetsPoolUnbound;
var
i:TvSetsPoolUnbounds.Iterator;
begin
Result:=nil;
i:=FSetsPoolUnbounds.find(@Pipeline);
if (i.Item<>nil) then
begin
Result:=TvSetsPoolUnbound(ptruint(i.Item^)-ptruint(@TvSetsPoolUnbound(nil).FPipeline));
end;
end;
Function _Fetch(Pipeline:TvPipelineLayout):TvDescriptorGroupNode;
var
t:TvSetsPoolUnbound;
n:TvDescriptorGroupNode;
begin
Result:=nil;
t:=_Find(Pipeline);
if (t=nil) then
begin
t:=TvSetsPoolUnbound.Create(Pipeline);
FSetsPoolUnbounds.Insert(@t.FPipeline);
end;
n:=t.Alloc;
Result:=n;
end;
Function FetchDescriptorGroup(cmd:TvCustomCmdBuffer;Pipeline:TvPipelineLayout):TvDescriptorGroup;
begin
Result:=nil;
if (Pipeline=nil) then Exit;
if Pipeline.isSpace then Exit;
FSetsPoolUnbounds.Lock_wr;
Result:=_Fetch(Pipeline);
if (cmd<>nil) and (Result<>nil) then
begin
cmd.AddDependence(@TvDescriptorGroupNode(Result).Release);
end;
FSetsPoolUnbounds.Unlock;
end;
initialization
FSetsPoolUnbounds.Init;
end.

183
vulkan/vShader.pas
View File

@ -10,26 +10,36 @@ uses
type
TvSupportDescriptorType=array[0..1] of TVkDescriptorType;
PvShaderBind=^TvShaderBind;
{PvShaderBind=^TvShaderBind;
TvShaderBind=packed object
FDVID:DWORD;
FDSET:DWORD;
FBIND:DWORD;
FSCLS:DWORD;
FTYPE:DWORD;
end;
end;}
TvShader=class
FHandle:TVkShaderModule;
FStage:TVkShaderStageFlagBits;
FLocalSize:TVkOffset3D;
FEntry:RawByteString;
FBinds:array of TvShaderBind;
//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 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
@ -40,6 +50,13 @@ begin
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;
@ -48,10 +65,8 @@ begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyShaderModule(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
FStage:=Default(TVkShaderStageFlagBits);
FLocalSize:=TVkOffset3D.Create(1,1,1);
FEntry:='';
SetLength(FBinds,0);
ClearInfo;
Parse(data,size);
cinfo:=Default(TVkShaderModuleCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO;
cinfo.codeSize:=size;
@ -62,7 +77,6 @@ begin
Writeln('vkCreateShaderModule:',r);
Exit;
end;
Parse(data,size);
end;
procedure TvShader.LoadFromStream(Stream:TStream);
@ -86,14 +100,30 @@ end;
procedure TvShader.LoadFromFile(const FileName:RawByteString);
Var
S:TFileStream;
F:THandle;
data:Pointer;
size:Int64;
begin
S:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
Try
LoadFromStream(S);
finally
S.Free;
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;
type
@ -117,6 +147,7 @@ type
Const
MagicNumber = 119734787;
//Operation
OpSourceExtension = 4;
OpEntryPoint = 15;
OpExecutionMode = 16;
OpTypeVoid = 19;
@ -170,15 +201,39 @@ Const
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;
//orig_data:Pointer;
//orig_size:Ptruint;
I:TSPIRVInstruction;
f:Ptruint;
r:PvShaderBind;
//r:PvShaderBind;
d:dword;
{
function Fetch(ID:DWORD):PvShaderBind;
var
i:Integer;
@ -196,29 +251,6 @@ var
Result:=@FBinds[i];
end;
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
Result:=Default(TVkShaderStageFlagBits);
end;
end;
function find_pointer_type(data:Pointer;size:Ptruint;var id:DWORD):boolean;
var
I:TSPIRVInstruction;
@ -284,6 +316,7 @@ var
size:=size-f;
until false;
end;
}
@ -293,15 +326,22 @@ begin
data:=data+SizeOf(TSPIRVHeader);
size:=size-SizeOf(TSPIRVHeader);
orig_data:=data;
orig_size:=size;
//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;
@ -313,9 +353,7 @@ begin
LocalSize:
if (I.COUNT>=6) then
begin
FLocalSize.x:=PDWORD(data)[3];
FLocalSize.y:=PDWORD(data)[4];
FLocalSize.z:=PDWORD(data)[5];
OnLocalSize(PDWORD(data)[3],PDWORD(data)[4],PDWORD(data)[5]);
end;
end;
end;
@ -324,24 +362,26 @@ begin
begin
d:=PDWORD(data)[2];
case d of
Sample:
{Sample:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FSCLS:=Sample shl 16;
end;
end;}
Binding:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FBIND:=PDWORD(data)[3];
OnBinding(PDWORD(data)[1],PDWORD(data)[3]);
//r:=Fetch(PDWORD(data)[1]);
//r^.FBIND:=PDWORD(data)[3];
end;
DescriptorSet:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FDSET:=PDWORD(data)[3];
OnDescriptorSet(PDWORD(data)[1],PDWORD(data)[3]);
//r:=Fetch(PDWORD(data)[1]);
//r^.FDSET:=PDWORD(data)[3];
end;
end;
end;
OpVariable:
{OpVariable:
if (I.COUNT>=4) then
begin
d:=PDWORD(data)[3];
@ -361,7 +401,7 @@ begin
end;
end;
end;
end;
end;}
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
@ -371,6 +411,41 @@ begin
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,

900
vulkan/vShaderExt.pas Normal file
View File

@ -0,0 +1,900 @@
unit vShaderExt;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
ps4_shader,
ps4_gpu_regs,
vulkan,
vDevice,
vPipeline,
vShader,
vImage,
vSetLayoutManager,
vPipelineLayoutManager{,
vSetsPoolManager};
type
TvResourceType=(
vtBufPtr2,
vtFunPtr2,
vtVSharp4,
vtSSharp4,
vtTSharp4,
vtTSharp8
);
TvDataLayout=packed record
rtype:TvResourceType;
parent:DWORD;
offset:DWORD;
end;
ADataLayout=array of TvDataLayout;
TvFuncCb=procedure(addr:ADataLayout) of object;
TvCustomLayout=packed record
dtype:DWORD;
bind:DWORD;
size:DWORD;
offset:DWORD;
addr:ADataLayout;
end;
ACustomLayout=array of TvCustomLayout;
TvCustomLayoutCb=procedure(const L:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD) of object;
TvShaderExt=class(TvShader)
FDescSetId:Integer;
FSetLayout:TvSetLayout;
FDataLayouts:ADataLayout;
FVertLayouts:ACustomLayout;
FUnifLayouts:ACustomLayout;
FPushConst:TvCustomLayout;
procedure ClearInfo; override;
procedure InitSetLayout;
procedure AddToPipeline(p:TvPipelineLayout);
procedure OnDescriptorSet(var Target,id:DWORD); override;
procedure OnSourceExtension(P:PChar); override;
Procedure AddDataLayout(rtype:TvResourceType;parent,offset:DWORD);
procedure OnDataLayout(P:PChar);
Procedure EnumFuncLayout(cb:TvFuncCb);
function GetLayoutAddr(parent:DWORD):ADataLayout;
Procedure AddVertLayout(parent,bind:DWORD);
procedure OnVertLayout(P:PChar);
Procedure EnumVertLayout(cb:TvCustomLayoutCb;Fset:TVkUInt32;FData:PDWORD);
Procedure AddBuffLayout(dtype:TVkDescriptorType;parent,bind,size,offset:DWORD);
Procedure SetPushConst(parent,size:DWORD);
procedure OnBuffLayout(P:PChar);
Function GetPushConstData(pUserData:Pointer):Pointer;
Procedure AddUnifLayout(dtype:TVkDescriptorType;parent,bind:DWORD);
procedure OnUnifLayout(P:PChar);
Procedure EnumUnifLayout(cb:TvCustomLayoutCb;Fset:TVkUInt32;FData:PDWORD);
end;
TvShaderStage=(
vShaderStageLs,
vShaderStageHs,
vShaderStageEs,
vShaderStageGs,
vShaderStageVs,
vShaderStagePs,
vShaderStageCs
);
AvShaderStage=array[TvShaderStage] of TvShaderExt;
TvShaderGroup=class
FShaders:AvShaderStage;
FLayout:TvPipelineLayout;
Procedure SetLSShader(Shader:TvShaderExt);
Procedure SetHSShader(Shader:TvShaderExt);
Procedure SetESShader(Shader:TvShaderExt);
Procedure SetGSShader(Shader:TvShaderExt);
Procedure SetVSShader(Shader:TvShaderExt);
Procedure SetPSShader(Shader:TvShaderExt);
Procedure SetCSShader(Shader:TvShaderExt);
Procedure Clear;
Function Compile:Boolean;
Procedure ExportStages(Stages:PVkPipelineShaderStageCreateInfo;stageCount:PVkUInt32);
end;
TAttrBindExt=packed record
min_addr:Pointer;
binding:TVkUInt32;
stride:TVkUInt32;
count:TVkUInt32;
end;
TvAttrBuilder=object
FBindDescs:array of TVkVertexInputBindingDescription;
FAttrDescs:array of TVkVertexInputAttributeDescription;
FBindExt:array of TAttrBindExt;
function NewBindDesc(binding,stride:TVkUInt32):TVkUInt32;
procedure NewAttrDesc(location,binding,offset:TVkUInt32;format:TVkFormat);
procedure PatchAttr(binding,offset:TVkUInt32);
Procedure AddVSharp(PV:PVSharpResource4;location:DWord);
procedure AddAttr(const v:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
end;
TBufBindExt=packed record
fset:TVkUInt32;
bind:TVkUInt32;
offset:TVkUInt32;
addr:Pointer;
size:TVkUInt32;
end;
TImageBindExt=packed record
fset:TVkUInt32;
bind:TVkUInt32;
FImage:TvImageKey;
FView:TvImageViewKey;
end;
TSamplerBindExt=packed record
fset:TVkUInt32;
bind:TVkUInt32;
PS:PSSharpResource4;
end;
TvUniformBuilder=object
FBuffers :array of TBufBindExt;
FImages :array of TImageBindExt;
FSamplers:array of TSamplerBindExt;
Procedure AddVSharp(PV:PVSharpResource4;fset,bind,offset:DWord);
Procedure AddBufPtr(P:Pointer;fset,size,bind,offset:DWord);
Procedure AddTSharp4(PT:PTSharpResource4;fset,bind:DWord);
Procedure AddSSharp4(PS:PSSharpResource4;fset,bind:DWord);
procedure AddAttr(const b:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
end;
TvBufOffsetChecker=object
FResult:Boolean;
procedure AddAttr(const b:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
end;
TvFuncLayout=object
FList:array of ADataLayout;
Procedure Add(addr:ADataLayout);
end;
function GetSharpByPatch(pData:Pointer;addr:ADataLayout):Pointer;
implementation
procedure TvShaderExt.ClearInfo;
begin
inherited;
FSetLayout:=nil;
FDataLayouts:=Default(ADataLayout);
FVertLayouts:=Default(ACustomLayout);
FUnifLayouts:=Default(ACustomLayout);
FPushConst:=Default(TvCustomLayout);
end;
procedure TvShaderExt.InitSetLayout;
var
i:Integer;
A:AVkDescriptorSetLayoutBinding;
begin
if (FSetLayout<>nil) then Exit;
A:=Default(AVkDescriptorSetLayoutBinding);
SetLength(A,Length(FUnifLayouts)); //++ other todo
if (Length(FUnifLayouts)<>0) then
For i:=0 to High(FUnifLayouts) do
begin
A[i]:=Default(TVkDescriptorSetLayoutBinding);
A[i].binding :=FUnifLayouts[i].bind;
A[i].descriptorType :=TVkDescriptorType(FUnifLayouts[i].dtype);
A[i].descriptorCount:=1;
A[i].stageFlags :=ord(FStage);
end;
FSetLayout:=FetchSetLayout(ord(FStage),0,A);
end;
procedure TvShaderExt.AddToPipeline(p:TvPipelineLayout);
begin
InitSetLayout;
p.AddLayout(FSetLayout);
if (FPushConst.size<>0) then
begin
p.AddPushConst(0,FPushConst.size,ord(FStage));
end;
end;
procedure TvShaderExt.OnDescriptorSet(var Target,id:DWORD);
begin
if (FDescSetId>=0) then id:=FDescSetId;
end;
function _get_hex_dword(P:PChar):DWord;
var
Error:word;
s:string[9];
begin
s[0]:=#9;
s[1]:='$';
PQWORD(@s[2])^:=PQWORD(P)^;
Result:=0;
Val(s,Result,Error);
end;
//0123456789ABCDEF0123456789ABCDEF012345678
//#B;PID=00000000;OFS=00000000
//VA;PID=00000004;BND=00000000
//BP;PID=00000003;BND=00000000;LEN=00000040
//UI;PID=00000001;BND=00000000
//US;PID=00000002;BND=00000001
procedure TvShaderExt.OnSourceExtension(P:PChar);
begin
//Writeln(P);
Case P^ of
'#':OnDataLayout(P);
'V':OnVertLayout(P);
'B':OnBuffLayout(P);
'U':OnUnifLayout(P);
end;
end;
Procedure TvShaderExt.AddDataLayout(rtype:TvResourceType;parent,offset:DWORD);
var
i:Integer;
begin
i:=Length(FDataLayouts);
SetLength(FDataLayouts,i+1);
FDataLayouts[i].rtype :=rtype;
FDataLayouts[i].parent:=parent;
FDataLayouts[i].offset:=offset;
end;
procedure TvShaderExt.OnDataLayout(P:PChar);
begin
Case P[1] of
'B':AddDataLayout(vtBufPtr2,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
'F':AddDataLayout(vtFunPtr2,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
'V':AddDataLayout(vtVSharp4,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
'S':AddDataLayout(vtSSharp4,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
't':AddDataLayout(vtTSharp4,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
'T':AddDataLayout(vtTSharp8,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
end;
end;
Procedure TvShaderExt.EnumFuncLayout(cb:TvFuncCb);
var
i:Integer;
begin
if (cb=nil) then Exit;
if (Length(FDataLayouts)=0) then Exit;
For i:=0 to High(FDataLayouts) do
if (FDataLayouts[i].rtype=vtFunPtr2) then
begin
cb(GetLayoutAddr(i));
end;
end;
function TvShaderExt.GetLayoutAddr(parent:DWORD):ADataLayout;
var
i:Integer;
begin
Result:=Default(ADataLayout);
repeat
if (parent>=Length(FDataLayouts)) then
begin
SetLength(Result,0);
Break;
end;
i:=Length(Result);
SetLength(Result,i+1);
Result[i]:=FDataLayouts[parent];
if (parent=0) then Break;
parent:=FDataLayouts[parent].parent;
until false;
end;
Procedure AddToCustomLayout(var A:ACustomLayout;const v:TvCustomLayout);
var
i:Integer;
begin
i:=Length(A);
SetLength(A,i+1);
A[i]:=v;
end;
Procedure TvShaderExt.AddVertLayout(parent,bind:DWORD);
var
v:TvCustomLayout;
begin
v:=Default(TvCustomLayout);
v.bind:=bind;
v.addr:=GetLayoutAddr(parent);
AddToCustomLayout(FVertLayouts,v);
end;
procedure TvShaderExt.OnVertLayout(P:PChar);
begin
Case P[1] of
'A':AddVertLayout(_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
end;
end;
Procedure TvShaderExt.EnumVertLayout(cb:TvCustomLayoutCb;Fset:TVkUInt32;FData:PDWORD);
var
i:Integer;
begin
if (cb=nil) then Exit;
if (Length(FVertLayouts)=0) then Exit;
For i:=0 to High(FVertLayouts) do
begin
cb(FVertLayouts[i],Fset,FData);
end;
end;
Procedure TvShaderExt.AddBuffLayout(dtype:TVkDescriptorType;parent,bind,size,offset:DWORD);
var
v:TvCustomLayout;
begin
if (dtype=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER) then
begin
if (size>$FFFF) then //max UBO
begin
dtype:=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER;
end else
begin
dtype:=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER;
end;
end;
v:=Default(TvCustomLayout);
v.dtype:=ord(dtype);
v.bind:=bind;
v.size:=size;
v.offset:=offset;
v.addr:=GetLayoutAddr(parent);
AddToCustomLayout(FUnifLayouts,v);
end;
Procedure TvShaderExt.SetPushConst(parent,size:DWORD);
begin
FPushConst:=Default(TvCustomLayout);
FPushConst.size:=size;
FPushConst.addr:=GetLayoutAddr(parent)
end;
//BS;PID=00000002;BND=00000001;LEN=FFFFFFFF;OFS=00000000"
//0123456789ABCDEF0123456789ABCDEF0123456789ABCDEF
//0 1 2
procedure TvShaderExt.OnBuffLayout(P:PChar);
begin
Case P[1] of
'P':SetPushConst(_get_hex_dword(@P[7]),_get_hex_dword(@P[$21]));
'U':AddBuffLayout(VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER,
_get_hex_dword(@P[7]),
_get_hex_dword(@P[$14]),
_get_hex_dword(@P[$21]),
_get_hex_dword(@P[$2E]));
'S':AddBuffLayout(VK_DESCRIPTOR_TYPE_STORAGE_BUFFER,
_get_hex_dword(@P[7]),
_get_hex_dword(@P[$14]),
_get_hex_dword(@P[$21]),
_get_hex_dword(@P[$2E]));
end;
end;
Function TvShaderExt.GetPushConstData(pUserData:Pointer):Pointer;
begin
Result:=nil;
if (pUserData=nil) then Exit;
if (FPushConst.size=0) then Exit;
Result:=GetSharpByPatch(pUserData,FPushConst.addr);
if (Result=nil) then Exit;
Case FPushConst.addr[0].rtype of
vtVSharp4:Result:=Pointer(PVSharpResource4(Result)^.base);
vtTSharp4,
vtTSharp8:Result:=Pointer(PTSharpResource4(Result)^.base shl 8);
else;
end;
end;
Procedure TvShaderExt.AddUnifLayout(dtype:TVkDescriptorType;parent,bind:DWORD);
var
v:TvCustomLayout;
begin
v:=Default(TvCustomLayout);
v.dtype:=ord(dtype);
v.bind:=bind;
v.addr:=GetLayoutAddr(parent);
AddToCustomLayout(FUnifLayouts,v);
end;
procedure TvShaderExt.OnUnifLayout(P:PChar);
begin
Case P[1] of
'I':AddUnifLayout(VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
'S':AddUnifLayout(VK_DESCRIPTOR_TYPE_SAMPLER ,_get_hex_dword(@P[7]),_get_hex_dword(@P[$14]));
end;
end;
Procedure TvShaderExt.EnumUnifLayout(cb:TvCustomLayoutCb;Fset:TVkUInt32;FData:PDWORD);
var
i:Integer;
begin
if (cb=nil) then Exit;
if (Length(FUnifLayouts)=0) then Exit;
For i:=0 to High(FUnifLayouts) do
begin
cb(FUnifLayouts[i],Fset,FData);
end;
end;
///
function GetSharpByPatch(pData:Pointer;addr:ADataLayout):Pointer;
var
i:Integer;
pSharp:Pointer;
begin
Result:=nil;
if (Length(addr)=0) then Exit;
pSharp:=nil;
For i:=High(addr)-1 downto 0 do
begin
pData:=pData+addr[i].offset;
Case addr[i].rtype of
vtBufPtr2:
begin
pData:=Pointer(PPtrUint(pData)^ and (not 3));
pSharp:=pData;
end;
vtVSharp4:
begin
pSharp:=pData;
pData:=Pointer(PVSharpResource4(pData)^.base);
end;
vtSSharp4:
begin
pSharp:=pData;
Break;
end;
vtTSharp4,
vtTSharp8:
begin
pSharp:=pData;
pData:=Pointer(PTSharpResource4(pData)^.base shl 8);
end;
else
Exit;
end;
end;
Result:=pSharp;
end;
//
function TvAttrBuilder.NewBindDesc(binding,stride:TVkUInt32):TVkUInt32;
var
i:Integer;
begin
i:=Length(FBindDescs);
SetLength(FBindDescs,i+1);
FBindDescs[i]:=Default(TVkVertexInputBindingDescription);
FBindDescs[i].binding :=binding;
FBindDescs[i].stride :=stride;
FBindDescs[i].inputRate:=VK_VERTEX_INPUT_RATE_VERTEX;
Result:=i;
end;
procedure TvAttrBuilder.NewAttrDesc(location,binding,offset:TVkUInt32;format:TVkFormat);
var
i:Integer;
begin
i:=Length(FAttrDescs);
SetLength(FAttrDescs,i+1);
FAttrDescs[i].location:=location;
FAttrDescs[i].binding :=binding ;
FAttrDescs[i].format :=format ;
FAttrDescs[i].offset :=offset ;
end;
procedure TvAttrBuilder.PatchAttr(binding,offset:TVkUInt32);
var
i:Integer;
begin
if Length(FAttrDescs)<>0 then
For i:=0 to High(FAttrDescs) do
if (FAttrDescs[i].binding=binding) then
begin
FAttrDescs[i].offset:=FAttrDescs[i].offset+offset;
end;
end;
function _ptr_diff(p1,p2:Pointer):TVkUInt32;
begin
if (p1>p2) then
Result:=p1-p2
else
Result:=p2-p1;
end;
Procedure TvAttrBuilder.AddVSharp(PV:PVSharpResource4;location:DWord);
var
i:Integer;
begin
if (PV=nil) then Exit;
if Length(FBindExt)<>0 then
For i:=0 to High(FBindExt) do
With FBindExt[i] do
if (stride=PV^.stride) then
if (_ptr_diff(min_addr,Pointer(PV^.base))<=stride-1) then
begin
if (min_addr>Pointer(PV^.base)) then
begin
PatchAttr(binding,min_addr-Pointer(PV^.base));
min_addr:=Pointer(PV^.base);
end;
if (count<PV^.num_records) then
begin
count:=PV^.num_records;
end;
NewAttrDesc(location,binding,Pointer(PV^.base)-min_addr,_get_vsharp_cformat(PV));
Exit;
end;
i:=Length(FBindExt);
SetLength(FBindExt,i+1);
FBindExt[i]:=Default(TAttrBindExt);
FBindExt[i].min_addr:=Pointer(PV^.base);
FBindExt[i].binding :=i;
FBindExt[i].stride :=PV^.stride;
FBindExt[i].count :=PV^.num_records;
NewBindDesc(i,PV^.stride);
NewAttrDesc(location,i,0,_get_vsharp_cformat(PV));
end;
procedure TvAttrBuilder.AddAttr(const v:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
var
PV:PVSharpResource4;
begin
PV:=GetSharpByPatch(FData,v.addr);
//print_vsharp(PV);
AddVSharp(PV,v.bind);
end;
//
Procedure TvUniformBuilder.AddVSharp(PV:PVSharpResource4;fset,bind,offset:DWord);
var
b:TBufBindExt;
i,stride:Integer;
begin
if (PV=nil) then Exit;
//print_vsharp(PV);
b:=Default(TBufBindExt);
b.fset:=fset;
b.bind:=bind;
b.offset:=offset;
b.addr:=Pointer(PV^.base);
stride:=PV^.stride;
if (stride=0) then stride:=1;
b.size:=stride*PV^.num_records;
i:=Length(FBuffers);
SetLength(FBuffers,i+1);
FBuffers[i]:=b;
end;
Procedure TvUniformBuilder.AddBufPtr(P:Pointer;fset,size,bind,offset:DWord);
var
b:TBufBindExt;
i:Integer;
begin
if (P=nil) or (size=0) then Exit;
b:=Default(TBufBindExt);
b.fset:=fset;
b.bind:=bind;
b.offset:=offset;
b.addr:=P;
b.size:=size;
i:=Length(FBuffers);
SetLength(FBuffers,i+1);
FBuffers[i]:=b;
end;
Procedure TvUniformBuilder.AddTSharp4(PT:PTSharpResource4;fset,bind:DWord);
var
b:TImageBindExt;
i:Integer;
begin
if (PT=nil) then Exit;
//print_tsharp4(PT);
b:=Default(TImageBindExt);
b.fset:=fset;
b.bind:=bind;
b.FImage:=_get_tsharp4_image_info(PT);
b.FView :=_get_tsharp4_image_view(PT);
i:=Length(FImages);
SetLength(FImages,i+1);
FImages[i]:=b;
end;
procedure TvUniformBuilder.AddAttr(const b:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
var
P:Pointer;
begin
P:=GetSharpByPatch(FData,b.addr);
if (P=nil) then Exit;
Case TVkDescriptorType(b.dtype) of
VK_DESCRIPTOR_TYPE_SAMPLER:
Case b.addr[0].rtype of
vtSSharp4:AddSSharp4(P,fset,b.bind);
else
Assert(false);
end;
VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE:
Case b.addr[0].rtype of
vtTSharp4:AddTSharp4(P,fset,b.bind);
vtTSharp8:
begin
print_tsharp8(P);
Assert(false);
end;
else
Assert(false);
end;
//VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER=4,
//VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER=5,
VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER,
VK_DESCRIPTOR_TYPE_STORAGE_BUFFER:
Case b.addr[0].rtype of
vtBufPtr2:AddBufPtr(P,Fset,b.size,b.bind,b.offset);
vtVSharp4:AddVSharp(P,Fset,b.bind,b.offset);
else
Assert(false);
end;
else
Assert(false);
end;
//Writeln('----');
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 TvUniformBuilder.AddSSharp4(PS:PSSharpResource4;fset,bind:DWord);
var
b:TSamplerBindExt;
i:Integer;
begin
if (PS=nil) then Exit;
//print_ssharp4(PS);
b:=Default(TSamplerBindExt);
b.fset:=fset;
b.bind:=bind;
b.PS:=PS;
i:=Length(FSamplers);
SetLength(FSamplers,i+1);
FSamplers[i]:=b;
end;
//
Procedure TvShaderGroup.SetLSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_VERTEX_BIT) then
FShaders[vShaderStageLs]:=Shader;
end;
Procedure TvShaderGroup.SetHSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT) then
FShaders[vShaderStageHs]:=Shader;
end;
Procedure TvShaderGroup.SetESShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT) then
FShaders[vShaderStageEs]:=Shader;
end;
Procedure TvShaderGroup.SetGSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_GEOMETRY_BIT) then
FShaders[vShaderStageGs]:=Shader;
end;
Procedure TvShaderGroup.SetVSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_VERTEX_BIT) then
FShaders[vShaderStageVs]:=Shader;
end;
Procedure TvShaderGroup.SetPSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_FRAGMENT_BIT) then
FShaders[vShaderStagePs]:=Shader;
end;
Procedure TvShaderGroup.SetCSShader(Shader:TvShaderExt);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_COMPUTE_BIT) then
FShaders[vShaderStageCs]:=Shader;
end;
Procedure TvShaderGroup.Clear;
begin
FShaders:=Default(AvShaderStage);
FLayout:=nil;;
end;
Function TvShaderGroup.Compile:Boolean;
var
i:TvShaderStage;
c,p:Integer;
A:AvSetLayout;
B:AvPushConstantRange;
begin
if (FLayout<>nil) then Exit(True);
A:=Default(AvSetLayout);
B:=Default(AvPushConstantRange);
c:=0;
p:=0;
For i:=Low(TvShaderStage) to High(TvShaderStage) do
begin
if (FShaders[i]<>nil) then
begin
FShaders[i].InitSetLayout;
SetLength(A,c+1);
A[c]:=FShaders[i].FSetLayout;
Inc(c);
if (FShaders[i].FPushConst.size<>0) then
begin
SetLength(B,p+1);
B[p]:=Default(TVkPushConstantRange);
B[p].stageFlags:=ord(FShaders[i].FStage);
B[p].size :=FShaders[i].FPushConst.size;
Inc(p);
end;
end;
end;
FLayout:=FetchPipelineLayout(A,B);
end;
Procedure TvShaderGroup.ExportStages(Stages:PVkPipelineShaderStageCreateInfo;stageCount:PVkUInt32);
var
i:TvShaderStage;
begin
For i:=Low(TvShaderStage) to High(TvShaderStage) do
if (FShaders[i]<>nil) then
begin
Stages[stageCount^].sType :=VK_STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO;
Stages[stageCount^].stage :=FShaders[i].FStage;
Stages[stageCount^].module:=FShaders[i].FHandle;
Stages[stageCount^].pName :=PChar(FShaders[i].FEntry);
Inc(stageCount^);
end;
end;
procedure TvBufOffsetChecker.AddAttr(const b:TvCustomLayout;Fset:TVkUInt32;FData:PDWORD);
var
P:Pointer;
a:QWORD;
begin
if not FResult then Exit;
P:=GetSharpByPatch(FData,b.addr);
if (P=nil) then Exit;
Case TVkDescriptorType(b.dtype) of
//VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER=4,
//VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER=5,
VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER,
VK_DESCRIPTOR_TYPE_STORAGE_BUFFER:
Case b.addr[0].rtype of
vtBufPtr2:
begin
a:=AlignShift(P,limits.minStorageBufferOffsetAlignment);
if (a<>b.offset) then FResult:=False;
end;
vtVSharp4:
begin
a:=AlignShift(Pointer(PVSharpResource4(P)^.base),limits.minStorageBufferOffsetAlignment);
if (a<>b.offset) then FResult:=False;
end;
else;
end;
else;
end;
end;
Procedure TvFuncLayout.Add(addr:ADataLayout);
var
i:Integer;
begin
i:=Length(FList);
SetLength(FList,i+1);
FList[i]:=addr;
end;
end.

331
vulkan/vShaderManager.pas Normal file
View File

@ -0,0 +1,331 @@
unit vShaderManager;
{$mode objfpc}{$H+}
interface
uses
SysUtils,
Classes,
RWLock,
g23tree,
ps4_pssl,
ps4_shader,
ps4_gpu_regs,
shader_dump,
vDevice,
vShaderExt,
SprvEmit,
emit_post,
emit_alloc,
emit_print,
emit_bin;
type
TShaderFunc=packed object
FLen:Ptruint;
pData:PDWORD;
function c(var a,b:TShaderFunc):Integer;
end;
{
}
PShaderDataKey=^TShaderDataKey;
TShaderDataKey=packed record
FStage:TvShaderStage;
FLen:Ptruint;
pData:PDWORD;
end;
TShaderCache=class
key:TShaderDataKey;
FShaders:array of TvShaderExt;
Destructor Destroy; override;
end;
function FetchShader(FStage:TvShaderStage;FDescSetId:Integer;var GPU_REGS:TGPU_REGS):TvShaderExt;
implementation
type
TShaderCacheCompare=object
function c(a,b:PShaderDataKey):Integer; static;
end;
_TShaderCacheSet=specialize T23treeSet<PShaderDataKey,TShaderCacheCompare>;
TShaderCacheSet=object(_TShaderCacheSet)
lock:TRWLock;
Procedure Init;
Procedure Lock_wr;
Procedure Unlock;
end;
var
FShaderCacheSet:TShaderCacheSet;
Procedure TShaderCacheSet.Init;
begin
rwlock_init(lock);
end;
Procedure TShaderCacheSet.Lock_wr;
begin
rwlock_wrlock(lock);
end;
Procedure TShaderCacheSet.Unlock;
begin
rwlock_unlock(lock);
end;
function Max(a,b:PtrInt):PtrInt; inline;
begin
if (a>b) then Result:=a else Result:=b;
end;
function TShaderCacheCompare.c(a,b:PShaderDataKey):Integer;
begin
//1 FStage
Result:=Integer(a^.FStage>b^.FStage)-Integer(a^.FStage<b^.FStage);
if (Result<>0) then Exit;
//2 FLen
Result:=Integer((a^.FLen>b^.FLen) and (b^.FLen<>0))-Integer((a^.FLen<b^.FLen) and (a^.FLen<>0));
if (Result<>0) then Exit;
//3 pData
Result:=CompareDWord(a^.pData^,b^.pData^,Max(a^.FLen,b^.FLen) div 4);
end;
Destructor TShaderCache.Destroy;
begin
if (Key.pData<>nil) then FreeMem(Key.pData);
inherited;
end;
function TShaderFunc.c(var a,b:TShaderFunc):Integer;
begin
//1 FLen
Result:=Integer((a.FLen>b.FLen) and (b.FLen<>0))-Integer((a.FLen<b.FLen) and (a.FLen<>0));
if (Result<>0) then Exit;
//2 pData
Result:=CompareDWord(a.pData^,b.pData^,Max(a.FLen,b.FLen) div 4);
end;
function _Find(var F:TShaderDataKey):TShaderCache;
var
i:TShaderCacheSet.Iterator;
begin
Result:=nil;
i:=FShaderCacheSet.find(@F);
if (i.Item<>nil) then
begin
Result:=TShaderCache(ptruint(i.Item^)-ptruint(@TShaderCache(nil).key));
end;
end;
function ParseShader(FStage:TvShaderStage;pData:PDWORD;var GPU_REGS:TGPU_REGS):TMemoryStream;
var
SprvEmit:TSprvEmit;
begin
Result:=nil;
SprvEmit:=Default(TSprvEmit);
case FStage of
vShaderStagePs :
begin
SprvEmit.InitPs(GPU_REGS.SPI.PS.RSRC2,GPU_REGS.SPI.PS.INPUT_ENA);
SprvEmit.SetUserData(@GPU_REGS.SPI.PS.USER_DATA);
end;
vShaderStageVs:
begin
SprvEmit.InitVs(GPU_REGS.SPI.VS.RSRC2,GPU_REGS.VGT_NUM_INSTANCES);
SprvEmit.SetUserData(@GPU_REGS.SPI.VS.USER_DATA);
end;
vShaderStageCs:
begin
SprvEmit.InitCs(GPU_REGS.SPI.CS.RSRC2,GPU_REGS.SPI.CS.NUM_THREAD_X,GPU_REGS.SPI.CS.NUM_THREAD_Y,GPU_REGS.SPI.CS.NUM_THREAD_Z);
SprvEmit.SetUserData(@GPU_REGS.SPI.CS.USER_DATA);
end;
else
Exit;
end;
SprvEmit.FPrintAsm :=False;
SprvEmit.FUseVertexInput:=True;
SprvEmit.FUseTexelBuffer:=False;
SprvEmit.FBuffers.cfg.maxUniformBufferRange :=0; // $FFFF
SprvEmit.FBuffers.cfg.PushConstantsOffset :=0; // 0
SprvEmit.FBuffers.cfg.maxPushConstantsSize :=limits.maxPushConstantsSize; // 128
SprvEmit.FBuffers.cfg.minStorageBufferOffsetAlignment:=limits.minStorageBufferOffsetAlignment; // $10
SprvEmit.FBuffers.cfg.minUniformBufferOffsetAlignment:=limits.minUniformBufferOffsetAlignment; // $100
//SprvEmit.FBuffers.cfg.maxPushConstantsSize:=0;
//SprvEmit.FUseVertexInput:=False;
if (SprvEmit.Parse(pData)>1) then
begin
Writeln(StdErr,'Shader Parse Err');
SprvEmit.FAllocator.Free;
Exit;
end;
TSprvEmit_post(SprvEmit).Post;
TSprvEmit_alloc(SprvEmit).Alloc;
//TSprvEmit_print(SprvEmit).Print;
Result:=TMemoryStream.Create;
TSprvEmit_bin(SprvEmit).SaveToStream(Result);
SprvEmit.FAllocator.Free;
end;
function _Fetch(FStage:TvShaderStage;pData:PDWORD;FDescSetId:Integer;var GPU_REGS:TGPU_REGS):TvShaderExt;
var
F:TShaderDataKey;
i:Integer;
FShader:TvShaderExt;
t:TShaderCache;
fdump:RawByteString;
M:TMemoryStream;
pUserData:Pointer;
ch:TvBufOffsetChecker;
begin
F:=Default(TShaderDataKey);
F.FStage:=FStage;
F.pData :=pData;
t:=_Find(F);
if (t<>nil) then
begin
Case FStage of
vShaderStageVs:pUserData:=@GPU_REGS.SPI.VS.USER_DATA;
vShaderStagePs:pUserData:=@GPU_REGS.SPI.PS.USER_DATA;
vShaderStageCs:pUserData:=@GPU_REGS.SPI.CS.USER_DATA;
else
Assert(false);
end;
FShader:=nil;
if Length(t.FShaders)<>0 then
For i:=0 to High(t.FShaders) do
begin
FShader:=t.FShaders[i];
ch.FResult:=True;
FShader.EnumUnifLayout(@ch.AddAttr,FDescSetId,pUserData);
if ch.FResult then
begin
Break;
end else
begin
FShader:=nil;
end;
end;
if (FShader=nil) then
begin
M:=ParseShader(FStage,pData,GPU_REGS);
Assert(M<>nil);
FShader:=TvShaderExt.Create;
FShader.FDescSetId:=FDescSetId;
FShader.LoadFromStream(M);
M.Free;
i:=Length(t.FShaders);
SetLength(t.FShaders,i+1);
t.FShaders[i]:=FShader;
end;
end else
begin
F.FLen:=_calc_shader_size(pData);
F.pData:=AllocMem(F.FLen);
Move(pData^,F.pData^,F.FLen);
t:=TShaderCache.Create;
t.key:=F;
{
Case FStage of
vShaderStageVs:fdump:=DumpVS(GPU_REGS);
vShaderStagePs:fdump:=DumpPS(GPU_REGS);
vShaderStageCs:fdump:=DumpCS(GPU_REGS);
else
Assert(false);
end;
FShader:=TvShaderExt.Create;
FShader.FDescSetId:=FDescSetId;
FShader.LoadFromFile(ChangeFileExt(fdump,'.spv'));
}
M:=ParseShader(FStage,pData,GPU_REGS);
Assert(M<>nil);
FShader:=TvShaderExt.Create;
FShader.FDescSetId:=FDescSetId;
FShader.LoadFromStream(M);
M.Free;
SetLength(t.FShaders,1);
t.FShaders[0]:=FShader;
FShaderCacheSet.Insert(@t.key);
end;
Result:=FShader;
end;
function FetchShader(FStage:TvShaderStage;FDescSetId:Integer;var GPU_REGS:TGPU_REGS):TvShaderExt;
var
pData:PDWORD;
begin
Case FStage of
vShaderStageVs:pData:=getCodeAddress(GPU_REGS.SPI.VS.LO,GPU_REGS.SPI.VS.HI);
vShaderStagePs:pData:=getCodeAddress(GPU_REGS.SPI.PS.LO,GPU_REGS.SPI.PS.HI);
vShaderStageCs:pData:=getCodeAddress(GPU_REGS.SPI.CS.LO,GPU_REGS.SPI.CS.HI);
else
Assert(false);
end;
if (pData=nil) then Exit(nil);
//Assert(pData<>nil);
FShaderCacheSet.Lock_wr;
Result:=_Fetch(FStage,pData,FDescSetId,GPU_REGS);
FShaderCacheSet.Unlock;
end;
initialization
FShaderCacheSet.Init;
end.