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

+

This commit is contained in:
Pavel 2024-02-11 18:25:16 +03:00
parent 807658f415
commit 72cde2c713
11 changed files with 503 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

228
fpPS4.lpi
View File

@ -614,6 +614,234 @@
<Filename Value="sys\md\vm_pmap_prot.pas"/> <Filename Value="sys\md\vm_pmap_prot.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
</Unit> </Unit>
<Unit>
<Filename Value="sys\vm\vm_nt_map.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\bittype.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\ntapi.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_mmap.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_map.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\LFQueue.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vmparam.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\evpoll.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\atomic.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="rtl\mqueue.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\device_pager.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\dmem_map.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\rmem_map.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\sys_vm_object.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_fault.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_file.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_object.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_pager.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vm_patch_link.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vm\vnode_pager.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vnode.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vstat.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_syscalls.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_vnops.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vnode_if.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vsys_generic.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\kern_conf.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\kern_descrip.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\subr_uio.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\sys_capability.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vcapability.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vdirent.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vdisk.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfcntl.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfile.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfiledesc.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfilio.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_cache.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_default.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_init.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_lookup.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_mount.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_mountroot.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vfs_subr.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vioccom.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vmount.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vnamei.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vpoll.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vselect.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vselinfo.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vsockbuf.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vsocket.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vsocketvar.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vsockstate.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vttycom.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="sys\vfs\vuio.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

89
gui/game_run.pas
View File

@ -8,25 +8,45 @@ uses
windows, windows,
Classes, Classes,
SysUtils, SysUtils,
kern_thr,
md_pipe, md_pipe,
host_ipc, host_ipc,
md_host_ipc, md_host_ipc,
game_info; game_info;
var type
t_wr_handle:THandle; TGameRunConfig=record
hOutput:THandle;
hError :THandle;
fork_proc:Boolean;
end;
TGameProcess=class
g_ipc :THostIpcConnect;
g_fork:Boolean;
end;
TGameProcessSimple=class(TGameProcess)
Ftd:p_kthread;
end;
TGameProcessPipe=class(TGameProcess)
FProcess:THandle;
FChild:THandle;
end;
var
mgui_ipc:THostIpcConnect=nil;
kern_ipc:THostIpcConnect=nil; kern_ipc:THostIpcConnect=nil;
procedure run_item(Item:TGameItem); function run_item(const cfg:TGameRunConfig;Item:TGameItem):TGameProcess;
implementation implementation
uses uses
sys_sysinit, sys_sysinit,
kern_param, kern_param,
kern_thr,
kern_thread, kern_thread,
kern_exec, kern_exec,
vfs_mountroot, vfs_mountroot,
@ -187,12 +207,8 @@ begin
sleep(-1); sleep(-1);
end; end;
const function run_item(const cfg:TGameRunConfig;Item:TGameItem):TGameProcess;
fork_proc:Boolean=True;
procedure run_item(Item:TGameItem);
var var
td:p_kthread;
r:Integer; r:Integer;
kern2mgui:array[0..1] of THandle; kern2mgui:array[0..1] of THandle;
@ -204,21 +220,29 @@ var
mem:TMemoryStream; mem:TMemoryStream;
begin begin
Result:=nil;
if Item.FLock then Exit; if Item.FLock then Exit;
if runing then Exit; if runing then Exit;
SetStdHandle(STD_ERROR_HANDLE ,t_wr_handle); SetStdHandle(STD_OUTPUT_HANDLE,cfg.hOutput);
SetStdHandle(STD_OUTPUT_HANDLE,t_wr_handle); SetStdHandle(STD_ERROR_HANDLE ,cfg.hError );
if fork_proc then if cfg.fork_proc then
begin begin
md_pipe2(@kern2mgui,MD_PIPE_ASYNC0 or MD_PIPE_ASYNC1); Result:=TGameProcessPipe.Create;
Result.g_fork:=cfg.fork_proc;
p_mgui_ipc:=THostIpcPipeMGUI.Create; with TGameProcessPipe(Result) do
p_mgui_ipc.set_pipe(kern2mgui[0]); begin
md_pipe2(@kern2mgui,MD_PIPE_ASYNC0 or MD_PIPE_ASYNC1);
mgui_ipc:=p_mgui_ipc; p_mgui_ipc:=THostIpcPipeMGUI.Create;
p_mgui_ipc.set_pipe(kern2mgui[0]);
g_ipc:=p_mgui_ipc;
FChild:=kern2mgui[1];
end;
// //
@ -228,23 +252,34 @@ begin
Item.Serialize(mem); Item.Serialize(mem);
md_fork_process(@fork_process,mem.Memory,mem.Size); with TGameProcessPipe(Result) do
begin
FProcess:=md_fork_process(@fork_process,mem.Memory,mem.Size);
end;
mem.Free; mem.Free;
end else end else
begin begin
s_kern_ipc:=THostIpcSimpleKERN.Create; Result:=TGameProcessSimple.Create;
s_mgui_ipc:=THostIpcSimpleMGUI.Create; Result.g_fork:=cfg.fork_proc;
s_kern_ipc.FDest:=s_mgui_ipc; with TGameProcessSimple(Result) do
s_mgui_ipc.FDest:=s_kern_ipc; begin
kern_ipc:=s_kern_ipc; s_kern_ipc:=THostIpcSimpleKERN.Create;
mgui_ipc:=s_mgui_ipc; s_mgui_ipc:=THostIpcSimpleMGUI.Create;
s_kern_ipc.FDest:=s_mgui_ipc;
s_mgui_ipc.FDest:=s_kern_ipc;
g_ipc:=s_mgui_ipc;
kern_ipc:=s_kern_ipc;
Ftd:=nil;
r:=kthread_add(@prepare,Item,@Ftd,'[main]');
end;
td:=nil;
r:=kthread_add(@prepare,Item,@td,'[main]');
Assert(r=0);
end; end;
runing:=True; runing:=True;

22
gui/main.pas
View File

@ -9,6 +9,7 @@ uses
game_info, game_info,
game_edit, game_edit,
game_run,
host_ipc; host_ipc;
@ -41,6 +42,8 @@ type
private private
public public
GameProcess:TGameProcess;
procedure ReadIniFile; procedure ReadIniFile;
procedure LoadItemIni(Item:TGameItem); procedure LoadItemIni(Item:TGameItem);
procedure SaveItemIni(Item:TGameItem); procedure SaveItemIni(Item:TGameItem);
@ -76,9 +79,7 @@ uses
Rtti, Rtti,
evbuffer, evbuffer,
evpoll, evpoll;
game_run;
// //
@ -309,9 +310,10 @@ begin
FLogUpdateTime:=GetTickCount64; FLogUpdateTime:=GetTickCount64;
end; end;
if (mgui_ipc<>nil) then if (GameProcess<>nil) then
if (GameProcess.g_ipc<>nil) then
begin begin
mgui_ipc.Update(IpcHandler); GameProcess.g_ipc.Update(IpcHandler);
end; end;
end; end;
@ -386,6 +388,7 @@ procedure TfrmMain.MIRunClick(Sender: TObject);
var var
Item:TGameItem; Item:TGameItem;
aRow:Integer; aRow:Integer;
cfg:TGameRunConfig;
begin begin
aRow:=ListGrid.Row; aRow:=ListGrid.Row;
@ -394,8 +397,6 @@ begin
Item:=GetItemRow(aRow); Item:=GetItemRow(aRow);
t_wr_handle:=FAddHandle;
FList.FSynLog.TopLine:=FList.FSynLog.Lines.Count; FList.FSynLog.TopLine:=FList.FSynLog.Lines.Count;
//reset file //reset file
@ -405,7 +406,12 @@ begin
Pages.ActivePage:=TabLog; Pages.ActivePage:=TabLog;
run_item(Item); cfg.hOutput:=FAddHandle;
cfg.hError :=FAddHandle;
cfg.fork_proc:=False;
GameProcess:=run_item(cfg,Item);
end; end;
procedure TfrmMain.MIDelClick(Sender: TObject); procedure TfrmMain.MIDelClick(Sender: TObject);

13
sys/host_ipc.pas
View File

@ -64,6 +64,7 @@ type
procedure TriggerNodeSync(tid:DWORD;value:Ptruint); procedure TriggerNodeSync(tid:DWORD;value:Ptruint);
procedure Pack(mtype:t_mtype;mlen,mtid:DWORD;buf:Pointer); procedure Pack(mtype:t_mtype;mlen,mtid:DWORD;buf:Pointer);
function Recv:PQNode; function Recv:PQNode;
procedure Flush;
procedure RecvSync(node:PQNode); procedure RecvSync(node:PQNode);
public public
// //
@ -112,6 +113,7 @@ end;
Destructor THostIpcConnect.Destroy; Destructor THostIpcConnect.Destroy;
begin begin
Flush;
mtx_destroy(FWLock); mtx_destroy(FWLock);
inherited; inherited;
end; end;
@ -135,6 +137,17 @@ begin
FQueue.Pop(Result); FQueue.Pop(Result);
end; end;
procedure THostIpcConnect.Flush;
var
node:PQNode;
begin
node:=nil;
while FQueue.Pop(node) do
begin
FreeMem(node);
end;
end;
procedure THostIpcConnect.RecvSync(node:PQNode); procedure THostIpcConnect.RecvSync(node:PQNode);
var var
value:Ptruint; value:Ptruint;

49
sys/kern/kern_rtprio.pas
View File

@ -6,6 +6,7 @@ unit kern_rtprio;
interface interface
uses uses
mqueue,
rtprio, rtprio,
kern_thr; kern_thr;
@ -133,7 +134,6 @@ function sys_rtprio(func,pid:Integer;rtp:Pointer):Integer;
var var
td,tdp:p_kthread; td,tdp:p_kthread;
rtp1,rtp2:t_rtprio; rtp1,rtp2:t_rtprio;
i:kthread_iterator;
begin begin
if (pid<>0) and (pid<>p_proc.p_pid) then Exit(ESRCH); if (pid<>0) and (pid<>p_proc.p_pid) then Exit(ESRCH);
@ -162,24 +162,25 @@ begin
rtp1._type:=RTP_PRIO_IDLE; rtp1._type:=RTP_PRIO_IDLE;
rtp1._prio:=RTP_PRIO_MAX; rtp1._prio:=RTP_PRIO_MAX;
if FOREACH_THREAD_START(@i) then threads_lock;
begin
repeat
tdp:=THREAD_GET(@i);
pri_to_rtp(tdp,@rtp2); tdp:=TAILQ_FIRST(@p_threads);
while (tdp<>nil) do
if (rtp2._type<rtp1._type) or
((rtp2._type=rtp1._type) and
(rtp2._prio<rtp1._prio)) then
begin begin
rtp1:=rtp2;
pri_to_rtp(tdp,@rtp2);
if (rtp2._type<rtp1._type) or
((rtp2._type=rtp1._type) and
(rtp2._prio<rtp1._prio)) then
begin
rtp1:=rtp2;
end;
tdp:=TAILQ_NEXT(tdp,@tdp^.td_plist)
end; end;
until not THREAD_NEXT(@i); threads_unlock;
FOREACH_THREAD_FINISH();
end;
end; end;
PROC_UNLOCK; PROC_UNLOCK;
@ -197,19 +198,19 @@ begin
Result:=rtp_to_pri(@rtp1,td); Result:=rtp_to_pri(@rtp1,td);
end else end else
begin begin
threads_lock;
if FOREACH_THREAD_START(@i) then tdp:=TAILQ_FIRST(@p_threads);
begin while (tdp<>nil) do
repeat begin
tdp:=THREAD_GET(@i);
Result:=rtp_to_pri(@rtp1,tdp); Result:=rtp_to_pri(@rtp1,tdp);
if (Result<>0) then Break; if (Result<>0) then Break;
until not THREAD_NEXT(@i); tdp:=TAILQ_NEXT(tdp,@tdp^.td_plist)
FOREACH_THREAD_FINISH(); end;
end;
threads_unlock;
end; end;
PROC_UNLOCK; PROC_UNLOCK;

50
sys/kern/kern_sig.pas
View File

@ -417,21 +417,22 @@ procedure sigqueue_delete_set_proc(_set:p_sigset_t);
var var
td0:p_kthread; td0:p_kthread;
worklist:sigqueue_t; worklist:sigqueue_t;
i:kthread_iterator;
begin begin
sigqueue_init(@worklist); sigqueue_init(@worklist);
sigqueue_move_set(@p_proc.p_sigqueue,@worklist,_set); sigqueue_move_set(@p_proc.p_sigqueue,@worklist,_set);
if FOREACH_THREAD_START(@i) then threads_lock;
begin
repeat td0:=TAILQ_FIRST(@p_threads);
td0:=THREAD_GET(@i); while (td0<>nil) do
begin
sigqueue_move_set(@td0^.td_sigqueue,@worklist,_set); sigqueue_move_set(@td0^.td_sigqueue,@worklist,_set);
until not THREAD_NEXT(@i); td0:=TAILQ_NEXT(td0,@td0^.td_plist)
FOREACH_THREAD_FINISH(); end;
end;
threads_unlock;
sigqueue_flush(@worklist); sigqueue_flush(@worklist);
end; end;
@ -1341,7 +1342,6 @@ var
td:p_kthread; td:p_kthread;
first_td :p_kthread; first_td :p_kthread;
signal_td:p_kthread; signal_td:p_kthread;
i:kthread_iterator;
begin begin
td:=curkthread; td:=curkthread;
@ -1354,25 +1354,27 @@ begin
first_td :=nil; first_td :=nil;
signal_td:=nil; signal_td:=nil;
if FOREACH_THREAD_START(@i) then threads_lock;
begin
repeat
td:=THREAD_GET(@i);
if (first_td=nil) then td:=TAILQ_FIRST(@p_threads);
while (td<>nil) do
begin begin
first_td:=td;
if (first_td=nil) then
begin
first_td:=td;
end;
if (not SIGISMEMBER(@td^.td_sigmask,sig)) then
begin
signal_td:=td;
Break;
end;
td:=TAILQ_NEXT(td,@td^.td_plist)
end; end;
if (not SIGISMEMBER(@td^.td_sigmask,sig)) then threads_unlock;
begin
signal_td:=td;
Break;
end;
until not THREAD_NEXT(@i);
FOREACH_THREAD_FINISH();
end;
if (signal_td=nil) then if (signal_td=nil) then
begin begin

4
sys/kern/kern_thr.pas
View File

@ -177,6 +177,7 @@ type
pp_kthread=^p_kthread; pp_kthread=^p_kthread;
p_kthread=^kthread; p_kthread=^kthread;
kthread=record kthread=record
td_plist :TAILQ_ENTRY;
td_umtxq :Pointer; //p_umtx_q td_umtxq :Pointer; //p_umtx_q
td_handle :THandle; //nt thread td_handle :THandle; //nt thread
td_teb :p_teb; td_teb :p_teb;
@ -198,11 +199,9 @@ type
td_user_pri :Word; td_user_pri :Word;
td_name :t_td_name; td_name :t_td_name;
// //
td_cpuset :Ptruint;
td_sigmask :sigset_t; td_sigmask :sigset_t;
td_oldsigmask :sigset_t; td_oldsigmask :sigset_t;
td_sigqueue :sigqueue_t; td_sigqueue :sigqueue_t;
td_align :Pointer;
td_frame :trapframe; td_frame :trapframe;
td_fpstate :t_fpstate; td_fpstate :t_fpstate;
td_retval :array[0..1] of QWORD; td_retval :array[0..1] of QWORD;
@ -210,6 +209,7 @@ type
td_ustack :t_td_stack; td_ustack :t_td_stack;
td_kstack :t_td_stack; td_kstack :t_td_stack;
// //
td_cpuset :Ptruint;
td_sleepqueue :Pointer; td_sleepqueue :Pointer;
td_slpq :TAILQ_ENTRY; td_slpq :TAILQ_ENTRY;
td_wchan :Pointer; td_wchan :Pointer;

80
sys/kern/kern_thread.pas
View File

@ -17,10 +17,6 @@ uses
rtprio, rtprio,
hamt; hamt;
type
p_kthread_iterator=^kthread_iterator;
kthread_iterator=THAMT_Iterator32;
procedure thread_reap(); procedure thread_reap();
function thread_alloc:p_kthread; function thread_alloc:p_kthread;
@ -48,10 +44,8 @@ procedure thread_lock (td:p_kthread);
procedure thread_unlock (td:p_kthread); procedure thread_unlock (td:p_kthread);
function tdfind(tid:DWORD):p_kthread; function tdfind(tid:DWORD):p_kthread;
function FOREACH_THREAD_START (i:p_kthread_iterator):Boolean; procedure threads_lock;
procedure FOREACH_THREAD_FINISH(); procedure threads_unlock;
function THREAD_NEXT(i:p_kthread_iterator):Boolean;
function THREAD_GET (i:p_kthread_iterator):p_kthread;
procedure KernSetThreadDebugName(newtd:p_kthread;prefix:PChar); procedure KernSetThreadDebugName(newtd:p_kthread;prefix:PChar);
@ -65,6 +59,9 @@ procedure kthread_exit();
var var
init_tty_cb:Tprocedure; init_tty_cb:Tprocedure;
p_threads:TAILQ_HEAD=(tqh_first:nil;tqh_last:@p_threads.tqh_first);
p_numthreads:Integer=0;
implementation implementation
uses uses
@ -74,7 +71,6 @@ uses
md_sleep, md_sleep,
md_context, md_context,
machdep, machdep,
md_proc,
md_thread, md_thread,
kern_rwlock, kern_rwlock,
kern_sig, kern_sig,
@ -108,8 +104,6 @@ var
zombie_threads:TAILQ_HEAD=(tqh_first:nil;tqh_last:@zombie_threads.tqh_first); zombie_threads:TAILQ_HEAD=(tqh_first:nil;tqh_last:@zombie_threads.tqh_first);
zombie_lock:Pointer=nil; zombie_lock:Pointer=nil;
p_numthreads:Integer=0;
const const
max_threads_per_proc=1500; max_threads_per_proc=1500;
@ -126,9 +120,12 @@ begin
Result:=0; Result:=0;
end; end;
var
_t_init:Integer=0;
procedure threadinit; procedure threadinit;
begin begin
FillChar(tidhashtbl,SizeOf(tidhashtbl),0); if (System.InterlockedExchange(_t_init,1)<>0) then Exit;
//init internals //init internals
BeginThread(@_thread_null); BeginThread(@_thread_null);
end; end;
@ -265,6 +262,8 @@ var
begin begin
rw_wlock(tidhash_lock); rw_wlock(tidhash_lock);
TAILQ_INSERT_HEAD(@p_threads, td, @td^.td_plist);
data:=HAMT_insert32(@tidhashtbl,td^.td_tid,td); data:=HAMT_insert32(@tidhashtbl,td^.td_tid,td);
if (data<>nil) then if (data<>nil) then
@ -285,6 +284,8 @@ begin
data:=nil; data:=nil;
rw_wlock(tidhash_lock); rw_wlock(tidhash_lock);
TAILQ_REMOVE(@p_threads, td, @td^.td_plist);
HAMT_delete32(@tidhashtbl,td^.td_tid,@data); HAMT_delete32(@tidhashtbl,td^.td_tid,@data);
rw_wunlock(tidhash_lock); rw_wunlock(tidhash_lock);
@ -295,33 +296,16 @@ begin
end; end;
end; end;
function FOREACH_THREAD_START(i:p_kthread_iterator):Boolean; procedure threads_lock;
begin begin
rw_rlock(tidhash_lock); rw_wlock(tidhash_lock);
Result:=HAMT_first32(@tidhashtbl,i);
if not Result then //space
begin
rw_runlock(tidhash_lock);
end;
end; end;
procedure FOREACH_THREAD_FINISH(); procedure threads_unlock;
begin begin
rw_runlock(tidhash_lock); rw_wunlock(tidhash_lock);
end; end;
function THREAD_NEXT(i:p_kthread_iterator):Boolean;
begin
Result:=HAMT_next32(i);
end;
function THREAD_GET(i:p_kthread_iterator):p_kthread;
begin
Result:=nil;
HAMT_get_value32(i,@Result);
end;
procedure KernSetThreadDebugName(newtd:p_kthread;prefix:PChar); procedure KernSetThreadDebugName(newtd:p_kthread;prefix:PChar);
var var
@ -605,6 +589,8 @@ var
begin begin
Result:=0; Result:=0;
threadinit;
if (func=nil) or if (func=nil) or
(newtdp=nil) then (newtdp=nil) then
begin begin
@ -833,7 +819,6 @@ function sys_thr_kill(id,sig:Integer):Integer;
var var
td,ttd:p_kthread; td,ttd:p_kthread;
ksi:ksiginfo_t; ksi:ksiginfo_t;
i:kthread_iterator;
begin begin
td:=curkthread; td:=curkthread;
@ -854,19 +839,24 @@ begin
Result:=ESRCH; Result:=ESRCH;
PROC_LOCK; PROC_LOCK;
if FOREACH_THREAD_START(@i) then threads_lock;
begin
repeat ttd:=TAILQ_FIRST(@p_threads);
ttd:=THREAD_GET(@i); while (ttd<>nil) do
if (ttd<>td) then
begin begin
Result:=0;
if (sig=0) then Break; if (ttd<>td) then
tdksignal(ttd,sig,@ksi); begin
Result:=0;
if (sig=0) then Break;
tdksignal(ttd,sig,@ksi);
end;
ttd:=TAILQ_NEXT(ttd,@ttd^.td_plist)
end; end;
until not THREAD_NEXT(@i);
FOREACH_THREAD_FINISH(); threads_unlock;
end;
PROC_UNLOCK; PROC_UNLOCK;
end; end;

61
sys/md/md_map.pas
View File

@ -37,6 +37,17 @@ const
MD_PROT_RW //XWR MD_PROT_RW //XWR
); );
wprots_e:array[0..7] of Byte=(
MD_PROT_NONE,//___
MD_PROT_R ,//__R
MD_PROT_W ,//_W_
MD_PROT_RW ,//_WR
MD_PROT_X ,//X__
MD_PROT_RX ,//X_R
MD_PROT_WX ,//XW_
MD_PROT_RWX //XWR
);
function md_reserve(hProcess:THandle;var base:Pointer;size:QWORD):Integer; function md_reserve(hProcess:THandle;var base:Pointer;size:QWORD):Integer;
function md_reserve(var base:Pointer;size:QWORD):Integer; function md_reserve(var base:Pointer;size:QWORD):Integer;
@ -44,7 +55,7 @@ function md_split (base:Pointer;size:QWORD):Integer;
function md_union (base:Pointer;size:QWORD):Integer; function md_union (base:Pointer;size:QWORD):Integer;
function md_memfd_create(var hMem:THandle;size:QWORD):Integer; function md_memfd_create(var hMem:THandle;size:QWORD):Integer;
function md_memfd_open (var hMem:THandle;hFile:THandle):Integer; function md_memfd_open (var hMem:THandle;hFile:THandle;maxprot:Byte):Integer;
function md_memfd_close (hMem:THandle):Integer; function md_memfd_close (hMem:THandle):Integer;
function md_protect(hProcess:THandle;base:Pointer;size:QWORD;prot:Integer):Integer; function md_protect(hProcess:THandle;base:Pointer;size:QWORD;prot:Integer):Integer;
@ -187,19 +198,39 @@ begin
); );
end; end;
function md_memfd_open(var hMem:THandle;hFile:THandle):Integer; function md_memfd_open(var hMem:THandle;hFile:THandle;maxprot:Byte):Integer;
var var
Access:DWORD;
prot:DWORD;
size:QWORD; size:QWORD;
begin begin
Access:=SECTION_QUERY;
if ((maxprot and VM_PROT_READ)<>0) then
begin
Access:=Access or SECTION_MAP_READ;
end;
if ((maxprot and VM_PROT_WRITE)<>0) then
begin
Access:=Access or SECTION_MAP_WRITE;
end;
if ((maxprot and VM_PROT_EXECUTE)<>0) then
begin
Access:=Access or SECTION_MAP_EXECUTE;
end;
prot:=wprots_e[maxprot and VM_RWX];
size:=0; size:=0;
hMem:=0; hMem:=0;
Result:=NtCreateSection( Result:=NtCreateSection(
@hMem, @hMem,
SECTION_ALL_ACCESS, Access,
//SECTION_MAP_WRITE or SECTION_MAP_READ or SECTION_MAP_EXECUTE,
nil, nil,
@size, @size,
PAGE_READWRITE, prot,
SEC_COMMIT, SEC_COMMIT,
hFile hFile
); );
@ -293,31 +324,15 @@ end;
function md_file_mmap(handle:THandle;var base:Pointer;offset,size:QWORD;prot:Integer):Integer; function md_file_mmap(handle:THandle;var base:Pointer;offset,size:QWORD;prot:Integer):Integer;
var var
hSection:THandle;
CommitSize:ULONG_PTR; CommitSize:ULONG_PTR;
SectionOffset:ULONG_PTR; SectionOffset:ULONG_PTR;
begin begin
CommitSize:=0; //full size
hSection:=0;
Result:=NtCreateSection(
@hSection,
SECTION_MAP_WRITE or SECTION_MAP_READ or SECTION_MAP_EXECUTE,
nil,
@CommitSize,
prot,
SEC_COMMIT,
handle
);
if (Result<>0) then Exit;
base:=md_alloc_page(base); base:=md_alloc_page(base);
CommitSize:=size; CommitSize:=size;
SectionOffset:=offset and (not (MD_ALLOC_GRANULARITY-1)); SectionOffset:=offset and (not (MD_ALLOC_GRANULARITY-1));
Result:=NtMapViewOfSection(hSection, Result:=NtMapViewOfSection(handle,
NtCurrentProcess, NtCurrentProcess,
@base, @base,
0, 0,
@ -328,8 +343,6 @@ begin
0, 0,
prot prot
); );
NtClose(hSection);
end; end;
function md_file_unmap(base:Pointer;size:QWORD):Integer; function md_file_unmap(base:Pointer;size:QWORD):Integer;

49
sys/md/vm_pmap.pas
View File

@ -86,6 +86,9 @@ procedure pmap_remove(pmap :pmap_t;
implementation implementation
uses
ntapi;
function atop(x:QWORD):DWORD; inline; function atop(x:QWORD):DWORD; inline;
begin begin
Result:=QWORD(x) shr PAGE_SHIFT; Result:=QWORD(x) shr PAGE_SHIFT;
@ -119,6 +122,8 @@ begin
Assert(false,'dev_mem_init'); Assert(false,'dev_mem_init');
end; end;
DEV_INFO.DEV_FD.maxp:=VM_PROT_READ or VM_PROT_WRITE;
DEV_INFO.DEV_PTR:=nil; DEV_INFO.DEV_PTR:=nil;
r:=md_reserve(DEV_INFO.DEV_PTR,DEV_INFO.DEV_SIZE); r:=md_reserve(DEV_INFO.DEV_PTR,DEV_INFO.DEV_SIZE);
if (r<>0) then if (r<>0) then
@ -260,7 +265,7 @@ begin
Assert(false,'get_private_fd'); Assert(false,'get_private_fd');
end; end;
info.obj:=vm_nt_file_obj_allocate(hfile); info.obj:=vm_nt_file_obj_allocate(hfile,VM_PROT_READ or VM_PROT_WRITE);
with info.obj^ do with info.obj^ do
begin begin
@ -283,6 +288,8 @@ begin
begin begin
R:=md_memfd_create(DMEM_FD[i].hfile,PMAPP_1GB_SIZE); R:=md_memfd_create(DMEM_FD[i].hfile,PMAPP_1GB_SIZE);
DMEM_FD[i].maxp:=VM_PROT_READ or VM_PROT_WRITE;
if (r<>0) then if (r<>0) then
begin begin
Writeln('failed md_memfd_create(',HexStr(PMAPP_1GB_SIZE,11),'):0x',HexStr(r,8)); Writeln('failed md_memfd_create(',HexStr(PMAPP_1GB_SIZE,11),'):0x',HexStr(r,8));
@ -391,6 +398,9 @@ procedure pmap_copy(pmap :pmap_t;
delta :vm_ooffset_t; delta :vm_ooffset_t;
size :vm_ooffset_t); size :vm_ooffset_t);
var var
start :vm_ooffset_t;
__end :vm_ooffset_t;
offset:vm_ooffset_t;
src,dst:Pointer; src,dst:Pointer;
r:Integer; r:Integer;
begin begin
@ -399,8 +409,12 @@ begin
size:=delta; size:=delta;
end; end;
start :=src_ofs and (not (MD_ALLOC_GRANULARITY-1)); //dw
__end :=src_ofs+size; //up
offset:=src_ofs and (MD_ALLOC_GRANULARITY-1);
src:=nil; src:=nil;
r:=md_file_mmap(src_obj^.hfile,src,src_ofs,size,MD_PROT_R); r:=md_file_mmap(src_obj^.hfile,src,start,__end-start,MD_PROT_R);
if (r<>0) then if (r<>0) then
begin begin
@ -417,7 +431,7 @@ begin
Assert(false,'pmap_copy'); Assert(false,'pmap_copy');
end; end;
Move(src^,dst^,size); Move((src+offset)^,dst^,size);
md_cacheflush(dst,size,DCACHE); md_cacheflush(dst,size,DCACHE);
@ -469,6 +483,8 @@ var
info:t_fd_info; info:t_fd_info;
cow :p_vm_nt_file_obj; cow :p_vm_nt_file_obj;
max:Integer;
r:Integer; r:Integer;
begin begin
Writeln('pmap_enter_object:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2)); Writeln('pmap_enter_object:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2));
@ -605,7 +621,14 @@ begin
end; end;
size:=size-offset; size:=size-offset;
r:=md_memfd_open(md,fd); max:=VM_PROT_READ or VM_PROT_WRITE;
r:=md_memfd_open(md,fd,max);
if (DWORD(r)=STATUS_ACCESS_DENIED) then
begin
max:=VM_PROT_READ;
r:=md_memfd_open(md,fd,max);
end;
end; end;
VM_OBJECT_UNLOCK(obj); VM_OBJECT_UNLOCK(obj);
@ -629,9 +652,7 @@ begin
begin begin
Writeln('pmap_enter_cowobj:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2)); Writeln('pmap_enter_cowobj:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2));
Assert(false,'TODO COW'); cow:=vm_nt_file_obj_allocate(md,VM_PROT_READ);
cow:=vm_nt_file_obj_allocate(md);
info.offset:=offset; info.offset:=offset;
info.start :=start; info.start :=start;
@ -675,7 +696,7 @@ begin
end else end else
begin begin
info.obj :=vm_nt_file_obj_allocate(md); info.obj :=vm_nt_file_obj_allocate(md,max);
info.offset:=offset; info.offset:=offset;
info.start :=start; info.start :=start;
info.__end :=start+paddi; info.__end :=start+paddi;
@ -697,16 +718,14 @@ begin
pmap_mark(info.start,info.__end,prot and VM_RWX); pmap_mark(info.start,info.__end,prot and VM_RWX);
//aligned size //upper pages
size:=paddi; delta:=(paddi and PAGE_MASK);
//padding pages if (delta<>0) then
paddi:=PAGE_SIZE-((delta-size) and PAGE_MASK);
if (paddi<>0) then
begin begin
offset:=0; offset:=0;
start:=start+size; start:=start+paddi;
prot:=prot and (not VM_PROT_COPY);
goto _default; goto _default;
end; end;

35
sys/vm/vm_nt_map.pas
View File

@ -24,6 +24,7 @@ type
hfile:THandle; hfile:THandle;
refs :QWORD; refs :QWORD;
flags:QWORD; flags:QWORD;
maxp :Byte;
end; end;
pp_vm_nt_entry=^p_vm_nt_entry; pp_vm_nt_entry=^p_vm_nt_entry;
@ -50,7 +51,7 @@ type
property max_offset:vm_offset_t read header.__end write header.__end; property max_offset:vm_offset_t read header.__end write header.__end;
end; end;
function vm_nt_file_obj_allocate (hfile:THandle):p_vm_nt_file_obj; function vm_nt_file_obj_allocate (hfile:THandle;maxp:Byte):p_vm_nt_file_obj;
procedure vm_nt_file_obj_destroy (obj:p_vm_nt_file_obj); procedure vm_nt_file_obj_destroy (obj:p_vm_nt_file_obj);
procedure vm_nt_file_obj_reference (obj:p_vm_nt_file_obj); procedure vm_nt_file_obj_reference (obj:p_vm_nt_file_obj);
procedure vm_nt_file_obj_deallocate(obj:p_vm_nt_file_obj); procedure vm_nt_file_obj_deallocate(obj:p_vm_nt_file_obj);
@ -114,13 +115,16 @@ type
); );
end; end;
function vm_nt_file_obj_allocate(hfile:THandle):p_vm_nt_file_obj; function vm_nt_file_obj_allocate(hfile:THandle;maxp:Byte):p_vm_nt_file_obj;
begin begin
Assert(maxp<>0);
Result:=AllocMem(SizeOf(vm_nt_file_obj)); Result:=AllocMem(SizeOf(vm_nt_file_obj));
Result^.hfile:=hfile; Result^.hfile:=hfile;
Result^.refs :=1; Result^.refs :=1;
Result^.flags:=NT_FILE_FREE or NT_MOBJ_FREE or NT_UNION_OBJ; Result^.flags:=NT_FILE_FREE or NT_MOBJ_FREE or NT_UNION_OBJ;
Result^.maxp :=maxp;
end; end;
procedure vm_nt_file_obj_destroy(obj:p_vm_nt_file_obj); procedure vm_nt_file_obj_destroy(obj:p_vm_nt_file_obj);
@ -163,7 +167,10 @@ end;
// //
procedure vm_prot_fixup(map:p_vm_nt_map;start,__end:vm_offset_t); procedure vm_prot_fixup(map:p_vm_nt_map;
start:vm_offset_t;
__end:vm_offset_t;
max :Integer);
var var
next:vm_offset_t; next:vm_offset_t;
base,size:vm_size_t; base,size:vm_size_t;
@ -184,7 +191,7 @@ begin
prot:=wprots[prot and VM_RWX]; prot:=wprots[prot and VM_RWX];
if (prot<>MD_PROT_RW) then if (prot<>max) then
begin begin
r:=md_protect(Pointer(base),size,prot); r:=md_protect(Pointer(base),size,prot);
if (r<>0) then if (r<>0) then
@ -240,6 +247,7 @@ var
start:vm_offset_t; start:vm_offset_t;
__end:vm_offset_t; __end:vm_offset_t;
size:vm_size_t; size:vm_size_t;
max:Integer;
r:Integer; r:Integer;
begin begin
if (entry^.obj<>nil) then if (entry^.obj<>nil) then
@ -260,13 +268,15 @@ begin
end; end;
end; end;
max:=wprots[entry^.obj^.maxp and VM_RWX];
if (entry^.obj^.hfile<>0) then if (entry^.obj^.hfile<>0) then
begin begin
r:=md_file_mmap_ex(entry^.obj^.hfile, r:=md_file_mmap_ex(entry^.obj^.hfile,
Pointer(entry^.start), Pointer(entry^.start),
entry^.offset, entry^.offset,
entry^.size, //unaligned size entry^.size, //unaligned size
MD_PROT_RW); max);
if (r<>0) then if (r<>0) then
begin begin
Writeln('failed md_file_mmap_ex(',HexStr(entry^.start,11),',',HexStr(entry^.start+size,11),'):0x',HexStr(r,8)); Writeln('failed md_file_mmap_ex(',HexStr(entry^.start,11),',',HexStr(entry^.start+size,11),'):0x',HexStr(r,8));
@ -274,7 +284,7 @@ begin
end; end;
end; end;
if (prot<>MD_PROT_RW) then if (prot<>max) then
begin begin
r:=md_protect(Pointer(entry^.start),size,prot); r:=md_protect(Pointer(entry^.start),size,prot);
if (r<>0) then if (r<>0) then
@ -304,6 +314,8 @@ var
__end:vm_offset_t; __end:vm_offset_t;
size:vm_size_t; size:vm_size_t;
max:Integer;
p:p_range; p:p_range;
i,r:Integer; i,r:Integer;
begin begin
@ -419,6 +431,8 @@ begin
end; end;
end; end;
max:=wprots[stat.obj^.maxp and VM_RWX];
//map new parts //map new parts
For i:=Low(ets) to High(ets) do For i:=Low(ets) to High(ets) do
begin begin
@ -432,7 +446,7 @@ begin
Pointer(ets[i]^.start), Pointer(ets[i]^.start),
ets[i]^.offset, ets[i]^.offset,
ets[i]^.size, //unaligned size ets[i]^.size, //unaligned size
MD_PROT_RW); max);
if (r<>0) then if (r<>0) then
begin begin
Writeln('failed md_file_mmap_ex(',HexStr(ets[i]^.start,11),',',HexStr(ets[i]^.__end,11),'):0x',HexStr(r,8)); Writeln('failed md_file_mmap_ex(',HexStr(ets[i]^.start,11),',',HexStr(ets[i]^.__end,11),'):0x',HexStr(r,8));
@ -451,8 +465,13 @@ begin
if (ets[i]<>nil) then if (ets[i]<>nil) then
begin begin
if (ets[i]^.obj<>nil) then if (ets[i]^.obj<>nil) then
if (stat.obj^.hfile<>0) then
begin begin
vm_prot_fixup(map,ets[i]^.start,ets[i]^.__end); vm_prot_fixup(map,
ets[i]^.start,
ets[i]^.__end,
max
);
end; end;
end; end;
end; end;