2011-01-19 Basile Starynkevitch <basile@starynkevitch.net>

	* melt/warmelt-base.melt (some_string_value): New cmatcher.

	* melt/warmelt-outobj.melt (generate_runtypesupport_mapfun): Adding
	new function, still incomplete.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@168987 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 193 insertions, 0 deletions

diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt
index bd782ccbce6..962d427130b 100644
--- a/gcc/melt/warmelt-outobj.melt
+++ b/gcc/melt/warmelt-outobj.melt
@@ -6232,6 +6232,7 @@ melt_scanning (melt_ptr_t p)
   
 
 
+
 ;; internal function to generate parameter passing support
 (defun generate_runtypesupport_param (ctytup valdesctup outname outbuf)
   (debug_msg outname "generate_runtypesupport_param outname start")
@@ -6353,6 +6354,196 @@ melt_scanning (melt_ptr_t p)
     )
   )
 
+;;; generate the inlined map functions for map of GTY-ed types.
+
+(defun generate_runtypesupport_mapfun (ctytup outarg outbuf)
+  (debug_msg outarg "generate_runtypesupport_mapfun start")
+  (assert_msg "check ctytup is tuple" (is_multiple ctytup))
+  (assert_msg "check outbuf is buffer" (is_strbuf outbuf))
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_strconst outbuf 
+		     "/** start of code generated by generate_runtypesupport_mapfun **/")
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+;;;
+  (foreach_in_multiple
+   (ctytup)
+   (curctyp :long tix)
+   (debug_msg curctyp "generate runtypesupport_mapfun curctyp")
+   (assert_msg "check curctyp" (is_a curctyp class_ctype_gty))
+   (add2sbuf_strconst outbuf "/*gtyctype #")
+   (add2sbuf_longdec outbuf (+i 1 tix))
+   (add2sbuf_strconst outbuf " ")
+   (add2sbuf_ccomstring outbuf (get_field :named_name curctyp))
+   (add2sbuf_strconst outbuf "*/")
+   (add2sbuf_indentnl outbuf 1)
+   (match curctyp
+	  (?(instance class_ctype_gty
+		      :named_name          ?(some_string_value ?ctypnam)
+		      :ctype_cname         ?(some_string_value ?cname)
+		      :ctypg_mapstruct     ?(some_string_value ?mapstruct)
+		      :ctypg_mapmagic      ?(some_string_value ?mapmagic)
+		      :ctypg_mapdiscr      ?(and ?(instance class_discriminant 
+							    :named_name ?mapdiscrname) ?mapdiscr)
+		      :ctypg_mapunimemb    ?(some_string_value ?mapunimemb)
+		      :ctypg_newmapfun     ?(some_string_value ?newmapfun)
+		      :ctypg_mapgetfun     ?(some_string_value ?mapgetfun)
+		      :ctypg_mapputfun     ?(some_string_value ?mapputfun)
+		      :ctypg_mapremovefun  ?(some_string_value ?mapremovefun)
+	   	      :ctypg_mapcountfun   ?(some_string_value ?mapcountfun)
+	   	      :ctypg_mapsizefun	   ?(some_string_value ?mapsizefun)	 
+	   	      :ctypg_mapnattfun	   ?(some_string_value ?mapnattfun)	 
+	   	      :ctypg_mapnvalfun	   ?(some_string_value ?mapnvalfun)	 
+		      )
+	    (add2sbuf_strconst outbuf "/***map support for GTY ctype ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf " **/")
+	    (add2sbuf_indentnl outbuf 1)
+	    ;;;
+	    ;;; generate the new map function
+	    (add2sbuf_strconst outbuf "static inline melt_ptr_t /*New map for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/ ")
+	    (add2sbuf_string outbuf newmapfun)
+	    (add2sbuf_strconst outbuf " (meltobject_ptr_t discr, unsigned len) {")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_string outbuf 
+ #{$' /*generated map creation */
+ if (melt_magic_discr ((melt_ptr_t) discr) != MELTOBMAG_OBJECT)
+    return NULL;
+ if (discr->meltobj_magic != }#)
+            (add2sbuf_string outbuf mapmagic)
+	    (add2sbuf_string outbuf #{$') /* not map magic */
+    return NULL;
+ return (melt_ptr_t) meltgc_raw_new_mappointers (discr, len);
+} /*end generated new map for }#)
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf " */")
+	    (add2sbuf_indentnl outbuf 0)
+	    ;;;
+	    ;;; generate the map getter function
+	    (add2sbuf_strconst outbuf "static inline melt_ptr_t /* Map getter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/ ")
+	    (add2sbuf_string outbuf mapgetfun)
+	    (add2sbuf_strconst outbuf " (melt_ptr_t map_p, ")
+	    (add2sbuf_string outbuf cname)
+	    (add2sbuf_strconst outbuf "attr) {")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "if (!map_p || !attr ")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf " || melt_magic_discr ((melt_ptr_t) map_p) != ")
+            (add2sbuf_string outbuf mapmagic)
+	    (add2sbuf_strconst outbuf ")")
+	    (add2sbuf_indentnl outbuf 4)
+	    (add2sbuf_strconst outbuf "return NULL;")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "return melt_raw_get_mappointers ((void*)map_p, (void*)attr);")
+	    (add2sbuf_indentnl outbuf 0)
+	    (add2sbuf_strconst outbuf "} /*end generated map getter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/")
+	    (add2sbuf_indentnl outbuf 0)
+	    ;;;
+	    ;;; generate the map putter function
+	    (add2sbuf_strconst outbuf "static inline void /* Map putter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/ ")
+	    (add2sbuf_string outbuf mapputfun)
+	    (add2sbuf_strconst outbuf " (melt_ptr_t map_p, ")
+	    (add2sbuf_string outbuf cname)
+	    (add2sbuf_strconst outbuf "attr, melt_ptr_t valu_p) {")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "if (!map_p || !attr || !valu_p")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf " || melt_magic_discr ((melt_ptr_t) map_p) != ")
+            (add2sbuf_string outbuf mapmagic)
+	    (add2sbuf_strconst outbuf ")")
+	    (add2sbuf_indentnl outbuf 4)
+	    (add2sbuf_strconst outbuf "return;")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "melt_raw_put_mappointers ((void*)map_p, (void*)attr, valu_p);")
+	    (add2sbuf_indentnl outbuf 0)
+	    (add2sbuf_strconst outbuf "} /*end generated map putter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/")
+	    (add2sbuf_indentnl outbuf 0)
+	    ;;;
+	    ;;; generate the map remover function
+	    (add2sbuf_strconst outbuf "static inline void /* Map remover for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/ ")
+	    (add2sbuf_string outbuf mapremovefun)
+	    (add2sbuf_strconst outbuf " (melt_ptr_t map_p, ")
+	    (add2sbuf_string outbuf cname)
+	    (add2sbuf_strconst outbuf "attr, melt_ptr_t valu_p) {")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "if (!map_p || !attr")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf " || melt_magic_discr ((melt_ptr_t) map_p) != ")
+            (add2sbuf_string outbuf mapmagic)
+	    (add2sbuf_strconst outbuf ")")
+	    (add2sbuf_indentnl outbuf 4)
+	    (add2sbuf_strconst outbuf "return;")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "melt_raw_remove_mappointers ((void*)map_p, (void*)attr);")
+	    (add2sbuf_indentnl outbuf 0)
+	    (add2sbuf_strconst outbuf "} /*end generated map remover for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/")
+	    (add2sbuf_indentnl outbuf 0)
+	    ;;;
+	    ;;; generate the map counter function
+	    (add2sbuf_strconst outbuf "static inline unsigned /* Map counter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/ ")
+	    (add2sbuf_string outbuf mapcountfun)
+	    (add2sbuf_strconst outbuf " (struct ")
+	    (add2sbuf_string outbuf mapstruct)
+	    (add2sbuf_strconst outbuf "* map_s) {")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "if (!map_s")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf " || melt_magic_discr ((melt_ptr_t) map_s) != ")
+            (add2sbuf_string outbuf mapmagic)
+	    (add2sbuf_strconst outbuf ")")
+	    (add2sbuf_indentnl outbuf 4)
+	    (add2sbuf_strconst outbuf "return 0;")
+	    (add2sbuf_indentnl outbuf 2)
+	    (add2sbuf_strconst outbuf "return map_s->count;")
+	    (add2sbuf_indentnl outbuf 0)
+	    (add2sbuf_strconst outbuf "} /*end generated map counter for ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf "*/")
+	    (add2sbuf_indentnl outbuf 0)
+	    ;;;
+	    (compile_warning "some missing functions should be generated in generate_runtypesupport_mapfun")
+            ;;;;;;;;;;
+	    ;;; trailer of map support
+	    (add2sbuf_strconst outbuf "/***end of map support for GTY ctype ")
+	    (add2sbuf_string outbuf ctypnam)
+	    (add2sbuf_strconst outbuf " **/")
+	    (add2sbuf_indentnl outbuf 1)
+	    )
+	  (?_
+	   (add2sbuf_strconst outbuf "/*incomplete gtypctype*/")
+	   )
+     );; end match
+   (add2sbuf_indentnl outbuf 1)
+   )					;end foreach ctype
+;;;
+  (add2sbuf_strconst outbuf 
+		     "/** end of code generated by generate_runtypesupport_mapfun **/")
+  (add2sbuf_indentnl outbuf 0)
+  (add2sbuf_indentnl outbuf 0)
+  (debug_msg outarg "generate_runtypesupport_mapfun end")
+  )
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun runtypesupport_docmd (cmd moduldata)
   (debug_msg cmd "start runtypesupport_docmd cmd")
   (debug_msg moduldata "start runtypesupport_docmd moduldata")
@@ -6428,6 +6619,8 @@ melt_scanning (melt_ptr_t p)
       (generate_runtypesupport_scanning sortedctygtytuple
 					sortedvaldesctuple
 					outarg outcodebuf)
+      ;; generate the inlined melt map functions
+      (generate_runtypesupport_mapfun sortedctygtytuple outarg outdeclbuf)
       ;;;;;;;;;;;;;;;;;;
       ;; add a terminating comment and write the files
       ;;