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"/>
<IsPartOfProject Value="True"/>
</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>
</ProjectOptions>
<CompilerOptions>

89
gui/game_run.pas
View File

@ -8,25 +8,45 @@ uses
windows,
Classes,
SysUtils,
kern_thr,
md_pipe,
host_ipc,
md_host_ipc,
game_info;
var
t_wr_handle:THandle;
type
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;
procedure run_item(Item:TGameItem);
function run_item(const cfg:TGameRunConfig;Item:TGameItem):TGameProcess;
implementation
uses
sys_sysinit,
kern_param,
kern_thr,
kern_thread,
kern_exec,
vfs_mountroot,
@ -187,12 +207,8 @@ begin
sleep(-1);
end;
const
fork_proc:Boolean=True;
procedure run_item(Item:TGameItem);
function run_item(const cfg:TGameRunConfig;Item:TGameItem):TGameProcess;
var
td:p_kthread;
r:Integer;
kern2mgui:array[0..1] of THandle;
@ -204,21 +220,29 @@ var
mem:TMemoryStream;
begin
Result:=nil;
if Item.FLock then Exit;
if runing then Exit;
SetStdHandle(STD_ERROR_HANDLE ,t_wr_handle);
SetStdHandle(STD_OUTPUT_HANDLE,t_wr_handle);
SetStdHandle(STD_OUTPUT_HANDLE,cfg.hOutput);
SetStdHandle(STD_ERROR_HANDLE ,cfg.hError );
if fork_proc then
if cfg.fork_proc then
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;
p_mgui_ipc.set_pipe(kern2mgui[0]);
with TGameProcessPipe(Result) do
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);
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;
end else
begin
s_kern_ipc:=THostIpcSimpleKERN.Create;
s_mgui_ipc:=THostIpcSimpleMGUI.Create;
Result:=TGameProcessSimple.Create;
Result.g_fork:=cfg.fork_proc;
s_kern_ipc.FDest:=s_mgui_ipc;
s_mgui_ipc.FDest:=s_kern_ipc;
with TGameProcessSimple(Result) do
begin
kern_ipc:=s_kern_ipc;
mgui_ipc:=s_mgui_ipc;
s_kern_ipc:=THostIpcSimpleKERN.Create;
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;
runing:=True;

22
gui/main.pas
View File

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

13
sys/host_ipc.pas
View File

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

49
sys/kern/kern_rtprio.pas
View File

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

50
sys/kern/kern_sig.pas
View File

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

4
sys/kern/kern_thr.pas
View File

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

80
sys/kern/kern_thread.pas
View File

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

61
sys/md/md_map.pas
View File

@ -37,6 +37,17 @@ const
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(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_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_protect(hProcess:THandle;base:Pointer;size:QWORD;prot:Integer):Integer;
@ -187,19 +198,39 @@ begin
);
end;
function md_memfd_open(var hMem:THandle;hFile:THandle):Integer;
function md_memfd_open(var hMem:THandle;hFile:THandle;maxprot:Byte):Integer;
var
Access:DWORD;
prot:DWORD;
size:QWORD;
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;
hMem:=0;
Result:=NtCreateSection(
@hMem,
SECTION_ALL_ACCESS,
//SECTION_MAP_WRITE or SECTION_MAP_READ or SECTION_MAP_EXECUTE,
Access,
nil,
@size,
PAGE_READWRITE,
prot,
SEC_COMMIT,
hFile
);
@ -293,31 +324,15 @@ end;
function md_file_mmap(handle:THandle;var base:Pointer;offset,size:QWORD;prot:Integer):Integer;
var
hSection:THandle;
CommitSize:ULONG_PTR;
SectionOffset:ULONG_PTR;
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);
CommitSize:=size;
SectionOffset:=offset and (not (MD_ALLOC_GRANULARITY-1));
Result:=NtMapViewOfSection(hSection,
Result:=NtMapViewOfSection(handle,
NtCurrentProcess,
@base,
0,
@ -328,8 +343,6 @@ begin
0,
prot
);
NtClose(hSection);
end;
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
uses
ntapi;
function atop(x:QWORD):DWORD; inline;
begin
Result:=QWORD(x) shr PAGE_SHIFT;
@ -119,6 +122,8 @@ begin
Assert(false,'dev_mem_init');
end;
DEV_INFO.DEV_FD.maxp:=VM_PROT_READ or VM_PROT_WRITE;
DEV_INFO.DEV_PTR:=nil;
r:=md_reserve(DEV_INFO.DEV_PTR,DEV_INFO.DEV_SIZE);
if (r<>0) then
@ -260,7 +265,7 @@ begin
Assert(false,'get_private_fd');
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
begin
@ -283,6 +288,8 @@ begin
begin
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
begin
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;
size :vm_ooffset_t);
var
start :vm_ooffset_t;
__end :vm_ooffset_t;
offset:vm_ooffset_t;
src,dst:Pointer;
r:Integer;
begin
@ -399,8 +409,12 @@ begin
size:=delta;
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;
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
begin
@ -417,7 +431,7 @@ begin
Assert(false,'pmap_copy');
end;
Move(src^,dst^,size);
Move((src+offset)^,dst^,size);
md_cacheflush(dst,size,DCACHE);
@ -469,6 +483,8 @@ var
info:t_fd_info;
cow :p_vm_nt_file_obj;
max:Integer;
r:Integer;
begin
Writeln('pmap_enter_object:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2));
@ -605,7 +621,14 @@ begin
end;
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;
VM_OBJECT_UNLOCK(obj);
@ -629,9 +652,7 @@ begin
begin
Writeln('pmap_enter_cowobj:',HexStr(start,11),':',HexStr(__end,11),':',HexStr(prot,2));
Assert(false,'TODO COW');
cow:=vm_nt_file_obj_allocate(md);
cow:=vm_nt_file_obj_allocate(md,VM_PROT_READ);
info.offset:=offset;
info.start :=start;
@ -675,7 +696,7 @@ begin
end else
begin
info.obj :=vm_nt_file_obj_allocate(md);
info.obj :=vm_nt_file_obj_allocate(md,max);
info.offset:=offset;
info.start :=start;
info.__end :=start+paddi;
@ -697,16 +718,14 @@ begin
pmap_mark(info.start,info.__end,prot and VM_RWX);
//aligned size
size:=paddi;
//upper pages
delta:=(paddi and PAGE_MASK);
//padding pages
paddi:=PAGE_SIZE-((delta-size) and PAGE_MASK);
if (paddi<>0) then
if (delta<>0) then
begin
offset:=0;
start:=start+size;
start:=start+paddi;
prot:=prot and (not VM_PROT_COPY);
goto _default;
end;

35
sys/vm/vm_nt_map.pas
View File

@ -24,6 +24,7 @@ type
hfile:THandle;
refs :QWORD;
flags:QWORD;
maxp :Byte;
end;
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;
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_reference (obj:p_vm_nt_file_obj);
procedure vm_nt_file_obj_deallocate(obj:p_vm_nt_file_obj);
@ -114,13 +115,16 @@ type
);
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
Assert(maxp<>0);
Result:=AllocMem(SizeOf(vm_nt_file_obj));
Result^.hfile:=hfile;
Result^.refs :=1;
Result^.flags:=NT_FILE_FREE or NT_MOBJ_FREE or NT_UNION_OBJ;
Result^.maxp :=maxp;
end;
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
next:vm_offset_t;
base,size:vm_size_t;
@ -184,7 +191,7 @@ begin
prot:=wprots[prot and VM_RWX];
if (prot<>MD_PROT_RW) then
if (prot<>max) then
begin
r:=md_protect(Pointer(base),size,prot);
if (r<>0) then
@ -240,6 +247,7 @@ var
start:vm_offset_t;
__end:vm_offset_t;
size:vm_size_t;
max:Integer;
r:Integer;
begin
if (entry^.obj<>nil) then
@ -260,13 +268,15 @@ begin
end;
end;
max:=wprots[entry^.obj^.maxp and VM_RWX];
if (entry^.obj^.hfile<>0) then
begin
r:=md_file_mmap_ex(entry^.obj^.hfile,
Pointer(entry^.start),
entry^.offset,
entry^.size, //unaligned size
MD_PROT_RW);
max);
if (r<>0) then
begin
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;
if (prot<>MD_PROT_RW) then
if (prot<>max) then
begin
r:=md_protect(Pointer(entry^.start),size,prot);
if (r<>0) then
@ -304,6 +314,8 @@ var
__end:vm_offset_t;
size:vm_size_t;
max:Integer;
p:p_range;
i,r:Integer;
begin
@ -419,6 +431,8 @@ begin
end;
end;
max:=wprots[stat.obj^.maxp and VM_RWX];
//map new parts
For i:=Low(ets) to High(ets) do
begin
@ -432,7 +446,7 @@ begin
Pointer(ets[i]^.start),
ets[i]^.offset,
ets[i]^.size, //unaligned size
MD_PROT_RW);
max);
if (r<>0) then
begin
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
begin
if (ets[i]^.obj<>nil) then
if (stat.obj^.hfile<>0) then
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;