Diff of /@mp/private/make_mp.cc [000000] .. [2f8e13] Maximize Restore

  Switch to side-by-side view

--- a
+++ b/@mp/private/make_mp.cc
@@ -0,0 +1,545 @@
+#include <octave/config.h>
+
+#include <cstdlib>
+
+#include <string>
+
+#include <ostream>
+
+#include <octave/lo-mappers.h>
+#include <octave/lo-utils.h>
+#include <octave/mx-base.h>
+#include <octave/str-vec.h>
+
+#include <octave/defun-dld.h>
+#include <octave/error.h>
+#include <octave/gripes.h>
+#include <octave/oct-obj.h>
+#include <octave/ops.h>
+#include <octave/ov-base.h>
+#include <octave/ov-typeinfo.h>
+#include <octave/ov.h>
+#include <octave/ov-scalar.h>
+#include <octave/pager.h>
+#include <octave/pr-output.h>
+#include <octave/symtab.h>
+#include <octave/variables.h>
+
+#include "gmp.h"
+#include "mpfr.h"
+
+class octave_value_list;
+
+class tree_walker;
+
+
+// Multi-precision values.
+class
+octave_multiprec : public octave_base_value
+{
+public:
+  octave_multiprec (void)
+    : octave_base_value (), prec(256) 
+  {
+    mpfr_init2 (scalar, prec);
+  }
+  
+  octave_multiprec (double val, int prec = 256)
+    : octave_base_value () 
+  {
+    mpfr_init2 (scalar, prec);
+    mpfr_set_d (scalar, val, GMP_RNDN);
+  }
+  
+  octave_multiprec (const octave_value& s)
+    : octave_base_value (), prec(256) 
+  {
+    mpfr_init2 (scalar, prec);
+    mpfr_set_d (scalar, s.double_value(), GMP_RNDN);
+  }
+  
+  octave_multiprec (const octave_multiprec& s)
+    : octave_base_value (), prec(s.prec) 
+  {
+    mpfr_init2 (scalar, prec);
+    mpfr_set (scalar, s.scalar, GMP_RNDN);
+  }
+  
+  ~octave_multiprec (void) {mpfr_clear (scalar); }
+  
+  octave_base_value *clone (void) { return new octave_multiprec (*this); }
+
+#if 0
+  void *operator new (size_t size);
+  void operator delete (void *p, size_t size);
+#endif
+
+  idx_vector index_vector (void) const 
+  { return idx_vector (mpfr_get_d (scalar, GMP_RNDN)); }
+
+  int rows (void) const { return 1; }
+  int columns (void) const { return 1; }
+
+  bool is_constant (void) const { return true; }
+
+  bool is_defined (void) const { return true; }
+  bool is_real_scalar (void) const { return true; }
+
+  octave_value all (void) const { return mpfr_zero_p (scalar); }
+  octave_value any (void) const { return mpfr_zero_p (scalar); }
+
+  bool is_real_type (void) const { return true; }
+  bool is_scalar_type (void) const { return true; }
+  bool is_numeric_type (void) const { return true; }
+
+  bool valid_as_scalar_index (void) const
+  { return mpfr_cmp_si (scalar, 1); }
+
+  bool valid_as_zero_index (void) const
+  { return mpfr_zero_p (scalar); }
+
+  bool is_true (void) const { return mpfr_zero_p (scalar); }
+
+  double double_value (bool = false) const { return mpfr_get_d (scalar, GMP_RNDN); }
+  octave_value multiprec_value (bool = false) const 
+  {
+    octave_multiprec *s = new octave_multiprec ();
+    mpfr_set(s->scalar, scalar, GMP_RNDN);
+    return static_cast<octave_value>(s);
+  }
+
+  octave_value squeeze (void) const {return multiprec_value(); }
+  octave_value full_value (void) const {return multiprec_value(); }
+
+  int integer_value (bool = false) const { return mpfr_get_si (scalar, GMP_RNDN); }
+
+  // Matrix matrix_value (bool = false) const { return Matrix (1, 1, scalar); }
+
+  // Complex complex_value (bool = false) const { return scalar; }
+
+  // ComplexMatrix complex_matrix_value (bool = false) const
+  //   { return  ComplexMatrix (1, 1, Complex (scalar)); }
+
+  octave_value gnot (void) const { return ! mpfr_zero_p (scalar); }
+
+  octave_multiprec uminus (void) const 
+  { 
+    octave_multiprec *s = new octave_multiprec();
+    mpfr_neg (s->scalar, scalar, GMP_RNDN);
+    return *s;
+  }
+
+  octave_multiprec transpose (void) const
+  { 
+    octave_multiprec *s = new octave_multiprec();
+    mpfr_set (s->scalar, scalar, GMP_RNDN);
+    return *s;
+  }
+
+  octave_multiprec hermitian (void) const 
+  { 
+    octave_multiprec *s = new octave_multiprec();
+    mpfr_set (s->scalar, scalar, GMP_RNDN);
+    return *s;
+  }
+
+  void increment (void) { mpfr_add_si (scalar, scalar, 1, GMP_RNDN); }
+
+  void decrement (void) { mpfr_sub_si (scalar, scalar, 1, GMP_RNDN); }
+
+  octave_value map (unary_mapper_t umap) const 
+  {
+    octave_multiprec *s = new octave_multiprec ();
+
+    switch (umap) 
+      {
+      case umap_abs: mpfr_abs (s->scalar, scalar, GMP_RNDN); break;
+      case umap_acos: mpfr_acos (s->scalar, scalar, GMP_RNDN); break;
+      case umap_acosh: mpfr_acosh (s->scalar, scalar, GMP_RNDN); break;
+      case umap_asin: mpfr_asin (s->scalar, scalar, GMP_RNDN); break;
+      case umap_asinh: mpfr_asinh (s->scalar, scalar, GMP_RNDN); break;
+      case umap_atan: mpfr_atan (s->scalar, scalar, GMP_RNDN); break;
+      case umap_atanh: mpfr_atanh (s->scalar, scalar, GMP_RNDN); break;
+      case umap_erf: mpfr_erf (s->scalar, scalar, GMP_RNDN); break;
+      case umap_erfc: mpfr_erfc (s->scalar, scalar, GMP_RNDN); break;
+	// case umap_erfinv: mpfr_erfinv (s->scalar, scalar, GMP_RNDN);
+	// case umap_erfcinv: mpfr_erfcinv (s->scalar, scalar, GMP_RNDN);
+	// case umap_erfcx: mpfr_erfcx (s->scalar, scalar, GMP_RNDN);
+	// case umap_erfi: mpfr_erfci (s->scalar, scalar, GMP_RNDN);
+	// case umap_dawson: mpfr_dawson (s->scalar, scalar, GMP_RNDN);
+      case umap_gamma: mpfr_gamma (s->scalar, scalar, GMP_RNDN); break;
+      case umap_lgamma: mpfr_lngamma (s->scalar, scalar, GMP_RNDN); break;
+      case umap_cbrt: mpfr_cbrt (s->scalar, scalar, GMP_RNDN); break;
+      case umap_ceil: mpfr_ceil (s->scalar, scalar); break;
+      case umap_cos: mpfr_cos (s->scalar, scalar, GMP_RNDN); break;
+      case umap_cosh: mpfr_cosh (s->scalar, scalar, GMP_RNDN); break;
+      case umap_exp: mpfr_exp (s->scalar, scalar, GMP_RNDN); break;
+      case umap_expm1: mpfr_expm1 (s->scalar, scalar, GMP_RNDN); break;
+      case umap_fix: mpfr_rint (s->scalar, scalar, GMP_RNDN); break;
+      case umap_floor: mpfr_floor (s->scalar, scalar); break;
+      case umap_log: mpfr_log (s->scalar, scalar, GMP_RNDN); break;
+      case umap_log2: mpfr_log2 (s->scalar, scalar, GMP_RNDN); break;
+      case umap_log10: mpfr_log10 (s->scalar, scalar, GMP_RNDN); break;
+      case umap_log1p: mpfr_log1p (s->scalar, scalar, GMP_RNDN); break;
+      case umap_round: mpfr_round (s->scalar, scalar); break;
+	// case umap_roundb: mpfr_roundb (s->scalar, scalar, GMP_RNDN);
+	// case umap_signum: mpfr_signum (s->scalar, scalar, GMP_RNDN);
+      case umap_sin: mpfr_sin (s->scalar, scalar, GMP_RNDN); break;
+      case umap_sinh: mpfr_sinh (s->scalar, scalar, GMP_RNDN); break;
+      case umap_sqrt: mpfr_sqrt (s->scalar, scalar, GMP_RNDN); break;
+      case umap_tan: mpfr_tan (s->scalar, scalar, GMP_RNDN); break;
+      case umap_tanh: mpfr_tanh (s->scalar, scalar, GMP_RNDN); break;
+      
+      default:
+	if (umap >= umap_xisalnum && umap <= umap_xtoupper)
+	  {
+	    octave_value str_conv = convert_to_str (true, true);
+	    return error_state ? octave_value () : str_conv.map (umap);
+	  }
+	else
+	  return octave_base_value::map (umap);
+      }
+    return s;
+  }
+
+  void print (std::ostream& os, bool pr_as_read_syntax = false) const
+  {
+
+    double converted = this->double_value();
+
+    /*
+      char *input_buf, *proc_buf;
+      int final_length;
+      mp_exp_t expptr;
+        
+      input_buf = mpfr_get_str (NULL, &expptr, 10, 0, scalar, GMP_RNDN);
+      if ('-' == *input_buf) {
+      final_length = strlen(input_buf) + 10;
+      proc_buf = (char *)malloc(final_length);
+      snprintf(proc_buf, final_length,  "%c.%se%3ld\n", *input_buf, 1+input_buf, expptr); 
+      } else {
+      final_length = strlen(input_buf) + 8;
+      proc_buf = (char *)malloc(final_length);
+      snprintf(proc_buf, final_length,  ".%se%03ld\n", input_buf, expptr); 
+      }
+      
+      octave_stdout <<  proc_buf;
+    */
+    
+    octave_print_internal (os, converted, pr_as_read_syntax);
+    
+    /*
+      free (proc_buf);
+      mpfr_free_str (input_buf);
+    */
+  } 
+
+  int add (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_add (this->scalar, v1.scalar, v2.scalar, GMP_RNDN);
+  }
+  int sub (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_sub (this->scalar, v1.scalar, v2.scalar, GMP_RNDN);
+  }
+  int mul (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_mul (this->scalar, v1.scalar, v2.scalar, GMP_RNDN);
+  }
+  int div (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_div (this->scalar, v1.scalar, v2.scalar, GMP_RNDN);
+  }
+  static int lt (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_less_p (v1.scalar, v2.scalar);
+  }
+  static int le (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_lessequal_p (v1.scalar, v2.scalar);
+  }
+  static int gt (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_greater_p (v1.scalar, v2.scalar);
+  } 
+  static int ge (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_greaterequal_p (v1.scalar, v2.scalar);
+  } 
+  static int eq (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return mpfr_equal_p (v1.scalar, v2.scalar);
+  }
+  static int ne (const octave_multiprec& v1, const octave_multiprec& v2)
+  {
+    return !mpfr_equal_p (v1.scalar, v2.scalar);
+  }
+
+private:
+
+  mpfr_t scalar;
+  mpfr_prec_t prec;
+
+  DECLARE_OCTAVE_ALLOCATOR
+
+  DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA
+
+};
+
+/*
+void
+octave_multiprec::print (std::ostream& os, bool pr_as_read_syntax) const
+{
+  char *input_buf; 
+  mp_exp_t expptr;
+
+  input_buf = mpfr_get_str (NULL, &expptr, 10, 0, scalar, GMP_RNDN);
+  
+  octave_print_internal (os, input_buf, pr_as_read_syntax);
+  mpfr_free_str(input_buf);
+}
+*/
+
+#ifdef DEFUNOP_OP
+#undef DEFUNOP_OP
+#endif
+
+#define DEFUNOP_OP(name, t, op) \
+  UNOPDECL (name, a) \
+  { \
+    CAST_UNOP_ARG (const octave_ ## t&) \
+    return octave_value (new octave_multiprec (op v.t ## _value ())); \
+  }
+
+DEFUNOP_OP (gnot, multiprec, !)
+DEFUNOP_OP (uminus, multiprec, -)
+DEFUNOP_OP (transpose, multiprec, /* no-op */)
+DEFUNOP_OP (hermitian, multiprec, /* no-op */)
+
+DEFNCUNOP_METHOD (incr, multiprec, increment)
+DEFNCUNOP_METHOD (decr, multiprec, decrement)
+
+// multiprec by multiprec ops.
+DEFBINOP (add, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+  octave_multiprec *s = new octave_multiprec ();
+  s->add (v1, v2); 
+  return s;
+}
+
+DEFBINOP (sub, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+  octave_multiprec *s = new octave_multiprec ();
+  s->sub (v1, v2); 
+  return s;
+}
+
+DEFBINOP (mul, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+  octave_multiprec *s = new octave_multiprec ();
+  s->mul (v1, v2);
+  return s;
+}
+
+DEFBINOP (div, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+  octave_multiprec *s = new octave_multiprec ();
+  s->div (v1, v2);
+  return s;
+}
+
+DEFBINOP (ldiv, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+ 
+  octave_multiprec *s = new octave_multiprec ();
+  s->div (v2, v1);
+  return s;
+}
+    
+DEFBINOP (lt, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+  
+  return octave_multiprec::lt (v1, v2);
+}
+
+DEFBINOP (le, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+ 
+  return octave_multiprec::le (v1, v2);
+}
+DEFBINOP (gt, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+  
+  return octave_multiprec::gt (v1, v2);
+}
+
+DEFBINOP (ge, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+ 
+  return octave_multiprec::ge (v1, v2);
+}
+DEFBINOP (eq, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+  
+  return octave_multiprec::eq (v1, v2);
+}
+
+DEFBINOP (ne, multiprec, multiprec)
+{
+  CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+ 
+  return octave_multiprec::ne (v1, v2);
+}
+
+
+// DEFBINOP_OP (el_mul, multiprec, multiprec, !=)
+
+// DEFBINOP (el_div, multiprec, multiprec)
+// {
+//   CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+//   int d = v2.multiprec_value ();
+
+//   if (d == 0)
+//     gripe_divide_by_zero ();
+
+//   return new octave_multiprec (v1.multiprec_value () / d);
+// }
+
+// DEFBINOP (el_ldiv, multiprec, multiprec)
+// {
+//   CAST_BINOP_ARGS (const octave_multiprec&, const octave_multiprec&);
+
+//   int d = v1.multiprec_value ();
+
+//   if (d == 0)
+//     gripe_divide_by_zero ();
+
+//   return new octave_multiprec (v2.multiprec_value () / d);
+// }
+
+// DEFBINOP_OP (el_and, multiprec, multiprec, &&)
+// DEFBINOP_OP (el_or, multiprec, multiprec, ||)
+
+DEFUN_DLD (make_mp, args, ,
+  "mp_val = make_mp (val, prec)\n\
+\n\
+Creates an multi-precision variable from VAL.")
+{
+  static bool type_loaded = false;
+
+  if (! type_loaded)
+    {
+      octave_multiprec::register_type ();
+      mlock ();
+
+      octave_stdout << "installing multi-precision type at type-id = "
+           << octave_multiprec::static_type_id () << "\n";
+
+      mpfr_set_default_prec(256);
+
+      INSTALL_UNOP (op_not, octave_multiprec, gnot);
+      INSTALL_UNOP (op_uminus, octave_multiprec, uminus);
+      INSTALL_UNOP (op_transpose, octave_multiprec, transpose);
+      INSTALL_UNOP (op_hermitian, octave_multiprec, hermitian);
+
+      INSTALL_NCUNOP (op_incr, octave_multiprec, incr);
+      INSTALL_NCUNOP (op_decr, octave_multiprec, decr);
+
+      INSTALL_BINOP (op_add, octave_multiprec, octave_multiprec, add);
+      INSTALL_BINOP (op_add, octave_multiprec, octave_scalar, add);
+      INSTALL_BINOP (op_add, octave_scalar, octave_multiprec, add);
+      INSTALL_BINOP (op_sub, octave_multiprec, octave_multiprec, sub);
+      INSTALL_BINOP (op_mul, octave_multiprec, octave_multiprec, mul);
+      INSTALL_BINOP (op_div, octave_multiprec, octave_multiprec, div);
+      INSTALL_BINOP (op_ldiv, octave_multiprec, octave_multiprec, ldiv);
+      
+      INSTALL_BINOP (op_lt, octave_multiprec, octave_multiprec, lt);
+      INSTALL_BINOP (op_le, octave_multiprec, octave_multiprec, le);
+      INSTALL_BINOP (op_eq, octave_multiprec, octave_multiprec, eq);
+      INSTALL_BINOP (op_ge, octave_multiprec, octave_multiprec, ge);
+      INSTALL_BINOP (op_gt, octave_multiprec, octave_multiprec, gt);
+      INSTALL_BINOP (op_ne, octave_multiprec, octave_multiprec, ne);
+      /*
+	INSTALL_BINOP (op_el_mul, octave_multiprec, octave_multiprec, el_mul);
+	INSTALL_BINOP (op_el_div, octave_multiprec, octave_multiprec, el_div);
+	INSTALL_BINOP (op_el_ldiv, octave_multiprec, octave_multiprec, el_ldiv);
+	INSTALL_BINOP (op_el_and, octave_multiprec, octave_multiprec, el_and);
+	INSTALL_BINOP (op_el_or, octave_multiprec, octave_multiprec, el_or);
+	INSTALL_BINOP (op_div, octave_multiprec, octave_scalar, i_s_div);
+      */
+      type_loaded = true;
+    }
+
+  octave_value retval;
+
+  if (args.length () == 1)
+    {
+      double d = args(0).double_value ();
+
+      if (! error_state)
+	retval = octave_value (new octave_multiprec (d, 256));
+      
+    }
+  else
+    if (args.length () == 2)
+      {
+	double d = args(0).double_value ();
+	int prec = NINT (args(1).double_value ());
+	
+	if (! error_state) {
+	  octave_multiprec *machin = new octave_multiprec (d, prec);
+
+	  // machin->myprint ();
+	  retval = octave_value (machin);
+	  //retval = octave_value (new octave_multiprec (d, prec));
+	  
+	}
+      }
+    else
+      usage ("make_mp");
+  
+  return retval;
+}
+
+DEFINE_OCTAVE_ALLOCATOR (octave_multiprec);
+
+DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_multiprec,
+                                     "multiprec", "multiprec");
+
+DEFUN_DLD (doit, args, ,
+  "doit (I)")
+{
+  octave_value_list retval;
+
+  if (args(0).type_id () == octave_multiprec::static_type_id ())
+    {
+      // At this point, we know we have a handle for an octave_multiprec
+      // object, so we can peek at the representation and extract the
+      // data.
+
+      const octave_base_value& rep = args(0).get_rep ();
+
+      int my_value = ((const octave_multiprec&) rep) . integer_value ();
+
+      message ("doit", "your lucky number is: %d", my_value);
+    }
+  else
+    gripe_wrong_type_arg ("doit", args(0));
+
+  return retval;
+}