Emulator-Archive/fpPS4
1
0
Fork 0
mirror of https://github.com/red-prig/fpPS4.git synced 2024-11-22 22:09:44 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
red-prig 2021-12-08 23:04:07 +03:00
commit 49e069874b
74 changed files with 155915 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored Normal file
View File

@ -0,0 +1,2 @@
# Auto detect text files and perform LF normalization
* text=auto

19
.gitignore vendored Normal file
View File

@ -0,0 +1,19 @@
*.exe
*.dll
*.lps
*.ppu
*.bak
*.o
*.ini
*.db
*.txt
*.rar
*.bat
*.prx
*.sprx
link.res
lib/
backup/
shader_dump/
spirv/
savedata/

461
LFQueue.pas Normal file
View File

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

504
LICENSE Normal file
View File

@ -0,0 +1,504 @@
GNU LESSER GENERAL PUBLIC LICENSE
Version 2.1, February 1999
Copyright (C) 1991, 1999 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
[This is the first released version of the Lesser GPL. It also counts
as the successor of the GNU Library Public License, version 2, hence
the version number 2.1.]
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
Licenses are intended to guarantee your freedom to share and change
free software--to make sure the software is free for all its users.
This license, the Lesser General Public License, applies to some
specially designated software packages--typically libraries--of the
Free Software Foundation and other authors who decide to use it. You
can use it too, but we suggest you first think carefully about whether
this license or the ordinary General Public License is the better
strategy to use in any particular case, based on the explanations below.
When we speak of free software, we are referring to freedom of use,
not price. Our General Public Licenses are designed to make sure that
you have the freedom to distribute copies of free software (and charge
for this service if you wish); that you receive source code or can get
it if you want it; that you can change the software and use pieces of
it in new free programs; and that you are informed that you can do
these things.
To protect your rights, we need to make restrictions that forbid
distributors to deny you these rights or to ask you to surrender these
rights. These restrictions translate to certain responsibilities for
you if you distribute copies of the library or if you modify it.
For example, if you distribute copies of the library, whether gratis
or for a fee, you must give the recipients all the rights that we gave
you. You must make sure that they, too, receive or can get the source
code. If you link other code with the library, you must provide
complete object files to the recipients, so that they can relink them
with the library after making changes to the library and recompiling
it. And you must show them these terms so they know their rights.
We protect your rights with a two-step method: (1) we copyright the
library, and (2) we offer you this license, which gives you legal
permission to copy, distribute and/or modify the library.
To protect each distributor, we want to make it very clear that
there is no warranty for the free library. Also, if the library is
modified by someone else and passed on, the recipients should know
that what they have is not the original version, so that the original
author's reputation will not be affected by problems that might be
introduced by others.
Finally, software patents pose a constant threat to the existence of
any free program. We wish to make sure that a company cannot
effectively restrict the users of a free program by obtaining a
restrictive license from a patent holder. Therefore, we insist that
any patent license obtained for a version of the library must be
consistent with the full freedom of use specified in this license.
Most GNU software, including some libraries, is covered by the
ordinary GNU General Public License. This license, the GNU Lesser
General Public License, applies to certain designated libraries, and
is quite different from the ordinary General Public License. We use
this license for certain libraries in order to permit linking those
libraries into non-free programs.
When a program is linked with a library, whether statically or using
a shared library, the combination of the two is legally speaking a
combined work, a derivative of the original library. The ordinary
General Public License therefore permits such linking only if the
entire combination fits its criteria of freedom. The Lesser General
Public License permits more lax criteria for linking other code with
the library.
We call this license the "Lesser" General Public License because it
does Less to protect the user's freedom than the ordinary General
Public License. It also provides other free software developers Less
of an advantage over competing non-free programs. These disadvantages
are the reason we use the ordinary General Public License for many
libraries. However, the Lesser license provides advantages in certain
special circumstances.
For example, on rare occasions, there may be a special need to
encourage the widest possible use of a certain library, so that it becomes
a de-facto standard. To achieve this, non-free programs must be
allowed to use the library. A more frequent case is that a free
library does the same job as widely used non-free libraries. In this
case, there is little to gain by limiting the free library to free
software only, so we use the Lesser General Public License.
In other cases, permission to use a particular library in non-free
programs enables a greater number of people to use a large body of
free software. For example, permission to use the GNU C Library in
non-free programs enables many more people to use the whole GNU
operating system, as well as its variant, the GNU/Linux operating
system.
Although the Lesser General Public License is Less protective of the
users' freedom, it does ensure that the user of a program that is
linked with the Library has the freedom and the wherewithal to run
that program using a modified version of the Library.
The precise terms and conditions for copying, distribution and
modification follow. Pay close attention to the difference between a
"work based on the library" and a "work that uses the library". The
former contains code derived from the library, whereas the latter must
be combined with the library in order to run.
GNU LESSER GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any software library or other
program which contains a notice placed by the copyright holder or
other authorized party saying it may be distributed under the terms of
this Lesser General Public License (also called "this License").
Each licensee is addressed as "you".
A "library" means a collection of software functions and/or data
prepared so as to be conveniently linked with application programs
(which use some of those functions and data) to form executables.
The "Library", below, refers to any such software library or work
which has been distributed under these terms. A "work based on the
Library" means either the Library or any derivative work under
copyright law: that is to say, a work containing the Library or a
portion of it, either verbatim or with modifications and/or translated
straightforwardly into another language. (Hereinafter, translation is
included without limitation in the term "modification".)
"Source code" for a work means the preferred form of the work for
making modifications to it. For a library, complete source code means
all the source code for all modules it contains, plus any associated
interface definition files, plus the scripts used to control compilation
and installation of the library.
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running a program using the Library is not restricted, and output from
such a program is covered only if its contents constitute a work based
on the Library (independent of the use of the Library in a tool for
writing it). Whether that is true depends on what the Library does
and what the program that uses the Library does.
1. You may copy and distribute verbatim copies of the Library's
complete source code as you receive it, in any medium, provided that
you conspicuously and appropriately publish on each copy an
appropriate copyright notice and disclaimer of warranty; keep intact
all the notices that refer to this License and to the absence of any
warranty; and distribute a copy of this License along with the
Library.
You may charge a fee for the physical act of transferring a copy,
and you may at your option offer warranty protection in exchange for a
fee.
2. You may modify your copy or copies of the Library or any portion
of it, thus forming a work based on the Library, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) The modified work must itself be a software library.
b) You must cause the files modified to carry prominent notices
stating that you changed the files and the date of any change.
c) You must cause the whole of the work to be licensed at no
charge to all third parties under the terms of this License.
d) If a facility in the modified Library refers to a function or a
table of data to be supplied by an application program that uses
the facility, other than as an argument passed when the facility
is invoked, then you must make a good faith effort to ensure that,
in the event an application does not supply such function or
table, the facility still operates, and performs whatever part of
its purpose remains meaningful.
(For example, a function in a library to compute square roots has
a purpose that is entirely well-defined independent of the
application. Therefore, Subsection 2d requires that any
application-supplied function or table used by this function must
be optional: if the application does not supply it, the square
root function must still compute square roots.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Library,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Library, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Library.
In addition, mere aggregation of another work not based on the Library
with the Library (or with a work based on the Library) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may opt to apply the terms of the ordinary GNU General Public
License instead of this License to a given copy of the Library. To do
this, you must alter all the notices that refer to this License, so
that they refer to the ordinary GNU General Public License, version 2,
instead of to this License. (If a newer version than version 2 of the
ordinary GNU General Public License has appeared, then you can specify
that version instead if you wish.) Do not make any other change in
these notices.
Once this change is made in a given copy, it is irreversible for
that copy, so the ordinary GNU General Public License applies to all
subsequent copies and derivative works made from that copy.
This option is useful when you wish to copy part of the code of
the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable form
under the terms of Sections 1 and 2 above provided that you accompany
it with the complete corresponding machine-readable source code, which
must be distributed under the terms of Sections 1 and 2 above on a
medium customarily used for software interchange.
If distribution of object code is made by offering access to copy
from a designated place, then offering equivalent access to copy the
source code from the same place satisfies the requirement to
distribute the source code, even though third parties are not
compelled to copy the source along with the object code.
5. A program that contains no derivative of any portion of the
Library, but is designed to work with the Library by being compiled or
linked with it, is called a "work that uses the Library". Such a
work, in isolation, is not a derivative work of the Library, and
therefore falls outside the scope of this License.
However, linking a "work that uses the Library" with the Library
creates an executable that is a derivative of the Library (because it
contains portions of the Library), rather than a "work that uses the
library". The executable is therefore covered by this License.
Section 6 states terms for distribution of such executables.
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
copyright notice for the Library among them, as well as a reference
directing the user to the copy of this License. Also, you must do one
of these things:
a) Accompany the work with the complete corresponding
machine-readable source code for the Library including whatever
changes were used in the work (which must be distributed under
Sections 1 and 2 above); and, if the work is an executable linked
with the Library, with the complete machine-readable "work that
uses the Library", as object code and/or source code, so that the
user can modify the Library and then relink to produce a modified
executable containing the modified Library. (It is understood
that the user who changes the contents of definitions files in the
Library will not necessarily be able to recompile the application
to use the modified definitions.)
b) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (1) uses at run time a
copy of the library already present on the user's computer system,
rather than copying library functions into the executable, and (2)
will operate properly with a modified version of the library, if
the user installs one, as long as the modified version is
interface-compatible with the version that the work was made with.
c) Accompany the work with a written offer, valid for at
least three years, to give the same user the materials
specified in Subsection 6a, above, for a charge no more
than the cost of performing this distribution.
d) If distribution of the work is made by offering access to copy
from a designated place, offer equivalent access to copy the above
specified materials from the same place.
e) Verify that the user has already received a copy of these
materials or that you have already sent this user a copy.
For an executable, the required form of the "work that uses the
Library" must include any data and utility programs needed for
reproducing the executable from it. However, as a special exception,
the materials to be distributed need not include anything that is
normally distributed (in either source or binary form) with the major
components (compiler, kernel, and so on) of the operating system on
which the executable runs, unless that component itself accompanies
the executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
accompany the operating system. Such a contradiction means you cannot
use both them and the Library together in an executable that you
distribute.
7. You may place library facilities that are a work based on the
Library side-by-side in a single library together with other library
facilities not covered by this License, and distribute such a combined
library, provided that the separate distribution of the work based on
the Library and of the other library facilities is otherwise
permitted, and provided that you do these two things:
a) Accompany the combined library with a copy of the same work
based on the Library, uncombined with any other library
facilities. This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined library of the fact
that part of it is a work based on the Library, and explaining
where to find the accompanying uncombined form of the same work.
8. You may not copy, modify, sublicense, link with, or distribute
the Library except as expressly provided under this License. Any
attempt otherwise to copy, modify, sublicense, link with, or
distribute the Library is void, and will automatically terminate your
rights under this License. However, parties who have received copies,
or rights, from you under this License will not have their licenses
terminated so long as such parties remain in full compliance.
9. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Library or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.
10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties with
this License.
11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Library at all. For example, if a patent
license would not permit royalty-free redistribution of the Library by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Library.
If any portion of this section is held invalid or unenforceable under any
particular circumstance, the balance of the section is intended to apply,
and the section as a whole is intended to apply in other circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded. In such case, this License incorporates the limitation as if
written in the body of this License.
13. The Free Software Foundation may publish revised and/or new
versions of the Lesser General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Library
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Library does not specify a
license version number, you may choose any version ever published by
the Free Software Foundation.
14. If you wish to incorporate parts of the Library into other free
programs whose distribution conditions are incompatible with these,
write to the author to ask for permission. For software which is
copyrighted by the Free Software Foundation, write to the Free
Software Foundation; we sometimes make exceptions for this. Our
decision will be guided by the two goals of preserving the free status
of all derivatives of our free software and of promoting the sharing
and reuse of software generally.
NO WARRANTY
15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Libraries
If you develop a new library, and you want it to be of the greatest
possible use to the public, we recommend making it free software that
everyone can redistribute and change. You can do so by permitting
redistribution under these terms (or, alternatively, under the terms of the
ordinary General Public License).
To apply these terms, attach the following notices to the library. It is
safest to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the library's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
Also add information on how to contact you by electronic and paper mail.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the library, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
library `Frob' (a library for tweaking knobs) written by James Random
Hacker.
<signature of Ty Coon>, 1 April 1990
Ty Coon, President of Vice
That's all there is to it!

14
README.md Normal file
View File

@ -0,0 +1,14 @@
# fpPS4
** PS4 compatibility layer (emulator) on Free Pascal**
This project is at the beginning and started for fun.
### Building
- Free pascal compiler: 3.0.0 and higher
- Lazarus: 2.0.0 and higher
### Minimum system requirements
- OS: Windows 7 x64 and higher
- CPU: x64, AVX1 support
- GPU: Vulkan API support

420
RWLock.pas Normal file
View File

@ -0,0 +1,420 @@
{ Implementation of Slim read-write lock based on https://github.com/neosmart/RWLock
Copyright (C) 2018-2020 Red_prig
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
}
unit RWLock;
{$mode objfpc}{$H+}
interface
{$IFDEF UNIX}
{$DEFINE SMART} //Force NeoSmart algoritm
{$ENDIF}
{/$DEFINE SMART}
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
uses
UnixType,pthreads;
type
TRWLock=pthread_rwlock_t;
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
uses
Windows;
{$ENDIF}
type
TRWLock=packed record
Case Byte of
0:(SRWLock:Pointer;Mode:SizeInt);
1:(Event:PRTLEvent;vLock:DWORD);
end;
{$ENDIF}
Procedure rwlock_init(Var L:TRWLock);
Procedure rwlock_destroy(Var L:TRWLock);
Procedure rwlock_rdlock(Var L:TRWLock);
Procedure rwlock_wrlock(Var L:TRWLock);
function rwlock_tryrdlock(Var L:TRWLock):Boolean;
function rwlock_trywrlock(Var L:TRWLock):Boolean;
Procedure rwlock_unlock(Var L:TRWLock);
implementation
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
type
TSRWLockProc=procedure(Var SRWLock:Pointer); stdcall;
TSRWLockTryFunc=Function(Var SRWLock:Pointer):Boolean; stdcall;
Var
InitializeSRWLock,
AcquireSRWLockShared,
ReleaseSRWLockShared,
AcquireSRWLockExclusive,
ReleaseSRWLockExclusive:TSRWLockProc;
TryAcquireSRWLockShared,
TryAcquireSRWLockExclusive:TSRWLockTryFunc;
Procedure LoadSRW;
Var
Handle:THandle;
begin
InitializeSRWLock :=nil;
AcquireSRWLockShared :=nil;
ReleaseSRWLockShared :=nil;
AcquireSRWLockExclusive :=nil;
ReleaseSRWLockExclusive :=nil;
TryAcquireSRWLockShared :=nil;
TryAcquireSRWLockExclusive:=nil;
Handle:=GetModuleHandle('kernel32.dll');
if Handle<>INVALID_HANDLE_VALUE then
begin
Pointer(InitializeSRWLock ):=GetProcAddress(Handle,'InitializeSRWLock');
if InitializeSRWLock<>nil then
begin
Pointer(AcquireSRWLockShared ):=GetProcAddress(Handle,'AcquireSRWLockShared');
Pointer(ReleaseSRWLockShared ):=GetProcAddress(Handle,'ReleaseSRWLockShared');
Pointer(AcquireSRWLockExclusive ):=GetProcAddress(Handle,'AcquireSRWLockExclusive');
Pointer(ReleaseSRWLockExclusive ):=GetProcAddress(Handle,'ReleaseSRWLockExclusive');
Pointer(TryAcquireSRWLockShared ):=GetProcAddress(Handle,'TryAcquireSRWLockShared');
Pointer(TryAcquireSRWLockExclusive):=GetProcAddress(Handle,'TryAcquireSRWLockExclusive');
end;
end;
end;
{$ENDIF}
{$IF (not DEFINED(UNIX)) or DEFINED(SMART)}
Const
MAX_SPIN=50000;
function ReaderCount(lock:DWORD):WORD; inline;
begin
Result:=WORD(lock and $00007FFF);
end;
function SetReaders(lock:DWORD;readers:WORD):DWORD; inline;
begin
Result:=(lock and (not $00007FFF)) or readers;
end;
function WaitingCount(lock:DWORD):WORD; inline;
begin
Result:=WORD((lock and $3FFF8000) shr 15);
end;
function SetWaiting(lock:DWORD;waiting:WORD):DWORD; inline;
begin
Result:=(lock and (not $3FFF8000)) or (waiting shl 15);
end;
function Writer(lock:DWORD):Boolean; inline;
begin
Result:=(lock and $40000000)<>0;
end;
function SetWriter(lock:DWORD;writer:Boolean):DWORD; inline;
begin
if writer then
Result:=lock or $40000000
else
Result:=lock and (not $40000000);
end;
function AllClear(lock:DWORD):Boolean; inline;
begin
Result:=(lock and $40007FFF)=0;
end;
function Initialized(lock:DWORD):Boolean; inline;
begin
Result:=(lock and $80000000)<>0;
end;
function SetInitialized(lock:DWORD;init:Boolean):DWORD; inline;
begin
if init then
Result:=lock or $80000000
else
Result:=lock and (not $80000000);
end;
Procedure _rdlock(Var vLock:DWORD;Event:PRTLEvent); inline;
Var
i:SizeUInt;
temp:DWORD;
begin
i:=0;
repeat
temp:=vLock;
if not Writer(temp) then
begin
if System.InterlockedCompareExchange(vLock,SetReaders(temp,ReaderCount(temp)+1),temp)=temp then
Break
else
Continue;
end else
begin
if (i<MAX_SPIN) then
begin
ThreadSwitch;
Continue;
end;
if System.InterlockedCompareExchange(vLock,SetWaiting(temp,WaitingCount(temp)+1),temp)<>temp then
Continue;
RTLeventWaitFor(Event);
i:=0;
repeat
temp:=vLock;
if (i>MAX_SPIN) then
begin
ThreadSwitch;
Continue;
end;
Inc(i);
until System.InterlockedCompareExchange(vLock,SetWaiting(temp,WaitingCount(temp)-1),temp)=temp;
i:=0;
end;
Inc(i);
until False;
end;
Procedure _wrlock(Var vLock:DWORD;Event:PRTLEvent); inline;
Var
i:SizeUInt;
temp:DWORD;
begin
i:=0;
repeat
temp:=vLock;
if AllClear(temp) then
begin
if System.InterlockedCompareExchange(vLock,SetWriter(temp,true),temp)=temp then
Break
else
Continue;
end else
begin
if (i<MAX_SPIN) then
begin
ThreadSwitch;
Continue;
end;
if System.InterlockedCompareExchange(vLock,SetWaiting(temp,WaitingCount(temp)+1),temp)<>temp then
Continue;
RTLeventWaitFor(Event);
i:=0;
repeat
temp:=vLock;
if (i>MAX_SPIN) then
begin
ThreadSwitch;
Continue;
end;
Inc(i);
until System.InterlockedCompareExchange(vLock,SetWaiting(temp,WaitingCount(temp)-1),temp)=temp;
i:=0;
end;
Inc(i);
until False;
end;
Procedure _unlock(Var vLock:DWORD;Event:PRTLEvent); inline;
Var
temp:DWORD;
begin
if ReaderCount(vLock)=0 then
begin
repeat
repeat
temp:=vLock;
if (WaitingCount(temp)=0) then break;
RTLeventSetEvent(Event);
until False;
until System.InterlockedCompareExchange(vLock,SetWriter(temp,false),temp)=temp;
end else
begin
repeat
temp:=vLock;
if (ReaderCount(temp)=1) and (WaitingCount(temp)<>0) then
RTLeventSetEvent(Event);
until System.InterlockedCompareExchange(vLock,SetReaders(temp,ReaderCount(temp)-1),temp)=temp;
end;
end;
function _tryrdlock(Var vLock:DWORD):Boolean; inline;
Var
temp:DWORD;
begin
Result:=False;
temp:=vLock;
if not Writer(temp) then
begin
if System.InterlockedCompareExchange(vLock,SetReaders(temp,ReaderCount(temp)+1),temp)=temp then
Result:=True;
end;
end;
function _trywrlock(Var vLock:DWORD):Boolean; inline;
Var
temp:DWORD;
begin
Result:=False;
temp:=vLock;
if AllClear(temp) then
begin
if System.InterlockedCompareExchange(vLock,SetWriter(temp,true),temp)=temp then
Result:=True;
end;
end;
{$ENDIF}
Procedure rwlock_init(Var L:TRWLock);
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
pthread_rwlock_init(@L,nil);
{$ELSE}
L:=Default(TRWLock);
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
InitializeSRWLock(L.SRWLock);
L.Mode:=0;
end else
{$ENDIF}
begin
L.vLock:=SetInitialized(0,true);
L.Event:=RTLEventCreate;
end;
{$ENDIF}
end;
Procedure rwlock_destroy(Var L:TRWLock);
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
pthread_rwlock_destroy(@L);
{$ELSE}
{$IF DEFINED(WINDOWS) and (not defined(SMART))}
if InitializeSRWLock=nil then
{$ENDIF}
RTLEventDestroy(L.Event);
{$ENDIF}
end;
Procedure rwlock_rdlock(Var L:TRWLock);
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
pthread_rwlock_rdlock(@L);
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
AcquireSRWLockShared(L.SRWLock);
L.Mode:=1;
end else
{$ENDIF}
_rdlock(L.vLock,L.Event);
{$ENDIF}
end;
Procedure rwlock_wrlock(Var L:TRWLock);
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
pthread_rwlock_wrlock(@L);
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
AcquireSRWLockExclusive(L.SRWLock);
L.Mode:=2;
end else
{$ENDIF}
_wrlock(L.vLock,L.Event);
{$ENDIF}
end;
function rwlock_tryrdlock(Var L:TRWLock):Boolean;
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
Result:=pthread_rwlock_tryrdlock(@L)=0;
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
Result:=TryAcquireSRWLockShared(L.SRWLock);
if Result then
L.Mode:=1;
end else
{$ENDIF}
Result:=_tryrdlock(L.vLock);
{$ENDIF}
end;
function rwlock_trywrlock(Var L:TRWLock):Boolean;
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
Result:=pthread_rwlock_trywrlock(@L)=0;
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
Result:=TryAcquireSRWLockExclusive(L.SRWLock);
if Result then
L.Mode:=2;
end else
{$ENDIF}
Result:=_trywrlock(L.vLock);
{$ENDIF}
end;
Procedure rwlock_unlock(Var L:TRWLock);
begin
{$IF DEFINED(UNIX)) and (not DEFINED(SMART))}
pthread_rwlock_unlock(@L);
{$ELSE}
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
if InitializeSRWLock<>nil then
begin
if L.SRWLock<>nil then
Case L.Mode of
1:ReleaseSRWLockShared(L.SRWLock);
2:ReleaseSRWLockExclusive(L.SRWLock);
end;
end else
{$ENDIF}
_unlock(L.vLock,L.Event);
{$ENDIF}
end;
{$IF DEFINED(WINDOWS) and (not DEFINED(SMART))}
initialization
begin
LoadSRW;
end;
{$ENDIF}
end.

48
bittype.pas Normal file
View File

@ -0,0 +1,48 @@
unit bittype;
{$mode objfpc}{$H+}
interface
type
bit1=0..1;
bit2=0..3;
bit3=0..7;
bit4=0..15;
bit5=0..31;
bit6=0..63;
bit7=0..127;
bit8=Byte;
bit9=0..511;
bit10=0..1023;
bit11=0..2047;
bit12=0..4095;
bit13=0..8191;
bit14=0..16383;
bit15=0..32767;
bit16=Word;
bit17=0..131071;
bit18=0..262143;
bit19=0..524287;
bit20=0..1048575;
bit21=0..2097151;
bit22=0..4194303;
bit23=0..8388607;
bit24=0..16777215;
bit25=0..33554431;
bit26=0..67108863;
bit27=0..134217727;
bit28=0..268435455;
bit29=0..536870911;
bit30=0..1073741823;
bit31=0..2147483647;
bit32=DWORD;
bit38=0..274877906943;
bit44=0..17592186044415;
bit48=0..281474976710655;
bit64=QWORD;
implementation
end.

501
chip/pm4defs.pas Normal file
View File

@ -0,0 +1,501 @@
unit pm4defs;
{$mode objfpc}{$H+}
interface
uses
bittype,
si_ci_vi_merged_registers;
const
IT_NOP = $00000010;
IT_SET_BASE = $00000011;
IT_CLEAR_STATE = $00000012;
IT_INDEX_BUFFER_SIZE = $00000013;
IT_DISPATCH_DIRECT = $00000015;
IT_DISPATCH_INDIRECT = $00000016;
IT_INDIRECT_BUFFER_END = $00000017;
IT_INDIRECT_BUFFER_CNST_END = $00000019;
IT_ATOMIC_GDS = $0000001d;
IT_ATOMIC_MEM = $0000001e;
IT_OCCLUSION_QUERY = $0000001f;
IT_SET_PREDICATION = $00000020;
IT_REG_RMW = $00000021;
IT_COND_EXEC = $00000022;
IT_PRED_EXEC = $00000023;
IT_DRAW_INDIRECT = $00000024;
IT_DRAW_INDEX_INDIRECT = $00000025;
IT_INDEX_BASE = $00000026;
IT_DRAW_INDEX_2 = $00000027;
IT_CONTEXT_CONTROL = $00000028;
IT_INDEX_TYPE = $0000002a;
IT_DRAW_INDIRECT_MULTI = $0000002c;
IT_DRAW_INDEX_AUTO = $0000002d;
IT_NUM_INSTANCES = $0000002f;
IT_DRAW_INDEX_MULTI_AUTO = $00000030;
IT_INDIRECT_BUFFER_PRIV = $00000032;
IT_INDIRECT_BUFFER_CNST = $00000033;
IT_COND_INDIRECT_BUFFER_CNST = $00000033;
IT_STRMOUT_BUFFER_UPDATE = $00000034;
IT_DRAW_INDEX_OFFSET_2 = $00000035;
IT_DRAW_PREAMBLE = $00000036;
IT_WRITE_DATA = $00000037;
IT_DRAW_INDEX_INDIRECT_MULTI = $00000038;
IT_MEM_SEMAPHORE = $00000039;
IT_DRAW_INDEX_MULTI_INST = $0000003a;
IT_COPY_DW = $0000003b;
IT_WAIT_REG_MEM = $0000003c;
IT_INDIRECT_BUFFER = $0000003f;
IT_COND_INDIRECT_BUFFER = $0000003f;
IT_COPY_DATA = $00000040;
IT_CP_DMA = $00000041;
IT_PFP_SYNC_ME = $00000042;
IT_SURFACE_SYNC = $00000043;
IT_ME_INITIALIZE = $00000044;
IT_COND_WRITE = $00000045;
IT_EVENT_WRITE = $00000046;
IT_EVENT_WRITE_EOP = $00000047;
IT_EVENT_WRITE_EOS = $00000048;
IT_RELEASE_MEM = $00000049;
IT_PREAMBLE_CNTL = $0000004a;
IT_DRAW_RESERVED0 = $0000004c;
IT_DRAW_RESERVED1 = $0000004d;
IT_DRAW_RESERVED2 = $0000004e;
IT_DRAW_RESERVED3 = $0000004f;
IT_DMA_DATA = $00000050;
IT_CONTEXT_REG_RMW = $00000051;
IT_GFX_CNTX_UPDATE = $00000052;
IT_BLK_CNTX_UPDATE = $00000053;
IT_INCR_UPDT_STATE = $00000055;
IT_ACQUIRE_MEM = $00000058;
IT_REWIND = $00000059;
IT_INTERRUPT = $0000005a;
IT_GEN_PDEPTE = $0000005b;
IT_INDIRECT_BUFFER_PASID = $0000005c;
IT_PRIME_UTCL2 = $0000005d;
IT_LOAD_UCONFIG_REG = $0000005e;
IT_LOAD_SH_REG = $0000005f;
IT_LOAD_CONFIG_REG = $00000060;
IT_LOAD_CONTEXT_REG = $00000061;
IT_LOAD_COMPUTE_STATE = $00000062;
IT_LOAD_SH_REG_INDEX = $00000063;
IT_SET_CONFIG_REG = $00000068;
IT_SET_CONTEXT_REG = $00000069;
IT_SET_CONTEXT_REG_INDEX = $0000006a;
IT_SET_VGPR_REG_DI_MULTI = $00000071;
IT_SET_SH_REG_DI = $00000072;
IT_SET_CONTEXT_REG_INDIRECT = $00000073;
IT_SET_SH_REG_DI_MULTI = $00000074;
IT_GFX_PIPE_LOCK = $00000075;
IT_SET_SH_REG = $00000076;
IT_SET_SH_REG_OFFSET = $00000077;
IT_SET_QUEUE_REG = $00000078;
IT_SET_UCONFIG_REG = $00000079;
IT_SET_UCONFIG_REG_INDEX = $0000007a;
IT_FORWARD_HEADER = $0000007c;
IT_SCRATCH_RAM_WRITE = $0000007d;
IT_SCRATCH_RAM_READ = $0000007e;
IT_LOAD_CONST_RAM = $00000080;
IT_WRITE_CONST_RAM = $00000081;
IT_DUMP_CONST_RAM = $00000083;
IT_INCREMENT_CE_COUNTER = $00000084;
IT_INCREMENT_DE_COUNTER = $00000085;
IT_WAIT_ON_CE_COUNTER = $00000086;
IT_WAIT_ON_DE_COUNTER_DIFF = $00000088;
IT_SWITCH_BUFFER = $0000008b;
IT_FRAME_CONTROL = $00000090;
IT_INDEX_ATTRIBUTES_INDIRECT = $00000091;
IT_WAIT_REG_MEM64 = $00000093;
IT_COND_PREEMPT = $00000094;
IT_HDP_FLUSH = $00000095;
IT_INVALIDATE_TLBS = $00000098;
IT_DMA_DATA_FILL_MULTI = $0000009a;
IT_SET_SH_REG_INDEX = $0000009b;
IT_DRAW_INDIRECT_COUNT_MULTI = $0000009c;
IT_DRAW_INDEX_INDIRECT_COUNT_MULTI = $0000009d;
IT_DUMP_CONST_RAM_OFFSET = $0000009e;
IT_LOAD_CONTEXT_REG_INDEX = $0000009f;
IT_SET_RESOURCES = $000000a0;
IT_MAP_PROCESS = $000000a1;
IT_MAP_QUEUES = $000000a2;
IT_UNMAP_QUEUES = $000000a3;
IT_QUERY_STATUS = $000000a4;
IT_RUN_LIST = $000000a5;
IT_MAP_PROCESS_VM = $000000a6;
//OP_HINT_NOP=0;
OP_HINT_1920_1080=$04380780;
OP_HINT_1860_1080=$04380744;
OP_HINT_320_240 =$00F00140;
OP_HINT_WRITE_GPU_PREFETCH_INTO_L2 =$60000000;
OP_HINT_BASE_ALLOCATE_FROM_COMMAND_BUFFER =$68750000;
OP_HINT_PUSH_MARKER =$68750001;
OP_HINT_POP_MARKER =$68750002;
OP_HINT_SET_VSHARP_IN_USER_DATA =$68750004;
OP_HINT_SET_TSHARP_IN_USER_DATA =$68750005;
OP_HINT_SET_SSHARP_IN_USER_DATA =$68750006;
OP_HINT_SET_USER_DATA_REGION =$6875000D;
OP_HINT_BASE_MARK_DISPATCH_DRAW_ACB_ADDRESS =$68750012;
OP_HINT_PREPARE_FLIP_VOID =$68750777;
OP_HINT_PREPARE_FLIP_LABEL =$68750778;
OP_HINT_PREPARE_FLIP_WITH_EOP_INTERRUPT_VOID =$68750780;
OP_HINT_PREPARE_FLIP_WITH_EOP_INTERRUPT_LABEL =$68750781;
OP_HINT_INLINE_DATA1 =$68752000;
OP_HINT_INLINE_DATA2 =$68753000;
OP_HINT_SET_DB_RENDER_CONTROL =$00000000;
OP_HINT_SET_DB_COUNT_CONTROL =$00000001;
OP_HINT_SET_RENDER_OVERRIDE_CONTROL =$00000003;
OP_HINT_SET_RENDER_OVERRIDE2CONTROL =$00000004;
OP_HINT_SET_PS_SHADER_SAMPLE_EXCLUSION_MASK =$00000006;
OP_HINT_SET_DEPTH_BOUNDS_RANGE =$00000008;
OP_HINT_SET_STENCIL_CLEAR_VALUE =$0000000A;
OP_HINT_SET_DEPTH_CLEAR_VALUE =$0000000B;
OP_HINT_SET_SCREEN_SCISSOR =$0000000C;
OP_HINT_SET_DEPTH_RENDER_TARGET =$00000010;
OP_HINT_SET_BORDER_COLOR_TABLE_ADDR =$00000020;
OP_HINT_SET_WINDOW_OFFSET =$00000080;
OP_HINT_SET_WINDOW_SCISSOR =$00000081;
OP_HINT_SET_CLIP_RECTANGLE_RULE =$00000083;
OP_HINT_SET_HARDWARE_SCREEN_OFFSET =$0000008D;
OP_HINT_SET_RENDER_TARGET_MASK =$0000008E;
OP_HINT_SET_GENERIC_SCISSOR =$00000090;
OP_HINT_SET_PERFMON_ENABLE =$000000D8;
OP_HINT_SET_SCALED_RESOLUTION_GRID =$000000E8;
OP_HINT_SET_FOVEATED_WINDOW =$000000EB;
OP_HINT_SET_RESET_FOVEATED_WINDOW =$000000EB;
OP_HINT_SET_INDEX_OFFSET =$00000102;
OP_HINT_SET_PRIMITIVE_RESET_INDEX =$00000103;
OP_HINT_SET_STENCIL_OP_CONTROL =$0000010B;
OP_HINT_SET_STENCIL =$0000010C;
OP_HINT_SET_STENCIL_SEPARATE =$0000010C;
OP_HINT_SET_PS_SHADER_USAGE =$00000191;
OP_HINT_SET_GRAPHICS_SCRATCH_SIZE =$000001BA;
OP_HINT_SET_DEPTH_STENCIL_CONTROL =$00000200;
OP_HINT_SET_DEPTH_STENCIL_DISABLE =$00000200;
OP_HINT_SET_DEPTH_EQAA_CONTROL =$00000201;
OP_HINT_SET_CB_CONTROL =$00000202;
OP_HINT_SET_CLIP_CONTROL =$00000204;
OP_HINT_SET_PRIMITIVE_SETUP =$00000205;
OP_HINT_SET_VIEWPORT_TRANSFORM_CONTROL =$00000206;
OP_HINT_SET_OBJECT_ID_MODE =$0000020D;
OP_HINT_SET_COMPUTE_SHADER_CONTROL =$00000215;
OP_HINT_SET_COMPUTE_SCRATCH_SIZE =$00000218;
OP_HINT_SET_PRIMITIVE_TYPE_BASE =$00000242;
OP_HINT_SET_POINT_SIZE =$00000280;
OP_HINT_SET_POINT_MIN_MAX =$00000281;
OP_HINT_SET_LINE_WIDTH =$00000282;
OP_HINT_GS_MODE_ENABLE =$00000290;
OP_HINT_SET_GS_MODE =$00000290;
OP_HINT_GS_MODE_ENABLE_ON_CHIP =$00000291;
OP_HINT_SET_GS_ON_CHIP_CONTROL =$00000291;
OP_HINT_SET_SCAN_MODE_CONTROL =$00000292;
OP_HINT_SET_PS_SHADER_RATE =$00000293;
OP_HINT_SET_PRIMITIVE_ID_ENABLE =$000002A1;
OP_HINT_SET_PRIMITIVE_RESET_INDEX_ENABLE =$000002A5;
OP_HINT_SET_DRAW_PAYLOAD_CONTROL =$000002A6;
OP_HINT_SET_INSTANCE_STEP_RATE =$000002A8;
OP_HINT_SETUP_ES_GS_RING_REGISTERS =$000002AB;
OP_HINT_SET_VERTEX_REUSE_ENABLE =$000002AD;
OP_HINT_SET_HTILE_STENCIL0 =$000002B0;
OP_HINT_SET_HTILE_STENCIL1 =$000002B1;
OP_HINT_SETUP_DRAW_OPAQUE_PARAMETERS_1 =$000002CA;
OP_HINT_SETUP_DRAW_OPAQUE_PARAMETERS_0 =$000002CC;
OP_HINT_SET_TESSELLATION_DISTRIBUTION_THRESHOLDS =$000002D4;
OP_HINT_SET_ACTIVE_SHADER_STAGES =$000002D5;
OP_HINT_SETUP_GS_VS_RING_REGISTERS =$000002D7;
OP_HINT_SET_ALPHA_TO_MASK_CONTROL =$000002DC;
OP_HINT_SET_DISPATCH_DRAW_INDEX_DEALLOCATION_MASK=$000002DD;
OP_HINT_SET_POLYGON_OFFSET_Z_FORMAT =$000002DE;
OP_HINT_SET_POLYGON_OFFSET_CLAMP =$000002DF;
OP_HINT_SET_POLYGON_OFFSET_FRONT =$000002E0;
OP_HINT_SET_POLYGON_OFFSET_BACK =$000002E2;
OP_HINT_GS_MODE_DISABLE =$000002E5;
OP_HINT_SET_GS_MODE_DISABLE =$000002E5;
OP_HINT_SET_VS_SHADER_STREAMOUT_ENABLE =$000002E5;
OP_HINT_SET_STREAMOUT_MAPPING =$000002E6;
OP_HINT_SET_AA_SAMPLE_COUNT =$000002F8;
OP_HINT_SET_VERTEX_QUANTIZATION =$000002F9;
OP_HINT_SET_GUARD_BANDS =$000002FA;
OP_HINT_SET_AA_SAMPLE_MASK1 =$0000030E;
OP_HINT_SET_AA_SAMPLE_MASK2 =$0000030F;
OP_HINT_SET_TEXTURE_GRADIENT_FACTORS =$00000382;
OP_HINT_SET_PERF_COUNTER_CONTROL_PA =$00001808;
OP_HINT_SET_PRIMITIVE_TYPE_NEO =$10000242;
type
PPM4_HEADER=^PM4_HEADER;
PM4_HEADER=bitpacked record
reserved:Word; //16
count:bit14; //14
_type:bit2; //2
end;
PPM4_TYPE_0_HEADER=^PM4_TYPE_0_HEADER;
PM4_TYPE_0_HEADER=bitpacked record
baseIndex:Word; //16
count:bit14; //14
_type:bit2; //2
end;
PPM4_TYPE_3_HEADER=^PM4_TYPE_3_HEADER;
PM4_TYPE_3_HEADER=bitpacked record
predicate:bit1; //1
shaderType:bit1; //1
reserved:bit6; //6
opcode:Byte; //8
count:bit14; //14
_type:bit2; //2
end;
PPM4PrepareFlip=^TPM4PrepareFlip;
TPM4PrepareFlip=packed record
ADDRES_LO:DWORD;
ADDRES_HI:DWORD;
DATA:DWORD;
end;
PPM4PrepareFlipWithEopInterrupt=^TPM4PrepareFlipWithEopInterrupt;
TPM4PrepareFlipWithEopInterrupt=packed record
ADDRES_LO:DWORD;
ADDRES_HI:DWORD;
DATA:DWORD;
eventType:DWORD;
cacheAction:DWORD;
end;
PTPM4CMDWRITEDATA=^TPM4CMDWRITEDATA;
TPM4CMDWRITEDATA=packed record
CONTROL:bitpacked record
reserved1 :bit8;
dstSel :bit4; ///< destination select
reserved2 :bit4;
wrOneAddr :bit1; ///< Increment or not increment address
reserved3 :bit3;
wrConfirm :bit1; ///< Wait or not wait for confirmation
reserved4 :bit3;
atc :bit1;
cachePolicy:bit2; ///< Cache olicy settings for write requests to the TCL2
volatile :bit1; ///< Volatile setting for write requests to the TCL2
reserved5 :bit2;
engineSel :bit2; ///< engine select
end;
dstAddrLo:DWORD;
dstAddrHi:DWORD;
data:packed record end;
end;
PEVENTWRITEEOP=^TEVENTWRITEEOP;
TEVENTWRITEEOP=packed record
EVENT_CNTL:bitpacked record
EVENT_TYPE:bit6; //6 ///< event type written to VGT_EVENT_INITIATOR
Reserved1:bit2; //2
EVENT_INDEX:bit4; //4 ///< event index
tcl1VolActionEna__CI:bit1; //1
tcVolActionEna__CI :bit1; //1
reserved2:bit1; //1
tcWbActionEna__CI:bit1; //1
tcl1ActionEna__CI:bit1; //1
tcActionEna__CI:bit1; //1
reserved3:bit2; //2
invalidateL2__SI:bit1; //1
reserved4:bit3; //3
atc__CI:bit1; //1
cachePolicy__CI:bit2; //2 ///< Cache Policy setting used for writing fences and timestamps to the TCL2
volatile__CI:bit1; //1 ///< Volatile setting used for writing fences and timestamps to the TCL2.
reserved5:bit4; //4
end;
ADDRESS_LO:DWORD; ///< low bits of address
DATA_CNTL:bitpacked record
ADDRESS_HI:bit24;//24 ///< high bits of address
INT_SEL:bit2; //2 ///< selects interrupt action for end-of-pipe
Reserved:bit3; //3 ///< reserved
DATA_SEL:bit3; //3 ///< selects source of data
end;
DATA_LO:DWORD; ///< value that will be written to memory when event occurs
DATA_HI:DWORD; ///< value that will be written to memory when event occurs
end;
PTPM4CMDEVENTWRITEEOS=^TPM4CMDEVENTWRITEEOS;
TPM4CMDEVENTWRITEEOS=bitpacked record
eventType :bit6; ///< event type written to VGT_EVENT_INITIATOR
reserved1 :bit2; ///< reserved
eventIndex :bit4; ///< event index
reserved2 :bit20; ///< reserved
addressLo:DWORD; ///< low bits of address, must be 4 byte aligned
addressHi :bit29; ///< high bits of address
command :bit3; ///< command
Case byte of
0:(
gdsIndex:Word; ///< indexed offset into GDS partition
size :Word; ///< number of DWs to read from the GDS
);
1:(
data:DWORD; ///< fence value that will be written to memory when event occurs
);
end;
PTPM4CMDEVENTWRITE=^TPM4CMDEVENTWRITE;
TPM4CMDEVENTWRITE=bitpacked record
eventType :bit6; ///< event type written to VGT_EVENT_INITIATOR
reserved1 :bit2; ///< reserved
eventIndex :bit4; ///< event index
///< 0000: Any non-Time Stamp/non-Fence/non-Trap EVENT_TYPE not listed.
///< 0001: ZPASS_DONE
///< 0010: SAMPLE_PIPELINESTATS
///< 0011: SAMPLE_STREAMOUTSTAT[S|S1|S2|S3]
///< 0100: [CS|VS|PS]_PARTIAL_FLUSH
///< 0101: Reserved for EVENT_WRITE_EOP time stamp/fence event types
///< 0110: Reserved for EVENT_WRITE_EOS packet
///< 0111: CACHE_FLUSH, CACHE_FLUSH_AND_INV_EVENT
///< 1000 - 1111: Reserved for future use.
reserved2 :bit8; ///< reserved
invalidateL2 :bit1; ///< Send WBINVL2 op to the TC L2 cache when eventIndex = 0111.
reserved3 :bit3;
ATC :bit1; ///< needed by Sample_PipelineStats (compute engine)
reserved4 :bit6; ///< reserved
offload_enable :bit1; ///< Offload queue until EOP queue goes empty, only works for MEC. ///< Setting this bit on graphics/ME will do nothing/be masked out.
end;
PTPM4DMADATA=^TPM4DMADATA;
TPM4DMADATA=packed record
Flags1:bitpacked record
engine :bit1;
reserved1 :bit11;
srcATC :bit1;
srcCachePolicy :bit2;
srcVolatile :bit1;
reserved2 :bit4;
dstSel :bit2;
reserved3 :bit2;
dstATC :bit1;
dstCachePolicy :bit2;
dstVolatile :bit1;
reserved4 :bit1;
srcSel :bit2;
cpSync :bit1;
end;
srcAddrLo:DWORD;
srcAddrHi:DWORD;
dstAddrLo:DWORD;
dstAddrHi:DWORD;
Flags2:bitpacked record
byteCount :bit21;
disWC :bit1;
srcSwap :bit2;
dstSwap :bit2;
sas :bit1;
das :bit1;
saic :bit1;
daic :bit1;
rawWait :bit1;
reserved5 :bit1;
end;
end;
PPM4ACQUIREMEM=^TPM4ACQUIREMEM;
TPM4ACQUIREMEM=bitpacked record
coherCntl :bit31;
engine :bit1;
coherSize :DWORD;
coherSizeHi :bit8;
coherSizeHiRsvd:bit16;
reserved1 :bit8;
coherBaseLo :DWORD;
coherBaseHi :bit24;
reserved2 :bit8;
pollInterval :bit16;
reserved3 :bit16;
end;
TCONTEXTCONTROLENABLE=bitpacked record
enableSingleCntxConfigReg:bit1; ///< single context config reg
enableMultiCntxRenderReg :bit1; ///< multi context render state reg
reserved1 :bit13; ///< reserved
enableUserConfigReg :bit1; ///< User Config Reg on CI(reserved for SI)
enableGfxSHReg :bit1; ///< Gfx SH Registers
reserved2 :bit7; ///< reserved
enableCSSHReg :bit1; ///< CS SH Registers
reserved3 :bit6; ///< reserved
enableDw :bit1; ///< DW enable
end;
PPM4CMDCONTEXTCONTROL=^TPM4CMDCONTEXTCONTROL;
TPM4CMDCONTEXTCONTROL=bitpacked record
loadControl :TCONTEXTCONTROLENABLE; ///< enable bits for loading
shadowEnable:TCONTEXTCONTROLENABLE; ///< enable bits for shadowing
end;
PPM4CMDCLEARSTATE=^DWORD;
PPM4CMDSETDATA=^TPM4CMDSETDATA;
TPM4CMDSETDATA=packed record
REG_OFFSET:WORD;
RESERVED:WORD;
REG_DATA:packed record end;
end;
PPM4CMDDRAWINDEX2=^TPM4CMDDRAWINDEX2;
TPM4CMDDRAWINDEX2=packed record
maxSize:DWORD; // VGT_DMA_MAX_SIZE
indexBaseLo:DWORD; // VGT_DMA_BASE
indexBaseHi:DWORD; // VGT_DMA_BASE_HI
indexCount:DWORD; // VGT_DMA_SIZE ,VGT_NUM_INDICES
drawInitiator:TVGT_DRAW_INITIATOR;
end;
PPM4CMDDRAWINDEXAUTO=^TPM4CMDDRAWINDEXAUTO;
TPM4CMDDRAWINDEXAUTO=packed record
indexCount:DWORD; ///< max index count
drawInitiator:TVGT_DRAW_INITIATOR;
end;
PPM4CMDDISPATCHDIRECT=^TPM4CMDDISPATCHDIRECT;
TPM4CMDDISPATCHDIRECT=packed record
dimX:DWORD; ///< X dimensions of the array of thread groups to be dispatched
dimY:DWORD; ///< Y dimensions of the array of thread groups to be dispatched
dimZ:DWORD; ///< Z dimensions of the array of thread groups to be dispatched
dispatchInitiator:TCOMPUTE_DISPATCH_INITIATOR; ///< Dispatch Initiator Register
end;
function PM4_HEADER_BUILD(lenDw:WORD;op,priv:Byte):DWORD; inline;
function PM4_PRIV(token:DWORD):Byte; inline;
function PM4_TYPE(token:DWORD):Byte; inline;
function PM4_LENGTH_DW(token:DWORD):WORD; inline;
implementation
function PM4_HEADER_BUILD(lenDw:WORD;op,priv:Byte):DWORD; inline;
begin
Result:=((lenDw shl 16)+$3FFE0000) or $C0000000 or
(op shl 8) or priv;
end;
function PM4_PRIV(token:DWORD):Byte; inline;
begin
Result:=Byte(token);
end;
function PM4_TYPE(token:DWORD):Byte; inline;
begin
Result:=(token shr 30) and 3;
end;
function PM4_LENGTH_DW(token:DWORD):WORD; inline;
begin
Result:=((token shr 16) and $3FFF) + 2;
end;
end.

928
chip/ps4_gpu_regs.pas Normal file
View File

@ -0,0 +1,928 @@
unit ps4_gpu_regs;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
vulkan,
bittype,
pm4defs,
si_ci_vi_merged_offset,
si_ci_vi_merged_enum,
si_ci_vi_merged_registers;
type
TRENDER_TARGET=packed record
BASE :TCB_COLOR0_BASE ; //mmCB_COLOR0_BASE_DEFAULT
PITCH :TCB_COLOR0_PITCH ; //mmCB_COLOR0_PITCH_DEFAULT
SLICE :TCB_COLOR0_SLICE ; //mmCB_COLOR0_SLICE_DEFAULT
VIEW :TCB_COLOR0_VIEW ; //mmCB_COLOR0_VIEW_DEFAULT
INFO :TCB_COLOR0_INFO ; //mmCB_COLOR0_INFO_DEFAULT
ATTRIB :TCB_COLOR0_ATTRIB ; //mmCB_COLOR0_ATTRIB_DEFAULT
DCC_CONTROL:TCB_COLOR0_DCC_CONTROL; //mmCB_COLOR0_DCC_CONTROL_DEFAULT
CMASK :TCB_COLOR0_CMASK ; //mmCB_COLOR0_CMASK_DEFAULT
CMASK_SLICE:TCB_COLOR0_CMASK_SLICE; //mmCB_COLOR0_CMASK_SLICE_DEFAULT
FMASK :TCB_COLOR0_FMASK ; //mmCB_COLOR0_FMASK_DEFAULT
FMASK_SLICE:TCB_COLOR0_FMASK_SLICE; //mmCB_COLOR0_FMASK_SLICE_DEFAULT
CLEAR_WORD :QWORD; //mmCB_COLOR0_CLEAR_WORD0_DEFAULT
//mmCB_COLOR0_CLEAR_WORD1_DEFAULT
DCC_BASE :TCB_COLOR0_DCC_BASE ; //mmCB_COLOR0_DCC_BASE_DEFAULT
align:DWORD;
end;
TGB_CLIP=packed record
VERT_CLIP_ADJ:Single;
VERT_DISC_ADJ:Single;
HORZ_CLIP_ADJ:Single;
HORZ_DISC_ADJ:Single;
end;
TVPORT_SCISSOR=packed record
TL:TPA_SC_VPORT_SCISSOR_0_TL;
BR:TPA_SC_VPORT_SCISSOR_0_BR;
end;
TVPORT_ZMIN_MAX=packed record
ZMIN:Single;
ZMAX:Single;
end;
TVPORT_SCALE_OFFSET=packed record
XSCALE :Single;
XOFFSET:Single;
YSCALE :Single;
YOFFSET:Single;
ZSCALE :Single;
ZOFFSET:Single;
end;
TSPI_USER_DATA=array[0..15] of DWORD;
TRT_INFO=record
Addr:Pointer;
extend:TVkExtent2D;
padded:TVkExtent2D;
cformat:TVkFormat;
TILE_MODE_INDEX:DWORD;
COMP_SWAP :Byte;
FAST_CLEAR:Boolean;
CLEAR_COLOR:TVkClearColorValue;
blend:TVkPipelineColorBlendAttachmentState;
end;
TDB_INFO=record
Z_READ_ADDR:Pointer;
Z_WRITE_ADDR:Pointer;
STENCIL_READ_ADDR:Pointer;
STENCIL_WRITE_ADDR:Pointer;
extend:TVkExtent2D;
padded:TVkExtent2D;
DEPTH_CLEAR :Boolean;
STENCIL_CLEAR :Boolean;
Z_READ_ONLY :Boolean;
STENCIL_READ_ONLY:Boolean;
CLEAR_VALUE:TVkClearValue;
depthTestEnable :TVkBool32;
depthWriteEnable :TVkBool32;
depthCompareOp :TVkCompareOp;
depthBoundsTestEnable:TVkBool32;
stencilTestEnable :TVkBool32;
front:TVkStencilOpState;
back:TVkStencilOpState;
minDepthBounds:TVkFloat;
maxDepthBounds:TVkFloat;
dformat:TVkFormat;
zorder_stage:TVkPipelineStageFlagBits;
end;
TGPU_REGS=packed object
RENDER_TARGET:array[0..7] of TRENDER_TARGET;
TARGET_MASK:TCB_TARGET_MASK;
VTE_CNTL:TPA_CL_VTE_CNTL;
SC_MODE_CNTL_0:TPA_SC_MODE_CNTL_0;
SC_MODE_CNTL_1:TPA_SC_MODE_CNTL_1;
VPORT_SCISSOR:array[0..15] of TVPORT_SCISSOR;
VPORT_ZMIN_MAX:array[0..15] of TVPORT_ZMIN_MAX;
VPORT_SCALE_OFFSET:array[0..15] of TVPORT_SCALE_OFFSET;
SCREEN_SCISSOR_BR:TPA_SC_SCREEN_SCISSOR_BR;
SCREEN_SCISSOR_TL:TPA_SC_SCREEN_SCISSOR_TL;
SC_AA_CONFIG:TPA_SC_AA_CONFIG;
SC_AA_MASK_X0Y0_X1Y0:TPA_SC_AA_MASK_X0Y0_X1Y0;
SC_AA_MASK_X0Y1_X1Y1:TPA_SC_AA_MASK_X0Y1_X1Y1;
HARDWARE_SCREEN_OFFSET:TPA_SU_HARDWARE_SCREEN_OFFSET;
SU_LINE_CNTL:TPA_SU_LINE_CNTL;
SU_POINT_SIZE:TPA_SU_POINT_SIZE;
SU_POINT_MINMAX:TPA_SU_POINT_MINMAX;
VTX_CNTL:TPA_SU_VTX_CNTL;
GB_CLIP:TGB_CLIP;
CL_CLIP_CNTL:TPA_CL_CLIP_CNTL;
SC_CLIPRECT_RULE:TPA_SC_CLIPRECT_RULE;
VGT_SHADER_STAGES_EN:TVGT_SHADER_STAGES_EN;
VGT_OUT_DEALLOC_CNTL:TVGT_OUT_DEALLOC_CNTL;
VGT_VTX_INDX:packed record
CNT_EN:TVGT_VTX_CNT_EN;
INDX_OFFSET:DWORD;
MIN_INDX:DWORD;
MAX_INDX:DWORD;
end;
VGT_MULTI_PRIM_IB_RESET_INDX:TVGT_MULTI_PRIM_IB_RESET_INDX;
VGT_OUTPUT_PATH_CNTL:TVGT_OUTPUT_PATH_CNTL;
VGT_PRIMITIVE_TYPE:TVGT_PRIMITIVE_TYPE;
VGT_INDEX_TYPE :TVGT_INDEX_TYPE ;
VGT_NUM_INSTANCES :TVGT_NUM_INSTANCES ;
VGT_DMA:packed record
INDEX_TYPE:TVGT_DMA_INDEX_TYPE;
NUM_INSTANCES:TVGT_DMA_NUM_INSTANCES;
MAX_SIZE:DWORD;
BASE_LO:DWORD;
BASE_HI:DWORD;
SIZE:DWORD;
INDICES:DWORD;
end;
SPI:packed record
PS:packed record
INPUT_CNTL_0:TSPI_PS_INPUT_CNTL_0;
INPUT_CNTL_1:TSPI_PS_INPUT_CNTL_1;
LO,HI:DWORD;
RSRC1:TSPI_SHADER_PGM_RSRC1_PS;
RSRC2:TSPI_SHADER_PGM_RSRC2_PS;
RSRC3:TSPI_SHADER_PGM_RSRC3_PS;
Z_FORMAT :TSPI_SHADER_Z_FORMAT;
COL_FORMAT:TSPI_SHADER_COL_FORMAT;
INPUT_ENA :TSPI_PS_INPUT_ENA;
INPUT_ADDR:TSPI_PS_INPUT_ADDR;
IN_CONTROL:TSPI_PS_IN_CONTROL;
BARYC_CNTL:TSPI_BARYC_CNTL;
SHADER_CONTROL:TDB_SHADER_CONTROL;
SHADER_MASK:TCB_SHADER_MASK;
USER_DATA:TSPI_USER_DATA;
end;
VS:packed record
LO,HI:DWORD;
RSRC1:TSPI_SHADER_PGM_RSRC1_VS;
RSRC2:TSPI_SHADER_PGM_RSRC2_VS;
RSRC3:TSPI_SHADER_PGM_RSRC3_VS;
OUT_CONFIG:TSPI_VS_OUT_CONFIG;
POS_FORMAT:TSPI_SHADER_POS_FORMAT;
OUT_CNTL :TPA_CL_VS_OUT_CNTL;
USER_DATA:TSPI_USER_DATA;
LATE_ALLOC:TSPI_SHADER_LATE_ALLOC_VS;
end;
CS:packed record
LO,HI:DWORD;
RSRC1:TCOMPUTE_PGM_RSRC1;
RSRC2:TCOMPUTE_PGM_RSRC2;
STATIC_THREAD_MGMT_SE0:TCOMPUTE_STATIC_THREAD_MGMT_SE0;
STATIC_THREAD_MGMT_SE1:TCOMPUTE_STATIC_THREAD_MGMT_SE1;
RESOURCE_LIMITS:TCOMPUTE_RESOURCE_LIMITS;
NUM_THREAD_X:TCOMPUTE_NUM_THREAD_X;
NUM_THREAD_Y:TCOMPUTE_NUM_THREAD_Y;
NUM_THREAD_Z:TCOMPUTE_NUM_THREAD_Z;
USER_DATA:TSPI_USER_DATA;
end;
end;
DEPTH:packed record
RENDER_CONTROL :TDB_RENDER_CONTROL;
DEPTH_CONTROL :TDB_DEPTH_CONTROL;
DEPTH_VIEW :TDB_DEPTH_VIEW ;
HTILE_DATA_BASE :TDB_HTILE_DATA_BASE ;
DEPTH_BOUNDS_MIN :Single;
DEPTH_BOUNDS_MAX :Single;
STENCIL_CLEAR :TDB_STENCIL_CLEAR ;
DEPTH_CLEAR :Single;
DEPTH_INFO :TDB_DEPTH_INFO ;
Z_INFO :TDB_Z_INFO ;
STENCIL_INFO :TDB_STENCIL_INFO ;
Z_READ_BASE :TDB_Z_READ_BASE ;
STENCIL_READ_BASE :TDB_STENCIL_READ_BASE ;
Z_WRITE_BASE :TDB_Z_WRITE_BASE ;
STENCIL_WRITE_BASE:TDB_STENCIL_WRITE_BASE;
DEPTH_SIZE :TDB_DEPTH_SIZE ;
DEPTH_SLICE :TDB_DEPTH_SLICE ;
HTILE_SURFACE :TDB_HTILE_SURFACE ;
end;
CB_COLOR_CONTROL:TCB_COLOR_CONTROL;
CB_BLEND_CONTROL:array[0..7] of TCB_BLEND0_CONTROL;
PA_SU_POLY_OFFSET_DB_FMT_CNTL:TPA_SU_POLY_OFFSET_DB_FMT_CNTL;
Function _SHADER_MASK(i:Byte):Byte; inline; //0..7
Function _TARGET_MASK(i:Byte):Byte; inline; //0..7
Function _COMP_MASK(i:Byte):Byte; inline; //0..7
Function COMP_ENABLE:Boolean; inline;
Function RT_ENABLE(i:Byte):Boolean; //0..7
Function VP_ENABLE(i:Byte):Boolean; //0..15
Function GET_VPORT(i:Byte):TVkViewport; //0..15
Function GET_SCISSOR(i:Byte):TVkRect2D; //0..15
Function GET_SCREEN:TVkRect2D;
Function GET_SCREEN_SIZE:TVkExtent2D;
Function GET_RT_BLEND(i:Byte):TVkPipelineColorBlendAttachmentState; //0..7
Function GET_RT_INFO(i:Byte):TRT_INFO; //0..7
Function DB_ENABLE:Boolean;
Function GET_DB_INFO:TDB_INFO;
function GET_PRIM_TYPE:TVkPrimitiveTopology;
function GET_INDEX_TYPE:TVkIndexType;
function GET_INDEX_TYPE_SIZE:Byte;
Procedure Clear;
Procedure ClearDMA;
end;
implementation
Function TGPU_REGS._SHADER_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=(DWORD(SPI.PS.SHADER_MASK) shr i) and 15;
end;
Function TGPU_REGS._TARGET_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=(DWORD(TARGET_MASK) shr i) and 15;
end;
Function TGPU_REGS._COMP_MASK(i:Byte):Byte; inline; //0..7
begin
Result:=((DWORD(SPI.PS.SHADER_MASK) and DWORD(TARGET_MASK)) shr i) and 15;
end;
Function TGPU_REGS.COMP_ENABLE:Boolean; inline;
begin
Result:=(DWORD(SPI.PS.SHADER_MASK) and DWORD(TARGET_MASK))<>0;
end;
Function TGPU_REGS.RT_ENABLE(i:Byte):Boolean; //0..7
begin
Result:=(RENDER_TARGET[i].BASE<>0) and
(RENDER_TARGET[i].INFO.FORMAT<>0) and
(_COMP_MASK(i)<>0);
end;
Function TGPU_REGS.VP_ENABLE(i:Byte):Boolean; //0..15
begin
Result:=(PQWORD(@VPORT_SCALE_OFFSET[i])[0]<>0) or
(PQWORD(@VPORT_SCALE_OFFSET[i])[1]<>0) or
(PQWORD(@VPORT_SCALE_OFFSET[i])[2]<>0);
end;
Function TGPU_REGS.GET_VPORT(i:Byte):TVkViewport; //0..15
var
V:TVPORT_SCALE_OFFSET;
begin
Result:=Default(TVkViewport);
V:=VPORT_SCALE_OFFSET[i];
if (VTE_CNTL.VPORT_X_SCALE_ENA =0) then V.XSCALE :=1;
if (VTE_CNTL.VPORT_X_OFFSET_ENA=0) then V.XOFFSET:=0;
if (VTE_CNTL.VPORT_Y_SCALE_ENA =0) then V.YSCALE :=1;
if (VTE_CNTL.VPORT_Y_OFFSET_ENA=0) then V.YOFFSET:=0;
if (VTE_CNTL.VPORT_Z_SCALE_ENA =0) then V.ZSCALE :=1;
if (VTE_CNTL.VPORT_Z_OFFSET_ENA=0) then V.ZOFFSET:=0;
Assert(VTE_CNTL.VTX_XY_FMT=0);
Assert(VTE_CNTL.VTX_Z_FMT =0);
Assert(VTE_CNTL.VTX_W0_FMT=1);
Result.x :=V.XOFFSET-V.XSCALE;
Result.y :=V.YOFFSET-V.YSCALE;
Result.width :=V.XSCALE*2;
Result.height :=V.YSCALE*2;
Result.minDepth:=V.ZOFFSET;
Result.maxDepth:=V.ZOFFSET+V.ZSCALE;
end;
Function _fix_scissor_range(i:Word):Word;
begin
Result:=i;
if SmallInt(Result)<0 then Result:=0;
if SmallInt(Result)>16384 then Result:=16384;
end;
Function TGPU_REGS.GET_SCISSOR(i:Byte):TVkRect2D; //0..15
begin
if (SC_MODE_CNTL_0.VPORT_SCISSOR_ENABLE=1) then
begin
Result.offset.x :=_fix_scissor_range(VPORT_SCISSOR[i].TL.TL_X);
Result.offset.y :=_fix_scissor_range(VPORT_SCISSOR[i].TL.TL_Y);
Result.extent.width :=_fix_scissor_range(VPORT_SCISSOR[i].BR.BR_X);
Result.extent.height:=_fix_scissor_range(VPORT_SCISSOR[i].BR.BR_Y);
Result.extent.width :=Result.extent.width -Result.offset.x;
Result.extent.height:=Result.extent.height-Result.offset.y;
end else
begin
Result.offset.x :=_fix_scissor_range(SCREEN_SCISSOR_TL.TL_X);
Result.offset.y :=_fix_scissor_range(SCREEN_SCISSOR_TL.TL_Y);
Result.extent.width :=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.extent.height:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
Result.extent.width :=Result.extent.width -Result.offset.x;
Result.extent.height:=Result.extent.height-Result.offset.y;
end;
end;
Function TGPU_REGS.GET_SCREEN:TVkRect2D;
{var
i:Byte;
x,y:Word;}
begin
Result.offset.x :=_fix_scissor_range(SCREEN_SCISSOR_TL.TL_X);
Result.offset.y :=_fix_scissor_range(SCREEN_SCISSOR_TL.TL_Y);
Result.extent.width :=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.extent.height:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
Result.extent.width :=Result.extent.width -Result.offset.x;
Result.extent.height:=Result.extent.height-Result.offset.y;
{if (SC_MODE_CNTL_0.VPORT_SCISSOR_ENABLE=1) then
begin
Result:=Default(TPA_SC_SCREEN_SCISSOR_BR);
For i:=0 to 15 do //SCISSOR WINDOW TODO
begin
x:=_fix_scissor_range(VPORT_SCISSOR[i].BR.BR_X);
y:=_fix_scissor_range(VPORT_SCISSOR[i].BR.BR_Y);
if (Result.BR_X<x) then Result.BR_X:=x;
if (Result.BR_Y<y) then Result.BR_Y:=y;
end;
end else
begin
Result.BR_X:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.BR_Y:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
end;}
end;
Function TGPU_REGS.GET_SCREEN_SIZE:TVkExtent2D;
begin
Result.width :=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_X);
Result.height:=_fix_scissor_range(SCREEN_SCISSOR_BR.BR_Y);
end;
Function GetBlendFactor(i:Byte):TVkBlendFactor;
begin
Case i of
BLEND_ZERO :Result:=VK_BLEND_FACTOR_ZERO;
BLEND_ONE :Result:=VK_BLEND_FACTOR_ONE;
BLEND_SRC_COLOR :Result:=VK_BLEND_FACTOR_SRC_COLOR;
BLEND_ONE_MINUS_SRC_COLOR :Result:=VK_BLEND_FACTOR_ONE_MINUS_SRC_COLOR;
BLEND_SRC_ALPHA :Result:=VK_BLEND_FACTOR_SRC_ALPHA;
BLEND_ONE_MINUS_SRC_ALPHA :Result:=VK_BLEND_FACTOR_ONE_MINUS_SRC_ALPHA;
BLEND_DST_ALPHA :Result:=VK_BLEND_FACTOR_DST_ALPHA;
BLEND_ONE_MINUS_DST_ALPHA :Result:=VK_BLEND_FACTOR_ONE_MINUS_DST_ALPHA;
BLEND_DST_COLOR :Result:=VK_BLEND_FACTOR_DST_COLOR;
BLEND_ONE_MINUS_DST_COLOR :Result:=VK_BLEND_FACTOR_ONE_MINUS_DST_COLOR;
BLEND_SRC_ALPHA_SATURATE :Result:=VK_BLEND_FACTOR_SRC_ALPHA_SATURATE;
BLEND_BOTH_SRC_ALPHA :Result:=VK_BLEND_FACTOR_SRC1_ALPHA;
BLEND_BOTH_INV_SRC_ALPHA :Result:=VK_BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA;
BLEND_CONSTANT_COLOR :Result:=VK_BLEND_FACTOR_CONSTANT_COLOR;
BLEND_ONE_MINUS_CONSTANT_COLOR:Result:=VK_BLEND_FACTOR_ONE_MINUS_CONSTANT_COLOR;
BLEND_SRC1_COLOR :Result:=VK_BLEND_FACTOR_SRC1_COLOR;
BLEND_INV_SRC1_COLOR :Result:=VK_BLEND_FACTOR_ONE_MINUS_SRC1_COLOR;
BLEND_SRC1_ALPHA :Result:=VK_BLEND_FACTOR_SRC1_ALPHA;
BLEND_INV_SRC1_ALPHA :Result:=VK_BLEND_FACTOR_ONE_MINUS_SRC1_ALPHA;
BLEND_CONSTANT_ALPHA :Result:=VK_BLEND_FACTOR_CONSTANT_ALPHA;
BLEND_ONE_MINUS_CONSTANT_ALPHA:Result:=VK_BLEND_FACTOR_ONE_MINUS_CONSTANT_ALPHA;
else
Assert(false);
end;
end;
Function GetBlendOp(i:Byte):TVkBlendOp;
begin
Case i of
COMB_DST_PLUS_SRC :Result:=VK_BLEND_OP_ADD;
COMB_SRC_MINUS_DST:Result:=VK_BLEND_OP_SUBTRACT;
COMB_MIN_DST_SRC :Result:=VK_BLEND_OP_MIN;
COMB_MAX_DST_SRC :Result:=VK_BLEND_OP_MAX;
COMB_DST_MINUS_SRC:Result:=VK_BLEND_OP_REVERSE_SUBTRACT;
else
Assert(false);
end;
end;
function GetRTCompCount(FORMAT:Byte):Byte;
begin
Result:=0;
Case FORMAT of
COLOR_8 :Result:=1;
COLOR_16 :Result:=1;
COLOR_8_8 :Result:=2;
COLOR_32 :Result:=1;
COLOR_16_16 :Result:=2;
COLOR_10_11_11 :Result:=3;
COLOR_11_11_10 :Result:=3;
COLOR_10_10_10_2 :Result:=4;
COLOR_2_10_10_10 :Result:=4;
COLOR_8_8_8_8 :Result:=4;
COLOR_32_32 :Result:=2;
COLOR_16_16_16_16 :Result:=4;
COLOR_RESERVED_13 :Result:=3; //32_32_32
COLOR_32_32_32_32 :Result:=4;
COLOR_5_6_5 :Result:=3;
COLOR_1_5_5_5 :Result:=4;
COLOR_5_5_5_1 :Result:=4;
COLOR_4_4_4_4 :Result:=4;
COLOR_8_24 :Result:=2;
COLOR_24_8 :Result:=2;
COLOR_X24_8_32_FLOAT:Result:=3;
end;
end;
type
TCOMP_MAP=array[0..3] of Byte;
function GetCompMap(COMP_SWAP,COUNT:Byte):TCOMP_MAP;
begin
Result:=Default(TCOMP_MAP);
Case COUNT of
1:
Case COMP_SWAP of
SWAP_STD :Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
SWAP_ALT :Result[0]:=ord(VK_COLOR_COMPONENT_G_BIT);
SWAP_STD_REV:Result[0]:=ord(VK_COLOR_COMPONENT_B_BIT);
SWAP_ALT_REV:Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
end;
2:
Case COMP_SWAP of
SWAP_STD :begin
Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_G_BIT);
end;
SWAP_ALT :begin
Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_A_BIT);
end;
SWAP_STD_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_B_BIT);
end;
SWAP_ALT_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_R_BIT);
end;
end;
3:
Case COMP_SWAP of
SWAP_STD :begin
Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_B_BIT);
end;
SWAP_ALT :begin
Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_A_BIT);
end;
SWAP_STD_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_B_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_G_BIT);
end;
SWAP_ALT_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_G_BIT);
end;
end;
4:
Case COMP_SWAP of
SWAP_STD :begin
Result[0]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_B_BIT);
Result[3]:=ord(VK_COLOR_COMPONENT_A_BIT);
end;
SWAP_ALT :begin
Result[0]:=ord(VK_COLOR_COMPONENT_B_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[3]:=ord(VK_COLOR_COMPONENT_A_BIT);
end;
SWAP_STD_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_B_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[3]:=ord(VK_COLOR_COMPONENT_R_BIT);
end;
SWAP_ALT_REV:begin
Result[0]:=ord(VK_COLOR_COMPONENT_A_BIT);
Result[1]:=ord(VK_COLOR_COMPONENT_R_BIT);
Result[2]:=ord(VK_COLOR_COMPONENT_G_BIT);
Result[3]:=ord(VK_COLOR_COMPONENT_B_BIT);
end;
end;
end;
//SWAP_STD (R=>0)
//SWAP_ALT (G=>0)
//SWAP_STD_REV (B=>0)
//SWAP_ALT_REV (A=>0)
//SWAP_ALT (R=>0, A=>1)
//SWAP_ALT (R=>0, G=>1, A=>2)
//SWAP_STD (R=>0, G=>1, B=>2, A=>3)
//SWAP_ALT (B=>0, G=>1, R=>2, A=>3).
//SWAP_STD_REV (A=>0, B=>1, G=>2, R=>3)
//SWAP_ALT_REV (A=>0, R=>1, G=>2, B=>3)
end;
Function TGPU_REGS.GET_RT_BLEND(i:Byte):TVkPipelineColorBlendAttachmentState; //0..7
var
m:Byte;
COMP_MAP:TCOMP_MAP;
begin
Result:=Default(TVkPipelineColorBlendAttachmentState);
m:=GetRTCompCount(RENDER_TARGET[i].INFO.FORMAT);
COMP_MAP:=GetCompMap(RENDER_TARGET[i].INFO.COMP_SWAP,m);
//COMP_SWAP depend (B=>0, G=>1, R=>2, A=>3)
m:=_COMP_MASK(i);
if m.TestBit(0) then Result.colorWriteMask:=Result.colorWriteMask or COMP_MAP[0];
if m.TestBit(1) then Result.colorWriteMask:=Result.colorWriteMask or COMP_MAP[1];
if m.TestBit(2) then Result.colorWriteMask:=Result.colorWriteMask or COMP_MAP[2];
if m.TestBit(3) then Result.colorWriteMask:=Result.colorWriteMask or COMP_MAP[3];
//BLEND_CLAMP
if (RENDER_TARGET[i].INFO.BLEND_BYPASS=1) then
begin
Result.blendEnable:=VK_FALSE;
end else
if (CB_BLEND_CONTROL[i].ENABLE=0) then
begin
Result.blendEnable:=VK_FALSE;
end else
begin
Result.blendEnable:=VK_TRUE;
Result.srcColorBlendFactor:=GetBlendFactor(CB_BLEND_CONTROL[i].COLOR_SRCBLEND);
Result.dstColorBlendFactor:=GetBlendFactor(CB_BLEND_CONTROL[i].COLOR_DESTBLEND);
Result.srcAlphaBlendFactor:=GetBlendFactor(CB_BLEND_CONTROL[i].ALPHA_SRCBLEND);
Result.dstAlphaBlendFactor:=GetBlendFactor(CB_BLEND_CONTROL[i].ALPHA_DESTBLEND);
Result.colorBlendOp:=GetBlendOp(CB_BLEND_CONTROL[i].COLOR_COMB_FCN);
Result.alphaBlendOp:=GetBlendOp(CB_BLEND_CONTROL[i].ALPHA_COMB_FCN);
Assert(CB_BLEND_CONTROL[i].SEPARATE_ALPHA_BLEND=0);
Assert(CB_BLEND_CONTROL[i].DISABLE_ROP3 =0);
end;
//Assert(CB_COLOR_CONTROL.ROP3 = 204);
end;
Function TGPU_REGS.GET_RT_INFO(i:Byte):TRT_INFO; //0..7
var
COMP_MAP:TCOMP_MAP;
W:QWORD;
begin
Result:=Default(TRT_INFO);
Result.Addr:=Pointer(QWORD(RENDER_TARGET[i].BASE) shl 8);
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL=1) then
begin
Result.Addr:=Pointer(QWORD(Result.Addr) or Byte(RENDER_TARGET[i].VIEW.SLICE_START));
end;
Result.extend:=GET_SCREEN_SIZE;
Result.padded.Width :=(RENDER_TARGET[i].PITCH.TILE_MAX+1)*8;
Result.padded.Height:=(RENDER_TARGET[i].SLICE.TILE_MAX+1)*8 div (RENDER_TARGET[i].PITCH.TILE_MAX+1);
Assert(RENDER_TARGET[i].INFO.ENDIAN=ENDIAN_NONE);
Assert(RENDER_TARGET[i].INFO.COMPRESSION=0);
Case RENDER_TARGET[i].INFO.FORMAT of
COLOR_8_8_8_8:
Case RENDER_TARGET[i].INFO.NUMBER_TYPE of
NUMBER_UNORM:Result.cformat:=VK_FORMAT_R8G8B8A8_UNORM;
NUMBER_SRGB :Result.cformat:=VK_FORMAT_R8G8B8A8_SRGB;
else
Assert(false);
end;
else
Assert(false);
end;
Result.TILE_MODE_INDEX:=RENDER_TARGET[i].ATTRIB.TILE_MODE_INDEX;
if (RENDER_TARGET[i].INFO.LINEAR_GENERAL=1) then Result.TILE_MODE_INDEX:=8;
Result.COMP_SWAP:=RENDER_TARGET[i].INFO.COMP_SWAP;
if (RENDER_TARGET[i].INFO.FAST_CLEAR=1) then
begin
Result.FAST_CLEAR:=True;
Case RENDER_TARGET[i].INFO.FORMAT of
COLOR_8_8_8_8:
Case RENDER_TARGET[i].INFO.NUMBER_TYPE of
NUMBER_UNORM,
NUMBER_SRGB :
begin
COMP_MAP:=GetCompMap(RENDER_TARGET[i].INFO.COMP_SWAP,4);
//VK_COLOR_COMPONENT_R_BIT=$00000001, 0001
//VK_COLOR_COMPONENT_G_BIT=$00000002, 0010
//VK_COLOR_COMPONENT_B_BIT=$00000004, 0100
//VK_COLOR_COMPONENT_A_BIT=$00000008 1000
W:=RENDER_TARGET[i].CLEAR_WORD;
//Writeln((W shr (BsrDWord(COMP_MAP[0]) shl 3)) and 255);
//Writeln((W shr (BsrDWord(COMP_MAP[1]) shl 3)) and 255);
//Writeln((W shr (BsrDWord(COMP_MAP[2]) shl 3)) and 255);
//Writeln((W shr (BsrDWord(COMP_MAP[3]) shl 3)) and 255);
Result.CLEAR_COLOR.float32[0]:=((W shr (BsrDWord(COMP_MAP[0]) shl 3)) and 255)/255;
Result.CLEAR_COLOR.float32[1]:=((W shr (BsrDWord(COMP_MAP[1]) shl 3)) and 255)/255;
Result.CLEAR_COLOR.float32[2]:=((W shr (BsrDWord(COMP_MAP[2]) shl 3)) and 255)/255;
Result.CLEAR_COLOR.float32[3]:=((W shr (BsrDWord(COMP_MAP[3]) shl 3)) and 255)/255;
end;
else
Assert(false);
end;
else
Assert(false);
end;
end;
Result.blend:=GET_RT_BLEND(i);
end;
Function TGPU_REGS.DB_ENABLE:Boolean;
begin
Result:=(
(DEPTH.DEPTH_CONTROL.STENCIL_ENABLE<>0) and
(DEPTH.STENCIL_INFO.FORMAT<>0)
) or
(
(DEPTH.DEPTH_CONTROL.Z_ENABLE<>0) and
(DEPTH.Z_INFO.FORMAT<>0)
);
end;
Function TGPU_REGS.GET_DB_INFO:TDB_INFO;
begin
Result:=Default(TDB_INFO);
Result.extend:=GET_SCREEN_SIZE;
Result.padded.width :=(DEPTH.DEPTH_SIZE.PITCH_TILE_MAX +1)*8;
Result.padded.height:=(DEPTH.DEPTH_SIZE.HEIGHT_TILE_MAX+1)*8;
Result.DEPTH_CLEAR :=DEPTH.RENDER_CONTROL.DEPTH_CLEAR_ENABLE<>0;
Result.STENCIL_CLEAR:=DEPTH.RENDER_CONTROL.STENCIL_CLEAR_ENABLE<>0;
Result.Z_READ_ONLY :=DEPTH.DEPTH_VIEW.Z_READ_ONLY<>0;
Result.STENCIL_READ_ONLY:=DEPTH.DEPTH_VIEW.STENCIL_READ_ONLY<>0;
Assert(DEPTH.RENDER_CONTROL.DEPTH_COPY=0);
Assert(DEPTH.RENDER_CONTROL.STENCIL_COPY=0);
Assert(DEPTH.RENDER_CONTROL.COPY_CENTROID=0);
Assert(DEPTH.RENDER_CONTROL.COPY_SAMPLE=0);
Result.CLEAR_VALUE.depthStencil.depth :=DEPTH.DEPTH_CLEAR;
Result.CLEAR_VALUE.depthStencil.stencil:=DEPTH.STENCIL_CLEAR.CLEAR;
/////
Result.depthTestEnable :=DEPTH.DEPTH_CONTROL.Z_ENABLE; //1:1
Result.depthWriteEnable :=DEPTH.DEPTH_CONTROL.Z_WRITE_ENABLE; //1:1
Result.depthBoundsTestEnable:=DEPTH.DEPTH_CONTROL.DEPTH_BOUNDS_ENABLE; //1:1
Result.stencilTestEnable :=DEPTH.DEPTH_CONTROL.STENCIL_ENABLE; //1:1
Result.depthCompareOp:=TVkCompareOp(DEPTH.DEPTH_CONTROL.ZFUNC); //1:1
Result.minDepthBounds:=DEPTH.DEPTH_BOUNDS_MIN;
Result.maxDepthBounds:=DEPTH.DEPTH_BOUNDS_MAX;
//compareMask:TVkUInt32; //DB_STENCILREFMASK DB_STENCILREFMASK_BF
//writeMask:TVkUInt32; //DB_STENCILREFMASK DB_STENCILREFMASK_BF
//reference:TVkUInt32; //DB_STENCILREFMASK DB_STENCILREFMASK_BF
if (DEPTH.DEPTH_CONTROL.DISABLE_COLOR_WRITES_ON_DEPTH_PASS<>0) then
begin
Result.front.failOp:=VK_STENCIL_OP_REPLACE;
Result.front.depthFailOp:=VK_STENCIL_OP_REPLACE;
//Result.front.reference:=; ???
end;
if (DEPTH.DEPTH_CONTROL.ENABLE_COLOR_WRITES_ON_DEPTH_FAIL<>0) then
begin
Result.front.passOp:=VK_STENCIL_OP_REPLACE;
//Result.front.reference:=; ???
end;
Result.front.compareOp:=TVkCompareOp(DEPTH.DEPTH_CONTROL.STENCILFUNC); //1:1
if (DEPTH.DEPTH_CONTROL.BACKFACE_ENABLE<>0) then
begin
Result.back:=Result.front;
Result.back.compareOp:=TVkCompareOp(DEPTH.DEPTH_CONTROL.STENCILFUNC_BF); //1:1
end;
////
Assert(DEPTH.DEPTH_VIEW.SLICE_START=0);
Case DEPTH.Z_INFO.FORMAT of
Z_INVALID :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_S8_UINT;
end;
Z_16 :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D16_UNORM_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_D16_UNORM;
end;
Z_24 :
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D24_UNORM_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_X8_D24_UNORM_PACK32;
end;
Z_32_FLOAT:
if (DEPTH.STENCIL_INFO.FORMAT=STENCIL_8) then
begin
Result.dformat:=VK_FORMAT_D32_SFLOAT_S8_UINT;
end else
begin
Result.dformat:=VK_FORMAT_D32_SFLOAT;
end;
end;
Result.Z_READ_ADDR :=Pointer(QWORD(DEPTH.Z_READ_BASE) shl 8);
Result.Z_WRITE_ADDR:=Pointer(QWORD(DEPTH.Z_WRITE_BASE) shl 8);
Result.STENCIL_READ_ADDR :=Pointer(QWORD(DEPTH.STENCIL_READ_BASE) shl 8);
Result.STENCIL_WRITE_ADDR:=Pointer(QWORD(DEPTH.STENCIL_WRITE_BASE) shl 8);
Assert(SPI.PS.SHADER_CONTROL.Z_EXPORT_ENABLE=0);
Assert(SPI.PS.SHADER_CONTROL.STENCIL_TEST_VAL_EXPORT_ENABLE=0);
Case SPI.PS.SHADER_CONTROL.Z_ORDER of
LATE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT;
EARLY_Z_THEN_LATE_Z:Result.zorder_stage:=TVkPipelineStageFlagBits(
ord(VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT) or
ord(VK_PIPELINE_STAGE_LATE_FRAGMENT_TESTS_BIT));
RE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT;
EARLY_Z_THEN_RE_Z :Result.zorder_stage:=VK_PIPELINE_STAGE_EARLY_FRAGMENT_TESTS_BIT;
end;
end;
function TGPU_REGS.GET_PRIM_TYPE:TVkPrimitiveTopology;
begin
case VGT_PRIMITIVE_TYPE.PRIM_TYPE of
DI_PT_POINTLIST :Result:=VK_PRIMITIVE_TOPOLOGY_POINT_LIST ;
DI_PT_LINELIST :Result:=VK_PRIMITIVE_TOPOLOGY_LINE_LIST ;
DI_PT_LINESTRIP :Result:=VK_PRIMITIVE_TOPOLOGY_LINE_STRIP ;
DI_PT_TRILIST :Result:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST ;
DI_PT_TRIFAN :Result:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_FAN ;
DI_PT_TRISTRIP :Result:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP ;
DI_PT_PATCH :Result:=VK_PRIMITIVE_TOPOLOGY_PATCH_LIST ;
DI_PT_LINELIST_ADJ :Result:=VK_PRIMITIVE_TOPOLOGY_LINE_LIST_WITH_ADJACENCY ;
DI_PT_LINESTRIP_ADJ:Result:=VK_PRIMITIVE_TOPOLOGY_LINE_STRIP_WITH_ADJACENCY ;
DI_PT_TRILIST_ADJ :Result:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST_WITH_ADJACENCY ;
DI_PT_TRISTRIP_ADJ :Result:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP_WITH_ADJACENCY;
DI_PT_RECTLIST ,
DI_PT_LINELOOP ,
DI_PT_QUADLIST ,
DI_PT_QUADSTRIP ,
DI_PT_POLYGON :Result:=TVkPrimitiveTopology(VGT_PRIMITIVE_TYPE.PRIM_TYPE); //need to emulate
else
Assert(False);
end;
end;
// VGT_DI_PRIM_TYPE
//DI_PT_NONE | kPrimitiveTypeNone |
//DI_PT_POINTLIST | kPrimitiveTypePointList | VK_PRIMITIVE_TOPOLOGY_POINT_LIST
//DI_PT_LINELIST | kPrimitiveTypeLineList | VK_PRIMITIVE_TOPOLOGY_LINE_LIST
//DI_PT_LINESTRIP | kPrimitiveTypeLineStrip | VK_PRIMITIVE_TOPOLOGY_LINE_STRIP
//DI_PT_TRILIST | kPrimitiveTypeTriList | VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST
//DI_PT_TRIFAN | kPrimitiveTypeTriFan | VK_PRIMITIVE_TOPOLOGY_TRIANGLE_FAN
//DI_PT_TRISTRIP | kPrimitiveTypeTriStrip | VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP
//DI_PT_PATCH | kPrimitiveTypePatch | VK_PRIMITIVE_TOPOLOGY_PATCH_LIST
//DI_PT_LINELIST_ADJ | kPrimitiveTypeLineListAdjacency | VK_PRIMITIVE_TOPOLOGY_LINE_LIST_WITH_ADJACENCY
//DI_PT_LINESTRIP_ADJ | kPrimitiveTypeLineStripAdjacency | VK_PRIMITIVE_TOPOLOGY_LINE_STRIP_WITH_ADJACENCY
//DI_PT_TRILIST_ADJ | kPrimitiveTypeTriListAdjacency | VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST_WITH_ADJACENCY
//DI_PT_TRISTRIP_ADJ | kPrimitiveTypeTriStripAdjacency | VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP_WITH_ADJACENCY
//DI_PT_RECTLIST | kPrimitiveTypeRectList |
//DI_PT_LINELOOP | kPrimitiveTypeLineLoop |
//DI_PT_QUADLIST | kPrimitiveTypeQuadList |
//DI_PT_QUADSTRIP | kPrimitiveTypeQuadStrip |
//DI_PT_POLYGON | kPrimitiveTypePolygon |
function TGPU_REGS.GET_INDEX_TYPE:TVkIndexType;
begin
Case VGT_DMA.INDEX_TYPE.INDEX_TYPE of
VGT_INDEX_16:Result:=VK_INDEX_TYPE_UINT16;
VGT_INDEX_32:Result:=VK_INDEX_TYPE_UINT32;
VGT_INDEX_8 :Result:=VK_INDEX_TYPE_UINT8_EXT;
else Result:=VK_INDEX_TYPE_NONE_KHR;
end;
end;
function TGPU_REGS.GET_INDEX_TYPE_SIZE:Byte;
begin
Case VGT_DMA.INDEX_TYPE.INDEX_TYPE of
VGT_INDEX_16:Result:=16;
VGT_INDEX_32:Result:=32;
VGT_INDEX_8 :Result:=8;
else Result:=0;
end;
end;
Procedure TGPU_REGS.Clear;
begin
FillChar(Self,SizeOf(Self),0);
DWORD(SPI.CS.STATIC_THREAD_MGMT_SE0):=$FFFFFFFF;
DWORD(SPI.CS.STATIC_THREAD_MGMT_SE1):=$FFFFFFFF;
end;
Procedure TGPU_REGS.ClearDMA;
begin
FillChar(VGT_DMA,SizeOf(VGT_DMA),0);
end;
end.

1783
chip/ps4_pssl.pas Normal file
View File

File diff suppressed because it is too large Load Diff

284
chip/ps4_shader.pas Normal file
View File

@ -0,0 +1,284 @@
unit ps4_shader;
{$mode objfpc}{$H+}
interface
uses
Classes,SysUtils,
bittype,
ps4_pssl;
const
SHADER_BINARY_INFO_SIG:array[0..6] of Char='OrbShdr';
SHADER_END_SEARCH_MAX_DW=256+7;
type
PShaderBinaryInfo=^TShaderBinaryInfo;
TShaderBinaryInfo=bitpacked record
signature:array[0..6] of AnsiChar; // 'OrbShdr'
version:Byte; // ShaderBinaryInfoVersion
pssl_or_cg :bit1; // 1 = PSSL / Cg, 0 = IL / shtb
cached :bit1; // 1 = when compile, debugging source was cached. May only make sense for PSSL=1
m_type :bit4; // See enum ShaderBinaryType
source_type :bit2; // See enum ShaderSourceType
length :bit24; // Binary code length (does not include this structure or any of its preceding associated tables)
chunkUsageBaseOffsetInDW:Byte; // in DW, which starts at ((uint32_t*)&ShaderBinaryInfo) - m_chunkUsageBaseOffsetInDW; max is currently 7 dwords (128 T# + 32 V# + 20 CB V# + 16 UAV T#/V#)
numInputUsageSlots:Byte; // Up to 16 user data reg slots + 128 extended user data dwords supported by CUE; up to 16 user data reg slots + 240 extended user data dwords supported by Gnm::InputUsageSlot
isSrt :bit1; // 1 if this shader uses shader resource tables and has an SrtDef table embedded below the input usage table and any extended usage info
isSrtUsedInfoValid :bit1; // 1 if SrtDef::m_isUsed=0 indicates an element is definitely unused; 0 if SrtDef::m_isUsed=0 indicates only that the element is not known to be used (m_isUsed=1 always indicates a resource is known to be used)
isExtendedUsageInfo:bit1; // 1 if this shader has extended usage info for the InputUsage table embedded below the input usage table
reserved2:bit5; //1;
reserved3:Byte; //5
shaderHash0:DWORD; // Association hash first 4 bytes
shaderHash1:DWORD; // Association hash second 4 bytes
crc32 :DWORD; // crc32 of shader + this struct, just up till this field
end;
PInputUsageSlot=^TInputUsageSlot;
TInputUsageSlot=packed record
m_usageType :Byte; ///< From Gnm::ShaderInputUsageType.
m_apiSlot :Byte; ///< API slot or chunk ID.
m_startRegister:Byte; ///< User data slot.
Case byte of
0:(
b:bitpacked record
m_registerCount:bit1; ///< If 0, count is 4DW; if 1, count is 8DW. Other sizes are defined by the usage type.
m_resourceType:bit1; ///< If 0, resource type <c>V#</c>; if 1, resource type <c>T#</c>, in case of a Gnm::kShaderInputUsageImmResource.
m_reserved:bit2; ///< Unused; must be set to zero.
m_chunkMask:bit4; ///< Internal usage data.
end;
);
1:(m_srtSizeInDWordMinusOne:Byte); ///< Size of the SRT data; used for Gnm::kShaderInputUsageImmShaderResourceTable.
end;
const
//ShaderBinaryType
kShaderTypePs = 0;
kShaderTypeVsVs = 1;
kShaderTypeVsEs = 2;
kShaderTypeVsLs = 3;
kShaderTypeCs = 4;
kShaderTypeGs = 5;
kShaderTypeHs = 7;
kShaderTypeDsVs = 8;
//ShaderType
kShaderTypeGraphics = $00000000; ///< Configures command buffer for graphics commands.
kShaderTypeCompute = $00000001; ///< Configures command buffer for compute commands.
//ShaderStage
kShaderStageCs = $00000000; ///< Compute shader stage.
kShaderStagePs = $00000001; ///< Pixel shader stage.
kShaderStageVs = $00000002; ///< Vertex shader stage.
kShaderStageGs = $00000003; ///< Geometry shader stage.
kShaderStageEs = $00000004; ///< Export shader stage.
kShaderStageHs = $00000005; ///< Hull shader stage.
kShaderStageLs = $00000006; ///< LDS shader stage.
kShaderStageCount = 7; //< The number of shader stages.
//Specifies which stages should be activated in the graphics shader pipeline.
//ActiveShaderStages
kActiveShaderStagesVsPs = $00000000; ///< VS/PS only.
kActiveShaderStagesEsGsVsPs = $000000B0; ///< Geometry shader followed by VS/PS.
kActiveShaderStagesLsHsVsPs = $00000045; ///< Tessellation followed by VS/PS.
kActiveShaderStagesOffChipLsHsVsPs = $00000145; ///< Off-chip tessellation followed by VS/PS
kActiveShaderStagesLsHsEsGsVsPs = $000000AD; ///< Tessellation followed by the geometry shader followed by VS/PS.
kActiveShaderStagesOffChipLsHsEsGsVsPs = $000001AD; ///< Off-chip tessellation followed by the geometry shader followed by VS/PS.
kActiveShaderStagesDispatchDrawVsPs = $00000200; ///< Dispatch Draw VS/PS only.
//Describes a data resource expected by a shader.
//Each input must be bound by the application before the shader runs.
//ShaderInputUsageType
kShaderInputUsageImmResource = $00; ///< Immediate read-only buffer/texture descriptor.
kShaderInputUsageImmSampler = $01; ///< Immediate sampler descriptor.
kShaderInputUsageImmConstBuffer = $02; ///< Immediate constant buffer descriptor.
kShaderInputUsageImmVertexBuffer = $03; ///< Immediate vertex buffer descriptor.
kShaderInputUsageImmRwResource = $04; ///< Immediate read/write buffer/texture descriptor.
kShaderInputUsageImmAluFloatConst = $05; ///< Immediate float const (scalar or vector).
kShaderInputUsageImmAluBool32Const = $06; ///< 32 immediate Booleans packed into one UINT.
kShaderInputUsageImmGdsCounterRange = $07; ///< Immediate UINT with GDS address range for counters (used for append/consume buffers).
kShaderInputUsageImmGdsMemoryRange = $08; ///< Immediate UINT with GDS address range for storage.
kShaderInputUsageImmGwsBase = $09; ///< Immediate UINT with GWS resource base offset.
kShaderInputUsageImmShaderResourceTable = $0A; ///< Pointer to read/write resource indirection table.
kShaderInputUsageImmLdsEsGsSize = $0D; ///< Immediate LDS ESGS size used in on-chip GS
// Skipped several items here...
kShaderInputUsageSubPtrFetchShader = $12; ///< Immediate fetch shader subroutine pointer.
kShaderInputUsagePtrResourceTable = $13; ///< Flat resource table pointer.
kShaderInputUsagePtrInternalResourceTable = $14; ///< Flat internal resource table pointer.
kShaderInputUsagePtrSamplerTable = $15; ///< Flat sampler table pointer.
kShaderInputUsagePtrConstBufferTable = $16; ///< Flat const buffer table pointer.
kShaderInputUsagePtrVertexBufferTable = $17; ///< Flat vertex buffer table pointer.
kShaderInputUsagePtrSoBufferTable = $18; ///< Flat stream-out buffer table pointer.
kShaderInputUsagePtrRwResourceTable = $19; ///< Flat read/write resource table pointer.
kShaderInputUsagePtrInternalGlobalTable = $1A; ///< Internal driver table pointer.
kShaderInputUsagePtrExtendedUserData = $1B; ///< Extended user data pointer.
kShaderInputUsagePtrIndirectResourceTable = $1C; ///< Pointer to resource indirection table.
kShaderInputUsagePtrIndirectInternalResourceTable = $1D; ///< Pointer to internal resource indirection table.
kShaderInputUsagePtrIndirectRwResourceTable = $1E; ///< Pointer to read/write resource indirection table.
// Skipped several items here...
kShaderInputUsageImmGdsKickRingBufferOffse = $22; ///< Immediate UINT offset into GDS kick ring buffer for DispatchDraw. This must not be in extended user data.
kShaderInputUsageImmVertexRingBufferOffse = $23; ///< Immediate UINT offset into vertex ring buffer for DispatchDraw. This must not be in extended user data.
kShaderInputUsagePtrDispatchDraw = $24; ///< Pointer to DispatchDraw data. This must not be in extended user data.
kShaderInputUsageImmDispatchDrawInstances = $25; ///< Immediate UINT ((firstInstance<<16)|(numInstances-1)). This must not be in extended user data.
//ShaderProgramType
kShaderProgramTypeLs = 1 shl 0;
kShaderProgramTypeHs = 1 shl 1;
kShaderProgramTypeEs = 1 shl 2;
kShaderProgramTypeGs = 1 shl 3;
kShaderProgramTypeVs = 1 shl 4;
kShaderProgramTypePs = 1 shl 5;
kShaderProgramTypeCsG = 1 shl 10;
kShaderProgramTypeCs0 = 1 shl 15;
kShaderProgramTypeCs1 = 1 shl 16;
kShaderProgramTypeCs2 = 1 shl 17;
kShaderProgramTypeCs3 = 1 shl 18;
kShaderProgramTypeCs4 = 1 shl 19;
kShaderProgramTypeCs5 = 1 shl 20;
kShaderProgramTypeCs6 = 1 shl 21;
kShaderProgramTypeCs7 = 1 shl 22;
type
TShaderType=(
kInvalidShader, ///< Invalid or unrecognized shader.
kVertexShader, ///< VS stage shader
kPixelShader, ///< PS stage shader.
kGeometryShader, ///< GS stage shader.
kComputeShader, ///< CS stage shader.
kExportShader, ///< ES stage shader.
kLocalShader, ///< LS stage shader.
kHullShader, ///< HS stage shader.
kComputeVertexShader); ///< VS stage shader with embedded CS stage frontend shader.
TPsslShaderType=(
kShaderTypeVsShader,
kShaderTypeFsShader,
kShaderTypeCsShader,
kShaderTypeGsShader,
kShaderTypeHsShader,
kShaderTypeDsShader,
kShaderTypeShaderTypeLast
);
TPsslCodeType=(
kCodeTypeIl,
kCodeTypeIsa,
kCodeTypeScu,
kCodeTypeCodeTypeLast
);
type
PVSharpResource=^TVSharpResource;
TVSharpResource=bitpacked record
base:bit44;
mtype_L1s:bit2;
mtype_L2:bit2;
stride:bit14;
cache_swizzle:bit1;
swizzle_en:bit1; //swizzle AOS according to stride, index_stride, and element_size, else linear (stride * index + offset)
//64
num_records:bit32; //n units of 'stride'
dst_sel_x:bit3; //Destination channel select:
dst_sel_y:bit3; //0=0, 1=1, 4=R, 5=G, 6=B, 7=A
dst_sel_z:bit3;
dst_sel_w:bit3;
nfmt:bit3; //numeric data type (float, int, ...)
dfmt:bit4; //data format
element_size:bit2; //2, 4, 8, or 16 bytes. Used for swizzled buffer addressing
index_stride:bit2; //8, 16, 32, or 64. Used for swizzled buffer addressing
addtid_en:bit1; //addtid_en add thread id to the index for addr calc
reserved:bit1;
hash_en:bit1;
mtype:bit3;
_type:bit2; //value == 0 for buf. Overlaps upper 2 bits of 4-bit TYPE field in 128-bit T# resource
end;
PTSharpResource=^TTSharpResource;
TTSharpResource=bitpacked record
base:bit38;
mtype_L2:bit2;
min_lod:bit12;
dfmt:bit6;
nfmt:bit4;
mtype_L1L:bit2;
//64
width:bit14;
height:bit14;
perf_mod:bit3;
interlaced:bit1;
dst_sel_x:bit3;
dst_sel_y:bit3;
dst_sel_z:bit3;
dst_sel_w:bit3;
base_level:bit4;
last_level:bit4;
tiling_idx:bit5;
pow2pad:bit1;
mtype_L1M:bit1;
reserved:bit1;
_type:bit4;
//
end;
PVBufResource=^TVBufResource;
TVBufResource=Pointer;
function _calc_shader_size(base:Pointer;size_dw:DWORD=0;setpc:Boolean=false):DWORD;
function _calc_shader_info(base:Pointer;size_dw:DWORD=0;setpc:Boolean=false):PShaderBinaryInfo;
function _calc_shader_slot(info:PShaderBinaryInfo):PInputUsageSlot;
implementation
function _calc_shader_size(base:Pointer;size_dw:DWORD=0;setpc:Boolean=false):DWORD;
var
i:Integer;
_end:Pointer;
begin
if (base=nil) then Exit(0);
_end:=ps4_pssl._parse_size(base,size_dw,setpc);
Result:=(_end-base);
i:=System.IndexDword(_end^,SHADER_END_SEARCH_MAX_DW,PDWORD(@SHADER_BINARY_INFO_SIG)^);
If (i<>-1) then
begin
Result:=Result+i*SizeOf(DWORD)+SizeOf(TShaderBinaryInfo);
end;
end;
function _calc_shader_info(base:Pointer;size_dw:DWORD=0;setpc:Boolean=false):PShaderBinaryInfo;
var
i:Integer;
_end:Pointer;
begin
Result:=nil;
if (base=nil) then Exit;
_end:=ps4_pssl._parse_size(base,size_dw,setpc);
i:=System.IndexDword(_end^,SHADER_END_SEARCH_MAX_DW,PDWORD(@SHADER_BINARY_INFO_SIG)^);
If (i<>-1) then
begin
Result:=_end+i*SizeOf(DWORD);
end;
end;
function _calc_shader_slot(info:PShaderBinaryInfo):PInputUsageSlot;
var
usageMasks:Pointer;
begin
Result:=nil;
if (info=nil) then Exit;
if (info^.numInputUsageSlots<>0) then
begin
usageMasks:=Pointer(info)-(info^.chunkUsageBaseOffsetInDW*4);
Result:=PInputUsageSlot(usageMasks)-info^.numInputUsageSlots;
end;
end;
end.

3450
chip/ps4_tiling.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1154
chip/ps4_videodrv.pas Normal file
View File

File diff suppressed because it is too large Load Diff

309
chip/shader_dump.pas Normal file
View File

@ -0,0 +1,309 @@
unit shader_dump;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
ps4_program,
si_ci_vi_merged_offset,
ps4_shader,
ps4_gpu_regs;
type
TDUMP_WORD=packed record
REG,COUNT:WORD;
end;
Function FastHash(data:PByte;len:DWORD):DWORD;
Procedure DUMP_BLOCK(F:THandle;REG:WORD;P:Pointer;Size:DWORD);
Procedure DumpCS(var GPU_REGS:TGPU_REGS);
Procedure DumpPS(var GPU_REGS:TGPU_REGS);
Procedure DumpVS(var GPU_REGS:TGPU_REGS);
implementation
Function FastHash(data:PByte;len:DWORD):DWORD;
var
hash,tmp,rem:DWORD;
begin
if (len=0) or (data=nil) then Exit(0);
hash:=len;
rem:=len and 3;
len:=len shr 2;
While (len>0) do
begin
tmp :=PDWORD(data)[0];
hash:=hash+PWORD(@tmp)[0];
tmp :=(PWORD(@tmp)[1] shl 11) xor hash;
hash:=(hash shl 16) xor tmp;
data:=@PWORD(data)[2];
hash:=hash+(hash shr 11);
Dec(len);
end;
Case rem of
3:
begin
hash:=hash+PWORD(data)[0];
hash:=hash xor (hash shl 16);
hash:=hash xor (PShortint(data)[2] shl 18);
hash:=hash+(hash shr 11);
end;
2:
begin
hash:=hash+PWORD(data)[0];
hash:=hash xor (hash shl 11);
hash:=hash+(hash shr 17);
end;
1:
begin
hash:=hash+PShortint(data)[0];
hash:=hash xor (hash shl 10);
hash:=hash+(hash shr 1);
end;
end;
hash:=hash xor (hash shl 3);
hash:=hash+(hash shr 5);
hash:=hash xor (hash shl 4);
hash:=hash+(hash shr 17);
hash:=hash xor (hash shl 25);
hash:=hash+(hash shr 6);
Result:=hash;
end;
Procedure DUMP_BLOCK(F:THandle;REG:WORD;P:Pointer;Size:DWORD);
const
MAX_SIZE=($FFFF+1)*4;
var
W:TDUMP_WORD;
begin
if (F=feInvalidHandle) then Exit;
if (Size=0) or (P=nil) then Exit;
if (Size>MAX_SIZE) then Size:=MAX_SIZE;
W.REG :=REG;
W.COUNT:=((Size+3) div 4)-1;
FileWrite(F,W,SizeOf(W));
FileWrite(F,P^,System.Align(Size,4));
end;
function getCodeAddress(lo,hi:DWORD):Pointer;
begin
Result:=Pointer(((QWORD(hi) shl 40) or (QWORD(lo) shl 8)));
end;
function getFetchAddress(P:PDWORD):Pointer;
begin
Result:=Pointer(((QWORD(P[1]) shl 32) or (QWORD(P[0]) and (not 3))));
end;
type
TUSER_DATA_USEAGE=array[0..15] of Byte;
Procedure _calc_usage(info:PShaderBinaryInfo;var USER_DATA:TSPI_USER_DATA;var USEAGE_DATA:TUSER_DATA_USEAGE);
var
i:Integer;
Slots:PInputUsageSlot;
r:Byte;
begin
USEAGE_DATA:=Default(TUSER_DATA_USEAGE);
if (info<>nil) then
begin
Slots:=_calc_shader_slot(info);
if (Slots<>nil) then
For i:=0 to info^.numInputUsageSlots-1 do
if (Slots[i].m_usageType=kShaderInputUsageSubPtrFetchShader) then
begin
r:=Slots[i].m_startRegister;
Assert(r<15);
USEAGE_DATA[r]:=2;
USEAGE_DATA[r+1]:=1;
end;
end;
For i:=0 to 15 do
if (USEAGE_DATA[i]=0) and (USER_DATA[i]=0) then
begin
USEAGE_DATA[i]:=1;
end;
end;
Procedure DumpCS(var GPU_REGS:TGPU_REGS);
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
F:THandle;
fname:RawByteString;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
base:=getCodeAddress(GPU_REGS.SPI.CS.LO,GPU_REGS.SPI.CS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.CS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_cs_'+HexStr(hash,8)+'.dump';
CreateDir('shader_dump');
F:=FileCreate(fname);
DUMP_BLOCK(F,mmCOMPUTE_PGM_LO,base,size);
DUMP_BLOCK(F,mmCOMPUTE_PGM_RSRC1 ,@GPU_REGS.SPI.CS.RSRC1 ,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_PGM_RSRC2 ,@GPU_REGS.SPI.CS.RSRC2 ,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_NUM_THREAD_X,@GPU_REGS.SPI.CS.NUM_THREAD_X,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_NUM_THREAD_Y,@GPU_REGS.SPI.CS.NUM_THREAD_Y,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_NUM_THREAD_Z,@GPU_REGS.SPI.CS.NUM_THREAD_Z,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmCOMPUTE_USER_DATA_0+i,@GPU_REGS.SPI.CS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.CS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmCOMPUTE_USER_DATA_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_BLOCK(F,mmCOMPUTE_STATIC_THREAD_MGMT_SE0,@GPU_REGS.SPI.CS.STATIC_THREAD_MGMT_SE0,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_STATIC_THREAD_MGMT_SE1,@GPU_REGS.SPI.CS.STATIC_THREAD_MGMT_SE1,SizeOf(DWORD));
DUMP_BLOCK(F,mmCOMPUTE_RESOURCE_LIMITS ,@GPU_REGS.SPI.CS.RESOURCE_LIMITS ,SizeOf(DWORD));
FileClose(F);
end;
end;
Procedure DumpPS(var GPU_REGS:TGPU_REGS);
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
F:THandle;
fname:RawByteString;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
base:=getCodeAddress(GPU_REGS.SPI.PS.LO,GPU_REGS.SPI.PS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.PS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_ps_'+HexStr(hash,8)+'.dump';
CreateDir('shader_dump');
F:=FileCreate(fname);
DUMP_BLOCK(F,mmSPI_SHADER_PGM_LO_PS,base,size);
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC1_PS,@GPU_REGS.SPI.PS.RSRC1,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC2_PS,@GPU_REGS.SPI.PS.RSRC2,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC3_PS,@GPU_REGS.SPI.PS.RSRC3,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_Z_FORMAT ,@GPU_REGS.SPI.PS.Z_FORMAT ,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_COL_FORMAT ,@GPU_REGS.SPI.PS.COL_FORMAT,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_PS_INPUT_ENA ,@GPU_REGS.SPI.PS.INPUT_ENA ,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_PS_INPUT_ADDR ,@GPU_REGS.SPI.PS.INPUT_ADDR,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_PS_IN_CONTROL ,@GPU_REGS.SPI.PS.IN_CONTROL,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_BARYC_CNTL ,@GPU_REGS.SPI.PS.BARYC_CNTL,SizeOf(DWORD));
DUMP_BLOCK(F,mmDB_SHADER_CONTROL ,@GPU_REGS.SPI.PS.SHADER_CONTROL,SizeOf(DWORD));
DUMP_BLOCK(F,mmCB_SHADER_MASK ,@GPU_REGS.SPI.PS.SHADER_MASK ,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_PS_0+i,@GPU_REGS.SPI.PS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.PS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_PS_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_BLOCK(F,mmSPI_PS_INPUT_CNTL_0,@GPU_REGS.SPI.PS.INPUT_CNTL_0,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_PS_INPUT_CNTL_1,@GPU_REGS.SPI.PS.INPUT_CNTL_1,SizeOf(DWORD));
FileClose(F);
end;
end;
Procedure DumpVS(var GPU_REGS:TGPU_REGS);
var
i:Integer;
size,hash:DWORD;
base,Fetch:Pointer;
F:THandle;
fname:RawByteString;
USEAGE_DATA:TUSER_DATA_USEAGE;
begin
base:=getCodeAddress(GPU_REGS.SPI.VS.LO,GPU_REGS.SPI.VS.HI);
if (base<>nil) then
begin
size:=_calc_shader_size(base);
_calc_usage(_calc_shader_info(base),GPU_REGS.SPI.VS.USER_DATA,USEAGE_DATA);
hash:=FastHash(base,size);
fname:='shader_dump\'+get_dev_progname+'_vs_'+HexStr(hash,8)+'.dump';
CreateDir('shader_dump');
F:=FileCreate(fname);
DUMP_BLOCK(F,mmSPI_SHADER_PGM_LO_VS,base,size);
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC1_VS,@GPU_REGS.SPI.VS.RSRC1,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC2_VS,@GPU_REGS.SPI.VS.RSRC2,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_PGM_RSRC3_VS,@GPU_REGS.SPI.VS.RSRC3,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_VS_OUT_CONFIG ,@GPU_REGS.SPI.VS.OUT_CONFIG,SizeOf(DWORD));
DUMP_BLOCK(F,mmSPI_SHADER_POS_FORMAT,@GPU_REGS.SPI.VS.POS_FORMAT,SizeOf(DWORD));
DUMP_BLOCK(F,mmPA_CL_VS_OUT_CNTL ,@GPU_REGS.SPI.VS.OUT_CNTL ,SizeOf(DWORD));
For i:=0 to 15 do
begin
Case USEAGE_DATA[i] of
0:DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_VS_0+i,@GPU_REGS.SPI.VS.USER_DATA[i],SizeOf(DWORD));
2:
begin
Fetch:=getFetchAddress(@GPU_REGS.SPI.VS.USER_DATA[i]);
if (Fetch<>nil) then
begin
size:=_calc_shader_size(Fetch,0,True);
DUMP_BLOCK(F,mmSPI_SHADER_USER_DATA_VS_0+i,Fetch,size);
end;
end;
end;
end;
DUMP_BLOCK(F,mmVGT_NUM_INSTANCES ,@GPU_REGS.VGT_NUM_INSTANCES,SizeOf(DWORD));
FileClose(F);
end;
end;
end.

6128
chip/si_ci_vi_merged_enum.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2472
chip/si_ci_vi_merged_offset.pas Normal file
View File

File diff suppressed because it is too large Load Diff

8590
chip/si_ci_vi_merged_registers.pas Normal file
View File

File diff suppressed because it is too large Load Diff

142
fpPS4.lpi Normal file
View File

@ -0,0 +1,142 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fpPS4"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="fpPS4.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="ps4_elf_tls.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="ps4_libkerenel\ps4_rwlock.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="ps4_libkerenel\ps4_time.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="ps4_libkerenel\ps4_pthread.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="ps4_libsceuserservice.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceUserService"/>
</Unit5>
<Unit6>
<Filename Value="ps4_libkerenel\ps4_kernel_file.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="ps4_libscesavedata.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceSaveData"/>
</Unit7>
<Unit8>
<Filename Value="ps4_libscenptrophy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceNpTrophy"/>
</Unit8>
<Unit9>
<Filename Value="ps4_libkerenel\ps4_queue.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
<Unit10>
<Filename Value="chip\ps4_gpu_regs.pas"/>
<IsPartOfProject Value="True"/>
</Unit10>
<Unit11>
<Filename Value="chip\shader_dump.pas"/>
<IsPartOfProject Value="True"/>
</Unit11>
<Unit12>
<Filename Value="ps4_libscehttp.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceHttp"/>
</Unit12>
<Unit13>
<Filename Value="ps4_libscenet.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ps4_libSceNet"/>
</Unit13>
<Unit14>
<Filename Value="vulkan\vRender.pas"/>
<IsPartOfProject Value="True"/>
</Unit14>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fpPS4"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="ps4_libkerenel;vulkan;chip"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<RelocatableUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<LinkSmart Value="True"/>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

290
fpPS4.lpr Normal file
View File

@ -0,0 +1,290 @@
uses
{$IFDEF Linux}
cmem,
cthreads,
{$ENDIF}
seh64,
Classes,sysutils,
stub_manager,
ps4libdoc,
ps4_libSceNet,
ps4_libSceHttp,
ps4_libSceGnmDriver,
ps4_libSceNpScore,
ps4_libSceNpTrophy,
ps4_libSceSystemService,
ps4_libSceNpManager,
ps4_libSceSaveData,
ps4_libSceDialogs,
ps4_libSceUserService,
ps4_libsceaudioout,
ps4_libSceVideoOut,
ps4_libScePad,
ps4_libkernel,
ps4_types,
ps4_elf,
ps4_pthread,
ps4_program,
ps4_elf_tls;
function ParseCmd:Boolean;
var
i,n:Integer;
label
promo;
begin
if (ParamCount=0) then
begin
promo:
Writeln('PS4 compatibility layer (emulator) on Free Pascal '+{$I %FPCVERSION%});
Writeln(' Parameters:');
Writeln(' -e <name> //decrypted elf or self file name');
Writeln(' -f <name> //folder of app');
Writeln(' -s <name> //savedata path');
Exit(False);
end;
n:=-1;
For i:=1 to ParamCount do
begin
case LowerCase(ParamStr(i)) of
'-e':n:=0;
'-f':n:=1;
'-s':n:=2;
else
if (n<>-1) then
begin
Case n of
0:begin
if (ps4_app.app_file<>'') then Goto promo;
ps4_app.app_file:=Trim(ParamStr(i));
if (ps4_app.app_path='') then
begin
ps4_app.app_path:=ExtractFileDir(ps4_app.app_file);
if (ExcludeLeadingPathDelimiter(ps4_app.app_path)='') then ps4_app.app_path:=GetCurrentDir;
end;
end;
1:begin
ps4_app.app_path:=Trim(ParamStr(i));
if (ExcludeLeadingPathDelimiter(ps4_app.app_path)='') then ps4_app.app_path:=GetCurrentDir;
end;
2:begin
ps4_app.save_path:=Trim(ParamStr(i));
end;
end;
n:=-1;
end;
end;
end;
if (ps4_app.app_file='') or (ps4_app.app_path='') or (ps4_app.save_path='') then Goto promo;
if not FileExists(ps4_app.app_file) then
begin
Writeln('File not found:',ps4_app.app_file);
Writeln;
Goto promo;
end;
if not DirectoryExists(ps4_app.app_path) then
begin
Writeln('Path not found:',ps4_app.app_path);
Writeln;
Goto promo;
end;
if not DirectoryExists(ps4_app.save_path) then
begin
Writeln('Path not found:',ps4_app.save_path);
Writeln;
Goto promo;
end;
Result:=True;
end;
{
type
_TElf_node=class(TElf_node)
end;
procedure Print_libs(node:TElf_node);
var
i,l:SizeInt;
lib:PLIBRARY;
begin
l:=Length(_TElf_node(node).aLibs);
if (l<>0) then
begin
For i:=0 to l-1 do
begin
lib:=_TElf_node(node).aLibs[i];
Writeln(hexStr(lib));
if lib<>nil then
Writeln(lib^.Import,' ',lib^.strName);
end;
end;
end;
}
var
Stub:TStubMemoryProc;
procedure _nop_stub; assembler; nostackframe;
asm
xor %rax,%rax
end;
procedure print_stub(nid:QWORD;lib:PLIBRARY);
begin
Writeln('nop nid:',lib^.strName,':',HexStr(nid,16),':',ps4libdoc.GetFunctName(nid));
writeln;
//readln;
//Print_libs(ps4_app.GetFile('libc.prx'));
end;
function ps4_sceSslInit(poolSize:size_t):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSslInit:',poolSize);
Result:=3;
end;
function ResolveImport(elf:Telf_file;Info:PResolveImportInfo;data:Pointer):Pointer;
var
lib:PLIBRARY;
begin
Result:=nil;
//cache
Result:=Info^.lib^.get_proc(Info^.nid);
if (Result<>nil) then
begin
//Writeln('Cache^:',Info^.lib^.strName,':',ps4libdoc.GetFunctName(Info^.Nid));
Exit;
end;
lib:=ps4_app.GetLib(Info^.lib^.strName);
if (lib<>nil) then
begin
Result:=lib^.get_proc(Info^.Nid);
end;
if (Result=nil) then
begin
Case Info^.lib^.strName of
'libSceSsl':
Case Info^.nid of
$85DA551140C55B7B:Result:=@ps4_sceSslInit;
end;
end;
end;
if (Result=nil) then
begin
if (Info^.sType=STT_FUN) then
begin
Result:=Stub.NewNopStub(Info^.Nid,Info^.lib,@print_stub);
//Writeln('Warn^:',Info^.lib^.strName,':',ps4libdoc.GetFunctName(Info^.Nid),':',HexStr(Info^.Nid,16));
end else
begin
//PNAME = 'module_stop',
//_MD = $11af200,
//LIB = $114e110,
//NID = 0,
//OFFSET = 311584,
//RTYPE = 7, //R_X86_64_JUMP_SLOT
//SBIND = 2, //STB_WEAK
//STYPE = 0} //STT_NOTYPE
Writeln('Warn^:',Info^.lib^.strName,':',ps4libdoc.GetFunctName(Info^.Nid),':',HexStr(Info^.Nid,16));
end;
end;
if (Result<>nil) then //cache
begin
Info^.lib^.set_proc(Info^.nid,Result);
end;
end;
var
elf:Telf_file;
//i:Integer;
//F:THandle;
main:pthread;
begin
DefaultSystemCodePage:=CP_UTF8;
DefaultUnicodeCodePage:=CP_UTF8;
DefaultFileSystemCodePage:=CP_UTF8;
DefaultRTLFileSystemCodePage:=CP_UTF8;
UTF8CompareLocale:=CP_UTF8;
ps4_app.save_path:=IncludeTrailingPathDelimiter(GetCurrentDir)+'savedata';
if not ParseCmd then Exit;
//ps4_app.app_path:='..\samples\api_gnm\simplet-single-triangle';
//ps4_app.app_file:='..\samples\api_gnm\simplet-single-triangle\simplet-single-triangle_debug.elf';
//ps4_app.app_file:='..\samples\api_gnm\simplet-cmask\simplet-cmask_debug.elf';
//ps4_app.app_path:='..\samples\api_gnm\simplet-simple-fs\';
//ps4_app.app_file:='..\samples\api_gnm\simplet-simple-fs\simplet-simple-fs_debug.elf';
//ps4_app.app_path:='..\samples\tutorial_graphics_programming\basic_quad\';
//ps4_app.app_file:='..\samples\tutorial_graphics_programming\basic_quad\basic_quad_debug.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_cursor.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_flip.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic2.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic3.elf';
//ps4_app.app_file:='..\samples\api_video_out\videoout_basic5.elf';
//ps4_app.app_path:='G:\Games\MOMODORA\CUSA05694\';
//ps4_app.app_file:='G:\Games\MOMODORA\CUSA05694\eboot.bin';
//ps4_app.app_path:='G:\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\';
//ps4_app.app_file:='G:\Games\We.Are.Doomed.PS4-PRELUDE\CUSA02394\eboot.elf';
//Writeln(_parse_filename('/app0/data/system_ps4/flatShader_vv.sb'));
//Writeln(_parse_filename('savedata0/11/../app.prf'));
//elf:=Telf_file(LoadPs4ElfFromFile('libSceLibcInternal.sprx'));
//elf.Prepare;
//elf.SavePs4ElfToFile('libSceLibcInternal.prx');
//F:=FileCreate('libSceLibcInternal.txt');
//elf.DympSymbol(F);
//FileClose(F);
//FreeAndNil(elf);
elf:=Telf_file(LoadPs4ElfFromFile(ps4_app.app_file));
elf.Prepare;
ps4_app.prog:=elf;
ps4_app.RegistredElf(elf);
ps4_app.ResolveDepended(elf);
ps4_app.LoadSymbolImport(@ResolveImport,nil);
Stub.FinStub;
ps4_app.InitProt;
ps4_app.InitThread;
_pthread_run_entry(@main);
//ps4_app.InitCode;
//elf.mapCodeEntry;
ps4_libSceVideoOut.App_Run;
//KillALLThreads TODO
//readln;
end.

1007
g23tree.pas Normal file
View File

File diff suppressed because it is too large Load Diff

989
hamt.pas Normal file
View File

@ -0,0 +1,989 @@
{ Simplified implementation of HAMT (Hash Array Mapped Trie) with 32bit/64bit hash key.
Specific hash functions and collision resolution are outside the scope of
this implementation and can be implemented on top of it.
Copyright (C) 2021 Red_prig
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
}
unit hamt;
{$mode objfpc}{$H+}
interface
type
THAMT=type Pointer;
Tfree_data_cb=procedure(data,userdata:Pointer);
function HAMT_create32:THAMT;
function HAMT_clear32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
function HAMT_destroy32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
function HAMT_search32(hamt:THAMT;key:DWORD):PPointer; //mutable link to data
function HAMT_insert32(hamt:THAMT;key:DWORD;data:Pointer):PPointer; //mutable link to data
function HAMT_delete32(hamt:THAMT;key:DWORD):Pointer; //data
function HAMT_traverse32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
function HAMT_create64:THAMT;
function HAMT_clear64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
function HAMT_destroy64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
function HAMT_search64(hamt:THAMT;key:QWORD):PPointer; //mutable link to data
function HAMT_insert64(hamt:THAMT;key:QWORD;data:Pointer):PPointer; //mutable link to data
function HAMT_delete64(hamt:THAMT;key:QWORD):Pointer; //data
function HAMT_traverse64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
type
// [7] [5]*5 =32
HAMT32=object
type
TBitKey=DWORD;
const
node_size=SizeOf(TBitKey)*TBitKey(8);
node_mask=TBitKey(node_size)-TBitKey(1);
node_bits=PopCnt(TBitKey(node_mask));
root_bits=(TBitKey(node_size) mod TBitKey(node_bits))+TBitKey(node_bits);
root_size=TBitKey(1) shl TBitKey(root_bits);
root_mask=TBitKey(root_size)-TBitKey(1);
const_one=TBitKey(1);
const_max=not TBitKey(0);
stack_max=(TBitKey(node_size) div TBitKey(node_bits));
end;
//[10] [6]*9 =64
HAMT64=object
type
TBitKey=QWORD;
const
node_size=SizeOf(TBitKey)*TBitKey(8);
node_mask=TBitKey(node_size)-TBitKey(1);
node_bits=PopCnt(TBitKey(node_mask));
root_bits=(TBitKey(node_size) mod TBitKey(node_bits))+TBitKey(node_bits);
root_size=TBitKey(1) shl TBitKey(root_bits);
root_mask=TBitKey(root_size)-TBitKey(1);
const_one=TBitKey(1);
const_max=not TBitKey(0);
stack_max=(TBitKey(node_size) div TBitKey(node_bits));
end;
type
PHAMTNode32=^THAMTNode32;
THAMTNode32=packed record
BitMapKey:DWORD;
BaseValue:Pointer;
end;
PHAMTNode64=^THAMTNode64;
THAMTNode64=packed record
BitMapKey:QWORD;
BaseValue:Pointer;
end;
TSTUB_HAMT32=array[0..HAMT32.root_size-1] of THAMTNode32;
TSTUB_HAMT64=array[0..HAMT64.root_size-1] of THAMTNode64;
implementation
function IsSubTrie32(n:PHAMTNode32):Boolean; inline;
begin
Result:=(PtrUint(n^.BaseValue) and 1)<>0;
end;
function IsSubTrie64(n:PHAMTNode64):Boolean; inline;
begin
Result:=(PtrUint(n^.BaseValue) and 1)<>0;
end;
procedure SetSubTrie32(n:PHAMTNode32;v:PHAMTNode32); inline;
begin
Assert((PtrUint(v) and 1)=0);
PtrUint(n^.BaseValue):=PtrUint(v) or 1;
end;
procedure SetSubTrie64(n:PHAMTNode64;v:PHAMTNode64); inline;
begin
Assert((PtrUint(v) and 1)=0);
PtrUint(n^.BaseValue):=PtrUint(v) or 1;
end;
procedure SetValue32(n:PHAMTNode32;v:Pointer); inline;
begin
Assert((PtrUint(v) and 1)=0);
n^.BaseValue:=v;
end;
procedure SetValue64(n:PHAMTNode64;v:Pointer); inline;
begin
Assert((PtrUint(v) and 1)=0);
n^.BaseValue:=v;
end;
function GetSubTrie32(n:PHAMTNode32):PHAMTNode32; inline;
begin
PtrUint(Result):=(PtrUint(n^.BaseValue) or 1) xor 1;
end;
function GetSubTrie64(n:PHAMTNode64):PHAMTNode64; inline;
begin
PtrUint(Result):=(PtrUint(n^.BaseValue) or 1) xor 1;
end;
function GetValue32(n:PHAMTNode32):Pointer; inline;
begin
Result:=n^.BaseValue;
end;
function GetValue64(n:PHAMTNode64):Pointer; inline;
begin
Result:=n^.BaseValue;
end;
function GetMutableValue32(n:PHAMTNode32):PPointer; inline;
begin
Result:=@n^.BaseValue;
end;
function GetMutableValue64(n:PHAMTNode64):PPointer; inline;
begin
Result:=@n^.BaseValue;
end;
function GetBitMapSize32(BitKey:DWORD):DWORD; inline;
begin
Result:=PopCnt(BitKey);
Result:=Result and HAMT32.node_mask;
if (Result=0) then Result:=HAMT32.node_size;
end;
function GetBitMapSize64(BitKey:QWORD):QWORD; inline;
begin
Result:=PopCnt(BitKey);
Result:=Result and HAMT64.node_mask;
if (Result=0) then Result:=HAMT64.node_size;
end;
function BitIsNotSet32(BitKey,keypart:DWORD):Boolean; inline;
begin
Result:=(BitKey and (HAMT32.const_one shl keypart))=0;
end;
function BitIsNotSet64(BitKey,keypart:QWORD):Boolean; inline;
begin
Result:=(BitKey and (HAMT64.const_one shl keypart))=0;
end;
function SetBitInSet32(BitKey,keypart:DWORD):DWORD; inline;
begin
Result:=BitKey or (HAMT32.const_one shl keypart);
end;
function SetBitInSet64(BitKey,keypart:QWORD):QWORD; inline;
begin
Result:=BitKey or (HAMT64.const_one shl keypart);
end;
function UnSetBitInSet32(BitKey,keypart:DWORD):DWORD; inline;
begin
Result:=BitKey and (not (HAMT32.const_one shl keypart));
end;
function UnSetBitInSet64(BitKey,keypart:QWORD):QWORD; inline;
begin
Result:=BitKey and (not (HAMT64.const_one shl keypart));
end;
function GetMapPos32(BitKey,keypart:DWORD):DWORD; inline;
begin
Result:=PopCnt(BitKey and (not DWORD(HAMT32.const_max shl keypart)));
Result:=Result and HAMT32.node_mask; //Clamp
end;
function GetMapPos64(BitKey,keypart:QWORD):QWORD; inline;
begin
Result:=PopCnt(BitKey and (not QWORD(HAMT64.const_max shl keypart)));
Result:=Result and HAMT64.node_mask; //Clamp
end;
function HAMT_create32:THAMT;
begin
Result:=AllocMem(HAMT32.root_size*SizeOf(THAMTNode32));
end;
function HAMT_create64:THAMT;
begin
Result:=AllocMem(HAMT64.root_size*SizeOf(THAMTNode64));
end;
procedure HAMT_delete_trie32(node:PHAMTNode32;cb:Tfree_data_cb;userdata:Pointer); inline;
type
PStackNode=^TStackNode;
TStackNode=packed record
bnode,cnode,enode:PHAMTNode32;
end;
var
curr:PStackNode;
data:array[0..HAMT32.stack_max] of TStackNode;
Size:DWORD;
begin
if IsSubTrie32(node) then
begin
curr:=@data;
Size:=GetBitMapSize32(node^.BitMapKey);
With curr^ do
begin
bnode:=GetSubTrie32(node);
cnode:=bnode;
enode:=@bnode[Size];
end;
repeat
if (curr^.cnode>=curr^.enode) then
begin
FreeMem(curr^.bnode);
if (curr=@data) then Break;
Dec(curr);
Inc(curr^.cnode);
Continue;
end;
if IsSubTrie32(curr^.cnode) then
begin
node:=curr^.cnode;
Inc(curr);
Size:=GetBitMapSize32(node^.BitMapKey);
With curr^ do
begin
bnode:=GetSubTrie32(node);
cnode:=bnode;
enode:=@bnode[Size];
end;
end else
begin
if (cb<>nil) then
cb(GetValue32(curr^.cnode),userdata);
Inc(curr^.cnode);
end;
until false;
end else
begin
if (cb<>nil) then
cb(GetValue32(node),userdata);
end;
end;
procedure HAMT_delete_trie64(node:PHAMTNode64;cb:Tfree_data_cb;userdata:Pointer); inline;
type
PStackNode=^TStackNode;
TStackNode=packed record
bnode,cnode,enode:PHAMTNode64;
end;
var
curr:PStackNode;
data:array[0..HAMT64.stack_max] of TStackNode;
Size:QWORD;
begin
if IsSubTrie64(node) then
begin
curr:=@data;
Size:=GetBitMapSize64(node^.BitMapKey);
With curr^ do
begin
bnode:=GetSubTrie64(node);
cnode:=bnode;
enode:=@bnode[Size];
end;
repeat
if (curr^.cnode>=curr^.enode) then
begin
FreeMem(curr^.bnode);
if (curr=@data) then Break;
Dec(curr);
Inc(curr^.cnode);
Continue;
end;
if IsSubTrie64(curr^.cnode) then
begin
node:=curr^.cnode;
Inc(curr);
Size:=GetBitMapSize64(node^.BitMapKey);
With curr^ do
begin
bnode:=GetSubTrie64(node);
cnode:=bnode;
enode:=@bnode[Size];
end;
end else
begin
if (cb<>nil) then
cb(GetValue64(curr^.cnode),userdata);
Inc(curr^.cnode);
end;
until false;
end else
begin
if (cb<>nil) then
cb(GetValue64(node),userdata);
end;
end;
function HAMT_clear32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
var
i:Integer;
begin
if (hamt=nil) then Exit(False);
For i:=0 to HAMT32.root_mask do
begin
HAMT_delete_trie32(@PHAMTNode32(hamt)[i],cb,userdata);
end;
FillChar(hamt^,HAMT32.root_size*SizeOf(THAMTNode32),0);
Result:=True;
end;
function HAMT_clear64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
var
i:Integer;
begin
if (hamt=nil) then Exit(False);
For i:=0 to HAMT64.root_mask do
begin
HAMT_delete_trie64(@PHAMTNode64(hamt)[i],cb,userdata);
end;
FillChar(hamt^,HAMT64.root_size*SizeOf(THAMTNode64),0);
Result:=True;
end;
procedure HAMT_traverse_trie32(node:PHAMTNode32;cb:Tfree_data_cb;userdata:Pointer); inline;
type
PStackNode=^TStackNode;
TStackNode=packed record
cnode,enode:PHAMTNode32;
end;
var
curr:PStackNode;
data:array[0..HAMT32.stack_max] of TStackNode;
Size:QWORD;
begin
if IsSubTrie32(node) then
begin
curr:=@data;
Size:=GetBitMapSize32(node^.BitMapKey);
With curr^ do
begin
cnode:=GetSubTrie32(node);
enode:=@cnode[Size];
end;
repeat
if (curr^.cnode>=curr^.enode) then
begin
if (curr=@data) then Break;
Dec(curr);
Inc(curr^.cnode);
Continue;
end;
if IsSubTrie32(curr^.cnode) then
begin
node:=curr^.cnode;
Inc(curr);
Size:=GetBitMapSize32(node^.BitMapKey);
With curr^ do
begin
cnode:=GetSubTrie32(node);
enode:=@cnode[Size];
end;
end else
begin
if (cb<>nil) then
cb(GetValue32(curr^.cnode),userdata);
Inc(curr^.cnode);
end;
until false;
end else
begin
if (cb<>nil) then
cb(GetValue32(node),userdata);
end;
end;
procedure HAMT_traverse_trie64(node:PHAMTNode64;cb:Tfree_data_cb;userdata:Pointer); inline;
type
PStackNode=^TStackNode;
TStackNode=packed record
cnode,enode:PHAMTNode64;
end;
var
curr:PStackNode;
data:array[0..HAMT64.stack_max] of TStackNode;
Size:QWORD;
begin
if IsSubTrie64(node) then
begin
curr:=@data;
Size:=GetBitMapSize64(node^.BitMapKey);
With curr^ do
begin
cnode:=GetSubTrie64(node);
enode:=@cnode[Size];
end;
repeat
if (curr^.cnode>=curr^.enode) then
begin
if (curr=@data) then Break;
Dec(curr);
Inc(curr^.cnode);
Continue;
end;
if IsSubTrie64(curr^.cnode) then
begin
node:=curr^.cnode;
Inc(curr);
Size:=GetBitMapSize64(node^.BitMapKey);
With curr^ do
begin
cnode:=GetSubTrie64(node);
enode:=@cnode[Size];
end;
end else
begin
if (cb<>nil) then
cb(GetValue64(curr^.cnode),userdata);
Inc(curr^.cnode);
end;
until false;
end else
begin
if (cb<>nil) then
cb(GetValue64(node),userdata);
end;
end;
function HAMT_traverse32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
var
i:Integer;
begin
if (hamt=nil) then Exit(False);
For i:=0 to HAMT32.root_mask do
begin
HAMT_traverse_trie32(@PHAMTNode32(hamt)[i],cb,userdata);
end;
Result:=True;
end;
function HAMT_traverse64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
var
i:Integer;
begin
if (hamt=nil) then Exit(False);
For i:=0 to HAMT64.root_mask do
begin
HAMT_traverse_trie64(@PHAMTNode64(hamt)[i],cb,userdata);
end;
Result:=True;
end;
function HAMT_destroy32(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
begin
Result:=HAMT_clear32(hamt,cb,userdata);
FreeMem(hamt);
end;
function HAMT_destroy64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
begin
Result:=HAMT_clear64(hamt,cb,userdata);
FreeMem(hamt);
end;
function HAMT_search32(hamt:THAMT;key:DWORD):PPointer;
var
node:PHAMTNode32;
keypart,Map:DWORD;
keypartbits:DWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT32.root_bits;
keypart:=key and HAMT32.root_mask;
node:=@PHAMTNode32(hamt)[keypart];
if (node^.BaseValue=nil) then Exit(nil);
repeat
if not IsSubTrie32(node) then
begin
if (node^.BitMapKey=key) then
begin
Exit(GetMutableValue32(node));
end else
Exit(nil);
end;
//Subtree: look up in bitmap
Assert(keypartbits<HAMT32.node_size);
keypart:=(key shr keypartbits) and HAMT32.node_mask;
if BitIsNotSet32(node^.BitMapKey,keypart) then
Exit(nil); // bit is 0 in bitmap -> no match
Map:=GetMapPos32(node^.BitMapKey,keypart);
// Go down a level */
node:=@GetSubTrie32(node)[Map];
keypartbits:=keypartbits+HAMT32.node_bits;
until false;
end;
function HAMT_search64(hamt:THAMT;key:QWORD):PPointer;
var
node:PHAMTNode64;
keypart,Map:QWORD;
keypartbits:QWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT64.root_bits;
keypart:=key and HAMT64.root_mask;
node:=@PHAMTNode64(hamt)[keypart];
if (node^.BaseValue=nil) then Exit(nil);
repeat
if not IsSubTrie64(node) then
begin
if (node^.BitMapKey=key) then
begin
Exit(GetMutableValue64(node));
end else
Exit(nil);
end;
//Subtree: look up in bitmap
Assert(keypartbits<HAMT64.node_size);
keypart:=(key shr keypartbits) and HAMT64.node_mask;
if BitIsNotSet64(node^.BitMapKey,keypart) then
Exit(nil); // bit is 0 in bitmap -> no match
Map:=GetMapPos64(node^.BitMapKey,keypart);
// Go down a level */
node:=@GetSubTrie64(node)[Map];
keypartbits:=keypartbits+HAMT64.node_bits;
until false;
end;
function HAMT_insert32(hamt:THAMT;key:DWORD;data:Pointer):PPointer;
var
node,oldnodes,newnodes:PHAMTNode32;
key2,keypart,keypart2,Map,Size:DWORD;
keypartbits:DWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT32.root_bits;
keypart:=key and HAMT32.root_mask;
node:=@PHAMTNode32(hamt)[keypart];
if (node^.BaseValue=nil) then
begin
node^.BitMapKey:=key;
SetValue32(node,data);
Assert(not IsSubTrie32(node));
Exit(GetMutableValue32(node));
end;
repeat
if not IsSubTrie32(node) then
begin
if (node^.BitMapKey=key) then
begin
Exit(GetMutableValue32(node));
end else
begin
key2:=node^.BitMapKey;
//build tree downward until keys differ
repeat
Assert(keypartbits<HAMT32.node_size);
keypart :=(key shr keypartbits) and HAMT32.node_mask;
keypart2:=(key2 shr keypartbits) and HAMT32.node_mask;
if (keypart=keypart2) then
begin
newnodes:=AllocMem(SizeOf(THAMTNode32));
Assert((PtrUint(newnodes) and 1)=0);
newnodes[0].BitMapKey:=key2;
newnodes[0].BaseValue:=node^.BaseValue;
node^.BitMapKey:=SetBitInSet32(0,keypart);
SetSubTrie32(node,newnodes);
node:=@newnodes[0];
end else
begin
newnodes:=AllocMem(2*SizeOf(THAMTNode32));
Assert((PtrUint(newnodes) and 1)=0);
if (keypart2<keypart) then
begin
newnodes[0].BitMapKey:=key2;
newnodes[0].BaseValue:=node^.BaseValue;
newnodes[1].BitMapKey:=key;
SetValue32(@newnodes[1],data);
Result:=GetMutableValue32(@newnodes[1]);
end else
begin
newnodes[0].BitMapKey:=key;
SetValue32(@newnodes[0],data);
Result:=GetMutableValue32(@newnodes[0]);
newnodes[1].BitMapKey:=key2;
newnodes[1].BaseValue:=node^.BaseValue;
end;
node^.BitMapKey:=(HAMT32.const_one shl keypart) or (HAMT32.const_one shl keypart2);
SetSubTrie32(node,newnodes);
Exit;
end;
keypartbits:=keypartbits+HAMT32.node_bits;
until false;
end;
end; //if not IsSubTrie(node) then
Assert(keypartbits<HAMT32.node_size);
keypart:=(key shr keypartbits) and HAMT32.node_mask;
if BitIsNotSet32(node^.BitMapKey,keypart) then
begin
// bit is 0 in bitmap -> add node to table
node^.BitMapKey:=SetBitInSet32(node^.BitMapKey,keypart);
Size:=GetBitMapSize32(node^.BitMapKey);
Map:=GetMapPos32(node^.BitMapKey,keypart);
oldnodes:=GetSubTrie32(node);
if (MemSize(oldnodes)>=(Size*SizeOf(THAMTNode32))) then
begin
newnodes:=oldnodes;
Move(oldnodes[Map],newnodes[Map+1],(Size-Map-1)*SizeOf(THAMTNode32));
end else
begin
newnodes:=AllocMem(Size*SizeOf(THAMTNode32));
Assert((PtrUint(newnodes) and 1)=0);
Move(oldnodes[0] ,newnodes[0] , Map*SizeOf(THAMTNode32));
Move(oldnodes[Map],newnodes[Map+1],(Size-Map-1)*SizeOf(THAMTNode32));
FreeMem(oldnodes);
SetSubTrie32(node,newnodes);
end;
// Set up new node
newnodes[Map].BitMapKey:=key;
SetValue32(@newnodes[Map],data);
Exit(GetMutableValue32(@newnodes[Map]));
end;
Map:=GetMapPos32(node^.BitMapKey,keypart);
// Go down a level */
node:=@GetSubTrie32(node)[Map];
keypartbits:=keypartbits+HAMT32.node_bits;
until false;
end;
function HAMT_insert64(hamt:THAMT;key:QWORD;data:Pointer):PPointer;
var
node,oldnodes,newnodes:PHAMTNode64;
key2,keypart,keypart2,Map,Size:QWORD;
keypartbits:QWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT64.root_bits;
keypart:=key and HAMT64.root_mask;
node:=@PHAMTNode64(hamt)[keypart];
if (node^.BaseValue=nil) then
begin
node^.BitMapKey:=key;
SetValue64(node,data);
Assert(not IsSubTrie64(node));
Exit(GetMutableValue64(node));
end;
repeat
if not IsSubTrie64(node) then
begin
if (node^.BitMapKey=key) then
begin
Exit(GetMutableValue64(node));
end else
begin
key2:=node^.BitMapKey;
//build tree downward until keys differ
repeat
Assert(keypartbits<HAMT64.node_size);
keypart :=(key shr keypartbits) and HAMT64.node_mask;
keypart2:=(key2 shr keypartbits) and HAMT64.node_mask;
if (keypart=keypart2) then
begin
newnodes:=AllocMem(SizeOf(THAMTNode64));
Assert((PtrUint(newnodes) and 1)=0);
newnodes[0].BitMapKey:=key2;
newnodes[0].BaseValue:=node^.BaseValue;
node^.BitMapKey:=SetBitInSet64(0,keypart);
SetSubTrie64(node,newnodes);
node:=@newnodes[0];
end else
begin
newnodes:=AllocMem(2*SizeOf(THAMTNode64));
Assert((PtrUint(newnodes) and 1)=0);
if (keypart2<keypart) then
begin
newnodes[0].BitMapKey:=key2;
newnodes[0].BaseValue:=node^.BaseValue;
newnodes[1].BitMapKey:=key;
SetValue64(@newnodes[1],data);
Result:=GetMutableValue64(@newnodes[1]);
end else
begin
newnodes[0].BitMapKey:=key;
SetValue64(@newnodes[0],data);
Result:=GetMutableValue64(@newnodes[0]);
newnodes[1].BitMapKey:=key2;
newnodes[1].BaseValue:=node^.BaseValue;
end;
node^.BitMapKey:=(HAMT64.const_one shl keypart) or (HAMT64.const_one shl keypart2);
SetSubTrie64(node,newnodes);
Exit;
end;
keypartbits:=keypartbits+HAMT64.node_bits;
until false;
end;
end; //if not IsSubTrie(node) then
Assert(keypartbits<HAMT64.node_size);
keypart:=(key shr keypartbits) and HAMT64.node_mask;
if BitIsNotSet64(node^.BitMapKey,keypart) then
begin
// bit is 0 in bitmap -> add node to table
node^.BitMapKey:=SetBitInSet64(node^.BitMapKey,keypart);
Size:=GetBitMapSize64(node^.BitMapKey);
Map:=GetMapPos64(node^.BitMapKey,keypart);
oldnodes:=GetSubTrie64(node);
if (MemSize(oldnodes)>=(Size*SizeOf(THAMTNode64))) then
begin
newnodes:=oldnodes;
Move(oldnodes[Map],newnodes[Map+1],(Size-Map-1)*SizeOf(THAMTNode64));
end else
begin
newnodes:=AllocMem(Size*SizeOf(THAMTNode64));
Assert((PtrUint(newnodes) and 1)=0);
Move(oldnodes[0] ,newnodes[0] , Map*SizeOf(THAMTNode64));
Move(oldnodes[Map],newnodes[Map+1],(Size-Map-1)*SizeOf(THAMTNode64));
FreeMem(oldnodes);
SetSubTrie64(node,newnodes);
end;
// Set up new node
newnodes[Map].BitMapKey:=key;
SetValue64(@newnodes[Map],data);
Exit(GetMutableValue64(@newnodes[Map]));
end;
Map:=GetMapPos64(node^.BitMapKey,keypart);
// Go down a level */
node:=@GetSubTrie64(node)[Map];
keypartbits:=keypartbits+HAMT64.node_bits;
until false;
end;
function HAMT_delete32(hamt:THAMT;key:DWORD):Pointer;
var
prev,node,oldnodes,newnodes:PHAMTNode32;
keypart,Map,Size:DWORD;
keypartbits:DWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT32.root_bits;
prev:=nil;
Map:=0;
keypart:=key and HAMT32.root_mask;
node:=@PHAMTNode32(hamt)[keypart];
if (node^.BaseValue=nil) then Exit(nil);
repeat
if not IsSubTrie32(node) then
begin
if (node^.BitMapKey=key) then
begin
Result:=GetValue32(node);
node^:=Default(THAMTNode32);
if (prev=nil) then Exit;
node:=prev;
node^.BitMapKey:=UnSetBitInSet32(node^.BitMapKey,keypart);
Size:=GetBitMapSize32(node^.BitMapKey);
oldnodes:=GetSubTrie32(node);
if (Size=1) then
begin
if (Map=0) then
begin
node^:=oldnodes[1];
end else
begin
node^:=oldnodes[0];
end;
FreeMem(oldnodes);
end else
if ((2*Size*SizeOf(THAMTNode32))<=MemSize(oldnodes)) then
begin
newnodes:=AllocMem(Size*SizeOf(THAMTNode32));
Assert((PtrUint(newnodes) and 1)=0);
Move(oldnodes[0] ,newnodes[0] ,Map*SizeOf(THAMTNode32));
Move(oldnodes[Map+1],newnodes[Map],(Size-Map)*SizeOf(THAMTNode32));
FreeMem(oldnodes);
SetSubTrie32(node,newnodes);
end else
begin
Move(oldnodes[Map+1],oldnodes[Map],(Size-Map)*SizeOf(THAMTNode32));
end;
Exit;
end else
Exit(nil);
end;
//Subtree: look up in bitmap
Assert(keypartbits<HAMT32.node_size);
keypart:=(key shr keypartbits) and HAMT32.node_mask;
if BitIsNotSet32(node^.BitMapKey,keypart) then
Exit(nil); // bit is 0 in bitmap -> no match
Map:=GetMapPos32(node^.BitMapKey,keypart);
// Go down a level */
prev:=node;
node:=@GetSubTrie32(node)[Map];
keypartbits:=keypartbits+HAMT32.node_bits;
until false;
end;
function HAMT_delete64(hamt:THAMT;key:QWORD):Pointer;
var
prev,node,oldnodes,newnodes:PHAMTNode64;
keypart,Map,Size:QWORD;
keypartbits:QWORD;
begin
if (hamt=nil) then Exit(nil);
keypartbits:=HAMT64.root_bits;
prev:=nil;
Map:=0;
keypart:=key and HAMT64.root_mask;
node:=@PHAMTNode64(hamt)[keypart];
if (node^.BaseValue=nil) then Exit(nil);
repeat
if not IsSubTrie64(node) then
begin
if (node^.BitMapKey=key) then
begin
Result:=GetValue64(node);
node^:=Default(THAMTNode64);
if (prev=nil) then Exit;
node:=prev;
node^.BitMapKey:=UnSetBitInSet64(node^.BitMapKey,keypart);
Size:=GetBitMapSize64(node^.BitMapKey);
oldnodes:=GetSubTrie64(node);
if (Size=1) then
begin
if (Map=0) then
begin
node^:=oldnodes[1];
end else
begin
node^:=oldnodes[0];
end;
FreeMem(oldnodes);
end else
if ((2*Size*SizeOf(THAMTNode64))<=MemSize(oldnodes)) then
begin
newnodes:=AllocMem(Size*SizeOf(THAMTNode64));
Assert((PtrUint(newnodes) and 1)=0);
Move(oldnodes[0] ,newnodes[0] ,Map*SizeOf(THAMTNode64));
Move(oldnodes[Map+1],newnodes[Map],(Size-Map)*SizeOf(THAMTNode64));
FreeMem(oldnodes);
SetSubTrie64(node,newnodes);
end else
begin
Move(oldnodes[Map+1],oldnodes[Map],(Size-Map)*SizeOf(THAMTNode64));
end;
Exit;
end else
Exit(nil);
end;
//Subtree: look up in bitmap
Assert(keypartbits<HAMT64.node_size);
keypart:=(key shr keypartbits) and HAMT64.node_mask;
if BitIsNotSet64(node^.BitMapKey,keypart) then
Exit(nil); // bit is 0 in bitmap -> no match
Map:=GetMapPos64(node^.BitMapKey,keypart);
// Go down a level */
prev:=node;
node:=@GetSubTrie64(node)[Map];
keypartbits:=keypartbits+HAMT64.node_bits;
until false;
end;
end.

278
libportaudio.pas Normal file
View File

@ -0,0 +1,278 @@
{ Header for libportaudio
Copyright (C) 2021 Red_prig
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version with the following modification:
As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,and
to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify
this library, you may extend this exception to your version of the library,
but you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
}
unit libportaudio;
{$mode objfpc}{$H+}
{$PACKRECORDS C}
interface
uses
{$if defined(USE_STATIC_PORTAUDIO) and defined(WINDOWS)}
libaudio_static,
{$ENDIF}
CTypes;
{$ifdef USE_STATIC_PORTAUDIO}
{$Linklib libportaudio.a, static}
{$IFDEF unix}
{$Linklib libasound}
{$Linklib libpthread}
{$Linklib libm}
{$Linklib libc}
{$ENDIF}
{$endif}
Const
{$IFDEF unix}
{$IFDEF darwin}
libname='libportaudio.2.dylib';
{$ELSE}
libname='libportaudio.so.2';
{$ENDIF}
{$ELSE}
libname='libportaudio-2.dll';
{$ENDIF}
type
PaError = CInt32;
PaErrorCode =(
paNotInitialized := -10000,
paUnanticipatedHostError,
paInvalidChannelCount,
paInvalidSampleRate,
paInvalidDevice,
paInvalidFlag,
paSampleFormatNotSupported,
paBadIODeviceCombination,
paInsufficientMemory,
paBufferTooBig,
paBufferTooSmall,
paNullCallback,
paBadStreamPtr,
paTimedOut,
paInternalError,
paDeviceUnavailable,
paIncompatibleHostApiSpecificStreamInfo,
paStreamIsStopped,
paStreamIsNotStopped,
paInputOverflowed,
paOutputUnderflowed,
paHostApiNotFound,
paInvalidHostApi,
paCanNotReadFromACallbackStream,
paCanNotWriteToACallbackStream,
paCanNotReadFromAnOutputOnlyStream,
paCanNotWriteToAnInputOnlyStream,
paIncompatibleStreamHostApi,
paBadBufferPtr,
paNoError := 0
);
PaDeviceIndex = CInt32;
PaHostApiIndex = CInt32;
PaHostApiTypeId =(paInDevelopment := 0,
paDirectSound := 1,
paMME := 2,
paASIO := 3,
paSoundManager := 4,
paCoreAudio := 5,
paOSS := 7,
paALSA := 8,
paAL := 9,
paBeOS := 10,
paWDMKS := 11,
paJACK := 12,
paWASAPI := 13,
paAudioScienceHPI := 14
);
PaHostApiInfo = record
structVersion : CInt32;
_type : PaHostApiTypeId ;
_name : Pchar;
deviceCount : CInt32;
defaultInputDevice : PaDeviceIndex;
defaultOutputDevice : PaDeviceIndex;
end;
PPaHostApiInfo = ^PaHostApiInfo;
PaHostErrorInfo = record
hostApiType : PaHostApiTypeId;
errorCode : CLong;
errorText : PChar;
end;
PPaHostErrorInfo = ^PaHostErrorInfo;
PaTime = CDouble;
PaSampleFormat = pCULongLong;
PaDeviceInfo = record
structVersion : CInt32;
_name : PChar;
hostApi : PaHostApiIndex;
maxInputChannels : CInt32;
maxOutputChannels : CInt32;
defaultLowInputLatency : PaTime;
defaultLowOutputLatency : PaTime;
defaultHighInputLatency : PaTime;
defaultHighOutputLatency : PaTime;
defaultSampleRate : CDouble;
end;
PPaDeviceInfo = ^PaDeviceInfo;
PaStreamParameters = record
device : PaDeviceIndex;
channelCount : CInt32;
sampleFormat : PaSampleFormat;
suggestedLatency : PaTime;
hostApiSpecificStreamInfo : Pointer;
end;
PPaStreamParameters = ^PaStreamParameters;
PaStream = Pointer;
PPaStream = ^PaStream;
PPPaStream = ^PPaStream;
PaStreamFlags = CULong;
PaStreamCallbackTimeInfo = record
inputBufferAdcTime : PaTime;
currentTime : PaTime;
outputBufferDacTime : PaTime;
end;
PaStreamCallbackFlags = CULong;
PaStreamCallbackResult =(
paContinue := 0,
paComplete := 1,
paAbort := 2);
PaStreamCallback = function(
input : Pointer;
output : Pointer;
frameCount : CULong;
timeInfo : PaStreamCallbackTimeInfo;
statusFlags : PaStreamCallbackFlags;
userData : Pointer) : CInt32;
PaStreamFinishedCallback = procedure(userData : Pointer);
PaStreamInfo = record
structVersion : CInt32;
inputLatency : PaTime;
outputLatency : PaTime;
sampleRate : CDouble;
end;
PPaStreamInfo = ^PaStreamInfo;
const
paFormatIsSupported = 0;
paFramesPerBufferUnspecified = 0;
paNoDevice = PaDeviceIndex(-1);
paUseHostApiSpecificDeviceSpecification = PaDeviceIndex(-2);
paFloat32 = PaSampleFormat($00000001);
paInt32 = PaSampleFormat($00000002);
paInt24 = PaSampleFormat($00000004);
paInt16 = PaSampleFormat($00000008);
paInt8 = PaSampleFormat($00000010);
paUInt8 = PaSampleFormat($00000020);
paCustomFormat = PaSampleFormat($00010000);
paNonInterleaved = PaSampleFormat($80000000);
paNoFlag = PaStreamFlags(0);
paClipOff = PaStreamFlags($00000001);
paDitherOff = PaStreamFlags($00000002);
paNeverDropInput = PaStreamFlags($00000004);
paPrimeOutputBuffersUsingStreamCallback = PaStreamFlags($00000008);
paPlatformSpecificFlags = PaStreamFlags($FFFF0000);
paInputUnderflow = PaStreamCallbackFlags($00000001);
paInputOverflow = PaStreamCallbackFlags($00000002);
paOutputUnderflow = PaStreamCallbackFlags($00000004);
paOutputOverflow = PaStreamCallbackFlags($00000008);
paPrimingOutput = PaStreamCallbackFlags($00000010);
function Pa_GetVersion():CInt32 ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetVersionText():PChar ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetErrorText(errorCode : PaError):PChar ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_Initialize():PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_Terminate():PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetHostApiCount():PaHostApiIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetDefaultHostApi():PaHostApiIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetHostApiInfo(hostApi : PaHostApiIndex):PPaHostApiInfo ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_HostApiTypeIdToHostApiIndex(_type : PaHostApiTypeId):PaHostApiIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_HostApiDeviceIndexToDeviceIndex(hostApi : PaHostApiIndex;hostApiDeviceIndex : CInt32):PaDeviceIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetLastHostErrorInfo():PPaHostErrorInfo ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetDeviceCount:PaDeviceIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetDefaultInputDevice:PaDeviceIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetDefaultOutputDevice:PaDeviceIndex ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetDeviceInfo(device : PaDeviceIndex):PPaDeviceInfo ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_IsFormatSupported(inputParameters,outputParameters : PPaStreamParameters; sampleRate : CDouble):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_OpenStream(stream : PPPaStream;
inputParameters : PPaStreamParameters;
outputParameters : PPaStreamParameters;
sampleRate : CDouble;
framesPerBuffer : CULong;
streamFlags : PaStreamFlags;
streamCallback : PaStreamCallback;
userData : Pointer):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_OpenDefaultStream(stream : PPPaStream;
numInputChannels : CInt32;
numOutputChannels : CInt32;
sampleFormat : PaSampleFormat;
sampleRate : CDouble;
framesPerBuffer : CULong;
streamCallback : PaStreamCallback;
userData : Pointer):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_CloseStream(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_SetStreamFinishedCallback(stream : PPaStream;
streamFinishedCallback : PaStreamFinishedCallback):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_StartStream(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_StopStream(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_AbortStream(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_IsStreamStopped(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_IsStreamActive(stream : PPaStream):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetStreamInfo(stream : PPaStream):PPaStreamInfo ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetStreamTime(stream : PPaStream):Patime ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetStreamCpuLoad(stream : PPaStream):CDouble ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_ReadStream(stream : PPaStream; buffer : pcfloat ;frames : CULong):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_WriteStream(stream : PPaStream; buffer : pcfloat ;frames : CULong):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetStreamReadAvailable(stream : PPaStream):CSLong ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetStreamWriteAvailable(stream : PPaStream):CSLong ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_GetSampleSize(format : PaSampleFormat):PaError ; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
function Pa_Sleep(msec : CLong) : integer; cdecl; external {$ifndef USE_STATIC_PORTAUDIO} libname {$endif};
implementation
end.

2407
ps4_elf.pas Normal file
View File

File diff suppressed because it is too large Load Diff

83
ps4_elf_tls.pas Normal file
View File

@ -0,0 +1,83 @@
unit ps4_elf_tls;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
Hamt;
type
Pdtv=^Tdtv;
Tdtv=packed record
value:Pointer;
is_static:QWORD;
gen:QWORD;
end;
Ptls_tcb=^Ttls_tcb;
Ttls_tcb=packed record
seg_adr:Pointer;
dtv:Pdtv;
_dtv:Tdtv;
end;
function _init_tls_tcb(Size,is_static,gen:QWORD):Ptls_tcb;
function _get_tls_tcb(gen:QWORD):Ptls_tcb;
procedure _free_tls_tcb_all;
implementation
threadvar
tls_local:THAMT;
function _init_tls_tcb(Size,is_static,gen:QWORD):Ptls_tcb;
var
full_size:QWORD;
base:Pointer;
tcb:Ptls_tcb;
PP:PPointer;
begin
full_size:=Size+SizeOf(Ttls_tcb);
base:=AllocMem(full_size);
tcb:=Pointer(base+Size);
tcb^.seg_adr:=tcb;
tcb^.dtv:=@tcb^._dtv;
tcb^._dtv.value:=base;
tcb^._dtv.is_static:=is_static;
tcb^._dtv.gen:=gen;
if (tls_local=nil) then tls_local:=HAMT_create64;
PP:=HAMT_insert64(tls_local,gen,tcb);
Assert(PP<>nil);
Assert(PP^=tcb);
Result:=tcb;
end;
function _get_tls_tcb(gen:QWORD):Ptls_tcb;
var
PP:PPointer;
begin
Result:=nil;
PP:=HAMT_search64(tls_local,gen);
if (PP<>nil) then Result:=PP^;
end;
procedure _free_tls_tcb(data,userdata:Pointer);
Var
tcb:Ptls_tcb;
base:Pointer;
begin
tcb:=data;
if (tcb=nil) then Exit;
base:=tcb^._dtv.value;
FreeMem(base);
end;
procedure _free_tls_tcb_all;
begin
HAMT_destroy64(tls_local,@_free_tls_tcb,nil);
tls_local:=nil;
end;
end.

190
ps4_handles.pas Normal file
View File

@ -0,0 +1,190 @@
unit ps4_handles;
{$mode objfpc}{$H+}
interface
uses
hamt,
RWLock,
Classes, SysUtils;
type
TClassHandle=class
private
FRef:Pointer;
public
Procedure Acqure;
Procedure Release;
end;
AClassHandle=Array of TClassHandle;
TClassHandleLock=class(TClassHandle)
private
FLock:TRWLock;
public
constructor Create;
destructor Destroy; override;
Procedure Lock;
Procedure UnLock;
end;
TIntegerHandles=class
private
Const
def_min_key=1;
def_max_key=$7FFFFFFF;
var
FStub:TSTUB_HAMT32;
FHAMT:THAMT;
FCount,FPos:Integer;
FLock:TRWLock;
public
min_key,max_key:Integer;
constructor Create;
destructor Destroy; override;
function New(H:TClassHandle;var OutKey:Integer):Boolean;
function Acqure(const Key:Integer):TClassHandle;
function Delete(const Key:Integer):Boolean;
end;
implementation
Procedure TClassHandle.Acqure;
begin
System.InterlockedIncrement(FRef);
end;
Procedure TClassHandle.Release;
begin
if System.InterlockedDecrement(FRef)=nil then
begin
Free;
end;
end;
constructor TClassHandleLock.Create;
begin
inherited;
rwlock_init(FLock);
end;
destructor TClassHandleLock.Destroy;
begin
rwlock_destroy(FLock);
inherited;
end;
Procedure TClassHandleLock.Lock;
begin
rwlock_wrlock(FLock);
end;
Procedure TClassHandleLock.UnLock;
begin
rwlock_unlock(FLock);
end;
constructor TIntegerHandles.Create;
begin
min_key:=def_min_key;
max_key:=def_max_key;
FPos:=def_min_key;
FHAMT:=@FStub;
rwlock_init(FLock);
end;
procedure _free_data_cb(data,userdata:Pointer);
begin
if (data<>nil) then
TClassHandle(data).Release;
end;
destructor TIntegerHandles.Destroy;
begin
HAMT_clear32(FHAMT,@_free_data_cb,nil);
rwlock_destroy(FLock);
inherited;
end;
function TIntegerHandles.New(H:TClassHandle;var OutKey:Integer):Boolean;
Var
i,m:Integer;
data:PPointer;
Label
_data,_exit;
begin
Result:=False;
if (H=nil) then Exit;
rwlock_wrlock(FLock);
m:=(max_key-min_key);
if (FCount>=m+1) then Goto _exit;
if (FPos<min_key) or (FPos>max_key) then FPos:=min_key;
if (FCount=0) then
begin
OutKey:=FPos;
Inc(FPos);
data:=HAMT_insert32(FHAMT,OutKey,Pointer(H));
if (data=nil) then Goto _exit;
if (data^<>Pointer(H)) then Goto _exit;
end else
begin
For i:=0 to m do
begin
OutKey:=FPos;
Inc(FPos);
if (FPos>max_key) then FPos:=min_key;
data:=HAMT_insert32(FHAMT,OutKey,Pointer(H));
if (data=nil) then Goto _exit;
if (data^=Pointer(H)) then Goto _data;
end;
Goto _exit;
end;
_data:
Inc(FCount);
H.Acqure;
H.Acqure;
Result:=True;
_exit:
rwlock_unlock(FLock);
end;
function TIntegerHandles.Acqure(const Key:Integer):TClassHandle;
Var
data:PPointer;
Label
_exit;
begin
Result:=nil;
if (Key<min_key) or (Key>max_key) then Exit;
rwlock_rdlock(FLock);
data:=HAMT_search32(FHAMT,Key);
if (data=nil) then Goto _exit;
Pointer(Result):=data^;
if Assigned(Result) then
begin
Result.Acqure;
end;
_exit:
rwlock_unlock(FLock);
end;
function TIntegerHandles.Delete(const Key:Integer):Boolean;
Var
data:TClassHandle;
begin
Result:=False;
if (Key<min_key) or (Key>max_key) then Exit;
rwlock_wrlock(FLock);
Pointer(data):=HAMT_delete32(FHAMT,Key);
if Assigned(data) then
begin
data.Release;
Dec(FCount);
Result:=True;
end;
rwlock_unlock(FLock);
end;
end.

259
ps4_libkerenel/StopNotificationReason.inc Normal file
View File

@ -0,0 +1,259 @@
const
STOP_REASON_SIGHUP =$00000001; //Stop caused by SIGHUP signal.
STOP_REASON_SIGINT =$00000002; //Stop caused by SIGINT signal.
STOP_REASON_SIGQUIT =$00000003; //Stop caused by SIGQUIT signal.
STOP_REASON_SIGILL =$00000004; //Stop caused by SIGILL signal.
STOP_REASON_SIGTRAP =$00000005; //Stop caused by SIGTRAP signal.
STOP_REASON_SIGABRT =$00000006; //Stop caused by SIGABRT signal.
STOP_REASON_SIGEMT =$00000007; //Stop caused by SIGEMT (emulator trap) signal.
STOP_REASON_SIGFPE =$00000008; //Stop caused by SIGFPE signal.
STOP_REASON_SIGKILL =$00000009; //Stop caused by SIGKILL signal.
STOP_REASON_SIGBUS =$0000000A; //Stop caused by SIGBUS signal.
STOP_REASON_SIGSEGV =$0000000B; //Stop caused by SIGSEGV signal.
STOP_REASON_SIGSYS =$0000000C; //Stop caused by SIGSYS signal.
STOP_REASON_SIGPIPE =$0000000D; //Stop caused by SIGPIPE signal.
STOP_REASON_SIGALRM =$0000000E; //Stop caused by SIGALRM signal.
STOP_REASON_SIGTERM =$0000000F; //Stop caused by SIGTERM signal.
STOP_REASON_SIGURG =$00000010; //Stop caused by SIGURG signal.
STOP_REASON_SIGSTOP =$00000011; //Stop caused by SIGSTOP signal.
STOP_REASON_SIGTSTP =$00000012; //Stop caused by SIGTSTP signal.
STOP_REASON_SIGCONT =$00000013; //Stop caused by SIGCONT signal.
STOP_REASON_SIGCHLD =$00000014; //Stop caused by SIGCHLD signal.
STOP_REASON_SIGTTIN =$00000015; //Stop caused by SIGTTIN signal.
STOP_REASON_SIGTTOU =$00000016; //Stop caused by SIGTTOU signal.
STOP_REASON_SIGIO =$00000017; //Stop caused by SIGIO (SIGPOLL) signal.
STOP_REASON_SIGXCPU =$00000018; //Stop caused by SIGXCPU signal.
STOP_REASON_SIGXFSZ =$00000019; //Stop caused by SIGXFSZ signal.
STOP_REASON_SIGVTALRM =$0000001A; //Stop caused by SIGVTALRM signal.
STOP_REASON_SIGPROF =$0000001B; //Stop caused by SIGPROF signal.
STOP_REASON_SIGWINCH =$0000001C; //Stop caused by SIGWINCH signal.
STOP_REASON_SIGINFO =$0000001D; //Stop caused by SIGINFO signal.
STOP_REASON_SIGUSR1 =$0000001E; //Stop caused by SIGUSR1 signal.
STOP_REASON_SIGUSR2 =$0000001F; //Stop caused by SIGUSR2 signal.
STOP_REASON_SIGTHR =$00000020; //Reserved by thread library.
STOP_REASON_SIGNONE =$00000080; //When this reason is used in SceDbgpProcInfo, it means the process is running. When this reason is used in SceDbgpThrInfo, it means the thread is running no matter what the process state is.
STOP_REASON_SIGSUSPEND_PROCESS =$00000081; //Stopped because SCE_DBGP_TYPE_SUSPEND_PROCESS_CMD was received, or the process was spawned with SceDbgpLoadFlags.loadSuspended = 1 and has not been resumed.
STOP_REASON_SIGSUSPEND_THREAD =$00000082; //Stopped because SCE_DBGP_TYPE_SUSPEND_THREAD_CMD was received.
STOP_REASON_SIGSWBRKPT =$00000083; //Stopped due to hitting software breakpoint inserted with SET_SWBRKPT_CMD.
STOP_REASON_DL_STOP_INIT =$00000084; //Stopped due to loading dynamic module for the process when dlStop bit is set.
STOP_REASON_DL_START_UP_FAILED =$00000085; //Error was encountered when preparing to start or on starting a dynamic library.
STOP_REASON_SIGHWBRKPT =$00000086; //Stopped due to hitting hardware breakpoint inserted with SET_HWBRKPT_CMD. Even though hardware breakpoints are not thread specific, only the thread that hit the breakpoint should have this reason.
STOP_REASON_GPU_FAULT_ASYNC =$a0d0c001; //GPU exception was detected.
STOP_REASON_GPU_HP3D_TIMEOUT_ASYNC =$a0d04002; //System software forcibly shutdown the process because of GPU timeout.
STOP_REASON_GPU_SUBMITDONE_TIMEOUT_ASYNC =$a0d04003; //System software forcibly shutdown the process because of submitDone timeout.
STOP_REASON_GPU_BREAK_ASYNC =$a0d0c004; //GPU breakpoint detected.
STOP_REASON_GPU_FAULT_PAGE_FAULT_ASYNC =$a0d0c005; //GPU page fault detected.
STOP_REASON_GPU_FAULT_BAD_OP_CODE_ASYNC =$a0d0c006; //GPU encountered illegal instruction.
STOP_REASON_GPU_FAULT_SUBMITDONE_TIMEOUT_IN_RUN_ASYNC =$a0d0c007; //System software forcibly shutdown the process because of submitDone timeout. GPU was in busy state.
STOP_REASON_GPU_FAULT_SUBMITDONE_TIMEOUT_IN_SUSPEND_ASYNC =$a0d0c008; //System software failed to suspend the process because of submitDone timeout. GPU was in busy state.
STOP_REASON_CPU_FAULT_SUBMITDONE_TIMEOUT_IN_RUN_ASYNC =$a0d0c009; //System software forcibly shutdown the process because of submitDone timeout. GPU was in idle state.
STOP_REASON_CPU_FAULT_SUBMITDONE_TIMEOUT_IN_SUSPEND_ASYNC =$a0d0c00a; //System software failed to suspend the process because of submitDone timeout. GPU was in idle state.
STOP_REASON_GPU_FAULT_IDLE_TIMEOUT_AFTER_SUBMITDONE_ASYNC =$a0d0c00b; //GPU idle timeout after submitDone.
STOP_REASON_LIBC_RETURN_MAIN_SUCCESS =$a0020001; //Returned from main with zero.
STOP_REASON_LIBC_RETURN_MAIN_FAIL =$a0020002; //Returned from main with non-zero.
STOP_REASON_LIBC_EXIT_SUCCESS =$a0020003; //exit is called with zero.
STOP_REASON_LIBC_EXIT_FAIL =$a0020004; //exit is called with non-zero.
STOP_REASON_LIBC__EXIT_SUCCESS =$a0020005; //_Exit is called with zero.
STOP_REASON_LIBC__EXIT_FAIL =$a0020006; //_Exit is called with non-zero.
STOP_REASON_LIBC_ASSERT =$a0020007; //assert is called.
STOP_REASON_LIBC_TERMINATE =$a0020008; //terminate is called.
STOP_REASON_LIBC_UNEXPECTED =$a0020009; //unexpected is called.
STOP_REASON_LIBC_PURE_VIRTUAL =$a002000a; //pure virtual function is called.
STOP_REASON_LIBC_ABORT =$a002000b; //abort is called.
STOP_REASON_LIBC_QUICK_EXIT_SUCCESS =$a002000c; //quick_exit is called with zero.
STOP_REASON_LIBC_QUICK_EXIT_FAIL =$a002000d; //quick_exit is called with non-zero.
STOP_REASON_LIBC_FAILED_TO_CREATE_HEAP =$a002000e; //Failed to create the heap. Please check the value of sceLibcHeapSize.
STOP_REASON_LIBC_FAILED_TO_REPLACE_MALLOC =$a0020010; //Failed to replace malloc. Please check that you defined all necessary functions.
STOP_REASON_LIBC_FAILED_TO_REPLACE_NEW =$a0020011; //Failed to replace new. Please check that you defined all necessary functions.
STOP_REASON_LIBC_FAILED_TO_REPLACE_TLS_MALLOC =$a0020012; //Failed to replace malloc for TLS. Please check that you defined all necessary functions.
STOP_REASON_LIBC_FAILED_TO_MALLOC_INIT =$a0020013; //Failed to initialize malloc.
STOP_REASON_LIBC_FAILED_TO_TLS_MALLOC_INIT =$a0020014; //Failed to initialize malloc for TLS.
STOP_REASON_LIBC_INTERNAL_RETURN_MAIN_SUCCESS =$a0020081; //Returned from main with zero(system).
STOP_REASON_LIBC_INTERNAL_RETURN_MAIN_FAIL =$a0020082; //Returned from main with non-zero(system).
STOP_REASON_LIBC_INTERNAL_EXIT_SUCCESS =$a0020083; //exit is called with zero(system).
STOP_REASON_LIBC_INTERNAL_EXIT_FAIL =$a0020084; //exit is called with non-zero(system).
STOP_REASON_LIBC_INTERNAL__EXIT_SUCCESS =$a0020085; //_Exit is called with zero(system).
STOP_REASON_LIBC_INTERNAL__EXIT_FAIL =$a0020086; //_Exit is called with non-zero(system).
STOP_REASON_LIBC_INTERNAL_ASSERT =$a0020087; //assert is called(system).
STOP_REASON_LIBC_INTERNAL_TERMINATE =$a0020088; //terminate is called(system).
STOP_REASON_LIBC_INTERNAL_UNEXPECTED =$a0020089; //unexpected is called(system).
STOP_REASON_LIBC_INTERNAL_PURE_VIRTUAL =$a002008a; //pure virtual function is called(system).
STOP_REASON_LIBC_INTERNAL_ABORT =$a002008b; //abort is called(system).
STOP_REASON_LIBC_INTERNAL_QUICK_EXIT_SUCCESS =$a002008c; //quick_exit is called with zero(system).
STOP_REASON_LIBC_INTERNAL_QUICK_EXIT_FAIL =$a002008d; //quick_exit is called with non-zero(system).
STOP_REASON_LIBC_INTERNAL_FAILED_TO_CREATE_SYSTEM_MEMORY =$a002008f; //Failed to create the system memory (please report it in devnet).
STOP_REASON_PRX_NOT_RESOLVED_FUNCTION =$a0020101; //Called PRX function was not resolved.
STOP_REASON_PRX_SCE_MODULE_LOAD_ERROR =$a0020102; //Cannot load necessary modules from sce_module.
STOP_REASON_PRX_RUNTIME_ERROR =$a0020103; //An error occured in dynamic library (PRX) runtime.
STOP_REASON_PRX_PROCESS_STARTUP_FAILURE =$a0020104; //System software failed to initialize process environment.
STOP_REASON_SYSTEM_FATAL_LOAD_ERROR =$a0020302; //System software could not start the program.
STOP_REASON_SYSTEM_PTHREAD_RUNTIME_ERROR =$a0020305; //ScePthread runtime detected a fatal runtime error.
STOP_REASON_SYSTEM_INTERNAL_PTHREAD_RUNTIME_ERROR =$a0020306; //ScePthread runtime detected a fatal runtime error(internal).
STOP_REASON_SYSTEM_STACK_CHECK_FAILURE =$a0020307; //System software detected user stack is corrupted.
STOP_REASON_SYSTEM_INTERNAL_STACK_CHECK_FAILURE =$a0020308; //System software detected user stack is corrupted(internal).
STOP_REASON_SYSTEM_UNKNOWN_FATAL_ERROR =$a0020309; //The process was forcibly terminated due to unknown fatal error.
STOP_REASON_SYSTEM_ILLEGAL_FUNCTION_CALL =$a002030a; //The process was terminated with illegal function call.
STOP_REASON_SYSTEM_SCE_BREAK =$a002030b; //The process was terminated with unhandled SCE_BREAK.
STOP_REASON_SYSTEM_SCE_STOP =$a002030c; //The process was terminated with unhandled SCE_STOP.
STOP_REASON_SYSTEM_UNKNOWN_KERNEL_ERROR =$a002030d; //System software forcibly shutdown the process(driver).
STOP_REASON_SYSTEM_EXECUTABLE_ACCESS_ERROR =$a0020311; //Failed to verify executable.
STOP_REASON_KERNEL_ABORT_SYSTEM_ABNORMAL_TERMINATION_REQUEST =$a0020318; //The process terminated with sceSystemServiceReportAbnormalTermination.
STOP_REASON_SYSTEM_INTERNAL_DATA_ACCESS_ERROR =$a0020319; //System software is corrupted.
STOP_REASON_SYSTEM_ILLEGAL_EXCEPTION_CODE =$a002031a; //The process misused a library and was terminated.
STOP_REASON_SYSTEM_INTERNAL_SERVICE_RUNTIME_ERROR =$a002031c; //Failed to request system software service.
STOP_REASON_SYSTEM_DEBUG_RUNTIME_ERROR =$a002031d; //Cannot continue process instrumentation.
STOP_REASON_SYSTEM_INTERNAL_SERVICE_RUNTIME_FATAL =$a002031e; //Failed to request system software service.
STOP_REASON_SYSTEM_INTERNAL_SERVICE_CALL_ERROR =$a002031f; //Failed to request system software service.
STOP_REASON_SYSTEM_INTERNAL_SERVICE_CALL_FATAL =$a0020320; //Failed to request system software service.
STOP_REASON_SYSTEM_PTHREAD_MUTEX_ERROR =$a0020321; //Critical error on pthread mutex.
STOP_REASON_SYSTEM_WRITE_ADDRESS_WRAPAROUND =$a0020323; //System software detected wraparound of write address.
STOP_REASON_SYSTEM_ASAN_FATAL_ASSERT =$a0020325; //The process encountered a fatal ASan error.
STOP_REASON_SYSTEM_BAILOUT_REQUEST =$a0020404; //Terminating system service(s) without crash reporting. (Internal)
STOP_REASON_SYSTEM_BAILOUT_LOW_MEMORY =$a0020405; //Terminating system service(s) without crash reporting. (Internal)
STOP_REASON_SYSTEM_SUSPEND_BLOCK_TIMEOUT_ASYNC =$a0024301; //System software forcibly shutdown the process because of suspend blocker timeout.
STOP_REASON_SYSTEM_UNKNOWN_FATAL_ERROR_ASYNC =$a0024303; //System software forcibly shutdown the process.
STOP_REASON_SYSTEM_USER_DEBUG_REQUEST_ASYNC =$a0024304; //The process received debug termination request.
STOP_REASON_SYSTEM_INTERNAL_SERVICE_TIMEOUT_ASYNC =$a002431b; //Terminating system service(s). (Internal)
STOP_REASON_SYSTEM_SOFTWARE_TIMEOUT_ASYNC =$a0024402; //The process was forcibly terminated with operation timeout.
STOP_REASON_SYSTEM_BAILOUT_GENERIC_ASYNC =$a0024403; //Terminating system service(s) without crash reporting. (Internal)
STOP_REASON_SYSTEM_DEBUGHANDLER_TIMEOUT =$a0028310; //The core dump handler timed out.
STOP_REASON_SYSTEM_DEBUGHANDLER_REJECTED =$a0028316; //Core dump handler was skipped due to application suspend.
STOP_REASON_SYSTEM_TRIGGER_COREDUMP_REQUEST =$a0028322; //The process requested core dump generation.
STOP_REASON_SYSTEM_ASAN_ASSERT =$a0028324; //The process encountered an ASan error.
STOP_REASON_SYSTEM_VM_RUNTIME =$a0028401; //The process was terminated with VM runtime exception.
STOP_REASON_SYSTEM_DUMP_AND_CONTINUE_REQUEST_ASYNC =$a002c315; //The process received core dump request.
STOP_REASON_KERNEL_EXCEPTION_SYSTEM_DEBUG_REQUEST_TIMEOUT_ASYNC=$a002c317; //Debug suspend request was timed out.
function GetStopReasonInfo(dwStopReason:DWORD):RawByteString;
begin
Case dwStopReason of
STOP_REASON_SIGHUP :Result:='Stop caused by SIGHUP signal.';
STOP_REASON_SIGINT :Result:='Stop caused by SIGINT signal.';
STOP_REASON_SIGQUIT :Result:='Stop caused by SIGQUIT signal.';
STOP_REASON_SIGILL :Result:='Stop caused by SIGILL signal.';
STOP_REASON_SIGTRAP :Result:='Stop caused by SIGTRAP signal.';
STOP_REASON_SIGABRT :Result:='Stop caused by SIGABRT signal.';
STOP_REASON_SIGEMT :Result:='Stop caused by SIGEMT (emulator trap) signal.';
STOP_REASON_SIGFPE :Result:='Stop caused by SIGFPE signal.';
STOP_REASON_SIGKILL :Result:='Stop caused by SIGKILL signal.';
STOP_REASON_SIGBUS :Result:='Stop caused by SIGBUS signal.';
STOP_REASON_SIGSEGV :Result:='Stop caused by SIGSEGV signal.';
STOP_REASON_SIGSYS :Result:='Stop caused by SIGSYS signal.';
STOP_REASON_SIGPIPE :Result:='Stop caused by SIGPIPE signal.';
STOP_REASON_SIGALRM :Result:='Stop caused by SIGALRM signal.';
STOP_REASON_SIGTERM :Result:='Stop caused by SIGTERM signal.';
STOP_REASON_SIGURG :Result:='Stop caused by SIGURG signal.';
STOP_REASON_SIGSTOP :Result:='Stop caused by SIGSTOP signal.';
STOP_REASON_SIGTSTP :Result:='Stop caused by SIGTSTP signal.';
STOP_REASON_SIGCONT :Result:='Stop caused by SIGCONT signal.';
STOP_REASON_SIGCHLD :Result:='Stop caused by SIGCHLD signal.';
STOP_REASON_SIGTTIN :Result:='Stop caused by SIGTTIN signal.';
STOP_REASON_SIGTTOU :Result:='Stop caused by SIGTTOU signal.';
STOP_REASON_SIGIO :Result:='Stop caused by SIGIO (SIGPOLL) signal.';
STOP_REASON_SIGXCPU :Result:='Stop caused by SIGXCPU signal.';
STOP_REASON_SIGXFSZ :Result:='Stop caused by SIGXFSZ signal.';
STOP_REASON_SIGVTALRM :Result:='Stop caused by SIGVTALRM signal.';
STOP_REASON_SIGPROF :Result:='Stop caused by SIGPROF signal.';
STOP_REASON_SIGWINCH :Result:='Stop caused by SIGWINCH signal.';
STOP_REASON_SIGINFO :Result:='Stop caused by SIGINFO signal.';
STOP_REASON_SIGUSR1 :Result:='Stop caused by SIGUSR1 signal.';
STOP_REASON_SIGUSR2 :Result:='Stop caused by SIGUSR2 signal.';
STOP_REASON_SIGTHR :Result:='Reserved by thread library.';
STOP_REASON_SIGNONE :Result:='When this reason is used in SceDbgpProcInfo, it means the process is running. When this reason is used in SceDbgpThrInfo, it means the thread is running no matter what the process state is.';
STOP_REASON_SIGSUSPEND_PROCESS :Result:='Stopped because SCE_DBGP_TYPE_SUSPEND_PROCESS_CMD was received, or the process was spawned with SceDbgpLoadFlags.loadSuspended = 1 and has not been resumed.';
STOP_REASON_SIGSUSPEND_THREAD :Result:='Stopped because SCE_DBGP_TYPE_SUSPEND_THREAD_CMD was received.';
STOP_REASON_SIGSWBRKPT :Result:='Stopped due to hitting software breakpoint inserted with SET_SWBRKPT_CMD.';
STOP_REASON_DL_STOP_INIT :Result:='Stopped due to loading dynamic module for the process when dlStop bit is set.';
STOP_REASON_DL_START_UP_FAILED :Result:='Error was encountered when preparing to start or on starting a dynamic library.';
STOP_REASON_SIGHWBRKPT :Result:='Stopped due to hitting hardware breakpoint inserted with SET_HWBRKPT_CMD. Even though hardware breakpoints are not thread specific, only the thread that hit the breakpoint should have this reason.';
STOP_REASON_GPU_FAULT_ASYNC :Result:='GPU exception was detected.';
STOP_REASON_GPU_HP3D_TIMEOUT_ASYNC :Result:='System software forcibly shutdown the process because of GPU timeout.';
STOP_REASON_GPU_SUBMITDONE_TIMEOUT_ASYNC :Result:='System software forcibly shutdown the process because of submitDone timeout.';
STOP_REASON_GPU_BREAK_ASYNC :Result:='GPU breakpoint detected.';
STOP_REASON_GPU_FAULT_PAGE_FAULT_ASYNC :Result:='GPU page fault detected.';
STOP_REASON_GPU_FAULT_BAD_OP_CODE_ASYNC :Result:='GPU encountered illegal instruction.';
STOP_REASON_GPU_FAULT_SUBMITDONE_TIMEOUT_IN_RUN_ASYNC :Result:='System software forcibly shutdown the process because of submitDone timeout. GPU was in busy state.';
STOP_REASON_GPU_FAULT_SUBMITDONE_TIMEOUT_IN_SUSPEND_ASYNC :Result:='System software failed to suspend the process because of submitDone timeout. GPU was in busy state.';
STOP_REASON_CPU_FAULT_SUBMITDONE_TIMEOUT_IN_RUN_ASYNC :Result:='System software forcibly shutdown the process because of submitDone timeout. GPU was in idle state.';
STOP_REASON_CPU_FAULT_SUBMITDONE_TIMEOUT_IN_SUSPEND_ASYNC :Result:='System software failed to suspend the process because of submitDone timeout. GPU was in idle state.';
STOP_REASON_GPU_FAULT_IDLE_TIMEOUT_AFTER_SUBMITDONE_ASYNC :Result:='GPU idle timeout after submitDone.';
STOP_REASON_LIBC_RETURN_MAIN_SUCCESS :Result:='Returned from main with zero.';
STOP_REASON_LIBC_RETURN_MAIN_FAIL :Result:='Returned from main with non-zero.';
STOP_REASON_LIBC_EXIT_SUCCESS :Result:='exit is called with zero.';
STOP_REASON_LIBC_EXIT_FAIL :Result:='exit is called with non-zero.';
STOP_REASON_LIBC__EXIT_SUCCESS :Result:='_Exit is called with zero.';
STOP_REASON_LIBC__EXIT_FAIL :Result:='_Exit is called with non-zero.';
STOP_REASON_LIBC_ASSERT :Result:='assert is called.';
STOP_REASON_LIBC_TERMINATE :Result:='terminate is called.';
STOP_REASON_LIBC_UNEXPECTED :Result:='unexpected is called.';
STOP_REASON_LIBC_PURE_VIRTUAL :Result:='pure virtual function is called.';
STOP_REASON_LIBC_ABORT :Result:='abort is called.';
STOP_REASON_LIBC_QUICK_EXIT_SUCCESS :Result:='quick_exit is called with zero.';
STOP_REASON_LIBC_QUICK_EXIT_FAIL :Result:='quick_exit is called with non-zero.';
STOP_REASON_LIBC_FAILED_TO_CREATE_HEAP :Result:='Failed to create the heap. Please check the value of sceLibcHeapSize.';
STOP_REASON_LIBC_FAILED_TO_REPLACE_MALLOC :Result:='Failed to replace malloc. Please check that you defined all necessary functions.';
STOP_REASON_LIBC_FAILED_TO_REPLACE_NEW :Result:='Failed to replace new. Please check that you defined all necessary functions.';
STOP_REASON_LIBC_FAILED_TO_REPLACE_TLS_MALLOC :Result:='Failed to replace malloc for TLS. Please check that you defined all necessary functions.';
STOP_REASON_LIBC_FAILED_TO_MALLOC_INIT :Result:='Failed to initialize malloc.';
STOP_REASON_LIBC_FAILED_TO_TLS_MALLOC_INIT :Result:='Failed to initialize malloc for TLS.';
STOP_REASON_LIBC_INTERNAL_RETURN_MAIN_SUCCESS :Result:='Returned from main with zero(system).';
STOP_REASON_LIBC_INTERNAL_RETURN_MAIN_FAIL :Result:='Returned from main with non-zero(system).';
STOP_REASON_LIBC_INTERNAL_EXIT_SUCCESS :Result:='exit is called with zero(system).';
STOP_REASON_LIBC_INTERNAL_EXIT_FAIL :Result:='exit is called with non-zero(system).';
STOP_REASON_LIBC_INTERNAL__EXIT_SUCCESS :Result:='_Exit is called with zero(system).';
STOP_REASON_LIBC_INTERNAL__EXIT_FAIL :Result:='_Exit is called with non-zero(system).';
STOP_REASON_LIBC_INTERNAL_ASSERT :Result:='assert is called(system).';
STOP_REASON_LIBC_INTERNAL_TERMINATE :Result:='terminate is called(system).';
STOP_REASON_LIBC_INTERNAL_UNEXPECTED :Result:='unexpected is called(system).';
STOP_REASON_LIBC_INTERNAL_PURE_VIRTUAL :Result:='pure virtual function is called(system).';
STOP_REASON_LIBC_INTERNAL_ABORT :Result:='abort is called(system).';
STOP_REASON_LIBC_INTERNAL_QUICK_EXIT_SUCCESS :Result:='quick_exit is called with zero(system).';
STOP_REASON_LIBC_INTERNAL_QUICK_EXIT_FAIL :Result:='quick_exit is called with non-zero(system).';
STOP_REASON_LIBC_INTERNAL_FAILED_TO_CREATE_SYSTEM_MEMORY :Result:='Failed to create the system memory (please report it in devnet).';
STOP_REASON_PRX_NOT_RESOLVED_FUNCTION :Result:='Called PRX function was not resolved.';
STOP_REASON_PRX_SCE_MODULE_LOAD_ERROR :Result:='Cannot load necessary modules from sce_module.';
STOP_REASON_PRX_RUNTIME_ERROR :Result:='An error occured in dynamic library (PRX) runtime.';
STOP_REASON_PRX_PROCESS_STARTUP_FAILURE :Result:='System software failed to initialize process environment.';
STOP_REASON_SYSTEM_FATAL_LOAD_ERROR :Result:='System software could not start the program.';
STOP_REASON_SYSTEM_PTHREAD_RUNTIME_ERROR :Result:='ScePthread runtime detected a fatal runtime error.';
STOP_REASON_SYSTEM_INTERNAL_PTHREAD_RUNTIME_ERROR :Result:='ScePthread runtime detected a fatal runtime error(internal).';
STOP_REASON_SYSTEM_STACK_CHECK_FAILURE :Result:='System software detected user stack is corrupted.';
STOP_REASON_SYSTEM_INTERNAL_STACK_CHECK_FAILURE :Result:='System software detected user stack is corrupted(internal).';
STOP_REASON_SYSTEM_UNKNOWN_FATAL_ERROR :Result:='The process was forcibly terminated due to unknown fatal error.';
STOP_REASON_SYSTEM_ILLEGAL_FUNCTION_CALL :Result:='The process was terminated with illegal function call.';
STOP_REASON_SYSTEM_SCE_BREAK :Result:='The process was terminated with unhandled SCE_BREAK.';
STOP_REASON_SYSTEM_SCE_STOP :Result:='The process was terminated with unhandled SCE_STOP.';
STOP_REASON_SYSTEM_UNKNOWN_KERNEL_ERROR :Result:='System software forcibly shutdown the process(driver).';
STOP_REASON_SYSTEM_EXECUTABLE_ACCESS_ERROR :Result:='Failed to verify executable.';
STOP_REASON_KERNEL_ABORT_SYSTEM_ABNORMAL_TERMINATION_REQUEST :Result:='The process terminated with sceSystemServiceReportAbnormalTermination.';
STOP_REASON_SYSTEM_INTERNAL_DATA_ACCESS_ERROR :Result:='System software is corrupted.';
STOP_REASON_SYSTEM_ILLEGAL_EXCEPTION_CODE :Result:='The process misused a library and was terminated.';
STOP_REASON_SYSTEM_INTERNAL_SERVICE_RUNTIME_ERROR :Result:='Failed to request system software service.';
STOP_REASON_SYSTEM_DEBUG_RUNTIME_ERROR :Result:='Cannot continue process instrumentation.';
STOP_REASON_SYSTEM_INTERNAL_SERVICE_RUNTIME_FATAL :Result:='Failed to request system software service.';
STOP_REASON_SYSTEM_INTERNAL_SERVICE_CALL_ERROR :Result:='Failed to request system software service.';
STOP_REASON_SYSTEM_INTERNAL_SERVICE_CALL_FATAL :Result:='Failed to request system software service.';
STOP_REASON_SYSTEM_PTHREAD_MUTEX_ERROR :Result:='Critical error on pthread mutex.';
STOP_REASON_SYSTEM_WRITE_ADDRESS_WRAPAROUND :Result:='System software detected wraparound of write address.';
STOP_REASON_SYSTEM_ASAN_FATAL_ASSERT :Result:='The process encountered a fatal ASan error.';
STOP_REASON_SYSTEM_BAILOUT_REQUEST :Result:='Terminating system service(s) without crash reporting. (Internal)';
STOP_REASON_SYSTEM_BAILOUT_LOW_MEMORY :Result:='Terminating system service(s) without crash reporting. (Internal)';
STOP_REASON_SYSTEM_SUSPEND_BLOCK_TIMEOUT_ASYNC :Result:='System software forcibly shutdown the process because of suspend blocker timeout.';
STOP_REASON_SYSTEM_UNKNOWN_FATAL_ERROR_ASYNC :Result:='System software forcibly shutdown the process.';
STOP_REASON_SYSTEM_USER_DEBUG_REQUEST_ASYNC :Result:='The process received debug termination request.';
STOP_REASON_SYSTEM_INTERNAL_SERVICE_TIMEOUT_ASYNC :Result:='Terminating system service(s). (Internal)';
STOP_REASON_SYSTEM_SOFTWARE_TIMEOUT_ASYNC :Result:='The process was forcibly terminated with operation timeout.';
STOP_REASON_SYSTEM_BAILOUT_GENERIC_ASYNC :Result:='Terminating system service(s) without crash reporting. (Internal)';
STOP_REASON_SYSTEM_DEBUGHANDLER_TIMEOUT :Result:='The core dump handler timed out.';
STOP_REASON_SYSTEM_DEBUGHANDLER_REJECTED :Result:='Core dump handler was skipped due to application suspend.';
STOP_REASON_SYSTEM_TRIGGER_COREDUMP_REQUEST :Result:='The process requested core dump generation.';
STOP_REASON_SYSTEM_ASAN_ASSERT :Result:='The process encountered an ASan error.';
STOP_REASON_SYSTEM_VM_RUNTIME :Result:='The process was terminated with VM runtime exception.';
STOP_REASON_SYSTEM_DUMP_AND_CONTINUE_REQUEST_ASYNC :Result:='The process received core dump request.';
STOP_REASON_KERNEL_EXCEPTION_SYSTEM_DEBUG_REQUEST_TIMEOUT_ASYNC:Result:='Debug suspend request was timed out.';
else
Result:='';
end;
end;

183
ps4_libkerenel/errno.inc Normal file
View File

@ -0,0 +1,183 @@
const
EPERM =1 ;// Operation not permitted */
ENOENT =2 ;// No such file or directory */
ESRCH =3 ;// No such process */
EINTR =4 ;// Interrupted system call */
EIO =5 ;// Input/output error */
ENXIO =6 ;// Device not configured */
E2BIG =7 ;// Argument list too long */
ENOEXEC =8 ;// Exec format error */
EBADF =9 ;// Bad file descriptor */
ECHILD =10 ;// No child processes */
EDEADLK =11 ;// Resource deadlock avoided */
// 11 was EAGAIN */
ENOMEM =12 ;// Cannot allocate memory */
EACCES =13 ;// Permission denied */
EFAULT =14 ;// Bad address */
ENOTBLK =15 ;// Block device required */
EBUSY =16 ;// Device busy */
EEXIST =17 ;// File exists */
EXDEV =18 ;// Cross-device link */
ENODEV =19 ;// Operation not supported by device */
ENOTDIR =20 ;// Not a directory */
EISDIR =21 ;// Is a directory */
EINVAL =22 ;// Invalid argument */
ENFILE =23 ;// Too many open files in system */
EMFILE =24 ;// Too many open files */
ENOTTY =25 ;// Inappropriate ioctl for device */
ETXTBSY =26 ;// Text file busy */
EFBIG =27 ;// File too large */
ENOSPC =28 ;// No space left on device */
ESPIPE =29 ;// Illegal seek */
EROFS =30 ;// Read-only filesystem */
EMLINK =31 ;// Too many links */
EPIPE =32 ;// Broken pipe */
// math software
EDOM =33 ;// Numerical argument out of domain */
ERANGE =34 ;// Result too large */
// non-blocking and interrupt i/o
EAGAIN =35 ;// Resource temporarily unavailable */
EWOULDBLOCK =EAGAIN ;// Operation would block */
EINPROGRESS =36 ;// Operation now in progress */
EALREADY =37 ;// Operation already in progress */
// ipc/network software -- argument errors
ENOTSOCK =38 ;// Socket operation on non-socket */
EDESTADDRREQ =39 ;// Destination address required */
EMSGSIZE =40 ;// Message too long */
EPROTOTYPE =41 ;// Protocol wrong type for socket */
ENOPROTOOPT =42 ;// Protocol not available */
EPROTONOSUPPORT =43 ;// Protocol not supported */
ESOCKTNOSUPPORT =44 ;// Socket type not supported */
EOPNOTSUPP =45 ;// Operation not supported */
ENOTSUP =EOPNOTSUPP ;// Operation not supported */
EPFNOSUPPORT =46 ;// Protocol family not supported */
EAFNOSUPPORT =47 ;// Address family not supported by protocol family */
EADDRINUSE =48 ;// Address already in use */
EADDRNOTAVAIL =49 ;// Can't assign requested address */
// ipc/network software -- operational errors
ENETDOWN =50 ;// Network is down */
ENETUNREACH =51 ;// Network is unreachable */
ENETRESET =52 ;// Network dropped connection on reset */
ECONNABORTED =53 ;// Software caused connection abort */
ECONNRESET =54 ;// Connection reset by peer */
ENOBUFS =55 ;// No buffer space available */
EISCONN =56 ;// Socket is already connected */
ENOTCONN =57 ;// Socket is not connected */
ESHUTDOWN =58 ;// Can't send after socket shutdown */
ETOOMANYREFS =59 ;// Too many references: can't splice */
ETIMEDOUT =60 ;// Operation timed out */
ECONNREFUSED =61 ;// Connection refused */
ELOOP =62 ;// Too many levels of symbolic links */
ENAMETOOLONG =63 ;// File name too long */
// should be rearranged
EHOSTDOWN =64 ;// Host is down */
EHOSTUNREACH =65 ;// No route to host */
ENOTEMPTY =66 ;// Directory not empty */
// quotas & mush */
EPROCLIM =67 ;// Too many processes */
EUSERS =68 ;// Too many users */
EDQUOT =69 ;// Disc quota exceeded */
// Network File System */
ESTALE =70 ;// Stale NFS file handle */
EREMOTE =71 ;// Too many levels of remote in path */
EBADRPC =72 ;// RPC struct is bad */
ERPCMISMATCH =73 ;// RPC version wrong */
EPROGUNAVAIL =74 ;// RPC prog. not avail */
EPROGMISMATCH =75 ;// Program version wrong */
EPROCUNAVAIL =76 ;// Bad procedure for program */
ENOLCK =77 ;// No locks available */
ENOSYS =78 ;// Function not implemented */
EFTYPE =79 ;// Inappropriate file type or format */
EAUTH =80 ;// Authentication error */
ENEEDAUTH =81 ;// Need authenticator */
EIDRM =82 ;// Identifier removed */
ENOMSG =83 ;// No message of desired type */
EOVERFLOW =84 ;// Value too large to be stored in data type */
ECANCELED =85 ;// Operation canceled */
EILSEQ =86 ;// Illegal byte sequence */
ENOATTR =87 ;// Attribute not found */
EDOOFUS =88 ;// Programming error */
EBADMSG =89 ;// Bad message */
EMULTIHOP =90 ;// Multihop attempted */
ENOLINK =91 ;// Link has been severed */
EPROTO =92 ;// Protocol error */
ENOTCAPABLE =93 ;// Capabilities insufficient */
ECAPMODE =94 ;// Not permitted in capability mode */
ENOBLK =95;
EICV =96;
ENOPLAYGOENT =97;
EREVOKE =98;
ESDKVERSION =99;
ESTART =100 ;// module_start() fails */
ESTOP =101 ;// module_stop() fails */
ELAST =101 ;// Must be equal largest errno */
EADHOC =160 ;// adhoc mode */
// 161 reserved */
// 162 reserved */
EINACTIVEDISABLED =163 ;// IP address was changed */
ENETNODATA =164 ;// internal code */
ENETDESC =165 ;// internal code */
ENETDESCTIMEDOUT =166 ;// internal code */
ENETINTR =167 ;// network abort */
// 168 reserved */
// 169 reserved */
ERETURN =205 ;// libnetctl error */
// Dinkumware */
// ERROR CODES */
EFPOS =$0098;
// POSIX SUPPLEMENT */
ENODATA=1040;
ENOSR=1050;
ENOSTR=1051; // ENOSTR */
ENOTRECOVERABLE=1056; // ENOTRECOVERABLE */
EOTHER=1062;// EOTHER */
EOWNERDEAD=1064;// EOWNERDEAD */
ETIME=1074;// ETIME */
// pseudo-errors returned inside kernel to modify return to process */
ERESTART =(-1) ;// restart syscall */
EJUSTRETURN =(-2) ;// don't modify regs, just return */
ENOIOCTL =(-3) ;// ioctl not handled by this layer */
EDIRIOCTL =(-4) ;// do direct ioctl in GEOM */

588
ps4_libkerenel/ps4_cond.pas Normal file
View File

@ -0,0 +1,588 @@
unit ps4_cond;
{$mode objfpc}{$H+}
interface
uses
Windows,
ps4_mutex,
ps4_types;
type
Ppthread_condattr=^pthread_condattr_t;
pthread_condattr_t=bitpacked record
_shared:0..1; //1
_clock:0..31; //5
_align:0..67108863; //26
_align2:Integer; //32
end;
Ppthread_cond=^pthread_cond;
pthread_cond=^pthread_cond_t;
pthread_cond_t=record
valid:DWORD;
busy :DWORD;
waiters_count_:DWORD;
waiters_count_unblock_:DWORD;
waiters_count_gone_:DWORD;
value_q:Integer;
value_b:Integer;
waiters_count_lock_:TRTLCriticalSection;
waiters_q_lock_:TRTLCriticalSection;
waiters_b_lock_:TRTLCriticalSection;
sema_q:THandle;
sema_b:THandle;
name:array[0..31] of AnsiChar;
end;
PScePthreadCond=Ppthread_cond;
Const
PTHREAD_COND_INITIALIZER=nil;
function ps4_pthread_condattr_init(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_destroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getclock(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setclock(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_getpshared(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_condattr_setpshared(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_init(pCond:Ppthread_cond;pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_destroy(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_signal(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_broadcast(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_wait(pCond:Ppthread_cond;pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_cond_timedwait(pCond:Ppthread_cond;pMutex:Ppthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrInit(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondattrDestroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:Ppthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondDestroy(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondSignal(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondWait(pCond:PScePthreadCond;pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondTimedwait(pCond:PScePthreadCond;pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCondBroadcast(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
implementation
Uses
spinlock,
ps4_sema,
ps4_libkernel,
ps4_time;
function ps4_pthread_condattr_init(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_pthread_condattr_destroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_pthread_condattr_getclock(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._clock;
Result:=0;
end;
function ps4_pthread_condattr_setclock(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
CLOCK_REALTIME :;
CLOCK_VIRTUAL :;
CLOCK_PROF :;
CLOCK_MONOTONIC :;
CLOCK_UPTIME :;
CLOCK_UPTIME_PRECISE :;
CLOCK_UPTIME_FAST :;
CLOCK_REALTIME_PRECISE :;
CLOCK_REALTIME_FAST :;
CLOCK_MONOTONIC_PRECISE:;
CLOCK_MONOTONIC_FAST :;
CLOCK_SECOND :;
CLOCK_THREAD_CPUTIME_ID:;
CLOCK_PROCTIME :;
CLOCK_EXT_NETWORK :;
CLOCK_EXT_DEBUG_NETWORK:;
CLOCK_EXT_AD_NETWORK :;
CLOCK_EXT_RAW_NETWORK :;
else
Exit(EINVAL);
end;
pAttr^._clock:=t;
Result:=0;
end;
function ps4_pthread_condattr_getpshared(pAttr:Ppthread_condattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_condattr_setpshared(pAttr:Ppthread_condattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
PTHREAD_PROCESS_PRIVATE:;
PTHREAD_PROCESS_SHARED :;
else
Exit(EINVAL);
end;
pAttr^._shared:=t;
Result:=0;
end;
Const
LIFE_COND=$C0BAB1FD;
DEAD_COND=$C0DEADBF;
{type
sCondWaitHelper=record
c:pthread_cond;
external_mutex:pthread_mutex;
r:Pinteger;
end;}
var
cond_locked:Pointer=nil;
function STATIC_COND_INITIALIZER(x:Ppthread_cond):Boolean; inline;
begin
Result:=(x^=PTHREAD_COND_INITIALIZER);
end;
function pthread_cond_init(c:Ppthread_cond;a:Ppthread_condattr;str:PChar):Integer;
var
_c:pthread_cond;
begin
if (c=nil) then Exit(EINVAL);
_c:=AllocMem(SizeOf(pthread_cond_t));
if (_c=nil) then Exit(ENOMEM);
_c^.valid:=DEAD_COND;
_c^.sema_q:=CreateSemaphore(nil,0,$7fffffff,nil);
if (_c^.sema_q=0) then
begin
FreeMem(_c);
c^:=nil;
Exit(EAGAIN);
end;
_c^.sema_b:=CreateSemaphore(nil,0,$7fffffff,nil);
if (_c^.sema_b=0) then
begin
CloseHandle(_c^.sema_q);
FreeMem(_c);
c^:=nil;
Exit(EAGAIN);
end;
System.InitCriticalSection(_c^.waiters_count_lock_);
System.InitCriticalSection(_c^.waiters_b_lock_);
System.InitCriticalSection(_c^.waiters_q_lock_);
_c^.value_q:=0;
_c^.value_b:=1;
_c^.valid:=LIFE_COND;
if (str<>nil) then MoveChar0(str^,_c^.name,32);
c^:=_c;
Result:=0;
end;
function cond_static_init(c:Ppthread_cond):Integer;
var
r:Integer;
begin
r:=0;
spin_lock(cond_locked);
if (c=nil) then Exit(EINVAL);
if STATIC_COND_INITIALIZER(c) then
begin
r:=pthread_cond_init(c,nil,nil);
end;
spin_unlock(cond_locked);
Result:=r;
end;
function ps4_pthread_cond_init(pCond:Ppthread_cond;pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_cond_init(pCond,pAttr,nil);
end;
function ps4_pthread_cond_destroy(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
var
r:Integer;
_c:pthread_cond;
begin
if (pCond=nil) then Exit(EINVAL);
if STATIC_COND_INITIALIZER(pCond) then
begin
spin_lock(cond_locked);
if STATIC_COND_INITIALIZER(pCond) then
begin
r:=0;
end else
begin
r:=EBUSY;
end;
spin_unlock(cond_locked);
Exit(r);
end;
_c:=pCond^;
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
begin
do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
Exit(EBUSY);
end;
if (_c^.waiters_count_ > _c^.waiters_count_gone_) then
begin
r:=do_sema_b_release(_c^.sema_b, 1,_c^.waiters_b_lock_,_c^.value_b);
if (r=0) then r:=EBUSY;
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Exit(r);
end;
pCond^:=nil;
do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (not CloseHandle(_c^.sema_q)) and (r=0) then r:=EINVAL;
if (not CloseHandle(_c^.sema_b)) and (r=0) then r:=EINVAL;
System.LeaveCriticalSection (_c^.waiters_count_lock_);
System.DoneCriticalSection(_c^.waiters_count_lock_);
System.DoneCriticalSection(_c^.waiters_b_lock_);
System.DoneCriticalSection(_c^.waiters_q_lock_);
_c^.valid:=DEAD_COND;
FreeMem(_c);
Result:=0;
end;
function ps4_pthread_cond_signal(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
var
r:Integer;
_c:pthread_cond;
begin
if (pCond=nil) then Exit(EINVAL);
_c:=pCond^;
if (_c=PTHREAD_COND_INITIALIZER) then
Exit(0)
else
if (_c^.valid<>LIFE_COND) then
Exit(EINVAL);
System.EnterCriticalSection(_c^.waiters_count_lock_);
//mingw implement is wrong
if true {(_c^.waiters_count_unblock_<>0)} then
begin
if (_c^.waiters_count_=0) then
begin
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Exit(0);
end;
Dec(_c^.waiters_count_);
Inc(_c^.waiters_count_unblock_);
end else
if false {(_c^.waiters_count_>_c^.waiters_count_gone_)} then
begin
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then
begin
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
System.LeaveCriticalSection (_c^.waiters_count_lock_);
Exit(r);
end;
if (_c^.waiters_count_gone_<>0) then
begin
Dec(_c^.waiters_count_,_c^.waiters_count_gone_);
_c^.waiters_count_gone_:=0;
end;
Dec(_c^.waiters_count_);
_c^.waiters_count_unblock_:=1;
//System.LeaveCriticalSection(_c^.waiters_count_lock_);
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
end else
begin
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Exit(0);
end;
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Result:=do_sema_b_release(_c^.sema_q,1,_c^.waiters_q_lock_,_c^.value_q);
end;
function ps4_pthread_cond_broadcast(pCond:Ppthread_cond):Integer; SysV_ABI_CDecl;
var
r,relCnt:Integer;
_c:pthread_cond;
begin
if (pCond=nil) then Exit(EINVAL);
relCnt:=0;
_c:=pCond^;
if (_c=PTHREAD_COND_INITIALIZER) then
Exit(0)
else
if (_c^.valid<>LIFE_COND) then
Exit(EINVAL);
System.EnterCriticalSection(_c^.waiters_count_lock_);
//mingw implement is wrong
if true {(_c^.waiters_count_unblock_<>0)} then
begin
if (_c^.waiters_count_=0) then
begin
System.LeaveCriticalSection (_c^.waiters_count_lock_);
Exit(0);
end;
relCnt:=_c^.waiters_count_;
_c^.waiters_count_:=0;
Inc(_c^.waiters_count_unblock_,relCnt);
end else
if false {(_c^.waiters_count_>_c^.waiters_count_gone_)} then
begin
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then
begin
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Exit(r);
end;
if (_c^.waiters_count_gone_<>0) then
begin
Dec(_c^.waiters_count_,_c^.waiters_count_gone_);
_c^.waiters_count_gone_:=0;
end;
relCnt:=_c^.waiters_count_;
_c^.waiters_count_:=0;
_c^.waiters_count_unblock_:=relCnt;
//System.LeaveCriticalSection(_c^.waiters_count_lock_);
//r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
end else
begin
System.LeaveCriticalSection(_c^.waiters_count_lock_);
Exit(0);
end;
LeaveCriticalSection(_c^.waiters_count_lock_);
Result:=do_sema_b_release(_c^.sema_q,relCnt,_c^.waiters_q_lock_,_c^.value_q);
end;
function ps4_pthread_cond_wait(pCond:Ppthread_cond;pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
var
//ch:sCondWaitHelper;
r:Integer;
_c:pthread_cond;
Label
tryagain;
begin
if (pCond=nil) then Exit(EINVAL);
_c:=pCond^;
if (_c=PTHREAD_COND_INITIALIZER) then
begin
r:=cond_static_init(pCond);
if (r<>0) and (r<>EBUSY) then Exit(r);
_c:=pCond^;
end else
if (_c^.valid<>LIFE_COND) then
Exit(EINVAL);
tryagain:
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
begin
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
System.ThreadSwitch;
goto tryagain;
end;
Inc(_c^.waiters_count_);
LeaveCriticalSection(_c^.waiters_count_lock_);
r:=do_sema_b_release (_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
//ch.c = _c;
//ch.r = &r;
//ch.external_mutex = external_mutex;
//pthread_cleanup_push(cleanup_wait, (void *) &ch);
r:=ps4_pthread_mutex_unlock(pMutex);
//Writeln('ps4_pthread_mutex_unlock:',HexStr(pMutex),':',HexStr(r,8));
if (r=0) then
begin
r:=do_sema_b_wait(_c^.sema_q,INFINITE,_c^.waiters_q_lock_,_c^.value_q);
end;
ps4_pthread_mutex_lock(pMutex); //WHY IT NO IN MINGW
//pthread_cleanup_pop(1);
Result:=r;
end;
function pthread_cond_timedwait_impl(c:Ppthread_cond;m:Ppthread_mutex;t:DWORD):Integer;
var
//ch:sCondWaitHelper;
r:Integer;
_c:pthread_cond;
Label
tryagain;
begin
if (c=nil) then Exit(EINVAL);
_c:=c^;
if (_c=PTHREAD_COND_INITIALIZER) then
begin
r:=cond_static_init(c);
if (r<>0) and (r<>EBUSY) then Exit(r);
_c:=c^;
end else
if (_c^.valid<>LIFE_COND) then
Exit(EINVAL);
tryagain:
r:=do_sema_b_wait(_c^.sema_b,INFINITE,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
if (System.TryEnterCriticalSection(_c^.waiters_count_lock_)=0) then
begin
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
System.ThreadSwitch;
goto tryagain;
end;
Inc(_c^.waiters_count_);
System.LeaveCriticalSection(_c^.waiters_count_lock_);
r:=do_sema_b_release(_c^.sema_b,1,_c^.waiters_b_lock_,_c^.value_b);
if (r<>0) then Exit(r);
//ch.c = _c;
//ch.r = &r;
//ch.external_mutex = external_mutex;
//pthread_cleanup_push(cleanup_wait, (void *) &ch);
r:=ps4_pthread_mutex_unlock(m);
//Writeln('ps4_pthread_mutex_unlock:',HexStr(m),':',HexStr(r,8));
if (r=0) then
begin
r:=do_sema_b_wait(_c^.sema_q,t,_c^.waiters_q_lock_,_c^.value_q);
end;
ps4_pthread_mutex_lock(m); //WHY IT NO IN MINGW
//pthread_cleanup_pop(1);
Result:=r;
end;
function ps4_pthread_cond_timedwait(pCond:Ppthread_cond;pMutex:Ppthread_mutex;ptime:Ptimespec):Integer; SysV_ABI_CDecl;
var
t:DWORD;
begin
if (ptime=nil) then
begin
Result:=ps4_pthread_cond_wait(pCond,pMutex);
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ptime^));
Result:=pthread_cond_timedwait_impl(pCond,pMutex,t);
end;
end;
///////////////////////
function ps4_scePthreadCondattrInit(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_scePthreadCondattrDestroy(pAttr:Ppthread_condattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_condattr_t);
Result:=0;
end;
function ps4_scePthreadCondInit(pCond:PScePthreadCond;pAttr:Ppthread_condattr;name:Pchar):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(pthread_cond_init(pCond,pAttr,name));
end;
function ps4_scePthreadCondDestroy(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_cond_destroy(pCond));
end;
function ps4_scePthreadCondSignal(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondSignal:',HexStr(pCond));
Result:=px2sce(ps4_pthread_cond_signal(pCond));
//Writeln('<scePthreadCondSignal:',HexStr(pCond),':',HexStr(Result,8));
end;
function ps4_scePthreadCondWait(pCond:PScePthreadCond;pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondWait:',HexStr(pCond),':',HexStr(pMutex));
Result:=px2sce(ps4_pthread_cond_wait(pCond,pMutex));
//Writeln('<scePthreadCondWait:',HexStr(pCond),':',HexStr(pMutex),':',HexStr(Result,8));
//Result:=0;
end;
//Time to wait (microseconds)
function ps4_scePthreadCondTimedwait(pCond:PScePthreadCond;pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondTimedwait:',HexStr(pCond),':',HexStr(pMutex));
Result:=px2sce(pthread_cond_timedwait_impl(pCond,pMutex,_usec2msec(usec)));
//if Result=SCE_KERNEL_ERROR_ETIMEDOUT then Writeln('SCE_KERNEL_ERROR_ETIMEDOUT');
end;
function ps4_scePthreadCondBroadcast(pCond:PScePthreadCond):Integer; SysV_ABI_CDecl;
begin
//Writeln('>scePthreadCondBroadcast:',HexStr(pCond));
Result:=px2sce(ps4_pthread_cond_broadcast(pCond));
//Writeln('<scePthreadCondBroadcast:',HexStr(pCond),':',HexStr(Result,8));
end;
end.

539
ps4_libkerenel/ps4_kernel_file.pas Normal file
View File

@ -0,0 +1,539 @@
unit ps4_kernel_file;
{$mode objfpc}{$H+}
interface
uses
windows,
ps4_types,
ps4_program,
Classes, SysUtils;
const
NAME_MAX =255; // max bytes in a file name
PATH_MAX =1024; // max bytes in pathname
IOV_MAX =1024; // max elements in i/o vector
MAXNAMLEN =255;
O_RDONLY =$0000; // open for reading only
O_WRONLY =$0001; // open for writing only
O_RDWR =$0002; // open for reading and writing
O_ACCMODE =$0003; // mask for above modes
O_NONBLOCK =$0004; // no delay
O_APPEND =$0008; // set append mode
O_SYNC =$0080; // POSIX synonym for O_FSYNC
O_CREAT =$0200; // create if nonexistent
O_TRUNC =$0400; // truncate to zero length
O_EXCL =$0800; // error if already exists
O_DSYNC =$1000; // synchronous data writes(omit inode writes)
O_DIRECT =$00010000;
O_FSYNC =$0080; // synchronous writes
O_DIRECTORY =$00020000; // Fail if not directory
O_EXEC =$00040000; // Open for execute only
S_IRWXU =0000700; // RWX mask for owner
S_IRUSR =0000400; // R for owner
S_IWUSR =0000200; // W for owner
S_IXUSR =0000100; // X for owner
S_IRWXG =0000070; // RWX mask for group
S_IRGRP =0000040; // R for group
S_IWGRP =0000020; // W for group
S_IXGRP =0000010; // X for group
S_IRWXO =0000007; // RWX mask for other
S_IROTH =0000004; // R for other
S_IWOTH =0000002; // W for other
S_IXOTH =0000001; // X for other
S_IFMT =0170000; // type of file mask
S_IFDIR =0040000; // directory
S_IFREG =0100000; // regular
F_GETFL =3; // get file status flags
F_SETFL =4; // set file status flags
SEEK_SET =0; // set file offset to offset
SEEK_CUR =1; // set file offset to current plus offset
SEEK_END =2; // set file offset to EOF plus offset
MAP_SHARED =$0001; // share changes
MAP_PRIVATE =$0002; // changes are private
MAP_FILE =$0000; // map from file (default)
MAP_ANON =$1000; // allocated from memory, swap space
MAP_SYSTEM =$2000;
MAP_NOCORE =$00020000; // dont include these pages in a coredump
MAP_NOSYNC =$0800; // page to but do not sync underlying file
MAP_PREFAULT_READ =$00040000; // prefault mapping for reading
DT_UNKNOWN =0;
DT_DIR =4;
DT_REG =8;
SCE_KERNEL_NAME_MAX =NAME_MAX;
SCE_KERNEL_PATH_MAX =PATH_MAX;
SCE_KERNEL_IOV_MAX =IOV_MAX;
SCE_KERNEL_MAXNAMLEN =MAXNAMLEN;
SCE_KERNEL_O_RDONLY =O_RDONLY;
SCE_KERNEL_O_WRONLY =O_WRONLY;
SCE_KERNEL_O_RDWR =O_RDWR ;
SCE_KERNEL_O_NONBLOCK =O_NONBLOCK;
SCE_KERNEL_O_APPEND =O_APPEND;
SCE_KERNEL_O_CREAT =O_CREAT;
SCE_KERNEL_O_TRUNC =O_TRUNC;
SCE_KERNEL_O_EXCL =O_EXCL;
SCE_KERNEL_O_DIRECT =O_DIRECT;
SCE_KERNEL_O_FSYNC =O_FSYNC;
SCE_KERNEL_O_SYNC =O_SYNC;
SCE_KERNEL_O_DSYNC =O_DSYNC;
SCE_KERNEL_O_DIRECTORY =O_DIRECTORY;
SCE_KERNEL_S_IFMT =S_IFMT;
SCE_KERNEL_S_IFDIR =S_IFDIR;
SCE_KERNEL_S_IFREG =S_IFREG;
SCE_KERNEL_S_IRUSR =(S_IRUSR or S_IRGRP or S_IROTH or S_IXUSR or S_IXGRP or S_IXOTH);
SCE_KERNEL_S_IWUSR =(S_IWUSR or S_IWGRP or S_IWOTH or S_IXUSR or S_IXGRP or S_IXOTH);
SCE_KERNEL_S_IXUSR =(S_IXUSR or S_IXGRP or S_IXOTH);
SCE_KERNEL_S_IRWXU =(SCE_KERNEL_S_IRUSR or SCE_KERNEL_S_IWUSR);
SCE_KERNEL_S_IRWU =(SCE_KERNEL_S_IRUSR or SCE_KERNEL_S_IWUSR);
// 00777, R/W
SCE_KERNEL_S_IRU =(SCE_KERNEL_S_IRUSR);
// 00555, R
SCE_KERNEL_S_INONE =0000000;
//SCE_KERNEL_S_ISDIR(m) =S_ISDIR(m);
//SCE_KERNEL_S_ISREG(m) =S_ISREG(m);
// for sceKernelFcntl()
SCE_KERNEL_F_GETFL =F_GETFL;
SCE_KERNEL_F_SETFL =F_SETFL;
// for sceKernelLseek()
SCE_KERNEL_SEEK_SET =SEEK_SET;
SCE_KERNEL_SEEK_CUR =SEEK_CUR;
SCE_KERNEL_SEEK_END =SEEK_END;
// for sceKernelMmap()
SCE_KERNEL_MAP_NOCORE =MAP_NOCORE;
SCE_KERNEL_MAP_NOSYNC =MAP_NOSYNC;
SCE_KERNEL_MAP_PREFAULT_READ=MAP_PREFAULT_READ;
SCE_KERNEL_MAP_PRIVATE =MAP_PRIVATE;
SCE_KERNEL_MAP_SHARED =MAP_SHARED;
// for SceKernelDirent
SCE_KERNEL_DT_UNKNOWN =DT_UNKNOWN;
SCE_KERNEL_DT_DIR =DT_DIR;
SCE_KERNEL_DT_REG =DT_REG;
// for sceKernelSetCompress
SCE_KERNEL_COMPRESS_FILE_MAGIC =($43534650);
SCE_KERNEL_SET_COMPRESS_FILE =(1);
SCE_KERNEL_SET_REGULAR_FILE =(0);
// for sceKernelLwfsSetAttribute
SCE_KERNEL_LWFS_DISABLE =(0);
SCE_KERNEL_LWFS_ENABLE =(1);
type
P_ps4_stat=^T_ps4_stat;
T_ps4_stat=packed object
type
__dev_t=DWORD;
ino_t =DWORD;
mode_t =Word;
nlink_t=Word;
uid_t =DWORD;
gid_t =DWORD;
off_t =Int64;
blkcnt_t=Int64;
blksize_t=DWORD;
fflags_t =DWORD;
var
st_dev :__dev_t ; // inode's device
st_ino :ino_t ; // inode's number
st_mode :mode_t ; // inode protection mode
st_nlink :nlink_t ; // number of hard links
st_uid :uid_t ; // user ID of the file's owner
st_gid :gid_t ; // group ID of the file's group
st_rdev :__dev_t ; // device type
st_atim :timespec ; // time of last access
st_mtim :timespec ; // time of last data modification
st_ctim :timespec ; // time of last file status change
st_size :off_t ; // file size, in bytes
st_blocks :blkcnt_t ; // blocks allocated for file
st_blksize :blksize_t ; // optimal blocksize for I/O
st_flags :fflags_t ; // user defined flags for file
st_gen :DWORD ; // file generation number
st_lspare :DWORD ;
st_birthtim:timespec ; // time of file creation
end;
function ps4_sceKernelOpen(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelLseek(fd:Integer;offset:Int64;whence:Integer):Int64; SysV_ABI_CDecl;
function ps4_sceKernelWrite(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
function ps4_sceKernelRead(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
function ps4_sceKernelPread(fd:Integer;buf:Pointer;nbytes,offset:Int64):Int64; SysV_ABI_CDecl;
function ps4_sceKernelClose(fd:Integer):Integer; SysV_ABI_CDecl;
function ps4_stat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_sceKernelStat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
function ps4_write(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
function ps4_read(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
function ps4_sceKernelMkdir(path:PChar;mode:Integer):Integer; SysV_ABI_CDecl;
function ps4_mkdir(path:PChar):Integer; SysV_ABI_CDecl;
implementation
uses
ps4_libkernel;
function _open_osfhandle(h:THandle;flags:Integer):Integer; cdecl; external 'msvcrt';
function _get_osfhandle(fd:Integer):THandle; cdecl; external 'msvcrt';
function _close(fd:Integer):Integer; cdecl; external 'msvcrt';
function ps4_sceKernelOpen(path:PChar;flags,mode:Integer):Integer; SysV_ABI_CDecl;
const
WR_RDWR=SCE_KERNEL_O_WRONLY or SCE_KERNEL_O_RDWR;
CREAT_EXCL=SCE_KERNEL_O_CREAT or SCE_KERNEL_O_EXCL;
O_OFS=O_RDONLY or O_WRONLY or O_RDWR or O_APPEND;
var
h:THandle;
dwDesiredAccess:DWORD;
dwCreationDisposition:DWORD;
rp:RawByteString;
wp:WideString;
begin
if (path=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Assert((flags and SCE_KERNEL_O_DIRECTORY)=0,'folder open TODO');
if (flags and WR_RDWR)=WR_RDWR then
begin
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
if (path[0]=#0) then Exit(SCE_KERNEL_ERROR_ENOENT);
rp:=_parse_filename(path);
if (rp='') then Exit(SCE_KERNEL_ERROR_EACCES);
wp:=UTF8Decode(rp);
if (flags and SCE_KERNEL_O_RDWR)<>0 then
begin
dwDesiredAccess:=GENERIC_READ or GENERIC_WRITE;
end else
if (flags and SCE_KERNEL_O_WRONLY)<>0 then
begin
dwDesiredAccess:=GENERIC_WRITE;
end else
begin
dwDesiredAccess:=GENERIC_READ;
end;
if (flags and SCE_KERNEL_O_APPEND)<>0 then
begin
dwDesiredAccess:=dwDesiredAccess or FILE_APPEND_DATA;
end;
if (flags and CREAT_EXCL)=CREAT_EXCL then
begin
dwCreationDisposition:=CREATE_NEW;
end else
if (flags and SCE_KERNEL_O_CREAT)<>0 then
begin
dwCreationDisposition:=CREATE_ALWAYS;
end else
if (flags and SCE_KERNEL_O_TRUNC)<>0 then
begin
dwCreationDisposition:=TRUNCATE_EXISTING;
end else
begin
dwCreationDisposition:=OPEN_EXISTING;
end;
h:=CreateFileW(
PWideChar(wp),
dwDesiredAccess,
FILE_SHARE_READ,
nil,
dwCreationDisposition,
FILE_ATTRIBUTE_NORMAL,
0
);
if (h=INVALID_HANDLE_VALUE) then
begin
Writeln(GetLastError);
Case GetLastError of
ERROR_INVALID_DRIVE,
ERROR_PATH_NOT_FOUND,
ERROR_FILE_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_ACCESS_DENIED :Exit(SCE_KERNEL_ERROR_EACCES);
ERROR_FILE_EXISTS :Exit(SCE_KERNEL_ERROR_EEXIST);
else
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
Result:=_open_osfhandle(h,flags and O_OFS);
if (Result=-1) then
begin
Exit(SCE_KERNEL_ERROR_EMFILE);
end;
end;
function ps4_sceKernelLseek(fd:Integer;offset:Int64;whence:Integer):Int64; SysV_ABI_CDecl;
var
h:THandle;
begin
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
case whence of
SCE_KERNEL_SEEK_SET:Result:=FileSeek(h,offset,fsFromBeginning);
SCE_KERNEL_SEEK_CUR:Result:=FileSeek(h,offset,fsFromCurrent);
SCE_KERNEL_SEEK_END:Result:=FileSeek(h,offset,fsFromEnd);
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
if (Result=-1) then Result:=SCE_KERNEL_ERROR_EOVERFLOW;
end;
function ps4_sceKernelWrite(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
var
h:THandle;
N:DWORD;
begin
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) then Exit(SCE_KERNEL_ERROR_EINVAL);
N:=0;
if WriteFile(h,buf^,nbytes,N,nil) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
function ps4_sceKernelRead(fd:Integer;buf:Pointer;nbytes:Int64):Int64; SysV_ABI_CDecl;
var
h:THandle;
N:DWORD;
begin
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) then Exit(SCE_KERNEL_ERROR_EINVAL);
N:=0;
if ReadFile(h,buf^,nbytes,N,nil) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
function ps4_sceKernelPread(fd:Integer;buf:Pointer;nbytes,offset:Int64):Int64; SysV_ABI_CDecl;
var
h:THandle;
N:DWORD;
O:TOVERLAPPED;
begin
if (buf=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (nbytes<0) or (nbytes>High(Integer)) or (offset<0) then Exit(SCE_KERNEL_ERROR_EINVAL);
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(SCE_KERNEL_ERROR_EBADF);
O:=Default(TOVERLAPPED);
PInt64(@O.Offset)^:=offset;
N:=0;
if ReadFile(h,buf^,nbytes,N,@O) then
begin
Result:=N;
end else
begin
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
function ps4_sceKernelClose(fd:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=_close(fd);
if (Result<>0) then Result:=SCE_KERNEL_ERROR_EBADF;
end;
type
P_ms_stat64=^T_ms_stat64;
T_ms_stat64=packed object
type
_dev_t=DWORD;
_ino_t=WORD;
__time64_t=QWORD;
var
st_dev:_dev_t; //4
st_ino:_ino_t; //2
st_mode:WORD; //2 4
st_nlink:WORD; //2
st_uid:WORD; //2 4
st_gid:WORD; //2
a1:Word; //2 4
st_rdev:_dev_t; //4
a2:DWORD; //4
st_size:Int64; //8
st_atime:__time64_t;
st_mtime:__time64_t;
st_ctime:__time64_t;
end;
function _wstat64(path:PWideChar;stat:P_ms_stat64):Integer; cdecl; external 'msvcrt';
function ps4_stat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
var
stat_os:T_ms_stat64;
rp:RawByteString;
wp:WideString;
begin
//_wstat64(path:PWideChar;stat:P_ms_stat64)
writeln('stat:',path);
if (path=nil) then Exit(EINVAL);
if (path[0]=#0) then Exit(ENOENT);
rp:=_parse_filename(path);
if (rp='') then Exit(EACCES);
wp:=UTF8Decode(rp);
stat_os:=Default(T_ms_stat64);
Result:=_wstat64(PWideChar(wp),@stat_os);
if (Result<>0) then
begin
Writeln(GetLastError);
Case GetLastError of
ERROR_FILE_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOENT);
ERROR_PATH_NOT_FOUND:Exit(SCE_KERNEL_ERROR_ENOTDIR);
else
Exit(SCE_KERNEL_ERROR_EIO);
end;
end;
if (stat<>nil) then
begin
stat^:=Default(T_ps4_stat);
stat^.st_dev :=stat_os.st_dev;
stat^.st_ino :=stat_os.st_ino;
stat^.st_mode :=stat_os.st_mode;
stat^.st_nlink :=stat_os.st_nlink;
stat^.st_uid :=stat_os.st_uid;
stat^.st_gid :=stat_os.st_gid;
stat^.st_rdev :=stat_os.st_rdev;
stat^.st_atim.tv_sec:=stat_os.st_atime;
stat^.st_mtim.tv_sec:=stat_os.st_mtime;
stat^.st_ctim.tv_sec:=stat_os.st_ctime;
stat^.st_size :=stat_os.st_size;
end;
end;
function ps4_sceKernelStat(path:PChar;stat:P_ps4_stat):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_stat(path,stat));
end;
function GetStr(p:Pointer;L:SizeUint):RawByteString;
begin
SetString(Result,P,L);
end;
function ps4_write(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
var
h:THandle;
N:DWORD;
begin
if (data=nil) then Exit(lc_set_errno(EFAULT));
if (size>High(Integer)) then Exit(lc_set_errno(EINVAL));
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(lc_set_errno(EBADF));
N:=0;
if WriteFile(h,data^,size,N,nil) then
begin
Result:=N;
end else
begin
Exit(lc_set_errno(EIO));
end;
end;
function ps4_read(fd:Integer;data:Pointer;size:DWORD):Integer; SysV_ABI_CDecl;
var
h:THandle;
N:DWORD;
begin
if (data=nil) then Exit(lc_set_errno(EFAULT));
if (size>High(Integer)) then Exit(lc_set_errno(EINVAL));
h:=_get_osfhandle(fd);
if (h=INVALID_HANDLE_VALUE) then Exit(lc_set_errno(EBADF));
N:=0;
if ReadFile(h,data^,size,N,nil) then
begin
Result:=N;
end else
begin
Exit(lc_set_errno(EIO));
end;
end;
// nop nid:libkernel:0D1B81B76A6F2029:_read ps4_write
function ps4_sceKernelMkdir(path:PChar;mode:Integer):Integer; SysV_ABI_CDecl;
var
fn:RawByteString;
begin
Result:=0;
Writeln('sceKernelMkdir:',path,'(',OctStr(mode,3),')');
fn:=_parse_filename(path);
if not CreateDir(fn) then Result:=-1;
end;
function ps4_mkdir(path:PChar):Integer; SysV_ABI_CDecl;
var
fn:RawByteString;
begin
Result:=0;
Writeln('mkdir:',path);
fn:=_parse_filename(path);
if not CreateDir(fn) then Result:=-1;
end;
end.

866
ps4_libkerenel/ps4_libkernel.pas Normal file
View File

@ -0,0 +1,866 @@
unit ps4_libkernel;
{$mode objfpc}{$H+}
interface
uses
Windows,
ps4_map_mm,
RWLock,
ps4_types,
ps4_pthread,
ps4_mutex,
ps4_cond,
ps4_sema,
ps4_rwlock,
ps4_time,
ps4_kernel_file,
ps4_queue,
ps4_elf,
ps4_program,
Classes, SysUtils;
{$I sce_errno.inc}
{$I errno.inc}
function px2sce(e:Integer):Integer;
function lc_set_errno(r:Integer):Integer;
function ps4_sceKernelIsNeoMode:Integer; SysV_ABI_CDecl;
implementation
function px2sce(e:Integer):Integer;
begin
case e of
0:Result:=0;
EPERM :Result:=SCE_KERNEL_ERROR_EPERM ;
ENOENT :Result:=SCE_KERNEL_ERROR_ENOENT ;
ESRCH :Result:=SCE_KERNEL_ERROR_ESRCH ;
EINTR :Result:=SCE_KERNEL_ERROR_EINTR ;
EIO :Result:=SCE_KERNEL_ERROR_EIO ;
ENXIO :Result:=SCE_KERNEL_ERROR_ENXIO ;
E2BIG :Result:=SCE_KERNEL_ERROR_E2BIG ;
ENOEXEC :Result:=SCE_KERNEL_ERROR_ENOEXEC ;
EBADF :Result:=SCE_KERNEL_ERROR_EBADF ;
ECHILD :Result:=SCE_KERNEL_ERROR_ECHILD ;
EDEADLK :Result:=SCE_KERNEL_ERROR_EDEADLK ;
ENOMEM :Result:=SCE_KERNEL_ERROR_ENOMEM ;
EACCES :Result:=SCE_KERNEL_ERROR_EACCES ;
EFAULT :Result:=SCE_KERNEL_ERROR_EFAULT ;
ENOTBLK :Result:=SCE_KERNEL_ERROR_ENOTBLK ;
EBUSY :Result:=SCE_KERNEL_ERROR_EBUSY ;
EEXIST :Result:=SCE_KERNEL_ERROR_EEXIST ;
EXDEV :Result:=SCE_KERNEL_ERROR_EXDEV ;
ENODEV :Result:=SCE_KERNEL_ERROR_ENODEV ;
ENOTDIR :Result:=SCE_KERNEL_ERROR_ENOTDIR ;
EISDIR :Result:=SCE_KERNEL_ERROR_EISDIR ;
EINVAL :Result:=SCE_KERNEL_ERROR_EINVAL ;
ENFILE :Result:=SCE_KERNEL_ERROR_ENFILE ;
EMFILE :Result:=SCE_KERNEL_ERROR_EMFILE ;
ENOTTY :Result:=SCE_KERNEL_ERROR_ENOTTY ;
ETXTBSY :Result:=SCE_KERNEL_ERROR_ETXTBSY ;
EFBIG :Result:=SCE_KERNEL_ERROR_EFBIG ;
ENOSPC :Result:=SCE_KERNEL_ERROR_ENOSPC ;
ESPIPE :Result:=SCE_KERNEL_ERROR_ESPIPE ;
EROFS :Result:=SCE_KERNEL_ERROR_EROFS ;
EMLINK :Result:=SCE_KERNEL_ERROR_EMLINK ;
EPIPE :Result:=SCE_KERNEL_ERROR_EPIPE ;
EDOM :Result:=SCE_KERNEL_ERROR_EDOM ;
ERANGE :Result:=SCE_KERNEL_ERROR_ERANGE ;
EAGAIN :Result:=SCE_KERNEL_ERROR_EAGAIN ;
EINPROGRESS :Result:=SCE_KERNEL_ERROR_EINPROGRESS ;
EALREADY :Result:=SCE_KERNEL_ERROR_EALREADY ;
ENOTSOCK :Result:=SCE_KERNEL_ERROR_ENOTSOCK ;
EDESTADDRREQ :Result:=SCE_KERNEL_ERROR_EDESTADDRREQ ;
EMSGSIZE :Result:=SCE_KERNEL_ERROR_EMSGSIZE ;
EPROTOTYPE :Result:=SCE_KERNEL_ERROR_EPROTOTYPE ;
ENOPROTOOPT :Result:=SCE_KERNEL_ERROR_ENOPROTOOPT ;
EPROTONOSUPPORT:Result:=SCE_KERNEL_ERROR_EPROTONOSUPPORT;
ESOCKTNOSUPPORT:Result:=SCE_KERNEL_ERROR_ESOCKTNOSUPPORT;
EOPNOTSUPP :Result:=SCE_KERNEL_ERROR_EOPNOTSUPP ;
EPFNOSUPPORT :Result:=SCE_KERNEL_ERROR_EPFNOSUPPORT ;
EAFNOSUPPORT :Result:=SCE_KERNEL_ERROR_EAFNOSUPPORT ;
EADDRINUSE :Result:=SCE_KERNEL_ERROR_EADDRINUSE ;
EADDRNOTAVAIL :Result:=SCE_KERNEL_ERROR_EADDRNOTAVAIL ;
ENETDOWN :Result:=SCE_KERNEL_ERROR_ENETDOWN ;
ENETUNREACH :Result:=SCE_KERNEL_ERROR_ENETUNREACH ;
ENETRESET :Result:=SCE_KERNEL_ERROR_ENETRESET ;
ECONNABORTED :Result:=SCE_KERNEL_ERROR_ECONNABORTED ;
ECONNRESET :Result:=SCE_KERNEL_ERROR_ECONNRESET ;
ENOBUFS :Result:=SCE_KERNEL_ERROR_ENOBUFS ;
EISCONN :Result:=SCE_KERNEL_ERROR_EISCONN ;
ENOTCONN :Result:=SCE_KERNEL_ERROR_ENOTCONN ;
ESHUTDOWN :Result:=SCE_KERNEL_ERROR_ESHUTDOWN ;
ETOOMANYREFS :Result:=SCE_KERNEL_ERROR_ETOOMANYREFS ;
ETIMEDOUT :Result:=SCE_KERNEL_ERROR_ETIMEDOUT ;
ECONNREFUSED :Result:=SCE_KERNEL_ERROR_ECONNREFUSED ;
ELOOP :Result:=SCE_KERNEL_ERROR_ELOOP ;
ENAMETOOLONG :Result:=SCE_KERNEL_ERROR_ENAMETOOLONG ;
EHOSTDOWN :Result:=SCE_KERNEL_ERROR_EHOSTDOWN ;
EHOSTUNREACH :Result:=SCE_KERNEL_ERROR_EHOSTUNREACH ;
ENOTEMPTY :Result:=SCE_KERNEL_ERROR_ENOTEMPTY ;
EPROCLIM :Result:=SCE_KERNEL_ERROR_EPROCLIM ;
EUSERS :Result:=SCE_KERNEL_ERROR_EUSERS ;
EDQUOT :Result:=SCE_KERNEL_ERROR_EDQUOT ;
ESTALE :Result:=SCE_KERNEL_ERROR_ESTALE ;
EREMOTE :Result:=SCE_KERNEL_ERROR_EREMOTE ;
EBADRPC :Result:=SCE_KERNEL_ERROR_EBADRPC ;
ERPCMISMATCH :Result:=SCE_KERNEL_ERROR_ERPCMISMATCH ;
EPROGUNAVAIL :Result:=SCE_KERNEL_ERROR_EPROGUNAVAIL ;
EPROGMISMATCH :Result:=SCE_KERNEL_ERROR_EPROGMISMATCH ;
EPROCUNAVAIL :Result:=SCE_KERNEL_ERROR_EPROCUNAVAIL ;
ENOLCK :Result:=SCE_KERNEL_ERROR_ENOLCK ;
ENOSYS :Result:=SCE_KERNEL_ERROR_ENOSYS ;
EFTYPE :Result:=SCE_KERNEL_ERROR_EFTYPE ;
EAUTH :Result:=SCE_KERNEL_ERROR_EAUTH ;
ENEEDAUTH :Result:=SCE_KERNEL_ERROR_ENEEDAUTH ;
EIDRM :Result:=SCE_KERNEL_ERROR_EIDRM ;
ENOMSG :Result:=SCE_KERNEL_ERROR_ENOMSG ;
EOVERFLOW :Result:=SCE_KERNEL_ERROR_EOVERFLOW ;
ECANCELED :Result:=SCE_KERNEL_ERROR_ECANCELED ;
EILSEQ :Result:=SCE_KERNEL_ERROR_EILSEQ ;
ENOATTR :Result:=SCE_KERNEL_ERROR_ENOATTR ;
EDOOFUS :Result:=SCE_KERNEL_ERROR_EDOOFUS ;
EBADMSG :Result:=SCE_KERNEL_ERROR_EBADMSG ;
EMULTIHOP :Result:=SCE_KERNEL_ERROR_EMULTIHOP ;
ENOLINK :Result:=SCE_KERNEL_ERROR_ENOLINK ;
EPROTO :Result:=SCE_KERNEL_ERROR_EPROTO ;
ENOTCAPABLE :Result:=SCE_KERNEL_ERROR_ENOTCAPABLE ;
ECAPMODE :Result:=SCE_KERNEL_ERROR_ECAPMODE ;
ENOBLK :Result:=SCE_KERNEL_ERROR_ENOBLK ;
EICV :Result:=SCE_KERNEL_ERROR_EICV ;
ENOPLAYGOENT :Result:=SCE_KERNEL_ERROR_ENOPLAYGOENT ;
EREVOKE :Result:=SCE_KERNEL_ERROR_EREVOKE ;
ESDKVERSION :Result:=SCE_KERNEL_ERROR_ESDKVERSION ;
ESTART :Result:=SCE_KERNEL_ERROR_ESTART ;
ESTOP :Result:=SCE_KERNEL_ERROR_ESTOP ;
else
Result:=SCE_KERNEL_ERROR_UNKNOWN;
end;
end;
var
_error:QWORD;
function lc_set_errno(r:Integer):Integer;
begin
if (r<>0) then
begin
_error:=r;
Exit(-1);
end;
Result:=r;
end;
function ps4___error:Pointer; SysV_ABI_CDecl;
begin
//Writeln('___error');
Result:=@_error;
end;
Const
_stack_chk_guard:QWORD=$deadbeefa55a857;
ps4_stack_chk_guard:Pointer=@_stack_chk_guard;
procedure ps4_stack_chk_fail; SysV_ABI_CDecl;
begin
Writeln('Stack overflow detected! Aborting program.');
end;
{$I StopNotificationReason.inc}
// eStopNotificationReason
procedure ps4_sceKernelDebugRaiseException(dwStopReason,dwStopId:DWORD); SysV_ABI_CDecl;
begin
Writeln(StdErr,'RaiseException:',HexStr(dwStopReason,8),':',HexStr(dwStopId,8),':',GetStopReasonInfo(dwStopReason));
end;
procedure ps4_sceKernelDebugRaiseExceptionOnReleaseMode; assembler;
asm
xor %rax,%rax
end;
//ps4 neo mode is support? (Ps4 Pro)
function ps4_sceKernelIsNeoMode:Integer; SysV_ABI_CDecl;
begin
Result:=0; //no
//Result:=1; //yes
end;
//void * _aligned_malloc(
// size_t size,
// size_t alignment
//);
//void _aligned_free (
// void *memblock
//);
const
_SIG_WORDS =4;
_SIG_MAXSIG =128;
//_SIG_IDX(sig) ((sig) - 1)
//_SIG_WORD(sig) (_SIG_IDX(sig) >> 5)
//_SIG_BIT(sig) (1U << (_SIG_IDX(sig) & 31))
//_SIG_VALID(sig) ((sig) <= _SIG_MAXSIG && (sig) > 0)
SIG_BLOCK =1;
SIG_UNBLOCK =2;
SIG_SETMASK =3;
SIGPROCMASK_OLD =$0001;
SIGPROCMASK_PROC_LOCKED =$0002;
SIGPROCMASK_PS_LOCKED =$0004;
SIGPROCMASK_FASTBLK =$0008;
type
P__sigset_t=^__sigset_t;
__sigset_t=packed record
__bits:array[0.._SIG_WORDS-1] of DWORD;
end;
//function sigfillset(_set:P__sigset_t):Integer;
procedure ps4_sigfillset; assembler; nostackframe;
label
_end;
asm
xor %eax, %eax
dec %eax
test %rdi,%rdi
je _end
xor %rax, %rax
mov %rax, (%rdi) //0+1
mov %rax, 0x8(%rdi) //2+3
_end:
end;
function ps4_sigprocmask(how:Integer;_set,oldset:P__sigset_t):Integer; SysV_ABI_CDecl;
begin
//Writeln('sigprocmask:',how);
//if (_set<>nil) and (oldset<>nil) then oldset^:=_set^;
Result:=0;
end;
function ps4__sigprocmask(how:QWORD;_set,oldset:P__sigset_t):Integer; cdecl; SysV_ABI_CDecl;
begin
//Writeln('_sigprocmask:',how);
if (_set<>nil) and (oldset<>nil) then oldset^:=_set^;
Result:=0;
end;
function ps4_is_signal_return(P:Pointer):Integer; SysV_ABI_CDecl;
begin
Writeln('_is_signal_return:',HexStr(P));
Result:=1;
end;
function ps4_sceKernelGetModuleInfoFromAddr(Addr:Pointer;P2:Integer;pOut:PKernelModuleInfo):Integer; SysV_ABI_CDecl;
var
node:TElf_node;
begin
Writeln('GetModuleInfoFromAddr:',HexStr(Addr),':',P2,':',HexStr(pOut));
node:=ps4_app.FindFileByCodeAdr(Addr);
if (node=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if pOut<>nil then
begin
pOut^:=Telf_file(node).ModuleInfo;
end;
Result:=0;
end;
type
PInternalSegmentInfo=^TInternalSegmentInfo;
TInternalSegmentInfo=packed record
address:Pointer;
size:DWORD;
end;
function ps4_sceKernelInternalMemoryGetModuleSegmentInfo(pOut:PInternalSegmentInfo):Integer; SysV_ABI_CDecl;
begin
pOut^.address:=nil;
pOut^.size:=0;
Result:=0;
//sceKernelGetLibkernelTextLocation(pOut^.address,pOut^.size)
end;
function ps4_sceKernelGetProcParam:Pointer; SysV_ABI_CDecl;
var
elf:Telf_file;
Param:PSceProcParam;
begin
Result:=nil;
Writeln('KernelGetProcParam');
elf:=Telf_file(ps4_program.ps4_app.prog);
if (elf=nil) then Exit;
if (elf.pProcParam=0) then Exit;
Param:=elf.mMap.pAddr+elf.pProcParam;
Result:=Param;
end;
type
PAppHeapAPI=^TAppHeapAPI;
TAppHeapAPI=packed record
_malloc,_free:Pointer;
end;
procedure ps4_sceKernelRtldSetApplicationHeapAPI(heap_api:PAppHeapAPI); SysV_ABI_CDecl;
begin
Writeln('SetApplicationHeapAPI:',HexStr(heap_api));
Writeln(HexStr(heap_api^._malloc)); //__malloc
Writeln(HexStr(heap_api^._free)); //__free
end;
//registred destroy proc?
function ps4_sceKernelSetThreadDtors(Proc:TProcedure):Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelSetThreadDtors:',HexStr(proc));
Result:=0;
end;
type
TKernelAtexitFunc=function(param:Integer):Integer;
//registred thread atexit proc?
function ps4_sceKernelSetThreadAtexitCount(proc:TKernelAtexitFunc):Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelSetThreadAtexitCount:',HexStr(proc));
Result:=0;
end;
type
TKernelAtexitReportFunc=procedure(param:Integer);
function ps4_sceKernelSetThreadAtexitReport(proc:TKernelAtexitReportFunc):Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelSetThreadAtexitReport:',HexStr(proc));
Result:=0;
end;
//extern "C" {
//int user_malloc_init(void);
//int user_malloc_finalize(void);
//void *user_malloc(size_t size);
//void user_free(void *ptr);
//void *user_calloc(size_t nelem, size_t size);
//void *user_realloc(void *ptr, size_t size);
//void *user_memalign(size_t boundary, size_t size);
//int user_posix_memalign(void **ptr, size_t boundary, size_t size);
//void *user_reallocalign(void *ptr, size_t size, size_t boundary);
//int user_malloc_stats(SceLibcMallocManagedSize *mmsize);
//int user_malloc_stats_fast(SceLibcMallocManagedSize *mmsize);
//size_t user_malloc_usable_size(void *ptr);
//}
//PlayStation®4 Clang: UndefinedBehaviorSanitizer (UBSan)
function ps4_sceKernelGetSanitizerNewReplaceExternal():Pointer; SysV_ABI_CDecl;
begin
//list mem of proc????
Result:=nil;
end;
function ps4_sceKernelIsAddressSanitizerEnabled({name:Pchar}):Integer; SysV_ABI_CDecl;
begin
Writeln('sceKernelIsAddressSanitizerEnabled:'{,name});
Result:=0;
end;
type
SceKernelModule=Integer;
PSceKernelLoadModuleOpt=^SceKernelLoadModuleOpt;
SceKernelLoadModuleOpt=packed record
size:size_t;
end;
//dynamic load????
function ps4_sceKernelLoadStartModule(moduleFileName:Pchar;
argc:size_t;
argp:PPchar;
flags:DWORD;
pOpt:PSceKernelLoadModuleOpt;
pRes:PInteger):SceKernelModule; SysV_ABI_CDecl;
begin
Writeln('Load Lib:',moduleFileName);
Result:=1;
end;
function ps4_memset(ptr:Pointer;value:Integer;num:size_t):Pointer; assembler; nostackframe;
asm
//mov %rdx , %rdx //3->2
mov %rsi , %r8 //2->3
mov %rdi , %rcx //1
jmp FillByte
end;
function ps4_memcmp(buf1,buf2:Pointer;count:size_t):Integer; assembler; nostackframe;
asm
mov %rdx , %r8 //3
mov %rsi , %rdx //2
mov %rdi , %rcx //1
jmp CompareByte
end;
function ps4_memcpy_s(dst:Pointer;dstSize:size_t;src:Pointer;count:size_t):Integer; SysV_ABI_CDecl;
begin
if (count=0) then Exit(0);
if (dst=nil) or (src=nil) then
begin
if (dst<>nil) then FillChar(dst^,dstSize,0);
lc_set_errno(EINVAL);
Exit(EINVAL);
end;
if (dstSize<count) then
begin
FillChar(dst^,dstSize,0);
lc_set_errno(ERANGE);
Exit(ERANGE);
end;
Move(src^,dst^,count);
Result:=0;
end;
function ps4_strcpy_s(dst:PChar;destSize:size_t;src:PChar):Integer; SysV_ABI_CDecl;
var
count:size_t;
begin
if (dst=nil) or (src=nil) then
begin
if (dst<>nil) then dst[0]:=#0;
lc_set_errno(EINVAL);
Exit(EINVAL);
end;
count:=System.strlen(src)+1;
if (count>destSize) then
begin
dst[0]:=#0;
lc_set_errno(ERANGE);
Exit(ERANGE);
end;
Move(src^,dst^,count);
Result:=0;
end;
function ps4_memmove(dst,src:Pointer;len:size_t):Pointer; assembler; nostackframe;
asm
mov %rdx, %r8 //3
mov %rsi, %rcx //2->1
mov %rdi, %rdx //1->2
call Move
end;
const
SCE_LIBC_MSPACE_THREAD_UNSAFE =($00000001);
SCE_LIBC_MSPACE_DEBUG_SHORTAGE =($00000004);
type
SceLibcMspace=^TSceLibcMspace;
TSceLibcMspace=packed record
base:Pointer;
capacity:size_t;
count:size_t;
lock:TRWLock;
end;
function ps4_sceLibcMspaceCreate(name:PChar;base:Pointer;capacity:size_t;flag:Integer):SceLibcMspace; SysV_ABI_CDecl;
begin
Result:=nil;
if ((QWORD(base) and $F)<>0) or ((capacity and $F)<>0) then Exit;
if (capacity<=1440) then Exit;
Writeln('sceLibcMspaceCreate:',name,':',HexStr(base),'..',HexStr(base+capacity));
Result:=AllocMem(SizeOf(TSceLibcMspace));
Result^.base:=base;
Result^.capacity:=capacity;
Result^.count:=1440;
rwlock_init(Result^.lock);
end;
function ps4_sceLibcMspaceMalloc(msp:SceLibcMspace;size:size_t):Pointer; SysV_ABI_CDecl;
begin
Result:=nil;
if (msp=nil) then Exit;
rwlock_wrlock(msp^.lock);
if (msp^.count+size)>msp^.capacity then Exit;
Result:=msp^.base+msp^.count;
msp^.count:=msp^.count+size;
rwlock_unlock(msp^.lock);
end;
function ps4_expf(x:Single):Single; SysV_ABI_CDecl;
begin
Result:=System.Exp(x);
end;
type
PGetTraceInfo=^TGetTraceInfo;
TGetTraceInfo=packed record
Size:QWORD; //32
flag:DWORD; //1
get_segment_info:DWORD; //0
Unknow4:Pointer; //[2]
Unknow5:Pointer; //[3]
end;
var
td1:Pointer=Pointer($101);
td2:Pointer=Pointer($202);
//mysterious function
procedure ps4_sceLibcHeapGetTraceInfo(P:PGetTraceInfo); SysV_ABI_CDecl;
begin
P^.get_segment_info:=0;
P^.Unknow4:=@td1;
P^.Unknow5:=@td2;
end;
function ps4_sceSysmoduleLoadModule(id:Word):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSysmoduleLoadModule:',HexStr(id,4)); //libSceNgs2.sprx SCE_SYSMODULE_NGS2 0x000B
Result:=0;
end;
function ps4_sceSysmoduleUnloadModule(id:Word):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSysmoduleUnloadModule:',HexStr(id,4));
Result:=0;
end;
function ps4_sceSysmoduleIsLoaded(id:Word):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSysmoduleIsLoaded:',HexStr(id,4));
Result:=0;
end;
const
__progname:PChar='progname.elf';
Const
Need_sceLibcInternal:QWORD=1;
_Stdin :QWORD=0;
_Stdout:QWORD=1;
_Stderr:QWORD=2;
function _get_proc_libSceLibcInternal(src:PLIBRARY;nid:QWORD):Pointer;
var
lib:PLIBRARY;
begin
Result:=src^._get_proc(nid);
if (Result=nil) then
begin
Case nid of
$78B743C3A974FDB5: //snprintf
begin
lib:=ps4_app.GetLib('libc');
if (lib<>nil) then
begin
Result:=lib^.get_proc(Nid);
end;
end;
$F33B2ED385CDB19E: //expf
begin
lib:=ps4_app.GetLib('libc');
if (lib<>nil) then
begin
Result:=lib^.get_proc(Nid);
end;
if (Result=nil) then
begin
Result:=@ps4_expf;
end;
end;
end;
if (Result<>nil) then
begin
src^.set_proc(nid,Result);
end;
end;
end;
function Load_libSceLibcInternal(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceLibcInternal');
lib^.Fget_proc_cb:=@_get_proc_libSceLibcInternal;
lib^.set_proc($653E0E0C3D93B3DA,@Need_sceLibcInternal);
lib^.set_proc($D530E8FC89AA9097,@_Stdin );
lib^.set_proc($DAC5B3858A851F81,@_Stdout);
lib^.set_proc($1FC029ACA799B4D8,@_Stderr);
lib^.set_proc($F334C5BC120020DF,@ps4_memset);
lib^.set_proc($0DF8AF3C0AE1B9C8,@ps4_memcmp);
lib^.set_proc($3452ECF9D44918D8,@ps4_memcpy_s);
lib^.set_proc($E576B600234409DA,@ps4_strcpy_s);
lib^.set_proc($437541C425E1507B,@ps4_memmove);//memcpy
lib^.set_proc($FE19F5B5C547AB94,@ps4_sceLibcMspaceCreate);
lib^.set_proc($3898E6FD03881E52,@ps4_sceLibcMspaceMalloc);
lib:=Result._add_lib('libSceLibcInternalExt');
lib^.set_proc($356B53375D1C2731,@ps4_sceLibcHeapGetTraceInfo);
end;
function Load_libSceSysmodule(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceSysmodule');
lib^.set_proc($83C70CDFD11467AA,@ps4_sceSysmoduleLoadModule);
lib^.set_proc($791D9B6450005344,@ps4_sceSysmoduleUnloadModule);
lib^.set_proc($7CC3F934750E68C9,@ps4_sceSysmoduleIsLoaded);
end;
function Load_libkernel(Const name:RawByteString):TElf_node;
var
lib,px:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libkernel');
lib^.set_proc($BCD7B5C387622C2B,@_dynamic_tls_get_addr);
lib^.set_proc($763C713A65BAFDAC,@__progname);
lib^.set_proc($F41703CA43E6A352,@ps4___error);
lib^.set_proc($7FBB8EC58F663355,@ps4_stack_chk_guard);
lib^.set_proc($3AEDE22F569BBE78,@ps4_stack_chk_fail);
lib^.set_proc($91BC385071D2632D,@ps4_pthread_cxa_finalize);
lib^.set_proc($38C0D128A019F08E,@ps4_sceKernelDebugRaiseException);
lib^.set_proc($CC4FF05C86632E83,@ps4_sceKernelDebugRaiseExceptionOnReleaseMode);
lib^.set_proc($5644C0B2B643709D,@ps4_sigfillset);
lib^.set_proc($68F732A6D6CE899B,@ps4_sigprocmask);
lib^.set_proc($EB1569CB415DABE2,@ps4__sigprocmask);
lib^.set_proc($72B6F98FB9A49357,@ps4_is_signal_return);
lib^.set_proc($93E017AAEDBF7817,@ps4_getpagesize);
lib^.set_proc($04F13DB3DBD0417A,@ps4_mmap);
lib^.set_proc($52A0C68D7039C943,@ps4_munmap);
lib^.set_proc($B59638F9264D1610,@ps4_msync);
lib^.set_proc($FD84D6FAA5DCDC24,@ps4_sceKernelInternalMemoryGetModuleSegmentInfo);
lib^.set_proc($7FB28139A7F2B17A,@ps4_sceKernelGetModuleInfoFromAddr);
lib^.set_proc($F79F6AADACCF22B8,@ps4_sceKernelGetProcParam);
lib^.set_proc($A7911C41E11E2401,@ps4_sceKernelRtldSetApplicationHeapAPI);
lib^.set_proc($ACD856CFE96F38C5,@ps4_sceKernelSetThreadDtors);
lib^.set_proc($A41FF2199DA743DA,@ps4_sceKernelSetThreadAtexitCount);
lib^.set_proc($5A109CD70DC48522,@ps4_sceKernelSetThreadAtexitReport);
lib^.set_proc($6E7671620005780D,@ps4_sceKernelGetSanitizerNewReplaceExternal);
lib^.set_proc($8E1FBC5E22B82DE1,@ps4_sceKernelIsAddressSanitizerEnabled);
lib^.set_proc($C33BEA4F852A297F,@ps4_sceKernelLoadStartModule);
//mutex
lib^.set_proc($7501D612C26DA04E,@ps4_pthread_mutexattr_init);
lib^.set_proc($1C5EE52B8EB1CE36,@ps4_pthread_mutexattr_destroy);
lib^.set_proc($19916523B461B90A,@ps4_pthread_mutexattr_gettype);
lib^.set_proc($9839A030E19552A8,@ps4_pthread_mutexattr_settype);
lib^.set_proc($3E62FF4F0294CD72,@ps4_pthread_mutexattr_getpshared);
lib^.set_proc($117BF7CED1AAB433,@ps4_pthread_mutexattr_setpshared);
lib^.set_proc($C83696C54139D2CD,@ps4_pthread_mutexattr_getprotocol);
lib^.set_proc($E6DC4A7DC3140289,@ps4_pthread_mutexattr_setprotocol);
lib^.set_proc($FA6F3EAAEA8EC213,@ps4_pthread_mutexattr_getprioceiling);
lib^.set_proc($64BBDFEA55407383,@ps4_pthread_mutexattr_setprioceiling);
lib^.set_proc($B6D1CD7D4FAA0C15,@ps4_pthread_mutex_init);
lib^.set_proc($96D09F686AF62461,@ps4_pthread_mutex_destroy);
lib^.set_proc($EC7D224CE7224CBA,@ps4_pthread_mutex_lock);
lib^.set_proc($D99F8FA58E826898,@ps4_pthread_mutex_unlock);
lib^.set_proc($228F7E9D329766D0,@ps4_pthread_mutex_timedlock);
lib^.set_proc($2BF8D785BB76827E,@ps4_pthread_mutex_trylock);
lib^.set_proc($17C6D41F0006DBCE,@ps4_scePthreadMutexattrInit);
lib^.set_proc($B2658492D8B2C86D,@ps4_scePthreadMutexattrDestroy);
lib^.set_proc($82AB84841AD2DA2C,@ps4_scePthreadMutexattrGettype);
lib^.set_proc($88CA7C42913E5CEE,@ps4_scePthreadMutexattrSettype);
lib^.set_proc($1A84E615EBA2FA14,@ps4_scePthreadMutexattrGetprotocol);
lib^.set_proc($D451AF5348BDB1A4,@ps4_scePthreadMutexattrSetprotocol);
lib^.set_proc($4A08CCA721FD67D2,@ps4_scePthreadMutexattrGetprioceiling);
lib^.set_proc($E77D8869082EC0C8,@ps4_scePthreadMutexattrSetprioceiling);
lib^.set_proc($726A3544862F6BDA,@ps4_scePthreadMutexInit);
lib^.set_proc($D8E7F47FEDE68611,@ps4_scePthreadMutexDestroy);
lib^.set_proc($F542B5BCB6507EDE,@ps4_scePthreadMutexLock);
lib^.set_proc($21A7C8D8FC5C3E74,@ps4_scePthreadMutexTimedlock);
lib^.set_proc($B67DD5943D211BAD,@ps4_scePthreadMutexUnlock);
lib^.set_proc($BA9A15AF330715E1,@ps4_scePthreadMutexTrylock);
//mutex
//rwlock
lib^.set_proc($C4579BB00E18B052,@ps4_pthread_rwlockattr_init);
lib^.set_proc($AAC7668178EA4A09,@ps4_pthread_rwlockattr_destroy);
lib^.set_proc($97E6C6E5FB189218,@ps4_pthread_rwlockattr_gettype_np);
lib^.set_proc($F0DB8E1E24EBD55C,@ps4_pthread_rwlockattr_settype_np);
lib^.set_proc($56A10CB82BFFA876,@ps4_pthread_rwlockattr_getpshared);
lib^.set_proc($3AE2A0FA44430FB5,@ps4_pthread_rwlockattr_setpshared);
lib^.set_proc($CAD4142CDFE784BE,@ps4_pthread_rwlock_init);
lib^.set_proc($D78EF56A33F3C61D,@ps4_pthread_rwlock_destroy);
lib^.set_proc($8868ECAF5580B48D,@ps4_pthread_rwlock_rdlock);
lib^.set_proc($B08951BD0AAC3766,@ps4_pthread_rwlock_wrlock);
lib^.set_proc($485C5330E7EE0A41,@ps4_pthread_rwlock_tryrdlock);
lib^.set_proc($5E15879FA3F947B5,@ps4_pthread_rwlock_trywrlock);
lib^.set_proc($12098BA3A11682CA,@ps4_pthread_rwlock_unlock);
lib^.set_proc($E942C06B47EAE230,@ps4_scePthreadRwlockInit);
lib^.set_proc($041FA46F4F1397D0,@ps4_scePthreadRwlockDestroy);
lib^.set_proc($3B1F62D1CECBE70D,@ps4_scePthreadRwlockRdlock);
lib^.set_proc($9AA74DA2BAC1FA02,@ps4_scePthreadRwlockWrlock);
lib^.set_proc($5C3DE60DEC9B0A79,@ps4_scePthreadRwlockTryrdlock);
lib^.set_proc($6C81E86424E89AC2,@ps4_scePthreadRwlockTrywrlock);
lib^.set_proc($F8BF7C3C86C6B6D9,@ps4_scePthreadRwlockUnlock);
//rwlock
//Sema
lib^.set_proc($A43B8F11FDE6E1F2,@ps4_sem_init);
lib^.set_proc($7035B6DF7440C16A,@ps4_sem_destroy);
lib^.set_proc($06AF8B455FCDE879,@ps4_sem_getvalue);
lib^.set_proc($20A3FCB72A744149,@ps4_sem_post);
lib^.set_proc($C39207CAF6A183FA,@ps4_sem_timedwait);
lib^.set_proc($5815B3B1189F0840,@ps4_sem_trywait);
lib^.set_proc($602579746181702A,@ps4_sem_wait);
lib^.set_proc($D7CF31E7B258A748,@ps4_sceKernelCreateSema);
lib^.set_proc($47526F9FC6D2096F,@ps4_sceKernelDeleteSema);
lib^.set_proc($6716B45614154EC9,@ps4_sceKernelWaitSema);
lib^.set_proc($E1CCE9A47062AE2C,@ps4_sceKernelSignalSema);
lib^.set_proc($D76C0E1E4F32C1BD,@ps4_sceKernelPollSema);
lib^.set_proc($E03334E94D813446,@ps4_sceKernelCancelSema);
//Sema
//cond
lib^.set_proc($D13C959383122EDD,@ps4_pthread_cond_init);
lib^.set_proc($9A4C767D584D32C8,@ps4_pthread_cond_broadcast);
lib^.set_proc($9B9FF66EC35FBFBB,@ps4_scePthreadCondattrInit);
lib^.set_proc($C1A3DCC58891DD60,@ps4_scePthreadCondattrDestroy);
lib^.set_proc($D936FDDAABA9AE5D,@ps4_scePthreadCondInit);
lib^.set_proc($83E3D977686269C8,@ps4_scePthreadCondDestroy);
lib^.set_proc($90387F35FC6032D1,@ps4_scePthreadCondSignal);
lib^.set_proc($58A0172785C13D0E,@ps4_scePthreadCondWait);
lib^.set_proc($06632363199EC35C,@ps4_scePthreadCondTimedwait);
lib^.set_proc($246823ED4BEB97E0,@ps4_scePthreadCondBroadcast);
//cond
//thread
lib^.set_proc($9EC628351CB0C0D8,@ps4_scePthreadAttrInit);
lib^.set_proc($EB6282C04326CDC3,@ps4_scePthreadAttrDestroy);
lib^.set_proc($5135F325B5A18531,@ps4_scePthreadAttrSetstacksize);
lib^.set_proc($FD6ADEA6BB6ED10B,@ps4_scePthreadAttrSetdetachstate);
lib^.set_proc($E3E87D133C0A1782,@ps4_scePthreadAttrSetschedpolicy);
lib^.set_proc($0F3112F61405E1FE,@ps4_scePthreadAttrSetschedparam);
lib^.set_proc($DEAC603387B31130,@ps4_scePthreadAttrSetaffinity);
lib^.set_proc($7976D44A911A4EC0,@ps4_scePthreadAttrSetinheritsched);
lib^.set_proc($E9482DC15FB4CDBE,@ps4_scePthreadCreate);
lib^.set_proc($E2A1AB47A7A83FD6,@ps4_scePthreadDetach);
lib^.set_proc($A27358F41CA7FD6F,@ps4_scePthreadJoin);
lib^.set_proc($DE483BAD3D0D408B,@ps4_scePthreadExit);
lib^.set_proc($128B51F1ADC049FE,@ps4_pthread_self);
lib^.set_proc($688F8E782CFCC6B4,@ps4_scePthreadSelf);
lib^.set_proc($1E8C3B07C39EB7A9,@ps4_scePthreadGetname);
lib^.set_proc($181518EF2C1D50B1,@ps4_scePthreadRename);
lib^.set_proc($6EDDC24C12A61B22,@ps4_scePthreadSetaffinity);
lib^.set_proc($D6D2B21BB465309A,@ps4_scePthreadGetprio);
lib^.set_proc($5B41E99B65F4B8F1,@ps4_scePthreadSetprio);
lib^.set_proc($4FBDA1CFA7DFAB4F,@ps4_scePthreadYield);
//thread
lib^.set_proc($5AC95C2B51507062,@ps4_sceKernelIsNeoMode);
lib^.set_proc($A4EF7A4F0CCE9B91,@ps4_sceKernelGetDirectMemorySize);
lib^.set_proc($AD35F0EB9C662C80,@ps4_sceKernelAllocateDirectMemory);
lib^.set_proc($2FF4372C48C86E00,@ps4_sceKernelMapDirectMemory);
lib^.set_proc($98BF0D0C7F3A8902,@ps4_sceKernelMapNamedFlexibleMemory);
lib^.set_proc($21620105D4C78ADE,@ps4_sceKernelMapFlexibleMemory);
lib^.set_proc($71091EF54B8140E9,@ps4_sceKernelMunmap);
lib^.set_proc($58571F2F697389DA,@ps4_sceKernelQueryMemoryProtection);
//queue
lib^.set_proc($0F439D14C8E9E3A2,@ps4_sceKernelCreateEqueue);
lib^.set_proc($7F3C8C2ACF648A6D,@ps4_sceKernelWaitEqueue);
lib^.set_proc($BF3FA9836CDDA292,@ps4_sceKernelGetEventUserData);
//queue
//time
lib^.set_proc($9FCF2FC770B99D6F,@ps4_gettimeofday);
lib^.set_proc($94B313F6F240724D,@ps4_clock_gettime);
lib^.set_proc($D63DD2DE7FED4D6E,@ps4_sceKernelGetTscFrequency);
lib^.set_proc($FF62115023BFFCF3,@ps4_sceKernelReadTsc);
lib^.set_proc($4018BB1C22B4DE1C,@ps4_sceKernelClockGettime);
lib^.set_proc($E09DAC5099AE1D94,@ps4_sceKernelGetProcessTime);
lib^.set_proc($C92F14D931827B50,@ps4_nanosleep);
lib^.set_proc($41CB5E4706EC9D5D,@ps4_usleep);
lib^.set_proc($D637D72D15738AC7,@ps4_sceKernelUsleep);
//time
//file
lib^.set_proc($D46DE51751A0D64F,@ps4_sceKernelOpen);
lib^.set_proc($A226FBE85FF5D9F9,@ps4_sceKernelLseek);
lib^.set_proc($E304B37BDD8184B2,@ps4_sceKernelWrite);
lib^.set_proc($0A0E2CAD9E9329B5,@ps4_sceKernelRead);
lib^.set_proc($FABDEB305C08B55E,@ps4_sceKernelPread);
lib^.set_proc($50AD939760D6527B,@ps4_sceKernelClose);
lib^.set_proc($171559A81000EE4B,@ps4_write);
lib^.set_proc($0D1B81B76A6F2029,@ps4_read);
lib^.set_proc($D7F2C52E6445C713,@ps4_sceKernelMkdir);
lib^.set_proc($795F70003DAB8880,@ps4_sceKernelStat);
lib^.set_proc($13A6A8DF8C0FC3E5,@ps4_stat);
lib^.set_proc($246322A3EDB52F87,@ps4_mkdir);
//file
px:=Result._add_lib('libScePosix');
px^.MapSymbol:=lib^.MapSymbol;
end;
initialization
ps4_app.RegistredPreLoad('libSceLibcInternal.prx',@Load_libSceLibcInternal);
ps4_app.RegistredPreLoad('libSceSysmodule.prx',@Load_libSceSysmodule);
ps4_app.RegistredPreLoad('libkernel.prx',@Load_libkernel);
end.

1450
ps4_libkerenel/ps4_map_mm.pas Normal file
View File

File diff suppressed because it is too large Load Diff

578
ps4_libkerenel/ps4_mutex.pas Normal file
View File

@ -0,0 +1,578 @@
unit ps4_mutex;
{$mode objfpc}{$H+}
interface
uses
Windows,
sysutils,
ps4_types;
type
Ppthread_mutex_attr=^pthread_mutex_attr_t;
pthread_mutex_attr_t=bitpacked record
_type:0..7; //3
_shared:0..1; //1
_protocol:0..3; //2
_align:0..67108863; //26
_prioceiling:Integer; //32
end;
Ppthread_mutex=^pthread_mutex;
pthread_mutex=^pthread_mutex_t;
pthread_mutex_t=packed record
valid:DWORD;
state:DWORD;
_type:DWORD;
rec_lock:DWORD;
owner:DWORD;
event:THandle;
name:array[0..31] of AnsiChar;
end;
ScePthreadMutex=pthread_mutex;
PScePthreadMutex=Ppthread_mutex;
const
SCE_PTHREAD_MUTEX_ERRORCHECK = 1; // Default POSIX mutex
SCE_PTHREAD_MUTEX_RECURSIVE = 2; // Recursive mutex
SCE_PTHREAD_MUTEX_NORMAL = 3; // No error checking
SCE_PTHREAD_MUTEX_ADAPTIVE = 4; // Adaptive mutex, spins briefly before blocking on lock
SCE_PTHREAD_MUTEX_DEFAULT = SCE_PTHREAD_MUTEX_ERRORCHECK;
PTHREAD_MUTEX_ERRORCHECK = SCE_PTHREAD_MUTEX_ERRORCHECK;
PTHREAD_MUTEX_RECURSIVE = SCE_PTHREAD_MUTEX_RECURSIVE;
PTHREAD_MUTEX_NORMAL = SCE_PTHREAD_MUTEX_NORMAL;
PTHREAD_MUTEX_ADAPTIVE = SCE_PTHREAD_MUTEX_ADAPTIVE;
PTHREAD_MUTEX_DEFAULT = SCE_PTHREAD_MUTEX_ERRORCHECK;{SCE_PTHREAD_MUTEX_RECURSIVE;}//PTHREAD_MUTEX_ERRORCHECK;
PTHREAD_PROCESS_PRIVATE=0;
PTHREAD_PROCESS_SHARED =1;
PTHREAD_PRIO_NONE =0;
PTHREAD_PRIO_INHERIT =1;
PTHREAD_PRIO_PROTECT =2;
PTHREAD_MUTEX_INITIALIZER =0;
PTHREAD_ADAPTIVE_MUTEX_INITIALIZER_NP=1;
function ps4_pthread_mutexattr_init(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_destroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_gettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_settype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getpshared(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setpshared(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_getprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutexattr_setprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_lock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_timedlock(pMutex:Ppthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_trylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_unlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_init(pMutex:Ppthread_mutex;pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_pthread_mutex_destroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrInit(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrDestroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSettype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:Ppthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexLock(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexTimedlock(pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexTrylock(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexUnlock(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
function ps4_scePthreadMutexDestroy(pMutex:PScePthreadMutex):Integer; SysV_ABI_CDecl;
//pthread_mutexattr_setkind_np
implementation
Uses
spinlock,
ps4_sema,
ps4_libkernel,
ps4_time;
function ps4_pthread_mutexattr_init(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_mutex_attr_t);
pAttr^._type:=PTHREAD_MUTEX_DEFAULT;
Result:=0;
end;
function ps4_pthread_mutexattr_destroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Result:=0;
end;
function ps4_pthread_mutexattr_gettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_pthread_mutexattr_settype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
PTHREAD_MUTEX_ERRORCHECK:;
PTHREAD_MUTEX_RECURSIVE :;
PTHREAD_MUTEX_NORMAL :;
PTHREAD_MUTEX_ADAPTIVE :;
else
Exit(EINVAL);
end;
pAttr^._type:=t;
Result:=0;
end;
function ps4_pthread_mutexattr_getpshared(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_mutexattr_setpshared(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
PTHREAD_PROCESS_PRIVATE:;
PTHREAD_PROCESS_SHARED :;
else
Exit(EINVAL);
end;
pAttr^._shared:=t;
Result:=0;
end;
function ps4_pthread_mutexattr_getprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._protocol;
Result:=0;
end;
function ps4_pthread_mutexattr_setprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
PTHREAD_PRIO_NONE :;
PTHREAD_PRIO_INHERIT:;
PTHREAD_PRIO_PROTECT:;
else
Exit(EINVAL);
end;
pAttr^._protocol:=t;
Result:=0;
end;
function ps4_pthread_mutexattr_getprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._prioceiling;
Result:=0;
end;
function ps4_pthread_mutexattr_setprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^._prioceiling:=t;
Result:=0;
end;
///////////////////////////
Const
LIFE_MUTEX=$BAB1F00D;
DEAD_MUTEX=$DEADBEEF;
MS_Unlocked=0;
MS_Locked =1;
MS_Waiting =2;
function STATIC_INITIALIZER(m:pthread_mutex):Boolean; inline;
begin
Result:=False;
Case PtrUInt(m) of
PTHREAD_MUTEX_INITIALIZER,
PTHREAD_ADAPTIVE_MUTEX_INITIALIZER_NP:Result:=True;
end;
end;
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:SizeUInt;Comp,New:SizeUInt):Boolean; inline;
begin
Result:=system.InterlockedCompareExchange(Pointer(addr),Pointer(New),Pointer(Comp))=Pointer(Comp);
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function XCHG(Var addr:DWORD;New:DWORD):DWORD; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function mutex_impl_init(m:Ppthread_mutex;mi:pthread_mutex;_type:Integer):pthread_mutex;
var
new_mi:pthread_mutex;
begin
new_mi:=AllocMem(SizeOf(pthread_mutex_t));
if (new_mi=nil) then Exit(new_mi);
new_mi^.valid:=LIFE_MUTEX;
new_mi^.state:=MS_Unlocked;
new_mi^._type:=_type;
new_mi^.owner:=DWORD(-1);
if CAS(m^,mi,new_mi) then
begin
Result:=new_mi;
end else
begin
FreeMem(new_mi);
Result:=m^;
end;
end;
function mutex_impl(m:Ppthread_mutex;var mi:pthread_mutex;default:Integer):Integer;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
Case PtrUInt(mi) of
PTHREAD_MUTEX_INITIALIZER :mi:=mutex_impl_init(m,mi,default);
PTHREAD_ADAPTIVE_MUTEX_INITIALIZER_NP:mi:=mutex_impl_init(m,mi,PTHREAD_MUTEX_ADAPTIVE);
end;
if (mi=nil) then Exit(ENOMEM);
if (mi^.valid<>LIFE_MUTEX) then Exit(EINVAL);
Result:=0;
end;
function pthread_mutex_lock_intern(m:Ppthread_mutex;timeout:DWORD;default:Integer):Integer;
var
mi:pthread_mutex;
old_state:DWORD;
ev:THandle;
begin
Result:=mutex_impl(m,mi,default);
if (Result<>0) then Exit;
old_state:=XCHG(mi^.state,MS_Locked);
if (old_state<>MS_Unlocked) then
begin
if (mi^._type<>PTHREAD_MUTEX_NORMAL) then
if (mi^.owner=GetCurrentThreadId) then
begin
CAS(mi^.state,MS_Locked,old_state);
if (mi^._type=PTHREAD_MUTEX_RECURSIVE) then
begin
Inc(mi^.rec_lock);
Exit(0);
end else
begin
Exit(EDEADLK);
end;
end;
if (mi^.event=0) then
begin
ev:=CreateEvent(nil,false,false,nil);
if (ev=0) then
Case GetLastError of
ERROR_ACCESS_DENIED:Exit(EPERM);
else
Exit(EPERM);
end;
if not CAS(mi^.event,0,ev) then
begin
CloseHandle(ev);
end;
end;
While (XCHG(mi^.state,MS_Waiting)<>MS_Unlocked) do
begin
Result:=do_sema_b_wait_intern(mi^.event,timeout);
if (Result<>0) then Exit;
end;
end;
if (mi^._type<>PTHREAD_MUTEX_NORMAL) then
begin
mi^.owner:=GetCurrentThreadId;
end;
Result:=0;
end;
function ps4_pthread_mutex_lock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_lock_intern(pMutex,INFINITE,PTHREAD_MUTEX_DEFAULT);
end;
function ps4_pthread_mutex_timedlock(pMutex:Ppthread_mutex;ts:Ptimespec):Integer; SysV_ABI_CDecl;
var
t:DWORD;
begin
if (ts=nil) then
begin
t:=INFINITE;
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ts^));
end;
Result:=pthread_mutex_lock_intern(pMutex,t,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_unlock(m:Ppthread_mutex;default:Integer):Integer;
var
mi:pthread_mutex;
begin
Result:=mutex_impl(m,mi,default);
if (Result<>0) then Exit;
if (mi^._type<>PTHREAD_MUTEX_NORMAL) then
begin
if (mi^.state=MS_Unlocked) then Exit(EPERM);
if (mi^.owner<>GetCurrentThreadId) then Exit(EPERM);
if (mi^.rec_lock>0) then
begin
Dec(mi^.rec_lock);
Exit(0);
end;
mi^.owner:=DWORD(-1);
end;
if XCHG(mi^.state,MS_Unlocked)=MS_Waiting then
begin
if not SetEvent(mi^.event) then Exit(EPERM);
end;
Result:=0;
end;
function ps4_pthread_mutex_unlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_unlock(pMutex,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_trylock(m:Ppthread_mutex;default:Integer):Integer;
var
mi:pthread_mutex;
begin
Result:=mutex_impl(m,mi,default);
if (Result<>0) then Exit;
if CAS(mi^.state,MS_Unlocked,MS_Locked) then
begin
if (mi^._type<>PTHREAD_MUTEX_NORMAL) then
begin
mi^.owner:=GetCurrentThreadId;
end;
Exit(0);
end else
begin
if (mi^._type=PTHREAD_MUTEX_RECURSIVE) and (mi^.owner=GetCurrentThreadId) then
begin
Inc(mi^.rec_lock);
Exit(0);
end;
Exit(EBUSY);
end;
end;
function ps4_pthread_mutex_trylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_trylock(pMutex,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_init(m:Ppthread_mutex;a:Ppthread_mutex_attr;str:PChar;default:Integer):Integer;
var
mi:pthread_mutex;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
if (a<>nil) then
begin
mi:=mutex_impl_init(m,mi,a^._type);
end else
begin
mi:=mutex_impl_init(m,mi,default);
end;
if (mi=nil) then Exit(ENOMEM);
if (mi^.valid<>LIFE_MUTEX) then Exit(EINVAL);
if (str<>nil) then MoveChar0(str^,mi^.name,32);
Result:=0;
end;
function ps4_pthread_mutex_init(pMutex:Ppthread_mutex;pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_init(pMutex,pAttr,nil,PTHREAD_MUTEX_DEFAULT);
end;
function pthread_mutex_destroy(m:Ppthread_mutex):Integer;
var
mi:pthread_mutex;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
if not STATIC_INITIALIZER(mi) then
begin
mi:=XCHG(m^,nil);
if STATIC_INITIALIZER(mi) then Exit(0);
if not CAS(mi^.valid,LIFE_MUTEX,DEAD_MUTEX) then Exit(EINVAL);
if (mi^.event<>0) then CloseHandle(mi^.event);
FreeMem(mi);
end;
Result:=0;
end;
function ps4_pthread_mutex_destroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_mutex_destroy(pMutex);
end;
//---------------------------------------------------------
//sce
function ps4_scePthreadMutexattrInit(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_mutex_attr_t);
pAttr^._type:=SCE_PTHREAD_MUTEX_DEFAULT;
Result:=0;
end;
function ps4_scePthreadMutexattrDestroy(pAttr:Ppthread_mutex_attr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=0;
end;
function ps4_scePthreadMutexattrGettype(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_scePthreadMutexattrSettype(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
SCE_PTHREAD_MUTEX_ERRORCHECK:;
SCE_PTHREAD_MUTEX_RECURSIVE :;
SCE_PTHREAD_MUTEX_NORMAL :;
SCE_PTHREAD_MUTEX_ADAPTIVE :;
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
pAttr^._type:=t;
Result:=0;
end;
function ps4_scePthreadMutexattrGetprotocol(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._protocol;
Result:=0;
end;
function ps4_scePthreadMutexattrSetprotocol(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
PTHREAD_PRIO_NONE :;
PTHREAD_PRIO_INHERIT:;
PTHREAD_PRIO_PROTECT:;
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
pAttr^._protocol:=t;
Result:=0;
end;
function ps4_scePthreadMutexattrGetprioceiling(pAttr:Ppthread_mutex_attr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._prioceiling;
Result:=0;
end;
function ps4_scePthreadMutexattrSetprioceiling(pAttr:Ppthread_mutex_attr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^._prioceiling:=t;
Result:=0;
end;
//////////////
function ps4_scePthreadMutexLock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexLock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_lock_intern(pMutex,INFINITE,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexLock:',HexStr(pMutex),':',HexStr(Result,8));
end;
function ps4_scePthreadMutexTimedlock(pMutex:PScePthreadMutex;usec:DWORD):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexTimedlock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_lock_intern(pMutex,_usec2msec(usec),SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexTimedlock:',HexStr(pMutex),':',HexStr(Result,8));
end;
function ps4_scePthreadMutexUnlock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexUnlock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_unlock(pMutex,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexUnlock:',HexStr(pMutex),':',pMutex^^.name,':',HexStr(Result,8));
end;
function ps4_scePthreadMutexTrylock(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePthreadMutexTrylock:',HexStr(pMutex));
Result:=px2sce(pthread_mutex_trylock(pMutex,SCE_PTHREAD_MUTEX_DEFAULT));
//if (Result<>0) then Writeln('scePthreadMutexTrylock:',HexStr(pMutex),':',HexStr(Result,8));
end;
function ps4_scePthreadMutexInit(pMutex:PScePthreadMutex;pAttr:Ppthread_mutex_attr;str:PChar):Integer; SysV_ABI_CDecl;
begin
//if str='NP CVariable Mutex' then
// writeln;
Result:=px2sce(pthread_mutex_init(pMutex,pAttr,str,SCE_PTHREAD_MUTEX_DEFAULT));
end;
function ps4_scePthreadMutexDestroy(pMutex:Ppthread_mutex):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(pthread_mutex_destroy(pMutex));
end;
end.

500
ps4_libkerenel/ps4_pthread.pas Normal file
View File

@ -0,0 +1,500 @@
unit ps4_pthread;
{$mode objfpc}{$H+}
interface
uses
windows,
Classes, SysUtils;
type
Ppthread_attr_t=^pthread_attr_t;
pthread_attr_t=^tthread_attr_t;
tthread_attr_t=packed record
policy:Integer;
sched_priority:Integer;
//prio :Integer;
suspend :Integer;
flags :Integer;
stackaddr_attr:Pointer;
stacksize_attr:size_t;
cpuset:QWORD;
//guardsize_attr:size_t;
//cpuset :Pointer;//cpuset_t
//cpusetsize :size_t;
detachstate:Integer;
end;
Ppthread=^pthread;
pthread=^pthread_t;
pthread_t=record
entry:Pointer;
arg:Pointer;
handle:TThreadID;
detachstate:Integer;
name:array[0..31] of AnsiChar;
end;
const
//Run-time invariant values:
PTHREAD_STACK_MIN=4*1024;
PTHREAD_DETACHED =$1;
PTHREAD_SCOPE_SYSTEM =$2;
PTHREAD_INHERIT_SCHED=$4;
PTHREAD_NOFLOAT =$8;
PTHREAD_CREATE_DETACHED=PTHREAD_DETACHED;
PTHREAD_CREATE_JOINABLE=0;
SCE_PTHREAD_DESTRUCTOR_ITERATIONS =4;
SCE_PTHREAD_KEYS_MAX =256;
SCE_PTHREAD_STACK_MIN =PTHREAD_STACK_MIN;
SCE_PTHREAD_THREADS_MAX =High(DWORD);
SCE_PTHREAD_BARRIER_SERIAL_THREAD =-1;
//Flags for threads and thread attributes.
SCE_PTHREAD_DETACHED =$1;
SCE_PTHREAD_INHERIT_SCHED =$4;
SCE_PTHREAD_NOFLOAT =$8;
SCE_PTHREAD_CREATE_DETACHED =SCE_PTHREAD_DETACHED;
SCE_PTHREAD_CREATE_JOINABLE =0;
SCE_PTHREAD_EXPLICIT_SCHED =0;
//Flags for read/write lock attributes
SCE_PTHREAD_PROCESS_PRIVATE =0;
SCE_PTHREAD_PROCESS_SHARED =1;
const
//POSIX scheduling policies
SCHED_FIFO =1;
SCHED_OTHER =2;
SCHED_RR =3;
// for sceKernelMsync()
SCE_KERNEL_MS_SYNC =$0;
SCE_KERNEL_MS_ASYNC =$1;
SCE_KERNEL_MS_INVALIDATE =$2;
// for sceKernelSchedGetPriorityMax()/Min()
SCE_KERNEL_SCHED_FIFO =SCHED_FIFO;
SCE_KERNEL_SCHED_RR =SCHED_RR;
SCE_KERNEL_PRIO_FIFO_DEFAULT =700;
SCE_KERNEL_PRIO_FIFO_HIGHEST =256;
SCE_KERNEL_PRIO_FIFO_LOWEST =767;
// for SceKernelCpumask
SCE_KERNEL_CPUMASK_6CPU_ALL =$3f;
SCE_KERNEL_CPUMASK_7CPU_ALL =$7f;
SCE_KERNEL_CPUMASK_USER_ALL =$3f; // obsolete
procedure ps4_pthread_cxa_finalize(P:Pointer); SysV_ABI_CDecl;
function ps4_scePthreadAttrInit(pAttr:Ppthread_attr_t):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrDestroy(pAttr:Ppthread_attr_t):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetstacksize(pAttr:Ppthread_attr_t;size:size_t):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetdetachstate(pAttr:Ppthread_attr_t;detachstate:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetschedpolicy(pAttr:Ppthread_attr_t;policy:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetschedparam(pAttr:Ppthread_attr_t;param:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetaffinity(pAttr:Ppthread_attr_t;mask:QWORD):Integer; SysV_ABI_CDecl;
function ps4_scePthreadAttrSetinheritsched(pAttr:Ppthread_attr_t;inheritSched:Integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadCreate(pthread:Ppthread;pAttr:Ppthread_attr_t;entry:Pointer;arg:Pointer;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadDetach(_pthread:pthread):Integer; SysV_ABI_CDecl;
function ps4_scePthreadJoin(_pthread:pthread;value:PPointer):Integer; SysV_ABI_CDecl;
procedure ps4_scePthreadExit(value_ptr:Pointer); SysV_ABI_CDecl;
function ps4_pthread_self():pthread; SysV_ABI_CDecl;
function ps4_scePthreadSelf():pthread; SysV_ABI_CDecl;
function ps4_scePthreadGetname(_pthread:pthread;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRename(_pthread:pthread;name:Pchar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadSetaffinity(_pthread:pthread;mask:QWORD):Integer; SysV_ABI_CDecl;
function ps4_scePthreadGetprio(_pthread:pthread;prio:PInteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadSetprio(_pthread:pthread;prio:Integer):Integer; SysV_ABI_CDecl;
procedure ps4_scePthreadYield(); SysV_ABI_CDecl;
procedure _pthread_run_entry(pthread:Ppthread);
implementation
uses
ps4_map_mm,
ps4_program,
ps4_elf,
ps4_libkernel;
//struct dl_phdr_info
procedure ps4_pthread_cxa_finalize(P:Pointer); SysV_ABI_CDecl;
begin
Writeln('__pthread_cxa_finalize');
end;
function ps4_scePthreadAttrInit(pAttr:Ppthread_attr_t):Integer; SysV_ABI_CDecl;
begin
Writeln('scePthreadAttrInit');
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
pAttr^:=AllocMem(SizeOf(tthread_attr_t));
Result:=0;
end;
function ps4_scePthreadAttrDestroy(pAttr:Ppthread_attr_t):Integer; SysV_ABI_CDecl;
begin
Writeln('scePthreadAttrDestroy');
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
FreeMem(System.InterlockedExchange(pAttr^,nil));
Result:=0;
end;
function ps4_scePthreadAttrSetstacksize(pAttr:Ppthread_attr_t;size:size_t):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
if (pAttr^=nil) then Exit;
pAttr^^.stacksize_attr:=size;
Result:=0;
end;
function ps4_scePthreadAttrSetdetachstate(pAttr:Ppthread_attr_t;detachstate:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
if (pAttr^=nil) then Exit;
Case detachstate of
PTHREAD_CREATE_JOINABLE:;
PTHREAD_CREATE_DETACHED:;
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
pAttr^^.detachstate:=detachstate;
Result:=0;
end;
function ps4_scePthreadAttrSetschedpolicy(pAttr:Ppthread_attr_t;policy:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
if (pAttr^=nil) then Exit;
pAttr^^.policy:=policy;
Result:=0;
end;
function ps4_scePthreadAttrSetschedparam(pAttr:Ppthread_attr_t;param:PInteger):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) or (param=nil) then Exit;
if (pAttr^=nil) then Exit;
pAttr^^.sched_priority:=param^;
Result:=0;
end;
function ps4_scePthreadAttrSetaffinity(pAttr:Ppthread_attr_t;mask:QWORD):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pAttr=nil) then Exit;
if (pAttr^=nil) then Exit;
pAttr^^.cpuset:=mask;
Result:=0;
end;
function ps4_scePthreadAttrSetinheritsched(pAttr:Ppthread_attr_t;inheritSched:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function CAS(Var addr:Integer;Comp,New:Integer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
procedure _free_pthread(data:pthread);
begin
System.CloseThread(data^.handle);
FreeMem(data);
end;
threadvar
_pthread_self:pthread;
function on_ps4_run_entry(data:pthread):ptrint;
type
Tps4entry=function(arg:Pointer):Pointer; SysV_ABI_CDecl;
begin
Result:=0;
RegistredStack;
ps4_app.InitThread;
While (System.InterLockedExchangeAdd(data^.handle,0)=0) do System.ThreadSwitch;
_pthread_self:=data;
ps4_app.InitCode;
Telf_file(ps4_app.prog).mapCodeEntry;
ps4_app.FreeThread;
UnRegistredStack;
end;
procedure _pthread_run_entry(pthread:Ppthread);
Var
data:pthread;
Handle,ThreadId:TThreadID;
begin
if (pthread=nil) then Exit;
data:=AllocMem(SizeOf(pthread_t));
if (data=nil) then Exit;
ThreadId:=0;
Handle:=BeginThread(TThreadFunc(@on_ps4_run_entry),data,ThreadId);
if (Handle=0) then
begin
FreeMem(data);
Exit;
end;
System.InterlockedExchange(data^.handle,Handle);
pthread^:=data;
end;
const
_PREPARE_FREE=2;
_PREPARE_JOIN=3;
function on_ps4_run_thread(data:pthread):ptrint;
type
Tps4entry=function(arg:Pointer):Pointer; SysV_ABI_CDecl;
begin
Result:=0;
ReadBarrier;
if (data<>nil) and (data^.entry<>nil) then
begin
writeln('BeginThread:',data^.name,':',HexStr(data^.entry));
RegistredStack;
ps4_app.InitThread;
While (System.InterLockedExchangeAdd(data^.handle,0)=0) do System.ThreadSwitch;
_pthread_self:=data;
data^.arg:=Tps4entry(data^.entry)(data^.arg);
ReadWriteBarrier;
ps4_app.FreeThread;
UnRegistredStack;
writeln('EndThread:',data^.name);
if CAS(data^.detachstate,PTHREAD_CREATE_DETACHED,_PREPARE_FREE) then
begin
_free_pthread(data);
end else
begin
CAS(data^.detachstate,PTHREAD_CREATE_JOINABLE,_PREPARE_JOIN);
end;
end;
end;
//typedef pthread_t ScePthread;
function ps4_scePthreadCreate(pthread:Ppthread;pAttr:Ppthread_attr_t;entry:Pointer;arg:Pointer;name:Pchar):Integer; SysV_ABI_CDecl;
Var
data:pthread;
Handle,ThreadId:TThreadID;
sa:Pointer;
ss:SizeUInt;
creationFlags:dword;
begin
Writeln('scePthreadCreate:',HexStr(entry),' ',name);
Result:=SCE_KERNEL_ERROR_EINVAL;
if (pthread=nil) then Exit;
//if {false} name='AudioOutThread' then
//if (name='streamThread') or (name='AudioOutThread') then
//if false then
begin
data:=AllocMem(SizeOf(pthread_t));
if (data=nil) then Exit(SCE_KERNEL_ERROR_ENOMEM);
data^.entry:=entry;
data^.arg:=arg;
if (name<>nil) then MoveChar0(name^,data^.name,32);
ReadWriteBarrier;
if (pAttr<>nil) and (pAttr^<>nil) then
begin
data^.detachstate:=pAttr^^.detachstate;
ReadWriteBarrier;
creationFlags:=0;
sa:=pAttr^^.stackaddr_attr;
ss:=pAttr^^.stacksize_attr;
if (ss<DefaultStackSize) then ss:=DefaultStackSize;
ThreadId:=0;
Handle:=BeginThread(sa,ss,TThreadFunc(@on_ps4_run_thread),data,creationFlags,ThreadId);
if (Handle=0) then
begin
FreeMem(data);
Exit(SCE_KERNEL_ERROR_EAGAIN);
end;
if (pAttr^^.cpuset<>0) then
begin
SetThreadAffinityMask(Handle,pAttr^^.cpuset);
end;
end else
begin
ThreadId:=0;
Handle:=BeginThread(TThreadFunc(@on_ps4_run_thread),data,ThreadId);
if (Handle=0) then
begin
FreeMem(data);
Exit(SCE_KERNEL_ERROR_EAGAIN);
end;
end;
System.InterlockedExchange(data^.handle,Handle);
pthread^:=data;
end;
Result:=0;
end;
function ps4_scePthreadDetach(_pthread:pthread):Integer; SysV_ABI_CDecl;
begin
if (_pthread=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Writeln('scePthreadDetach:',_pthread^.name);
if CAS(_pthread^.detachstate,PTHREAD_CREATE_JOINABLE,PTHREAD_CREATE_DETACHED) then
begin
Result:=0
end else
if CAS(_pthread^.detachstate,_PREPARE_JOIN,_PREPARE_FREE) then
begin
_free_pthread(_pthread);
Result:=0
end else
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
end;
end;
function ps4_scePthreadJoin(_pthread:pthread;value:PPointer):Integer; SysV_ABI_CDecl;
begin
if (_pthread=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Writeln('scePthreadJoin:',_pthread^.name);
if CAS(_pthread^.detachstate,PTHREAD_CREATE_JOINABLE,_PREPARE_FREE) then
begin
System.WaitForThreadTerminate(_pthread^.handle,INFINITE);
if (value<>nil) then value^:=_pthread^.arg;
_free_pthread(_pthread);
Result:=0;
end else
if CAS(_pthread^.detachstate,_PREPARE_JOIN,_PREPARE_FREE) then
begin
if (value<>nil) then value^:=_pthread^.arg;
_free_pthread(_pthread);
Result:=0;
end else
begin
Result:=SCE_KERNEL_ERROR_EINVAL;
end;
end;
procedure ps4_scePthreadExit(value_ptr:Pointer); SysV_ABI_CDecl;
var
data:pthread;
begin
data:=_pthread_self;
if (data=nil) then Exit;
Writeln('ExitThread:',data^.name);
data^.arg:=value_ptr;
ReadWriteBarrier;
ps4_app.FreeThread;
UnRegistredStack;
if CAS(data^.detachstate,PTHREAD_CREATE_DETACHED,_PREPARE_FREE) then
begin
_free_pthread(data);
end else
begin
CAS(data^.detachstate,PTHREAD_CREATE_JOINABLE,_PREPARE_JOIN);
end;
System.EndThread(0);
end;
function ps4_pthread_self():pthread; SysV_ABI_CDecl;
begin
Result:=_pthread_self;
end;
function ps4_scePthreadSelf():pthread; SysV_ABI_CDecl;
begin
Result:=_pthread_self;
end;
function ps4_scePthreadGetname(_pthread:pthread;name:Pchar):Integer; SysV_ABI_CDecl;
begin
if (_pthread=nil) or (name=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
MoveChar0(_pthread^.name,name^,32);
end;
function ps4_scePthreadRename(_pthread:pthread;name:Pchar):Integer; SysV_ABI_CDecl;
begin
if (_pthread=nil) or (name=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
MoveChar0(name^,_pthread^.name,32);
end;
function ps4_scePthreadSetaffinity(_pthread:pthread;mask:QWORD):Integer; SysV_ABI_CDecl;
begin
if (_pthread=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=0;
SetThreadAffinityMask(_pthread^.handle,mask);
end;
//ThreadGetPriority = -15 and 15. :0..30
//scePthreadGetprio = 767 and 256 :0..511
function ps4_scePthreadGetprio(_pthread:pthread;prio:PInteger):Integer; SysV_ABI_CDecl;
Var
r:Integer;
begin
if (_pthread=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if (prio=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
r:=System.ThreadGetPriority(_pthread^.handle);
prio^:=767-(((r+15)*511) div 30);
Result:=0;
end;
function ps4_scePthreadSetprio(_pthread:pthread;prio:Integer):Integer; SysV_ABI_CDecl;
Var
r:Integer;
begin
if (_pthread=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
if (prio>767) then prio:=767;
if (prio<256) then prio:=256;
//Writeln('scePthreadSetprio:',prio);
r:=(((767-prio)*30) div 511)-15;
Result:=0;
if not System.ThreadSetPriority(_pthread^.handle,r) then Result:=SCE_KERNEL_ERROR_ESRCH;
end;
procedure ps4_scePthreadYield(); SysV_ABI_CDecl;
begin
System.ThreadSwitch;
end;
end.

368
ps4_libkerenel/ps4_queue.pas Normal file
View File

@ -0,0 +1,368 @@
unit ps4_queue;
{$mode objfpc}{$H+}
interface
uses
windows,
Classes, SysUtils;
const
EVFILT_READ =(-1) ;
EVFILT_WRITE =(-2) ;
EVFILT_AIO =(-3) ; // attached to aio requests
EVFILT_VNODE =(-4) ; // attached to vnodes
EVFILT_PROC =(-5) ; // attached to struct proc
EVFILT_SIGNAL =(-6) ; // attached to struct proc
EVFILT_TIMER =(-7) ; // timers
EVFILT_FS =(-9) ; // filesystem events
EVFILT_LIO =(-10); // attached to lio requests
EVFILT_USER =(-11); // User events
EVFILT_POLLING =(-12);
EVFILT_DISPLAY =(-13);
EVFILT_GRAPHICS_CORE =(-14);
EVFILT_HRTIMER =(-15);
EVFILT_UVD_TRAP =(-16);
EVFILT_VCE_TRAP =(-17);
EVFILT_SDMA_TRAP =(-18);
EVFILT_REG_EV =(-19);
EVFILT_GPU_EXCEPTION =(-20);
EVFILT_GPU_SYSTEM_EXCEPTION=(-21);
EVFILT_GPU_DBGGC_EV =(-22);
EVFILT_SYSCOUNT =(22) ;
// actions
EV_ADD =$0001; // add event to kq (implies enable)
EV_DELETE =$0002; // delete event from kq
EV_ENABLE =$0004; // enable event
EV_DISABLE =$0008; // disable event (not reported)
// flags
EV_ONESHOT =$0010; // only report one occurrence
EV_CLEAR =$0020; // clear event state after reporting
EV_RECEIPT =$0040; // force EV_ERROR on success, data=0
EV_DISPATCH =$0080; // disable event after reporting
EV_SYSFLAGS =$F000; // reserved by system
EV_FLAG1 =$2000; // filter-specific flag
// returned values
EV_EOF =$8000; // EOF detected
EV_ERROR =$4000; // error, data contains errno
NOTE_DELETE =$0001; // vnode was removed
NOTE_WRITE =$0002; // data contents changed
NOTE_EXTEND =$0004; // size increased
NOTE_ATTRIB =$0008; // attributes changed
NOTE_LINK =$0010; // link count changed
NOTE_RENAME =$0020; // vnode was renamed
NOTE_REVOKE =$0040; // vnode access was revoked
SCE_KERNEL_EVFILT_TIMER =EVFILT_TIMER ;
SCE_KERNEL_EVFILT_READ =EVFILT_READ ;
SCE_KERNEL_EVFILT_WRITE =EVFILT_WRITE ;
SCE_KERNEL_EVFILT_USER =EVFILT_USER ;
SCE_KERNEL_EVFILT_FILE =EVFILT_VNODE ;
SCE_KERNEL_EVFILT_GNM =EVFILT_GRAPHICS_CORE;
SCE_KERNEL_EVFILT_VIDEO_OUT =EVFILT_DISPLAY ;
SCE_KERNEL_EVFILT_HRTIMER =EVFILT_HRTIMER ;
SCE_KERNEL_EVNOTE_DELETE =NOTE_DELETE ;
SCE_KERNEL_EVNOTE_WRITE =NOTE_WRITE ;
SCE_KERNEL_EVNOTE_EXTEND =NOTE_EXTEND ;
SCE_KERNEL_EVNOTE_ATTRIB =NOTE_ATTRIB ;
SCE_KERNEL_EVNOTE_RENAME =NOTE_RENAME ;
SCE_KERNEL_EVNOTE_REVOKE =NOTE_REVOKE ;
SCE_KERNEL_EVFLAG_EOF =EV_EOF ;
SCE_KERNEL_EVFLAG_ERROR =EV_ERROR ;
SCE_VIDEO_OUT_EVENT_FLIP =0; //Flip completion event
SCE_VIDEO_OUT_EVENT_VBLANK =1; //Vblank event
SCE_VIDEO_OUT_EVENT_PRE_VBLANK_START=2; //PreVblankStart event
type
PSceKernelEvent=^SceKernelEvent;
SceKernelEvent=packed record
ident:PtrUint; // identifier for this event
filter:SmallInt; // filter for event
flags:Word; // action flags for kqueue
fflags:DWORD; // filter flag value
data:Ptrint; // filter data value
udata:Pointer; // opaque user data identifier
end;
type
PSceKernelEqueue=^SceKernelEqueue;
SceKernelEqueue=^SceKernelEqueue_t;
SceKernelEqueue_t=record
valid:DWORD;
FRefs:DWORD;
hIOCP:Thandle;
name:array[0..31] of AnsiChar;
end;
PKEventNode=^TKEventNode;
TKEventNode=object
refs:DWORD;
lock:DWORD;
eq:SceKernelEqueue;
ev:SceKernelEvent;
end;
function ps4_sceKernelCreateEqueue(outEq:PSceKernelEqueue;name:PChar):Integer; SysV_ABI_CDecl;
function ps4_sceKernelWaitEqueue(
eq:SceKernelEqueue;
ev:PSceKernelEvent;
num:Integer;
out_num:PInteger;
timo:PDWORD):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetEventUserData(ev:PSceKernelEvent):Pointer; SysV_ABI_CDecl;
type
TKFetchEvent=function(node:PKEventNode;ev:PSceKernelEvent):Boolean;
TKAfterEvent=function(node:PKEventNode;data:Pointer):Boolean;
function _acqure_equeue(eq:SceKernelEqueue):SceKernelEqueue;
procedure _release_equeue(eq:SceKernelEqueue);
function _post_event(eq:SceKernelEqueue;node:Pointer;cb:TKFetchEvent):Boolean;
function _alloc_kevent_node(eq:SceKernelEqueue;size:qword):Pointer;
procedure _free_kevent_node(node:PKEventNode);
function _get_kevent_node(node:PKEventNode;ev:PSceKernelEvent):Boolean;
function _trigger_kevent_node(node:PKEventNode;after:TKAfterEvent;data:Pointer):Boolean;
implementation
uses
spinlock,
ps4_time,
ps4_libkernel;
const
LIFE_EQ=$BAB1F00D;
DEAD_EQ=$DEADBEEF;
function _alloc_kevent_node(eq:SceKernelEqueue;size:qword):Pointer;
begin
eq:=_acqure_equeue(eq);
if (eq=nil) then Exit(Pointer(1));
Result:=AllocMem(size);
if (Result=nil) then
begin
_release_equeue(eq);
Exit;
end;
PKEventNode(Result)^.eq :=eq;
PKEventNode(Result)^.refs:=1;
end;
procedure _free_kevent_node(node:PKEventNode);
begin
if (node=nil) then Exit;
_release_equeue(System.InterlockedExchange(node^.eq,nil));
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
end;
end;
function _get_kevent_node(node:PKEventNode;ev:PSceKernelEvent):Boolean;
var
tmp:SceKernelEvent;
begin
Result:=false;
if (node=nil) or (ev=nil) then Exit;
tmp:=node^.ev;
spin_unlock(node^.lock);
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
Exit;
end;
ev^:=tmp;
Result:=True;
end;
function _trigger_kevent_node(node:PKEventNode;after:TKAfterEvent;data:Pointer):Boolean;
var
eq:SceKernelEqueue;
begin
Result:=False;
if (node=nil) then Exit;
eq:=node^.eq;
if (eq=nil) or (eq^.valid<>LIFE_EQ) then Exit;
if spin_trylock(node^.lock) then
begin
System.InterlockedIncrement(node^.refs);
if (after<>nil) then after(node,data);
Result:=_post_event(eq,node,@_get_kevent_node);
if not Result then
begin
spin_unlock(node^.lock);
if System.InterlockedDecrement(node^.refs)=0 then
begin
FreeMem(node);
Exit;
end;
end;
end;
end;
function ps4_sceKernelCreateEqueue(outEq:PSceKernelEqueue;name:PChar):Integer; SysV_ABI_CDecl;
var
hIOCP:Thandle;
data:SceKernelEqueue;
begin
Writeln('sceKernelCreateEqueue:',name);
if (outEq=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
data:=AllocMem(SizeOf(SceKernelEqueue_t));
if (data=nil) then
begin
Exit(SCE_KERNEL_ERROR_ENOMEM);
end;
hIOCP:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,High(Integer));
if (hIOCP=0) then
begin
Exit(SCE_KERNEL_ERROR_EMFILE);
end;
data^.valid:=LIFE_EQ;
data^.FRefs:=1;
data^.hIOCP:=hIOCP;
if (name<>nil) then MoveChar0(name^,data^.name,32);
outEq^:=data;
Result:=0;
end;
function _post_event(eq:SceKernelEqueue;node:Pointer;cb:TKFetchEvent):Boolean;
begin
Result:=False;
if (eq=nil) then Exit;
if (eq^.valid<>LIFE_EQ) then Exit;
Result:=PostQueuedCompletionStatus(eq^.hIOCP,1,ULONG_PTR(cb),node);
end;
function _acqure_equeue(eq:SceKernelEqueue):SceKernelEqueue;
begin
Result:=nil;
if (eq=nil) then Exit;
if (eq^.valid<>LIFE_EQ) then Exit;
System.InterlockedIncrement(eq^.FRefs);
Result:=eq;
end;
procedure _release_equeue(eq:SceKernelEqueue);
begin
if (eq=nil) then Exit;
if System.InterlockedDecrement(eq^.FRefs)=0 then
begin
FreeMem(eq);
end;
end;
type
TOVERLAPPED_ENTRY=record
lpCompletionKey:ULONG_PTR;
lpOverlapped:POverlapped;
Internal:ULONG_PTR;
dwNumberOfBytesTransferred:DWORD;
end;
POVERLAPPED_ENTRY=^TOVERLAPPED_ENTRY;
function GetQueuedCompletionStatusEx(CompletionPort:THandle;
lpCompletionPortEntries:POVERLAPPED_ENTRY;
ulCount:ULONG;
var ulNumEntriesRemoved:ULONG;
dwMilliseconds:DWORD;
fAlertable:BOOL):BOOL; stdcall; external kernel32;
function ps4_sceKernelWaitEqueue(
eq:SceKernelEqueue;
ev:PSceKernelEvent;
num:Integer;
out_num:PInteger;
timo:PDWORD):Integer; SysV_ABI_CDecl;
Var
QTIME:DWORD;
LTIME:DWORD;
OE:array[0..15] of TOVERLAPPED_ENTRY;
i,ulNum,olNum:ULONG;
CTXProc:TKFetchEvent;
Q:Boolean;
begin
if (eq=nil) then Exit(SCE_KERNEL_ERROR_EBADF);
if (eq^.valid<>LIFE_EQ) then Exit(SCE_KERNEL_ERROR_EBADF);
if (ev=nil) then Exit(SCE_KERNEL_ERROR_EFAULT);
if (num<1) then Exit(SCE_KERNEL_ERROR_EINVAL);
//Writeln('>sceKernelWaitEqueue');
if (timo<>nil) then
begin
//LTIME:=dwMilliSecs(timo^);
LTIME:=_usec2msec(timo^);
end else
begin
LTIME:=INFINITE;
end;
if (num>16) then num:=16;
Result:=0;
out_num^:=0;
FillChar(OE,SizeOf(OE),0);
CTXProc:=nil;
Repeat
ulNum:=0;
if (LTIME<>INFINITE) then QTIME:=Windows.GetTickCount;
Q:=GetQueuedCompletionStatusEX(eq^.hIOCP,@OE,num,ulNum,LTIME,True);
if (LTIME<>INFINITE) then
begin
QTIME:=Windows.GetTickCount-QTIME;
if (QTIME>LTIME) then
LTIME:=0
else
LTIME:=LTIME-QTIME;
end;
if not Q then
begin
Case GetLastError of
ERROR_INVALID_PARAMETER,
ERROR_INVALID_HANDLE :Exit(SCE_KERNEL_ERROR_EBADF);
WAIT_TIMEOUT :Exit(SCE_KERNEL_ERROR_ETIMEDOUT);
end;
end;
if (ulNum<>0) then
begin
olNum:=0;
For i:=0 to ulNum-1 do
begin
CTXProc:=TKFetchEvent(OE[i].lpCompletionKey);
if Assigned(CTXProc) then
begin
if CTXProc(PKEventNode(OE[i].lpOverlapped),@ev[olNum]) then Inc(olNum);
end;
end;
if (olNum<>0) then
begin
out_num^:=olNum;
//Writeln('<sceKernelWaitEqueue');
Exit(0);
end;
end;
Until false;
end;
function ps4_sceKernelGetEventUserData(ev:PSceKernelEvent):Pointer; SysV_ABI_CDecl;
begin
if (ev=nil) then Exit(nil);
Result:=ev^.udata;
end;
end.

339
ps4_libkerenel/ps4_rwlock.pas Normal file
View File

@ -0,0 +1,339 @@
unit ps4_rwlock;
{$mode objfpc}{$H+}
interface
uses
RWLock,
ps4_types;
const
PTHREAD_RWLOCK_INITIALIZER=nil;
SCE_PTHREAD_RWLOCK_NORMAL = 1; // Default POSIX rwlock
SCE_PTHREAD_RWLOCK_PREFER_READER = 2; // Reader preferred rwlock
type
Ppthread_rwlock=^pthread_rwlock;
pthread_rwlock=^pthread_rwlock_t;
pthread_rwlock_t=record
valid:DWORD;
Lock:TRWLock;
name:array[0..31] of AnsiChar;
end;
Ppthread_rwlockattr=^pthread_rwlockattr_t;
pthread_rwlockattr_t=packed record
_type:0..3; //2
_shared:0..1; //1
_align:0..536870911; //29
_align2:Integer; //32
end;
function ps4_pthread_rwlockattr_init(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_destroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_gettype_np(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_settype_np(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_getpshared(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlockattr_setpshared(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_init(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_destroy(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_rdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_wrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_tryrdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_trywrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_pthread_rwlock_unlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrInit(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrDestroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrGettype(pAttr:Ppthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockattrSettype(pAttr:Ppthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockInit(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockDestroy(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockRdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockWrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTryrdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockTrywrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
function ps4_scePthreadRwlockUnlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedrdlock(pRwlock:Ppthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
//function ps4_scePthreadRwlockTimedwrlock(pRwlock:Ppthread_rwlock;usec:DWORD):Integer; SysV_ABI_CDecl;
implementation
Uses
spinlock,
ps4_mutex,
ps4_libkernel;
//int pthread_rwlock_timedrdlock(pthread_rwlock_t *,const struct timespec *);
//int pthread_rwlock_timedwrlock(pthread_rwlock_t *,const struct timespec *);
//int pthread_rwlockattr_getkind_np(const pthread_rwlockattr_t *,int *);
//int pthread_rwlockattr_setkind_np(pthread_rwlockattr_t *, int);
function ps4_pthread_rwlockattr_init(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
pAttr^:=Default(pthread_rwlockattr_t);
pAttr^._type:=SCE_PTHREAD_RWLOCK_NORMAL;
Result:=0;
end;
function ps4_pthread_rwlockattr_destroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Result:=0;
end;
function ps4_pthread_rwlockattr_gettype_np(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_pthread_rwlockattr_settype_np(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
SCE_PTHREAD_RWLOCK_NORMAL :;
SCE_PTHREAD_RWLOCK_PREFER_READER:;
else
Exit(EINVAL);
end;
pAttr^._type:=t;
Result:=0;
end;
function ps4_pthread_rwlockattr_getpshared(pAttr:Ppthread_rwlockattr;t:PInteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(EINVAL);
t^:=pAttr^._shared;
Result:=0;
end;
function ps4_pthread_rwlockattr_setpshared(pAttr:Ppthread_rwlockattr;t:Integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(EINVAL);
Case t of
PTHREAD_PROCESS_PRIVATE:;
PTHREAD_PROCESS_SHARED :;
else
Exit(EINVAL);
end;
pAttr^._shared:=t;
Result:=0;
end;
Const
LIFE_RWLOCK=$BAB1F0ED;
DEAD_RWLOCK=$DEADB0EF;
function STATIC_RWL_INITIALIZER(x:pthread_rwlock):Boolean; inline;
begin
Result:=(x=PTHREAD_RWLOCK_INITIALIZER);
end;
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function rwlock_impl_init(m:Ppthread_rwlock;mi:pthread_rwlock):pthread_rwlock;
var
new_mi:pthread_rwlock;
begin
new_mi:=AllocMem(SizeOf(pthread_rwlock_t));
if (new_mi=nil) then Exit(new_mi);
new_mi^.valid:=LIFE_RWLOCK;
rwlock_init(new_mi^.Lock);
if CAS(m^,mi,new_mi) then
begin
Result:=new_mi;
end else
begin
rwlock_destroy(new_mi^.Lock);
FreeMem(new_mi);
Result:=m^;
end;
end;
function rwlock_impl(m:Ppthread_rwlock;var mi:pthread_rwlock):Integer;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
if STATIC_RWL_INITIALIZER(mi) then
begin
mi:=rwlock_impl_init(m,mi);
if (mi=nil) then Exit(ENOMEM);
end;
if (mi^.valid<>LIFE_RWLOCK) then Exit(EINVAL);
end;
function pthread_rwlock_init(m:Ppthread_rwlock;a:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
if (str<>nil) then MoveChar0(str^,mi^.name,32);
end;
function ps4_pthread_rwlock_init(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
Result:=pthread_rwlock_init(pRwlock,pAttr,nil);
end;
function ps4_pthread_rwlock_destroy(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
if (m=nil) then Exit(EINVAL);
mi:=m^;
if not STATIC_RWL_INITIALIZER(mi) then
begin
mi:=XCHG(m^,nil);
if STATIC_RWL_INITIALIZER(mi) then Exit(0);
if not CAS(mi^.valid,LIFE_RWLOCK,DEAD_RWLOCK) then Exit(EINVAL);
rwlock_destroy(mi^.Lock);
FreeMem(mi);
end;
Result:=0;
end;
function ps4_pthread_rwlock_rdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
rwlock_rdlock(mi^.Lock);
end;
function ps4_pthread_rwlock_wrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
rwlock_wrlock(mi^.Lock);
end;
function ps4_pthread_rwlock_tryrdlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
if not rwlock_tryrdlock(mi^.Lock) then Result:=EBUSY;
end;
function ps4_pthread_rwlock_trywrlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
if not rwlock_trywrlock(mi^.Lock) then Result:=EBUSY;
end;
function ps4_pthread_rwlock_unlock(m:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
var
mi:pthread_rwlock;
begin
Result:=rwlock_impl(m,mi);
if (Result<>0) then Exit;
rwlock_unlock(mi^.Lock);
end;
///////////
function ps4_scePthreadRwlockattrInit(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
pAttr^:=Default(pthread_rwlockattr_t);
pAttr^._type:=SCE_PTHREAD_RWLOCK_NORMAL;
Result:=0;
end;
function ps4_scePthreadRwlockattrDestroy(pAttr:Ppthread_rwlockattr):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=0;
end;
function ps4_scePthreadRwlockattrGettype(pAttr:Ppthread_rwlockattr;t:Pinteger):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) or (t=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
t^:=pAttr^._type;
Result:=0;
end;
function ps4_scePthreadRwlockattrSettype(pAttr:Ppthread_rwlockattr;t:integer):Integer; SysV_ABI_CDecl;
begin
if (pAttr=nil) then Exit(SCE_KERNEL_ERROR_EINVAL);
Case t of
SCE_PTHREAD_RWLOCK_NORMAL :;
SCE_PTHREAD_RWLOCK_PREFER_READER:;
else
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
pAttr^._type:=t;
Result:=0;
end;
//
function ps4_scePthreadRwlockInit(pRwlock:Ppthread_rwlock;pAttr:Ppthread_rwlockattr;str:PChar):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(pthread_rwlock_init(pRwlock,pAttr,str));
end;
function ps4_scePthreadRwlockDestroy(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_destroy(pRwlock));
end;
function ps4_scePthreadRwlockRdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_rdlock(pRwlock));
end;
function ps4_scePthreadRwlockWrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_wrlock(pRwlock));
end;
function ps4_scePthreadRwlockTryrdlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_tryrdlock(pRwlock));
end;
function ps4_scePthreadRwlockTrywrlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_trywrlock(pRwlock));
end;
function ps4_scePthreadRwlockUnlock(pRwlock:Ppthread_rwlock):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(ps4_pthread_rwlock_unlock(pRwlock));
end;
end.

512
ps4_libkerenel/ps4_sema.pas Normal file
View File

@ -0,0 +1,512 @@
unit ps4_sema;
{$mode objfpc}{$H+}
interface
uses
windows,
ps4_types;
const
SCE_KERNEL_SEMA_ATTR_TH_FIFO=$01;
SCE_KERNEL_SEMA_ATTR_TH_PRIO=$02;
SCE_KERNEL_SEMA_ID_INVALID:Int64=-1;
SEM_FAILED =nil;
SEM_VALUE_MAX =High(Integer);
type
PSceKernelSemaOptParam=^TSceKernelSemaOptParam;
TSceKernelSemaOptParam=packed record
size:QWORD;
end;
PSceKernelSema=^SceKernelSema;
SceKernelSema=^_sem_t;
_sem_t=record
valid:DWORD;
s:THandle;
init,max:Integer;
num:Integer;
value:Integer;
//vlock:pthread_mutex_t;
lock:Pointer;
name:array[0..31] of AnsiChar;
end;
function ps4_sem_init(sem:PSceKernelSema;value:Integer):Integer; SysV_ABI_CDecl;
function ps4_sem_destroy(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
function ps4_sem_getvalue(sem:PSceKernelSema;sval:PInteger):Integer; SysV_ABI_CDecl;
function ps4_sem_post(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
function ps4_sem_timedwait(sem:PSceKernelSema;ts:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_sem_trywait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
function ps4_sem_wait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
function ps4_sceKernelCreateSema(
sem:PSceKernelSema;
name:Pchar;
attr:DWORD;
init,max:Integer;
opt:PSceKernelSemaOptParam):Integer; SysV_ABI_CDecl;
function ps4_sceKernelDeleteSema(sem:SceKernelSema):Integer; SysV_ABI_CDecl;
function ps4_sceKernelWaitSema(sem:SceKernelSema;Count:Integer;pTimeout:PDWORD):Integer; SysV_ABI_CDecl;
function ps4_sceKernelSignalSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelPollSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelCancelSema(sem:SceKernelSema;count:Integer;threads:PInteger):Integer; SysV_ABI_CDecl;
function do_sema_b_wait(sema:THandle;timeout:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
function do_sema_b_wait_intern(sema:THandle;timeout:DWORD):Integer;
function do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
implementation
//int sem_unlink(const char *);
uses
spinlock,
ps4_time,
ps4_libkernel;
const
LIFE_SEM=$BAB1F00D;
DEAD_SEM=$DEADBEEF;
function do_sema_b_wait(sema:THandle;timeout:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
r:Integer;
v:Integer;
begin
System.EnterCriticalSection(cs);
System.InterlockedDecrement(val);
v:=val;
System.LeaveCriticalSection(cs);
if (v>=0) then Exit(0);
r:=do_sema_b_wait_intern(sema,timeout);
System.EnterCriticalSection(cs);
if (r<>0) then
begin
System.InterlockedIncrement(val);
end;
System.LeaveCriticalSection(cs);
Result:=r;
end;
function do_sema_b_wait_intern(sema:THandle;timeout:DWORD):Integer;
var
r:Integer;
res:DWORD;
begin
res:=WaitForSingleObject(sema,timeout);
case res of
WAIT_TIMEOUT :r:=ETIMEDOUT;
WAIT_ABANDONED:r:=EPERM;
WAIT_OBJECT_0 :r:=0;
else
r:=EINVAL;
end;
if (r<>0) and (r<>EINVAL) and (WaitForSingleObject(sema,0)=WAIT_OBJECT_0) then
r:=0;
Result:=r;
end;
function do_sema_b_release(sema:THandle;count:DWORD;var cs:TRTLCriticalSection;var val:Integer):Integer;
var
wc,s:Integer;
begin
System.EnterCriticalSection(cs);
if (Int64(val)+Int64(count))>$7fffffff then
begin
System.LeaveCriticalSection(cs);
Exit(EINVAL);
end;
wc:=-val;
//if (wc=0) then wc:=1;
System.InterlockedExchangeAdd(val,count);
if (wc<count) then s:=wc else s:=count;
if ((wc<=0) or ReleaseSemaphore(sema,s,nil)) then
begin
LeaveCriticalSection(cs);
Exit(0);
end;
System.InterlockedExchangeAdd(val, -count);
System.LeaveCriticalSection(cs);
Exit(EINVAL);
end;
/////
function CAS(Var addr:Pointer;Comp,New:Pointer):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function CAS(Var addr:DWORD;Comp,New:DWORD):Boolean; inline;
begin
Result:=System.InterlockedCompareExchange(addr,New,Comp)=Comp;
end;
function XCHG(Var addr:Pointer;New:Pointer):Pointer; inline;
begin
Result:=System.InterLockedExchange(addr,New);
end;
function sem_impl_init(m,mi:PSceKernelSema;max,value:Integer):Integer;
var
new_mi:SceKernelSema;
begin
new_mi:=AllocMem(SizeOf(_sem_t));
if (new_mi=nil) then Exit(ENOMEM);
new_mi^.init:=value;
new_mi^.max:=max;
new_mi^.value:=value;
new_mi^.s:=CreateSemaphore(nil,0,SEM_VALUE_MAX,nil);
if (new_mi^.s=0) then
begin
FreeMem(new_mi);
Exit(ENOSPC);
end;
new_mi^.valid:=LIFE_SEM;
if CAS(m^,mi^,new_mi) then
begin
mi^:=new_mi;
end else
begin
FreeMem(new_mi);
mi^:=m^;
end;
end;
function _sem_init(sem:PSceKernelSema;value:Integer):Integer;
var
sv:SceKernelSema;
begin
if (sem=nil) or (value<0) then Exit(EINVAL);
sv:=sem^;
Result:=sem_impl_init(sem,@sv,SEM_VALUE_MAX,value);
end;
function _sem_destroy(sem:PSceKernelSema):Integer;
var
sv:SceKernelSema;
bkoff:backoff_exp;
begin
if (sem=nil) then Exit(EINVAL);
sv:=XCHG(sem^,nil);
if (sv=nil) then Exit(EINVAL);
spin_lock(sv^.lock);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
if not CloseHandle(sv^.s) then
begin
spin_unlock(sv^.lock);
Exit(EINVAL);
end;
sv^.value:=SEM_VALUE_MAX;
if CAS(sv^.valid,LIFE_SEM,DEAD_SEM) then
begin
spin_unlock(sv^.lock);
bkoff.Reset;
While (sv^.num<>0) do bkoff.Wait;
FreeMem(sv);
Result:=0;
end else
begin
spin_unlock(sv^.lock);
Result:=EINVAL;
end;
end;
function sem_std_enter(sem,svp:PSceKernelSema):Integer;
var
sv:SceKernelSema;
begin
if (sem=nil) then Exit(EINVAL);
sv:=sem^;
if (sv=nil) then Exit(EINVAL);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
spin_lock(sv^.lock);
if (sv^.valid<>LIFE_SEM) then Exit(EINVAL);
if (sem^=nil) then
begin
spin_unlock(sv^.lock);
Exit(EINVAL);
end;
svp^:=sv;
Result:=0;
end;
function _sem_trywait(sem:PSceKernelSema):Integer;
var
sv:SceKernelSema;
begin
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
if (sv^.value<=0) then
begin
spin_unlock(sv^.lock);
Exit(EAGAIN);
end;
Dec(sv^.value);
spin_unlock(sv^.lock);
Result:=0;
end;
function _sem_wait(sem:PSceKernelSema;count:Integer;t:DWORD):Integer;
var
sv:SceKernelSema;
cur_v:Integer;
semh:THandle;
begin
if (count<=0) then Exit(EINVAL);
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
if (count>sv^.max) then
begin
spin_unlock(sv^.lock);
Exit(EINVAL);
end;
Dec(sv^.value,count);
cur_v:=sv^.value;
semh :=sv^.s;
spin_unlock(sv^.lock);
if (cur_v>=0) then Exit(0);
//pthread_cleanup_push (clean_wait_sem, (void *) &arg);
System.InterlockedIncrement(sv^.num);
Result:=do_sema_b_wait_intern(semh,t);
System.InterlockedDecrement(sv^.num);
//pthread_cleanup_pop (ret);
if (Result=EINVAL) then Result:=0;
end;
function _sem_timedwait(sem:PSceKernelSema;ts:Ptimespec):Integer;
var
t:DWORD;
begin
if (ts=nil) then
begin
t:=INFINITE;
end else
begin
t:=dwMilliSecs(_pthread_rel_time_in_ms(ts^));
end;
Result:=_sem_wait(sem,1,t);
end;
function _sem_post(sem:PSceKernelSema;count:Integer):Integer;
var
sv:SceKernelSema;
waiters_count,w:Integer;
begin
if (count<=0) then Exit(EINVAL);
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
if (count>sv^.max) or (sv^.value>(sv^.max-count)) then
begin
spin_unlock(sv^.lock);
Exit(EINVAL);
end;
waiters_count:=-sv^.value;
Inc(sv^.value,count);
if (waiters_count<count) then w:=waiters_count else w:=count;
if (waiters_count<=0) or ReleaseSemaphore(sv^.s,w,nil) then
begin
spin_unlock(sv^.lock);
Exit(0);
end;
Dec(sv^.value,count);
spin_unlock(sv^.lock);
Result:=EINVAL;
end;
function _sem_getvalue(sem:PSceKernelSema;sval:PInteger):Integer;
var
sv:SceKernelSema;
begin
if (sval=nil) then Exit(EINVAL);
Result:=sem_std_enter(sem,@sv);
if (Result<>0) then Exit;
sval^:=sv^.value;
spin_unlock(sv^.lock);
Result:=0;
end;
//
function ps4_sem_init(sem:PSceKernelSema;value:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_init(sem,value));
end;
function ps4_sem_destroy(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_destroy(sem));
end;
function ps4_sem_getvalue(sem:PSceKernelSema;sval:PInteger):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_getvalue(sem,sval));
end;
function ps4_sem_post(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_post(sem,1));
end;
function ps4_sem_timedwait(sem:PSceKernelSema;ts:Ptimespec):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_timedwait(sem,ts));
end;
function ps4_sem_trywait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_trywait(sem));
end;
function ps4_sem_wait(sem:PSceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=lc_set_errno(_sem_wait(sem,1,INFINITE));
end;
////
function ps4_sceKernelCreateSema(
sem:PSceKernelSema;
name:Pchar;
attr:DWORD;
init,max:Integer;
opt:PSceKernelSemaOptParam):Integer; SysV_ABI_CDecl;
var
sv:SceKernelSema;
begin
if (sem=nil) or (max<=0) or (init<0) then Exit(SCE_KERNEL_ERROR_EINVAL);
sv:=sem^;
Result:=px2sce(sem_impl_init(sem,@sv,max,init));
if (Result<>0) then Exit;
if (name<>nil) then MoveChar0(name^,sv^.name,32);
end;
function ps4_sceKernelDeleteSema(sem:SceKernelSema):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(_sem_destroy(@sem));
end;
//typedef unsigned int SceKernelUseconds;
function ps4_sceKernelWaitSema(sem:SceKernelSema;Count:Integer;pTimeout:PDWORD):Integer; SysV_ABI_CDecl;
var
q:QWORD;
t:DWORD;
begin
if (pTimeout=nil) then
begin
t:=INFINITE;
end else
begin
t:=_usec2msec(pTimeout^);
q:=_pthread_time_in_ms;
end;
Result:=px2sce(_sem_wait(@sem,Count,t));
if (pTimeout<>nil) then
begin
if (Result=SCE_KERNEL_ERROR_ETIMEDOUT) then
begin
pTimeout^:=0;
end else
begin
q:=_pthread_time_in_ms-q;
q:=q*1000;
pTimeout^:=dwMilliSecs(q);
end;
end;
end;
function ps4_sceKernelSignalSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=px2sce(_sem_post(@sem,Count));
end;
function ps4_sceKernelPollSema(sem:SceKernelSema;Count:Integer):Integer; SysV_ABI_CDecl;
var
sv:SceKernelSema;
begin
if (Count<=0) then Exit(SCE_KERNEL_ERROR_EINVAL);
Result:=px2sce(sem_std_enter(@sem,@sv));
if (Result<>0) then Exit;
if (Count>sv^.max) then
begin
spin_unlock(sv^.lock);
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
if (sv^.value>=Count) then
begin
Dec(sv^.value,Count);
Result:=0;
end else
begin
Result:=SCE_KERNEL_ERROR_EBUSY;
end;
spin_unlock(sv^.lock);
end;
function ps4_sceKernelCancelSema(sem:SceKernelSema;count:Integer;threads:PInteger):Integer; SysV_ABI_CDecl;
var
sv:SceKernelSema;
waiters_count:Integer;
begin
Result:=px2sce(sem_std_enter(@sem,@sv));
if (Result<>0) then Exit;
if (count>sv^.max) then
begin
spin_unlock(sv^.lock);
Exit(SCE_KERNEL_ERROR_EINVAL);
end;
if (threads<>nil) then threads^:=sv^.num;
waiters_count:=-sv^.value;
if (waiters_count>0) then
begin
ReleaseSemaphore(sv^.s,waiters_count,nil);
end;
if (count<0) then
sv^.value:=sv^.init
else
sv^.value:=count;
spin_unlock(sv^.lock);
Result:=0;
end;
end.

337
ps4_libkerenel/ps4_time.pas Normal file
View File

@ -0,0 +1,337 @@
unit ps4_time;
{$mode objfpc}{$H+}
interface
uses
spinlock,
windows,
ps4_types,
Classes, SysUtils;
const
CLOCK_REALTIME =0;
CLOCK_VIRTUAL =1;
CLOCK_PROF =2;
CLOCK_MONOTONIC =4;
CLOCK_UPTIME =5; // FreeBSD-specific.
CLOCK_UPTIME_PRECISE =7; // FreeBSD-specific.
CLOCK_UPTIME_FAST =8; // FreeBSD-specific.
CLOCK_REALTIME_PRECISE =9; // FreeBSD-specific.
CLOCK_REALTIME_FAST =10; // FreeBSD-specific.
CLOCK_MONOTONIC_PRECISE=11; // FreeBSD-specific.
CLOCK_MONOTONIC_FAST =12; // FreeBSD-specific.
CLOCK_SECOND =13; // FreeBSD-specific.
CLOCK_THREAD_CPUTIME_ID=14;
CLOCK_PROCTIME =15; // ORBIS only
CLOCK_EXT_NETWORK =16; // ORBIS only
CLOCK_EXT_DEBUG_NETWORK=17; // ORBIS only
CLOCK_EXT_AD_NETWORK =18; // ORBIS only
CLOCK_EXT_RAW_NETWORK =19; // ORBIS only
function _usec2msec(usec:DWORD):DWORD;
function _pthread_time_in_ms_from_timespec(const ts:timespec):QWORD; inline;
function _pthread_time_in_ms:QWORD; inline;
function _pthread_rel_time_in_ms(const ts:timespec):QWORD;
function dwMilliSecs(ms:QWORD):DWORD; inline;
function ps4_gettimeofday(tv:Ptimeval;tz:Ptimezone):Integer; SysV_ABI_CDecl;
function ps4_clock_gettime(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetTscFrequency():QWORD; SysV_ABI_CDecl;
function ps4_sceKernelReadTsc():QWORD; SysV_ABI_CDecl;
function ps4_sceKernelClockGettime(clockId:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_sceKernelGetProcessTime:QWORD; SysV_ABI_CDecl; //microseconds
function ps4_nanosleep(req,rem:Ptimespec):Integer; SysV_ABI_CDecl;
function ps4_usleep(usec:Integer):Integer; SysV_ABI_CDecl;
function ps4_sceKernelUsleep(usec:DWORD):Integer; SysV_ABI_CDecl;
Const
FILETIME_1970 =116444736000000000;
HECTONANOSEC_PER_SEC =10000000;
DELTA_EPOCH_IN_100NS =116444736000000000;
POW10_7 =10000000;
POW10_9 =1000000000;
implementation
Uses
ps4_libkernel;
function _usec2msec(usec:DWORD):DWORD;
begin
Result:=(usec+999) div 1000;
end;
function _pthread_time_in_ms_from_timespec(const ts:timespec):QWORD; inline;
begin
Result:=QWORD(ts.tv_sec)*1000+QWORD(ts.tv_nsec+999999) div 1000000;
end;
function _pthread_time_in_ms:QWORD; inline;
var
ts:timespec;
begin
ts:=Default(timespec);
ps4_clock_gettime(CLOCK_REALTIME,@ts);
Result:=_pthread_time_in_ms_from_timespec(ts);
end;
function _pthread_rel_time_in_ms(const ts:timespec):QWORD;
var
t1,t2:QWORD;
begin
t1:=_pthread_time_in_ms_from_timespec(ts);
t2:=_pthread_time_in_ms;
if (t1<t2) then
Result:=0
else
Result:=t1-t2;
end;
function dwMilliSecs(ms:QWORD):DWORD; inline;
begin
if (ms>=$ffffffff) then
Result:=$ffffffff
else
Result:=DWORD(ms);
end;
type
TGetSystemTimeAsFileTime=procedure(var lpSystemTimeAsFileTime:TFILETIME); stdcall;
var
_GetSystemTimeAsFileTime:TGetSystemTimeAsFileTime;
procedure GetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME);
var
h:HMODULE;
begin
if (_GetSystemTimeAsFileTime=nil) then
begin
h:=GetModuleHandle('kernel32.dll');
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimePreciseAsFileTime');
if (_GetSystemTimeAsFileTime=nil) then
begin
Pointer(_GetSystemTimeAsFileTime):=GetProcAddress(h,'GetSystemTimeAsFileTime');
end;
end;
_GetSystemTimeAsFileTime(lpSystemTimeAsFileTime);
end;
procedure gettimezone(z:Ptimezone);
var
TZInfo:TTimeZoneInformation;
tzi:DWORD;
begin
if (z<>nil) then
begin
tzi:=GetTimeZoneInformation(@TZInfo);
if (tzi<>TIME_ZONE_ID_INVALID) then
begin
z^.tz_minuteswest:=TZInfo.Bias;
if (tzi=TIME_ZONE_ID_DAYLIGHT) then
z^.tz_dsttime:=1
else
z^.tz_dsttime:=0;
end else
begin
z^.tz_minuteswest:=0;
z^.tz_dsttime :=0;
end;
end;
end;
function getntptimeofday(tp:Ptimespec;z:Ptimezone):Integer;
var
_now:TFILETIME;
begin
gettimezone(z);
if (tp<>nil) then
begin
GetSystemTimeAsFileTime(_now);
QWORD(_now):=QWORD(_now)-FILETIME_1970;
tp^.tv_sec :=QWORD(_now) div HECTONANOSEC_PER_SEC;
tp^.tv_nsec:=(QWORD(_now) mod HECTONANOSEC_PER_SEC)*100;
end;
Result:=0;
end;
function ps4_gettimeofday(tv:Ptimeval;tz:Ptimezone):Integer; SysV_ABI_CDecl;
Var
tp:timespec;
begin
Result:=getntptimeofday(@tp,tz);
if (tv<>nil) then
begin
tv^.tv_sec :=tp.tv_sec;
tv^.tv_usec:=(tp.tv_nsec div 1000);
end;
end;
var
FPerformanceFrequency:TLargeInteger=1;
function ps4_clock_gettime(clock_id:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
var
ct,et,kt,ut:TFILETIME;
pf,pc,tc:TLargeInteger;
begin
if (tp=nil) then Exit(-1);
Result:=0;
case clock_id of
CLOCK_SECOND:
begin
GetSystemTimeAsFileTime(ct);
QWORD(ct):=QWORD(ct)-DELTA_EPOCH_IN_100NS;
tp^.tv_sec :=QWORD(ct) div POW10_7;
//tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
tp^.tv_nsec:=0;
end;
CLOCK_REALTIME,
CLOCK_REALTIME_PRECISE,
CLOCK_REALTIME_FAST:
begin
GetSystemTimeAsFileTime(ct);
QWORD(ct):=QWORD(ct)-DELTA_EPOCH_IN_100NS;
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
end;
CLOCK_MONOTONIC,
CLOCK_MONOTONIC_PRECISE,
CLOCK_MONOTONIC_FAST:
begin
System.ThreadSwitch; //this stabilize timers, why? idk
System.ThreadSwitch;
pf:=FPerformanceFrequency;
pc:=0;
QueryPerformanceCounter(pc);
tp^.tv_sec :=pc div pf;
tp^.tv_nsec:=((pc mod pf)*POW10_9+(pf shr 1)) div pf;
if (tp^.tv_nsec>=POW10_9) then
begin
Inc(tp^.tv_sec);
Dec(tp^.tv_nsec,POW10_9);
end;
end;
CLOCK_PROCTIME:
begin
if not GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then Exit(lc_set_errno(EINVAL));
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
end;
CLOCK_THREAD_CPUTIME_ID:
begin
if not GetThreadTimes(GetCurrentProcess,ct,et,kt,ut) then Exit(lc_set_errno(EINVAL));
QWORD(ct) :=QWORD(kt)+QWORD(ut);
tp^.tv_sec :=QWORD(ct) div POW10_7;
tp^.tv_nsec:=(QWORD(ct) mod POW10_7)*100;
end
else
Result:=lc_set_errno(EINVAL);
end;
end;
function ps4_sceKernelGetTscFrequency():QWORD; SysV_ABI_CDecl;
begin
Result:=FPerformanceFrequency;
end;
function ps4_sceKernelReadTsc():QWORD; SysV_ABI_CDecl;
begin
System.ThreadSwitch; //this stabilize timers, why? idk
System.ThreadSwitch;
Result:=0;
QueryPerformanceCounter(TLargeInteger(Result));
end;
function ps4_sceKernelClockGettime(clockId:Integer;tp:Ptimespec):Integer; SysV_ABI_CDecl;
begin
Result:=ps4_clock_gettime(clockId,tp);
end;
function ps4_sceKernelGetProcessTime:QWORD; SysV_ABI_CDecl; //microseconds
var
ct,et,kt,ut:TFileTime;
begin
if GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then
begin
Result:=(QWORD(kt)+QWORD(ut)) div 10;
end else
begin
lc_set_errno(EINVAL);
Result:=0;
end;
end;
//1sec=10 000 000
//lpUserTime/ 10 000 000 *1 000 000
//lpUserTime/ 10 *1
function ps4_nanosleep(req,rem:Ptimespec):Integer; SysV_ABI_CDecl;
var
timer:THandle;
ft:TLargeInteger;
begin
if (req=nil) then Exit(EINVAL);
ft:=req^.tv_nsec+req^.tv_sec*1000000000;
ft:=-(ft div 100);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
if (rem<>nil) then
begin
rem^:=Default(timespec);
end;
Result:=0;
end;
function ps4_usleep(usec:Integer):Integer; SysV_ABI_CDecl;
var
timer:THandle;
ft:TLargeInteger;
begin
ft:=-(10*usec);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
Result:=0;
end;
function ps4_sceKernelUsleep(usec:DWORD):Integer; SysV_ABI_CDecl;
var
timer:THandle;
ft:TLargeInteger;
begin
ft:=-(10*usec);
timer:=CreateWaitableTimer(nil,True,nil);
SetWaitableTimer(timer,ft,0,nil,nil,False);
WaitForSingleObject(timer,INFINITE);
CloseHandle(timer);
Result:=0;
end;
initialization
QueryPerformanceFrequency(FPerformanceFrequency);
end.

107
ps4_libkerenel/sce_errno.inc Normal file
View File

@ -0,0 +1,107 @@
const
SCE_KERNEL_ERROR_UNKNOWN=Integer($80020000);
SCE_KERNEL_ERROR_EPERM=-2147352575; // 0x80020001
SCE_KERNEL_ERROR_ENOENT=-2147352574; // 0x80020002
SCE_KERNEL_ERROR_ESRCH=-2147352573; // 0x80020003
SCE_KERNEL_ERROR_EINTR=-2147352572; // 0x80020004
SCE_KERNEL_ERROR_EIO=-2147352571; // 0x80020005
SCE_KERNEL_ERROR_ENXIO=-2147352570; // 0x80020006
SCE_KERNEL_ERROR_E2BIG=-2147352569; // 0x80020007
SCE_KERNEL_ERROR_ENOEXEC=-2147352568; // 0x80020008
SCE_KERNEL_ERROR_EBADF=-2147352567; // 0x80020009
SCE_KERNEL_ERROR_ECHILD=-2147352566; // 0x8002000A
SCE_KERNEL_ERROR_EDEADLK=-2147352565; // 0x8002000B
SCE_KERNEL_ERROR_ENOMEM=-2147352564; // 0x8002000C
SCE_KERNEL_ERROR_EACCES=-2147352563; // 0x8002000D
SCE_KERNEL_ERROR_EFAULT=-2147352562; // 0x8002000E
SCE_KERNEL_ERROR_ENOTBLK=-2147352561; // 0x8002000F
SCE_KERNEL_ERROR_EBUSY=-2147352560; // 0x80020010
SCE_KERNEL_ERROR_EEXIST=-2147352559; // 0x80020011
SCE_KERNEL_ERROR_EXDEV=-2147352558; // 0x80020012
SCE_KERNEL_ERROR_ENODEV=-2147352557; // 0x80020013
SCE_KERNEL_ERROR_ENOTDIR=-2147352556; // 0x80020014
SCE_KERNEL_ERROR_EISDIR=-2147352555; // 0x80020015
SCE_KERNEL_ERROR_EINVAL=-2147352554; // 0x80020016
SCE_KERNEL_ERROR_ENFILE=-2147352553; // 0x80020017
SCE_KERNEL_ERROR_EMFILE=-2147352552; // 0x80020018
SCE_KERNEL_ERROR_ENOTTY=-2147352551; // 0x80020019
SCE_KERNEL_ERROR_ETXTBSY=-2147352550; // 0x8002001A
SCE_KERNEL_ERROR_EFBIG=-2147352549; // 0x8002001B
SCE_KERNEL_ERROR_ENOSPC=-2147352548; // 0x8002001C
SCE_KERNEL_ERROR_ESPIPE=-2147352547; // 0x8002001D
SCE_KERNEL_ERROR_EROFS=-2147352546; // 0x8002001E
SCE_KERNEL_ERROR_EMLINK=-2147352545; // 0x8002001F
SCE_KERNEL_ERROR_EPIPE=-2147352544; // 0x80020020
SCE_KERNEL_ERROR_EDOM=-2147352543; // 0x80020021
SCE_KERNEL_ERROR_ERANGE=-2147352542; // 0x80020022
SCE_KERNEL_ERROR_EAGAIN=-2147352541; // 0x80020023
SCE_KERNEL_ERROR_EWOULDBLOCK=-2147352541; // 0x80020023
SCE_KERNEL_ERROR_EINPROGRESS=-2147352540; // 0x80020024
SCE_KERNEL_ERROR_EALREADY=-2147352539; // 0x80020025
SCE_KERNEL_ERROR_ENOTSOCK=-2147352538; // 0x80020026
SCE_KERNEL_ERROR_EDESTADDRREQ=-2147352537; // 0x80020027
SCE_KERNEL_ERROR_EMSGSIZE=-2147352536; // 0x80020028
SCE_KERNEL_ERROR_EPROTOTYPE=-2147352535; // 0x80020029
SCE_KERNEL_ERROR_ENOPROTOOPT=-2147352534; // 0x8002002A
SCE_KERNEL_ERROR_EPROTONOSUPPORT=-2147352533; // 0x8002002B
SCE_KERNEL_ERROR_ESOCKTNOSUPPORT=-2147352532; // 0x8002002C
SCE_KERNEL_ERROR_EOPNOTSUPP=-2147352531; // 0x8002002D
SCE_KERNEL_ERROR_ENOTSUP=-2147352531; // 0x8002002D
SCE_KERNEL_ERROR_EPFNOSUPPORT=-2147352530; // 0x8002002E
SCE_KERNEL_ERROR_EAFNOSUPPORT=-2147352529; // 0x8002002F
SCE_KERNEL_ERROR_EADDRINUSE=-2147352528; // 0x80020030
SCE_KERNEL_ERROR_EADDRNOTAVAIL=-2147352527; // 0x80020031
SCE_KERNEL_ERROR_ENETDOWN=-2147352526; // 0x80020032
SCE_KERNEL_ERROR_ENETUNREACH=-2147352525; // 0x80020033
SCE_KERNEL_ERROR_ENETRESET=-2147352524; // 0x80020034
SCE_KERNEL_ERROR_ECONNABORTED=-2147352523; // 0x80020035
SCE_KERNEL_ERROR_ECONNRESET=-2147352522; // 0x80020036
SCE_KERNEL_ERROR_ENOBUFS=-2147352521; // 0x80020037
SCE_KERNEL_ERROR_EISCONN=-2147352520; // 0x80020038
SCE_KERNEL_ERROR_ENOTCONN=-2147352519; // 0x80020039
SCE_KERNEL_ERROR_ESHUTDOWN=-2147352518; // 0x8002003A
SCE_KERNEL_ERROR_ETOOMANYREFS=-2147352517; // 0x8002003B
SCE_KERNEL_ERROR_ETIMEDOUT=-2147352516; // 0x8002003C
SCE_KERNEL_ERROR_ECONNREFUSED=-2147352515; // 0x8002003D
SCE_KERNEL_ERROR_ELOOP=-2147352514; // 0x8002003E
SCE_KERNEL_ERROR_ENAMETOOLONG=-2147352513; // 0x8002003F
SCE_KERNEL_ERROR_EHOSTDOWN=-2147352512; // 0x80020040
SCE_KERNEL_ERROR_EHOSTUNREACH=-2147352511; // 0x80020041
SCE_KERNEL_ERROR_ENOTEMPTY=-2147352510; // 0x80020042
SCE_KERNEL_ERROR_EPROCLIM=-2147352509; // 0x80020043
SCE_KERNEL_ERROR_EUSERS=-2147352508; // 0x80020044
SCE_KERNEL_ERROR_EDQUOT=-2147352507; // 0x80020045
SCE_KERNEL_ERROR_ESTALE=-2147352506; // 0x80020046
SCE_KERNEL_ERROR_EREMOTE=-2147352505; // 0x80020047
SCE_KERNEL_ERROR_EBADRPC=-2147352504; // 0x80020048
SCE_KERNEL_ERROR_ERPCMISMATCH=-2147352503; // 0x80020049
SCE_KERNEL_ERROR_EPROGUNAVAIL=-2147352502; // 0x8002004A
SCE_KERNEL_ERROR_EPROGMISMATCH=-2147352501; // 0x8002004B
SCE_KERNEL_ERROR_EPROCUNAVAIL=-2147352500; // 0x8002004C
SCE_KERNEL_ERROR_ENOLCK=-2147352499; // 0x8002004D
SCE_KERNEL_ERROR_ENOSYS=-2147352498; // 0x8002004E
SCE_KERNEL_ERROR_EFTYPE=-2147352497; // 0x8002004F
SCE_KERNEL_ERROR_EAUTH=-2147352496; // 0x80020050
SCE_KERNEL_ERROR_ENEEDAUTH=-2147352495; // 0x80020051
SCE_KERNEL_ERROR_EIDRM=-2147352494; // 0x80020052
SCE_KERNEL_ERROR_ENOMSG=-2147352493; // 0x80020053
SCE_KERNEL_ERROR_EOVERFLOW=-2147352492; // 0x80020054
SCE_KERNEL_ERROR_ECANCELED=-2147352491; // 0x80020055
SCE_KERNEL_ERROR_EILSEQ=-2147352490; // 0x80020056
SCE_KERNEL_ERROR_ENOATTR=-2147352489; // 0x80020057
SCE_KERNEL_ERROR_EDOOFUS=-2147352488; // 0x80020058
SCE_KERNEL_ERROR_EBADMSG=-2147352487; // 0x80020059
SCE_KERNEL_ERROR_EMULTIHOP=-2147352486; // 0x8002005A
SCE_KERNEL_ERROR_ENOLINK=-2147352485; // 0x8002005B
SCE_KERNEL_ERROR_EPROTO=-2147352484; // 0x8002005C
SCE_KERNEL_ERROR_ENOTCAPABLE=-2147352483; // 0x8002005D
SCE_KERNEL_ERROR_ECAPMODE=-2147352482; // 0x8002005E
SCE_KERNEL_ERROR_ENOBLK=-2147352481; // 0x8002005F
SCE_KERNEL_ERROR_EICV=-2147352480; // 0x80020060
SCE_KERNEL_ERROR_ENOPLAYGOENT=-2147352479; // 0x80020061
SCE_KERNEL_ERROR_EREVOKE=-2147352478; // 0x80020062
SCE_KERNEL_ERROR_ESDKVERSION=-2147352477; // 0x80020063
SCE_KERNEL_ERROR_ESTART=-2147352476; // 0x80020064
SCE_KERNEL_ERROR_ESTOP=-2147352475; // 0x80020065

187
ps4_libkerenel/spinlock.pas Normal file
View File

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

641
ps4_libsceaudioout.pas Normal file
View File

@ -0,0 +1,641 @@
unit ps4_libSceAudioOut;
{$mode objfpc}{$H+}
{/$define silent}
interface
uses
libportaudio,
ps4_handles,
ps4_program,
Classes, SysUtils;
implementation
uses
ps4_libkernel;
const
SCE_AUDIO_OUT_ERROR_NOT_OPENED =-2144993279; // 0x80260001
SCE_AUDIO_OUT_ERROR_BUSY =-2144993278; // 0x80260002
SCE_AUDIO_OUT_ERROR_INVALID_PORT =-2144993277; // 0x80260003
SCE_AUDIO_OUT_ERROR_INVALID_POINTER =-2144993276; // 0x80260004
SCE_AUDIO_OUT_ERROR_PORT_FULL =-2144993275; // 0x80260005
SCE_AUDIO_OUT_ERROR_INVALID_SIZE =-2144993274; // 0x80260006
SCE_AUDIO_OUT_ERROR_INVALID_FORMAT =-2144993273; // 0x80260007
SCE_AUDIO_OUT_ERROR_INVALID_SAMPLE_FREQ=-2144993272; // 0x80260008
SCE_AUDIO_OUT_ERROR_INVALID_VOLUME =-2144993271; // 0x80260009
SCE_AUDIO_OUT_ERROR_INVALID_PORT_TYPE =-2144993270; // 0x8026000A
SCE_AUDIO_OUT_ERROR_INVALID_CONF_TYPE =-2144993268; // 0x8026000C
SCE_AUDIO_OUT_ERROR_OUT_OF_MEMORY =-2144993267; // 0x8026000D
SCE_AUDIO_OUT_ERROR_ALREADY_INIT =-2144993266; // 0x8026000E
SCE_AUDIO_OUT_ERROR_NOT_INIT =-2144993265; // 0x8026000F
SCE_AUDIO_OUT_ERROR_MEMORY =-2144993264; // 0x80260010
SCE_AUDIO_OUT_ERROR_SYSTEM_RESOURCE =-2144993263; // 0x80260011
SCE_AUDIO_OUT_ERROR_TRANS_EVENT =-2144993262; // 0x80260012
SCE_AUDIO_OUT_ERROR_INVALID_FLAG =-2144993261; // 0x80260013
SCE_AUDIO_OUT_ERROR_INVALID_MIXLEVEL =-2144993260; // 0x80260014
SCE_AUDIO_OUT_ERROR_INVALID_ARG =-2144993259; // 0x80260015
SCE_AUDIO_OUT_ERROR_INVALID_PARAM =-2144993258; // 0x80260016
SCE_AUDIO_MIN_LEN=256;
SCE_AUDIO_MAX_LEN=(256*8);
SCE_AUDIO_OUT_PORT_TYPE_MAIN =0;
SCE_AUDIO_OUT_PORT_TYPE_BGM =1;
SCE_AUDIO_OUT_PORT_TYPE_VOICE =2;
SCE_AUDIO_OUT_PORT_TYPE_PERSONAL =3;
SCE_AUDIO_OUT_PORT_TYPE_PADSPK =4;
SCE_AUDIO_OUT_PORT_TYPE_AUX =127;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_MONO =0;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_STEREO =1;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH =2;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_MONO =3;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_STEREO =4;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH =5;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH_STD =6;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH_STD=7;
SCE_AUDIO_OUT_PARAM_FORMAT_MASK =$000000FF;
SCE_AUDIO_OUT_PARAM_FORMAT_SHIFT =0;
SCE_AUDIO_OUT_PARAM_ATTR_RESTRICTED =$00010000;
SCE_AUDIO_OUT_PARAM_ATTR_MIX_TO_MAIN =$00020000;
SCE_AUDIO_OUT_PARAM_ATTR_MASK =$000F0000;
SCE_AUDIO_OUT_PARAM_ATTR_SHIFT =16;
SCE_AUDIO_VOLUME_SHIFT =15;
SCE_AUDIO_VOLUME_0DB =(1<<SCE_AUDIO_VOLUME_SHIFT);
SCE_AUDIO_VOLUME_FLAG_L_CH =(1 shl 0);
SCE_AUDIO_VOLUME_FLAG_R_CH =(1 shl 1);
SCE_AUDIO_VOLUME_FLAG_C_CH =(1 shl 2);
SCE_AUDIO_VOLUME_FLAG_LFE_CH =(1 shl 3);
SCE_AUDIO_VOLUME_FLAG_LS_CH =(1 shl 4);
SCE_AUDIO_VOLUME_FLAG_RS_CH =(1 shl 5);
SCE_AUDIO_VOLUME_FLAG_LE_CH =(1 shl 6);
SCE_AUDIO_VOLUME_FLAG_RE_CH =(1 shl 7);
var
_lazy_init:Integer=0;
_lazy_wait:Integer=0;
HAudioOuts:TIntegerHandles;
function ps4_sceAudioOutInit():Integer; SysV_ABI_CDecl;
begin
if System.InterlockedExchange(_lazy_init,1)=0 then
begin
Result:=Pa_Initialize();
if (Result<>0) then Exit(SCE_AUDIO_OUT_ERROR_TRANS_EVENT);
HAudioOuts:=TIntegerHandles.Create;
System.InterLockedExchangeAdd(_lazy_wait,1);
end else
begin
While (System.InterLockedExchangeAdd(_lazy_wait,0)=0) do System.ThreadSwitch;
Result:=SCE_AUDIO_OUT_ERROR_ALREADY_INIT;
end;
//Writeln('sceAudioOutInit');
//Result:=111;
end;
{
userId
User ID of the output destination
type
Virtual device type
index
Device index (unused; specify 0)
len
Granularity (number of samples to be output at once; 256, 512, 768, 1024, 1280, 1536, 1792, or 2048)
freq
Sampling frequency (Hz; specify 48000)
param
Data format, etc.
}
type
TAudioOutHandle=class(TClassHandle)
userId,_type,index:Integer;
len,freq,param:DWORD;
volume:array[0..7] of Integer;
pstream:PaStream;
pnumOutputChannels:Integer;
psampleFormat:PaSampleFormat;
bufsize:Integer;
buf:Pointer;
//d:QWORD;
Destructor Destroy; override;
end;
Destructor TAudioOutHandle.Destroy;
begin
Pa_StopStream(pstream);
Pa_CloseStream(pstream);
FreeMem(buf);
inherited;
end;
//int32_t SceUserServiceUserId;
function ps4_sceAudioOutOpen(userId,_type,index:Integer;
len,freq,param:DWORD):Integer; SysV_ABI_CDecl;
Var
H:TAudioOutHandle;
i:Byte;
err:Integer;
pstream:PaStream;
pnumOutputChannels:Integer;
psampleFormat:PaSampleFormat;
begin
Result:=0;
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
case _type of
SCE_AUDIO_OUT_PORT_TYPE_MAIN :;
SCE_AUDIO_OUT_PORT_TYPE_BGM :;
SCE_AUDIO_OUT_PORT_TYPE_VOICE :;
SCE_AUDIO_OUT_PORT_TYPE_PERSONAL:;
SCE_AUDIO_OUT_PORT_TYPE_PADSPK :;
SCE_AUDIO_OUT_PORT_TYPE_AUX :;
else
Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT_TYPE);
end;
case len of
256,
512,
768,
1024,
1280,
1536,
1792,
2048:;
else
Exit(SCE_AUDIO_OUT_ERROR_INVALID_SIZE);
end;
case freq of
48000:;
else
Exit(SCE_AUDIO_OUT_ERROR_INVALID_SAMPLE_FREQ);
end;
case (param and SCE_AUDIO_OUT_PARAM_FORMAT_MASK) of
SCE_AUDIO_OUT_PARAM_FORMAT_S16_MONO:
begin
pnumOutputChannels:=1;
psampleFormat:=paInt16;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_STEREO:
begin
pnumOutputChannels:=2;
psampleFormat:=paInt16;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH:
begin
pnumOutputChannels:=8;
psampleFormat:=paInt16;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_MONO:
begin
pnumOutputChannels:=1;
psampleFormat:=paFloat32;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_STEREO:
begin
pnumOutputChannels:=2;
psampleFormat:=paFloat32;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH:
begin
pnumOutputChannels:=8;
psampleFormat:=paFloat32;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH_STD:
begin
pnumOutputChannels:=8;
psampleFormat:=paInt16;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH_STD:
begin
pnumOutputChannels:=8;
psampleFormat:=paFloat32;
end;
else
Exit(SCE_AUDIO_OUT_ERROR_INVALID_FORMAT);
end;
err:=Pa_OpenDefaultStream(@pstream,
0,
pnumOutputChannels,
psampleFormat,
freq,
paFramesPerBufferUnspecified,nil,nil);
if (err<>0) and (pnumOutputChannels>2) then
begin
pnumOutputChannels:=2;
err:=Pa_OpenDefaultStream(@pstream,
0,
pnumOutputChannels,
psampleFormat,
freq,
paFramesPerBufferUnspecified,nil,nil);
end;
if (err<>0) then
begin
Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
end;
err:=Pa_StartStream(pstream);
if (err<>0) then
begin
Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
end;
H:=TAudioOutHandle.Create;
H.userId:=userId;
H._type :=_type ;
H.index :=index ;
H.len :=len ;
H.freq :=freq ;
H.param :=param ;
For i:=0 to 7 do
H.volume[i]:=SCE_AUDIO_VOLUME_0DB;
H.pstream :=pstream;
H.pnumOutputChannels:=pnumOutputChannels;
H.psampleFormat :=psampleFormat;
if not HAudioOuts.New(H,Result) then Result:=SCE_AUDIO_OUT_ERROR_PORT_FULL;
Case QWORD(psampleFormat) of
QWORD(paInt16 ):H.bufsize:=2*pnumOutputChannels*len;
QWORD(paFloat32):H.bufsize:=4*pnumOutputChannels*len;
end;
H.buf:=GetMem(H.bufsize);
H.Release;
Writeln('AudioOutOpen:',userId,':',_type,':',index,':',len,':',freq,':',param);
end;
function ps4_sceAudioOutClose(handle:Integer):Integer; SysV_ABI_CDecl;
begin
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
if not HAudioOuts.Delete(handle) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
Result:=0;
end;
function ps4_sceAudioOutSetVolume(handle,flag:Integer;vol:PInteger):Integer; SysV_ABI_CDecl;
Var
H:TAudioOutHandle;
i:Integer;
begin
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
if (vol=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_POINTER);
i:=vol^;
if (i>SCE_AUDIO_VOLUME_0DB) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_VOLUME);
{$ifdef silent}if (i>800) then i:=800;{$endif}
H:=TAudioOutHandle(HAudioOuts.Acqure(handle));
if (H=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
if (flag and SCE_AUDIO_VOLUME_FLAG_L_CH <>0) then H.volume[0]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_R_CH <>0) then H.volume[1]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_C_CH <>0) then H.volume[2]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_LFE_CH<>0) then H.volume[3]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_LS_CH <>0) then H.volume[4]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_RS_CH <>0) then H.volume[5]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_LE_CH <>0) then H.volume[6]:=i;
if (flag and SCE_AUDIO_VOLUME_FLAG_RE_CH <>0) then H.volume[7]:=i;
H.Release;
Writeln('sceAudioOutSetVolume:',handle,':',flag);
Result:=0;
end;
procedure _VecMulI16M(Src,Dst:Pointer;count:Integer;volume:Integer);// inline;
begin
if volume=SCE_AUDIO_VOLUME_0DB then
begin
Move(Src^,Dst^,count*2);
end else
While (count>0) do
begin
PSmallInt(Dst)^:=(PSmallInt(Src)^*volume) div SCE_AUDIO_VOLUME_0DB;
Inc(Src,2);
Inc(Dst,2);
Dec(count);
end;
end;
procedure _VecMulI16S(Src,Dst:Pointer;count:Integer;volume:PInteger); inline;
begin
if (volume[0]=SCE_AUDIO_VOLUME_0DB) and (volume[1]=SCE_AUDIO_VOLUME_0DB) then
begin
Move(Src^,Dst^,count*2*2);
end else
While (count>0) do
begin
PSmallInt(Dst)^:=(PSmallInt(Src)^*volume[0]) div SCE_AUDIO_VOLUME_0DB;
Inc(Src,2);
Inc(Dst,2);
PSmallInt(Dst)^:=(PSmallInt(Src)^*volume[1]) div SCE_AUDIO_VOLUME_0DB;
Inc(Src,2);
Inc(Dst,2);
Dec(count);
end;
end;
procedure _VecMulF32M(Src,Dst:Pointer;count:Integer;volume:Integer); inline;
var
fvolume:Single;
begin
if volume=SCE_AUDIO_VOLUME_0DB then
begin
Move(Src^,Dst^,count*4);
end else
begin
fvolume:=volume/SCE_AUDIO_VOLUME_0DB;
While (count>0) do
begin
PSingle(Dst)^:=PSingle(Src)^*fvolume;
Inc(Src,4);
Inc(Dst,4);
Dec(count);
end;
end;
end;
procedure _VecMulF32S(Src,Dst:Pointer;count:Integer;volume:PInteger); inline;
var
fvolume:array[0..1] of Single;
begin
if (volume[0]=SCE_AUDIO_VOLUME_0DB) and (volume[1]=SCE_AUDIO_VOLUME_0DB) then
begin
Move(Src^,Dst^,count*4*2);
end else
begin
fvolume[0]:=volume[0]/SCE_AUDIO_VOLUME_0DB;
fvolume[1]:=volume[1]/SCE_AUDIO_VOLUME_0DB;
While (count>0) do
begin
PSingle(Dst)^:=PSingle(Src)^*fvolume[0];
Inc(Src,4);
Inc(Dst,4);
PSingle(Dst)^:=PSingle(Src)^*fvolume[1];
Inc(Src,4);
Inc(Dst,4);
Dec(count);
end;
end;
end;
// 1+3/√2
//L=FL+0.707*C+0.707*SL+0.707*BL
//R=FR+0.707*C+0.707*SR+0.707*BR
//1/√2
const
_FL=0;
_FR=1;
_FC=2;
_LF=3;
_SL=4;
_SR=5;
_BL=6;
_BR=7;
procedure _VecMulF32CH8ToS(Src,Dst:Pointer;count:Integer;volume:PInteger);
const
fdiv1:Single=1+(3/Sqrt(2));
fdiv2:Single=(1/Sqrt(2))*(1+(3/Sqrt(2)));
var
fvolume:array[0..7] of Single;
fL,fR:Single;
begin
fvolume[_FL]:=(volume[_FL]/SCE_AUDIO_VOLUME_0DB)*fdiv1;
fvolume[_FR]:=(volume[_FR]/SCE_AUDIO_VOLUME_0DB)*fdiv1;
fvolume[_FC]:=(volume[_FC]/SCE_AUDIO_VOLUME_0DB)*fdiv2;
fvolume[_SL]:=(volume[_SL]/SCE_AUDIO_VOLUME_0DB)*fdiv2;
fvolume[_SR]:=(volume[_SR]/SCE_AUDIO_VOLUME_0DB)*fdiv2;
fvolume[_BL]:=(volume[_BL]/SCE_AUDIO_VOLUME_0DB)*fdiv2;
fvolume[_BR]:=(volume[_BR]/SCE_AUDIO_VOLUME_0DB)*fdiv2;
While (count>0) do
begin
fL:=(PSingle(Src)[_FL]*fvolume[_FL])+
(PSingle(Src)[_FC]*fvolume[_FC])+
(PSingle(Src)[_SL]*fvolume[_SL])+
(PSingle(Src)[_BL]*fvolume[_BL]);
fR:=(PSingle(Src)[_FR]*fvolume[_FR])+
(PSingle(Src)[_FC]*fvolume[_FC])+
(PSingle(Src)[_SR]*fvolume[_SR])+
(PSingle(Src)[_BR]*fvolume[_BR]);
//fL:=fL*0.05;
//fR:=fR*0.05;
PSingle(Dst)^:=fL;
Inc(Dst,4);
PSingle(Dst)^:=fR;
Inc(Dst,4);
Inc(Src,4*8);
Dec(count);
end;
end;
function ps4_sceAudioOutOutput(handle:Integer;ptr:Pointer):Integer; SysV_ABI_CDecl;
Var
H:TAudioOutHandle;
count,err:Integer;
begin
if (HAudioOuts=nil) then Exit(SCE_AUDIO_OUT_ERROR_NOT_INIT);
if (ptr=nil) then Exit(0);
err:=0;
H:=TAudioOutHandle(HAudioOuts.Acqure(handle));
if (H=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PORT);
count:=H.len;
case (H.param and SCE_AUDIO_OUT_PARAM_FORMAT_MASK) of
SCE_AUDIO_OUT_PARAM_FORMAT_S16_MONO:
begin
_VecMulI16M(ptr,H.buf,count,H.volume[0]);
err:=Pa_WriteStream(H.pstream,H.buf,count);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_STEREO:
begin
_VecMulI16S(ptr,H.buf,count,@H.volume);
err:=Pa_WriteStream(H.pstream,H.buf,count);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH:
begin
Assert(false);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_MONO:
begin
_VecMulF32M(ptr,H.buf,count,H.volume[0]);
err:=Pa_WriteStream(H.pstream,H.buf,count);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_STEREO:
begin
_VecMulF32S(ptr,H.buf,count,@H.volume);
err:=Pa_WriteStream(H.pstream,H.buf,count);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH:
begin
if H.pnumOutputChannels=2 then
begin
_VecMulF32CH8ToS(ptr,H.buf,count,@H.volume);
err:=Pa_WriteStream(H.pstream,H.buf,count);
end else
begin
Assert(false);
end;
end;
SCE_AUDIO_OUT_PARAM_FORMAT_S16_8CH_STD:
begin
Assert(false);
end;
SCE_AUDIO_OUT_PARAM_FORMAT_FLOAT_8CH_STD:
begin
Assert(false);
end;
end;
if err<>0 then
case PaErrorCode(err) of
paNotInitialized :Writeln('paNotInitialized ');
paUnanticipatedHostError :Writeln('paUnanticipatedHostError ');
paInvalidChannelCount :Writeln('paInvalidChannelCount ');
paInvalidSampleRate :Writeln('paInvalidSampleRate ');
paInvalidDevice :Writeln('paInvalidDevice ');
paInvalidFlag :Writeln('paInvalidFlag ');
paSampleFormatNotSupported :Writeln('paSampleFormatNotSupported ');
paBadIODeviceCombination :Writeln('paBadIODeviceCombination ');
paInsufficientMemory :Writeln('paInsufficientMemory ');
paBufferTooBig :Writeln('paBufferTooBig ');
paBufferTooSmall :Writeln('paBufferTooSmall ');
paNullCallback :Writeln('paNullCallback ');
paBadStreamPtr :Writeln('paBadStreamPtr ');
paTimedOut :Writeln('paTimedOut ');
paInternalError :Writeln('paInternalError ');
paDeviceUnavailable :Writeln('paDeviceUnavailable ');
paIncompatibleHostApiSpecificStreamInfo:Writeln('paIncompatibleHostApiSpecificStreamInfo');
paStreamIsStopped :Writeln('paStreamIsStopped ');
paStreamIsNotStopped :Writeln('paStreamIsNotStopped ');
paInputOverflowed :Writeln('paInputOverflowed ');
paOutputUnderflowed :Writeln('paOutputUnderflowed ');
paHostApiNotFound :Writeln('paHostApiNotFound ');
paInvalidHostApi :Writeln('paInvalidHostApi ');
paCanNotReadFromACallbackStream :Writeln('paCanNotReadFromACallbackStream ');
paCanNotWriteToACallbackStream :Writeln('paCanNotWriteToACallbackStream ');
paCanNotReadFromAnOutputOnlyStream :Writeln('paCanNotReadFromAnOutputOnlyStream ');
paCanNotWriteToAnInputOnlyStream :Writeln('paCanNotWriteToAnInputOnlyStream ');
paIncompatibleStreamHostApi :Writeln('paIncompatibleStreamHostApi ');
paBadBufferPtr :Writeln('paBadBufferPtr ');
end;
//Writeln('sceAudioOutOutput:',handle,':',HexStr(ptr));
H.Release;
Result:=0;
end;
type
PSceAudioOutOutputParam=^SceAudioOutOutputParam;
SceAudioOutOutputParam=packed record
handle:Integer;
align:Integer;
ptr:Pointer;
end;
function ps4_sceAudioOutOutputs(param:PSceAudioOutOutputParam;num:DWORD):Integer; SysV_ABI_CDecl;
var
i:DWORD;
begin
if (param=nil) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_POINTER);
if (num=0) then Exit(SCE_AUDIO_OUT_ERROR_INVALID_PARAM);
For i:=0 to num-1 do
begin
Result:=ps4_sceAudioOutOutput(param[i].handle,param[i].ptr);
if (Result<>0) then Exit;
end;
end;
function Load_libSceAudioOut(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceAudioOut');
lib^.set_proc($25F10F5D5C6116A0,@ps4_sceAudioOutInit);
lib^.set_proc($7A436FB13DB6AEC6,@ps4_sceAudioOutOpen);
lib^.set_proc($B35FFFB84F66045C,@ps4_sceAudioOutClose);
lib^.set_proc($6FEB8057CF489711,@ps4_sceAudioOutSetVolume);
lib^.set_proc($40E42D6DE0EAB13E,@ps4_sceAudioOutOutput);
lib^.set_proc($C373DD6924D2C061,@ps4_sceAudioOutOutputs);
end;
const
SCE_AUDIO_IN_ERROR_NOT_OPENED=$80260109;
function ps4_sceAudioInOpen(userID,busType,index,len,freq,param:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=Integer(SCE_AUDIO_IN_ERROR_NOT_OPENED);
end;
function Load_libSceAudioIn(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceAudioIn');
lib^.set_proc($E4D13C4A373B542F,@ps4_sceAudioInOpen);
end;
initialization
ps4_app.RegistredPreLoad('libSceAudioOut.prx',@Load_libSceAudioOut);
ps4_app.RegistredPreLoad('libSceAudioIn.prx',@Load_libSceAudioIn);
end.

116
ps4_libscedialogs.pas Normal file
View File

@ -0,0 +1,116 @@
unit ps4_libSceDialogs;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
const
//SceCommonDialogStatus
SCE_COMMON_DIALOG_STATUS_NONE = 0;
SCE_COMMON_DIALOG_STATUS_INITIALIZED = 1;
SCE_COMMON_DIALOG_STATUS_RUNNING = 2;
SCE_COMMON_DIALOG_STATUS_FINISHED = 3;
//SceCommonDialogResult {
SCE_COMMON_DIALOG_RESULT_OK = 0;
SCE_COMMON_DIALOG_RESULT_USER_CANCELED = 1;
function ps4_sceCommonDialogInitialize():Integer; SysV_ABI_CDecl;
begin
Writeln('sceCommonDialogInitialize');
Result:=0;
end;
function ps4_sceErrorDialogInitialize():Integer; SysV_ABI_CDecl;
begin
Writeln('sceErrorDialogInitialize');
Result:=0;
end;
function ps4_sceNpProfileDialogInitialize():Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpProfileDialogInitialize');
Result:=0;
end;
function ps4_sceSaveDataDialogUpdateStatus():Integer; SysV_ABI_CDecl;
begin
Writeln('sceSaveDataDialogUpdateStatus');
Result:=SCE_COMMON_DIALOG_STATUS_NONE;
end;
function ps4_sceSaveDataDialogProgressBarSetValue(target:Integer;rate:DWORD):Integer; SysV_ABI_CDecl;
begin
Writeln('sceSaveDataDialogProgressBarSetValue:',rate);
Result:=0;
end;
function ps4_sceSaveDataDialogTerminate():Integer; SysV_ABI_CDecl;
begin
Writeln('sceSaveDataDialogTerminate');
Result:=0;
end;
function Load_libSceCommonDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceCommonDialog');
lib^.set_proc($BA85292C6364CA09,@ps4_sceCommonDialogInitialize);
end;
//
function Load_libSceErrorDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceErrorDialog');
lib^.set_proc($23CF0A0A19729D2B,@ps4_sceErrorDialogInitialize);
end;
//
function Load_libSceNpProfileDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNpProfileDialog');
lib^.set_proc($2E0F8D084EA94F04,@ps4_sceNpProfileDialogInitialize);
end;
//
function Load_libSceSaveDataDialog(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceSaveDataDialog');
lib^.set_proc($28ADC1760D5158AD,@ps4_sceSaveDataDialogUpdateStatus);
lib^.set_proc($85ACB509F4E62F20,@ps4_sceSaveDataDialogProgressBarSetValue);
lib^.set_proc($62E1F6140EDACEA4,@ps4_sceSaveDataDialogTerminate);
end;
initialization
ps4_app.RegistredPreLoad('libSceCommonDialog.prx',@Load_libSceCommonDialog);
ps4_app.RegistredPreLoad('libSceErrorDialog.prx',@Load_libSceErrorDialog);
ps4_app.RegistredPreLoad('libSceNpProfileDialog.prx',@Load_libSceNpProfileDialog);
ps4_app.RegistredPreLoad('libSceSaveDataDialog.prx',@Load_libSceSaveDataDialog);
end.

1161
ps4_libscegnmdriver.pas Normal file
View File

File diff suppressed because it is too large Load Diff

68
ps4_libscehttp.pas Normal file
View File

@ -0,0 +1,68 @@
unit ps4_libSceHttp;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
function ps4_sceHttpInit(libnetMemId,libsslCtxId:Integer;poolSize:size_t):Integer; SysV_ABI_CDecl;
begin
Writeln('sceHttpInit:',poolSize);
Result:=4;
end;
function ps4_sceHttpCreateTemplate(
libhttpCtxId:Integer;
userAgent:PChar;
httpVer:Integer;
autoProxyConf:Integer):Integer; SysV_ABI_CDecl;
begin
Writeln('userAgent:',userAgent);
Result:=0;
end;
function ps4_sceHttpSetNonblock(id:Integer;enable:Boolean):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
type
PSceHttpEpollHandle=^SceHttpEpollHandle;
SceHttpEpollHandle=Pointer;
function ps4_sceHttpCreateEpoll(libhttpCtxId:Integer;eh:PSceHttpEpollHandle):Integer; SysV_ABI_CDecl;
begin
Result:=0;
eh^:=Pointer($BADF);
end;
function ps4_sceHttpAddRequestHeader(id:Integer;name:PChar;value:PChar;mode:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
Writeln(name,': ',value);
end;
function Load_libSceHttp(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceHttp');
lib^.set_proc($03D715314B44A786,@ps4_sceHttpInit);
lib^.set_proc($D206233D347FE9C6,@ps4_sceHttpCreateTemplate);
lib^.set_proc($B36FCD3C8BF3FA20,@ps4_sceHttpSetNonblock);
lib^.set_proc($EB7F3575617EC6C4,@ps4_sceHttpCreateEpoll);
lib^.set_proc($118DBC4F66E437B9,@ps4_sceHttpAddRequestHeader);
end;
initialization
ps4_app.RegistredPreLoad('libSceHttp.prx',@Load_libSceHttp);
end.

116
ps4_libscenet.pas Normal file
View File

@ -0,0 +1,116 @@
unit ps4_libSceNet;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
function ps4_sceNetInit:Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNetPoolCreate(name:PChar;size,flags:Integer):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNetPoolCreate:',name,':',size,':',flags);
Result:=2;
end;
//
function ps4_sceNetCtlInit:Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
const
SCE_NET_CTL_ERROR_INVALID_ADDR=$80412107;
SCE_NET_CTL_STATE_DISCONNECTED=0;
SCE_NET_CTL_STATE_CONNECTING =1;
SCE_NET_CTL_STATE_IPOBTAINING =2;
SCE_NET_CTL_STATE_IPOBTAINED =3;
SCE_NET_CTL_EVENT_TYPE_DISCONNECTED=1;
SCE_NET_CTL_EVENT_TYPE_DISCONNECT_REQ_FINISHED=2;
SCE_NET_CTL_EVENT_TYPE_IPOBTAINED=3;
function ps4_sceNetCtlGetState(state:PInteger):Integer; SysV_ABI_CDecl;
begin
if (state=nil) then Exit(Integer(SCE_NET_CTL_ERROR_INVALID_ADDR));
state^:=SCE_NET_CTL_STATE_DISCONNECTED;
Result:=0;
end;
type
SceNetCtlCallback=Procedure(eventType:Integer;arg:Pointer); SysV_ABI_CDecl;
var
NetCtlCb:packed record
func:SceNetCtlCallback;
arg:Pointer;
end;
function ps4_sceNetCtlRegisterCallback(func:SceNetCtlCallback;arg:Pointer;cid:PInteger):Integer; SysV_ABI_CDecl;
begin
NetCtlCb.func:=func;
NetCtlCb.arg:=arg;
if (cid<>nil) then cid^:=0;
Result:=0;
end;
function ps4_sceNetCtlCheckCallback():Integer; SysV_ABI_CDecl;
begin
if (NetCtlCb.func<>nil) then
begin
NetCtlCb.func(SCE_NET_CTL_EVENT_TYPE_DISCONNECTED,NetCtlCb.arg);
end;
Result:=0;
end;
Const
SCE_NET_CTL_ERROR_ETHERNET_PLUGOUT=$80412115;
function ps4_sceNetCtlGetResult(eventType:Integer;errorCode:PInteger):Integer; SysV_ABI_CDecl;
begin
if (errorCode=nil) then Exit(Integer(SCE_NET_CTL_ERROR_INVALID_ADDR));
errorCode^:=Integer(SCE_NET_CTL_ERROR_ETHERNET_PLUGOUT);
Result:=0;
end;
function Load_libSceNet(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNet');
lib^.set_proc($3657AFECB83C9370,@ps4_sceNetInit);
lib^.set_proc($76024169E2671A9A,@ps4_sceNetPoolCreate);
end;
function Load_libSceNetCtl(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNetCtl');
lib^.set_proc($824CB4FA868D3389,@ps4_sceNetCtlInit);
lib^.set_proc($B813E5AF495BBA22,@ps4_sceNetCtlGetState);
lib^.set_proc($509F99ED0FB8724D,@ps4_sceNetCtlRegisterCallback);
lib^.set_proc($890C378903E1BD44,@ps4_sceNetCtlCheckCallback);
lib^.set_proc($D1C06076E3D147E3,@ps4_sceNetCtlGetResult);
end;
initialization
ps4_app.RegistredPreLoad('libSceNet.prx' ,@Load_libSceNet);
ps4_app.RegistredPreLoad('libSceNetCtl.prx',@Load_libSceNetCtl);
end.

166
ps4_libscenpmanager.pas Normal file
View File

@ -0,0 +1,166 @@
unit ps4_libSceNpManager;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
Const
SCE_NP_COUNTRY_CODE_LENGTH=2;
type
// Np country code (ISO 3166-1 two-letter system)
SceNpCountryCode=packed record
data:array[0..SCE_NP_COUNTRY_CODE_LENGTH-1] of AnsiChar;
term:AnsiChar;
padding:array[0..1] of AnsiChar;
end;
SceNpAgeRestriction=packed record
countryCode:SceNpCountryCode;
age:Shortint;
padding:array[0..2] of Byte;
end;
PSceNpContentRestriction=^SceNpContentRestriction;
SceNpContentRestriction=packed record
size:QWORD;
defaultAgeRestriction:Byte;
padding:array[0..2] of Byte;
ageRestrictionCount:Integer;
ageRestriction:SceNpAgeRestriction;
end;
function ps4_sceNpSetContentRestriction(pRestriction:PSceNpContentRestriction):Integer; SysV_ABI_CDecl;
begin
Writeln('sceNpSetContentRestriction:',HexStr(pRestriction));
Result:=0;
end;
const
SCE_NP_ONLINEID_MIN_LENGTH=3;
SCE_NP_ONLINEID_MAX_LENGTH=16;
type
SceNpOnlineId=packed record
data:array[0..SCE_NP_ONLINEID_MAX_LENGTH-1] of AnsiChar;
term:AnsiChar;
dummy:array[0..2] of AnsiChar;
end;
PSceNpId=^SceNpId;
SceNpId=packed record
handle:SceNpOnlineId;
opt:array[0..7] of Byte;
reserved:array[0..7] of Byte;
end;
function ps4_sceNpGetNpId(userId:Integer;npId:PSceNpId):Integer; SysV_ABI_CDecl;
begin
npId^:=Default(SceNpId);
npId^.handle.data:='user';
Result:=0;
end;
const
SCE_NP_TITLE_ID_LEN=12;
type
PSceNpTitleId=^SceNpTitleId;
SceNpTitleId=packed record
id:array[0..SCE_NP_TITLE_ID_LEN] of Char;
padding:array[0..2] of Byte;
end;
const
SCE_NP_TITLE_SECRET_SIZE=128;
type
PSceNpTitleSecret=^SceNpTitleSecret;
SceNpTitleSecret=array[0..SCE_NP_TITLE_SECRET_SIZE-1] of Byte;
function GetStr(p:Pointer;L:SizeUint):RawByteString; inline;
begin
SetString(Result,P,L);
end;
function ps4_sceNpSetNpTitleId(titleId:PSceNpTitleId;titleSecret:PSceNpTitleSecret):Integer; SysV_ABI_CDecl;
begin
Writeln(GetStr(@titleId^.id,StrLen(@titleId^.id)));
Result:=0;
end;
function ps4_sceNpCheckCallback():Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
const
SCE_NP_STATE_UNKNOWN =0;
SCE_NP_STATE_SIGNED_OUT =1;
SCE_NP_STATE_SIGNED_IN =2;
type
SceUserServiceUserId=Integer;
SceNpStateCallbackA=procedure(userId:SceUserServiceUserId;state:Integer;userdata:Pointer); SysV_ABI_CDecl;
//int sceNpRegisterStateCallbackA(
// SceNpStateCallbackA callback,
// void *userdata);
const
SCE_NP_ERROR_INVALID_ARGUMENT=$80550003;
SCE_NP_ERROR_CALLBACK_ALREADY_REGISTERED=$80550008;
var
Cb4Toolkit:packed record
callback:SceNpStateCallbackA;
userdata:Pointer;
end;
function ps4_sceNpRegisterStateCallbackForToolkit(callback:SceNpStateCallbackA;userdata:Pointer):Integer; SysV_ABI_CDecl;
begin
Cb4Toolkit.callback:=callback;
Cb4Toolkit.userdata:=userdata;
Result:=0;
end;
function ps4_sceNpCheckCallbackForLib():Integer; SysV_ABI_CDecl;
begin
if (Cb4Toolkit.callback<>nil) then
begin
//Cb4Toolkit.callback(0,SCE_NP_STATE_SIGNED_OUT,Cb4Toolkit.userdata);
end;
Result:=0;
end;
function Load_libSceNpManager(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNpManager');
lib^.set_proc($036090DE4812A294,@ps4_sceNpSetContentRestriction);
lib^.set_proc($A7FA3BE029E83736,@ps4_sceNpGetNpId);
lib^.set_proc($11CEB7CB9F65F6DC,@ps4_sceNpSetNpTitleId);
lib^.set_proc($DD997C05E3D387D6,@ps4_sceNpCheckCallback);
lib:=Result._add_lib('libSceNpManagerForToolkit');
lib^.set_proc($D1CEC76D744A52DE,@ps4_sceNpRegisterStateCallbackForToolkit);
lib^.set_proc($2442C77F8C4FB9FA,@ps4_sceNpCheckCallbackForLib);
end;
initialization
ps4_app.RegistredPreLoad('libSceNpManager.prx',@Load_libSceNpManager);
end.

151
ps4_libscenpscore.pas Normal file
View File

@ -0,0 +1,151 @@
unit ps4_libSceNpScore;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
function ps4_sceNpScoreCreateNpTitleCtx(npServiceLabel:Integer;selfId:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNpScoreCreateRequest(titleCtxId:Integer):Integer; SysV_ABI_CDecl;
begin
writeln('ScoreCreateRequest:',titleCtxId);
Result:=894;
end;
function ps4_sceNpScoreDeleteRequest(reqId:Integer):Integer; SysV_ABI_CDecl;
begin
writeln('sceNpScoreDeleteRequest:',reqId);
Result:=0;
end;
const
SCE_NP_ONLINEID_MIN_LENGTH=3;
SCE_NP_ONLINEID_MAX_LENGTH=16;
type
SceNpOnlineId=packed record
data:array[0..SCE_NP_ONLINEID_MAX_LENGTH-1] of Char;
term:Char;
dummy:array[0..2] of Char;
end;
PSceNpScoreRankDataA=^SceNpScoreRankDataA;
SceNpScoreRankDataA=packed record
onlineId:SceNpOnlineId;
reserved0:array[0..15] of Byte;
reserved:array[0..48] of Byte;
pad0:array[0..2] of Byte;
pcId:Integer;
serialRank:DWORD;
rank:DWORD;
highestRank:DWORD;
hasGameData:Integer;
pad1:array[0..3] of Byte;
scoreValue:Int64;
recordDate:QWORD;
accountId:QWORD;
pad2:array[0..7] of Byte;
end;
const
SCE_NP_SCORE_COMMENT_MAXLEN=63;
type
PSceNpScoreComment=^SceNpScoreComment;
SceNpScoreComment=packed record
utf8Comment:array[0..SCE_NP_SCORE_COMMENT_MAXLEN] of Char;
end;
const
SCE_NP_SCORE_GAMEINFO_MAXSIZE=189;
type
PSceNpScoreGameInfo=^SceNpScoreGameInfo;
SceNpScoreGameInfo=packed record
infoSize:size_t;
data:array[0..SCE_NP_SCORE_GAMEINFO_MAXSIZE-1] of Byte;
pad2:array[0..2] of Byte;
end;
PSceNpScoreGetFriendRankingOptParam=^SceNpScoreGetFriendRankingOptParam;
SceNpScoreGetFriendRankingOptParam=packed record
size:size_t;
startSerialRank:PInteger;
hits:PInteger;
end;
function ps4_sceNpScoreGetFriendsRanking(
reqId:Integer; //1
boardId:DWORD; //2
includeSelf:Integer; //3
rankArray:PSceNpScoreRankDataA; //4
rankArraySize:size_t; //5
commentArray:PSceNpScoreComment; //6
commentArraySize:size_t; //7
infoArray:PSceNpScoreGameInfo; //8
infoArraySize:size_t; //9
arrayNum:size_t; //10
lastSortDate:PQWORD; //11
totalRecord:PDWORD; //12
option:PSceNpScoreGetFriendRankingOptParam):Integer; SysV_ABI_CDecl; //13
begin
//lastSortDate^:=0;
//totalRecord^:=0;
Result:=0;
end;
type
PSceNpScoreAccountIdPcId=^SceNpScoreAccountIdPcId;
SceNpScoreAccountIdPcId=packed record
accountId:QWORD;
pcId:Integer;
pad:array[0..3] of Byte;
end;
function ps4_sceNpScoreGetRankingByAccountIdPcId(
reqId:Integer;
boardId:DWORD;
idArray:PSceNpScoreAccountIdPcId;
idArraySize:size_t;
rankArray:PSceNpScoreRankDataA;
rankArraySize:size_t;
commentArray:PSceNpScoreComment;
commentArraySize:size_t;
infoArray:PSceNpScoreGameInfo;
infoArraySize:size_t;
arrayNum:size_t;
lastSortDate:PQWORD;
totalRecord:PDWORD;
option:Pointer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function Load_libSceNpScoreRanking(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNpScore');
lib^.set_proc($2A7340D53120B412,@ps4_sceNpScoreCreateNpTitleCtx);
lib^.set_proc($816F2ACA362B51B9,@ps4_sceNpScoreCreateRequest);
lib^.set_proc($74AF3F4A061FEABE,@ps4_sceNpScoreDeleteRequest);
lib^.set_proc($F24B88CD4C3ABAD4,@ps4_sceNpScoreGetFriendsRanking);
lib^.set_proc($F66644828884ABA6,@ps4_sceNpScoreGetRankingByAccountIdPcId);
end;
initialization
ps4_app.RegistredPreLoad('libSceNpScoreRanking.prx',@Load_libSceNpScoreRanking);
end.

57
ps4_libscenptrophy.pas Normal file
View File

@ -0,0 +1,57 @@
unit ps4_libSceNpTrophy;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
function ps4_sceNpTrophyCreateContext(context:PInteger;
userId:Integer;
serviceLabel:DWORD;
options:QWORD):Integer; SysV_ABI_CDecl;
begin
context^:=543;
Result:=0;
end;
function ps4_sceNpTrophyCreateHandle(handle:PInteger):Integer; SysV_ABI_CDecl;
begin
handle^:=3333;
Result:=0;
end;
function ps4_sceNpTrophyRegisterContext(context:Integer;
handle:Integer;
options:QWORD):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceNpTrophyDestroyHandle(handle:Integer):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function Load_libSceNpTrophy(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceNpTrophy');
lib^.set_proc($5DB9236E86D99426,@ps4_sceNpTrophyCreateContext);
lib^.set_proc($ABB53AB440107FB7,@ps4_sceNpTrophyCreateHandle);
lib^.set_proc($4C9080C6DA3D4845,@ps4_sceNpTrophyRegisterContext);
lib^.set_proc($18D705E2889D6346,@ps4_sceNpTrophyDestroyHandle);
end;
initialization
ps4_app.RegistredPreLoad('libSceNpTrophy.prx',@Load_libSceNpTrophy);
end.

308
ps4_libscepad.pas Normal file
View File

@ -0,0 +1,308 @@
unit ps4_libScePad;
{$mode objfpc}{$H+}
interface
uses
windows,
ps4_program,
Classes, SysUtils;
implementation
const
SCE_PAD_ERROR_INVALID_ARG =-2137915391; // 0x80920001
SCE_PAD_ERROR_INVALID_PORT =-2137915390; // 0x80920002
SCE_PAD_ERROR_INVALID_HANDLE =-2137915389; // 0x80920003
SCE_PAD_ERROR_ALREADY_OPENED =-2137915388; // 0x80920004
SCE_PAD_ERROR_NOT_INITIALIZED =-2137915387; // 0x80920005
SCE_PAD_ERROR_INVALID_LIGHTBAR_SETTING=-2137915386; // 0x80920006
SCE_PAD_ERROR_DEVICE_NOT_CONNECTED =-2137915385; // 0x80920007
SCE_PAD_ERROR_NO_HANDLE =-2137915384; // 0x80920008
SCE_PAD_ERROR_FATAL =-2137915137; // 0x809200FF
function ps4_scePadInit():Integer; SysV_ABI_CDecl;
begin
Writeln('scePadInit');
Result:=0;
end;
function ps4_scePadOpen(userID,_type,index:Integer;param:Pointer):Integer; SysV_ABI_CDecl;
begin
//Writeln('scePadOpen:',userID);
Result:=222;
end;
const
ORBIS_PAD_PORT_TYPE_STANDARD=0;
SCE_PAD_BUTTON_L3 = $00000002;
SCE_PAD_BUTTON_R3 = $00000004;
SCE_PAD_BUTTON_OPTIONS = $00000008;
SCE_PAD_BUTTON_UP = $00000010;
SCE_PAD_BUTTON_RIGHT = $00000020;
SCE_PAD_BUTTON_DOWN = $00000040;
SCE_PAD_BUTTON_LEFT = $00000080;
SCE_PAD_BUTTON_L2 = $00000100;
SCE_PAD_BUTTON_R2 = $00000200;
SCE_PAD_BUTTON_L1 = $00000400;
SCE_PAD_BUTTON_R1 = $00000800;
SCE_PAD_BUTTON_TRIANGLE = $00001000;
SCE_PAD_BUTTON_CIRCLE = $00002000;
SCE_PAD_BUTTON_CROSS = $00004000;
SCE_PAD_BUTTON_SQUARE = $00008000;
SCE_PAD_BUTTON_TOUCH_PAD = $00100000;
SCE_PAD_BUTTON_INTERCEPTED = $80000000;
SCE_PAD_MAX_TOUCH_NUM=2;
SCE_PAD_MAX_DEVICE_UNIQUE_DATA_SIZE=12;
type
Tvec_float3=packed record
x,y,z:Single;
end;
Tvec_float4=packed record
x,y,z,w:Single;
end;
ScePadAnalogStick=packed record
x,y:Byte;
end;
ScePadAnalogButtons=packed record
l2,r2:Byte;
padding :Word;
end;
ScePadTouch=packed record
x:Word;
y:Word;
id:Byte;
reserve:array[0..2] of Byte;
end;
ScePadTouchData=packed record
touchNum:Byte;
reserve:array[0..2] of Byte;
reserve1:DWORD;
touch:array[0..SCE_PAD_MAX_TOUCH_NUM-1] of ScePadTouch;
end;
ScePadExtensionUnitData=packed record
extensionUnitId:DWORD;
reserve:Byte;
dataLength:Byte;
data:array[0..9] of Byte;
end;
PScePadData=^ScePadData;
ScePadData=packed record
buttons :DWORD;
leftStick :ScePadAnalogStick;
rightStick :ScePadAnalogStick;
analogButtons :ScePadAnalogButtons;
orientation :Tvec_float4;
acceleration :Tvec_float3;
angularVelocity :Tvec_float3;
touchData :ScePadTouchData;
connected :Boolean;
timestamp :QWORD;
extensionUnitData:ScePadExtensionUnitData;
connectedCount :Byte;
reserve:array[0..1] of Byte;
deviceUniqueDataLen:Byte;
deviceUniqueData:array[0..SCE_PAD_MAX_DEVICE_UNIQUE_DATA_SIZE-1] of Byte;
end;
TPadColor=packed record
r,g,b,a:Byte;
end;
PScePadVibrationParam=^ScePadVibrationParam;
ScePadVibrationParam=packed record
largeMotor:Byte;
smallMotor:Byte;
end;
ScePadColor=packed record
r:Byte;
g:Byte;
b:Byte;
reserve:Byte;
end;
ScePadLightBarParam=ScePadColor;
PScePadLightBarParam=^ScePadLightBarParam;
function ps4_scePadReadState(handle:Integer;data:PScePadData):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_PAD_ERROR_INVALID_ARG;
if (data=nil) then Exit;
//Writeln(SizeOf(TPadData)); //184
data^:=Default(ScePadData);
//FillChar(data^,SizeOf(ScePadData),1);
data^.connected:=True;
data^.timestamp:=Sysutils.GetTickCount64;
data^.connectedCount:=1;
data^.leftStick.x:=$80;
data^.leftStick.y:=$80;
data^.rightStick.x:=$80;
data^.rightStick.y:=$80;
if GetAsyncKeyState(VK_W)<>0 then
data^.leftStick.y:=0;
if GetAsyncKeyState(VK_S)<>0 then
data^.leftStick.y:=$FF;
if GetAsyncKeyState(VK_A)<>0 then
data^.leftStick.x:=0;
if GetAsyncKeyState(VK_D)<>0 then
data^.leftStick.x:=$FF;
if GetAsyncKeyState(VK_RETURN)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_OPTIONS;
if GetAsyncKeyState(VK_UP)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_UP;
if GetAsyncKeyState(VK_RIGHT)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_RIGHT;
if GetAsyncKeyState(VK_DOWN)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_DOWN;
if GetAsyncKeyState(VK_LEFT)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_LEFT;
if GetAsyncKeyState(VK_NUMPAD1)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_TRIANGLE;
if GetAsyncKeyState(VK_NUMPAD2)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_CIRCLE;
if GetAsyncKeyState(VK_NUMPAD4)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_CROSS;
if GetAsyncKeyState(VK_NUMPAD5)<>0 then
data^.buttons:=data^.buttons or SCE_PAD_BUTTON_SQUARE;
//data^.buttons:=not data^.buttons;
Result:=0;
end;
function ps4_scePadRead(handle:Integer;data:PScePadData;num:Integer):Integer; SysV_ABI_CDecl;
begin
ps4_scePadReadState(handle,data);
Result:=1;
end;
function ps4_scePadSetVibration(handle:Integer;pParam:PScePadVibrationParam):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_scePadResetLightBar(handle:Integer):Integer; assembler; nostackframe;
asm
xor %rax,%rax
end;
type
ScePadTouchPadInformation=packed record
pixelDensity:Single;
resolution:packed record
x,y:Word;
end;
end;
ScePadStickInformation=packed record
deadZoneLeft:Byte;
deadZoneRight:Byte;
end;
PScePadControllerInformation=^ScePadControllerInformation;
ScePadControllerInformation=packed record
touchPadInfo:ScePadTouchPadInformation;
stickInfo:ScePadStickInformation;
connectionType:Byte;
connectedCount:Byte;
connected:Boolean;
deviceClass:DWORD;
reserve:array[0..7] of Byte;
end;
const
SCE_PAD_CONNECTION_TYPE_LOCAL=0;
SCE_PAD_CONNECTION_TYPE_REMOTE=1;
SCE_PAD_CONNECTION_TYPE_REMOTE_VITA=SCE_PAD_CONNECTION_TYPE_REMOTE;
SCE_PAD_CONNECTION_TYPE_REMOTE_DUALSHOCK4=2;
SCE_PAD_DEVICE_CLASS_INVALID = -1;
SCE_PAD_DEVICE_CLASS_STANDARD = 0;
SCE_PAD_DEVICE_CLASS_GUITAR = 1;
SCE_PAD_DEVICE_CLASS_DRUM = 2;
SCE_PAD_DEVICE_CLASS_DJ_TURNTABLE = 3;
SCE_PAD_DEVICE_CLASS_DANCEMAT = 4;
SCE_PAD_DEVICE_CLASS_NAVIGATION = 5;
SCE_PAD_DEVICE_CLASS_STEERING_WHEEL = 6;
SCE_PAD_DEVICE_CLASS_STICK = 7;
SCE_PAD_DEVICE_CLASS_FLIGHT_STICK = 8;
SCE_PAD_DEVICE_CLASS_GUN = 9;
function ps4_scePadGetControllerInformation(handle:Integer;pInfo:PScePadControllerInformation):Integer; SysV_ABI_CDecl;
begin
//FillChar(pInfo^,SizeOf(ScePadControllerInformation),1);
//Exit(0);
if (pInfo=nil) then Exit(SCE_PAD_ERROR_INVALID_ARG);
pInfo^:=Default(ScePadControllerInformation);
pInfo^.touchPadInfo.pixelDensity := 1;
pInfo^.touchPadInfo.resolution.x := 256;
pInfo^.touchPadInfo.resolution.y := 256;
pInfo^.stickInfo.deadZoneLeft := 2;
pInfo^.stickInfo.deadZoneRight := 2;
pInfo^.connectionType := SCE_PAD_CONNECTION_TYPE_LOCAL;
pInfo^.connectedCount := 1;
pInfo^.connected := True;
pInfo^.deviceClass := SCE_PAD_DEVICE_CLASS_STANDARD;
Result:=0;
end;
function ps4_scePadSetMotionSensorState(handle:Integer;bEnable:Boolean):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_scePadSetLightBar(handle:Integer;pParam:PScePadLightBarParam):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function Load_libScePad(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libScePad');
lib^.set_proc($86FD65BA226BA903,@ps4_scePadInit);
lib^.set_proc($C64D0071AACFDD5E,@ps4_scePadOpen);
lib^.set_proc($6277605EA41557B7,@ps4_scePadReadState);
lib^.set_proc($AB570735F1B270B2,@ps4_scePadRead);
lib^.set_proc($C8556739D1B1BD96,@ps4_scePadSetVibration);
lib^.set_proc($0EC703D62F475F5C,@ps4_scePadResetLightBar);
lib^.set_proc($8233FDFCA433A149,@ps4_scePadGetControllerInformation);
lib^.set_proc($72556F2F86439EDC,@ps4_scePadSetMotionSensorState);
lib^.set_proc($451E27A2F50410D6,@ps4_scePadSetLightBar);
end;
initialization
ps4_app.RegistredPreLoad('libScePad.prx',@Load_libScePad);
end.

180
ps4_libscesavedata.pas Normal file
View File

@ -0,0 +1,180 @@
unit ps4_libSceSaveData;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
Const
SCE_SAVE_DATA_TITLE_MAXSIZE =128;
SCE_SAVE_DATA_SUBTITLE_MAXSIZE=128;
SCE_SAVE_DATA_DETAIL_MAXSIZE =1024;
SCE_SAVE_DATA_DIRNAME_DATA_MAXSIZE=32;
SCE_SAVE_DATA_MOUNT_POINT_DATA_MAXSIZE=16;
SCE_SAVE_DATA_MOUNT_STATUS_CREATED=$00000001;
type
PSceSaveDataParam=^SceSaveDataParam;
SceSaveDataParam=packed record
title:array[0..SCE_SAVE_DATA_TITLE_MAXSIZE-1] of AnsiChar;
subTitle:array[0..SCE_SAVE_DATA_SUBTITLE_MAXSIZE-1] of AnsiChar;
detail:array[0..SCE_SAVE_DATA_DETAIL_MAXSIZE-1] of AnsiChar;
userParam:DWORD;
align:DWORD;
mtime:QWORD;
reserved:array[0..31] of Byte;
end;
PSceSaveDataIcon=^SceSaveDataIcon;
SceSaveDataIcon=packed record
buf:Pointer;
bufSize:size_t;
dataSize:size_t;
reserved:array[0..31] of Byte;
end;
PSceSaveDataMemorySetup2=^SceSaveDataMemorySetup2;
SceSaveDataMemorySetup2=packed record
option:DWORD;
userId:Integer;
memorySize:size_t;
iconMemorySize:size_t;
initParam:PSceSaveDataParam;
initIcon:PSceSaveDataIcon;
reserved:array[0..23] of Byte;
end;
PSceSaveDataMemorySetupResult=^SceSaveDataMemorySetupResult;
SceSaveDataMemorySetupResult=packed record
existedMemorySize:size_t;
reserved:array[0..15] of Byte;
end;
PSceSaveDataDirName=^SceSaveDataDirName;
SceSaveDataDirName=array[0..SCE_SAVE_DATA_DIRNAME_DATA_MAXSIZE-1] of Char;
PSceSaveDataMountPoint=^SceSaveDataMountPoint;
SceSaveDataMountPoint=array[0..SCE_SAVE_DATA_MOUNT_POINT_DATA_MAXSIZE-1] of Char;
PSceSaveDataMount2=^SceSaveDataMount2;
SceSaveDataMount2=packed record
userId:Integer;
align1:Integer;
dirName:PSceSaveDataDirName;
blocks:QWORD;
mountMode:DWORD;
reserved:array[0..31] of Byte;
align2:Integer;
end;
PSceSaveDataMountResult=^SceSaveDataMountResult;
SceSaveDataMountResult=packed record
mountPoint:SceSaveDataMountPoint;
requiredBlocks:QWORD;
unused:DWORD;
mountStatus:DWORD;
reserved:array[0..27] of Byte;
align1:Integer;
end;
implementation
uses
ps4_libkernel;
function ps4_sceSaveDataInitialize(params:Pointer):Integer; assembler; nostackframe;
asm
xor %rax,%rax
end;
function ps4_sceSaveDataInitialize3(params:Pointer):Integer; assembler; nostackframe;
asm
xor %rax,%rax
end;
function ps4_sceSaveDataSetupSaveDataMemory(userId:Integer;
memorySize:QWORD;
param:PSceSaveDataParam):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function sceSaveDataSetupSaveDataMemory2(setupParam:PSceSaveDataMemorySetup2;
_result:PSceSaveDataMemorySetupResult):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function ps4_sceSaveDataGetSaveDataMemory(userId:Integer;
buf:Pointer;
bufSize:size_t;
offset:QWORD):Integer; SysV_ABI_CDecl;
begin
FillChar(buf^,bufSize,0);
Result:=0;
end;
function ps4_sceSaveDataSetSaveDataMemory(userId:Integer;
buf:Pointer;
bufSize:size_t;
offset:QWORD):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
const
SCE_SAVE_DATA_ERROR_PARAMETER =-2137063424; // 0x809F0000
SCE_SAVE_DATA_ERROR_EXISTS =-2137063417; // 0x809F0007
SCE_SAVE_DATA_ERROR_MOUNT_FULL =-2137063412; // 0x809F000C
SCE_SAVE_DATA_ERROR_NOT_MOUNTED=-2137063420; // 0x809F0004
function ps4_sceSaveDataMount2(mount:PSceSaveDataMount2;mountResult:PSceSaveDataMountResult):Integer; SysV_ABI_CDecl;
begin
if (mount=nil) or (mountResult=nil) then Exit(SCE_SAVE_DATA_ERROR_PARAMETER);
Result:=FetchMount(PChar(mount^.dirName),@mountResult^.mountPoint);
end;
function ps4_sceSaveDataUmount(mountPoint:PSceSaveDataMountPoint):Integer; SysV_ABI_CDecl;
begin
Result:=UnMountPath(PChar(mountPoint));
end;
type
SceSaveDataParamType=DWORD;
function ps4_sceSaveDataSetParam(mountPoint:PSceSaveDataMountPoint;
paramType:SceSaveDataParamType;
paramBuf:Pointer;
paramBufSize:size_t):Integer; SysV_ABI_CDecl;
begin
Result:=0;
end;
function Load_libSceSaveData(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceSaveData');
lib^.set_proc($664661B2408F5C5C,@ps4_sceSaveDataInitialize);
lib^.set_proc($4F2C2B14A0A82C66,@ps4_sceSaveDataInitialize3);
lib^.set_proc($BFB00000CA342F3E,@ps4_sceSaveDataSetupSaveDataMemory);
lib^.set_proc($EC1B79A410BF01CA,@ps4_sceSaveDataGetSaveDataMemory);
lib^.set_proc($8776144735C64954,@ps4_sceSaveDataSetSaveDataMemory);
lib^.set_proc($D33E393C81FE48D2,@ps4_sceSaveDataMount2);
lib^.set_proc($04C47817F51E9371,@ps4_sceSaveDataUmount);
lib^.set_proc($F39CEE97FFDE197B,@ps4_sceSaveDataSetParam);
end;
initialization
ps4_app.RegistredPreLoad('libSceSaveData.prx',@Load_libSceSaveData);
end.

176
ps4_libscesystemservice.pas Normal file
View File

@ -0,0 +1,176 @@
unit ps4_libSceSystemService;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
implementation
uses
ps4_libkernel;
const
SCE_SYSTEM_SERVICE_PARAM_ID_LANG =1;
SCE_SYSTEM_SERVICE_PARAM_ID_DATE_FORMAT =2;
SCE_SYSTEM_SERVICE_PARAM_ID_TIME_FORMAT =3;
SCE_SYSTEM_SERVICE_PARAM_ID_TIME_ZONE =4;
SCE_SYSTEM_SERVICE_PARAM_ID_SUMMERTIME =5;
SCE_SYSTEM_SERVICE_PARAM_ID_SYSTEM_NAME =6;
SCE_SYSTEM_SERVICE_PARAM_ID_GAME_PARENTAL_LEVEL =7;
SCE_SYSTEM_SERVICE_PARAM_ID_ENTER_BUTTON_ASSIGN =1000;
SCE_SYSTEM_SERVICE_ERROR_INTERNAL =-2136932351;
SCE_SYSTEM_SERVICE_ERROR_UNAVAILABLE =-2136932350;
SCE_SYSTEM_SERVICE_ERROR_PARAMETER =-2136932349;
SCE_SYSTEM_SERVICE_ERROR_NO_EVENT =-2136932348;
SCE_SYSTEM_SERVICE_ERROR_REJECTED =-2136932347;
SCE_SYSTEM_SERVICE_ERROR_NEED_DISPLAY_SAFE_AREA_SETTINGS =-2136932346;
SCE_SYSTEM_SERVICE_ERROR_INVALID_URI_LEN =-2136932345;
SCE_SYSTEM_SERVICE_ERROR_INVALID_URI_SCHEME =-2136932344;
SCE_SYSTEM_SERVICE_ERROR_NO_APP_INFO =-2136932343;
SCE_SYSTEM_SERVICE_ERROR_NOT_FLAG_IN_PARAM_SFO =-2136932342;
// Language
SCE_SYSTEM_PARAM_LANG_JAPANESE =0;
SCE_SYSTEM_PARAM_LANG_ENGLISH_US =1;
SCE_SYSTEM_PARAM_LANG_FRENCH =2;
SCE_SYSTEM_PARAM_LANG_SPANISH =3;
SCE_SYSTEM_PARAM_LANG_GERMAN =4;
SCE_SYSTEM_PARAM_LANG_ITALIAN =5;
SCE_SYSTEM_PARAM_LANG_DUTCH =6;
SCE_SYSTEM_PARAM_LANG_PORTUGUESE_PT =7;
SCE_SYSTEM_PARAM_LANG_RUSSIAN =8;
SCE_SYSTEM_PARAM_LANG_KOREAN =9;
SCE_SYSTEM_PARAM_LANG_CHINESE_T =10;
SCE_SYSTEM_PARAM_LANG_CHINESE_S =11;
SCE_SYSTEM_PARAM_LANG_FINNISH =12;
SCE_SYSTEM_PARAM_LANG_SWEDISH =13;
SCE_SYSTEM_PARAM_LANG_DANISH =14;
SCE_SYSTEM_PARAM_LANG_NORWEGIAN =15;
SCE_SYSTEM_PARAM_LANG_POLISH =16;
SCE_SYSTEM_PARAM_LANG_PORTUGUESE_BR =17;
SCE_SYSTEM_PARAM_LANG_ENGLISH_GB =18;
SCE_SYSTEM_PARAM_LANG_TURKISH =19;
SCE_SYSTEM_PARAM_LANG_SPANISH_LA =20;
SCE_SYSTEM_PARAM_LANG_ARABIC =21;
SCE_SYSTEM_PARAM_LANG_FRENCH_CA =22;
// Date
SCE_SYSTEM_PARAM_DATE_FORMAT_YYYYMMDD=0;
SCE_SYSTEM_PARAM_DATE_FORMAT_DDMMYYYY=1;
SCE_SYSTEM_PARAM_DATE_FORMAT_MMDDYYYY=2;
// Time
SCE_SYSTEM_PARAM_TIME_FORMAT_12HOUR=0;
SCE_SYSTEM_PARAM_TIME_FORMAT_24HOUR=1;
//
SCE_SYSTEM_SERVICE_MAX_SYSTEM_NAME_LENGTH=65;
//
SCE_SYSTEM_PARAM_GAME_PARENTAL_OFF =0;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL01=1;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL02=2;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL03=3;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL04=4;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL05=5;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL06=6;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL07=7;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL08=8;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL09=9;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL10=10;
SCE_SYSTEM_PARAM_GAME_PARENTAL_LEVEL11=11;
//
SCE_SYSTEM_PARAM_ENTER_BUTTON_ASSIGN_CIRCLE=0;
SCE_SYSTEM_PARAM_ENTER_BUTTON_ASSIGN_CROSS =1;
function ps4_sceSystemServiceParamGetInt(paramId:Integer;value:Pinteger):Integer; SysV_ABI_CDecl;
begin
Writeln('ParamGetInt:',paramId);
Result:=SCE_SYSTEM_SERVICE_ERROR_PARAMETER;
if value=nil then Exit;
value^:=0;
if ((paramId<>SCE_SYSTEM_SERVICE_PARAM_ID_ENTER_BUTTON_ASSIGN) and
((paramId < SCE_SYSTEM_SERVICE_PARAM_ID_LANG) or (paramId > SCE_SYSTEM_SERVICE_PARAM_ID_GAME_PARENTAL_LEVEL))) then
Exit;
Case paramId of
SCE_SYSTEM_SERVICE_PARAM_ID_LANG :value^:=SCE_SYSTEM_PARAM_LANG_CHINESE_T;
SCE_SYSTEM_SERVICE_PARAM_ID_DATE_FORMAT:value^:=SCE_SYSTEM_PARAM_DATE_FORMAT_DDMMYYYY;
SCE_SYSTEM_SERVICE_PARAM_ID_TIME_FORMAT:value^:=SCE_SYSTEM_PARAM_TIME_FORMAT_12HOUR;
SCE_SYSTEM_SERVICE_PARAM_ID_TIME_ZONE :value^:=480;// GMT+8
SCE_SYSTEM_SERVICE_PARAM_ID_SUMMERTIME :value^:=1; // 1 in daylight savings time, 0 not in daylight savings time
SCE_SYSTEM_SERVICE_PARAM_ID_SYSTEM_NAME:;// for sceSystemServiceParamGetString, shouldn't be used here.
SCE_SYSTEM_SERVICE_PARAM_ID_GAME_PARENTAL_LEVEL:value^:=SCE_SYSTEM_PARAM_GAME_PARENTAL_OFF;
SCE_SYSTEM_SERVICE_PARAM_ID_ENTER_BUTTON_ASSIGN:value^:=SCE_SYSTEM_PARAM_ENTER_BUTTON_ASSIGN_CIRCLE;
end;
end;
procedure ps4_sceSystemServiceHideSplashScreen; assembler; nostackframe;
asm
xor %rax,%rax
end;
type
PSceSystemServiceDisplaySafeAreaInfo=^SceSystemServiceDisplaySafeAreaInfo;
SceSystemServiceDisplaySafeAreaInfo=packed record
ratio:Single; //Ratio of the safe area (0.9 or more, 1.0 or less)
reserved:array[0..127] of Byte;
end;
function ps4_sceSystemServiceGetDisplaySafeAreaInfo(info:PSceSystemServiceDisplaySafeAreaInfo):Integer; SysV_ABI_CDecl;
begin
Result:=SCE_KERNEL_ERROR_UNKNOWN;
if (info=nil) then Exit(SCE_SYSTEM_SERVICE_ERROR_PARAMETER);
info^.ratio:=1.0;
Result:=0;
end;
type
PSceSystemServiceStatus=^SceSystemServiceStatus;
SceSystemServiceStatus=packed record
eventNum:Integer;
isSystemUiOverlaid,
isInBackgroundExecution,
isCpuMode7CpuNormal,
isGameLiveStreamingOnAir,
isOutOfVrPlayArea:Boolean;
reserved:array[0..124] of Byte;
end;
function ps4_sceSystemServiceGetStatus(status:PSceSystemServiceStatus):Integer; SysV_ABI_CDecl;
begin
if status=nil then Exit(SCE_SYSTEM_SERVICE_ERROR_PARAMETER);
status^.eventNum:=0;
status^.isSystemUiOverlaid:=false;
status^.isInBackgroundExecution:=false;
status^.isCpuMode7CpuNormal:=true;
status^.isGameLiveStreamingOnAir:=false;
status^.isOutOfVrPlayArea:=false;
Result:=0;
end;
function Load_libSceSystemService(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceSystemService');
lib^.set_proc($7D9A38F2E9FB2CAE,@ps4_sceSystemServiceParamGetInt);
lib^.set_proc($568E55F0A0300A69,@ps4_sceSystemServiceHideSplashScreen);
lib^.set_proc($D67DFBAB506F7396,@ps4_sceSystemServiceGetDisplaySafeAreaInfo);
lib^.set_proc($ACFA3AB55F03F5B3,@ps4_sceSystemServiceGetStatus);
end;
initialization
ps4_app.RegistredPreLoad('libSceSystemService.prx',@Load_libSceSystemService);
end.

84
ps4_libsceuserservice.pas Normal file
View File

@ -0,0 +1,84 @@
unit ps4_libSceUserService;
{$mode objfpc}{$H+}
interface
uses
ps4_program,
Classes, SysUtils;
const
SCE_KERNEL_PRIO_FIFO_LOWEST =$2FF;
SCE_KERNEL_PRIO_FIFO_NORMAL =$2BC;
SCE_KERNEL_PRIO_FIFO_HIGHEST=$100;
SCE_USER_SERVICE_MAX_LOGIN_USERS=4;
SCE_USER_SERVICE_USER_ID_INVALID=Integer($FFFFFFFF);
type
PUserServiceInitializeParams=^TUserServiceInitializeParams;
TUserServiceInitializeParams=packed record
priority:DWORD;
end;
PUserServiceLoginUserIdList=^TUserServiceLoginUserIdList;
TUserServiceLoginUserIdList=packed record
userId:array[0..SCE_USER_SERVICE_MAX_LOGIN_USERS-1] of Integer;
end;
implementation
function ps4_sceUserServiceInitialize(params:PUserServiceInitializeParams):Integer; assembler; nostackframe;
asm
xor %rax,%rax
end;
function ps4_sceUserServiceGetLoginUserIdList(List:PUserServiceLoginUserIdList):Integer; SysV_ABI_CDecl;
var
i:Integer;
begin
Result:=-1;
if (List=nil) then Exit;
List^.userId[0]:=1;
For i:=1 to SCE_USER_SERVICE_MAX_LOGIN_USERS-1 do
List^.userId[i]:=SCE_USER_SERVICE_USER_ID_INVALID;
Result:=0;
end;
function ps4_sceUserServiceGetInitialUser(pUserId:PInteger):Integer; SysV_ABI_CDecl;
begin
Result:=-1;
if pUserId=nil then Exit;
pUserId^:=1;
Result:=0;
end;
function ps4_sceUserServiceGetUserName(userId:Integer;userName:PChar;size:size_t):Integer; SysV_ABI_CDecl;
Const
cuser:PChar='user';
begin
Move(cuser^,userName^,Length(cuser)+1);
Result:=0;
end;
function Load_libSceUserService(Const name:RawByteString):TElf_node;
var
lib:PLIBRARY;
begin
Result:=TElf_node.Create;
Result.pFileName:=name;
lib:=Result._add_lib('libSceUserService');
lib^.set_proc($8F760CBB531534DA,@ps4_sceUserServiceInitialize);
lib^.set_proc($7CF87298A36F2BF0,@ps4_sceUserServiceGetLoginUserIdList);
lib^.set_proc($09D5A9D281D61ABD,@ps4_sceUserServiceGetInitialUser);
lib^.set_proc($D71C5C3221AED9FA,@ps4_sceUserServiceGetUserName);
end;
initialization
ps4_app.RegistredPreLoad('libSceUserService.prx',@Load_libSceUserService);
end.

1248
ps4_libscevideoout.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1347
ps4_program.pas Normal file
View File

File diff suppressed because it is too large Load Diff

500
ps4_types.pas Normal file
View File

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

65349
ps4libdoc.pas Normal file
View File

File diff suppressed because it is too large Load Diff

406
seh64.pas Normal file
View File

@ -0,0 +1,406 @@
unit seh64;
{$mode objfpc}{$H+}
interface
implementation
uses
Windows,
SysConst,
SysUtils,
hamt,
ps4libdoc,
ps4_types,
ps4_program;
function AddVectoredExceptionHandler(FirstHandler: DWORD; VectoredHandler: pointer): pointer; stdcall;
external 'kernel32.dll' name 'AddVectoredExceptionHandler';
function RemoveVectoredExceptionHandler(VectoredHandlerHandle: pointer): ULONG; stdcall;
external 'kernel32.dll' name 'RemoveVectoredExceptionHandler';
function GetModuleHandleEx(dwFlags: DWORD; lpModuleName: pointer; var hModule: THandle): BOOL; stdcall;
external 'kernel32.dll' name 'GetModuleHandleExA';
// sysutils.GetModuleName();
const
GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT = 2;
GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS = 4;
function GetModuleByAdr(adr:Pointer):THandle;
var
Flags:DWORD;
begin
Flags:=GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS or GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT;
Result:=0;
GetModuleHandleEx(Flags,adr,Result);
end;
function RunErrorCode(const rec: TExceptionRecord): longint;
begin
{ negative result means 'FPU reset required' }
case rec.ExceptionCode of
STATUS_INTEGER_DIVIDE_BY_ZERO: result := 200; { reDivByZero }
STATUS_FLOAT_DIVIDE_BY_ZERO: result := -208; { !!reZeroDivide }
STATUS_ARRAY_BOUNDS_EXCEEDED: result := 201; { reRangeError }
STATUS_STACK_OVERFLOW: result := 202; { reStackOverflow }
STATUS_FLOAT_OVERFLOW: result := -205; { reOverflow }
STATUS_FLOAT_DENORMAL_OPERAND,
STATUS_FLOAT_UNDERFLOW: result := -206; { reUnderflow }
STATUS_FLOAT_INEXACT_RESULT,
STATUS_FLOAT_INVALID_OPERATION,
STATUS_FLOAT_STACK_CHECK: result := -207; { reInvalidOp }
STATUS_INTEGER_OVERFLOW: result := 215; { reIntOverflow }
STATUS_ILLEGAL_INSTRUCTION: result := -216;
STATUS_ACCESS_VIOLATION: result := 216; { reAccessViolation }
STATUS_CONTROL_C_EXIT: result := 217; { reControlBreak }
STATUS_PRIVILEGED_INSTRUCTION: result := 218; { rePrivilegedInstruction }
STATUS_FLOAT_MULTIPLE_TRAPS,
STATUS_FLOAT_MULTIPLE_FAULTS: result := -255; { indicate FPU reset }
else
result := 255; { reExternalException }
end;
end;
procedure TranslateMxcsr(mxcsr: longword; var code: longint);
begin
{ we can return only one value, further one's are lost }
{ InvalidOp }
if (mxcsr and 1)<>0 then
code:=-207
{ Denormal }
else if (mxcsr and 2)<>0 then
code:=-206
{ !!reZeroDivide }
else if (mxcsr and 4)<>0 then
code:=-208
{ reOverflow }
else if (mxcsr and 8)<>0 then
code:=-205
{ Underflow }
else if (mxcsr and 16)<>0 then
code:=-206
{ Precision }
else if (mxcsr and 32)<>0 then
code:=-207
else { this should not happen }
code:=-255
end;
function RunErrorCodex64(const rec: TExceptionRecord; const context: TContext): Longint;
begin
Result:=RunErrorCode(rec);
if (Result=-255) then
TranslateMxcsr(context.MxCsr,result);
end;
type
_TElf_node=class(TElf_node)
end;
PTLQRec=^TLQRec;
TLQRec=record
pAddr:Pointer;
ExceptAddr:Pointer;
LastAdr:Pointer;
LastNid:QWORD;
end;
procedure trav_proc(data,userdata:Pointer);
var
adr:Pointer;
nid:QWORD;
begin
if (data=nil) then Exit;
safe_move_ptr(PPointer(data)[0],adr);
safe_move_ptr(PPointer(data)[1],nid);
if (adr>=PTLQRec(userdata)^.pAddr) then
if (adr<=PTLQRec(userdata)^.ExceptAddr) then
if (adr>PTLQRec(userdata)^.LastAdr) then
begin
PTLQRec(userdata)^.LastAdr:=adr;
PTLQRec(userdata)^.LastNid:=nid;
end;
end;
function IsSubTrie64(n:PHAMTNode64):Boolean; inline;
var
BaseValue:PtrUint;
begin
safe_move_ptr(n^.BaseValue,BaseValue);
Result:=(BaseValue and 1)<>0;
end;
function GetBitMapSize64(n:PHAMTNode64):QWORD; inline;
var
BitMapKey:QWORD;
begin
safe_move_ptr(n^.BitMapKey,BitMapKey);
Result:=PopCnt(BitMapKey);
Result:=Result and HAMT64.node_mask;
if (Result=0) then Result:=HAMT64.node_size;
end;
function GetSubTrie64(n:PHAMTNode64):PHAMTNode64; inline;
var
BaseValue:PtrUint;
begin
safe_move_ptr(n^.BaseValue,BaseValue);
PtrUint(Result):=(BaseValue or 1) xor 1;
end;
function GetValue64(n:PHAMTNode64):Pointer; inline;
begin
safe_move_ptr(n^.BaseValue,Result);
end;
procedure HAMT_traverse_trie64(node:PHAMTNode64;cb:Tfree_data_cb;userdata:Pointer); inline;
type
PStackNode=^TStackNode;
TStackNode=packed record
cnode,enode:PHAMTNode64;
end;
var
curr:PStackNode;
data:array[0..HAMT64.stack_max] of TStackNode;
Size:QWORD;
begin
if IsSubTrie64(node) then
begin
curr:=@data;
Size:=GetBitMapSize64(node);
With curr^ do
begin
cnode:=GetSubTrie64(node);
enode:=@cnode[Size];
end;
repeat
if (curr^.cnode>=curr^.enode) then
begin
if (curr=@data) then Break;
Dec(curr);
Inc(curr^.cnode);
Continue;
end;
if IsSubTrie64(curr^.cnode) then
begin
node:=curr^.cnode;
Inc(curr);
Size:=GetBitMapSize64(node);
With curr^ do
begin
cnode:=GetSubTrie64(node);
enode:=@cnode[Size];
end;
end else
begin
if (cb<>nil) then
cb(GetValue64(curr^.cnode),userdata);
Inc(curr^.cnode);
end;
until false;
end else
begin
if (cb<>nil) then
cb(GetValue64(node),userdata);
end;
end;
function HAMT_traverse64(hamt:THAMT;cb:Tfree_data_cb;userdata:Pointer):Boolean;
var
i:Integer;
node:PHAMTNode64;
begin
if (hamt=nil) then Exit(False);
For i:=0 to HAMT64.root_mask do
begin
node:=@PHAMTNode64(hamt)[i];
HAMT_traverse_trie64(node,cb,userdata);
end;
Result:=True;
end;
Function FindLQProc(node:TElf_node;r:PTLQRec):Boolean;
var
i,l:SizeInt;
lib:PLIBRARY;
MapSymbol:THAMT;
Import:Boolean;
begin
Result:=false;
l:=Length(_TElf_node(node).aLibs);
if (l<>0) then
begin
r^.LastAdr:=nil;
r^.LastNid:=0;
For i:=0 to l-1 do
begin
safe_move_ptr(_TElf_node(node).aLibs[i],lib);
if (lib<>nil) then
begin
Import:=True;
safe_move(lib^.Import,Import,SizeOf(Boolean));
if not Import then
begin
safe_move_ptr(lib^.MapSymbol,MapSymbol);
HAMT_traverse64(MapSymbol,@trav_proc,r);
end;
end;
end;
Result:=(r^.LastAdr<>nil);
end;
end;
Procedure WriteErr(Const s:shortstring);
var
num:DWORD;
begin
WriteConsole(GetStdHandle(STD_ERROR_HANDLE),@s[1],ord(s[0]),num,nil);
end;
function IntToStr(Value:longint): shortstring;
begin
System.Str(Value,result);
end;
function GetModuleName(Module:HMODULE): shortstring;
var
Len:DWORD;
Buffer:array[0..MAX_PATH] of WideChar;
P:PWideChar;
begin
Len:=GetModuleFileNameW(Module,@Buffer,MAX_PATH);
P:=@Buffer[Len];
While (P<>@Buffer) do
begin
if (P^='\') then
begin
Inc(P);
Break;
end;
Dec(P);
end;
Len:=@Buffer[Len]-P;
Len:=UnicodeToUtf8(@Result[1],255,P,Len);
Byte(Result[0]):=Len;
end;
Procedure DumpException(node:TElf_node;code:Longint;ExceptAddr:Pointer;ContextRecord:PCONTEXT);
var
Report:shortstring;
pFileName:PChar;
Mem:TMemChunk;
top,rbp:PPointer;
procedure print_adr;
var
r:TLQRec;
begin
Report:=' $'+hexstr(ExceptAddr);
if (node<>nil) then
begin
Mem:=node.GetCodeFrame;
if (Mem.pAddr<>nil) and (Mem.nSize<>0) then
begin
safe_move_ptr(node.pFileName,pFileName);
Report:=Report+' offset $'+hexstr(ExceptAddr-Mem.pAddr,8)+' '+safe_str(pFileName);
r.pAddr:=Mem.pAddr;
r.ExceptAddr:=ExceptAddr;
if FindLQProc(node,@r) then
begin
Report:=Report+':'+ps4libdoc.GetFunctName(r.LastNid)+'+$'+hexstr(ExceptAddr-r.LastAdr,8);
end else
if (node.GetEntryPoint<>nil) then
begin
Report:=Report+':EntryPoint+$'+hexstr(ExceptAddr-node.GetEntryPoint,8);
end;
end;
end;
Report:=Report+#13#10;
WriteErr(Report);
end;
procedure print_adr2;
begin
Report:=' $'+hexstr(ExceptAddr);
Report:=Report+' '+GetModuleName(GetModuleByAdr(ExceptAddr));
Report:=Report+#13#10;
WriteErr(Report);
end;
begin
Report:='';
Report:=Report+'Message: '+SysConst.GetRunError(abs(code));
Report:=Report+' ('+IntToStr(longint(code))+')';
Report:=Report+#13#10;
WriteErr(Report);
print_adr;
top:=Pointer(ContextRecord^.Rbp);
//if (top>StackBottom) and (top<StackTop) then
begin
rbp:=top;
repeat
safe_move_ptr(rbp[1],ExceptAddr);
safe_move_ptr(rbp[0],rbp);
if (ExceptAddr<>nil) then
begin
node:=ps4_app.FindFileByCodeAdr(ExceptAddr);
if (node<>nil) then
begin
print_adr;
end else
begin
print_adr2;
end;
end;
until (node=nil) {or (rbp>top) or (rbp<StackBottom)};
end;
end;
const
FPC_EXCEPTION_CODE=$E0465043;
function ProcessException(p: PExceptionPointers): longint; stdcall;
var
code: Longint;
node:TElf_node;
begin
Result := 0;
if (p^.ExceptionRecord^.ExceptionCode=FPC_EXCEPTION_CODE) then Exit(EXCEPTION_CONTINUE_SEARCH);
node:=ps4_app.FindFileByCodeAdr(p^.ExceptionRecord^.ExceptionAddress);
if (node=nil) and
(GetModuleByAdr(p^.ExceptionRecord^.ExceptionAddress)<>GetModuleByAdr(@ProcessException)) then
Exit(EXCEPTION_CONTINUE_SEARCH);
code:=RunErrorCodex64(p^.ExceptionRecord^,p^.ContextRecord^);
DumpException(node,code,p^.ExceptionRecord^.ExceptionAddress,P^.ContextRecord);
halt;
end;
var
VEHandler: pointer = Nil;
procedure InstallExceptionHandler;
begin
VEHandler := AddVectoredExceptionHandler(1, @ProcessException);
end;
procedure UninstallExceptionHandler;
begin
if Assigned(VEHandler) then
begin
RemoveVectoredExceptionHandler(VEHandler);
VEHandler := Nil;
end;
end;
initialization
InstallExceptionHandler;
finalization
UninstallExceptionHandler;
end.

60
shaders/FLIP_CURSOR.comp Normal file
View File

@ -0,0 +1,60 @@
#version 450
layout (local_size_x = 16, local_size_y = 16) in;
layout (binding = 0) readonly buffer Host
{
uint data[];
} host;
layout (binding = 1, rgba8) uniform image2D resultImage;
layout (push_constant) uniform constants
{
vec4 gamma;
ivec2 pos;
} cfg;
void main()
{
ivec2 pixelCoords = ivec2(gl_GlobalInvocationID.xy);
int offset = (pixelCoords.y*64)+pixelCoords.x;
uint pack=host.data[offset];
////const uvec4 shift = uvec4(16,8,0,24);
////const uvec4 mask4 = uvec4(255,255,255,255);
////uvec4 pix_int=(uvec4(pack,pack,pack,pack) >> shift) & mask4;
//24,16, 8, 0
//AA,RR,GG,BB
//0,8,16,24
//R,G, B,A
//16,8,0,24
//BGRA
//24,0,8,16
//ARGB
////vec4 pixel = vec4(pix_int) / mask4;
vec4 pixel=unpackUnorm4x8(pack);
pixel=pixel.bgra;
pixel = pow(pixel, cfg.gamma);
pixelCoords = pixelCoords + cfg.pos;
vec4 prev = imageLoad(resultImage, pixelCoords);
pixel.rgb = mix(prev.rgb,pixel.rgb,pixel.a);
imageStore(resultImage, pixelCoords, pixel);
}

BIN
shaders/FLIP_CURSOR.spv Normal file
View File

Binary file not shown.

44
shaders/FLIP_LINE_A8R8G8B8_SRGB.comp Normal file
View File

@ -0,0 +1,44 @@
#version 450
layout (local_size_x = 16, local_size_y = 16) in;
layout (binding = 0) readonly buffer Host
{
uint data[];
} host;
layout (binding = 1, rgba8) writeonly uniform image2D resultImage;
layout (push_constant) uniform constants
{
vec4 gamma;
ivec2 Width;
} cfg;
void main()
{
ivec2 pixelCoords = ivec2(gl_GlobalInvocationID.xy);
int offset = (pixelCoords.y*cfg.Width.y)+pixelCoords.x;
uint pack=host.data[offset];
const uvec4 shift = uvec4(16,8,0,24);
const uvec4 mask4 = uvec4(255,255,255,255);
uvec4 pix_int=(uvec4(pack,pack,pack,pack) >> shift) & mask4;
//0,8,16,24
//R,G, B,A
//16,8,0,24
//BGRA
vec4 pixel = vec4(pix_int) / mask4;
pixel = pow(pixel, cfg.gamma);
imageStore(resultImage, pixelCoords, pixel);
}

BIN
shaders/FLIP_LINE_A8R8G8B8_SRGB.spv Normal file
View File

Binary file not shown.

95
shaders/FLIP_TILE_A8R8G8B8_SRGB.comp Normal file
View File

@ -0,0 +1,95 @@
#version 450
layout (local_size_x = 16, local_size_y = 16) in;
layout (binding = 0) readonly buffer Host
{
uint data[];
} host;
layout (binding = 1, rgba8) writeonly uniform image2D resultImage;
layout (push_constant) uniform constants
{
vec4 gamma;
ivec2 pitch;
} cfg;
const ivec2 sh02 = ivec2(0,2);
const ivec4 sh1212 = ivec4(1,2,1,2);
const ivec4 sh1345 = ivec4(1,3,4,5);
const ivec3 sh345 = ivec3(3,4,5);
const ivec3 sh678 = ivec3(6,7,8);
const ivec4 sh6789 = ivec4(6,7,8,9);
const ivec4 sh6543 = ivec4(6,5,4,3);
const ivec4 sh9101112 = ivec4(9,10,11,12);
const ivec2 i2_1 = ivec2(1,1);
const ivec3 i3_1 = ivec3(1,1,1);
const ivec4 i4_1 = ivec4(1,1,1,1);
int getElementIndex(ivec2 p) //[0..5]
{
ivec2 t1=(p.xy & i2_1) << sh02;
ivec4 t2=((p.xxyy >> sh1212) & i4_1) << sh1345;
t1=t1 | t2.xy | t2.zw;
return t1.x | t1.y;
}
int getPipeIndex(ivec2 p) //[6..8]
{
ivec3 t=(((p.xxx >> sh345) ^ (p.yyy >> sh345) ^ ivec3(p.x>>4,0,0)) & i3_1) << sh678;
return t.x | t.y | t.z;
}
int getBankIndex(ivec2 p) //[9..12]
{
ivec4 bank=(((p.xxxx >> sh6789) ^ (p.yyyy >> sh6543) ^ ivec4(0,p.y>>6,0,0)) & i4_1) << sh9101112;
ivec2 t=bank.xy | bank.zw;
return t.x | t.y;
}
void main()
{
ivec2 pixelCoords = ivec2(gl_GlobalInvocationID.xy);
int element_index=getElementIndex(pixelCoords);
int pipe=getPipeIndex(pixelCoords);
int bank=getBankIndex(pixelCoords);
const ivec4 shmt = ivec4(7,6,6,3);
const ivec2 bmod = ivec2(1,1);
ivec4 mt=(pixelCoords.xyxy >> shmt);
ivec2 total_offset=(mt.xy*cfg.pitch)+(mt.zw % bmod);
int offset = element_index | pipe | bank | ((total_offset.x+total_offset.y) << 13);
uint pack=host.data[offset];
////const uvec4 shift = uvec4(16,8,0,24);
////const uvec4 mask4 = uvec4(255,255,255,255);
////uvec4 pix_int=(uvec4(pack,pack,pack,pack) >> shift) & mask4;
//0,8,16,24
//R,G, B,A
//16,8,0,24
//BGRA
////vec4 pixel = vec4(pix_int) / mask4;
vec4 pixel=unpackUnorm4x8(pack);
pixel=pixel.bgra;
pixel = pow(pixel, cfg.gamma);
imageStore(resultImage, pixelCoords, pixel);
}

BIN
shaders/FLIP_TILE_A8R8G8B8_SRGB.spv Normal file
View File

Binary file not shown.

97
shaders/FLIP_TILE_A8R8G8B8_SRGB_NEO.comp Normal file
View File

@ -0,0 +1,97 @@
#version 450
layout (local_size_x = 16, local_size_y = 16) in;
layout (binding = 0) readonly buffer Host
{
uint data[];
} host;
layout (binding = 1, rgba8) writeonly uniform image2D resultImage;
layout (push_constant) uniform constants
{
vec4 gamma;
ivec2 pitch;
} cfg;
const ivec2 sh02 = ivec2(0,2);
const ivec4 sh1212 = ivec4(1,2,1,2);
const ivec4 sh1345 = ivec4(1,3,4,5);
const ivec4 sh3456 = ivec4(3,4,5,6);
const ivec4 sh3455 = ivec4(3,4,5,5);
const ivec4 sh6789 = ivec4(6,7,8,9);
const ivec3 sh789 = ivec3(7,8,9);
const ivec3 sh654 = ivec3(6,5,4);
const ivec3 sh101112 = ivec3(10,11,12);
const ivec2 i2_1 = ivec2(1,1);
const ivec3 i3_1 = ivec3(1,1,1);
const ivec4 i4_1 = ivec4(1,1,1,1);
int getElementIndex(ivec2 p) //[0..5]
{
ivec2 t1=(p.xy & i2_1) << sh02;
ivec4 t2=((p.xxyy >> sh1212) & i4_1) << sh1345;
t1=t1 | t2.xy | t2.zw;
return t1.x | t1.y;
}
int getPipeIndex(ivec2 p) //[6..9]
{
ivec4 t=(((p.xxxx >> sh3456) ^ (p.yyyy >> sh3455) ^ ivec4(p.x>>4,0,0,0)) & i4_1) << sh6789;
ivec2 t2=t.xy | t.zw;
return t2.x | t2.y;
}
int getBankIndex(ivec2 p) //[10..12]
{
ivec3 bank=(((p.xxx >> sh789) ^ (p.yyy >> sh654) ^ ivec3(0,p.y>>6,0)) & i3_1) << sh101112;
return bank.x | bank.y | bank.z;
}
void main()
{
ivec2 pixelCoords = ivec2(gl_GlobalInvocationID.xy);
int element_index=getElementIndex(pixelCoords);
int pipe=getPipeIndex(pixelCoords);
int bank=getBankIndex(pixelCoords);
const ivec4 shmt = ivec4(7,7,7,3);
const ivec2 bmod = ivec2(1,2);
ivec4 mt=(pixelCoords.xyxy >> shmt);
ivec2 total_offset=((mt.xy*cfg.pitch) << i2_1)+(mt.zw % bmod);
int offset = element_index | pipe | bank | ((total_offset.x+total_offset.y) << 13);
uint pack=host.data[offset];
////const uvec4 shift = uvec4(16,8,0,24);
////const uvec4 mask4 = uvec4(255,255,255,255);
////uvec4 pix_int=(uvec4(pack,pack,pack,pack) >> shift) & mask4;
//0,8,16,24
//R,G, B,A
//16,8,0,24
//BGRA
////vec4 pixel = vec4(pix_int) / mask4;
vec4 pixel=unpackUnorm4x8(pack);
pixel=pixel.bgra;
pixel = pow(pixel, cfg.gamma);
imageStore(resultImage, pixelCoords, pixel);
}

BIN
shaders/FLIP_TILE_A8R8G8B8_SRGB_NEO.spv Normal file
View File

Binary file not shown.

19
shaders/compile.cmd Normal file
View File

@ -0,0 +1,19 @@
Set spirvgls=spirv\glslangValidator -g0 -V --target-env vulkan1.0
Set spirvopt=spirv\spirv-opt --eliminate-dead-branches --eliminate-local-multi-store --inline-entry-points-exhaustive --eliminate-dead-code-aggressive --scalar-replacement --simplify-instructions
%spirvgls% FLIP_CURSOR.comp -o FLIP_CURSOR.spv
%spirvopt% FLIP_CURSOR.spv -o FLIP_CURSOR.spv
%spirvgls% FLIP_TILE_A8R8G8B8_SRGB.comp -o FLIP_TILE_A8R8G8B8_SRGB.spv
%spirvopt% FLIP_TILE_A8R8G8B8_SRGB.spv -o FLIP_TILE_A8R8G8B8_SRGB.spv
%spirvgls% FLIP_LINE_A8R8G8B8_SRGB.comp -o FLIP_LINE_A8R8G8B8_SRGB.spv
%spirvopt% FLIP_LINE_A8R8G8B8_SRGB.spv -o FLIP_LINE_A8R8G8B8_SRGB.spv
%spirvgls% FLIP_TILE_A8R8G8B8_SRGB_NEO.comp -o FLIP_TILE_A8R8G8B8_SRGB_NEO.spv
%spirvopt% FLIP_TILE_A8R8G8B8_SRGB_NEO.spv -o FLIP_TILE_A8R8G8B8_SRGB_NEO.spv
pause

184
stub_manager.pas Normal file
View File

@ -0,0 +1,184 @@
unit stub_manager;
{$mode objfpc}{$H+}
interface
uses
Windows;
type
TStubMemory=object
protected
type
PNode=^TNode;
TNode=record
pNext:PNode;
Stub_va:Pointer;
end;
Const
VA_SIZE=16*1024;
var
pHead:PNode;
Stub_va:Pointer;
Stub_pos:Word;
procedure Push(P:Pointer);
function Pop:Pointer;
public
Procedure Clear;
procedure FinStub;
function NewStub(data:Pointer;size:Word):Pointer;
end;
TStubMemoryProc=object(TStubMemory)
function NewNopStub(nid:QWORD;lib,proc:Pointer):Pointer;
end;
implementation
procedure TStubMemory.Push(P:Pointer);
var
Node:PNode;
begin
Node:=AllocMem(SizeOf(TNode));
Node^.Stub_va:=P;
if (pHead=nil) then
begin
node^.pNext:=nil;
end else
begin
node^.pNext:=pHead;
end;
pHead:=node;
end;
function TStubMemory.Pop:Pointer;
var
Node:PNode;
begin
Result:=nil;
Node:=pHead;
if (pHead<>nil) then
begin
pHead:=pHead^.pNext;
end;
if (Node<>nil) then
begin
Node^.pNext:=nil;
end;
if (Node<>nil) then
begin
Result:=Node^.Stub_va;
FreeMem(Node);
end;
end;
Procedure TStubMemory.Clear;
var
P:Pointer;
begin
P:=Pop;
While (P<>nil) do
begin
VirtualFree(P,0,MEM_RELEASE);
P:=Pop;
end;
if (Stub_va<>nil) then
begin
VirtualFree(Stub_va,0,MEM_RELEASE);
end;
Stub_va:=nil;
Stub_pos:=0;
end;
procedure TStubMemory.FinStub;
var
dummy:DWORD;
begin
if (Stub_va<>nil) then
begin
Push(Stub_va);
VirtualProtect(Stub_va,VA_SIZE,PAGE_EXECUTE_READ,@dummy);
FlushInstructionCache(GetCurrentProcess,Stub_va,VA_SIZE);
Stub_va:=nil;
Stub_pos:=0;
end;
end;
function TStubMemory.NewStub(data:Pointer;size:Word):Pointer;
begin
if ((Stub_pos+size)>VA_SIZE) then
FinStub;
if (Stub_va=nil) then
begin
Stub_va:=VirtualAlloc(nil,VA_SIZE,MEM_COMMIT or MEM_RESERVE,PAGE_READWRITE);
end;
Result:=Stub_va+Stub_pos;
Move(data^,Result^,size);
Stub_pos:=Stub_pos+size;
end;
//
//52 push %rdx
//51 push %rcx
//48ba0100000000000000 movabs $0x1,%rdx
//48b90200000000000000 movabs $0x2,%rcx
//48b80300000000000000 movabs $0x3,%rax
//ffd0 callq *%rax
//4831c0 xor %rax,%rax
//59 pop %rcx
//5a pop %rdx
//c3 retq
Type
Pnopstub=^Tnopstub;
Tnopstub=packed record
_push_rdx:Byte; // $52
_push_rcx:Byte; // $51
_movabs_rdx:array[0..1] of Byte; // $48 $ba
_lib:Pointer;
_movabs_rcx:array[0..1] of Byte; // $48 $B9
_nid:QWord;
_movabs_rax:array[0..1] of Byte; // $48 $B8
_addr:Pointer;
_call_rax:array[0..1] of Byte; // $FF $D0
_pop_rcx:Byte; // $59
_pop_rdx:Byte; // $5A
_ret:Byte; // $C3
end;
const
_nopstub:Tnopstub=(
_push_rdx:$52;
_push_rcx:$51;
_movabs_rdx:($48,$BA);
_lib:nil;
_movabs_rcx:($48,$B9);
_nid:0;
_movabs_rax:($48,$B8);
_addr:nil;
_call_rax:($FF,$D0);
_pop_rcx:$59;
_pop_rdx:$5A;
_ret:$C3
);
function TStubMemoryProc.NewNopStub(nid:QWORD;lib,proc:Pointer):Pointer;
var
nopstub:Tnopstub;
begin
nopstub:=_nopstub;
nopstub._lib:=lib;
nopstub._nid:=nid;
nopstub._addr:=proc;
Result:=NewStub(@nopstub,SizeOf(Tnopstub));
end;
end.

38766
vulkan/Vulkan.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1019
vulkan/vDevice.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1053
vulkan/vFlip.pas Normal file
View File

File diff suppressed because it is too large Load Diff

539
vulkan/vImage.pas Normal file
View File

@ -0,0 +1,539 @@
unit vImage;
{$mode objfpc}{$H+}
interface
uses
g23tree,
vulkan,
vDevice,
vPipeline,
vMemory;
type
TSwapChain=class
FSurface:TvSurface;
FSize:TVkExtent2D;
FHandle:TVkSwapchainKHR;
FImage:array of TVkImage;
FViews:array of TVkImageView;
Constructor Create(Surface:TvSurface;mode:Integer;imageUsage:TVkImageUsageFlags);
Destructor Destroy; override;
end;
TvImageView=class
FHandle:TVkImageView;
Destructor Destroy; override;
end;
TvImage=class
FHandle:TVkImage;
FFormat:TVkFormat;
FUsage:TVkFlags;
FExtent:TVkExtent3D;
Constructor Create(format:TVkFormat;extent:TVkExtent3D;usage:TVkFlags;ext:Pointer=nil);
Destructor Destroy; override;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
function GetCInfo:TVkImageCreateInfo; virtual; abstract;
function GetIVCInfo:TVkImageViewCreateInfo; virtual; abstract;
function NewView:TvImageView;
function NewViewF(Format:TVkFormat):TvImageView;
end;
TvHostImage2D=class(TvImage)
function GetCInfo:TVkImageCreateInfo; override;
end;
TvDeviceImage2D=class(TvImage)
function GetIVCInfo:TVkImageViewCreateInfo; override;
function GetCInfo:TVkImageCreateInfo; override;
end;
TvBuffer=class
FHandle:TVkBuffer;
FSize:TVkDeviceSize;
FUsage:TVkFlags;
Constructor Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
Destructor Destroy; override;
function GetRequirements:TVkMemoryRequirements;
function GetDedicatedAllocation:Boolean;
function BindMem(P:TvPointer):TVkResult;
end;
_TvImageViewCompare=object
function c(const a,b:TvImageView):Integer; static;
end;
_TvImageViewSet=specialize T23treeSet<TvImageView,_TvImageViewCompare>;
TvFramebuffer=class
FHandle:TVkFramebuffer;
FEdit,FCompile:ptruint;
FRenderPass:TvRenderPass;
FSize:TVkExtent2D;
FImages:_TvImageViewSet;
Procedure SetRenderPass(r:TvRenderPass);
Procedure SetSize(Size:TVkExtent2D);
Procedure AddImageView(v:TvImageView);
Procedure ClearImageViews;
Procedure FreeImageViews;
function IsEdit:Boolean;
function Compile:Boolean;
Destructor Destroy; override;
end;
implementation
function _TvImageViewCompare.c(const a,b:TvImageView):Integer;
begin
Result:=CompareByte(a,b,SizeOf(TvImageView));
end;
Procedure TvFramebuffer.SetRenderPass(r:TvRenderPass);
begin
if (r=FRenderPass) then Exit;
FRenderPass:=r;
Inc(FEdit);
end;
Procedure TvFramebuffer.SetSize(Size:TVkExtent2D);
begin
if CompareByte(Size,FSize,SizeOf(TVkExtent2D))=0 then Exit;
FSize:=Size;
Inc(FEdit);
end;
Procedure TvFramebuffer.AddImageView(v:TvImageView);
begin
if (v=nil) then Exit;
if FImages.Contains(v) then Exit;
FImages.Insert(v);
Inc(FEdit);
end;
Procedure TvFramebuffer.ClearImageViews;
begin
FImages.Free;
Inc(FEdit);
end;
Procedure TvFramebuffer.FreeImageViews;
var
It:_TvImageViewSet.Iterator;
begin
It:=FImages.cbegin;
if (It.Item<>nil) then
repeat
TvImageView(It.Item^).Free;
until not It.Next;
FImages.Free;
Inc(FEdit);
end;
function TvFramebuffer.IsEdit:Boolean;
begin
Result:=(FEdit<>FCompile);
end;
function TvFramebuffer.Compile:Boolean;
var
i:TVkUInt32;
It:_TvImageViewSet.Iterator;
v:TvImageView;
r:TVkResult;
info:TVkFramebufferCreateInfo;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) and (not IsEdit) then Exit(true);
if (FRenderPass=nil) then Exit;
if (FRenderPass.FHandle=VK_NULL_HANDLE) then Exit;
if (FSize.width=0) or (FSize.height=0) then Exit;
info:=Default(TVkFramebufferCreateInfo);
info.sType :=VK_STRUCTURE_TYPE_FRAMEBUFFER_CREATE_INFO;
info.renderPass :=FRenderPass.FHandle;
info.attachmentCount:=FImages.Size;
info.width :=FSize.width;
info.height:=FSize.height;
info.layers:=1;
if (info.attachmentCount<>0) then
begin
info.pAttachments:=AllocMem(info.attachmentCount*SizeOf(TVkImageView));
i:=0;
It:=FImages.cbegin;
if (It.Item<>nil) then
repeat
v:=It.Item^;
if (v<>nil) then
begin
info.pAttachments[i]:=v.FHandle;
Inc(i);
end;
until not It.Next;
info.attachmentCount:=i;
end;
if (info.attachmentCount=0) then
begin
if (info.pAttachments<>nil) then
FreeMem(info.pAttachments);
info.flags:=ord(VK_FRAMEBUFFER_CREATE_IMAGELESS_BIT);
info.pAttachments:=nil;
end;
r:=vkCreateFramebuffer(Device.FHandle,@info,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateFramebuffer');
end;
if (info.pAttachments<>nil) then
FreeMem(info.pAttachments);
Result:=(r=VK_SUCCESS);
end;
Destructor TvFramebuffer.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyFramebuffer(Device.FHandle,FHandle,nil);
inherited;
end;
Constructor TSwapChain.Create(Surface:TvSurface;mode:Integer;imageUsage:TVkImageUsageFlags);
var
queueFamilyIndices:array[0..1] of TVkUInt32;
cinfo:TVkSwapchainCreateInfoKHR;
r:TVkResult;
i,count:TVkUInt32;
cimg:TVkImageViewCreateInfo;
begin
FSurface:=Surface;
Case mode of
1,2,3:;
else
mode:=1;
end;
FSize:=Surface.GetSize;
if (FSize.width=0) or (FSize.height=0) then Exit;
cinfo:=Default(TVkSwapchainCreateInfoKHR);
cinfo.sType :=VK_STRUCTURE_TYPE_SWAPCHAIN_CREATE_INFO_KHR;
cinfo.surface :=FSurface.FHandle;
cinfo.minImageCount :=2;
cinfo.imageFormat :=FSurface.Fformat.format;
cinfo.imageColorSpace :=FSurface.Fformat.colorSpace;
cinfo.imageExtent :=FSize;
cinfo.imageArrayLayers:=1;
cinfo.imageUsage :=imageUsage or ord(VK_IMAGE_USAGE_COLOR_ATTACHMENT_BIT);
if (VulkanApp.FGFamily<>Surface.FPFamily) then
begin
queueFamilyIndices[0]:=VulkanApp.FGFamily;
queueFamilyIndices[1]:=Surface.FPFamily;
cinfo.imageSharingMode :=VK_SHARING_MODE_CONCURRENT;
cinfo.queueFamilyIndexCount :=2;
cinfo.pQueueFamilyIndices :=@queueFamilyIndices;
end else
begin
cinfo.imageSharingMode :=VK_SHARING_MODE_EXCLUSIVE;
cinfo.queueFamilyIndexCount :=0;
cinfo.pQueueFamilyIndices :=nil;
end;
cinfo.preTransform :=VK_SURFACE_TRANSFORM_IDENTITY_BIT_KHR;
cinfo.compositeAlpha:=VK_COMPOSITE_ALPHA_OPAQUE_BIT_KHR;
cinfo.presentMode :=Surface.FModes[mode-1];
cinfo.clipped :=VK_TRUE;
cinfo.oldSwapchain :=VK_NULL_HANDLE;
r:=vkCreateSwapchainKHR(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateSwapchainKHR:',r);
Exit;
end;
count:=1;
Case mode of
1,2:count:=2;
3:count:=3;
end;
SetLength(FImage,count);
SetLength(FViews,count);
r:=vkGetSwapchainImagesKHR(Device.FHandle,FHandle,@count,@FImage[0]);
if (r<>VK_SUCCESS) then
begin
Writeln('vkGetSwapchainImagesKHR:',r);
Exit;
end;
cimg:=Default(TVkImageViewCreateInfo);
cimg.sType :=VK_STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO;
cimg.viewType :=VK_IMAGE_VIEW_TYPE_2D;
cimg.format :=Surface.Fformat.format;
cimg.components.r:=VK_COMPONENT_SWIZZLE_IDENTITY;
cimg.components.g:=VK_COMPONENT_SWIZZLE_IDENTITY;
cimg.components.b:=VK_COMPONENT_SWIZZLE_IDENTITY;
cimg.components.a:=VK_COMPONENT_SWIZZLE_IDENTITY;
cimg.subresourceRange.aspectMask :=TVkImageAspectFlags(VK_IMAGE_ASPECT_COLOR_BIT);
cimg.subresourceRange.baseMipLevel :=0;
cimg.subresourceRange.levelCount :=1;
cimg.subresourceRange.baseArrayLayer:=0;
cimg.subresourceRange.layerCount :=1;
For i:=0 to count-1 do
begin
cimg.image:=FImage[i];
r:=vkCreateImageView(Device.FHandle,@cimg,nil,@FViews[i]);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImageView:',r);
Exit;
end;
end;
end;
Destructor TSwapChain.Destroy;
var
i:Integer;
begin
For i:=0 to High(FViews) do
begin
vkDestroyImageView(Device.FHandle,FViews[i],nil);
end;
vkDestroySwapchainKHR(Device.FHandle,FHandle,nil);
end;
Constructor TvImage.Create(format:TVkFormat;extent:TVkExtent3D;usage:TVkFlags;ext:Pointer=nil);
var
cinfo:TVkImageCreateInfo;
r:TVkResult;
begin
FFormat:=format;
FUsage:=usage;
FExtent:=extent;
cinfo:=GetCInfo;
cinfo.format:=format;
cinfo.extent:=extent;
cinfo.usage :=usage;
cinfo.pNext:=ext;
r:=vkCreateImage(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImage:',r);
Exit;
end;
end;
Destructor TvImage.Destroy;
begin
vkDestroyImage(Device.FHandle,FHandle,nil);
end;
function TvImage.GetRequirements:TVkMemoryRequirements;
begin
Result:=Default(TVkMemoryRequirements);
vkGetImageMemoryRequirements(Device.FHandle,FHandle,@Result);
end;
function TvImage.GetDedicatedAllocation:Boolean;
var
info:TVkImageMemoryRequirementsInfo2;
rmem:TVkMemoryRequirements2;
rded:TVkMemoryDedicatedRequirements;
begin
Result:=false;
if Pointer(vkGetImageMemoryRequirements2)=nil then Exit;
info:=Default(TVkImageMemoryRequirementsInfo2);
info.sType:=VK_STRUCTURE_TYPE_IMAGE_MEMORY_REQUIREMENTS_INFO_2;
info.image:=FHandle;
rmem:=Default(TVkMemoryRequirements2);
rmem.sType:=VK_STRUCTURE_TYPE_MEMORY_REQUIREMENTS_2;
rded:=Default(TVkMemoryDedicatedRequirements);
rded.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS;
rmem.pNext:=@rded;
vkGetImageMemoryRequirements2(Device.FHandle,@info,@rmem);
Result:=(rded.requiresDedicatedAllocation<>VK_FALSE) or
(rded.prefersDedicatedAllocation <>VK_FALSE);
end;
function TvImage.BindMem(P:TvPointer):TVkResult;
begin
Result:=vkBindImageMemory(Device.FHandle,FHandle,P.FHandle,P.FOffset);
end;
function TvImage.NewView:TvImageView;
var
cinfo:TVkImageViewCreateInfo;
FImg:TVkImageView;
r:TVkResult;
begin
Result:=nil;
cinfo:=GetIVCInfo;
cinfo.image:=FHandle;
FImg:=VK_NULL_HANDLE;
r:=vkCreateImageView(Device.FHandle,@cinfo,nil,@FImg);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImageView:',r);
Exit;
end;
Result:=TvImageView.Create;
Result.FHandle:=FImg;
end;
function TvImage.NewViewF(Format:TVkFormat):TvImageView;
var
cinfo:TVkImageViewCreateInfo;
FImg:TVkImageView;
r:TVkResult;
begin
Result:=nil;
cinfo:=GetIVCInfo;
cinfo.image :=FHandle;
cinfo.format:=Format;
FImg:=VK_NULL_HANDLE;
r:=vkCreateImageView(Device.FHandle,@cinfo,nil,@FImg);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateImageView:',r);
Exit;
end;
Result:=TvImageView.Create;
Result.FHandle:=FImg;
end;
Destructor TvImageView.Destroy;
begin
vkDestroyImageView(Device.FHandle,FHandle,nil);
end;
function TvHostImage2D.GetCInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_2D;
Result.arrayLayers :=1;
Result.mipLevels :=1;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
Result.samples :=VK_SAMPLE_COUNT_1_BIT;
Result.tiling :=VK_IMAGE_TILING_LINEAR;
end;
//
function TvDeviceImage2D.GetCInfo:TVkImageCreateInfo;
begin
Result:=Default(TVkImageCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_CREATE_INFO;
Result.imageType :=VK_IMAGE_TYPE_2D;
Result.arrayLayers :=1;
Result.mipLevels :=1;
Result.initialLayout:=VK_IMAGE_LAYOUT_UNDEFINED;
Result.samples :=VK_SAMPLE_COUNT_1_BIT;
Result.tiling :=VK_IMAGE_TILING_OPTIMAL;
end;
function TvDeviceImage2D.GetIVCInfo:TVkImageViewCreateInfo;
begin
Result:=Default(TVkImageViewCreateInfo);
Result.sType :=VK_STRUCTURE_TYPE_IMAGE_VIEW_CREATE_INFO;
Result.viewType :=VK_IMAGE_VIEW_TYPE_2D;
Result.format :=FFormat;
Result.components.r:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.g:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.b:=VK_COMPONENT_SWIZZLE_IDENTITY;
Result.components.a:=VK_COMPONENT_SWIZZLE_IDENTITY;
Case FFormat of
VK_FORMAT_S8_UINT:
Result.subresourceRange.aspectMask :=ord(VK_IMAGE_ASPECT_STENCIL_BIT);
VK_FORMAT_D16_UNORM,
VK_FORMAT_X8_D24_UNORM_PACK32,
VK_FORMAT_D32_SFLOAT:
Result.subresourceRange.aspectMask :=ord(VK_IMAGE_ASPECT_DEPTH_BIT);
VK_FORMAT_D16_UNORM_S8_UINT,
VK_FORMAT_D24_UNORM_S8_UINT,
VK_FORMAT_D32_SFLOAT_S8_UINT:
Result.subresourceRange.aspectMask :=ord(VK_IMAGE_ASPECT_DEPTH_BIT) or ord(VK_IMAGE_ASPECT_STENCIL_BIT);
else
Result.subresourceRange.aspectMask :=ord(VK_IMAGE_ASPECT_COLOR_BIT);
end;
Result.subresourceRange.baseMipLevel :=0;
Result.subresourceRange.levelCount :=1;
Result.subresourceRange.baseArrayLayer:=0;
Result.subresourceRange.layerCount :=1;
end;
Constructor TvBuffer.Create(size:TVkDeviceSize;usage:TVkFlags;ext:Pointer=nil);
var
cinfo:TVkBufferCreateInfo;
r:TVkResult;
begin
FSize:=size;
FUsage:=usage;
cinfo:=Default(TVkBufferCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_BUFFER_CREATE_INFO;
cinfo.size :=size;
cinfo.usage:=usage;
cinfo.sharingMode:=VK_SHARING_MODE_EXCLUSIVE;
cinfo.pNext:=ext;
r:=vkCreateBuffer(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateBuffer:',r);
Exit;
end;
end;
Destructor TvBuffer.Destroy;
begin
vkDestroyBuffer(Device.FHandle,FHandle,nil);
end;
function TvBuffer.GetRequirements:TVkMemoryRequirements;
begin
Result:=Default(TVkMemoryRequirements);
vkGetBufferMemoryRequirements(Device.FHandle,FHandle,@Result);
end;
function TvBuffer.GetDedicatedAllocation:Boolean;
var
info:TVkBufferMemoryRequirementsInfo2;
rmem:TVkMemoryRequirements2;
rded:TVkMemoryDedicatedRequirements;
begin
Result:=false;
if Pointer(vkGetImageMemoryRequirements2)=nil then Exit;
info:=Default(TVkBufferMemoryRequirementsInfo2);
info.sType:=VK_STRUCTURE_TYPE_BUFFER_MEMORY_REQUIREMENTS_INFO_2;
info.buffer:=FHandle;
rmem:=Default(TVkMemoryRequirements2);
rmem.sType:=VK_STRUCTURE_TYPE_MEMORY_REQUIREMENTS_2;
rded:=Default(TVkMemoryDedicatedRequirements);
rded.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_REQUIREMENTS;
rmem.pNext:=@rded;
vkGetBufferMemoryRequirements2(Device.FHandle,@info,@rmem);
Result:=(rded.requiresDedicatedAllocation<>VK_FALSE) or
(rded.prefersDedicatedAllocation <>VK_FALSE);
end;
function TvBuffer.BindMem(P:TvPointer):TVkResult;
begin
Result:=vkBindBufferMemory(Device.FHandle,FHandle,P.FHandle,P.FOffset);
end;
end.

593
vulkan/vMemory.pas Normal file
View File

@ -0,0 +1,593 @@
unit vMemory;
{$mode objfpc}{$H+}
interface
uses
bittype,
g23tree,
vulkan,
vDevice;
type
TvPointer=packed record
FHandle:TVkDeviceMemory;
FOffset:TVkDeviceSize;
end;
Const
GRANULAR_DEV_BLOCK_SIZE=128*1024*1024;
type
TDevNode=packed record
FSize :TVkDeviceSize;
FOffset :TVkDeviceSize;
FBlockId:Word;
FmType :Byte;
Fisfree :Boolean;
end;
TDevBlock=object
FHandle:TVkDeviceMemory;
nSize :TVkDeviceSize;
mType :Byte;
end;
//free: [FmType]|[FSize]|[FBlockId]
//alloc: [FBlockId]|[FOffset]
TFreeCompare=object
function c(const a,b:TDevNode):Integer; static;
end;
TAllcCompare=object
function c(const a,b:TDevNode):Integer; static;
end;
TFreeDevNodeSet=specialize T23treeSet<TDevNode,TFreeCompare>;
TAllcDevNodeSet=specialize T23treeSet<TDevNode,TAllcCompare>;
TvMemManager=class
FProperties:TVkPhysicalDeviceMemoryProperties;
FHostVisibMt:TVkUInt32;
FHostCacheMt:TVkUInt32;
lock:Pointer;
FDevBlocks:array of TDevBlock;
FFreeSet:TFreeDevNodeSet;
FAllcSet:TAllcDevNodeSet;
Constructor Create;
function findMemoryType(Filter:TVkUInt32;prop:TVkMemoryPropertyFlags):Integer;
procedure PrintMemoryType(typeFilter:TVkUInt32);
Function _AllcDevBlock(Size:TVkDeviceSize;mtindex:Byte;Var R:Word):Boolean;
Function _FreeDevBlock(i:Word):Boolean;
Function _FindDevBlock(FHandle:TVkDeviceMemory;Var R:Word):Boolean;
Function _FetchFree_a(Size,Align:TVkDeviceSize;mtindex:Byte;var R:TDevNode):Boolean;
Function _FetchFree_l(key:TDevNode;var R:TDevNode):Boolean;
Function _FetchFree_b(key:TDevNode;var R:TDevNode):Boolean;
Function _FetchAllc(FOffset:TVkDeviceSize;FBlockId:Word;var R:TDevNode):Boolean;
Function Alloc(const mr:TVkMemoryRequirements;pr:TVkMemoryPropertyFlags):TvPointer;
Function Alloc(Size,Align:TVkDeviceSize;mtindex:Byte):TvPointer;
Function Free(P:TvPointer):Boolean;
end;
var
MemManager:TvMemManager;
function vkAllocMemory(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32):TVkDeviceMemory;
function vkAllocHostPointer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;adr:Pointer):TVkDeviceMemory;
function vkAllocDedicatedImage(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkImage):TVkDeviceMemory;
function vkAllocDedicatedBuffer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkBuffer):TVkDeviceMemory;
Function TryGetHostPointerByAddr(addr:Pointer;var P:TvPointer):Boolean;
implementation
uses
spinlock,
ps4_map_mm;
//free: [FmType]|[FSize]|[FBlockId]
function TFreeCompare.c(const a,b:TDevNode):Integer;
begin
if (a.FmType=b.FmType) then
begin
if (a.FSize=b.FSize) then
begin
if (a.FBlockId=b.FBlockId) then
Result:=0
else
if (a.FBlockId<b.FBlockId) then
Result:=-1
else
Result:=1;
end else
if (a.FSize<b.FSize) then
Result:=-1
else
Result:=1;
end else
if (a.FmType<b.FmType) then
Result:=-1
else
Result:=1;
end;
//alloc: [FBlockId]|[FOffset]
function TAllcCompare.c(const a,b:TDevNode):Integer;
begin
if (a.FBlockId=b.FBlockId) then
begin
if (a.FOffset=b.FOffset) then
Result:=0
else
if (a.FOffset<b.FOffset) then
Result:=-1
else
Result:=1;
end else
if (a.FBlockId<b.FBlockId) then
Result:=-1
else
Result:=1;
end;
Constructor TvMemManager.Create;
begin
FProperties:=Default(TVkPhysicalDeviceMemoryProperties);
vkGetPhysicalDeviceMemoryProperties(VulkanApp.FPhysicalDevice,@FProperties);
FHostVisibMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_COHERENT_BIT));
if (FHostVisibMt=DWORD(-1)) then
begin
FHostVisibMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT));
end;
FHostCacheMt:=findMemoryType($FFFFFFFF,
ord(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT) or
ord(VK_MEMORY_PROPERTY_HOST_CACHED_BIT));
if (FHostCacheMt=DWORD(-1)) then
begin
FHostCacheMt:=FHostVisibMt;
end;
end;
function TvMemManager.findMemoryType(Filter:TVkUInt32;prop:TVkMemoryPropertyFlags):Integer;
var
i:TVkUInt32;
begin
Result:=-1;
For i:=0 to FProperties.memoryTypeCount-1 do
begin
if ((Filter and (1 shl i))<>0) and ((FProperties.memoryTypes[i].propertyFlags and prop)=prop) then
begin
Exit(i);
end;
end;
end;
procedure TvMemManager.PrintMemoryType(typeFilter:TVkUInt32);
var
i:TVkUInt32;
begin
For i:=0 to FProperties.memoryTypeCount-1 do
begin
if ((typeFilter and (1 shl i))<>0) then
begin
Write(i,':',HexStr(FProperties.memoryTypes[i].propertyFlags,8));
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT))<>0 then
Write(' DEVICE_LOCAL');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_HOST_VISIBLE_BIT))<>0 then
Write(' HOST_VISIBLE');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_HOST_COHERENT_BIT))<>0 then
Write(' HOST_COHERENT');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_HOST_CACHED_BIT))<>0 then
Write(' HOST_CACHED');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_LAZILY_ALLOCATED_BIT))<>0 then
Write(' LAZILY_ALLOCATED');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_PROTECTED_BIT))<>0 then
Write(' PROTECTED');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_DEVICE_COHERENT_BIT_AMD))<>0 then
Write(' DEVICE_COHERENT_AMD');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_DEVICE_UNCACHED_BIT_AMD))<>0 then
Write(' DEVICE_UNCACHED_AMD');
if (FProperties.memoryTypes[i].propertyFlags and
TVkUInt32(VK_MEMORY_PROPERTY_RDMA_CAPABLE_BIT_NV))<>0 then
Write(' RDMA_CAPABLE_NV');
Writeln;
end;
end;
end;
Function TvMemManager._AllcDevBlock(Size:TVkDeviceSize;mtindex:Byte;Var R:Word):Boolean;
var
FHandle:TVkDeviceMemory;
i:Word;
begin
Result:=False;
FHandle:=vkAllocMemory(Device.FHandle,Size,mtindex);
if (FHandle=VK_NULL_HANDLE) then Exit;
if Length(FDevBlocks)<>0 then
For i:=0 to High(FDevBlocks) do
if (FDevBlocks[i].FHandle=VK_NULL_HANDLE) then
begin
FDevBlocks[i].FHandle:=FHandle;
FDevBlocks[i].nSize :=Size;
FDevBlocks[i].mType :=mtindex;
R:=i;
Exit(True);
end;
i:=Length(FDevBlocks);
SetLength(FDevBlocks,i+1);
FDevBlocks[i].FHandle:=FHandle;
FDevBlocks[i].nSize :=Size;
FDevBlocks[i].mType :=mtindex;
R:=i;
Result:=True;
end;
Function TvMemManager._FreeDevBlock(i:Word):Boolean;
var
c:Word;
begin
Result:=False;
if (i>=Length(FDevBlocks)) then Exit;
if (FDevBlocks[i].FHandle=VK_NULL_HANDLE) then Exit;
vkFreeMemory(Device.FHandle,FDevBlocks[i].FHandle,nil);
FDevBlocks[i].FHandle:=VK_NULL_HANDLE;
FDevBlocks[i].nSize :=0;
FDevBlocks[i].mType :=0;
Result:=True;
//shrink
c:=Length(FDevBlocks);
While (c<>0) do
if (FDevBlocks[c-1].FHandle=VK_NULL_HANDLE) then
Dec(c);
SetLength(FDevBlocks,c);
end;
Function TvMemManager._FindDevBlock(FHandle:TVkDeviceMemory;Var R:Word):Boolean;
var
i:Word;
begin
Result:=False;
if Length(FDevBlocks)<>0 then
For i:=0 to High(FDevBlocks) do
if (FDevBlocks[i].FHandle=FHandle) then
begin
R:=i;
Exit(True);
end;
end;
//free: [FmType]|[FSize]|[FBlockId]
Function TvMemManager._FetchFree_a(Size,Align:TVkDeviceSize;mtindex:Byte;var R:TDevNode):Boolean;
var
It:TFreeDevNodeSet.Iterator;
key:TDevNode;
Offset:TVkDeviceSize;
begin
Result:=false;
key:=Default(TDevNode);
key.FmType:=mtindex;
key.FSize:=Size;
It:=FFreeSet.find_be(key);
if (It.Item=nil) then Exit;
repeat
key:=It.Item^;
if (key.FmType<>mtindex) then Exit;
Offset:=System.Align(key.FOffset,Align);
if (Offset+Size)<=(key.FOffset+key.FSize) then
begin
R:=key;
FAllcSet.delete(key);
FFreeSet.erase(It);
Exit(True);
end;
until not It.Next;
end;
//alloc: [FBlockId]|[FOffset]
Function TvMemManager._FetchFree_l(key:TDevNode;var R:TDevNode):Boolean;
var
It:TFreeDevNodeSet.Iterator;
key2:TDevNode;
begin
Result:=false;
It:=FAllcSet.find_le(key);
if (It.Item=nil) then Exit;
key2:=It.Item^;
if (key2.FBlockId<>key.FBlockId) or
(key2.FmType <>key.FmType) or
(not key2.Fisfree) then Exit;
R:=key2;
FAllcSet.erase(It);
FFreeSet.delete(key2);
Result:=True;
end;
//alloc: [FBlockId]|[FOffset]
Function TvMemManager._FetchFree_b(key:TDevNode;var R:TDevNode):Boolean;
var
It:TFreeDevNodeSet.Iterator;
key2:TDevNode;
begin
Result:=false;
It:=FAllcSet.find_be(key);
if (It.Item=nil) then Exit;
key2:=It.Item^;
if (key2.FBlockId<>key.FBlockId) or
(key2.FmType <>key.FmType) or
(not key2.Fisfree) then Exit;
R:=key2;
FAllcSet.erase(It);
FFreeSet.delete(key2);
Result:=True;
end;
//alloc: [FBlockId]|[FOffset]
Function TvMemManager._FetchAllc(FOffset:TVkDeviceSize;FBlockId:Word;var R:TDevNode):Boolean;
var
It:TAllcDevNodeSet.Iterator;
key:TDevNode;
begin
Result:=False;
key:=Default(TDevNode);
key.FOffset :=FOffset;
key.FBlockId:=FBlockId;
It:=FAllcSet.find(key);
if (It.Item=nil) then Exit;
key:=It.Item^;
if key.Fisfree then Exit;
R:=key;
FAllcSet.erase(It);
Result:=True;
end;
//GRANULAR_DEV_BLOCK_SIZE
Function TvMemManager.Alloc(const mr:TVkMemoryRequirements;pr:TVkMemoryPropertyFlags):TvPointer;
var
mt:Integer;
begin
mt:=findMemoryType(mr.memoryTypeBits,pr);
if (mt=-1) then Exit(Default(TvPointer));
Result:=Alloc(mr.size,mr.alignment,mt);
end;
Function TvMemManager.Alloc(Size,Align:TVkDeviceSize;mtindex:Byte):TvPointer;
var
key:TDevNode;
Offset:TVkDeviceSize;
FSize:TVkDeviceSize;
FEndN,FEndO:TVkDeviceSize;
begin
Result:=Default(TvPointer);
if (Size=0) then Exit;
key:=Default(TDevNode);
Size:=System.Align(Size,8);
if (Align>GRANULAR_DEV_BLOCK_SIZE) then Align:=GRANULAR_DEV_BLOCK_SIZE;
spin_lock(lock);
if _FetchFree_a(Size,Align,mtindex,key) then
begin
Offset:=System.Align(key.FOffset,Align);
FSize:=key.FSize;
if (Offset<>key.FOffset) then //prev free save
begin
key.FSize:=Offset-key.FOffset;
FFreeSet.Insert(key);
FAllcSet.Insert(key);
end;
FEndN:=Offset+Size;
FEndO:=key.FOffset+FSize;
if (FEndN<>FEndO) then //next free save
begin
key.FOffset:=FEndN;
key.FSize :=FEndO-FEndN;
FFreeSet.Insert(key);
FAllcSet.Insert(key);
end;
//alloc save
key.Fisfree:=False;
key.FOffset:=Offset;
key.FSize :=Size;
FAllcSet.Insert(key);
Result.FHandle:=FDevBlocks[key.FBlockId].FHandle;
Result.FOffset:=key.FOffset;
end else
if _AllcDevBlock(System.Align(Size,GRANULAR_DEV_BLOCK_SIZE),mtindex,key.FBlockId) then
begin
//alloc save
key.Fisfree:=False;
key.FSize :=Size;
key.FOffset:=0;
key.FmType :=mtindex;
FAllcSet.Insert(key);
Result.FHandle:=FDevBlocks[key.FBlockId].FHandle;
Result.FOffset:=0;
//next free save
FSize:=FDevBlocks[key.FBlockId].nSize;
if (Size<>FSize) then
begin
key.Fisfree:=True;
key.FOffset:=Size;
key.FSize :=FSize-Size;
FFreeSet.Insert(key);
FAllcSet.Insert(key);
end;
end;
spin_unlock(lock);
end;
Function TvMemManager.Free(P:TvPointer):Boolean;
var
key,key2:TDevNode;
begin
if (P.FHandle=VK_NULL_HANDLE) then Exit;
key:=Default(TDevNode);
spin_lock(lock);
if _FindDevBlock(P.FHandle,key.FBlockId) then
if _FetchAllc(P.FOffset,key.FBlockId,key) then
begin
//prev union
repeat
if (key.FOffset=0) then Break;
key2:=key;
key2.FOffset:=key2.FOffset-1;
if not _FetchFree_l(key2,key2) then Break;
Assert((key2.FOffset+key2.FSize)=key.FOffset);
key.FSize :=key.FSize+(key.FOffset-key2.FOffset);
key.FOffset:=key2.FOffset;
until false;
//next union
repeat
key2:=key;
key2.FOffset:=key2.FOffset+key2.FSize;
if not _FetchFree_b(key2,key2) then Break;
Assert((key.FOffset+key.FSize)=key2.FOffset);
key.FSize :=key.FSize+key2.FSize;
until false;
//
if (key.FOffset=0) and (key.FSize>=FDevBlocks[key.FBlockId].nSize) then
begin
//free block
_FreeDevBlock(key.FBlockId);
end else
begin
//add free
key.Fisfree:=True;
FFreeSet.Insert(key);
FAllcSet.Insert(key);
end;
Result:=True;
end;
spin_unlock(lock);
end;
function vkAllocMemory(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
ainfo.allocationSize :=Size;
ainfo.memoryTypeIndex:=mtindex;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
end;
function vkAllocHostPointer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;adr:Pointer):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
import:TVkImportMemoryHostPointerInfoEXT;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
ainfo.allocationSize :=Size;
ainfo.memoryTypeIndex:=mtindex;
ainfo.pNext:=@import;
import:=Default(TVkImportMemoryHostPointerInfoEXT);
import.sType:=VK_STRUCTURE_TYPE_IMPORT_MEMORY_HOST_POINTER_INFO_EXT;
import.handleType:=VK_EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT;
import.pHostPointer:=adr;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
end;
function vkAllocDedicatedImage(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkImage):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
dinfo:TVkMemoryDedicatedAllocateInfo;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
ainfo.allocationSize :=Size;
ainfo.memoryTypeIndex:=mtindex;
ainfo.pNext:=@dinfo;
dinfo:=Default(TVkMemoryDedicatedAllocateInfo);
dinfo.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_ALLOCATE_INFO;
dinfo.image:=FHandle;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
end;
function vkAllocDedicatedBuffer(device:TVkDevice;Size:TVkDeviceSize;mtindex:TVkUInt32;FHandle:TVkBuffer):TVkDeviceMemory;
var
ainfo:TVkMemoryAllocateInfo;
dinfo:TVkMemoryDedicatedAllocateInfo;
begin
ainfo:=Default(TVkMemoryAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_MEMORY_ALLOCATE_INFO;
ainfo.allocationSize :=Size;
ainfo.memoryTypeIndex:=mtindex;
ainfo.pNext:=@dinfo;
dinfo:=Default(TVkMemoryDedicatedAllocateInfo);
dinfo.sType:=VK_STRUCTURE_TYPE_MEMORY_DEDICATED_ALLOCATE_INFO;
dinfo.buffer:=FHandle;
Result:=VK_NULL_HANDLE;
vkAllocateMemory(device,@ainfo,nil,@Result);
end;
function OnGpuMemAlloc(addr:Pointer;len:size_t):TVkDeviceMemory;
begin
InitVulkan;
Result:=vkAllocHostPointer(Device.FHandle,len,MemManager.FHostCacheMt,addr);
Assert(Result<>VK_NULL_HANDLE);
end;
procedure OnGpuMemFree(h:TVkDeviceMemory);
begin
if (h=VK_NULL_HANDLE) then Exit;
if not IsInitVulkan then Exit;
vkFreeMemory(Device.FHandle,h,nil);
end;
Function TryGetHostPointerByAddr(addr:Pointer;var P:TvPointer):Boolean;
var
block:TGpuMemBlock;
begin
Result:=False;
if TryGetGpuMemBlockByAddr(addr,block) then
begin
P.FHandle:=TVkDeviceMemory(block.Handle);
P.FOffset:=addr-block.pAddr;
Result:=True;
end;
end;
initialization
GpuMemCb.Alloc:=TGpuMemAlloc(@OnGpuMemAlloc);
GpuMemCb.Free :=TGpuMemFree (@OnGpuMemFree);
end.

717
vulkan/vPipeline.pas Normal file
View File

@ -0,0 +1,717 @@
unit vPipeline;
{$mode objfpc}{$H+}
interface
uses
g23tree,
vulkan,vDevice,vShader;
type
TvSetLayout=class
FHandle:TVkDescriptorSetLayout;
FEdit,FCompile:ptruint;
FBinds:array of TVkDescriptorSetLayoutBinding;
Destructor Destroy; override;
Procedure Add(aBind:TVkUInt32;dType:TVkDescriptorType;Flags:TVkShaderStageFlags;count:TVkUInt32=1);
procedure Clear;
function Compile:Boolean;
function IsEdit:Boolean;
end;
TvPipelineLayout=class
FHandle:TVkPipelineLayout;
FEdit,FCompile:ptruint;
FLayouts:array of TvSetLayout;
FPushConsts:array of TVkPushConstantRange;
Destructor Destroy; override;
Procedure Add(F:TvSetLayout);
Procedure AddPushConst(offset,size:TVkUInt32;Flags:TVkShaderStageFlags);
procedure Clear;
function Compile:Boolean;
function IsEdit:Boolean;
end;
TvPipeline=class
FHandle:TVkPipeline;
FEdit,FCompile:ptruint;
Destructor Destroy; override;
end;
TvRenderPass=class
FHandle:TVkRenderPass;
Destructor Destroy; override;
end;
TvComputePipeline=class(TvPipeline)
FLayout:TvPipelineLayout;
FComputeShader:TvShader;
procedure SetLayout(Layout:TvPipelineLayout);
Procedure SetShader(Shader:TvShader);
function Compile:Boolean;
function IsEdit:Boolean;
end;
TvSetsPool=class;
TvDescriptorSet=class
FParent:TvSetsPool;
FLayout:TvSetLayout;
FHandle:TVkDescriptorSet;
procedure _AllocDesc;
procedure _FreeDesc;
Destructor Destroy; override;
Procedure BindUB (aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSB (aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindUBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
Procedure BindSTI(aBind,aElem:TVkUInt32;const img:TVkImageView);
end;
_TvSetLayoutKey=object
Layout:TvSetLayout;
fcount:TVkUInt32;
function c(const a,b:_TvSetLayoutKey):Integer; static;
end;
_TvSetLayoutSet=specialize T23treeSet<_TvSetLayoutKey,_TvSetLayoutKey>;
_TvDescriptorSetCompare=object
function c(const a,b:TvDescriptorSet):Integer; static;
end;
_TvDescriptorSetSet=specialize T23treeSet<TvDescriptorSet,_TvDescriptorSetCompare>;
TvSetsPool=class
FHandle:TVkDescriptorPool;
FEdit,FCompile:ptruint;
FmaxSets:TVkUInt32;
FLayouts:_TvSetLayoutSet;
FSets:_TvDescriptorSetSet;
Destructor Destroy; override;
function _FindLayout(L:TvSetLayout):Boolean;
procedure ClearLayouts;
Procedure AddLayout(L:TvSetLayout;count:TVkUInt32=1);
Procedure AddFormPipelineLayout(L:TvPipelineLayout;count:TVkUInt32=1);
function Alloc(L:TvSetLayout):TvDescriptorSet;
function Compile:Boolean;
function IsEdit:Boolean;
end;
implementation
function _TvSetLayoutKey.c(const a,b:_TvSetLayoutKey):Integer;
begin
Result:=CompareByte(a.Layout,b.Layout,SizeOf(TvSetLayout));
end;
function _TvDescriptorSetCompare.c(const a,b:TvDescriptorSet):Integer;
begin
Result:=CompareByte(a,b,SizeOf(TvDescriptorSet));
end;
Procedure TvSetLayout.Add(aBind:TVkUInt32;dType:TVkDescriptorType;Flags:TVkShaderStageFlags;count:TVkUInt32=1);
var
i:Integer;
begin
i:=Length(FBinds);
SetLength(FBinds,i+1);
FBinds[i]:=Default(TVkDescriptorSetLayoutBinding);
FBinds[i].binding:=aBind;
FBinds[i].descriptorType:=dType;
FBinds[i].descriptorCount:=count;
FBinds[i].stageFlags:=Flags;
Inc(FEdit);
end;
Procedure TvSetLayout.Clear;
begin
SetLength(FBinds,0);
Inc(FEdit);
end;
function TvSetLayout.Compile:Boolean;
var
cinfo:TVkDescriptorSetLayoutCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) then
begin
if (FEdit=FCompile) then Exit(true);
vkDestroyDescriptorSetLayout(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
cinfo:=Default(TVkDescriptorSetLayoutCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_LAYOUT_CREATE_INFO;
cinfo.bindingCount:=Length(FBinds);
if (cinfo.bindingCount<>0) then
begin
cinfo.pBindings:=@FBinds[0];
end;
r:=vkCreateDescriptorSetLayout(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateDescriptorSetLayout:',r);
Exit;
end;
FCompile:=FEdit;
Result:=True;
end;
Destructor TvSetLayout.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyDescriptorSetLayout(Device.FHandle,FHandle,nil);
end;
function TvSetLayout.IsEdit:Boolean;
begin
Result:=FEdit<>FCompile;
end;
Destructor TvPipelineLayout.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyPipelineLayout(Device.FHandle,FHandle,nil);
end;
Procedure TvPipelineLayout.Add(F:TvSetLayout);
var
i:Integer;
begin
if (F=nil) then Exit;
i:=Length(FLayouts);
SetLength(FLayouts,i+1);
FLayouts[i]:=F;
Inc(FEdit);
end;
Procedure TvPipelineLayout.AddPushConst(offset,size:TVkUInt32;Flags:TVkShaderStageFlags);
var
i:Integer;
begin
i:=Length(FPushConsts);
SetLength(FPushConsts,i+1);
FPushConsts[i].stageFlags:=Flags;
FPushConsts[i].offset :=offset;
FPushConsts[i].size :=size;
Inc(FEdit);
end;
procedure TvPipelineLayout.Clear;
begin
SetLength(FLayouts,0);
SetLength(FPushConsts,0);
Inc(FEdit);
end;
function TvPipelineLayout.Compile:Boolean;
var
cinfo:TVkPipelineLayoutCreateInfo;
r:TVkResult;
_data_set:array of TVkDescriptorSetLayout;
i:Integer;
begin
Result:=false;
if (FHandle<>VK_NULL_HANDLE) then
begin
if (not IsEdit) then Exit(true);
vkDestroyPipelineLayout(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
if (Length(FLayouts)<>0) then
begin
_data_set:=nil;
SetLength(_data_set,Length(FLayouts));
For i:=0 to High(FLayouts) do
begin
if not FLayouts[i].Compile then Exit;
_data_set[i]:=FLayouts[i].FHandle;
end;
end;
cinfo:=Default(TVkPipelineLayoutCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_PIPELINE_LAYOUT_CREATE_INFO;
cinfo.setLayoutCount:=Length(_data_set);
if (cinfo.setLayoutCount<>0) then
begin
cinfo.pSetLayouts:=@_data_set[0];
end;
cinfo.pushConstantRangeCount:=Length(FPushConsts);
if (cinfo.pushConstantRangeCount<>0) then
begin
cinfo.pPushConstantRanges:=@FPushConsts[0];
end;
r:=vkCreatePipelineLayout(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreatePipelineLayout:',r);
Exit;
end;
FCompile:=FEdit;
Result:=True;
end;
function TvPipelineLayout.IsEdit:Boolean;
var
i:Integer;
begin
Result:=FEdit<>FCompile;
if not Result then
if (Length(FLayouts)<>0) then
For i:=0 to High(FLayouts) do
if FLayouts[i].IsEdit then Exit(true);
end;
Destructor TvPipeline.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyPipeline(Device.FHandle,FHandle,nil);
end;
Destructor TvRenderPass.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyRenderPass(Device.FHandle,FHandle,nil);
end;
procedure TvComputePipeline.SetLayout(Layout:TvPipelineLayout);
begin
if (FLayout<>Layout) then
begin
Inc(FEdit);
FLayout:=Layout;
Compile;
end;
end;
Procedure TvComputePipeline.SetShader(Shader:TvShader);
begin
if (FComputeShader<>Shader) then
begin
Inc(FEdit);
if (Shader=nil) then
begin
FComputeShader:=nil;
end else
if (Shader.FStage=VK_SHADER_STAGE_COMPUTE_BIT) then
begin
FComputeShader:=Shader;
Compile;
end;
end;
end;
function TvComputePipeline.Compile:Boolean;
var
cinfo:TVkComputePipelineCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FLayout=nil) or (FComputeShader=nil) then Exit;
if (FHandle<>VK_NULL_HANDLE) then
begin
if (not IsEdit) then Exit(true);
vkDestroyPipeline(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
if not FLayout.Compile then Exit;
cinfo:=Default(TVkComputePipelineCreateInfo);
cinfo.sType:=VK_STRUCTURE_TYPE_COMPUTE_PIPELINE_CREATE_INFO;
cinfo.stage.sType:=VK_STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO;
cinfo.stage.stage:=VK_SHADER_STAGE_COMPUTE_BIT;
cinfo.stage.module:=FComputeShader.FHandle;
cinfo.stage.pName:=PChar(FComputeShader.FEntry);
cinfo.layout:=FLayout.FHandle;
r:=vkCreateComputePipelines(Device.FHandle,VK_NULL_HANDLE,1,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateComputePipelines:',r);
Exit;
end;
FCompile:=FEdit;
Result:=True;
end;
function TvComputePipeline.IsEdit:Boolean;
begin
Result:=(FEdit<>FCompile);
if (not Result) and (FLayout<>nil) then
Result:=Result or FLayout.IsEdit;
end;
Destructor TvSetsPool.Destroy;
var
It:_TvDescriptorSetSet.Iterator;
begin
It:=FSets.cbegin;
if (It.Item<>nil) then
repeat
It.Item^.FHandle:=VK_NULL_HANDLE;
until not It.Next;
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyDescriptorPool(Device.FHandle,FHandle,nil);
FSets.Free;
FLayouts.Free;
end;
function _GetTypeById(i:Byte):TVkDescriptorType;
begin
Result:=VK_DESCRIPTOR_TYPE_SAMPLER;
Case i of
0:Result:=VK_DESCRIPTOR_TYPE_SAMPLER ;
1:Result:=VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER ;
2:Result:=VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE ;
3:Result:=VK_DESCRIPTOR_TYPE_STORAGE_IMAGE ;
4:Result:=VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER ;
5:Result:=VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER ;
6:Result:=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER ;
7:Result:=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER ;
8:Result:=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC ;
9:Result:=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC ;
10:Result:=VK_DESCRIPTOR_TYPE_INPUT_ATTACHMENT ;
11:Result:=VK_DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK_EXT ;
12:Result:=VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR;
13:Result:=VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV ;
14:Result:=VK_DESCRIPTOR_TYPE_MUTABLE_VALVE ;
end;
end;
function _GetIdByType(i:TVkDescriptorType):Byte;
begin
Result:=0;
Case i of
VK_DESCRIPTOR_TYPE_SAMPLER :Result:=0;
VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER :Result:=1;
VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE :Result:=2;
VK_DESCRIPTOR_TYPE_STORAGE_IMAGE :Result:=3;
VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER :Result:=4;
VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER :Result:=5;
VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER :Result:=6;
VK_DESCRIPTOR_TYPE_STORAGE_BUFFER :Result:=7;
VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC :Result:=8;
VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC :Result:=9;
VK_DESCRIPTOR_TYPE_INPUT_ATTACHMENT :Result:=10;
VK_DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK_EXT :Result:=11;
VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR:Result:=12;
VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV :Result:=13;
VK_DESCRIPTOR_TYPE_MUTABLE_VALVE :Result:=14;
end;
end;
function TvSetsPool.Compile:Boolean;
var
i,b,L:Integer;
It:_TvSetLayoutSet.Iterator;
Ik:_TvSetLayoutKey;
Id:_TvDescriptorSetSet.Iterator;
FCounts:array[0..14] of TVkUInt32;
FSize:array of TVkDescriptorPoolSize;
cinfo:TVkDescriptorPoolCreateInfo;
r:TVkResult;
begin
Result:=False;
if (FHandle<>VK_NULL_HANDLE) and (not IsEdit) then Exit(true);
if (FLayouts.Size=0) then Exit;
FSize:=nil;
FmaxSets:=0;
FillChar(FCounts,SizeOf(FCounts),0);
It:=FLayouts.cbegin;
repeat
Ik:=It.Item^;
if (Ik.Layout<>nil) and (Ik.fcount<>0) then
if (Length(Ik.Layout.FBinds)<>0) then
begin
FmaxSets:=FmaxSets+Ik.fcount;
For i:=0 to Ik.fcount-1 do
For b:=0 to High(Ik.Layout.FBinds) do
with Ik.Layout.FBinds[b] do
begin
Inc(FCounts[_GetIdByType(descriptorType)],descriptorCount);
end;
end;
until not It.Next;
For i:=0 to 14 do
if (FCounts[i]<>0) then
begin
L:=Length(FSize);
SetLength(FSize,L+1);
FSize[L].type_:=_GetTypeById(i);
FSize[L].descriptorCount:=FCounts[i];
end;
if (Length(FSize)=0) then Exit;
Id:=FSets.cbegin;
if (Id.Item<>nil) then
repeat
Id.Item^.FHandle:=VK_NULL_HANDLE;
until not Id.Next;
if (FHandle<>VK_NULL_HANDLE) then
begin
vkDestroyDescriptorPool(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
end;
It:=FLayouts.cbegin;
repeat
Ik:=It.Item^;
if (Ik.Layout<>nil) and (Ik.fcount<>0) then
begin
if not Ik.Layout.Compile then Exit;
end;
until not It.Next;
cinfo:=Default(TVkDescriptorPoolCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_POOL_CREATE_INFO;
cinfo.poolSizeCount:=Length(FSize);
cinfo.pPoolSizes :=@FSize[0];
cinfo.maxSets :=FmaxSets;
r:=vkCreateDescriptorPool(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateDescriptorPool:',r);
Exit;
end;
i:=0;
Id:=FSets.cbegin;
if (Id.Item<>nil) then
repeat
Id.Item^._AllocDesc;
Inc(i);
if (i>=FmaxSets) then Break;
until not Id.Next;
FCompile:=FEdit;
Result:=True;
end;
function TvSetsPool.IsEdit:Boolean;
var
It:_TvSetLayoutSet.Iterator;
Ik:_TvSetLayoutKey;
begin
Result:=False;
if (FEdit<>FCompile) then Exit(True);
It:=FLayouts.cbegin;
if (It.Item=nil) then Exit;
repeat
Ik:=It.Item^;
if (Ik.Layout<>nil) and (Ik.fcount<>0) then
if Ik.Layout.IsEdit then Exit(True);
until not It.Next;
end;
procedure TvSetsPool.ClearLayouts;
begin
FLayouts.Free;
Inc(FEdit);
end;
function TvSetsPool._FindLayout(L:TvSetLayout):Boolean;
var
Ik:_TvSetLayoutKey;
begin
Ik.Layout:=L;
Ik.fcount:=0;
Result:=FLayouts.Contains(Ik);
end;
Procedure TvSetsPool.AddLayout(L:TvSetLayout;count:TVkUInt32);
var
It:_TvSetLayoutSet.Iterator;
Ik:_TvSetLayoutKey;
begin
if (L=nil) then Exit;
if (count=0) then count:=1;
Ik.Layout:=L;
Ik.fcount:=count;
It:=FLayouts.find(Ik);
if (It.Item<>nil) then
begin
It.Item^.fcount:=It.Item^.fcount+count;
end else
begin
FLayouts.Insert(Ik);
end;
Inc(FEdit);
end;
Procedure TvSetsPool.AddFormPipelineLayout(L:TvPipelineLayout;count:TVkUInt32);
var
i:Integer;
begin
if (L=nil) then Exit;
if (Length(L.FLayouts)<>0) then
For i:=0 to High(L.FLayouts) do
begin
AddLayout(L.FLayouts[i],count);
end;
end;
function TvSetsPool.Alloc(L:TvSetLayout):TvDescriptorSet;
var
ainfo:TVkDescriptorSetAllocateInfo;
FResult:TVkDescriptorSet;
r:TVkResult;
begin
Result:=nil;
if (L=nil) then Exit;
if not _FindLayout(L) then Exit;
if not Compile then Exit;
if (FSets.Size>=FmaxSets) then Exit;
ainfo:=Default(TVkDescriptorSetAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_ALLOCATE_INFO;
ainfo.descriptorPool :=FHandle;
ainfo.descriptorSetCount:=1;
ainfo.pSetLayouts:=@L.FHandle;
r:=vkAllocateDescriptorSets(Device.FHandle,@ainfo,@FResult);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateDescriptorSets:',r);
Exit;
end;
Result:=TvDescriptorSet.Create;
Result.FParent:=Self;
Result.FLayout:=L;
Result.FHandle:=FResult;
FSets.Insert(Result);
end;
procedure TvDescriptorSet._AllocDesc;
var
ainfo:TVkDescriptorSetAllocateInfo;
r:TVkResult;
begin
if (FParent<>nil) and (FLayout<>nil) then
if (FHandle=VK_NULL_HANDLE) and
(FParent.FHandle<>VK_NULL_HANDLE) then
begin
ainfo:=Default(TVkDescriptorSetAllocateInfo);
ainfo.sType :=VK_STRUCTURE_TYPE_DESCRIPTOR_SET_ALLOCATE_INFO;
ainfo.descriptorPool :=FParent.FHandle;
ainfo.descriptorSetCount:=1;
ainfo.pSetLayouts:=@FLayout.FHandle;
r:=vkAllocateDescriptorSets(Device.FHandle,@ainfo,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkAllocateDescriptorSets:',r);
Exit;
end;
end;
end;
procedure TvDescriptorSet._FreeDesc;
var
r:TVkResult;
begin
if (FParent<>nil) then
if (FHandle<>VK_NULL_HANDLE) and
(FParent.FHandle<>VK_NULL_HANDLE) then
begin
r:=vkFreeDescriptorSets(Device.FHandle,FParent.FHandle,1,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkFreeDescriptorSets:',r);
end;
end;
FHandle:=VK_NULL_HANDLE;
end;
Destructor TvDescriptorSet.Destroy;
begin
if (FParent<>nil) then
begin
_FreeDesc;
FParent.FSets.delete(Self);
end;
inherited;
end;
Procedure TvDescriptorSet.BindUB(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSB(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindUBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSBD(aBind,aElem:TVkUInt32;const buf:TVkDescriptorBufferInfo);
var
dwrite:TVkWriteDescriptorSet;
begin
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC;
dwrite.descriptorCount:=1;
dwrite.pBufferInfo :=@buf;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
Procedure TvDescriptorSet.BindSTI(aBind,aElem:TVkUInt32;const img:TVkImageView);
var
dwrite:TVkWriteDescriptorSet;
dimg:TVkDescriptorImageInfo;
begin
dimg:=Default(TVkDescriptorImageInfo);
dimg.imageView:=img;
dimg.imageLayout:=VK_IMAGE_LAYOUT_GENERAL;
dwrite:=Default(TVkWriteDescriptorSet);
dwrite.sType :=VK_STRUCTURE_TYPE_WRITE_DESCRIPTOR_SET;
dwrite.dstSet :=FHandle;
dwrite.dstBinding :=aBind;
dwrite.dstArrayElement:=aElem;
dwrite.descriptorType :=VK_DESCRIPTOR_TYPE_STORAGE_IMAGE;
dwrite.descriptorCount:=1;
dwrite.pImageInfo :=@dimg;
vkUpdateDescriptorSets(Device.FHandle,1,@dwrite,0,nil);
end;
end.

983
vulkan/vRender.pas Normal file
View File

@ -0,0 +1,983 @@
unit vRender;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
ps4_types,
g23tree,
ps4_libSceVideoOut,
si_ci_vi_merged_enum,
vulkan,
vDevice,
vMemory,
vShader,
vPipeline,
vImage;
type
TvRenderPass=class(vPipeline.TvRenderPass)
AtCount:TVkUInt32;
ColorAt:array[0..8] of TVkAttachmentDescription;
ColorRef:array[0..7] of TVkAttachmentReference; //subpass.colorAttachmentCount
pDepthStencilRef:TVkAttachmentReference;
subpass:TVkSubpassDescription;
dependency:TVkSubpassDependency;
Procedure Clear;
Procedure SetZorderStage(s:TVkPipelineStageFlagBits);
Procedure AddColorRef(id:TVkUInt32);
Procedure SetDepthStencilRef(id:TVkUInt32);
Procedure AddColorAt(format:TVkFormat;ClearColor,DrawColor:Boolean);
Procedure AddDepthAt(format:TVkFormat;ClearDepth,DrawDepth,ClearStencil,DrawStencil:Boolean);
Function Compile:Boolean;
end;
TvGraphicsPipeline=class(TvPipeline)
FLayout:TvPipelineLayout;
FRenderPass:TvRenderPass;
Viewports:array[0..15] of TVkViewport; //viewportState.viewportCount
Scissors :array[0..15] of TVkRect2D; //viewportState.scissorCount
ColorBlends:array[0..7] of TVkPipelineColorBlendAttachmentState; //colorBlending.attachmentCount
FShaders:array[0..5] of TvShader;
dynamicStates:array[0..1] of TVkDynamicState; //dynamicState.dynamicStateCount
vertexInputInfo:TVkPipelineVertexInputStateCreateInfo;
inputAssembly:TVkPipelineInputAssemblyStateCreateInfo;
viewportState:TVkPipelineViewportStateCreateInfo;
rasterizer:TVkPipelineRasterizationStateCreateInfo;
multisampling:TVkPipelineMultisampleStateCreateInfo;
colorBlending:TVkPipelineColorBlendStateCreateInfo;
DepthStencil:TVkPipelineDepthStencilStateCreateInfo;
dynamicState:TVkPipelineDynamicStateCreateInfo;
emulate_primtype:TVkPrimitiveTopology;
Procedure SetPrimType(t:TVkPrimitiveTopology);
Procedure AddVPort(const V:TVkViewport;const S:TVkRect2D);
Procedure AddBlend(const b:TVkPipelineColorBlendAttachmentState);
Procedure Clear;
Procedure SetLSShader(Shader:TvShader);
Procedure SetHSShader(Shader:TvShader);
Procedure SetESShader(Shader:TvShader);
Procedure SetGSShader(Shader:TvShader);
Procedure SetVSShader(Shader:TvShader);
Procedure SetPSShader(Shader:TvShader);
procedure SetLayout(Layout:TvPipelineLayout);
procedure SetRenderPass(RenderPass:TvRenderPass);
function Compile:Boolean;
end;
TvRenderTargets=class
FRenderPass:TvRenderPass;
FPipeline:TvGraphicsPipeline;
FFramebuffer:TvFramebuffer;
FRenderArea:TVkRect2D;
FClearValuesCount:TVkUInt32;
FClearValues:array[0..8] of TVkClearValue;
Procedure AddClearColor(clr:TVkClearValue);
class function c(const a,b:TvRenderTargets):Integer;
Destructor Destroy; override;
end;
TvRenderTargetsSet=specialize T23treeSet<TvRenderTargets,TvRenderTargets>;
TvCmdBuffer=class
cmdbuf:TVkCommandBuffer;
FRenderTargets:TvRenderTargets;
FRenderList:TvRenderTargetsSet;
FWaitSemaphore:TvSemaphore;
FSignSemaphore:TvSemaphore;
FSignFence:TvFence;
FCBState:Boolean;
function BeginCmdBuffer:Boolean;
Procedure EndCmdBuffer;
function BeginRenderPass(RT:TvRenderTargets):Boolean;
Procedure EndRenderPass;
Procedure QueueSubmit;
Procedure ClearRenderList;
Procedure DrawIndex2(Addr:Pointer;INDICES:DWORD;INDEX_TYPE:TVkIndexType);
Procedure DrawIndexAuto(INDICES:DWORD;INDEX_TYPE:TVkIndexType);
end;
TUnionResource=class
Addr:Pointer;
host:TvPointer;
end;
TUnionResourceBuffer=class(TUnionResource)
FHostBuf:TvBuffer;
Foffset:TVkDeviceSize; //offset inside buffer
Destructor Destroy; override;
end;
TUnionResourceImage=class(TUnionResource)
FImage:TvDeviceImage2D;
devc:TvPointer;
Destructor Destroy; override;
end;
function FindHostBuffer(Addr:Pointer):TUnionResourceBuffer;
function FetchHostBuffer(Addr:Pointer;Size:TVkDeviceSize;usage:TVkFlags):TUnionResourceBuffer;
function FindUnionImage2D(Addr:Pointer):TUnionResourceImage;
function FetchUnionImage2D(Addr:Pointer;cformat:TVkFormat;extend:TVkExtent2D;usage:TVkFlags):TUnionResourceImage;
implementation
//lock res TODO
type
TUnionResourceCompare=object
function c(const a,b:TUnionResource):Integer; static;
end;
TUnionResourceSet=specialize T23treeSet<TUnionResource,TUnionResourceCompare>;
var
FUnionBuffer:TUnionResourceSet;
FUnionImages2D:TUnionResourceSet;
function FindHostBuffer(Addr:Pointer):TUnionResourceBuffer;
var
i:TUnionResourceSet.Iterator;
t:TUnionResourceBuffer;
begin
Result:=nil;
t:=TUnionResourceBuffer.Create;
t.Addr:=Addr;
i:=FUnionBuffer.find(t);
if (i.Item<>nil) then
begin
Result:=TUnionResourceBuffer(i.Item^);
end;
FreeAndNil(t);
end;
function FetchHostBuffer(Addr:Pointer;Size:TVkDeviceSize;usage:TVkFlags):TUnionResourceBuffer;
const
buf_ext:TVkExternalMemoryBufferCreateInfo=(
sType:VK_STRUCTURE_TYPE_EXTERNAL_MEMORY_BUFFER_CREATE_INFO;
pNext:nil;
handleTypes:ord(VK_EXTERNAL_MEMORY_HANDLE_TYPE_HOST_ALLOCATION_BIT_EXT);
);
var
i:TUnionResourceSet.Iterator;
t:TUnionResourceBuffer;
host:TvPointer;
procedure _init;
var
mr:TVkMemoryRequirements;
p:TVkDeviceSize;
begin
t.host:=host;
t.FHostBuf:=TvBuffer.Create(Size,usage,@buf_ext);
t.Foffset:=0;
mr:=t.FHostBuf.GetRequirements;
if IsAlign(host.FOffset,mr.alignment) then
begin
t.FHostBuf.BindMem(host);
end else
begin
p:=AlignDw(host.FOffset,mr.alignment);
t.Foffset:=(host.FOffset-p);
host.FOffset:=p;
Size:=Size+t.Foffset;
FreeAndNil(t.FHostBuf);
t.FHostBuf:=TvBuffer.Create(Size,usage,@buf_ext);
t.FHostBuf.BindMem(host);
end;
end;
begin
Result:=nil;
t:=TUnionResourceBuffer.Create;
t.Addr:=Addr;
i:=FUnionBuffer.find(t);
if (i.Item=nil) then
begin
if not TryGetHostPointerByAddr(addr,host) then
begin
FreeAndNil(t);
Exit;
end;
FUnionBuffer.Insert(t);
_init;
Result:=t;
end else
begin
FreeAndNil(t);
t:=TUnionResourceBuffer(i.Item^);
if not TryGetHostPointerByAddr(addr,host) then
begin
FUnionBuffer.delete(t);
FreeAndNil(t);
Exit;
end;
if (t.host.FHandle<>host.FHandle) or
(t.host.FOffset<>host.FOffset) or
(t.FHostBuf.FSize<>Size) or
(t.FHostBuf.FUsage<>usage) then
begin
FreeAndNil(t.FHostBuf);
_init;
end;
Result:=t;
end;
end;
function FindUnionImage2D(Addr:Pointer):TUnionResourceImage;
var
i:TUnionResourceSet.Iterator;
t:TUnionResourceImage;
begin
Result:=nil;
t:=TUnionResourceImage.Create;
t.Addr:=Addr;
i:=FUnionImages2D.find(t);
if (i.Item<>nil) then
begin
Result:=TUnionResourceImage(i.Item^);
end;
FreeAndNil(t);
end;
function FetchUnionImage2D(Addr:Pointer;cformat:TVkFormat;extend:TVkExtent2D;usage:TVkFlags):TUnionResourceImage;
var
i:TUnionResourceSet.Iterator;
t:TUnionResourceImage;
host:TvPointer;
procedure _init;
begin
t.host:=host;
t.FImage:=TvDeviceImage2D.Create(cformat,TVkExtent3D.Create(extend.width,extend.height,1),usage);
t.devc:=MemManager.Alloc(
t.FImage.GetRequirements,
ord(VK_MEMORY_PROPERTY_DEVICE_LOCAL_BIT)
);
t.FImage.BindMem(t.devc);
end;
begin
Result:=nil;
t:=TUnionResourceImage.Create;
t.Addr:=Addr;
i:=FUnionImages2D.find(t);
if (i.Item=nil) then
begin
if not TryGetHostPointerByAddr(addr,host) then
begin
FreeAndNil(t);
Exit;
end;
FUnionImages2D.Insert(t);
_init;
Result:=t;
end else
begin
FreeAndNil(t);
t:=TUnionResourceImage(i.Item^);
if not TryGetHostPointerByAddr(addr,host) then
begin
FUnionImages2D.delete(t);
FreeAndNil(t);
Exit;
end;
if (t.host.FHandle<>host.FHandle) or
(t.host.FOffset<>host.FOffset) or
(t.FImage.FFormat<>cformat) or
(t.FImage.FUsage<>usage) or
(t.FImage.FExtent.width<>extend.width) or
(t.FImage.FExtent.height<>extend.height) then
begin
FreeAndNil(t.FImage);
MemManager.Free(t.devc);
_init;
end;
Result:=t;
end;
end;
Procedure TvRenderPass.Clear;
begin
AtCount:=0;
FillChar(ColorAt,SizeOf(ColorAt),0);
FillChar(ColorRef,SizeOf(ColorRef),0);
subpass:=Default(TVkSubpassDescription);
subpass.pipelineBindPoint:=VK_PIPELINE_BIND_POINT_GRAPHICS;
subpass.inputAttachmentCount :=0;
subpass.pInputAttachments :=nil;
subpass.colorAttachmentCount:=0;
subpass.pColorAttachments :=@ColorRef;
subpass.pResolveAttachments :=nil; //colorAttachmentCount VK_ATTACHMENT_UNUSED
subpass.pDepthStencilAttachment:=nil; //1
subpass.preserveAttachmentCount:=0;
subpass.pPreserveAttachments :=nil;
dependency:=Default(TVkSubpassDependency);
dependency.srcSubpass :=VK_SUBPASS_EXTERNAL;
dependency.dstSubpass :=0;
dependency.srcStageMask :=0{ord(VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT)};
dependency.dstStageMask :=0{ord(VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT)};
dependency.srcAccessMask:=0;
dependency.dstAccessMask:=0{ord(VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT)};
end;
Procedure TvRenderPass.SetZorderStage(s:TVkPipelineStageFlagBits);
begin
dependency.srcStageMask:=TVkPipelineStageFlags(ord(dependency.srcStageMask) or ord(s));
dependency.dstStageMask:=TVkPipelineStageFlags(ord(dependency.dstStageMask) or ord(s));
end;
Procedure TvRenderPass.AddColorRef(id:TVkUInt32);
begin
if (subpass.colorAttachmentCount>7) then Exit;
ColorRef[subpass.colorAttachmentCount].attachment:=id;
ColorRef[subpass.colorAttachmentCount].layout :=VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL{VK_IMAGE_LAYOUT_GENERAL};
Inc(subpass.colorAttachmentCount);
dependency.srcStageMask :=TVkPipelineStageFlags(ord(dependency.srcStageMask) or ord(VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT));
dependency.dstStageMask :=TVkPipelineStageFlags(ord(dependency.dstStageMask) or ord(VK_PIPELINE_STAGE_COLOR_ATTACHMENT_OUTPUT_BIT));
dependency.dstAccessMask:=TVkAccessFlags(ord(dependency.dstAccessMask) or ord(VK_ACCESS_COLOR_ATTACHMENT_WRITE_BIT));
end;
Procedure TvRenderPass.SetDepthStencilRef(id:TVkUInt32);
begin
subpass.pDepthStencilAttachment:=@pDepthStencilRef;
pDepthStencilRef.attachment :=id;
pDepthStencilRef.layout :=VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL;
dependency.dstAccessMask:=TVkAccessFlags(ord(dependency.dstAccessMask) or ord(VK_ACCESS_DEPTH_STENCIL_ATTACHMENT_WRITE_BIT));
end;
Procedure TvRenderPass.AddColorAt(format:TVkFormat;ClearColor,DrawColor:Boolean);
begin
if (AtCount>8) then Exit;
ColorAt[AtCount]:=Default(TVkAttachmentDescription);
ColorAt[AtCount].format :=format;
ColorAt[AtCount].samples :=VK_SAMPLE_COUNT_1_BIT;
Case ClearColor of
True :ColorAt[AtCount].loadOp:=VK_ATTACHMENT_LOAD_OP_CLEAR;
False:ColorAt[AtCount].loadOp:=VK_ATTACHMENT_LOAD_OP_DONT_CARE;
end;
Case DrawColor of
True :ColorAt[AtCount].storeOp:=VK_ATTACHMENT_STORE_OP_STORE;
False:ColorAt[AtCount].storeOp:=VK_ATTACHMENT_STORE_OP_DONT_CARE;
end;
ColorAt[AtCount].stencilLoadOp :=VK_ATTACHMENT_LOAD_OP_DONT_CARE;
ColorAt[AtCount].stencilStoreOp:=VK_ATTACHMENT_STORE_OP_DONT_CARE;
ColorAt[AtCount].initialLayout :=VK_IMAGE_LAYOUT_UNDEFINED;
ColorAt[AtCount].finalLayout :=VK_IMAGE_LAYOUT_COLOR_ATTACHMENT_OPTIMAL;
{VK_IMAGE_LAYOUT_GENERAL}
{VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL};
Inc(AtCount);
end;
Procedure TvRenderPass.AddDepthAt(format:TVkFormat;ClearDepth,DrawDepth,ClearStencil,DrawStencil:Boolean);
begin
if (AtCount>8) then Exit;
ColorAt[AtCount]:=Default(TVkAttachmentDescription);
ColorAt[AtCount].format :=format;
ColorAt[AtCount].samples :=VK_SAMPLE_COUNT_1_BIT;
Case ClearDepth of
True :ColorAt[AtCount].loadOp:=VK_ATTACHMENT_LOAD_OP_CLEAR;
False:ColorAt[AtCount].loadOp:=VK_ATTACHMENT_LOAD_OP_DONT_CARE;
end;
Case DrawDepth of
True :ColorAt[AtCount].storeOp:=VK_ATTACHMENT_STORE_OP_STORE;
False:ColorAt[AtCount].storeOp:=VK_ATTACHMENT_STORE_OP_DONT_CARE;
end;
Case ClearStencil of
True :ColorAt[AtCount].stencilLoadOp:=VK_ATTACHMENT_LOAD_OP_CLEAR;
False:ColorAt[AtCount].stencilLoadOp:=VK_ATTACHMENT_LOAD_OP_DONT_CARE;
end;
Case DrawStencil of
True :ColorAt[AtCount].stencilStoreOp:=VK_ATTACHMENT_STORE_OP_STORE;
False:ColorAt[AtCount].stencilStoreOp:=VK_ATTACHMENT_STORE_OP_DONT_CARE;
end;
ColorAt[AtCount].initialLayout :=VK_IMAGE_LAYOUT_UNDEFINED;
ColorAt[AtCount].finalLayout :=VK_IMAGE_LAYOUT_DEPTH_STENCIL_ATTACHMENT_OPTIMAL;
{VK_IMAGE_LAYOUT_GENERAL}
{VK_IMAGE_LAYOUT_TRANSFER_SRC_OPTIMAL};
Inc(AtCount);
end;
Function TvRenderPass.Compile:Boolean;
var
r:TVkResult;
info:TVkRenderPassCreateInfo;
begin
Result:=False;
if (AtCount=0) then Exit;
info:=Default(TVkRenderPassCreateInfo);
info.sType :=VK_STRUCTURE_TYPE_RENDER_PASS_CREATE_INFO;
info.attachmentCount:=AtCount;
info.pAttachments :=@ColorAt;
info.subpassCount :=1;
info.pSubpasses :=@subpass;
info.dependencyCount:=1;
info.pDependencies :=@dependency;
r:=vkCreateRenderPass(Device.FHandle,@info,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateRenderPass');
Exit;
end;
Result:=True;
end;
//
Procedure TvGraphicsPipeline.SetPrimType(t:TVkPrimitiveTopology);
begin
Case ord(t) of
ord(VK_PRIMITIVE_TOPOLOGY_POINT_LIST)..ord(VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP_WITH_ADJACENCY):
inputAssembly.topology:=t;
DI_PT_RECTLIST ,
DI_PT_LINELOOP ,
DI_PT_QUADLIST ,
DI_PT_QUADSTRIP,
DI_PT_POLYGON :
begin
inputAssembly.topology:=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_STRIP;
emulate_primtype:=t;
end;
end;
end;
Procedure TvGraphicsPipeline.AddVPort(const V:TVkViewport;const S:TVkRect2D);
begin
if (viewportState.viewportCount>15) then Exit;
Viewports[viewportState.viewportCount]:=V;
Scissors [viewportState.viewportCount]:=S;
Inc(viewportState.viewportCount);
viewportState.scissorCount:=viewportState.viewportCount;
end;
Procedure TvGraphicsPipeline.AddBlend(const b:TVkPipelineColorBlendAttachmentState);
begin
if (colorBlending.attachmentCount>7) then Exit;
ColorBlends[colorBlending.attachmentCount]:=b;
Inc(colorBlending.attachmentCount);
end;
Procedure TvGraphicsPipeline.Clear;
begin
vertexInputInfo:=Default(TVkPipelineVertexInputStateCreateInfo);
vertexInputInfo.sType :=VK_STRUCTURE_TYPE_PIPELINE_VERTEX_INPUT_STATE_CREATE_INFO;
inputAssembly:=Default(TVkPipelineInputAssemblyStateCreateInfo);
inputAssembly.sType :=VK_STRUCTURE_TYPE_PIPELINE_INPUT_ASSEMBLY_STATE_CREATE_INFO;
inputAssembly.topology :=VK_PRIMITIVE_TOPOLOGY_TRIANGLE_LIST;
inputAssembly.primitiveRestartEnable:=VK_FALSE;
FillChar(Viewports ,SizeOf(Viewports),0);
FillChar(Scissors ,SizeOf(Scissors) ,0);
FillChar(ColorBlends,SizeOf(ColorBlends),0);
FillChar(FShaders ,SizeOf(FShaders),0);
viewportState:=Default(TVkPipelineViewportStateCreateInfo);
viewportState.sType :=VK_STRUCTURE_TYPE_PIPELINE_VIEWPORT_STATE_CREATE_INFO;
viewportState.viewportCount:=0;
viewportState.pViewports :=@Viewports;
viewportState.scissorCount :=0;
viewportState.pScissors :=@Scissors;
rasterizer:=Default(TVkPipelineRasterizationStateCreateInfo);
rasterizer.sType :=VK_STRUCTURE_TYPE_PIPELINE_RASTERIZATION_STATE_CREATE_INFO;
rasterizer.depthClampEnable:=VK_FALSE;
rasterizer.rasterizerDiscardEnable:=VK_FALSE;
rasterizer.polygonMode :=VK_POLYGON_MODE_FILL;
rasterizer.lineWidth :=1;
rasterizer.cullMode :=ord(VK_CULL_MODE_NONE);
rasterizer.frontFace :=VK_FRONT_FACE_COUNTER_CLOCKWISE;
rasterizer.depthBiasEnable :=VK_FALSE;
rasterizer.depthBiasConstantFactor:=0;
rasterizer.depthBiasClamp :=0;
rasterizer.depthBiasSlopeFactor :=0;
multisampling:=Default(TVkPipelineMultisampleStateCreateInfo);
multisampling.sType :=VK_STRUCTURE_TYPE_PIPELINE_MULTISAMPLE_STATE_CREATE_INFO;
multisampling.sampleShadingEnable :=VK_FALSE;
multisampling.rasterizationSamples :=VK_SAMPLE_COUNT_1_BIT;
multisampling.minSampleShading :=1;
multisampling.pSampleMask :=nil;
multisampling.alphaToCoverageEnable:=VK_FALSE;
multisampling.alphaToOneEnable :=VK_FALSE;
colorBlending:=Default(TVkPipelineColorBlendStateCreateInfo);
colorBlending.sType :=VK_STRUCTURE_TYPE_PIPELINE_COLOR_BLEND_STATE_CREATE_INFO;
colorBlending.logicOpEnable :=VK_FALSE;
colorBlending.logicOp :=VK_LOGIC_OP_COPY;
colorBlending.attachmentCount :=0;
colorBlending.pAttachments :=@ColorBlends;
DepthStencil:=Default(TVkPipelineDepthStencilStateCreateInfo);
DepthStencil.sType :=VK_STRUCTURE_TYPE_PIPELINE_DEPTH_STENCIL_STATE_CREATE_INFO;
DepthStencil.depthTestEnable :=VK_FALSE;
DepthStencil.depthWriteEnable :=VK_FALSE;
DepthStencil.depthCompareOp :=VK_COMPARE_OP_LESS;
DepthStencil.depthBoundsTestEnable:=VK_FALSE;
DepthStencil.stencilTestEnable :=VK_FALSE;
//DepthStencil.front :TVkStencilOpState;
//DepthStencil.back :TVkStencilOpState;
DepthStencil.minDepthBounds :=0;
DepthStencil.maxDepthBounds :=0;
dynamicState:=Default(TVkPipelineDynamicStateCreateInfo);
dynamicState.sType :=VK_STRUCTURE_TYPE_PIPELINE_DYNAMIC_STATE_CREATE_INFO;
dynamicState.dynamicStateCount:=0{2};
dynamicState.pDynamicStates :=@dynamicStates;
dynamicStates[0]:=VK_DYNAMIC_STATE_VIEWPORT;
dynamicStates[1]:=VK_DYNAMIC_STATE_LINE_WIDTH;
end;
//kShaderStageCs = 0x00000000, ///< Compute shader stage.
//kShaderStagePs = 0x00000001, ///< Pixel shader stage.
//kShaderStageVs = 0x00000002, ///< Vertex shader stage.
//kShaderStageGs = 0x00000003, ///< Geometry shader stage.
//kShaderStageEs = 0x00000004, ///< Export shader stage.
//kShaderStageHs = 0x00000005, ///< Hull shader stage.
//kShaderStageLs = 0x00000006, ///< LDS shader stage. = Vertex shader to share data
//kActiveShaderStagesVsPs = 0x00000000
//kActiveShaderStagesEsGsVsPs = 0x000000B0
//kActiveShaderStagesLsHsVsPs = 0x00000045
//kActiveShaderStagesLsHsEsGsVsPs = 0x000000AD
//kActiveShaderStagesDispatchDrawVsPs = 0x00000200
//Logical Pipeline ↓
//VK_SHADER_STAGE_VERTEX_BIT Vertex VS LS LS ES
//VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT Hull [] HS HS []
//VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT Domain [] VS ES []
//VK_SHADER_STAGE_GEOMETRY_BIT Geometry [] [] GS, VS GS, VS
//VK_SHADER_STAGE_FRAGMENT_BIT Pixel PS PS PS PS
//0 LS VK_SHADER_STAGE_VERTEX_BIT
//1 HS VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT
//2 ES VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT
//3 GS VK_SHADER_STAGE_GEOMETRY_BIT
//4 VS VK_SHADER_STAGE_VERTEX_BIT
//5 PS VK_SHADER_STAGE_FRAGMENT_BIT
Procedure TvGraphicsPipeline.SetLSShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_VERTEX_BIT) then
FShaders[0]:=Shader;
end;
Procedure TvGraphicsPipeline.SetHSShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT) then
FShaders[1]:=Shader;
end;
Procedure TvGraphicsPipeline.SetESShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT) then
FShaders[2]:=Shader;
end;
Procedure TvGraphicsPipeline.SetGSShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_GEOMETRY_BIT) then
FShaders[3]:=Shader;
end;
Procedure TvGraphicsPipeline.SetVSShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_VERTEX_BIT) then
FShaders[4]:=Shader;
end;
Procedure TvGraphicsPipeline.SetPSShader(Shader:TvShader);
begin
if (Shader=nil) then Exit;
if (Shader.FStage=VK_SHADER_STAGE_FRAGMENT_BIT) then
FShaders[5]:=Shader;
end;
procedure TvGraphicsPipeline.SetLayout(Layout:TvPipelineLayout);
begin
if (FLayout<>Layout) then
begin
FLayout:=Layout;
end;
end;
procedure TvGraphicsPipeline.SetRenderPass(RenderPass:TvRenderPass);
begin
if (FRenderPass<>RenderPass) then
begin
FRenderPass:=RenderPass;
end;
end;
function TvGraphicsPipeline.Compile:Boolean;
var
r:TVkResult;
i:Integer;
shaderStages:array[0..5] of TVkPipelineShaderStageCreateInfo; // info.stageCount
info:TVkGraphicsPipelineCreateInfo;
begin
Result:=False;
if (FLayout=nil) then Exit;
if (FRenderPass=nil) then Exit;
if (viewportState.viewportCount=0) then Exit;
if (viewportState.scissorCount=0) then Exit;
info:=Default(TVkGraphicsPipelineCreateInfo);
FillChar(shaderStages,SizeOf(shaderStages),0);
For i:=0 to 5 do
if (FShaders[i]<>nil) then
begin
shaderStages[info.stageCount].sType :=VK_STRUCTURE_TYPE_PIPELINE_SHADER_STAGE_CREATE_INFO;
shaderStages[info.stageCount].stage :=FShaders[i].FStage;
shaderStages[info.stageCount].module:=FShaders[i].FHandle;
shaderStages[info.stageCount].pName :=PChar(FShaders[i].FEntry);
Inc(info.stageCount);
end;
if (info.stageCount=0) then Exit;
if (not FLayout.Compile) then Exit;
if (not FRenderPass.Compile) then Exit;
info.sType :=VK_STRUCTURE_TYPE_GRAPHICS_PIPELINE_CREATE_INFO;
info.pStages :=@shaderStages;
info.pVertexInputState :=@vertexInputInfo;
info.pInputAssemblyState:=@inputAssembly;
info.pViewportState :=@viewportState;
info.pRasterizationState:=@rasterizer;
info.pMultisampleState :=@multisampling;
info.pDepthStencilState :=@DepthStencil;
info.pColorBlendState :=@colorBlending;
info.pDynamicState :=@dynamicState;
info.layout :=FLayout.FHandle;
info.renderPass :=FRenderPass.FHandle;
info.subpass :=0;
info.basePipelineHandle :=VK_NULL_HANDLE;
info.basePipelineIndex :=-1;
r:=vkCreateGraphicsPipelines(Device.FHandle,VK_NULL_HANDLE,1,@info,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('failed to create graphics pipeline!');
exit;
end;
Result:=True;
end;
/////////
Procedure TvRenderTargets.AddClearColor(clr:TVkClearValue);
begin
if (FClearValuesCount>8) then Exit;
FClearValues[FClearValuesCount]:=clr;
Inc(FClearValuesCount);
end;
class function TvRenderTargets.c(const a,b:TvRenderTargets):Integer;
begin
Result:=CompareByte(a,b,SizeOf(Pointer));
end;
Destructor TvRenderTargets.Destroy;
begin
FreeAndNil(FRenderPass);
FreeAndNil(FPipeline);
FreeAndNil(FFramebuffer);
inherited;
end;
///////////////
function TvCmdBuffer.BeginCmdBuffer:Boolean;
var
r:TVkResult;
Info:TVkCommandBufferBeginInfo;
begin
Result:=False;
if (Self=nil) then Exit;
if FCBState then Exit(True);
if (cmdbuf=VK_NULL_HANDLE) then Exit;
Info:=Default(TVkCommandBufferBeginInfo);
Info.sType:=VK_STRUCTURE_TYPE_COMMAND_BUFFER_BEGIN_INFO;
Info.flags:=ord(VK_COMMAND_BUFFER_USAGE_ONE_TIME_SUBMIT_BIT);
Info.pInheritanceInfo:=nil;
r:=vkBeginCommandBuffer(cmdbuf,@Info);
if (r<>VK_SUCCESS) then
begin
Writeln('vkBeginCommandBuffer:',r);
Exit;
end;
FCBState:=True;
Result:=True;
end;
Procedure TvCmdBuffer.EndCmdBuffer;
var
r:TVkResult;
begin
if (Self=nil) then Exit;
if FCBState then
begin
EndRenderPass;
r:=vkEndCommandBuffer(cmdbuf);
if (r<>VK_SUCCESS) then
begin
Writeln('vkEndCommandBuffer:',r);
end;
FCBState:=False;
end;
end;
function TvCmdBuffer.BeginRenderPass(RT:TvRenderTargets):Boolean;
var
info:TVkRenderPassBeginInfo;
begin
Result:=False;
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
if (RT=nil) then
begin
EndRenderPass;
Exit(True);
end;
if (FRenderTargets=RT) then Exit(True);
if (RT.FRenderPass=nil) then Exit;
if (RT.FPipeline=nil) then Exit;
if (RT.FFramebuffer=nil) then Exit;
if (not RT.FRenderPass.Compile) then Exit;
if (not RT.FPipeline.Compile) then Exit;
if (not RT.FFramebuffer.Compile) then Exit;
if (not BeginCmdBuffer) then Exit;
EndRenderPass;
info:=Default(TVkRenderPassBeginInfo);
info.sType :=VK_STRUCTURE_TYPE_RENDER_PASS_BEGIN_INFO;
info.renderPass :=RT.FRenderPass.FHandle;
info.renderArea :=RT.FRenderArea;
info.clearValueCount:=RT.FClearValuesCount;
info.pClearValues :=RT.FClearValues;
info.framebuffer :=RT.FFramebuffer.FHandle;
vkCmdBeginRenderPass(cmdbuf,@info,VK_SUBPASS_CONTENTS_INLINE);
vkCmdBindPipeline (cmdbuf,VK_PIPELINE_BIND_POINT_GRAPHICS,RT.FPipeline.FHandle);
FRenderTargets:=RT;
Result:=True;
end;
Procedure TvCmdBuffer.EndRenderPass;
begin
if (Self=nil) then Exit;
if (FRenderTargets<>nil) then
begin
vkCmdEndRenderPass(cmdbuf);
FRenderList.Insert(FRenderTargets);
FRenderTargets:=nil;
end;
end;
Procedure TvCmdBuffer.QueueSubmit;
var
r:TVkResult;
info:TVkSubmitInfo;
waitStages:TVkPipelineStageFlags;
Fence:TVkFence;
begin
if (Self=nil) then Exit;
if (cmdbuf=VK_NULL_HANDLE) then Exit;
EndCmdBuffer;
waitStages:=ord(VK_PIPELINE_STAGE_ALL_GRAPHICS_BIT);
info:=Default(TVkSubmitInfo);
info.sType :=VK_STRUCTURE_TYPE_SUBMIT_INFO;
info.commandBufferCount :=1;
info.pCommandBuffers :=@cmdbuf;
info.pWaitDstStageMask :=@waitStages;
if (FWaitSemaphore<>nil) then
begin
info.waitSemaphoreCount:=1;
info.pWaitSemaphores :=@FWaitSemaphore.FHandle;
end;
if (FSignSemaphore<>nil) then
begin
info.signalSemaphoreCount:=1;
info.pSignalSemaphores :=@FSignSemaphore.FHandle;
end;
Fence:=VK_NULL_HANDLE;
if (FSignFence<>nil) then
begin
Fence:=FSignFence.FHandle;
end;
r:=vkQueueSubmit(RenderQueue,1,@info,Fence);
if (r<>VK_SUCCESS) then
begin
Writeln('vkQueueSubmit');
exit;
end;
end;
Procedure TvCmdBuffer.ClearRenderList;
var
It:TvRenderTargetsSet.Iterator;
begin
if (Self=nil) then Exit;
It:=FRenderList.cbegin;
if (It.Item<>nil) then
repeat
TvRenderTargets(It.Item^).Free;
until not It.Next;
FRenderList.Free;
FreeAndNil(FRenderTargets);
end;
function GET_INDEX_TYPE_SIZE(INDEX_TYPE:TVkIndexType):Byte;
begin
Case INDEX_TYPE of
VK_INDEX_TYPE_UINT16:Result:=16;
VK_INDEX_TYPE_UINT32:Result:=32;
VK_INDEX_TYPE_UINT8_EXT :Result:=8;
else Result:=0;
end;
end;
Procedure TvCmdBuffer.DrawIndex2(Addr:Pointer;INDICES:DWORD;INDEX_TYPE:TVkIndexType);
var
rb:TUnionResourceBuffer;
Size:TVkDeviceSize;
begin
if (Self=nil) then Exit;
if (FRenderTargets=nil) then Exit;
Size:=INDICES*GET_INDEX_TYPE_SIZE(INDEX_TYPE);
rb:=FetchHostBuffer(Addr,Size,ord(VK_BUFFER_USAGE_INDEX_BUFFER_BIT));
Assert(rb<>nil);
vkCmdBindIndexBuffer(
cmdbuf,
rb.FHostBuf.FHandle,
rb.Foffset,
INDEX_TYPE);
vkCmdDrawIndexed(
cmdbuf,
INDICES,
1,0,0,0);
end;
Procedure TvCmdBuffer.DrawIndexAuto(INDICES:DWORD;INDEX_TYPE:TVkIndexType);
begin
if (Self=nil) then Exit;
if (FRenderTargets=nil) then Exit;
vkCmdDraw(
cmdbuf,
INDICES,
1,0,0);
end;
//
function TUnionResourceCompare.c(const a,b:TUnionResource):Integer;
begin
Result:=CompareByte(a.Addr,b.Addr,SizeOf(Pointer));
end;
//
Destructor TUnionResourceBuffer.Destroy;
begin
FreeAndNil(FHostBuf);
inherited;
end;
//
Destructor TUnionResourceImage.Destroy;
begin
FreeAndNil(FImage);
MemManager.Free(devc);
inherited;
end;
end.

406
vulkan/vShader.pas Normal file
View File

@ -0,0 +1,406 @@
unit vShader;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, vulkan, vDevice;
type
TvSupportDescriptorType=array[0..1] of TVkDescriptorType;
PvShaderBind=^TvShaderBind;
TvShaderBind=packed object
FDVID:DWORD;
FDSET:DWORD;
FBIND:DWORD;
FSCLS:DWORD;
FTYPE:DWORD;
end;
TvShader=class
FHandle:TVkShaderModule;
FStage:TVkShaderStageFlagBits;
FLocalSize:TVkOffset3D;
FEntry:RawByteString;
FBinds:array of TvShaderBind;
Destructor Destroy; override;
procedure LoadFromMemory(data:Pointer;size:Ptruint);
procedure LoadFromStream(Stream:TStream);
procedure LoadFromFile(const FileName:RawByteString);
procedure Parse(data:Pointer;size:Ptruint);
end;
implementation
Destructor TvShader.Destroy;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyShaderModule(Device.FHandle,FHandle,nil);
end;
procedure TvShader.LoadFromMemory(data:Pointer;size:Ptruint);
var
cinfo:TVkShaderModuleCreateInfo;
r:TVkResult;
begin
if (FHandle<>VK_NULL_HANDLE) then
vkDestroyShaderModule(Device.FHandle,FHandle,nil);
FHandle:=VK_NULL_HANDLE;
FStage:=Default(TVkShaderStageFlagBits);
FLocalSize:=TVkOffset3D.Create(1,1,1);
FEntry:='';
SetLength(FBinds,0);
cinfo:=Default(TVkShaderModuleCreateInfo);
cinfo.sType :=VK_STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO;
cinfo.codeSize:=size;
cinfo.pCode :=data;
r:=vkCreateShaderModule(Device.FHandle,@cinfo,nil,@FHandle);
if (r<>VK_SUCCESS) then
begin
Writeln('vkCreateShaderModule:',r);
Exit;
end;
Parse(data,size);
end;
procedure TvShader.LoadFromStream(Stream:TStream);
var
M:TCustomMemoryStream;
begin
if Stream.InheritsFrom(TCustomMemoryStream) then
begin
M:=TCustomMemoryStream(Stream);
end else
begin
M:=TMemoryStream.Create;
TMemoryStream(M).LoadFromStream(Stream);
end;
LoadFromMemory(M.Memory,M.Size);
if (M<>Stream) then
begin
M.Free;
end;
end;
procedure TvShader.LoadFromFile(const FileName:RawByteString);
Var
S:TFileStream;
begin
S:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
Try
LoadFromStream(S);
finally
S.Free;
end;
end;
type
PSPIRVHeader=^TSPIRVHeader;
TSPIRVHeader=packed record
MAGIC:DWORD;
VERSION_MINOR:WORD;
VERSION_MAJOR:WORD;
TOOL_VERSION:WORD;
TOOL_ID:WORD;
BOUND:DWORD;
RESERVED:DWORD;
end;
PSPIRVInstruction=^TSPIRVInstruction;
TSPIRVInstruction=packed record
OP:WORD;
COUNT:WORD;
end;
Const
MagicNumber = 119734787;
//Operation
OpEntryPoint = 15;
OpExecutionMode = 16;
OpTypeVoid = 19;
OpTypeBool = 20;
OpTypeInt = 21;
OpTypeFloat = 22;
OpTypeVector = 23;
OpTypeMatrix = 24;
OpTypeImage = 25;
OpTypeSampler = 26;
OpTypeSampledImage = 27;
OpTypeArray = 28;
OpTypeRuntimeArray = 29;
OpTypeStruct = 30;
OpTypeOpaque = 31;
OpTypePointer = 32;
OpTypeFunction = 33;
OpTypeEvent = 34;
OpTypeDeviceEvent = 35;
OpTypeReserveId = 36;
OpTypeQueue = 37;
OpTypePipe = 38;
OpTypeForwardPointer = 39;
OpDecorate = 71;
OpVariable = 59;
//ExecutionMode
LocalSize = 17;
//Decoration
Sample = 17;
Binding = 33;
DescriptorSet = 34;
//StorageClass
UniformConstant = 0;
Uniform = 2;
Image = 11;
StorageBuffer = 12;
//ExecutionModel
Vertex = 0;
TessellationControl = 1;
TessellationEvaluation = 2;
Geometry = 3;
Fragment = 4;
GLCompute = 5;
Kernel = 6;
TaskNV = 5267;
MeshNV = 5268;
RayGenerationKHR = 5313;
IntersectionKHR = 5314;
AnyHitKHR = 5315;
ClosestHitKHR = 5316;
MissKHR = 5317;
CallableKHR = 5318;
procedure TvShader.Parse(data:Pointer;size:Ptruint);
var
orig_data:Pointer;
orig_size:Ptruint;
I:TSPIRVInstruction;
f:Ptruint;
r:PvShaderBind;
d:dword;
function Fetch(ID:DWORD):PvShaderBind;
var
i:Integer;
begin
if Length(FBinds)<>0 then
For i:=0 to High(FBinds) do
if (ID=FBinds[i].FDVID) then
begin
Exit(@FBinds[i]);
end;
i:=Length(FBinds);
SetLength(FBinds,i+1);
FBinds[i]:=Default(TvShaderBind);
FBinds[i].FDVID:=ID;
Result:=@FBinds[i];
end;
function GetStageFlag(FStage:DWORD):TVkShaderStageFlagBits;
begin
case FStage of
Vertex :Result:=VK_SHADER_STAGE_VERTEX_BIT;
TessellationControl :Result:=VK_SHADER_STAGE_TESSELLATION_CONTROL_BIT;
TessellationEvaluation:Result:=VK_SHADER_STAGE_TESSELLATION_EVALUATION_BIT;
Geometry :Result:=VK_SHADER_STAGE_GEOMETRY_BIT;
Fragment :Result:=VK_SHADER_STAGE_FRAGMENT_BIT;
GLCompute :Result:=VK_SHADER_STAGE_COMPUTE_BIT;
Kernel :Result:=VK_SHADER_STAGE_COMPUTE_BIT;
TaskNV :Result:=VK_SHADER_STAGE_TASK_BIT_NV;
MeshNV :Result:=VK_SHADER_STAGE_MESH_BIT_NV;
RayGenerationKHR :Result:=VK_SHADER_STAGE_RAYGEN_BIT_KHR;
IntersectionKHR :Result:=VK_SHADER_STAGE_INTERSECTION_BIT_KHR;
AnyHitKHR :Result:=VK_SHADER_STAGE_ANY_HIT_BIT_KHR;
ClosestHitKHR :Result:=VK_SHADER_STAGE_CLOSEST_HIT_BIT_KHR;
MissKHR :Result:=VK_SHADER_STAGE_MISS_BIT_KHR;
CallableKHR :Result:=VK_SHADER_STAGE_CALLABLE_BIT_KHR;
else
Result:=Default(TVkShaderStageFlagBits);
end;
end;
function find_pointer_type(data:Pointer;size:Ptruint;var id:DWORD):boolean;
var
I:TSPIRVInstruction;
f:Ptruint;
begin
Result:=false;
repeat
I:=PSPIRVInstruction(data)^;
if (I.OP=OpTypePointer) and (I.COUNT=4) then
if (PDWORD(data)[1]=id) then
begin
id:=PDWORD(data)[3];
Exit(true);
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
function find_type(data:Pointer;size:Ptruint;var id:DWORD):boolean;
var
I:TSPIRVInstruction;
f:Ptruint;
begin
Result:=false;
repeat
I:=PSPIRVInstruction(data)^;
Case I.OP of
OpTypeVoid ,
OpTypeBool ,
OpTypeInt ,
OpTypeFloat ,
OpTypeVector ,
OpTypeMatrix ,
OpTypeImage ,
OpTypeSampler ,
OpTypeSampledImage ,
OpTypeArray ,
OpTypeRuntimeArray ,
OpTypeStruct ,
OpTypeOpaque ,
OpTypePointer ,
OpTypeFunction ,
OpTypeEvent ,
OpTypeDeviceEvent ,
OpTypeReserveId ,
OpTypeQueue ,
OpTypePipe ,
OpTypeForwardPointer:
if (PDWORD(data)[1]=id) then
begin
id:=PDWORD(data)[3];
Exit(true);
end;
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
begin
if (size<=SizeOf(TSPIRVHeader)) then Exit;
if (PSPIRVHeader(data)^.MAGIC<>MagicNumber) then Exit;
data:=data+SizeOf(TSPIRVHeader);
size:=size-SizeOf(TSPIRVHeader);
orig_data:=data;
orig_size:=size;
repeat
I:=PSPIRVInstruction(data)^;
Case I.OP of
OpEntryPoint:
if (I.COUNT>=4) then
begin
FStage:=GetStageFlag(PDWORD(data)[1]);
FEntry:=PChar(@PDWORD(data)[3]);
end;
OpExecutionMode:
if (I.COUNT>=3) then
begin
d:=PDWORD(data)[2];
case d of
LocalSize:
if (I.COUNT>=6) then
begin
FLocalSize.x:=PDWORD(data)[3];
FLocalSize.y:=PDWORD(data)[4];
FLocalSize.z:=PDWORD(data)[5];
end;
end;
end;
OpDecorate:
if (I.COUNT>=4) then
begin
d:=PDWORD(data)[2];
case d of
Sample:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FSCLS:=Sample shl 16;
end;
Binding:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FBIND:=PDWORD(data)[3];
end;
DescriptorSet:
begin
r:=Fetch(PDWORD(data)[1]);
r^.FDSET:=PDWORD(data)[3];
end;
end;
end;
OpVariable:
if (I.COUNT>=4) then
begin
d:=PDWORD(data)[3];
case d of
UniformConstant,
Uniform,
Image,
StorageBuffer:
begin
r:=Fetch(PDWORD(data)[2]);
r^.FSCLS:=d;
d:=PDWORD(data)[1];
if find_pointer_type(orig_data,orig_size,d) then
if find_type(orig_data,orig_size,d) then
begin
r^.FTYPE:=d;
end;
end;
end;
end;
end;
if (I.COUNT=0) then I.COUNT:=1;
f:=I.COUNT*SizeOf(DWORD);
if (size<f) then Break;
data:=data+f;
size:=size-f;
until false;
end;
// =0,
// VK_DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER=1,
// VK_DESCRIPTOR_TYPE_SAMPLED_IMAGE=2,
// VK_DESCRIPTOR_TYPE_STORAGE_IMAGE=3,
// VK_DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER=4,
// VK_DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER=5,
// VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER=6,
// VK_DESCRIPTOR_TYPE_STORAGE_BUFFER=7,
// VK_DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC=8,
// VK_DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC=9,
// VK_DESCRIPTOR_TYPE_INPUT_ATTACHMENT=10,
// VK_DESCRIPTOR_TYPE_INLINE_UNIFORM_BLOCK_EXT=1000138000,
// VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_KHR=1000150000,
// VK_DESCRIPTOR_TYPE_ACCELERATION_STRUCTURE_NV=1000165000,
// VK_DESCRIPTOR_TYPE_MUTABLE_VALVE=1000351000
{
function TvShaderBind.GetSupportTypes:TvSupportDescriptorType;
begin
Result:=Default(TvSupportDescriptorType);
case FType of
Sample shl 16 :begin Result[0]:=VK_DESCRIPTOR_TYPE_SAMPLER; end;;
UniformConstant :begin Result[0]:=; end;;
Uniform :begin Result[0]:=; end;;
Workgroup :begin Result[0]:=; end;;
CrossWorkgroup :begin Result[0]:=; end;;
Image :begin Result[0]:=; end;;
StorageBuffer :begin Result[0]:=; end;;
end;
end;}
end.