From 12ff33c3fbf1dfc2dce60f6a75bb546ca3bf6735 Mon Sep 17 00:00:00 2001 From: Thierry Vignaud Date: Tue, 18 Oct 2016 03:09:59 +0200 Subject: add support for int64, using Math::Int64 C API previously it was missing on 32bit arches --- MANIFEST | 2 + Makefile.PL | 1 + URPM.xs | 5 ++ perl_math_int64.c | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ perl_math_int64.h | 67 +++++++++++++++++++++++++++ typemap | 18 ++++++++ 6 files changed, 227 insertions(+) create mode 100644 perl_math_int64.c create mode 100644 perl_math_int64.h diff --git a/MANIFEST b/MANIFEST index 3630d80..30b2ed0 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,8 @@ README MANIFEST Makefile.PL +perl_math_int64.c +perl_math_int64.h typemap URPM.xs URPM.pm diff --git a/Makefile.PL b/Makefile.PL index e3f0ca3..9815a77 100755 --- a/Makefile.PL +++ b/Makefile.PL @@ -68,6 +68,7 @@ WriteMakefile( CCFLAGS => $ccflags, VERSION_FROM => 'URPM.pm', LIBS => [ $ldflags ], + OBJECT => [ 'perl_math_int64.o', 'URPM.o' ], INC => '-I/usr/include/rpm', dist => { COMPRESS => "xz -f", SUFFIX => ".xz" }, realclean => { FILES => "t/RPMS/noarch/*" }, diff --git a/URPM.xs b/URPM.xs index 5e23ba6..8602dc9 100644 --- a/URPM.xs +++ b/URPM.xs @@ -12,6 +12,10 @@ #include "perl.h" #include "XSUB.h" +#include +#define MATH_INT64_NATIVE_IF_AVAILABLE +#include "perl_math_int64.h" + #include #include #include @@ -2755,6 +2759,7 @@ MODULE = URPM PACKAGE = URPM PREFIX = Urpm_ BOOT: (void) read_config_files(0); + PERL_MATH_INT64_LOAD_OR_CROAK; void Urpm_bind_rpm_textdomain_codeset() diff --git a/perl_math_int64.c b/perl_math_int64.c new file mode 100644 index 0000000..2125ec1 --- /dev/null +++ b/perl_math_int64.c @@ -0,0 +1,134 @@ +/* + * perl_math_int64.c - This file is in the public domain + * Author: "Salvador Fandino , Dave Rolsky " + * + * Generated on: 2016-01-04 10:07:18 + * Math::Int64 version: 0.54 + * Module::CAPIMaker version: + */ + +#include "EXTERN.h" +#include "perl.h" +//#include "ppport.h" + +#ifdef __MINGW32__ +#include +#endif + +#ifdef _MSC_VER +#include +typedef __int64 int64_t; +typedef unsigned __int64 uint64_t; +#endif + +/* you may need to add a typemap for int64_t here if it is not defined + by default in your C header files */ + +HV *math_int64_c_api_hash; +int math_int64_c_api_min_version; +int math_int64_c_api_max_version; + +int64_t (*math_int64_c_api_SvI64)(pTHX_ SV*); +int (*math_int64_c_api_SvI64OK)(pTHX_ SV*); +uint64_t (*math_int64_c_api_SvU64)(pTHX_ SV*); +int (*math_int64_c_api_SvU64OK)(pTHX_ SV*); +SV * (*math_int64_c_api_newSVi64)(pTHX_ int64_t); +SV * (*math_int64_c_api_newSVu64)(pTHX_ uint64_t); +uint64_t (*math_int64_c_api_randU64)(pTHX); + +int +perl_math_int64_load(int required_version) { + dTHX; + SV **svp; + eval_pv("require Math::Int64", TRUE); + if (SvTRUE(ERRSV)) return 0; + + math_int64_c_api_hash = get_hv("Math::Int64::C_API", 0); + if (!math_int64_c_api_hash) { + sv_setpv(ERRSV, "Unable to load Math::Int64 C API"); + SvSETMAGIC(ERRSV); + return 0; + } + + svp = hv_fetch(math_int64_c_api_hash, "min_version", 11, 0); + if (!svp) svp = hv_fetch(math_int64_c_api_hash, "version", 7, 1); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to retrieve C API version for Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_min_version = SvIV(*svp); + + svp = hv_fetch(math_int64_c_api_hash, "max_version", 11, 0); + if (!svp) svp = hv_fetch(math_int64_c_api_hash, "version", 7, 1); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to retrieve C API version for Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_max_version = SvIV(*svp); + + if ((required_version < math_int64_c_api_min_version) || + (required_version > math_int64_c_api_max_version)) { + sv_setpvf(ERRSV, + "Math::Int64 C API version mismatch. " + "The installed module supports versions %d to %d but %d is required", + math_int64_c_api_min_version, + math_int64_c_api_max_version, + required_version); + SvSETMAGIC(ERRSV); + return 0; + } + + svp = hv_fetch(math_int64_c_api_hash, "SvI64", 5, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'SvI64' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_SvI64 = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "SvI64OK", 7, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'SvI64OK' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_SvI64OK = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "SvU64", 5, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'SvU64' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_SvU64 = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "SvU64OK", 7, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'SvU64OK' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_SvU64OK = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "newSVi64", 8, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'newSVi64' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_newSVi64 = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "newSVu64", 8, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'newSVu64' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_newSVu64 = INT2PTR(void *, SvIV(*svp)); + svp = hv_fetch(math_int64_c_api_hash, "randU64", 7, 0); + if (!svp || !*svp) { + sv_setpv(ERRSV, "Unable to fetch pointer 'randU64' C function from Math::Int64"); + SvSETMAGIC(ERRSV); + return 0; + } + math_int64_c_api_randU64 = INT2PTR(void *, SvIV(*svp)); + + return 1; +} diff --git a/perl_math_int64.h b/perl_math_int64.h new file mode 100644 index 0000000..42b585b --- /dev/null +++ b/perl_math_int64.h @@ -0,0 +1,67 @@ +/* + * perl_math_int64.h - This file is in the public domain + * Author: "Salvador Fandino , Dave Rolsky " + * Version: 2.1 + * + * Generated on: 2016-01-04 10:07:18 + * Math::Int64 version: 0.54 + * Module::CAPIMaker version: + */ + +#if !defined (PERL_MATH_INT64_H_INCLUDED) +#define PERL_MATH_INT64_H_INCLUDED + +#define MATH_INT64_C_API_REQUIRED_VERSION 2 +#define MATH_INT64_VERSION MATH_INT64_C_API_REQUIRED_VERSION + +int perl_math_int64_load(int required_version); + +#define PERL_MATH_INT64_LOAD perl_math_int64_load(MATH_INT64_C_API_REQUIRED_VERSION) +#define PERL_MATH_INT64_LOAD_OR_CROAK \ + if (PERL_MATH_INT64_LOAD); \ + else croak(NULL); +#define MATH_INT64_BOOT PERL_MATH_INT64_LOAD_OR_CROAK + +extern HV *math_int64_c_api_hash; +extern int math_int64_c_api_min_version; +extern int math_int64_c_api_max_version; +#define math_int64_capi_version math_int64_c_api_max_version + +#if (defined(MATH_INT64_NATIVE_IF_AVAILABLE) && (IVSIZE == 8)) +#define MATH_INT64_NATIVE 1 +#endif + +extern int64_t (*math_int64_c_api_SvI64)(pTHX_ SV*); +#define SvI64(a) ((*math_int64_c_api_SvI64)(aTHX_ (a))) +extern int (*math_int64_c_api_SvI64OK)(pTHX_ SV*); +#define SvI64OK(a) ((*math_int64_c_api_SvI64OK)(aTHX_ (a))) +extern uint64_t (*math_int64_c_api_SvU64)(pTHX_ SV*); +#define SvU64(a) ((*math_int64_c_api_SvU64)(aTHX_ (a))) +extern int (*math_int64_c_api_SvU64OK)(pTHX_ SV*); +#define SvU64OK(a) ((*math_int64_c_api_SvU64OK)(aTHX_ (a))) +extern SV * (*math_int64_c_api_newSVi64)(pTHX_ int64_t); +#define newSVi64(a) ((*math_int64_c_api_newSVi64)(aTHX_ (a))) +extern SV * (*math_int64_c_api_newSVu64)(pTHX_ uint64_t); +#define newSVu64(a) ((*math_int64_c_api_newSVu64)(aTHX_ (a))) +extern uint64_t (*math_int64_c_api_randU64)(pTHX); +#define randU64() ((*math_int64_c_api_randU64)(aTHX)) + + +#if MATH_INT64_NATIVE + +#undef newSVi64 +#define newSVi64 newSViv +#undef newSVu64 +#define newSVu64 newSVuv + +#define sv_seti64 sv_setiv_mg +#define sv_setu64 sv_setuv_mg + +#else + +#define sv_seti64(target, i64) (sv_setsv_mg(target, sv_2mortal(newSVi64(i64)))) +#define sv_setu64(target, u64) (sv_setsv_mg(target, sv_2mortal(newSVu64(u64)))) + +#endif + +#endif \ No newline at end of file diff --git a/typemap b/typemap index 031189e..7f688cc 100644 --- a/typemap +++ b/typemap @@ -1,3 +1,21 @@ URPM::DB T_PTROBJ URPM::Transaction T_PTROBJ URPM::Package T_PTROBJ + +TYPEMAP +int64_t T_INT64 +uint64_t T_UINT64 + +INPUT +T_INT64 + $var = SvI64($arg); + +T_UINT64 + $var = SvU64($arg); + +OUTPUT +T_INT64 + $arg = newSVi64($var); + +T_UINT64 + $arg = newSVu64($var); -- cgit v1.2.1