diff --git a/fpPS4.lpi b/fpPS4.lpi
index 5e4c8c42..1dca0fb9 100644
--- a/fpPS4.lpi
+++ b/fpPS4.lpi
@@ -31,7 +31,7 @@
-
+
@@ -620,6 +620,21 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/fpPS4.lpr b/fpPS4.lpr
index d4641224..3da965f7 100644
--- a/fpPS4.lpr
+++ b/fpPS4.lpr
@@ -14,6 +14,7 @@ uses
sys_types,
sys_pthread,
sys_path,
+ sys_kernel,
ps4libdoc,
ps4_libkernel,
ps4_libSceLibcInternal,
@@ -53,6 +54,7 @@ uses
ps4_libSceComposite,
ps4_libSceSysCore,
ps4_libSceSsl,
+ ps4_libSceFiber,
ps4_libSceUlt,
ps4_libSceGameLiveStreaming,
ps4_libSceSharePlay,
@@ -60,6 +62,8 @@ uses
ps4_libSceContentExport,
ps4_libSceUsbd,
ps4_libSceAudiodecCpu,
+ ps4_libSceDepth,
+ ps4_libSceNpTus,
ps4_elf,
ps4_pthread,
ps4_program,
@@ -224,7 +228,7 @@ end;
procedure print_stub(nid:QWORD;lib:PLIBRARY); MS_ABI_Default;
begin
- Writeln(StdErr,'nop nid:',lib^.strName,':',HexStr(nid,16),':',ps4libdoc.GetFunctName(nid));
+ Writeln(StdErr,SysLogPrefix,'nop nid:',lib^.strName,':',HexStr(nid,16),':',ps4libdoc.GetFunctName(nid));
//DebugBreak;
Sleep(INFINITE);
//readln;
diff --git a/src/np/ps4_libscenptus.pas b/src/np/ps4_libscenptus.pas
new file mode 100644
index 00000000..34f3a3b5
--- /dev/null
+++ b/src/np/ps4_libscenptus.pas
@@ -0,0 +1,32 @@
+unit ps4_libSceNpTus;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ ps4_program;
+
+implementation
+
+function ps4_sceNpTssCreateNpTitleCtx(serviceLabel:DWord;id:Integer):Integer; SysV_ABI_CDecl;
+begin
+ Result:=-1;
+end;
+
+function Load_libSceNpTus(Const name:RawByteString):TElf_node;
+var
+ lib:PLIBRARY;
+begin
+ Result:=TElf_node.Create;
+ Result.pFileName:=name;
+
+ lib:=Result._add_lib('libSceNpTus');
+ lib^.set_proc($B1155BD827F41878,@ps4_sceNpTssCreateNpTitleCtx);
+end;
+
+initialization
+ ps4_app.RegistredPreLoad('libSceNpTus.prx',@Load_libSceNpTus);
+
+end.
+
diff --git a/src/ps4_libscedepth.pas b/src/ps4_libscedepth.pas
new file mode 100644
index 00000000..0647c623
--- /dev/null
+++ b/src/ps4_libscedepth.pas
@@ -0,0 +1,46 @@
+unit ps4_libSceDepth;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ ps4_program;
+
+implementation
+
+type
+ PSceDepthInitializeParameter=Pointer;
+ PSceDepthQueryMemoryResult=Pointer;
+
+function ps4_sceDepthQueryMemory(initParam:PSceDepthInitializeParameter;queryMem:PSceDepthQueryMemoryResult):Integer; SysV_ABI_CDecl;
+begin
+ Writeln('sceDepthQueryMemory');
+ Result:=0;
+end;
+
+function ps4_sceDepthInitialize(initParam:PSceDepthInitializeParameter;queryMem:PSceDepthQueryMemoryResult):Integer; SysV_ABI_CDecl;
+begin
+ Writeln('sceDepthInitialize');
+ Result:=0;
+end;
+
+function Load_libSceDepth(Const name:RawByteString):TElf_node;
+var
+ lib:PLIBRARY;
+begin
+ Result:=TElf_node.Create;
+ Result.pFileName:=name;
+
+ lib:=Result._add_lib('libSceDepth');
+
+ lib^.set_proc($E4CC31224DFF80BA,@ps4_sceDepthQueryMemory);
+ lib^.set_proc($3DA6BD7601E71E94,@ps4_sceDepthInitialize);
+end;
+
+initialization
+ ps4_app.RegistredPreLoad('libSceDepth.prx',@Load_libSceDepth);
+
+end.
+
+
diff --git a/src/ps4_libscefiber.pas b/src/ps4_libscefiber.pas
new file mode 100644
index 00000000..d701798c
--- /dev/null
+++ b/src/ps4_libscefiber.pas
@@ -0,0 +1,403 @@
+unit ps4_libSceFiber;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+ Windows,
+ SysUtils,
+ ps4_program,
+ sys_kernel;
+
+const
+ SCE_FIBER_ERROR_NULL =$80590001;
+ SCE_FIBER_ERROR_RANGE =$80590003;
+ SCE_FIBER_ERROR_INVALID =$80590004;
+ SCE_FIBER_ERROR_PERMISSION=$80590005;
+ SCE_FIBER_ERROR_STATE =$80590006;
+
+ SCE_FIBER_CONTEXT_MINIMUM_SIZE=512;
+ SCE_FIBER_MAX_NAME_LENGTH =31;
+
+ // Our own defined state constants. Not match with the lib
+ FIBER_STATE_INIT =0;
+ FIBER_STATE_RUN =1;
+ FIBER_STATE_SUSPEND=2;
+
+type
+ SceFiberEntry=procedure(argInit,argRun:QWord); SysV_ABI_CDecl;
+
+ // Original struct layout from sce_module v1.75. Different sce_module version may have different struct layout.
+ {
+ SceFiberContext=packed record // Internal struct storing context
+ rsp :QWord; // 8
+ rbp :QWord; // 16
+ rip :QWord; // 24
+ rbx :QWord; // 32
+ r12 :QWord; // 40
+ r13 :QWord; // 48
+ r14 :QWord; // 56
+ r15 :QWord; // 64
+ fnstcw :Word; // 66
+ _unknown1 :array[0..1] of Byte; // 68
+ mxcsr :DWord; // 72
+ end;
+
+ SceFiber=packed record
+ sig1 :DWord; // 4 - Signature = $DEF1649C
+ state :DWord; // 8
+ entry :Pointer; // 16 - Entry function pointer
+ initValue :QWord; // 24
+ addrContext :Pointer; // 32
+ sizeContext :QWord; // 40
+ name :array[0..31] of Byte; // 72
+ context :SceFiberContext; // 144
+ _unknown1 :array[0..87] of Byte; // 232
+ sizeContextMirror:QWord; // 240
+ addrContextEnd :Pointer; // 248 - Point to the start of "stack", probably?
+ _unknown2 :DWord; // 252
+ sig2 :DWord; // 256 - Signature = $B37592A0
+ end;
+
+ SceFiberContext2=packed record // The struct that will be passed to set_context function. It is represented as array of 6 uint64s in ghidra
+ entry :Pointer; // 8
+ initValue :QWord; // 16
+ runValue :QWord; // 24
+ stackAddr :Pointer; // 32 - addrContextEnd
+ returnToMainThreadEntry:Pointer; // 40
+ _unknown1 :Pointer; // 48
+ end;
+ }
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceFiber=packed record
+ handle :Pointer; // 8 - Pointer to Windows's fiber
+ name :array[0..SCE_FIBER_MAX_NAME_LENGTH] of Char; // 40
+ entry :SceFiberEntry; // 48
+ argInit :QWord; // 56
+ pArgRun :PQWord; // 64
+ pArgReturn :PQWord; // 72
+ argRun :QWord; // 80
+ argReturn :QWord; // 88
+ state :QWord; // 96 - 0 = init, 1 = running, 2 = suspend
+ addrContext :Pointer; // 104
+ sizeContext :QWord; // 112
+ sizeContextMargin:QWord; // 120
+ _unknown :array[0..255-120] of Byte; // 256
+ end;
+ PSceFiber =^SceFiber;
+ PPSceFiber=^PSceFiber;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceFiberOptParam=packed record
+ _unknown:array[0..127] of Byte;
+ end;
+ PSceFiberOptParam=^SceFiberOptParam;
+
+ SceFiberInfo=packed record
+ size :QWord; // 8
+ entry :SceFiberEntry; // 16
+ argInit :QWord; // 24
+ addrContext :Pointer; // 32
+ sizeContext :QWord; // 40
+ name :array[0..SCE_FIBER_MAX_NAME_LENGTH] of Char; // 72
+ sizeContextMargin:QWord; // 80
+ _unkown :array[0..127-80] of Byte; // 128
+ end;
+ PSceFiberInfo=^SceFiberInfo;
+
+function GetFiberString:RawByteString;
+function GetFiberStringParam(fiber:PSceFiber):RawByteString;
+function ps4_sceFiberInitialize(fiber :PSceFiber;
+ name :PChar;
+ entry :SceFiberEntry;
+ argInit :QWord;
+ addrContext:Pointer;
+ sizeContext:QWord;
+ option :PSceFiberOptParam):Integer; SysV_ABI_CDecl;
+function ps4_sceFiberFinalize(fiber:PSceFiber):Integer; SysV_ABI_CDecl;
+function ps4_sceFiberSwitch(fiber:PSceFiber;argRunTo:QWord;argRun:PQWord):Integer; SysV_ABI_CDecl;
+function ps4_sceFiberRun(fiber:PSceFiber;argRun:QWord;argReturn:PQWord):Integer; SysV_ABI_CDecl;
+function ps4_sceFiberReturnToThread(argReturn:QWord;argRun:PQWord):Integer; SysV_ABI_CDecl;
+
+implementation
+
+threadvar
+ _threadFiber :Pointer; // TODO: Memory leak if thread is destroyed
+ _currentFiber:PSceFiber;
+
+// Imports
+
+function ConvertThreadToFiber(lpParameter:LPVOID):LPVOID; external 'kernel32' name 'ConvertThreadToFiber';
+function CreateFiber(dwStackSize:size_t;lpStartAddress:LPVOID;lpParameter:LPVOID):LPVOID; external 'kernel32' name 'CreateFiber';
+procedure SwitchToFiber(lpFiber:LPVOID); external 'kernel32' name 'SwitchToFiber';
+procedure DeleteFiber(lpFiber:LPVOID); external 'kernel32' name 'DeleteFiber';
+
+// Wrappers
+
+procedure _CheckFail(P:Pointer);
+begin
+ if P=nil then
+ raise Exception.Create(Format('Error with code %d', [GetLastError]));
+end;
+
+function GetFiberStringParam(fiber:PSceFiber):RawByteString;
+begin
+ Result:='F:['+PChar(@fiber^.name[0])+':'+IntToStr(QWord(fiber^.handle))+'] ';
+end;
+
+function GetFiberString:RawByteString;
+begin
+ if _currentFiber<>nil then
+ Result:=GetFiberStringParam(_currentFiber);
+end;
+
+procedure _CreateThreadFiber;
+begin
+ // Create a main fiber
+ if _threadFiber=nil then
+ begin
+ _threadFiber:=ConvertThreadToFiber(nil);
+ _CheckFail(_threadFiber);
+ end;
+end;
+
+procedure _FiberEntry(fiber:PSceFiber);
+var
+ argRun :QWord=0;
+ argReturn:QWord=0;
+begin
+ _currentFiber:=fiber;
+ Writeln(SysLogPrefix,'_FiberEntry Start');
+ if fiber^.pArgRun<>nil then
+ argRun:=fiber^.pArgRun^;
+ fiber^.entry(fiber^.argInit,argRun);
+ Writeln(SysLogPrefix,'_FiberEntry End');
+ if fiber^.pArgReturn<>nil then
+ argReturn:=fiber^.pArgReturn^;
+ ps4_sceFiberReturnToThread(fiber^.argReturn,fiber^.pArgRun);
+end;
+
+function _CreateFiber(fiber :PSceFiber;
+ name :PChar;
+ entry :SceFiberEntry;
+ argInit :QWord;
+ addrContext:Pointer;
+ sizeContext:QWord):Integer;
+begin
+ fiber^.argInit :=argInit;
+ fiber^.argRun :=0;
+ fiber^.argReturn :=0;
+ fiber^.pArgRun :=@fiber^.argRun;
+ fiber^.pArgReturn :=@fiber^.argReturn;
+ fiber^.entry :=entry;
+ fiber^.state :=FIBER_STATE_INIT;
+ fiber^.addrContext :=addrContext;
+ fiber^.sizeContext :=sizeContext;
+ fiber^.sizeContextMargin:=sizeContext;
+ fiber^.handle :=CreateFiber(sizeContext,@_FiberEntry,fiber);
+ StrLCopy(@fiber^.name[0],name,SCE_FIBER_MAX_NAME_LENGTH);
+ Result:=0;
+end;
+
+function _RunFiber(fiber:PSceFiber;argRun:QWord;argReturn:PQWord):Integer;
+begin
+ if _currentFiber<>nil then
+ Exit(SCE_FIBER_ERROR_PERMISSION);
+ _CreateThreadFiber;
+ _currentFiber :=fiber;
+ if fiber^.pArgRun<>nil then
+ fiber^.pArgRun^ :=argRun;
+ fiber^.pArgReturn:=argReturn;
+ fiber^.state :=FIBER_STATE_RUN;
+ SwitchToFiber(fiber^.handle);
+ Result:=0;
+end;
+
+function _DeleteFiber(fiber:PSceFiber):Integer;
+begin
+ if (fiber^.state=FIBER_STATE_RUN) or (fiber^.state=FIBER_STATE_SUSPEND) then
+ DeleteFiber(fiber^.handle);
+ Result:=0;
+end;
+
+function _ReCreateFiber(fiber:PSceFiber):Integer;
+begin
+ _DeleteFiber(fiber);
+ fiber^.handle:=CreateFiber(fiber^.sizeContext,@_FiberEntry,fiber);
+ fiber^.state :=FIBER_STATE_INIT;
+ Result:=0;
+end;
+
+function _SwitchFiber(fiber:PSceFiber;argRunTo:QWord;argRun:PQWord):Integer; SysV_ABI_CDecl;
+begin
+ if _currentFiber^.addrContext<>nil then
+ begin
+ _currentFiber^.state:=FIBER_STATE_SUSPEND;
+ end else
+ begin
+ _ReCreateFiber(_currentFiber);
+ end;
+ if _currentFiber^.pArgRun<>nil then
+ _currentFiber^.pArgRun^:=argRunTo;
+ fiber^.pArgRun :=argRun;
+ fiber^.state :=FIBER_STATE_RUN;
+ _currentFiber :=fiber;
+ SwitchToFiber(fiber^.handle);
+ Result:=0;
+end;
+
+// APIs
+
+function ps4_sceFiberSwitch(fiber:PSceFiber;argRunTo:QWord;argRun:PQWord):Integer; SysV_ABI_CDecl;
+begin
+ if _currentFiber=nil then
+ Exit(SCE_FIBER_ERROR_PERMISSION);
+ if fiber=nil then
+ Exit(SCE_FIBER_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceFiberSwitch,to=',GetFiberStringParam(fiber));
+ Result:=_SwitchFiber(fiber,argRunTo,argRun);
+end;
+
+function ps4_sceFiberInitialize(fiber :PSceFiber;
+ name :PChar;
+ entry :SceFiberEntry;
+ argInit :QWord;
+ addrContext:Pointer;
+ sizeContext:QWord;
+ option :PSceFiberOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if fiber=nil then
+ Exit(SCE_FIBER_ERROR_NULL);
+ if (sizeContext mod 16<>0) or
+ ((addrContext=nil) and (sizeContext>0)) or
+ ((addrContext<>nil) and (sizeContext=0)) then
+ Exit(SCE_FIBER_ERROR_INVALID);
+ if sizeContextnil then
+ begin
+ _currentFiber^.state:=FIBER_STATE_SUSPEND;
+ end else
+ begin
+ _ReCreateFiber(_currentFiber); // TODO: Proper reset fiber
+ end;
+ _currentFiber^.pArgRun :=argRun;
+ if _currentFiber^.pArgReturn<>nil then
+ _currentFiber^.pArgReturn^:=argReturn;
+ _currentFiber:=nil;
+ SwitchToFiber(_threadFiber);
+ Result:=0;
+end;
+
+function ps4_sceFiberOptParamInitialize(param:PSceFiberOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if param=nil then
+ Exit(SCE_FIBER_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceFiberOptParamInitialize');
+ Result:=0;
+end;
+
+function ps4_sceFiberStartContextSizeCheck(flags:DWord):Integer; SysV_ABI_CDecl;
+begin
+ Writeln(SysLogPrefix,'sceFiberStartContextSizeCheck');
+ Result:=0;
+end;
+
+function ps4_sceFiberStopContextSizeCheck(flags:DWord):Integer; SysV_ABI_CDecl;
+begin
+ Writeln(SysLogPrefix,'sceFiberStopContextSizeCheck');
+ Result:=0;
+end;
+
+function ps4_sceFiberRename(fiber:PSceFiber;name:PChar):Integer; SysV_ABI_CDecl;
+begin
+ //Writeln(SysLogPrefix,'sceFiberRename,fiber=',GetFiberStringParam(fiber),',newName=',name);
+ if fiber=nil then
+ Exit(SCE_FIBER_ERROR_NULL);
+ StrLCopy(@fiber^.name[0],name,SCE_FIBER_MAX_NAME_LENGTH);
+ Result:=0;
+end;
+
+function ps4_sceFiberGetSelf(pfiber:PPSceFiber):Integer; SysV_ABI_CDecl;
+begin
+ if _currentFiber=nil then
+ Exit(SCE_FIBER_ERROR_PERMISSION);
+ if pfiber=nil then
+ Exit(SCE_FIBER_ERROR_NULL);
+ //Writeln(SysLogPrefix,'sceFiberGetSelf');
+ pfiber^:=_currentFiber;
+ Result:=0;
+end;
+
+function ps4_sceFiberGetInfo(fiber:PSceFiber;fiberInfo:PSceFiberInfo):Integer; SysV_ABI_CDecl;
+begin
+ if (fiber=nil) or (fiberInfo=nil) then
+ Exit(SCE_FIBER_ERROR_NULL);
+ fiberInfo^.size :=128;
+ fiberInfo^.entry :=fiber^.entry;
+ fiberInfo^.argInit :=fiber^.argInit;
+ fiberInfo^.addrContext :=fiber^.addrContext;
+ fiberInfo^.sizeContext :=fiber^.sizeContext;
+ fiberInfo^.sizeContextMargin:=fiber^.sizeContextMargin;
+ Result:=0;
+end;
+
+function Load_libSceFiber(Const name:RawByteString):TElf_node;
+var
+ lib:PLIBRARY;
+begin
+ Result:=TElf_node.Create;
+ Result.pFileName:=name;
+
+ lib:=Result._add_lib('libSceFiber');
+
+ lib^.set_proc($855603ECEBB6A424,@ps4_sceFiberInitialize);
+ lib^.set_proc($25E357E45FCDCD05,@ps4_sceFiberFinalize);
+ lib^.set_proc($6B42CBAD959A7343,@ps4_sceFiberRun);
+ lib^.set_proc($3C54F64BFB49ED49,@ps4_sceFiberSwitch);
+ lib^.set_proc($074657DA1C7D0CCC,@ps4_sceFiberReturnToThread);
+ lib^.set_proc($6AC8D4249F9A6BCB,@ps4_sceFiberOptParamInitialize);
+ lib^.set_proc($2DCAADCBE40D5857,@ps4_sceFiberStartContextSizeCheck);
+ lib^.set_proc($2A3E275CCA6733C6,@ps4_sceFiberStopContextSizeCheck);
+ lib^.set_proc($273C93F75B9C1837,@ps4_sceFiberRename);
+ lib^.set_proc($A7ECCB20E836EF35,@ps4_sceFiberGetSelf);
+ lib^.set_proc($BAAD98E41173D0F1,@ps4_sceFiberGetInfo);
+end;
+
+initialization
+ ps4_app.RegistredPreLoad('libSceFiber.prx',@Load_libSceFiber);
+
+end.
+
diff --git a/src/ps4_libsceult.pas b/src/ps4_libsceult.pas
index 44d20bca..02332868 100644
--- a/src/ps4_libsceult.pas
+++ b/src/ps4_libsceult.pas
@@ -1,20 +1,739 @@
unit ps4_libSceUlt;
{$mode ObjFPC}{$H+}
+{$modeswitch ADVANCEDRECORDS}
interface
uses
- ps4_program;
+ SysUtils,
+ ps4_program,
+ sys_pthread,
+ sys_kernel,
+ ps4_pthread,
+ ps4_mutex,
+ ps4_sema,
+ Generics.Collections;
implementation
+uses
+ ps4_libSceFiber;
+
+{$I sce_errno.inc}
+
+const
+ SCE_ULT_ERROR_NULL =$80810001;
+ SCE_ULT_ERROR_ALIGNMENT =$80810002;
+ SCE_ULT_ERROR_RANGE =$80810003;
+ SCE_ULT_ERROR_INVALID =$80810004;
+ SCE_ULT_ERROR_PERMISSION =$80810005;
+ SCE_ULT_ERROR_STATE =$80810006;
+ SCE_ULT_ERROR_BUSY =$80810007;
+ SCE_ULT_ERROR_AGAIN =$80810008;
+ SCE_ULT_ERROR_NOT_INITIALIZE=$8081000A;
+ SCE_ULT_MAX_NAME_LENGTH =31;
+
+ ULT_STATE_INIT =0;
+ ULT_STATE_RUN =1;
+ ULT_STATE_SUSPEND =2;
+ ULT_STATE_PREPARE_JOIN=3;
+ ULT_STATE_DESTROYED =4;
+ ULT_STATE_WAIT =5;
+ ULT_EVENT_TIMEOUT =5000;
+
+type
+ SceUltUlthreadEntry=function(arg:QWord):Integer; SysV_ABI_CDecl;
+
+ PWorkerThread =^TWorkerThread;
+ PSceUltUlthreadRuntime =^SceUltUlthreadRuntime;
+ PSceUltUlthreadRuntimeOptParam =^SceUltUlthreadRuntimeOptParam;
+ PSceUltWaitingQueueResourcePoolOptParam=^SceUltWaitingQueueResourcePoolOptParam;
+ PSceUltUlthreadOptParam =^SceUltUlthreadOptParam;
+ PSceUltWaitingQueueResourcePool =^SceUltWaitingQueueResourcePool;
+ PSceUltUlthread =^SceUltUlthread;
+ PSceUltQueueDataResourcePoolOptParam =^SceUltQueueDataResourcePoolOptParam;
+ PSceUltQueueDataResourcePool =^SceUltQueueDataResourcePool;
+ PSceUltQueueOptParam =^SceUltQueueOptParam;
+ PSceUltQueue =^SceUltQueue;
+ PSceUltMutexOptParam =^SceUltMutexOptParam;
+ PSceUltMutex =^SceUltMutex;
+ PSceUltSemaphoreOptParam =^SceUltSemaphoreOptParam;
+ PSceUltSemaphore =^SceUltSemaphore;
+
+ SceUltUlthreadRuntimeOptParam=packed record
+ oneShotThreadStackSize :QWord; // 8
+ workerThreadCpuAffinityMask:QWord; // 16
+ workerThreadPriority :Integer; // 20
+ inheritSched :Integer; // 24
+ _unknown :array[0..127-24] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltUlthread=packed record
+ fiber :PSceFiber; // 8
+ entry :SceUltUlthreadEntry; // 16
+ arg :QWord; // 24
+ state :QWord; // 32
+ runtime :PSceUltUlthreadRuntime; // 40
+ returnStatus:QWord; // 48
+ _unknown:array[0..255-48] of Byte; // 256
+ procedure init(const aRuntime:PSceUltUlthreadRuntime;
+ const aName:PChar;
+ const aEntry:SceUltUlthreadEntry;
+ const aArg:QWord;
+ const aContext:Pointer;
+ const aSizeContext:QWord);
+ function getState:Integer;
+ procedure destroy;
+ end;
+
+ TUlThreadList=specialize TList;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltUlthreadOptParam=packed record
+ attr :DWord; // 4
+ _unknown:array[0..127-4] of Byte; // 128
+ end;
+
+ TWorkerThread=record
+ thread :pthread;
+ runtime :PSceUltUlthreadRuntime;
+ ulThreadList:TUlThreadList;
+ current :QWord; // Current ulThread index
+ indx :QWord; // This worker thread index in runtime
+ wakeUpEvent :PRTLEvent;
+ end;
+
+ TWorkerThreadList=specialize TList;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltUlthreadRuntime=packed record
+ param :SceUltUlthreadRuntimeOptParam; // 128
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 160
+ maxUlThread :Integer; // 164
+ maxWorkerThread :Integer; // 168
+ workerThreadList:TWorkerThreadList; // 176
+ ulThreadCount :QWord; // 184
+ balancer :QWord; // 192
+ cs :TRTLCriticalSection; // 232
+ _unknown:array[0..4095-232] of Byte; // 4096
+ procedure enter;
+ procedure leave;
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltWaitingQueueResourcePoolOptParam=packed record
+ _unknown:array[0..127] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltWaitingQueueResourcePool=packed record
+ param :SceUltWaitingQueueResourcePoolOptParam; // 128
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 160
+ numThreads :DWord; // 168
+ numSyncObjects:DWord; // 176
+ workArea :Pointer; // 184
+ _unknown:array[0..255-184] of Byte; // 256
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltQueueDataResourcePoolOptParam=packed record
+ _unknown:array[0..127] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltQueueDataResourcePool=packed record
+ param :SceUltQueueDataResourcePoolOptParam; // 128
+ numData :DWord; // 132
+ numQueueObjects:DWord; // 136
+ dataSize :QWord; // 144
+ waitingQueue :PSceUltWaitingQueueResourcePool; // 152
+ workArea :Pointer; // 160
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 192
+ cs :TRTLCriticalSection; // 200
+ queuePtr :Pointer; // 208
+ pushEvent :PRTLEvent; // 216
+ popEvent :PRTLEvent; // 224
+ _unknown:array[0..511-224] of Byte; // 512
+ procedure enter;
+ procedure leave;
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltQueueOptParam=packed record
+ _unknown:array[0..127] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltQueue=packed record
+ param :SceUltQueueOptParam; // 128
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 160
+ queueData :PSceUltQueueDataResourcePool; // 168
+ waitingQueue:PSceUltWaitingQueueResourcePool; // 176
+ _unknown:array[0..511-152] of Byte; // 512
+ function push(const aData:Pointer):Integer;
+ function pop(const aData:Pointer):Integer;
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltMutexOptParam=packed record
+ _unknown:array[0..127] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltMutex=packed record
+ param :SceUltMutexOptParam; // 128
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 160
+ waitingQueue:PSceUltWaitingQueueResourcePool; // 168
+ handle :p_pthread_mutex; // 176
+ _unknown:array[0..255-176] of Byte; // 256
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltSemaphoreOptParam=packed record
+ _unknown:array[0..127] of Byte; // 128
+ end;
+
+ // While we keep the size correct, the content is not the same as the one in original lib
+ SceUltSemaphore=packed record
+ param :SceUltSemaphoreOptParam; // 128
+ name :array[0..SCE_ULT_MAX_NAME_LENGTH] of Char; // 160
+ waitingQueue:PSceUltWaitingQueueResourcePool; // 168
+ handle :PSceKernelSema; // 176
+ wakeUpEvent :PRTLEvent; // 186
+ _unknown:array[0..255-184] of Byte; // 256
+ end;
+
+threadvar
+ _currentUlThread:PSceUltUlthread;
+
+// Wrappers
+
+procedure _workerThreadEntry(const workerThread:PWorkerThread); SysV_ABI_CDecl;
+var
+ ulThread:PSceUltUlthread;
+ runtime :PSceUltUlthreadRuntime;
+begin
+ assert(workerThread<>nil,'workerThread cannot be null');
+ Writeln(SysLogPrefix,'_workerThreadEntry Start');
+ runtime:=workerThread^.runtime;
+ while True do
+ begin
+ while workerThread^.ulThreadList.Count=0 do
+ begin
+ RTLEventWaitFor(workerThread^.wakeUpEvent,ULT_EVENT_TIMEOUT);
+ end;
+ if workerThread^.ulThreadList.Count=0 then
+ continue;
+ // Select next ulThread to be executed
+ runtime^.enter;
+ Inc(workerThread^.current);
+ if workerThread^.current>=workerThread^.ulThreadList.Count then
+ workerThread^.current:=0;
+ ulThread:=workerThread^.ulThreadList[workerThread^.current];
+ _currentUlThread:=ulThread;
+ runtime^.leave;
+
+ // Execute ulThread
+ if (ulThread^.state<>ULT_STATE_PREPARE_JOIN) and (ulThread^.state<>ULT_STATE_WAIT) then
+ begin
+ if ulThread^.fiber^.state=FIBER_STATE_INIT then
+ begin
+ ulThread^.state:=ULT_STATE_RUN;
+ ps4_sceFiberRun(ulThread^.fiber,0,@ulThread^.returnStatus);
+ end else
+ if ulThread^.fiber^.state=FIBER_STATE_SUSPEND then
+ ps4_sceFiberSwitch(ulThread^.fiber,0,nil);
+ end;
+ end;
+ Writeln(SysLogPrefix,'_workerThreadEntry End');
+ ps4_scePthreadExit(nil);
+end;
+
+procedure _ulThreadEntry(argInit,argRun:QWord); SysV_ABI_CDecl;
+var
+ ulThread:PSceUltUlthread;
+begin
+ ulThread:=PSceUltUlthread(argInit);
+ assert(ulThread<>nil,'ulThread cannot be null');
+
+ Writeln(SysLogPrefix,'_ulThreadEntry Start');
+ ulThread^.entry(ulThread^.arg);
+ Writeln(SysLogPrefix,'_ulThreadEntry End');
+ ulThread^.state:=ULT_STATE_PREPARE_JOIN;
+end;
+
+function _workerThreadCreate(const runtime:PSceUltUlthreadRuntime):PWorkerThread;
+begin
+ New(Result);
+ Result^.current :=0;
+ Result^.ulThreadList:=TUlThreadList.Create;
+ Result^.ulThreadList.Capacity:=runtime^.maxUlThread;
+ Result^.runtime :=runtime;
+ Result^.indx :=runtime^.workerThreadList.Count;
+ Result^.wakeUpEvent :=RTLEventCreate;
+ runtime^.workerThreadList.Add(Result);
+ ps4_scePthreadCreate(@Result^.thread,nil,@_workerThreadEntry,Result,PChar(runtime^.name+'_ultWorker_'+IntToStr(Result^.indx)));
+end;
+
+procedure _currentUlThreadSetState(const state:QWord); inline;
+begin
+ if _currentUlThread<>nil then
+ _currentUlThread^.state:=state;
+end;
+
+procedure SceUltUlthreadRuntime.enter;
+begin
+ EnterCriticalSection(cs);
+end;
+
+procedure SceUltUlthreadRuntime.leave;
+begin
+ LeaveCriticalSection(cs);
+end;
+
+procedure SceUltUlthread.init(const aRuntime:PSceUltUlthreadRuntime;
+ const aName:PChar;
+ const aEntry:SceUltUlthreadEntry;
+ const aArg:QWord;
+ const aContext:Pointer;
+ const aSizeContext:QWord);
+var
+ workerThread:PWorkerThread;
+begin
+ aRuntime^.enter;
+ fiber :=AllocMem(SizeOf(SceFiber));
+ runtime:=aRuntime;
+ entry :=aEntry;
+ arg :=aArg;
+ ps4_sceFiberInitialize(fiber,aName,@_ulThreadEntry,QWord(@Self),aContext,aSizeContext,nil);
+
+ workerThread:=runtime^.workerThreadList[runtime^.balancer mod runtime^.maxWorkerThread];
+ workerThread^.ulThreadList.Add(@Self);
+ Inc(runtime^.balancer);
+ RTLEventSetEvent(workerThread^.wakeUpEvent);
+ aRuntime^.leave;
+end;
+
+function SceUltUlthread.getState:Integer;
+var
+ i,j :Integer;
+ workerThread:PWorkerThread;
+begin
+ runtime^.enter;
+ for j:=0 to runtime^.workerThreadList.Count-1 do
+ begin
+ workerThread:=runtime^.workerThreadList[j];
+ for i:=0 to workerThread^.ulThreadList.Count-1 do
+ if workerThread^.ulThreadList[i]=@Self then
+ Exit(workerThread^.ulThreadList[i]^.state);
+ end;
+ Result:=ULT_STATE_DESTROYED;
+ runtime^.leave;
+end;
+
+procedure SceUltUlthread.destroy;
+var
+ workerThread:PWorkerThread;
+ ulThread :PSceUltUlthread;
+ i,j :Integer;
+begin
+ ulThread:=@Self;
+ runtime^.enter;
+ for j:=0 to runtime^.workerThreadList.Count-1 do
+ begin
+ workerThread:=runtime^.workerThreadList[j];
+ for i:=0 to workerThread^.ulThreadList.Count-1 do
+ if workerThread^.ulThreadList[i]=ulThread then
+ begin
+ ps4_sceFiberFinalize(ulThread^.fiber);
+ workerThread^.ulThreadList.Delete(i);
+ Exit;
+ end;
+ end;
+ runtime^.leave;
+end;
+
+procedure SceUltQueueDataResourcePool.enter;
+begin
+ EnterCriticalSection(cs);
+end;
+
+procedure SceUltQueueDataResourcePool.leave;
+begin
+ LeaveCriticalSection(cs);
+end;
+
+function SceUltQueue.push(const aData:Pointer):Integer;
+begin
+ queueData^.enter;
+ while ((QWord(queueData^.queuePtr) - QWord(queueData^.workArea)) div queueData^.dataSize) >= queueData^.numData do
+ begin
+ assert(_currentUlThread=nil,'TODO: SceUltQueue.push currently not working with ulthreads');
+ _currentUlThreadSetState(ULT_STATE_WAIT);
+ queueData^.leave;
+ RTLEventWaitFor(queueData^.popEvent,ULT_EVENT_TIMEOUT);
+ queueData^.enter;
+ end;
+ _currentUlThreadSetState(ULT_STATE_RUN);
+ Move(aData^,queueData^.queuePtr^,queueData^.dataSize);
+ Inc(queueData^.queuePtr,queueData^.dataSize);
+ Result:=0;
+ RTLEventSetEvent(queueData^.pushEvent);
+ queueData^.leave;
+end;
+
+function SceUltQueue.pop(const aData:Pointer):Integer;
+begin
+ queueData^.enter;
+ while QWord(queueData^.queuePtr) <= QWord(queueData^.workArea) do
+ begin
+ assert(_currentUlThread=nil,'TODO: SceUltQueue.pop currently not working with ulthreads');
+ _currentUlThreadSetState(ULT_STATE_WAIT);
+ queueData^.leave;
+ RTLEventWaitFor(queueData^.pushEvent,ULT_EVENT_TIMEOUT);
+ queueData^.enter;
+ end;
+ _currentUlThreadSetState(ULT_STATE_RUN);
+ Move(queueData^.workArea^,aData^,queueData^.dataSize);
+ Move((queueData^.workArea+queueData^.dataSize)^,queueData^.workArea^,QWord(queueData^.queuePtr)-QWord(queueData^.workArea)-queueData^.dataSize);
+ Dec(queueData^.queuePtr,queueData^.dataSize);
+ Result:=0;
+ RTLEventSetEvent(queueData^.popEvent);
+ queueData^.leave;
+end;
+
+// APIs
+
function ps4_sceUltInitialize():Integer; SysV_ABI_CDecl;
begin
- Writeln('sceUltInitialize');
+ Writeln(SysLogPrefix,'sceUltInitialize');
Result:=0;
end;
+function ps4_sceUltUlthreadRuntimeGetWorkAreaSize(maxUlThread,maxWorkerThread:DWord):QWord; SysV_ABI_CDecl;
+begin
+ Result:=8; // TODO: Fake size. Not important for current implementation of this lib.
+end;
+
+function ps4_sceUltUlthreadRuntimeCreate(runtime :PSceUltUlthreadRuntime;
+ name :PChar;
+ maxUlThread :Integer;
+ maxWorkerThread:Integer;
+ workArea :Pointer;
+ param :PSceUltUlthreadRuntimeOptParam):Integer; SysV_ABI_CDecl;
+var
+ i:Integer;
+begin
+ if (runtime=nil) or (name=nil) or (workArea=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (maxUlThread=0) or (maxWorkerThread=0) then
+ Exit(SCE_ULT_ERROR_INVALID);
+ Writeln(SysLogPrefix,'sceUltUlthreadRuntimeCreate,name=',name,',maxUltThread=',maxUlThread,',maxWorkerThread=',maxWorkerThread);
+ StrLCopy(@runtime^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ runtime^.maxUlThread :=maxUlThread;
+ runtime^.maxWorkerThread:=maxWorkerThread;
+ runtime^.balancer :=0;
+ InitCriticalSection(runtime^.cs);
+ if param<>nil then
+ runtime^.param:=param^
+ else
+ begin
+ runtime^.param.oneShotThreadStackSize :=16*1024;
+ runtime^.param.workerThreadCpuAffinityMask:=SCE_KERNEL_CPUMASK_6CPU_ALL;
+ runtime^.param.workerThreadPriority :=SCE_KERNEL_PRIO_FIFO_DEFAULT;
+ runtime^.param.inheritSched :=SCE_PTHREAD_INHERIT_SCHED;
+ end;
+ runtime^.workerThreadList:=TWorkerThreadList.Create;
+ runtime^.workerThreadList.Capacity:=maxWorkerThread;
+ for i:=0 to maxWorkerThread-1 do
+ _workerThreadCreate(runtime);
+end;
+
+function ps4_sceUltUlthreadRuntimeOptParamInitialize(optParam:PSceUltUlthreadOptParam):Integer; SysV_ABI_CDecl;
+begin
+ Result:=0;
+end;
+
+function ps4_sceUltUlthreadCreate(ulThread :PSceUltUlthread;
+ name :PChar;
+ entry :SceUltUlthreadEntry;
+ arg :QWord;
+ context :Pointer;
+ sizeContext:QWord;
+ runtime :PSceUltUlthreadRuntime;
+ optParam :PSceUltUlthreadOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (ulThread=nil) or (name=nil) or (entry=nil) or (runtime=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (sizeContext>0) and (sizeContext<512) then
+ Exit(SCE_ULT_ERROR_RANGE);
+ if (context<>nil) and ((sizeContext=0) or (sizeContext mod 16<>0)) then
+ Exit(SCE_ULT_ERROR_INVALID);
+ if runtime^.workerThreadList=nil then
+ Exit(SCE_ULT_ERROR_STATE);
+ if runtime^.ulThreadCount>=runtime^.maxUlThread then
+ Exit(SCE_ULT_ERROR_AGAIN);
+ Writeln(SysLogPrefix,'sceUltUlthreadCreate,name=',name,'runtime=',runtime^.name);
+ ulThread^.init(runtime,name,entry,arg,context,sizeContext);
+end;
+
+function ps4_sceUltUlthreadJoin(ulThread:PSceUltUlthread;status:PInteger):Integer; SysV_ABI_CDecl;
+begin
+ if ulThread=nil then
+ Exit(SCE_ULT_ERROR_NULL);
+ if ulThread=_currentUlThread then
+ Exit(SCE_ULT_ERROR_PERMISSION);
+ if ulThread^.getState=ULT_STATE_DESTROYED then
+ Exit(SCE_ULT_ERROR_STATE);
+ Writeln(SysLogPrefix,'sceUltUlthreadJoin,fiber=',GetFiberStringParam(ulThread^.fiber));
+ _currentUlThreadSetState(ULT_STATE_WAIT);
+ repeat
+ SwYieldExecution;
+ until ulThread^.getState=ULT_STATE_PREPARE_JOIN;
+ _currentUlThreadSetState(ULT_STATE_RUN);
+ //
+ if (status<>nil) and (ulThread^.fiber^.pArgReturn<>nil) then
+ begin
+ status^:=ulThread^.fiber^.pArgReturn^;
+ Writeln(SysLogPrefix,'Return code:',status^);
+ end;
+ ulThread^.destroy;
+end;
+
+function ps4_sceUltUlthreadExit(status:Integer):Integer; SysV_ABI_CDecl;
+var
+ ulThread:PSceUltUlthread;
+begin
+ ulThread:=_currentUlThread;
+ if ulThread=nil then
+ Exit(SCE_ULT_ERROR_PERMISSION);
+ Writeln(SysLogPrefix,'sceUltUlthreadExit,fiber=',GetFiberStringParam(ulThread^.fiber));
+ ulThread^.state:=ULT_STATE_PREPARE_JOIN;
+ ps4_sceFiberReturnToThread(status,nil);
+end;
+
+//
+
+function ps4_sceUltWaitingQueueResourcePoolGetWorkAreaSize(numThreads,numSyncObjects:DWord):QWord; SysV_ABI_CDecl;
+begin
+ Result:=8; // TODO: Fake size. Not important for current implementation of this lib.
+end;
+
+function ps4_sceUltWaitingQueueResourcePoolCreate(pool :PSceUltWaitingQueueResourcePool;
+ name :PChar;
+ numThreads :DWord;
+ numSyncObjects:DWord;
+ workArea :Pointer;
+ param :PSceUltWaitingQueueResourcePoolOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (pool=nil) or (name=nil) or (workArea=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (numThreads=0) or (numSyncObjects=0) then
+ Exit(SCE_ULT_ERROR_INVALID);
+ Writeln(SysLogPrefix,'sceUltWaitingQueueResourcePoolCreate,name=',name,',numThreads=',numThreads,',numSyncObjects=',numSyncObjects);
+ StrLCopy(@pool^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ pool^.numThreads :=numThreads;
+ pool^.numSyncObjects:=numSyncObjects;
+ pool^.workArea :=workArea;
+ pool^.workArea :=workArea;
+ if param<>nil then
+ pool^.param:=param^;
+ Result:=0; // TODO: Not used by current implementation of this lib.
+end;
+
+//
+
+function ps4_sceUltQueueDataResourcePoolGetWorkAreaSize(numData:DWord;dataSize:QWord;numQueueObjects:DWord):Integer; SysV_ABI_CDecl;
+begin
+ Result:=numData*dataSize*numQueueObjects;
+end;
+
+function ps4_sceUltQueueDataResourcePoolCreate(pool :PSceUltQueueDataResourcePool;
+ name :PChar;
+ numData :DWord;
+ dataSize :QWord;
+ numQueueObjects:DWord;
+ waitingQueue :PSceUltWaitingQueueResourcePool;
+ workArea :Pointer;
+ param :PSceUltQueueDataResourcePoolOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (pool=nil) or (name=nil) or (workArea=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (numData=0) or (dataSize=0) or (numQueueObjects=0) then
+ Exit(SCE_ULT_ERROR_INVALID);
+ assert(numQueueObjects=1,'TODO: numQueueObjects higher than 1');
+ Writeln(SysLogPrefix,'sceUltQueueDataResourcePoolCreate,name=',name,',numData=',numData,',dataSize=',dataSize,',numQueueObjects=',numQueueObjects);
+ StrLCopy(@pool^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ pool^.numData :=numData;
+ pool^.dataSize :=dataSize;
+ pool^.numQueueObjects:=numQueueObjects;
+ pool^.waitingQueue :=waitingQueue;
+ pool^.workArea :=workArea;
+ pool^.queuePtr :=workArea;
+ InitCriticalSection(pool^.cs);
+ pool^.pushEvent :=RTLEventCreate;
+ pool^.popEvent :=RTLEventCreate;
+ if param<>nil then
+ pool^.param:=param^;
+ Result:=0;
+end;
+
+//
+
+function ps4_sceUltQueueCreate(queue :PSceUltQueue;
+ name :PChar;
+ dataSize :QWord;
+ waitingQueue:PSceUltWaitingQueueResourcePool;
+ queueData :PSceUltQueueDataResourcePool;
+ param :PSceUltQueueOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (queue=nil) or (name=nil) or (queueData=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (dataSize=0) or (dataSize>queueData^.dataSize) then
+ Exit(SCE_ULT_ERROR_INVALID);
+ Writeln(SysLogPrefix,'sceUltQueueCreate,name=',name,',dataSize=',dataSize);
+ StrLCopy(@queue^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ queue^.queueData :=queueData;
+ queue^.waitingQueue:=waitingQueue;
+ if param<>nil then
+ queue^.param:=param^;
+ Result:=0;
+end;
+
+function ps4_sceUltQueuePush(queue:PSceUltQueue;data:Pointer):Integer; SysV_ABI_CDecl;
+begin
+ if (queue=nil) or (data=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceUltQueuePush,queue=',queue^.name);
+ Result:=queue^.push(data);
+end;
+
+function ps4_sceUltQueuePop(queue:PSceUltQueue;data:Pointer):Integer; SysV_ABI_CDecl;
+begin
+ if (queue=nil) or (data=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceUltQueuePop,queue=',queue^.name);
+ Result:=queue^.pop(data);
+end;
+
+//
+
+function ps4_sceUltMutexCreate(mutex :PSceUltMutex;
+ name :PChar;
+ waitingQueue:PSceUltWaitingQueueResourcePool;
+ param :PSceUltMutexOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (mutex=nil) or (name=nil) or (waitingQueue=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceUltMutexCreate,name=',name);
+ mutex^.handle :=AllocMem(SizeOf(pthread_mutex));
+ ps4_pthread_mutex_init(mutex^.handle,nil);
+ StrLCopy(@mutex^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ mutex^.waitingQueue:=waitingQueue;
+ if param<>nil then
+ mutex^.param:=param^;
+ Result:=0;
+end;
+
+function ps4_sceUltMutexLock(mutex:PSceUltMutex):Integer; SysV_ABI_CDecl;
+begin
+ if (mutex=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ //Writeln(SysLogPrefix,'sceUltMutexLock,mutex=',mutex^.name);
+ ps4_pthread_mutex_lock(mutex^.handle);
+ assert(_currentUlThread=nil,'TODO: ps4_sceUltMutexLock currently not working with ulthreads');
+end;
+
+function ps4_sceUltMutexUnlock(mutex:PSceUltMutex):Integer; SysV_ABI_CDecl;
+begin
+ if (mutex=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ //Writeln(SysLogPrefix,'sceUltMutexUnlock,mutex=',mutex^.name);
+ ps4_pthread_mutex_unlock(mutex^.handle);
+ assert(_currentUlThread=nil,'TODO: ps4_sceUltMutexUnlock currently not working with ulthreads');
+end;
+
+function ps4_sceUltMutexOptParamInitialize(param:PSceUltMutexOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if param=nil then
+ Exit(SCE_ULT_ERROR_NULL);
+ //Writeln(SysLogPrefix,'sceUltMutexOptParamInitialize');
+ Result:=0;
+end;
+
+//
+
+function ps4_sceUltSemaphoreCreate(semaphore :PSceUltSemaphore;
+ name :PChar;
+ numResource :Integer;
+ waitingQueue:PSceUltWaitingQueueResourcePool;
+ param :PSceUltSemaphoreOptParam):Integer; SysV_ABI_CDecl;
+begin
+ if (semaphore=nil) or (name=nil) then
+ Exit(SCE_ULT_ERROR_NULL);
+ Writeln(SysLogPrefix,'sceUltSemaphoreCreate,name=',name,',numResource=',numResource);
+ semaphore^.handle :=AllocMem(SizeOf(pthread_mutex));
+ semaphore^.waitingQueue:=waitingQueue;
+ semaphore^.wakeUpEvent :=RTLEventCreate;
+ ps4_sceKernelCreateSema(semaphore^.handle,name,SCE_KERNEL_SEMA_ATTR_TH_FIFO,numResource,$7FFFFFFF,nil);
+ StrLCopy(@semaphore^.name[0],name,SCE_ULT_MAX_NAME_LENGTH);
+ if param<>nil then
+ semaphore^.param:=param^;
+ Result:=0;
+end;
+
+function ps4_sceUltSemaphoreTryAcquire(semaphore :PSceUltSemaphore;
+ numResource:DWord):Integer; SysV_ABI_CDecl;
+var
+ r:Integer;
+begin
+ if semaphore=nil then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (numResource<=0) or (numResource>=$80000000) then
+ Exit(SCE_ULT_ERROR_RANGE);
+ //Writeln(SysLogPrefix,'sceUltSemaphoreTryAcquire,name=',semaphore^.name,',numResource=',numResource);
+ assert(_currentUlThread=nil,'TODO: ps4_sceUltSemaphoreTryAcquire currently not working with ulthreads');
+ r:=ps4_sceKernelPollSema(semaphore^.handle^,numResource);
+ if r=SCE_KERNEL_ERROR_EBUSY then
+ Exit(SCE_ULT_ERROR_AGAIN);
+ Result:=0;
+end;
+
+function ps4_sceUltSemaphoreAcquire(semaphore :PSceUltSemaphore;
+ numResource:DWord):Integer; SysV_ABI_CDecl;
+begin
+ if semaphore=nil then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (numResource<=0) or (numResource>=$80000000) then
+ Exit(SCE_ULT_ERROR_RANGE);
+ //Writeln(SysLogPrefix,'sceUltSemaphoreAcquire,name=',semaphore^.name,',numResource=',numResource);
+ assert(_currentUlThread=nil,'TODO: ps4_sceUltSemaphoreAcquire currently not working with ulthreads');
+ while ps4_sceKernelPollSema(semaphore^.handle^,numResource)<>0 do
+ begin
+ RTLEventWaitFor(semaphore^.wakeUpEvent,ULT_EVENT_TIMEOUT);
+ end;
+ Result:=0;
+end;
+
+function ps4_sceUltSemaphoreRelease(semaphore :PSceUltSemaphore;
+ numResource:DWord):Integer; SysV_ABI_CDecl;
+begin
+ if semaphore=nil then
+ Exit(SCE_ULT_ERROR_NULL);
+ if (numResource<=0) or (numResource>=$80000000) then
+ Exit(SCE_ULT_ERROR_RANGE);
+ //Writeln(SysLogPrefix,'sceUltSemaphoreRelease,name=',semaphore^.name,',numResource=',numResource);
+ assert(_currentUlThread=nil,'TODO: ps4_sceUltSemaphoreRelease currently not working with ulthreads');
+ if ps4_sceKernelSignalSema(semaphore^.handle^,numResource)=SCE_KERNEL_ERROR_EINVAL then
+ Exit(SCE_ULT_ERROR_STATE);
+ Result:=0;
+ RTLEventSetEvent(semaphore^.wakeUpEvent);
+end;
+
+//
+
function Load_libSceUlt(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
@@ -25,6 +744,32 @@ begin
lib:=Result._add_lib('libSceUlt');
lib^.set_proc($859220D44586B073,@ps4_sceUltInitialize);
+ lib^.set_proc($82BB36A5B7366B03,@ps4_sceUltUlthreadRuntimeGetWorkAreaSize);
+ lib^.set_proc($576BB758BAF087AE,@ps4_sceUltUlthreadRuntimeOptParamInitialize);
+ lib^.set_proc($8F0F45919057A3F8,@ps4_sceUltUlthreadRuntimeCreate);
+ lib^.set_proc($CE7237ABC4BB290E,@ps4_sceUltUlthreadCreate);
+ lib^.set_proc($802780239ECB1A02,@ps4_sceUltUlthreadJoin);
+ lib^.set_proc($905FFFB37C598DCA,@ps4_sceUltUlthreadExit);
+
+ lib^.set_proc($588595D5077B3C55,@ps4_sceUltWaitingQueueResourcePoolGetWorkAreaSize);
+ lib^.set_proc($6221EE8CE1BDBD76,@ps4_sceUltWaitingQueueResourcePoolCreate);
+
+ lib^.set_proc($7AF8FD60F912F2CE,@ps4_sceUltQueueDataResourcePoolGetWorkAreaSize);
+ lib^.set_proc($4C51E6EBF37ABE4B,@ps4_sceUltQueueDataResourcePoolCreate);
+
+ lib^.set_proc($F58E6478EBDBEA89,@ps4_sceUltQueueCreate);
+ lib^.set_proc($754C295F77B93431,@ps4_sceUltQueuePush);
+ lib^.set_proc($4554AADADB26DB2C,@ps4_sceUltQueuePop);
+
+ lib^.set_proc($9A6B7C49AEAD2FA7,@ps4_sceUltMutexCreate);
+ lib^.set_proc($F21106911D697EBF,@ps4_sceUltMutexLock);
+ lib^.set_proc($8745DE6CA88C06D9,@ps4_sceUltMutexUnlock);
+ lib^.set_proc($D7EF2DF5A1CB8B3F,@ps4_sceUltMutexOptParamInitialize);
+
+ lib^.set_proc($8794252188FE468F,@ps4_sceUltSemaphoreCreate);
+ lib^.set_proc($1C0D4B75B8B794F6,@ps4_sceUltSemaphoreTryAcquire);
+ lib^.set_proc($4001F5A1F23DEEF5,@ps4_sceUltSemaphoreAcquire);
+ lib^.set_proc($95BB64E57D6679CC,@ps4_sceUltSemaphoreRelease);
end;
initialization
diff --git a/sys/sys_kernel.pas b/sys/sys_kernel.pas
index 8146715b..50803071 100644
--- a/sys/sys_kernel.pas
+++ b/sys/sys_kernel.pas
@@ -122,17 +122,18 @@ implementation
uses
ntapi,
+ ps4_libscefiber,
sys_pthread,
sys_signal,
sys_time;
function SysLogPrefix : string;
-begin
- // Add thread name and id as prefix to log messages
+begin
+ // Add thread+fiber name and id as prefix to log messages
Result := '';
if _get_curthread <> nil then
begin
- Result:='['+_get_curthread^.name + ':'+ IntToStr(_get_curthread^.ThreadId) + '] ';
+ Result:='['+_get_curthread^.name + ':'+ IntToStr(_get_curthread^.ThreadId) + '] ' + GetFiberString;
end;
end;