Add the -mvpi_debug VPI module.

This is a place to store interesting debug tools for VPI.
For starters, there is $vpi_tree function.

vpi/Makefile.in

@@ -78,7 +78,9 @@ V2009 = v2009_table.o v2009_enum.o
 
 VHDL_SYS = vhdl_table.o
 
-all: dep system.vpi va_math.vpi v2005_math.vpi v2009.vpi vhdl_sys.vpi $(ALL32)
+VPI_DEBUG = vpi_debug.o
+
+all: dep system.vpi va_math.vpi v2005_math.vpi v2009.vpi vhdl_sys.vpi vpi_debug.vpi $(ALL32)
 
 check: all
 
@@ -87,7 +89,7 @@ clean:
 	rm -f sdf_lexor.c sdf_parse.c sdf_parse.output sdf_parse.h
 	rm -f table_mod_parse.c table_mod_parse.h table_mod_parse.output
 	rm -f table_mod_lexor.c
-	rm -f va_math.vpi v2005_math.vpi v2009.vpi vhdl_sys.vpi
+	rm -f va_math.vpi v2005_math.vpi v2009.vpi vhdl_sys.vpi vpi_debug.vpi
 
 distclean: clean
 	rm -f Makefile config.log
@@ -153,6 +155,9 @@ va_math.vpi: $V ../vvp/libvpi.a
 vhdl_sys.vpi: $(VHDL_SYS) ../vvp/libvpi.a
 	$(CC) @shared@ -o $@ $(VHDL_SYS) -L../vvp $(LDFLAGS) -lvpi $(SYSTEM_VPI_LDFLAGS)
 
+vpi_debug.vpi: $(VPI_DEBUG) ../vvp/libvpi.a
+	$(CC) @shared@ -o $@ $(VPI_DEBUG) -L../vvp $(LDFLAGS) -lvpi $(SYSTEM_VPI_LDFLAGS)
+
 stamp-vpi_config-h: $(srcdir)/vpi_config.h.in ../config.status
 	@rm -f $@
 	cd ..; ./config.status --header=vpi/vpi_config.h
@@ -163,7 +168,8 @@ install: all installdirs \
     $(vpidir)/va_math.vpi $(vpidir)/va_math.sft \
     $(vpidir)/v2005_math.vpi $(vpidir)/v2005_math.sft \
     $(vpidir)/v2009.vpi $(vpidir)/v2009.sft \
-    $(vpidir)/vhdl_sys.vpi $(vpidir)/vhdl_sys.sft
+    $(vpidir)/vhdl_sys.vpi $(vpidir)/vhdl_sys.sft \
+    $(vpidir)/vpi_debug.vpi
 
 $(vpidir)/system.vpi: ./system.vpi
 	$(INSTALL_PROGRAM) ./system.vpi "$(DESTDIR)$(vpidir)/system.vpi"
@@ -195,6 +201,9 @@ $(vpidir)/vhdl_sys.vpi: ./vhdl_sys.vpi
 $(vpidir)/vhdl_sys.sft: vhdl_sys.sft
 	$(INSTALL_DATA) $< "$(DESTDIR)$@"
 
+$(vpidir)/vpi_debug.vpi: ./vpi_debug.vpi
+	$(INSTALL_PROGRAM) ./vpi_debug.vpi "$(DESTDIR)$(vpidir)/vpi_debug.vpi"
+
 installdirs: $(srcdir)/../mkinstalldirs
 	$(srcdir)/../mkinstalldirs "$(DESTDIR)$(libdir)" "$(DESTDIR)$(vpidir)"
 
@@ -209,6 +218,7 @@ uninstall:
 	rm -f "$(DESTDIR)$(vpidir)/v2009.sft"
 	rm -f "$(DESTDIR)$(vpidir)/vhdl_sys.vpi"
 	rm -f "$(DESTDIR)$(vpidir)/vhdl_sys.sft"
+	rm -f "$(DESTDIR)$(vpidir)/vpi_debug.vpi"
 
 -include $(patsubst %.o, dep/%.d, $O)
 -include $(patsubst %.o, dep/%.d, $(OPP))

vpi/vpi_debug.c

@@ -0,0 +1,112 @@
+/*
+ * Copyright (c) 2011 Stephen Williams (steve@icarus.com)
+ *
+ *    This source code is free software; you can redistribute it
+ *    and/or modify it in source code form under the terms of the GNU
+ *    General Public License as published by the Free Software
+ *    Foundation; either version 2 of the License, or (at your option)
+ *    any later version.
+ *
+ *    This program is distributed in the hope that it will be useful,
+ *    but WITHOUT ANY WARRANTY; without even the implied warranty of
+ *    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ *    GNU General Public License for more details.
+ *
+ *    You should have received a copy of the GNU General Public License
+ *    along with this program; if not, write to the Free Software
+ *    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ */
+
+/*
+ * The $vpi_tree(...) system task dumps the scopes listed in the
+ * arguments. If no arguments are given, then dump the scope that
+ * contains the call to the $vpi_tree function.
+ */
+# include  "vpi_user.h"
+# include  <string.h>
+# include  <stdlib.h>
+
+static void dump_object(vpiHandle item)
+{
+      PLI_INT32 item_type = vpi_get(vpiType, item);
+      vpiHandle argv, cur;
+
+      vpi_printf("%s: ", vpi_get_str(vpiFullName, item));
+      vpi_printf("vpiType=%s (%d)\n", vpi_get_str(vpiType, item), item_type);
+
+      switch (item_type) {
+
+	      /* These types are themselves scopes and have objects within. */
+	  case vpiModule:
+	  case vpiFunction:
+	  case vpiTask:
+	  case vpiNamedBegin:
+	  case vpiNamedFork:
+	    argv = vpi_iterate(vpiScope, item);
+	    for (cur = vpi_scan(argv) ; cur ; cur = vpi_scan(argv))
+		  dump_object(cur);
+	    break;
+#if 0
+	  case vpiRegArray:
+	  case vpiNetArray:
+	    vpi_printf("%s: ", vpi_get_str(vpiFullName, item));
+	    vpi_printf("vpiType=%s (%d)\n", vpi_get_str(vpiType, item), item_type);
+	    argv = vpi_iterate(vpiMember, item);
+	    for (cur = vpi_scan(argv) ; cur ; cur = vpi_scan(argv))
+		  dump_object(cur);
+	    break;
+#endif
+	      /* vpiMemory contains words. */
+	  case vpiMemory:
+	    argv = vpi_iterate(vpiMemoryWord, item);
+	    for (cur = vpi_scan(argv) ; cur ; cur = vpi_scan(argv))
+		  dump_object(cur);
+
+	    break;
+
+	  default:
+	    break;
+      }
+}
+
+static PLI_INT32 vpi_tree_compiletf(ICARUS_VPI_CONST PLI_BYTE8*name)
+{
+      return 0;
+}
+
+static PLI_INT32 vpi_tree_calltf(ICARUS_VPI_CONST PLI_BYTE8*name)
+{
+      vpiHandle callh = vpi_handle(vpiSysTfCall, 0);
+      vpiHandle argv = vpi_iterate(vpiArgument, callh);
+      vpiHandle item;
+
+      if (argv == 0) {
+	    item = vpi_handle(vpiScope, callh);
+	    dump_object(item);
+	    return 0;
+      }
+
+      for (item = vpi_scan(argv) ; item ; item = vpi_scan(argv))
+	    dump_object(item);
+
+      return 0;
+}
+
+void sys_register()
+{
+      s_vpi_systf_data tf_data;
+      vpiHandle res;
+
+      tf_data.type      = vpiSysTask;
+      tf_data.tfname    = "$vpi_tree";
+      tf_data.calltf    = vpi_tree_calltf;
+      tf_data.compiletf = vpi_tree_compiletf;
+      tf_data.sizetf    = 0;
+      tf_data.user_data = "$vpi_tree";
+      res = vpi_register_systf(&tf_data);
+}
+
+void (*vlog_startup_routines[])() = {
+      sys_register,
+      0
+};