===================================================================
@@ -75,12 +75,12 @@
## the invoking command could set MELT_MAKE_MODULE_XTRAMAKEFLAGS=-j2
MELT_MAKE_MODULE=$(MAKE) -f $(melt_make_module_makefile) $(MELT_MAKE_MODULE_XTRAMAKEFLAGS) VPATH=$(VPATH):.
-warmelt-%.0.so: warmelt-%.0.c $(melt_make_module_makefile)
+warmelt-%.0.so: warmelt-%.0.c $(melt_make_module_makefile) melt-predef.h
echo in melt-make.mk melt_cflags= $(melt_cflags)
$(MELT_MAKE_MODULE) meltmodule \
GCCMELT_CFLAGS="$(melt_cflags)" \
GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
-warmelt-%.0.d.so: warmelt-%.0.c $(melt_make_module_makefile)
+warmelt-%.0.d.so: warmelt-%.0.c $(melt_make_module_makefile) melt-predef.h
$(MELT_MAKE_MODULE) meltmoduledynamic \
GCCMELT_CFLAGS="$(melt_cflags)" \
GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$(shell basename $@ .d.so).so
@@ -98,11 +98,11 @@
GCCMELT_CFLAGS="$(melt_cflags)" \
GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
## warmeltbig*.c is so big that it can only be compiled with -O0
-warmeltbig-%.so: warmeltbig-%.c $(melt_make_module_makefile)
+warmeltbig-%.so: warmeltbig-%.c $(melt_make_module_makefile) melt-predef.h
$(MELT_MAKE_MODULE) meltmodule \
GCCMELT_CFLAGS="$(melt_cflags) -O0" \
GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
-warm%.so: warm%.c $(melt_make_module_makefile)
+warm%.so: warm%.c $(melt_make_module_makefile) melt-predef.h
$(MELT_MAKE_MODULE) meltmodule \
GCCMELT_CFLAGS="$(melt_cflags) $(MELT_FINAL_CFLAGS)" \
GCCMELT_MODULE_SOURCE=$< GCCMELT_MODULE_BINARY=$@
===================================================================
@@ -1475,6 +1475,14 @@
:disc_super discr_any_receiver
:named_name '"DISCR_INTEGER")
+;;; The discriminant for boxed reals.
+(definstance discr_real class_discriminant
+ :doc #{The $DISCR_REAL is the discriminant of boxed reals. }#
+ :predef DISCR_REAL
+ :obj_num OBMAG_REAL
+ :disc_super discr_any_receiver
+ :named_name '"DISCR_REAL")
+
;;; the discriminant for constant integers, like '123
(definstance discr_constant_integer class_discriminant
:predef DISCR_CONSTANT_INTEGER
@@ -3544,6 +3552,7 @@
discr_ppl_constraint_system
discr_ppl_polyhedron
discr_rawfile
+ discr_real
discr_routine
discr_strbuf
discr_string
===================================================================
@@ -1329,8 +1329,19 @@
#{ /*$treeintk !*/ $n = tree_low_cst(($tr), 0);
}# )
-
-
+;;; pattern tree_real_cst
+(defcmatcher tree_real_cst
+ (:tree tr)
+ (:value v)
+ treerealc
+ ;; test expander
+ #{ /* $treerealc ?*/ (($tr) && TREE_CODE($tr) == REAL_CST) }#
+ ;; fill expander
+ #{ /* treerealc! */
+ $v = meltgc_new_real ((meltobject_ptr_t) MELT_PREDEF (DISCR_REAL),
+ TREE_REAL_CST(($tr))); }#
+)
+
;;; pattern for pointer types
(defcmatcher tree_pointer_type_p
(:tree tr)
===================================================================
@@ -1973,7 +1973,32 @@
#undef object_discrv
}
+melt_ptr_t
+meltgc_new_real (meltobject_ptr_t discr_p, REAL_VALUE_TYPE r)
+{
+ MELT_ENTERFRAME (2, NULL);
+#define resv meltfram__.varptr[0]
+#define discrv meltfram__.varptr[1]
+#define object_discrv ((meltobject_ptr_t)(discrv))
+#define real_resv ((struct meltreal_st*) resv)
+ discrv = (void*) discr_p;
+ if (!discrv)
+ discrv = (meltobject_ptr_t) MELT_PREDEF (DISCR_REAL);
+ if (object_discrv->object_magic != OBMAG_REAL)
+ goto end;
+ resv = meltgc_allocate (sizeof (struct meltreal_st), 0);
+ real_resv->discr = object_discrv;
+ real_resv->val = r;
+end:
+ MELT_EXITFRAME ();
+ return (melt_ptr_t) resv;
+#undef resv
+#undef discrv
+#undef object_discrv
+#undef real_resv
+}
+
/* allocate a new routine object of given DISCR and of length LEN,
with a DESCR-iptive string a a PROC-edure */
meltroutine_ptr_t
@@ -2961,7 +2986,7 @@
return ((meltobject_ptr_t) cont)->obj_vartab[FCONTAINER_VALUE];
}
-/* allocate a new boxed tree of given DISCR [or DISCR_TREE] & content
+/* allocate a new boxedtree of given DISCR [or DISCR_TREE] & content
VAL */
melt_ptr_t
meltgc_new_tree (meltobject_ptr_t discr_p, tree tr)
===================================================================
@@ -1522,6 +1522,7 @@
/* allocate a boxed long integer (or null if bad DISCR) fillen with NUM */
melt_ptr_t meltgc_new_int (meltobject_ptr_t discr, long num);
+/* Retrieve an integer from a boxed integer or mixnumbers. */
static inline long
melt_get_int (melt_ptr_t v)
{
@@ -1540,8 +1541,19 @@
}
}
+/* Make a boxed real from a real value. If discr is NULL, use DISCR_REAL. */
+melt_ptr_t meltgc_new_real(meltobject_ptr_t discr, REAL_VALUE_TYPE r);
+/* Unbox real value. It returns 0 if not a boxed real. */
+static inline REAL_VALUE_TYPE
+melt_get_real (melt_ptr_t v)
+{
+ if (melt_magic_discr (v) == OBMAG_REAL)
+ return ((struct meltreal_st*) v)->val;
+ return dconst0;
+}
+
static inline long
melt_obj_hash (melt_ptr_t v)
{
===================================================================
@@ -96,6 +96,7 @@
DISCR_NAME_STRING
DISCR_NULL_RECEIVER
DISCR_PAIR
+ DISCR_REAL
DISCR_ROUTINE
DISCR_STRBUF
DISCR_STRING