pa/eqemu-server
2
0
Fork 0
mirror of https://github.com/EQEmu/Server.git synced 2026-06-20 17:58:20 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Add perlbind library

Browse Source
This commit is contained in:
hg
2022-04-09 19:54:38 -04:00
parent be00aa1b60
commit a2c6252c58
28 changed files with 2231 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
libs/perlbind/src/function.cpp
+15
View File
@@ -0,0 +1,15 @@
#include <perlbind/perlbind.h>
namespace perlbind { namespace detail {
extern "C" int gc(pTHX_ SV* sv, MAGIC* mg)
{
auto pfunc = INT2PTR(perlbind::detail::function_base*, SvIV(sv));
delete pfunc;
return 1;
}
const MGVTBL function_base::mgvtbl = { 0, 0, 0, 0, gc, 0, 0, 0 };
} // namespace detail
} // namespace perlbind
libs/perlbind/src/hash.cpp
+107
View File
@@ -0,0 +1,107 @@
#include <perlbind/perlbind.h>
#include <perlbind/iterator.h>
#include <stdexcept>
namespace perlbind {
hash::hash(scalar ref)
: type_base(ref.my_perl)
{
if (!ref.is_hash_ref())
throw std::runtime_error("cannot construct hash from non-hash reference");
reset(reinterpret_cast<HV*>(SvREFCNT_inc(*ref)));
}
hash::hash(scalar_proxy proxy)
: hash(scalar(SvREFCNT_inc(proxy.sv())))
{}
scalar hash::at(const char* key)
{
return at(key, strlen(key));
}
scalar hash::at(const std::string& key)
{
return at(key.c_str(), key.size());
}
scalar hash::at(const char* key, size_t size)
{
SV** sv = hv_fetch(m_hv, key, static_cast<I32>(size), 1);
return SvREFCNT_inc(*sv);
}
void hash::insert(const char* key, scalar value)
{
insert(key, strlen(key), value);
}
void hash::insert(const std::string& key, scalar value)
{
insert(key.c_str(), key.size(), value);
}
scalar_proxy hash::operator[](const std::string& key)
{
return scalar_proxy(my_perl, at(key.c_str(), key.size()));
}
hash::iterator hash::begin() const noexcept
{
hv_iterinit(m_hv);
return { my_perl, m_hv, hv_iternext(m_hv) };
}
hash::iterator hash::end() const noexcept
{
return { my_perl, m_hv, nullptr };
}
hash::iterator hash::find(const char* key)
{
return find(key, static_cast<I32>(strlen(key)));
}
hash::iterator hash::find(const std::string& key)
{
return find(key.c_str(), static_cast<I32>(key.size()));
}
hash::iterator hash::find(const char* key, size_t size)
{
// key sv made mortal with SVs_TEMP flag
SV* keysv = newSVpvn_flags(key, static_cast<I32>(size), SVs_TEMP);
HE* he = hv_fetch_ent(m_hv, keysv, 0, 0);
return { my_perl, m_hv, he };
}
void hash::insert(const char* key, size_t size, scalar value)
{
if (!hv_store(m_hv, key, static_cast<I32>(size), SvREFCNT_inc(value), 0))
{
SvREFCNT_dec(value);
}
}
HV* hash::copy_hash(HV* other) noexcept
{
HV* hv = newHV();
hv_iterinit(other);
while (HE* entry = hv_iternext(other))
{
size_t key_size;
auto key = HePV(entry, key_size);
auto value = newSVsv(HeVAL(entry));
if (!hv_store(hv, key, static_cast<I32>(key_size), value, HeHASH(entry)))
{
SvREFCNT_dec(value);
}
}
return hv;
}
} // namespace perlbind
libs/perlbind/src/interpreter.cpp
+98
View File
@@ -0,0 +1,98 @@
#include <perlbind/perlbind.h>
#include <fstream>
#include <sstream>
#include <stdexcept>
EXTERN_C
{
void boot_DynaLoader(pTHX_ CV* cv);
static void xs_init(pTHX)
{
newXS(const_cast<char*>("DynaLoader::boot_DynaLoader"), boot_DynaLoader, const_cast<char*>(__FILE__));
}
}
namespace perlbind {
interpreter::interpreter()
: m_is_owner(true)
{
const char* argv[] = { "", "-ew", "0", nullptr };
constexpr int argc = (sizeof(argv) / sizeof(*argv)) - 1;
init(argc, argv);
}
interpreter::interpreter(int argc, const char** argv)
: m_is_owner(true)
{
init(argc, argv);
}
void interpreter::init(int argc, const char** argv)
{
char** argvs = const_cast<char**>(argv);
char** env = { nullptr };
// PERL_SYS_INIT3 and PERL_SYS_TERM should only be called once per program
PERL_SYS_INIT3(&argc, &argvs, &env);
my_perl = perl_alloc();
PERL_SET_CONTEXT(my_perl);
PL_perl_destruct_level = 1;
perl_construct(my_perl);
perl_parse(my_perl, xs_init, argc, argvs, nullptr);
perl_run(my_perl);
}
interpreter::~interpreter()
{
if (m_is_owner)
{
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
}
void interpreter::load_script(std::string packagename, std::string filename)
{
struct stat st{};
if (stat(filename.c_str(), &st) != 0)
{
throw std::runtime_error("Unable to read perl file '" + filename + "'");
}
std::ifstream ifs(filename);
std::stringstream buffer;
buffer << "package " << packagename << "; " << ifs.rdbuf();
try
{
eval(buffer.str().c_str());
}
catch (std::exception& e)
{
throw std::runtime_error("Error loading script '" + filename + "':\n " + e.what());
}
}
void interpreter::eval(const char* str)
{
SV* sv = eval_pv(str, 0);
if (sv == &PL_sv_undef)
{
SV* err = get_sv("@", 0);
if (err && err->sv_u.svu_pv[0])
{
throw std::runtime_error(err->sv_u.svu_pv);
}
throw std::runtime_error("unknown error in eval()");
}
}
} // namespace perlbind
libs/perlbind/src/package.cpp
+88
View File
@@ -0,0 +1,88 @@
#include <perlbind/perlbind.h>
namespace perlbind {
namespace detail {
extern "C" void xsub(PerlInterpreter* my_perl, CV* cv);
} // namespace detail
void package::add_impl(const char* name, detail::function_base* function)
{
std::string export_name = m_name + "::" + name;
// the sv is assigned a magic metamethod table to delete the function
// object when perl frees the sv
SV* sv = newSViv(PTR2IV(function));
sv_magicext(sv, nullptr, PERL_MAGIC_ext, &detail::function_base::mgvtbl, nullptr, 0);
CV* cv = get_cv(export_name.c_str(), 0);
if (!cv)
{
cv = newXS(export_name.c_str(), &detail::xsub, __FILE__);
CvXSUBANY(cv).any_ptr = function;
}
else // function exists, remove target to search overloads when called
{
CvXSUBANY(cv).any_ptr = nullptr;
}
// create an array with same name to store overloads in the CV's GV
AV* av = GvAV(CvGV(cv));
if (!av)
{
av = get_av(export_name.c_str(), GV_ADD);
}
array overloads = reinterpret_cast<AV*>(SvREFCNT_inc(av));
overloads.push_back(sv); // giving only ref to GV array
}
extern "C" void detail::xsub(PerlInterpreter* my_perl, CV* cv)
{
// croak does not unwind so inner calls throw exceptions to prevent leaks
try
{
detail::xsub_stack stack(my_perl, cv);
auto target = static_cast<detail::function_base*>(CvXSUBANY(cv).any_ptr);
if (target)
{
return target->call(stack);
}
// find first compatible overload
AV* av = GvAV(CvGV(cv));
array functions = reinterpret_cast<AV*>(SvREFCNT_inc(av));
for (const auto& function : functions)
{
auto func = INT2PTR(detail::function_base*, SvIV(function.sv()));
if (func->is_compatible(stack))
{
return func->call(stack);
}
}
SV* err = newSVpvf("no overload of '%s' matched the %d argument(s):\n (%s)\ncandidates:\n ",
stack.name().c_str(), stack.size(), stack.types().c_str());
for (const auto& function : functions)
{
auto func = INT2PTR(detail::function_base*, SvIV(function.sv()));
Perl_sv_catpvf(aTHX_ err, "%s\n ", func->get_signature().c_str());
}
err = sv_2mortal(err);
throw std::runtime_error(SvPV_nolen(err));
}
catch (std::exception& e)
{
Perl_croak(aTHX_ "%s", e.what());
}
catch (...)
{
Perl_croak(aTHX_ "unhandled exception");
}
}
} // namespace perlbind
libs/perlbind/src/perlbind.natvis
+112
View File
@@ -0,0 +1,112 @@
<?xml version="1.0" encoding="utf-8"?>
<AutoVisualizer xmlns="http://schemas.microsoft.com/vstudio/debugger/natvis/2010">
<Type Name="perlbind::scalar">
<AlternativeType Name="perlbind::reference" />
<DisplayString>{{ m_sv={(void*)m_sv} refcnt={m_sv->sv_refcnt,d} type={(svtype)(m_sv->sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<ExpandedItem>m_sv</ExpandedItem>
</Expand>
</Type>
<Type Name="perlbind::array">
<DisplayString Condition="m_av != nullptr">{{ size={(m_av->sv_any)->xav_fill + 1,d} refcnt={m_av->sv_refcnt,d} }</DisplayString>
<Expand>
<ExpandedItem>m_av</ExpandedItem>
</Expand>
</Type>
<Type Name="perlbind::hash">
<DisplayString Condition="m_hv != nullptr">{{ size={(m_hv->sv_any)->xhv_keys,d} refcnt={m_hv->sv_refcnt,d} }}</DisplayString>
<Expand>
<ExpandedItem>m_hv</ExpandedItem>
</Expand>
</Type>
<Type Name="sv">
<AlternativeType Name="cv" />
<DisplayString>{{ refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[type]">(svtype)(sv_flags &amp; 0xff),d</Item>
<Item Name="[reference]" Condition="(sv_flags &amp; 0x00000800)">sv_u.svu_rv</Item>
<!-- SVt_PVAV -->
<Item Name="[array]" Condition="((svtype)(sv_flags &amp; 0xff)) == 11">(av*)this</Item>
<!-- SVt_PVHV -->
<Item Name="[hash]" Condition="((svtype)(sv_flags &amp; 0xff)) == 12">(hv*)this</Item>
<!-- SVt_PVGV -->
<Item Name="[glob]" Condition="((svtype)(sv_flags &amp; 0xff)) == 9">(gv*)this</Item>
<!-- SVt_PVMG -->
<Item Name="[magic]" Condition="((svtype)(sv_flags &amp; 0xff)) == 7">((XPVMG*)(sv_any))</Item>
<!--<ExpandedItem>sv_u</ExpandedItem>-->
<Item Name="svu_pv">sv_u.svu_pv,na</Item>
<Item Name="svu_iv">sv_u.svu_iv,i</Item>
<Item Name="svu_uv">sv_u.svu_uv</Item>
<Item Name="svu_nv">sv_u.svu_nv,f</Item>
<Item Name="svu_rv">sv_u.svu_rv</Item>
</Expand>
</Type>
<Type Name="av">
<!--
These might be dependent on perl version
#define AvARRAY(av) ((av)->sv_u.svu_array)
#define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc
#define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max
#define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill
-->
<DisplayString>{{ size={(sv_any)->xav_fill + 1,d} refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[size]">(sv_any)->xav_fill + 1</Item>
<Item Name="[capacity]">(sv_any)->xav_max</Item>
<ArrayItems>
<Size>(sv_any)->xav_fill + 1</Size>
<ValuePointer>(sv_u).svu_array</ValuePointer>
</ArrayItems>
</Expand>
</Type>
<Type Name="hv">
<!--
These might be dependent on perl version
SvANY(hv): (m_hv->sv_any)
HvMAX(hv): ((m_hv->sv_any)->xhv_max
HvARRAY(hv): ((m_hv->sv_u).svu_hash
HvAUX(hv): (xpvhv_aux*)&(((m_hv->sv_u)->svu_hash)[((m_hv->sv_any)->xhv_max + 1]
-->
<DisplayString>{{ size={(sv_any)->xhv_keys,d} refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[size]">(sv_any)->xhv_keys</Item>
<Item Name="[capacity]">(sv_any)->xhv_max</Item>
<CustomListItems MaxItemsPerView="5000">
<Variable Name="index" InitialValue="0"/>
<Variable Name="bucket_inc" InitialValue="0"/>
<Variable Name="max_index" InitialValue="(sv_any)->xhv_max"/>
<Variable Name="bucket_array" InitialValue="(sv_u).svu_hash"/>
<Variable Name="entry" InitialValue="(sv_u).svu_hash[0]"/>
<Loop>
<If Condition="entry == nullptr">
<Exec>index++</Exec>
<Exec>bucket_inc = __findnonnull(bucket_array + index, max_index - index)</Exec>
<Break Condition="bucket_inc == -1" />
<Exec>index += bucket_inc</Exec>
<Exec>entry = bucket_array[index]</Exec>
</If>
<Item Name="[{ (entry->hent_hek)->hek_key,na }]">(entry->he_valu).hent_val</Item>
<Exec>entry = entry->hent_next</Exec>
</Loop>
</CustomListItems>
</Expand>
</Type>
<Type Name="gv">
<DisplayString>{{ refcnt={sv_refcnt,d} type={(svtype)(sv_flags &amp; 0xff),d} }}</DisplayString>
<Expand>
<Item Name="[refcnt]">sv_refcnt,d</Item>
<Item Name="[type]">(svtype)(sv_flags &amp; 0xff),d</Item>
<Item Name="[sv]" Condition="(sv_u.svu_gp)->gp_sv != nullptr">(sv_u.svu_gp)->gp_sv</Item>
<Item Name="[cv]" Condition="(sv_u.svu_gp)->gp_cv != nullptr">(sv_u.svu_gp)->gp_cv</Item>
<Item Name="[array]" Condition="(sv_u.svu_gp)->gp_av != nullptr">(sv_u.svu_gp)->gp_av</Item>
<Item Name="[hash]" Condition="(sv_u.svu_gp)->gp_hv != nullptr">(sv_u.svu_gp)->gp_hv</Item>
<Item Name="svu_gp">(sv_u.svu_gp)</Item>
</Expand>
</Type>
</AutoVisualizer>