From patchwork Wed Jun 16 08:11:03 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: Real_cst on MELT branch Date: Tue, 15 Jun 2010 22:11:03 -0000 From: jeremie.salvucci@free.fr X-Patchwork-Id: 55859 Message-Id: <2119007922.2926151276675863214.JavaMail.root@zimbra30-e5.priv.proxad.net> To: gcc-patches@gcc.gnu.org Hello all, This patch is useful to handle real type in GIMPLE representation thanks to MELT. It's my first one, so this is the assignments reference : I am an intern with Basile Starynkevitch at CEA-LIST covered by RT 306238 CEA-LIST November 2006 In addition, I am student at the Universite Paris Est which signed GCC disclaimer few months ago. Paolo Bonzini has already checked that everything was done on legal issues. Tested on x86-64 GNU/Linux system. gcc/Changelog.MELT entry 2010-06-16 Jeremie Salvucci * melt-make.mk (warmelt*): Added dependancies on melt-predef.h. * melt-runtime.c: Added meltgc_new_real. * melt/warmelt-first.melt: Added instance of discr_real. * melt/warmelt-ana-base.melt: Added a cmatcher for real_cst. * melt-predef.list: Added discr_real. Cheers. Jeremie Salvucci Index: gcc/melt-make.mk =================================================================== --- gcc/melt-make.mk (revision 160746) +++ gcc/melt-make.mk (working copy) @@ -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=$@ Index: gcc/melt/warmelt-first.melt =================================================================== --- gcc/melt/warmelt-first.melt (revision 160746) +++ gcc/melt/warmelt-first.melt (working copy) @@ -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 Index: gcc/melt/xtramelt-ana-base.melt =================================================================== --- gcc/melt/xtramelt-ana-base.melt (revision 160746) +++ gcc/melt/xtramelt-ana-base.melt (working copy) @@ -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) Index: gcc/melt-runtime.c =================================================================== --- gcc/melt-runtime.c (revision 160746) +++ gcc/melt-runtime.c (working copy) @@ -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) Index: gcc/melt-runtime.h =================================================================== --- gcc/melt-runtime.h (revision 160746) +++ gcc/melt-runtime.h (working copy) @@ -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) { Index: gcc/melt-predef.list =================================================================== --- gcc/melt-predef.list (revision 160746) +++ gcc/melt-predef.list (working copy) @@ -96,6 +96,7 @@ DISCR_NAME_STRING DISCR_NULL_RECEIVER DISCR_PAIR + DISCR_REAL DISCR_ROUTINE DISCR_STRBUF DISCR_STRING