Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Eliminate uses of <complex.h> on Android. #579

Merged
merged 1 commit into from
Nov 1, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion src/configure/extract_from_c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,7 +54,6 @@ let extract s =
let headers = "\
#include <stdint.h>
#include <stdbool.h>
#include <complex.h>
#include <inttypes.h>
#include <caml/mlvalues.h>
"
Expand Down
58 changes: 29 additions & 29 deletions src/configure/gen_c_primitives.ml
Original file line number Diff line number Diff line change
Expand Up @@ -28,35 +28,35 @@ let c_primitive constructor typ format =
alignment = "alignof("^typ^")"; }

let c_primitives = [
c_primitive "Char" "char" (Known_format "d");
c_primitive "Schar" "signed char" (Known_format "d");
c_primitive "Uchar" "unsigned char" (Known_format "d");
c_primitive "Bool" "bool" (Known_format "d");
c_primitive "Short" "short" (Known_format "hd");
c_primitive "Int" "int" (Known_format "d");
c_primitive "Long" "long" (Known_format "ld");
c_primitive "Llong" "long long" (Known_format "lld");
c_primitive "Ushort" "unsigned short" (Known_format "hu");
c_primitive "Sint" "int" (Known_format "d");
c_primitive "Uint" "unsigned int" (Known_format "u");
c_primitive "Ulong" "unsigned long" (Known_format "lu");
c_primitive "Ullong" "unsigned long long" (Known_format "llu");
c_primitive "Size_t" "size_t" (Known_format "zu");
c_primitive "Int8_t" "int8_t" (Defined_format "PRId8");
c_primitive "Int16_t" "int16_t" (Defined_format "PRId16");
c_primitive "Int32_t" "int32_t" (Defined_format "PRId32");
c_primitive "Int64_t" "int64_t" (Defined_format "PRId64");
c_primitive "Uint8_t" "uint8_t" (Defined_format "PRIu8");
c_primitive "Uint16_t" "uint16_t" (Defined_format "PRIu16");
c_primitive "Uint32_t" "uint32_t" (Defined_format "PRIu32");
c_primitive "Uint64_t" "uint64_t" (Defined_format "PRIu64");
c_primitive "Float" "float" (Known_format ".12g");
c_primitive "Double" "double" (Known_format ".12g");
c_primitive "LDouble" "long double" (Known_format ".12Lg");
c_primitive "Complex32" "float complex" (No_format);
c_primitive "Complex64" "double complex" (No_format);
c_primitive "Complexld" "long double complex"(No_format);
c_primitive "Nativeint" "intnat" (Defined_format "REAL_ARCH_INTNAT_PRINTF_FORMAT \"d\"");
c_primitive "Char" "char" (Known_format "d");
c_primitive "Schar" "signed char" (Known_format "d");
c_primitive "Uchar" "unsigned char" (Known_format "d");
c_primitive "Bool" "bool" (Known_format "d");
c_primitive "Short" "short" (Known_format "hd");
c_primitive "Int" "int" (Known_format "d");
c_primitive "Long" "long" (Known_format "ld");
c_primitive "Llong" "long long" (Known_format "lld");
c_primitive "Ushort" "unsigned short" (Known_format "hu");
c_primitive "Sint" "int" (Known_format "d");
c_primitive "Uint" "unsigned int" (Known_format "u");
c_primitive "Ulong" "unsigned long" (Known_format "lu");
c_primitive "Ullong" "unsigned long long" (Known_format "llu");
c_primitive "Size_t" "size_t" (Known_format "zu");
c_primitive "Int8_t" "int8_t" (Defined_format "PRId8");
c_primitive "Int16_t" "int16_t" (Defined_format "PRId16");
c_primitive "Int32_t" "int32_t" (Defined_format "PRId32");
c_primitive "Int64_t" "int64_t" (Defined_format "PRId64");
c_primitive "Uint8_t" "uint8_t" (Defined_format "PRIu8");
c_primitive "Uint16_t" "uint16_t" (Defined_format "PRIu16");
c_primitive "Uint32_t" "uint32_t" (Defined_format "PRIu32");
c_primitive "Uint64_t" "uint64_t" (Defined_format "PRIu64");
c_primitive "Float" "float" (Known_format ".12g");
c_primitive "Double" "double" (Known_format ".12g");
c_primitive "LDouble" "long double" (Known_format ".12Lg");
c_primitive "Complex32" "float _Complex" (No_format);
c_primitive "Complex64" "double _Complex" (No_format);
c_primitive "Complexld" "long double _Complex"(No_format);
c_primitive "Nativeint" "intnat" (Defined_format "REAL_ARCH_INTNAT_PRINTF_FORMAT \"d\"");
{ constructor = "Camlint";
typ = "intnat";
format = Defined_format "REAL_ARCH_INTNAT_PRINTF_FORMAT \"d\"";
Expand Down
27 changes: 13 additions & 14 deletions src/ctypes/complex_stubs.c
Original file line number Diff line number Diff line change
Expand Up @@ -5,11 +5,10 @@
* See the file LICENSE for details.
*/

#include <complex.h>

#include <caml/memory.h>
#include <caml/alloc.h>

#include "ctypes_complex_compatibility.h"
#include "ctypes_complex_stubs.h"

static value allocate_complex_value(double r, double i)
Expand All @@ -20,26 +19,26 @@ static value allocate_complex_value(double r, double i)
return v;
}

/* ctypes_copy_float_complex : float complex -> Complex.t */
value ctypes_copy_float_complex(float complex c)
/* ctypes_copy_float_complex : float _Complex -> Complex.t */
value ctypes_copy_float_complex(float _Complex c)
{
return allocate_complex_value(crealf(c), cimagf(c));
return allocate_complex_value(ctypes_compat_crealf(c), ctypes_compat_cimagf(c));
}

/* ctypes_copy_double_complex : double complex -> Complex.t */
value ctypes_copy_double_complex(double complex c)
/* ctypes_copy_double_complex : double _Complex -> Complex.t */
value ctypes_copy_double_complex(double _Complex c)
{
return allocate_complex_value(creal(c), cimag(c));
return allocate_complex_value(ctypes_compat_creal(c), ctypes_compat_cimag(c));
}

/* ctypes_float_complex_val : Complex.t -> float complex */
float complex ctypes_float_complex_val(value v)
/* ctypes_float_complex_val : Complex.t -> float _Complex */
float _Complex ctypes_float_complex_val(value v)
{
return Double_field(v, 0) + Double_field(v, 1) * I;
return ctypes_compat_make_complexf(Double_field(v, 0), Double_field(v, 1));
}

/* ctypes_double_complex_val : Complex.t -> double complex */
double complex ctypes_double_complex_val(value v)
/* ctypes_double_complex_val : Complex.t -> double _Complex */
double _Complex ctypes_double_complex_val(value v)
{
return Double_field(v, 0) + Double_field(v, 1) * I;
return ctypes_compat_make_complex(Double_field(v, 0), Double_field(v, 1));
}
139 changes: 139 additions & 0 deletions src/ctypes/ctypes_complex_compatibility.h
Original file line number Diff line number Diff line change
@@ -0,0 +1,139 @@
/*
* Copyright (c) 2018 Jeremy Yallop.
*
* This file is distributed under the terms of the MIT License.
* See the file LICENSE for details.
*/

#ifndef CTYPES_COMPLEX_COMPATIBILITY_H
#define CTYPES_COMPLEX_COMPATIBILITY_H

#if defined(__ANDROID__)

#include <math.h>

#include <caml/fail.h>

/* "Each complex type has the same representation and alignment
requirements as an array type containing exactly two elements of
the corresponding real type; the first element is equal to the real
part, and the second element to the imaginary part, of the complex
number."
- C99 6.2.5 (13)
*/
union ctypes_complex_long_double_union {
long double _Complex z;
long double parts[2];
};

static inline long double ctypes_compat_creall(long double _Complex z)
{ union ctypes_complex_long_double_union u; u.z = z; return u.parts[0]; }

static inline long double ctypes_compat_cimagl(long double _Complex z)
{ union ctypes_complex_long_double_union u; u.z = z; return u.parts[1]; }

static inline long double _Complex ctypes_compat_make_complexl(long double re, long double im)
{ union ctypes_complex_long_double_union u; u.parts[0] = re; u.parts[1] = im; return u.z; }

static inline long double _Complex ctypes_compat_conjl(long double _Complex z)
{ union ctypes_complex_long_double_union u; u.z = z; u.parts[1] = -u.parts[1]; return u.z; }

static inline long double _Complex ctypes_compat_csqrtl(long double _Complex z)
{ caml_failwith("ctypes: csqrtl does not exist on current platform"); }

static inline long double ctypes_compat_cargl(long double _Complex z)
{ return atan2(ctypes_compat_cimagl(z), ctypes_compat_creall(z)); }

union ctypes_complex_double_union {
double _Complex z;
double parts[2];
};

static inline double ctypes_compat_creal(double _Complex z)
{ union ctypes_complex_double_union u; u.z = z; return u.parts[0]; }

static inline double ctypes_compat_cimag(double _Complex z)
{ union ctypes_complex_double_union u; u.z = z; return u.parts[1]; }

static inline double _Complex ctypes_compat_make_complex(double re, double im)
{ union ctypes_complex_double_union u; u.parts[0] = re; u.parts[1] = im; return u.z; }

static inline double _Complex ctypes_compat_conj(double _Complex z)
{ union ctypes_complex_double_union u; u.z = z; u.parts[1] = -u.parts[1]; return u.z; }

union ctypes_complex_float_union {
float _Complex z;
float parts[2];
};

static inline float ctypes_compat_crealf(float _Complex z)
{ union ctypes_complex_float_union u; u.z = z; return u.parts[0]; }

static inline float ctypes_compat_cimagf(float _Complex z)
{ union ctypes_complex_float_union u; u.z = z; return u.parts[1]; }

static inline float _Complex ctypes_compat_make_complexf(float re, float im)
{ union ctypes_complex_float_union u; u.parts[0] = re; u.parts[1] = im; return u.z; }

static inline float _Complex ctypes_compat_conjf(float _Complex z)
{ union ctypes_complex_float_union u; u.z = z; u.parts[1] = -u.parts[1]; return u.z; }

#else

#include <complex.h>

static inline long double ctypes_compat_creall(long double _Complex z)
{ return creall(z); }
static inline long double ctypes_compat_cimagl(long double _Complex z)
{ return cimagl(z); }
static inline long double _Complex ctypes_compat_make_complexl(long double re, long double im)
{ return re + im * I; }
static inline long double _Complex ctypes_compat_conjl(long double _Complex z)
{ return conjl(z); }
static inline long double _Complex ctypes_compat_cexpl(long double _Complex z)
{ return cexpl(z); }
static inline long double _Complex ctypes_compat_clogl(long double _Complex z)
{ return clogl(z); }
static inline long double _Complex ctypes_compat_cpowl(long double _Complex x, long double _Complex z)
{ return cpowl(x, z); }
static inline long double _Complex ctypes_compat_csqrtl(long double _Complex z)
{ return csqrtl(z); }
static inline long double ctypes_compat_cargl(long double _Complex z)
{ return cargl(z); }

static inline double ctypes_compat_creal(double _Complex z)
{ return creal(z); }
static inline double ctypes_compat_cimag(double _Complex z)
{ return cimag(z); }
static inline double _Complex ctypes_compat_make_complex(double re, double im)
{ return re + im * I; }
static inline double _Complex ctypes_compat_conj(double _Complex z)
{ return conj(z); }

static inline float ctypes_compat_crealf(float _Complex z)
{ return crealf(z); }
static inline float ctypes_compat_cimagf(float _Complex z)
{ return cimagf(z); }
static inline float _Complex ctypes_compat_make_complexf(float re, float im)
{ return re + im * I; }
static inline float _Complex ctypes_compat_conjf(float _Complex z)
{ return conjf(z); }

#endif

#if defined(__ANDROID__) || defined(__FreeBSD__)
/* Android: As of API level 24, these functions do not exist.
Freebsd: still missing in FreeBSD 11.0-RELEASE-p2
*/

static inline long double _Complex ctypes_compat_cexpl(long double _Complex z)
{ caml_failwith("ctypes: cexpl does not exist on current platform"); }

static inline long double _Complex ctypes_compat_clogl(long double _Complex z)
{ caml_failwith("ctypes: clogl does not exist on current platform"); }

static inline long double _Complex ctypes_compat_cpowl(long double _Complex x, long double _Complex z)
{ caml_failwith("ctypes: cpowl does not exist on current platform"); }
#endif

#endif /* CTYPES_COMPLEX_COMPATIBILITY_H */
17 changes: 8 additions & 9 deletions src/ctypes/ctypes_complex_stubs.h
Original file line number Diff line number Diff line change
Expand Up @@ -8,19 +8,18 @@
#ifndef CTYPES_COMPLEX_STUBS_H
#define CTYPES_COMPLEX_STUBS_H

#include <complex.h>
#include <caml/mlvalues.h>

/* ctypes_copy_float_complex : float complex -> Complex.t */
value ctypes_copy_float_complex(float complex);
/* ctypes_copy_float_complex : float _Complex -> Complex.t */
value ctypes_copy_float_complex(float _Complex);

/* ctypes_copy_double_complex : double complex -> Complex.t */
value ctypes_copy_double_complex(double complex);
/* ctypes_copy_double_complex : double _Complex -> Complex.t */
value ctypes_copy_double_complex(double _Complex);

/* ctypes_float_complex_val : Complex.t -> float complex */
float complex ctypes_float_complex_val(value);
/* ctypes_float_complex_val : Complex.t -> float _Complex */
float _Complex ctypes_float_complex_val(value);

/* ctypes_double_complex_val : Complex.t -> double complex */
double complex ctypes_double_complex_val(value);
/* ctypes_double_complex_val : Complex.t -> double _Complex */
double _Complex ctypes_double_complex_val(value);

#endif /* CTYPES_COMPLEX_STUBS_H */
5 changes: 2 additions & 3 deletions src/ctypes/ctypes_ldouble_stubs.h
Original file line number Diff line number Diff line change
Expand Up @@ -8,16 +8,15 @@
#ifndef CTYPES_LDOUBLE_STUBS_H
#define CTYPES_LDOUBLE_STUBS_H

#include <complex.h>
#include <caml/mlvalues.h>

extern value ctypes_copy_ldouble(long double u);
extern long double ctypes_ldouble_val(value);
extern value ctypes_ldouble_of_float(value a);
extern value ctypes_ldouble_to_float(value a);

extern value ctypes_copy_ldouble_complex(long double complex u);
extern long double complex ctypes_ldouble_complex_val(value);
extern value ctypes_copy_ldouble_complex(long double _Complex u);
extern long double _Complex ctypes_ldouble_complex_val(value);
extern value ctypes_ldouble_complex_make(value r, value i);
extern value ctypes_ldouble_complex_real(value v);
extern value ctypes_ldouble_complex_imag(value v);
Expand Down
Loading