[Quest API] Use binding library for perl apis (#2216)

* Add perlbind library

* Convert perl apis to perlbind

libs/perlbind/include/perlbind/array.h

@@ -0,0 +1,119 @@
+#pragma once
+
+#include "types.h"
+#include "iterator.h"
+#include <stdexcept>
+
+namespace perlbind {
+
+struct array : public type_base
+{
+  using iterator = detail::array_iterator;
+
+  ~array() noexcept
+  {
+    SvREFCNT_dec(m_av);
+  }
+
+  array() noexcept
+    : type_base(), m_av(newAV()) {}
+  array(PerlInterpreter* interp) noexcept
+    : type_base(interp), m_av(newAV()) {}
+  array(const array& other) noexcept
+    : type_base(other.my_perl), m_av(copy_array(other.m_av)) {}
+  array(array&& other) noexcept
+    : type_base(other.my_perl), m_av(other.m_av)
+  {
+    other.m_av = newAV();
+  }
+  array(AV*& value) noexcept
+    : type_base(), m_av(copy_array(value)) {}
+  array(AV*&& value) noexcept
+    : type_base(), m_av(value) {} // take ownership
+  array(scalar ref)
+    : type_base(ref.my_perl)
+  {
+    if (!ref.is_array_ref())
+      throw std::runtime_error("cannot construct array from non-array reference");
+
+    reset(reinterpret_cast<AV*>(SvREFCNT_inc(*ref)));
+  }
+  array(scalar_proxy proxy)
+    : array(scalar(SvREFCNT_inc(proxy.sv()))) {}
+
+  array& operator=(const array& other) noexcept
+  {
+    if (this != &other)
+      m_av = copy_array(other.m_av);
+
+    return *this;
+  }
+
+  array& operator=(array&& other) noexcept
+  {
+    if (this != &other)
+      std::swap(m_av, other.m_av);
+
+    return *this;
+  }
+
+  array& operator=(AV*& value) noexcept
+  {
+    if (m_av != value)
+      m_av = copy_array(value);
+
+    return *this;
+  }
+
+  array& operator=(AV*&& value) noexcept
+  {
+    reset(value);
+    return *this;
+  }
+
+  operator AV*() const { return m_av; }
+  operator SV*() const { return reinterpret_cast<SV*>(m_av); }
+
+  AV* release() noexcept
+  {
+    AV* tmp = m_av;
+    m_av = newAV();
+    return tmp;
+  }
+
+  void reset(AV* value) noexcept
+  {
+    SvREFCNT_dec(m_av);
+    m_av = value;
+  }
+
+  void clear() noexcept               { av_clear(m_av); } // decreases refcnt of all SV elements
+  scalar pop_back() noexcept          { return av_pop(m_av); }
+  scalar pop_front() noexcept         { return av_shift(m_av); }
+  void push_back(const scalar& value) { av_push(m_av, newSVsv(value)); }
+  void push_back(scalar&& value)      { av_push(m_av, value.release()); }
+  void reserve(size_t count)          { av_extend(m_av, count > 0 ? count - 1 : 0); }
+  size_t size() const                 { return av_len(m_av) + 1; }
+  SV* sv() const                      { return reinterpret_cast<SV*>(m_av); }
+
+  // returns a proxy that takes ownership of one reference to the SV element
+  // extends the array and creates an undef SV if index out of range
+  scalar_proxy operator[](size_t index)
+  {
+    SV** sv = av_fetch(m_av, index, 1);
+    return scalar_proxy(my_perl, SvREFCNT_inc(*sv));
+  }
+
+  iterator begin() const noexcept { return { my_perl, m_av, 0 }; }
+  iterator end() const noexcept { return { my_perl, m_av, size() }; }
+
+private:
+  AV* copy_array(AV* other)
+  {
+    return av_make(av_len(other)+1, AvARRAY(other));
+  }
+
+  AV* m_av = nullptr;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/forward.h

@@ -0,0 +1,22 @@
+#pragma once
+
+namespace perlbind {
+
+namespace detail {
+
+class xsub_stack;
+struct function_base;
+struct array_iterator;
+struct hash_iterator;
+
+} // namespace detail
+
+class interpreter;
+class package;
+struct scalar;
+struct scalar_proxy;
+struct reference;
+struct array;
+struct hash;
+
+} // namespace perlbind

libs/perlbind/include/perlbind/function.h

@@ -0,0 +1,144 @@
+#pragma once
+
+namespace perlbind { namespace detail {
+
+// traits for function and class method exports
+template <typename Ret, typename Class, typename... Args>
+struct base_traits
+{
+  using return_t = Ret;
+  using sig_t = util::type_name<Args...>;
+  using stack_tuple = std::conditional_t<std::is_void<Class>::value,
+                                         std::tuple<Args...>,
+                                         std::tuple<Class*, Args...>>;
+  static constexpr int arity = sizeof...(Args);
+  static constexpr int stack_arity = sizeof...(Args) + (std::is_void<Class>::value ? 0 : 1);
+  static constexpr int vararg_count = count_of<array, Args...>::value +
+                                      count_of<hash, Args...>::value;
+  static constexpr bool is_vararg = vararg_count > 0;
+  static constexpr bool is_vararg_last = is_last<array, Args...>::value ||
+                                         is_last<hash, Args...>::value;
+
+  static_assert(!is_vararg || (vararg_count == 1 && is_vararg_last),
+    "A function may only accept a single array or hash and it must be "
+    "be the last parameter. Prefer using reference parameters instead.");
+};
+
+template <typename T, bool = std::is_class<T>::value>
+struct function_traits : public function_traits<decltype(&T::operator()), true> {};
+
+template <typename Ret, typename... Args>
+struct function_traits<Ret(*)(Args...), false> : base_traits<Ret, void, Args...>
+{
+  using type = Ret(*)(Args...);
+};
+
+template <typename Ret, typename Class, typename... Args>
+struct function_traits<Ret(Class::*)(Args...), false> : base_traits<Ret, Class, Args...>
+{
+  using type = Ret(Class::*)(Args...);
+};
+
+template <typename Ret, typename Class, typename... Args>
+struct function_traits<Ret(Class::*)(Args...) const, false> : base_traits<Ret, Class, Args...>
+{
+  using type = Ret(Class::*)(Args...) const;
+};
+
+template <typename Ret, typename Class, typename... Args>
+struct function_traits<Ret(Class::*)(Args...) const, true> : base_traits<Ret, void, Args...>
+{
+  using type = Ret(*)(Args...);
+};
+
+// represents a bound native function
+struct function_base
+{
+  virtual ~function_base() = default;
+  virtual std::string get_signature() const = 0;
+  virtual bool is_compatible(xsub_stack&) const = 0;
+  virtual void call(xsub_stack&) const = 0;
+
+  static const MGVTBL mgvtbl;
+};
+
+template <typename T>
+struct function : public function_base, function_traits<T>
+{
+  using target_t = typename function::type;
+  using return_t = typename function::return_t;
+
+  function() = delete;
+  function(PerlInterpreter* interp, T func)
+    : my_perl(interp), m_func(func) {}
+
+  std::string get_signature() const override
+  {
+    return util::type_name<target_t>::str();
+  };
+
+  bool is_compatible(xsub_stack& stack) const override
+  {
+    return function::is_vararg || stack.check_types(typename function::stack_tuple{});
+  }
+
+  void call(xsub_stack& stack) const override
+  {
+    if (!function::is_vararg && stack.size() != function::stack_arity)
+    {
+      using sig = typename function::sig_t;
+      int count = std::is_member_function_pointer<T>::value ? stack.size() - 1 : stack.size();
+      SV* err = newSVpvf("'%s(%s)' called with %d argument(s), expected %d\n argument(s): (%s)\n",
+                         stack.name().c_str(), sig::str().c_str(), count, function::arity, stack.types().c_str());
+      err = sv_2mortal(err);
+      throw std::runtime_error(SvPV_nolen(err));
+    }
+
+    call_impl(stack, std::is_void<function::return_t>());
+  }
+
+private:
+  void call_impl(xsub_stack& stack, std::false_type) const
+  {
+    return_t result = apply(m_func, stack.convert_stack(typename function::stack_tuple{}));
+    stack.push_return(std::move(result));
+  }
+
+  void call_impl(xsub_stack& stack, std::true_type) const
+  {
+    apply(m_func, stack.convert_stack(typename function::stack_tuple{}));
+  }
+
+  // c++14 call function template with tuple arg unpacking (c++17 can use std::apply())
+  template <typename F, typename Tuple, size_t... I>
+  auto call_func(F func, Tuple&& t, std::index_sequence<I...>) const
+  {
+    return func(std::get<I>(std::forward<Tuple>(t))...);
+  }
+
+  template <typename F, typename Tuple, size_t... I>
+  auto call_member(F method, Tuple&& t, std::index_sequence<I...>) const
+  {
+    return (std::get<0>(t)->*method)(std::get<I + 1>(std::forward<Tuple>(t))...);
+  }
+
+  template <typename F, typename Tuple, std::enable_if_t<!std::is_member_function_pointer<F>::value, bool> = true>
+  auto apply(F func, Tuple&& t) const
+  {
+    using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value>;
+    return call_func(func, std::forward<Tuple>(t), make_sequence{});
+  }
+
+  template <typename F, typename Tuple, std::enable_if_t<std::is_member_function_pointer<F>::value, bool> = true>
+  auto apply(F func, Tuple&& t) const
+  {
+    using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value - 1>;
+    return call_member(func, std::forward<Tuple>(t), make_sequence{});
+  }
+
+  PerlInterpreter* my_perl = nullptr;
+  T m_func;
+};
+
+} // namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/hash.h

@@ -0,0 +1,124 @@
+#pragma once
+
+#include "types.h"
+#include <string>
+
+namespace perlbind {
+
+struct hash : public type_base
+{
+  using iterator = detail::hash_iterator;
+
+  ~hash() noexcept
+  {
+    SvREFCNT_dec(m_hv);
+  }
+
+  hash() noexcept
+    : type_base(), m_hv(newHV()) {}
+  hash(PerlInterpreter* interp) noexcept
+    : type_base(interp), m_hv(newHV()) {}
+  hash(const hash& other) noexcept
+    : type_base(other.my_perl), m_hv(copy_hash(other.m_hv)) {}
+  hash(hash&& other) noexcept
+    : type_base(other.my_perl), m_hv(other.m_hv)
+  {
+    other.m_hv = newHV();
+  }
+  hash(HV*& value) noexcept
+    : type_base(), m_hv(copy_hash(value)) {}
+  hash(HV*&& value) noexcept
+    : type_base(), m_hv(value) {} // take ownership
+  hash(scalar ref);
+  hash(scalar_proxy proxy);
+
+  hash& operator=(const hash& other) noexcept
+  {
+    if (this != &other)
+      m_hv = copy_hash(other.m_hv);
+
+    return *this;
+  }
+
+  hash& operator=(hash&& other) noexcept
+  {
+    if (this != &other)
+      std::swap(m_hv, other.m_hv);
+
+    return *this;
+  }
+
+  hash& operator=(HV*& value) noexcept
+  {
+    if (m_hv != value)
+      m_hv = copy_hash(value);
+
+    return *this;
+  }
+
+  hash& operator=(HV*&& value) noexcept
+  {
+    reset(value);
+    return *this;
+  }
+
+  operator HV*() const { return m_hv; }
+  operator SV*() const { return reinterpret_cast<SV*>(m_hv); }
+
+  HV* release() noexcept
+  {
+    HV* tmp = m_hv;
+    m_hv = newHV();
+    return tmp;
+  }
+
+  void reset(HV* value) noexcept
+  {
+    SvREFCNT_dec(m_hv);
+    m_hv = value;
+  }
+
+  scalar at(const char* key);
+  scalar at(const std::string& key);
+  void clear() noexcept { hv_clear(m_hv); }
+  bool exists(const char* key) const
+  {
+    return hv_exists(m_hv, key, static_cast<I32>(strlen(key)));
+  }
+  bool exists(const std::string& key) const
+  {
+    return hv_exists(m_hv, key.c_str(), static_cast<I32>(key.size()));
+  }
+  void insert(const char* key, scalar value);
+  void insert(const std::string& key, scalar value);
+  void remove(const char* key)
+  {
+    hv_delete(m_hv, key, static_cast<I32>(strlen(key)), 0);
+  }
+  void remove(const std::string& key)
+  {
+    hv_delete(m_hv, key.c_str(), static_cast<I32>(key.size()), 0);
+  }
+  size_t size() const { return HvTOTALKEYS(m_hv); }
+  SV* sv() const { return reinterpret_cast<SV*>(m_hv); }
+
+  // returns a proxy that takes ownership of one reference to the SV value
+  // creates an undef SV entry for the key if it doesn't exist
+  scalar_proxy operator[](const std::string& key);
+
+  iterator begin() const noexcept;
+  iterator end() const noexcept;
+  iterator find(const char* key);
+  iterator find(const std::string& key);
+
+private:
+  scalar at(const char* key, size_t size);
+  iterator find(const char* key, size_t size);
+  void insert(const char* key, size_t size, scalar value);
+
+  HV* copy_hash(HV* other) noexcept;
+
+  HV* m_hv = nullptr;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/interpreter.h

@@ -0,0 +1,63 @@
+#pragma once
+
+namespace perlbind {
+
+class interpreter
+{
+public:
+  interpreter();
+  interpreter(PerlInterpreter* interp) : my_perl(interp) {}
+  interpreter(int argc, const char** argv);
+  interpreter(const interpreter& other) = delete;
+  interpreter(interpreter&& other) = delete;
+  interpreter& operator=(const interpreter& other) = delete;
+  interpreter& operator=(interpreter&& other) = delete;
+  ~interpreter();
+
+  PerlInterpreter* get() const { return my_perl; }
+
+  void load_script(std::string packagename, std::string filename);
+  void eval(const char* str);
+
+  template <typename T, typename... Args>
+  T call_sub(const char* subname, Args&&... args) const
+  {
+    detail::sub_caller caller(my_perl);
+    return caller.call_sub<T>(subname, std::forward<Args>(args)...);
+  }
+
+  // returns interface to add bindings to package name
+  package new_package(const char* name)
+  {
+    return package(my_perl, name);
+  }
+
+  // registers type for blessing objects, returns interface
+  template <typename T>
+  class_<T> new_class(const char* name)
+  {
+    static_assert(!std::is_pointer<T>::value && !std::is_reference<T>::value,
+                  "new_class<T> 'T' should not be a pointer or reference");
+
+    auto typemap = detail::typemap::get(my_perl);
+    auto type_id = detail::usertype<T*>::id();
+    typemap[type_id] = name;
+
+    return class_<T>(my_perl, name);
+  }
+
+  // helper to bind functions in default main:: package
+  template <typename T>
+  void add(const char* name, T&& func)
+  {
+    new_package("main").add(name, std::forward<T>(func));
+  }
+
+private:
+  void init(int argc, const char** argv);
+
+  bool m_is_owner = false;
+  PerlInterpreter* my_perl = nullptr;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/iterator.h

@@ -0,0 +1,100 @@
+#pragma once
+
+namespace perlbind { namespace detail {
+
+struct array_iterator
+{
+  array_iterator() = default;
+  array_iterator(PerlInterpreter* interp, AV* av, size_t index)
+    : my_perl(interp), m_av(av), m_index(index), m_scalar(interp)
+  {
+    fetch();
+  }
+
+  bool operator!=(const array_iterator& other) const
+  {
+    return m_index != other.m_index;
+  }
+
+  array_iterator& operator++()
+  {
+    ++m_index;
+    fetch();
+    return *this;
+  }
+
+  scalar* operator->()
+  {
+    return &m_scalar;
+  }
+
+  scalar& operator*()
+  {
+    return m_scalar;
+  }
+
+private:
+  void fetch()
+  {
+    SV** sv = av_fetch(m_av, m_index, 0);
+    if (sv)
+      m_scalar = SvREFCNT_inc(*sv);
+  }
+
+  PerlInterpreter* my_perl;
+  AV* m_av;
+  size_t m_index;
+  scalar m_scalar;
+};
+
+struct hash_iterator
+{
+  hash_iterator() = default;
+  hash_iterator(PerlInterpreter* interp, HV* hv, HE* he)
+    : my_perl(interp), m_hv(hv), m_he(he)
+  {
+    fetch();
+  }
+
+  bool operator==(const hash_iterator& other) const
+  {
+    return m_he == other.m_he;
+  }
+
+  bool operator!=(const hash_iterator& other) const
+  {
+    return !(*this == other);
+  }
+
+  hash_iterator& operator++()
+  {
+    m_he = hv_iternext(m_hv);
+    fetch();
+    return *this;
+  }
+
+  std::pair<const char*, scalar>* operator->()
+  {
+    return &m_pair;
+  }
+
+  std::pair<const char*, scalar>& operator*()
+  {
+    return m_pair;
+  }
+
+private:
+  void fetch()
+  {
+    if (m_he)
+      m_pair = { HePV(m_he, PL_na), scalar(my_perl, SvREFCNT_inc(HeVAL(m_he))) };
+  }
+
+  PerlInterpreter* my_perl;
+  HV* m_hv;
+  HE* m_he;
+  std::pair<const char*, scalar> m_pair;
+};
+
+} // namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/package.h

@@ -0,0 +1,59 @@
+#pragma once
+
+#include <string>
+
+namespace perlbind {
+
+class package
+{
+public:
+  virtual ~package() = default;
+  package() = delete;
+  package(PerlInterpreter* interp, const char* name)
+    : my_perl(interp), m_name(name), m_stash(gv_stashpv(name, GV_ADD))
+  {}
+
+  // bind a function pointer to a function name in the package
+  // overloads with same name must be explicit (default parameters not supported)
+  // overloads have a runtime lookup cost and chooses the first compatible overload
+  template <typename T>
+  void add(const char* name, T func)
+  {
+    // ownership of function object is given to perl
+    auto function = new detail::function<T>(my_perl, func);
+    add_impl(name, static_cast<detail::function_base*>(function));
+  }
+
+  // specify a base class name for object inheritance (must be registered)
+  // calling object methods missing from the package will search parent classes
+  // base classes are searched in registered order and include any grandparents
+  void add_base_class(const char* name)
+  {
+    std::string package_isa = m_name + "::ISA";
+    AV* av = get_av(package_isa.c_str(), GV_ADD);
+    array isa_array = reinterpret_cast<AV*>(SvREFCNT_inc(av));
+    isa_array.push_back(name);
+  }
+
+  // add a constant value to this package namespace
+  template <typename T>
+  void add_const(const char* name, T&& value)
+  {
+    newCONSTSUB(m_stash, name, scalar(value).release());
+  }
+
+private:
+  void add_impl(const char* name, detail::function_base* function);
+
+  std::string m_name;
+  PerlInterpreter* my_perl = nullptr;
+  HV* m_stash = nullptr;
+};
+
+template <typename T>
+struct class_ : public package
+{
+  using package::package;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/perlbind.h

@@ -0,0 +1,55 @@
+#pragma once
+
+// Defining PERLBIND_STRICT_NUMERIC_TYPES will enable strict type checks
+// for integers and floats.This is required for overloads that depend on
+// int and float type differences.
+// #define PERLBIND_STRICT_NUMERIC_TYPES
+
+// Defining PERLBIND_NO_STRICT_SCALAR_TYPES will disable strict type checks
+// for all int, float, and string function arguments. These types will only
+// be checked for scalar validity and converted to the function's expected
+// paramter type. This will break overloads that depend on distinct types.
+// This option overrides PERLBIND_STRICT_NUMERIC_TYPES.
+//#define PERLBIND_NO_STRICT_SCALAR_TYPES
+
+// defining PERL_NO_GET_CONTEXT gets context from local variable "my_perl"
+// instead of calling Perl_get_context() in macros
+#define PERL_NO_GET_CONTEXT
+
+#define WIN32IO_IS_STDIO
+#if _MSC_VER
+#define __inline__ __inline
+// perl 5.30+ defines HAS_BUILTIN_EXPECT for msvc which breaks builds
+#define __builtin_expect(expr,val) (expr)
+// avoid INT64_C and UINT64_C redefinition warnings
+#if PERL_VERSION < 28
+#include <cstdint>
+#endif
+#endif
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+// short name perl macros that cause issues
+#undef Move
+#undef Copy
+#undef Zero
+#undef list
+#undef seed
+#undef do_open
+#undef do_close
+
+#include <perlbind/version.h>
+#include <perlbind/forward.h>
+#include <perlbind/util.h>
+#include <perlbind/traits.h>
+#include <perlbind/hash.h>
+#include <perlbind/typemap.h>
+#include <perlbind/scalar.h>
+#include <perlbind/array.h>
+#include <perlbind/stack.h>
+#include <perlbind/subcaller.h>
+#include <perlbind/function.h>
+#include <perlbind/package.h>
+#include <perlbind/interpreter.h>

libs/perlbind/include/perlbind/scalar.h

@@ -0,0 +1,254 @@
+#pragma once
+
+#include "types.h"
+#include <string>
+#include <type_traits>
+
+namespace perlbind {
+
+struct scalar : type_base
+{
+  virtual ~scalar() noexcept
+  {
+    SvREFCNT_dec(m_sv);
+  }
+
+  scalar() noexcept
+    : type_base(), m_sv(newSV(0)) {} // nothing allocated
+  scalar(PerlInterpreter* interp) noexcept
+    : type_base(interp), m_sv(newSV(0)) {}
+  scalar(PerlInterpreter* interp, SV*&& sv) noexcept
+    : type_base(interp), m_sv(sv) {}
+  scalar(const scalar& other) noexcept
+    : type_base(other.my_perl), m_sv(newSVsv(other.m_sv)) {}
+  scalar(scalar&& other) noexcept
+    : type_base(other.my_perl), m_sv(other.m_sv)
+  {
+    other.m_sv = newSV(0);
+  }
+  scalar(SV*& value) noexcept
+    : type_base(), m_sv(newSVsv(value)) {}
+  scalar(SV*&& value) noexcept
+    : type_base(), m_sv(value) {}
+  scalar(const char* value) noexcept
+    : type_base(), m_sv(newSVpv(value, 0)) {}
+  scalar(const std::string& value) noexcept
+    : type_base(), m_sv(newSVpvn(value.c_str(), value.size())) {}
+
+  template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
+  scalar(T value) noexcept : type_base(), m_sv(newSViv(static_cast<IV>(value))) {}
+
+  template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
+  scalar(T value) noexcept : type_base(), m_sv(newSVuv(value)) {}
+
+  template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
+  scalar(T value) noexcept : type_base(), m_sv(newSVnv(value)) {}
+
+  template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
+  scalar(T value) noexcept : type_base(), m_sv(newSV(0))
+  {
+    *this = std::move(value);
+  }
+
+  scalar& operator=(const scalar& other) noexcept
+  {
+    if (this != &other)
+      sv_setsv(m_sv, other.m_sv);
+
+    return *this;
+  }
+
+  scalar& operator=(scalar&& other) noexcept
+  {
+    if (this != &other)
+      std::swap(m_sv, other.m_sv);
+
+    return *this;
+  }
+
+  scalar& operator=(SV*& value) noexcept
+  {
+    sv_setsv(m_sv, value);
+    return *this;
+  }
+
+  scalar& operator=(SV*&& value) noexcept
+  {
+    reset(value);
+    return *this;
+  }
+
+  scalar& operator=(const char* value) noexcept
+  {
+    sv_setpv(m_sv, value);
+    return *this;
+  }
+
+  scalar& operator=(const std::string& value) noexcept
+  {
+    sv_setpvn(m_sv, value.c_str(), value.size());
+    return *this;
+  }
+
+  template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
+  scalar& operator=(T value) noexcept
+  {
+    sv_setiv(m_sv, static_cast<IV>(value));
+    return *this;
+  }
+
+  template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
+  scalar& operator=(T value) noexcept
+  {
+    sv_setuv(m_sv, value);
+    return *this;
+  }
+
+  template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
+  scalar& operator=(T value) noexcept
+  {
+    sv_setnv(m_sv, value);
+    return *this;
+  }
+
+  template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
+  scalar& operator=(T value) noexcept
+  {
+    // bless if it's in the typemap
+    const char* type_name = detail::typemap::template get_name<T>(my_perl);
+    sv_setref_pv(m_sv, type_name, static_cast<void*>(value));
+    return *this;
+  }
+
+  operator SV*() const { return m_sv; }
+  operator void*() const { return m_sv; }
+  operator const char*() const { return SvPV_nolen(m_sv); }
+  operator std::string() const { return SvPV_nolen(m_sv); }
+  template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
+  operator T() const { return static_cast<T>(SvIV(m_sv)); }
+  template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
+  operator T() const { return static_cast<T>(SvUV(m_sv)); }
+  template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
+  operator T() const { return static_cast<T>(SvNV(m_sv)); }
+  template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
+  operator T() const
+  {
+    const char* type_name = detail::typemap::template get_name<T>(my_perl);
+    if (type_name && sv_isobject(m_sv) && sv_derived_from(m_sv, type_name))
+    {
+      IV tmp = SvIV(SvRV(m_sv));
+      return INT2PTR(T, tmp);
+    }
+    return nullptr;
+  }
+
+  template <typename T>
+  T as() const { return static_cast<T>(*this); }
+
+  // release ownership of SV
+  SV* release() noexcept
+  {
+    SV* tmp = m_sv;
+    m_sv = newSV(0);
+    return tmp;
+  }
+  // take ownership of an SV
+  void reset(SV* value) noexcept
+  {
+    SvREFCNT_dec(m_sv);
+    m_sv = value;
+  }
+
+  SV* sv()      const { return m_sv; }
+  SV* deref()   const { return SvRV(m_sv); }
+  size_t size() const { return SvPOK(m_sv) ? sv_len(m_sv) : 0; }
+  svtype type() const { return SvTYPE(m_sv); }
+  const char* c_str() const { return SvPV_nolen(m_sv); }
+
+  SV* operator*() { return SvRV(m_sv); }
+
+  bool is_null()       const { return type() == SVt_NULL; } //SvOK(m_sv)
+  bool is_integer()    const { return SvIOK(m_sv); }
+  bool is_float()      const { return SvNOK(m_sv); }
+  bool is_string()     const { return SvPOK(m_sv); }
+  bool is_reference()  const { return SvROK(m_sv); }
+  bool is_scalar_ref() const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) < SVt_PVAV; }
+  bool is_array_ref()  const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) == SVt_PVAV; }
+  bool is_hash_ref()   const { return SvROK(m_sv) && SvTYPE(SvRV(m_sv)) == SVt_PVHV; }
+
+protected:
+  SV* m_sv = nullptr;
+};
+
+// references are scalars that take ownership of one new reference to a value
+// use reset() to take ownership of an existing RV
+struct reference  : public scalar
+{
+  reference() = default;
+
+  template <typename T, std::enable_if_t<std::is_base_of<type_base, T>::value, bool> = true>
+  reference(T& value) noexcept : scalar(value.my_perl, nullptr) { m_sv = newRV_inc(value); }
+
+  // increments referent for rvalues of scalar objects (not raw SVs) since they dec on destruct
+  template <typename T, std::enable_if_t<std::is_base_of<type_base, T>::value, bool> = true>
+  reference(T&& value) noexcept : scalar(value.my_perl, nullptr) { m_sv = newRV_inc(value); }
+
+  template <typename T, std::enable_if_t<detail::is_any<T, SV*, AV*, HV*>::value, bool> = true>
+  reference(T& value) noexcept { reset(newRV_inc(reinterpret_cast<SV*>(value))); }
+
+  template <typename T, std::enable_if_t<detail::is_any<T, SV*, AV*, HV*>::value, bool> = true>
+  reference(T&& value) noexcept { reset(newRV_noinc(reinterpret_cast<SV*>(value))); }
+
+  SV* operator*() { return SvRV(m_sv); }
+};
+
+// scalar proxy reference is used for array and hash index operator[] overloads
+struct scalar_proxy
+{
+  scalar_proxy() = delete;
+  scalar_proxy(PerlInterpreter* interp, scalar&& value) noexcept
+    : my_perl(interp), m_value(std::move(value)) {}
+
+  SV* sv() const { return m_value; }
+  const char* c_str() const { return static_cast<const char*>(m_value); }
+
+  template <typename T>
+  T as() const { return m_value.as<T>(); }
+
+  operator std::string() const { return m_value; }
+
+  // copying value to supported conversion types (e.g. int val = arr[i])
+  template <typename T, std::enable_if_t<!std::is_base_of<type_base, T>::value, bool> = true>
+  operator T() const
+  {
+    return static_cast<T>(m_value);
+  }
+
+  // taking a reference to the source SV (e.g. scalar val = arr[i])
+  template <typename T, std::enable_if_t<std::is_same<T, scalar>::value, bool> = true>
+  operator T() const
+  {
+    return SvREFCNT_inc(m_value);
+  }
+
+  // assigning scalar to proxy, the source SV is modified (arr[i] = "new value")
+  scalar_proxy& operator=(scalar value)
+  {
+    m_value = value;
+    return *this;
+  }
+
+  scalar_proxy& operator=(const scalar_proxy& other)
+  {
+    m_value = other.m_value;
+    return *this;
+  }
+
+  // todo: nested proxy[]
+
+private:
+  PerlInterpreter* my_perl = nullptr;
+  scalar m_value;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/stack.h

@@ -0,0 +1,137 @@
+#pragma once
+
+#include "stack_push.h"
+#include "stack_read.h"
+#include <algorithm>
+#include <string>
+#include <tuple>
+
+namespace perlbind { namespace detail {
+
+// handles xsub call stack from perl, inherits stack::pusher to push return values
+class xsub_stack : public stack::pusher
+{
+public:
+  xsub_stack() = delete;
+  xsub_stack(PerlInterpreter* my_perl, CV* cv)
+    : stack::pusher(my_perl)
+  {
+    GV* gv = CvGV(cv);
+    m_sub_name = GvNAME(gv);
+    m_pkg_name = HvNAME(GvSTASH(gv));
+
+    dXSARGS;
+    this->sp = sp;
+    this->ax = ax;
+    this->mark = mark;
+    this->items = items;
+  }
+  ~xsub_stack() { XSRETURN(m_pushed); }
+
+  int size() const { return items; }
+  std::string name() const { return std::string(pkg_name()) + "::" + sub_name(); }
+  const char* pkg_name() const { return m_pkg_name; }
+  const char* sub_name() const { return m_sub_name; }
+
+  template <typename T>
+  void push_return(T&& value)
+  {
+    XSprePUSH;
+    push(std::forward<T>(value));
+  }
+
+  // returns true if all perl stack arguments are compatible with expected native arg types
+  template <typename Tuple>
+  bool check_types(Tuple&& types)
+  {
+    static constexpr int count = std::tuple_size<Tuple>::value;
+    if (items != count)
+      return false;
+    else if (count == 0)
+      return true;
+
+    using make_sequence = std::make_index_sequence<count>;
+    return check_stack(std::forward<Tuple>(types), make_sequence());
+  }
+
+  // returns tuple of converted perl stack arguments, throws on an incompatible type
+  template <typename Tuple>
+  auto convert_stack(Tuple&& types)
+  {
+    using make_sequence = std::make_index_sequence<std::tuple_size<Tuple>::value>;
+    return get_stack(std::forward<Tuple>(types), make_sequence());
+  }
+
+  std::string types()
+  {
+    std::string args;
+    for (int i = 0; i < items; ++i)
+    {
+      args += get_type_name(ST(i));
+      if (i < (items - 1))
+        args += ", ";
+    }
+    return args.empty() ? "void" : args;
+  }
+
+protected:
+  int ax = 0;
+  int items = 0;
+  SV** mark = nullptr;
+  const char* m_pkg_name = nullptr;
+  const char* m_sub_name = nullptr;
+
+  std::string get_type_name(SV* item)
+  {
+    switch (SvTYPE(item))
+    {
+    case SVt_NULL: return "<undefined>";
+    case SVt_NV:   return "double";
+    case SVt_PV:   return "string";
+    case SVt_PVAV: return "array";
+    case SVt_PVHV: return "hash";
+    case SVt_IV:
+      if (sv_isobject(item))
+        return std::string(sv_reftype(SvRV(item), true)) + "*";
+      else if (SvROK(item))
+        return "ref";
+      else
+        return "int";
+    default:
+      return sv_reftype(item, true);
+    }
+  }
+
+private:
+  template <typename T>
+  bool check_index(T t, size_t index)
+  {
+    return stack::read_as<T>::check(my_perl, static_cast<int>(index), ax, items);
+  }
+
+  // return true if perl stack matches all expected argument types in tuple
+  template <typename Tuple, size_t... I>
+  bool check_stack(Tuple&& t, std::index_sequence<I...>)
+  {
+    // lists compatibility of each expected arg type (no short-circuit)
+    std::initializer_list<bool> res = {
+      check_index(std::get<I>(std::forward<Tuple>(t)), I)... };
+
+    return std::all_of(res.begin(), res.end(), [](bool same) { return same; });
+  }
+
+  template <typename T>
+  T get_stack_index(T t, size_t index)
+  {
+    return stack::read_as<T>::get(my_perl, static_cast<int>(index), ax, items);
+  }
+
+  template <typename Tuple, size_t... I>
+  auto get_stack(Tuple&& t, std::index_sequence<I...>)
+  {
+    return Tuple{ get_stack_index(std::get<I>(std::forward<Tuple>(t)), I)... };
+  }
+};
+
+} // namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/stack_push.h

@@ -0,0 +1,118 @@
+#pragma once
+
+#include <string>
+
+namespace perlbind { namespace stack {
+
+// base class for pushing value types to perl stack
+// methods use macros that push new mortalized SVs but do not extend the stack
+// the stack is only extended when pushing an array, hash, or using push_args().
+// this is because for xsubs the "stack is always large enough to take one return value"
+struct pusher
+{
+  virtual ~pusher() = default;
+
+  pusher() = delete;
+  pusher(PerlInterpreter* interp) : my_perl(interp), sp(PL_stack_sp) {}
+
+  SV* pop() { return POPs; }
+
+  void push(bool value) { PUSHs(boolSV(value)); ++m_pushed; }
+  void push(const char* value)
+  {
+    if (!value)
+      PUSHs(&PL_sv_undef);
+    else
+      mPUSHp(value, strlen(value));
+
+    ++m_pushed;
+  }
+  void push(const std::string& value) { mPUSHp(value.c_str(), value.size()); ++m_pushed; }
+  void push(scalar value) { mPUSHs(value.release()); ++m_pushed; };
+  void push(reference value) { mPUSHs(value.release()); ++m_pushed; };
+
+  void push(array value)
+  {
+    int count = static_cast<int>(value.size());
+    EXTEND(sp, count);
+    for (int i = 0; i < count; ++i)
+    {
+      // mortalizes one reference to array element to avoid copying
+      PUSHs(sv_2mortal(SvREFCNT_inc(value[i].sv())));
+    }
+    m_pushed += count;
+  }
+
+  void push(hash value)
+  {
+    // hashes are pushed to the perl stack as alternating keys and values
+    // this is less efficient than pushing a reference to the hash
+    auto count = hv_iterinit(value) * 2;
+    EXTEND(sp, count);
+    while (HE* entry = hv_iternext(value))
+    {
+      auto val = HeVAL(entry);
+      PUSHs(hv_iterkeysv(entry)); // mortalizes new key sv (keys are not stored as sv)
+      PUSHs(sv_2mortal(SvREFCNT_inc(val)));
+    }
+    m_pushed += count;
+  }
+
+  template <typename T, std::enable_if_t<detail::is_signed_integral_or_enum<T>::value, bool> = true>
+  void push(T value) { mPUSHi(static_cast<IV>(value)); ++m_pushed; }
+
+  template <typename T, std::enable_if_t<std::is_unsigned<T>::value, bool> = true>
+  void push(T value) { mPUSHu(value); ++m_pushed; }
+
+  template <typename T, std::enable_if_t<std::is_floating_point<T>::value, bool> = true>
+  void push(T value) { mPUSHn(value); ++m_pushed; }
+
+  template <typename T, std::enable_if_t<std::is_pointer<T>::value, bool> = true>
+  void push(T value)
+  {
+    const char* type_name = detail::typemap::get_name<T>(my_perl);
+    if (!type_name)
+    {
+      throw std::runtime_error("cannot push unregistered pointer of type '" + util::type_name<T>::str() + "'");
+    }
+
+    SV* sv = sv_newmortal();
+    sv_setref_pv(sv, type_name, static_cast<void*>(value));
+    PUSHs(sv);
+    ++m_pushed;
+  };
+
+  void push(void* value)
+  {
+    SV* sv = sv_newmortal();
+    sv_setref_pv(sv, nullptr, value); // unblessed
+    PUSHs(sv);
+    ++m_pushed;
+  }
+
+  template <typename... Args>
+  void push_args(Args&&... args)
+  {
+    EXTEND(sp, sizeof...(Args));
+    push_args_impl(std::forward<Args>(args)...);
+  };
+
+protected:
+  PerlInterpreter* my_perl = nullptr;
+  SV** sp = nullptr;
+  int m_pushed = 0;
+
+private:
+  template <typename... Args>
+  void push_args_impl(Args&&... args) {}
+
+  template <typename T, typename... Args>
+  void push_args_impl(T&& value, Args&&... args)
+  {
+    push(std::forward<T>(value));
+    push_args_impl(std::forward<Args>(args)...);
+  }
+};
+
+} // namespace stack
+} // namespace perlbind

libs/perlbind/include/perlbind/stack_read.h

@@ -0,0 +1,266 @@
+#pragma once
+
+#include <string>
+
+namespace perlbind { namespace stack {
+
+// perl stack reader to convert types, throws if perl stack value isn't type compatible
+template <typename T, typename = void>
+struct read_as;
+
+template <typename T>
+struct read_as<T, std::enable_if_t<std::is_integral<T>::value || std::is_enum<T>::value>>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
+    return SvTYPE(ST(i)) < SVt_PVAV;
+#elif !defined PERLBIND_STRICT_NUMERIC_TYPES
+    return SvNIOK(ST(i));
+#else
+    return SvIOK(ST(i));
+#endif
+  }
+
+  static T get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be an integer");
+    }
+    return static_cast<T>(SvIV(ST(i))); // unsigned and bools casted
+  }
+};
+
+template <typename T>
+struct read_as<T, std::enable_if_t<std::is_floating_point<T>::value>>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
+    return SvTYPE(ST(i)) < SVt_PVAV;
+#elif !defined PERLBIND_STRICT_NUMERIC_TYPES
+    return SvNIOK(ST(i));
+#else
+    return SvNOK(ST(i));
+#endif
+  }
+
+  static T get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a floating point");
+    }
+    return static_cast<T>(SvNV(ST(i)));
+  }
+};
+
+template <>
+struct read_as<const char*>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+#ifdef PERLBIND_NO_STRICT_SCALAR_TYPES
+    return SvTYPE(ST(i)) < SVt_PVAV;
+#else
+    return SvPOK(ST(i));
+#endif
+  }
+
+  static const char* get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a string");
+    }
+    return static_cast<const char*>(SvPV_nolen(ST(i)));
+  }
+};
+
+template <>
+struct read_as<std::string> : read_as<const char*>
+{
+};
+
+template <>
+struct read_as<void*>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return sv_isobject(ST(i));
+  }
+
+  static void* get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an object");
+    }
+
+    IV tmp = SvIV(SvRV(ST(i)));
+    return INT2PTR(void*, tmp);
+  }
+};
+
+template <typename T>
+struct read_as<T, std::enable_if_t<std::is_pointer<T>::value>>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    const char* type_name = detail::typemap::get_name<T>(my_perl);
+    return type_name && sv_isobject(ST(i)) && sv_derived_from(ST(i), type_name);
+  }
+
+  static T get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      // would prefer to check for unregistered types at compile time (not possible?)
+      const char* type_name = detail::typemap::get_name<T>(my_perl);
+      if (!type_name)
+      {
+        throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an unregistered type (method unusable)");
+      }
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference to an object of type '" + type_name + "'");
+    }
+
+    IV tmp = SvIV(SvRV(ST(i)));
+    return INT2PTR(T, tmp);
+  }
+};
+
+template <typename T>
+struct read_as<nullable<T>>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return true;
+  }
+
+  static nullable<T> get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (sv_isobject(ST(i)))
+    {
+      const char* type_name = detail::typemap::get_name<T>(my_perl);
+      if (type_name && sv_derived_from(ST(i), type_name))
+      {
+        IV tmp = SvIV(SvRV(ST(i)));
+        return INT2PTR(T, tmp);
+      }
+    }
+    return nullptr;
+  }
+};
+
+template <>
+struct read_as<SV*>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return i < items;
+  }
+
+  static SV* get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be valid scalar value");
+    }
+    return ST(i);
+  }
+};
+
+// scalar, array, and hash readers return reference to stack items (not copies)
+template <>
+struct read_as<scalar>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return (SvROK(ST(i)) && SvTYPE(SvRV(ST(i))) < SVt_PVAV) || SvTYPE(ST(i)) < SVt_PVAV;
+  }
+
+  static scalar get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a scalar or reference to a scalar");
+    }
+    return SvROK(ST(i)) ? SvREFCNT_inc(SvRV(ST(i))) : SvREFCNT_inc(ST(i));
+  }
+};
+
+template <>
+struct read_as<reference>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return SvROK(ST(i));
+  }
+
+  static reference get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be a reference");
+    }
+    // take ownership of a reference to the RV itself (avoid reference to a reference)
+    reference result;
+    result.reset(SvREFCNT_inc(ST(i)));
+    return result;
+  }
+};
+
+template <>
+struct read_as<array>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    return items > i;
+  }
+
+  static array get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be start of a perl array");
+    }
+
+    array result;
+    result.reserve(items - i);
+    for (int index = i; index < items; ++index)
+    {
+      result.push_back(SvREFCNT_inc(ST(index)));
+    }
+    return result;
+  }
+};
+
+template <>
+struct read_as<hash>
+{
+  static bool check(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    int remaining = items - i;
+    return remaining > 0 && remaining % 2 == 0 && SvTYPE(ST(i)) == SVt_PV;
+  }
+
+  static hash get(PerlInterpreter* my_perl, int i, int ax, int items)
+  {
+    if (!check(my_perl, i, ax, items))
+    {
+      throw std::runtime_error("expected argument " + std::to_string(i+1) + " to be start of a perl hash");
+    }
+
+    hash result;
+    for (int index = i; index < items; index += 2)
+    {
+      const char* key = SvPV_nolen(ST(index));
+      result[key] = SvREFCNT_inc(ST(index + 1));
+    }
+    return result;
+  }
+};
+
+} // namespace stack
+} // namespace perlbind

libs/perlbind/include/perlbind/subcaller.h

@@ -0,0 +1,78 @@
+#pragma once
+
+#include <stdexcept>
+
+namespace perlbind { namespace detail {
+
+// handles calls to perl, inherits stack::pusher to push args to perl sub
+class sub_caller : public stack::pusher
+{
+public:
+  sub_caller() = delete;
+  sub_caller(PerlInterpreter* my_perl) : stack::pusher(my_perl)
+  {
+    ENTER; // enter scope boundary for any mortals we create
+    SAVETMPS;
+  }
+  ~sub_caller()
+  {
+    PUTBACK; // set global sp back to local for any popped return values
+    FREETMPS;
+    LEAVE; // leave scope, decref mortals and values returned by perl
+  }
+
+  template <typename T, typename... Args, std::enable_if_t<std::is_void<T>::value, bool> = true>
+  auto call_sub(const char* subname, Args&&... args)
+  {
+    call_sub_impl(subname, G_EVAL|G_VOID, std::forward<Args>(args)...);
+  }
+
+  template <typename T, typename... Args, std::enable_if_t<std::is_integral<T>::value, bool> = true>
+  auto call_sub(const char* subname, Args&&... args)
+  {
+    T result = 0;
+
+    try
+    {
+      int count = call_sub_impl(subname, G_EVAL|G_SCALAR, std::forward<Args>(args)...);
+
+      if (count == 1)
+      {
+        SV* sv_result = pop();
+        result = static_cast<T>(SvIV(sv_result));
+      }
+    }
+    catch (...)
+    {
+      pop(); // top of stack holds undef on error when called with these flags
+      throw;
+    }
+
+    return result;
+  }
+
+private:
+  template <typename... Args>
+  int call_sub_impl(const char* subname, int flags, Args&&... args)
+  {
+    PUSHMARK(SP); // notify perl of local sp (required even if not pushing args)
+    push_args(std::forward<Args>(args)...);
+    PUTBACK; // set global sp back to local so call will know pushed arg count
+
+    int result_count = call_pv(subname, flags);
+
+    SPAGAIN; // refresh local sp since call may reallocate stack for scalar returns
+
+    // ERRSV doesn't work in perl 5.28+ here for unknown reasons
+    SV* err = get_sv("@", 0);
+    if (SvTRUE(err))
+    {
+      throw std::runtime_error("Perl error: " + std::string(SvPV_nolen(err)));
+    }
+
+    return result_count;
+  }
+};
+
+} //namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/traits.h

@@ -0,0 +1,33 @@
+#pragma once
+
+namespace perlbind { namespace detail {
+
+template<typename T, typename... Rest>
+struct is_any : std::false_type {};
+template<typename T, typename Last>
+struct is_any<T, Last> : std::is_same<T, Last> {};
+template<typename T, typename First, typename... Rest>
+struct is_any<T, First, Rest...> : std::integral_constant<bool, std::is_same<T, First>::value || is_any<T, Rest...>::value> {};
+
+template <typename T>
+struct is_signed_integral : std::integral_constant<bool, std::is_integral<T>::value && std::is_signed<T>::value> {};
+
+template <typename T>
+struct is_signed_integral_or_enum : std::integral_constant<bool, is_signed_integral<T>::value || std::is_enum<T>::value> {};
+
+template <typename T, typename... Rest>
+struct count_of : std::integral_constant<size_t, 0> {};
+template <typename T, typename Last>
+struct count_of<T, Last> : std::integral_constant<size_t, std::is_same<T, Last>::value ? 1 : 0> {};
+template <typename T, typename Next, typename... Rest>
+struct count_of<T, Next, Rest...> : std::integral_constant<size_t, count_of<T, Next>::value + count_of<T, Rest...>::value> {};
+
+template <typename T, typename... Args>
+struct is_last : std::false_type {};
+template <typename T, typename Last>
+struct is_last<T, Last> : std::is_same<T, Last> {};
+template <typename T, typename Next, typename... Args>
+struct is_last<T, Next, Args...> : std::integral_constant<bool, is_last<T, Args...>::value> {};
+
+} // namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/typemap.h

@@ -0,0 +1,45 @@
+#pragma once
+
+namespace perlbind { namespace detail {
+
+struct usertype_counter
+{
+  static std::size_t next_id()
+  {
+    static std::size_t counter = 0;
+    return counter++;
+  }
+};
+
+template <typename T>
+struct usertype
+{
+  static std::string id()
+  {
+    static std::size_t id = usertype_counter::next_id();
+    return std::to_string(id);
+  }
+};
+
+namespace typemap
+{
+  // type names are stored in a hash on interpreter when registered with
+  // unique id keys generated by usertype counter
+  inline hash get(PerlInterpreter* my_perl)
+  {
+    HV* hv = get_hv("__perlbind::typemap", GV_ADD);
+    return reinterpret_cast<HV*>(SvREFCNT_inc(hv));
+  }
+
+  template <typename T>
+  const char* get_name(PerlInterpreter* my_perl)
+  {
+    auto typemap = detail::typemap::get(my_perl);
+    auto type_id = detail::template usertype<T>::id();
+
+    return typemap.exists(type_id) ? typemap[type_id].c_str() : nullptr;
+  }
+} // namespace typemap
+
+} // namespace detail
+} // namespace perlbind

libs/perlbind/include/perlbind/types.h

@@ -0,0 +1,25 @@
+#pragma once
+
+namespace perlbind {
+
+struct type_base
+{
+  type_base() : my_perl(PERL_GET_THX) {}
+  type_base(PerlInterpreter* interp) : my_perl(interp) {}
+  PerlInterpreter* my_perl = nullptr;
+};
+
+// helper type to allow null object reference arguments in bindings
+template <typename T>
+struct nullable
+{
+  static_assert(std::is_pointer<T>::value, "nullable<T> 'T' must be pointer");
+
+  nullable() = default;
+  nullable(T ptr) : m_ptr(ptr) {}
+  T get() { return m_ptr; }
+private:
+  T m_ptr = nullptr;
+};
+
+} // namespace perlbind

libs/perlbind/include/perlbind/util.h

@@ -0,0 +1,50 @@
+#pragma once
+
+#include <string>
+#include <typeinfo>
+#ifndef _MSC_VER
+#include <cxxabi.h>
+#endif
+
+namespace perlbind { namespace util {
+
+inline std::string demangle(const char* name)
+{
+#ifndef _MSC_VER
+  int status = 0;
+  char* res = abi::__cxa_demangle(name, nullptr, nullptr, &status);
+  if (res)
+  {
+    std::string demangled = res;
+    free(res);
+    return demangled;
+  }
+  return "<unknown>";
+#else
+  return name;
+#endif
+}
+
+template <typename... Args>
+struct type_name;
+
+template <>
+struct type_name<>
+{
+  static std::string str() { return "void"; }
+};
+
+template <typename T>
+struct type_name<T>
+{
+  static std::string str() { return demangle(typeid(T).name()); }
+};
+
+template <typename T, typename... Args>
+struct type_name<T, Args...>
+{
+  static std::string str() { return type_name<T>::str() + "," + type_name<Args...>::str(); }
+};
+
+} // namespace util
+} // namespace perlbind

libs/perlbind/include/perlbind/version.h

@@ -0,0 +1,10 @@
+#pragma once
+
+constexpr int perlbind_version_major = 1;
+constexpr int perlbind_version_minor = 0;
+constexpr int perlbind_version_patch = 0;
+
+constexpr int perlbind_version()
+{
+  return perlbind_version_major * 10000 + perlbind_version_minor * 100 + perlbind_version_patch;
+}