diff --git a/gui/game_run.pas b/gui/game_run.pas index 163cc5fd..852ddb6d 100644 --- a/gui/game_run.pas +++ b/gui/game_run.pas @@ -244,7 +244,6 @@ var mem:TMemoryStream; begin Result:=nil; - if Item.FLock then Exit; SetStdHandle(STD_OUTPUT_HANDLE,cfg.hOutput); SetStdHandle(STD_ERROR_HANDLE ,cfg.hError ); diff --git a/gui/main.pas b/gui/main.pas index fd91ab74..9d9c0079 100644 --- a/gui/main.pas +++ b/gui/main.pas @@ -74,6 +74,7 @@ type public FGameProcess:TGameProcess; + FGameItem :TGameItem; FIniFile:TIniFile; @@ -93,8 +94,10 @@ type FGameMainForm:TGameMainForm; + function get_caption_format:RawByteString; function OpenMainWindows():THandle; Procedure CloseMainWindows(); + procedure SetCaptionFPS(Ffps:QWORD); procedure ReadIniFile; procedure LoadItemIni(Item:TGameItem); @@ -179,6 +182,7 @@ begin case mtype of iKEV_EVENT :Result:=OnKevent(buf,mlen div sizeof(t_kevent)); iMAIN_WINDOWS:Result:=Form.OpenMainWindows(); + iCAPTION_FPS :Form.SetCaptionFPS(PQWORD(buf)^); else; ShowMessage(GetEnumName(TypeInfo(mtype),ord(mtype))); end; @@ -396,6 +400,29 @@ begin end; +function TfrmMain.get_caption_format:RawByteString; +var + TITLE,TITLE_ID,APP_VER:RawByteString; +begin + Result:=''; + + if (FGameItem=nil) then Exit; + + TITLE :=FGameItem.FGameInfo.Name; + TITLE_ID:=FGameItem.FGameInfo.TitleId; + APP_VER :=FGameItem.FGameInfo.Version; + + if (TITLE='') then + begin + TITLE:=ExtractFileName(FGameItem.FGameInfo.Exec); + end; + + if (TITLE_ID<>'') then TITLE_ID:='-' +TITLE_ID; + if (APP_VER <>'') then APP_VER :=':v'+APP_VER; + + Result:=Format('fpPS4 (%s) [%s%s%s]',[{$I tag.inc},TITLE,TITLE_ID,APP_VER])+' FPS:%d'; +end; + function TfrmMain.OpenMainWindows():THandle; const pd_Width=1280; @@ -409,7 +436,7 @@ begin FGameMainForm.ParentDoubleBuffered:=False; FGameMainForm.FormStyle:=fsNormal; FGameMainForm.SetBounds(100, 100, pd_Width, pd_Height); - //FGameMainForm.caption_format:=get_caption_format; + FGameMainForm.caption_format:=get_caption_format; FGameMainForm.SetCaptionFPS(0); //FGameMainForm.OnClose:=@FGameMainForm.CloseEvent; //FGameMainForm.OnKeyDown:=@FGameMainForm.KeyEvent; @@ -428,6 +455,13 @@ begin FreeAndNil(FGameMainForm); end; +procedure TfrmMain.SetCaptionFPS(Ffps:QWORD); +begin + if (FGameMainForm=nil) then Exit; + + FGameMainForm.SetCaptionFPS(Ffps); +end; + procedure TfrmMain.MIAddClick(Sender: TObject); var form:TfrmGameEditor; @@ -530,11 +564,19 @@ begin cfg.hOutput:=FAddHandle; cfg.hError :=FAddHandle; - cfg.fork_proc:=False; + cfg.fork_proc:=True; + + if Item.FLock then Exit; FGameProcess:=run_item(cfg,Item); - SetButtonsState(mdsStarted); + if (FGameProcess<>nil) then + begin + Item.FLock:=True; + FGameItem:=Item; + + SetButtonsState(mdsStarted); + end; end; procedure TfrmMain.TBPlayClick(Sender: TObject); @@ -571,6 +613,12 @@ begin SetButtonsState(mbsStopped); FreeAndNil(FGameProcess); // + if (FGameItem<>nil) then + begin + FGameItem.FLock:=False; + FGameItem:=nil; + end; + // CloseMainWindows; // Pages.ActivePage:=TabList; diff --git a/rtl/ntapi.pas b/rtl/ntapi.pas index 0efad65c..3f4dbd24 100644 --- a/rtl/ntapi.pas +++ b/rtl/ntapi.pas @@ -94,7 +94,8 @@ const ProcessImageFileNameWin32=43; //SystemInformationClass - SystemTimeAdjustmentInformation=28; + SystemTimeAdjustmentInformation =28; + SystemHypervisorSharedPageInformation=197; //ntapi PriorityClass PROCESS_PRIORITY_CLASS_UNKNOWN =0; diff --git a/sys/dev/display_soft.pas b/sys/dev/display_soft.pas index 38ebe9b4..93bd85aa 100644 --- a/sys/dev/display_soft.pas +++ b/sys/dev/display_soft.pas @@ -6,6 +6,7 @@ interface uses display_interface, + time, md_time; type @@ -51,8 +52,6 @@ begin hWindow:=p_proc.p_host_ipc.OpenMainWindows(); Writeln('OpenMainWindows:',hWindow); - - SetWindowTextA(hWindow,'OpenMainWindows'); end; function TDisplayHandleSoft.RegisterBufferAttribute(attrid:Byte;attr:p_register_buffer_attr):Integer; @@ -102,6 +101,10 @@ begin ReleaseDC(hWindow, hdc); end; +var + Ffps :QWORD=0; + Ftsc_prev:QWORD=0; + function TDisplayHandleSoft.SubmitFlip(submit:p_submit_flip):Integer; var buf:p_buffer; @@ -121,6 +124,21 @@ begin last_status.tsc :=rdtsc; last_status.processTime:=last_status.tsc; + if (Ftsc_prev=0) then + begin + Ftsc_prev:=last_status.tsc; + Ffps:=1; + end else + begin + Inc(Ffps); + if ((last_status.tsc-Ftsc_prev) div tsc_freq)>=1 then + begin + p_proc.p_host_ipc.SetCaptionFPS(Ffps); + Ffps:=0; + Ftsc_prev:=last_status.tsc; + end; + end; + Result:=0; end; diff --git a/sys/host_ipc.pas b/sys/host_ipc.pas index c034b6cb..d58e5aa1 100644 --- a/sys/host_ipc.pas +++ b/sys/host_ipc.pas @@ -20,7 +20,8 @@ type iKEV_CHANGE, iKEV_EVENT, iMOUNT, - iMAIN_WINDOWS + iMAIN_WINDOWS, + iCAPTION_FPS ); PNodeHeader=^TNodeHeader; @@ -71,6 +72,7 @@ type // procedure kevent(kev:p_kevent;count:Integer); function OpenMainWindows():THandle; + procedure SetCaptionFps(Ffps:QWORD); // function SendSync(mtype:t_mtype;mlen:DWORD;buf:Pointer):Ptruint; procedure SendAsyn(mtype:t_mtype;mlen:DWORD;buf:Pointer); @@ -296,6 +298,11 @@ begin Result:=THandle(SendSync(iMAIN_WINDOWS,0,nil)); end; +procedure THostIpcConnect.SetCaptionFps(Ffps:QWORD); +begin + SendAsyn(iCAPTION_FPS,SizeOf(Ffps),@Ffps); +end; + // function THostIpcConnect.NewNodeSync:PNodeIpcSync; diff --git a/sys/kern/kern_time.pas b/sys/kern/kern_time.pas index 9e517d9f..c3328764 100644 --- a/sys/kern/kern_time.pas +++ b/sys/kern/kern_time.pas @@ -39,7 +39,7 @@ Procedure timeinit; begin md_timeinit; getmicrouptime(@boottime); - tsc_freq:=tsc_calibrate; + tsc_freq:=get_rdtsc_freq; end; procedure getmicrouptime(tvp:p_timeval); diff --git a/sys/md/md_time.pas b/sys/md/md_time.pas index 864fb429..542d0595 100644 --- a/sys/md/md_time.pas +++ b/sys/md/md_time.pas @@ -13,7 +13,7 @@ uses Procedure md_timeinit; function rdtsc:QWORD; assembler; -function tsc_calibrate:QWORD; +function get_rdtsc_freq:QWORD; function get_proc_time:Int64; function get_proc_time_freq:Int64; @@ -46,15 +46,34 @@ end; function rdtsc:QWORD; assembler; nostackframe; asm + lfence rdtsc - shl $0x20,%rdx + lfence + shl $32,%rdx or %rdx,%rax end; +function _get_rdtsc_freq:QWORD; +var + shared_page:PQWORD; + size:DWORD; + R:DWORD; +begin + Result:=0; + shared_page:=nil; + size:=0; + + R:=NtQuerySystemInformation(SystemHypervisorSharedPageInformation, + @shared_page,SizeOf(Pointer),@size); + if (R<>0) then Exit; + if (size<>SizeOf(Pointer)) then Exit; + + Result:=(UNIT_PER_SEC shl 32) div (shared_page[1] shr 32); +end; function tsc_calibrate:QWORD; const - samples=40; + samples=80; var i:Integer; @@ -86,6 +105,16 @@ begin Result:=tsc_freq; end; +function get_rdtsc_freq:QWORD; +begin + Result:=_get_rdtsc_freq; + + if (Result=0) then + begin + Result:=tsc_calibrate; + end; +end; + function get_proc_time:Int64; var pc:QWORD;