This is now the low-level guile interface to LibGTop. For each of the

1999-12-05  Martin Baulig  <martin@home-of-linux.org>

	This is now the low-level guile interface to LibGTop. For
	each of the LibGTop structures we create a new smob here and
	let the `glibtop-get-<feature>' functions return such a smob.

	* main.c: New file.
	(glibtop_boot_guile_main): Initialize "glibtop-global-server" here.

	* guile.h: New file.

sysdeps/guile/.cvsignore

@@ -7,3 +7,4 @@ so_locations
 libgtop_guile.la
 *.lo
 *.x
+structures.h

sysdeps/guile/ChangeLog

@@ -1,3 +1,14 @@
+1999-12-05  Martin Baulig  <martin@home-of-linux.org>
+
+	This is now the low-level guile interface to LibGTop. For
+	each of the LibGTop structures we create a new smob here and
+	let the `glibtop-get-<feature>' functions return such a smob.
+
+	* main.c: New file.
+	(glibtop_boot_guile_main): Initialize "glibtop-global-server" here.
+
+	* guile.h: New file.
+
 1999-02-04  Martin Baulig  <martin@home-of-linux.org>
 
 	* names/guile-names.awk: Use `_' instead of `gettext'.

sysdeps/guile/Makefile.am

@@ -4,25 +4,32 @@ LINK				= $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@
 
 INCLUDES			= @INCLUDES@
 
-BUILT_SOURCES			= guile.c guile.x
+BUILT_SOURCES			= guile.c guile.x main.x
 
 lib_LTLIBRARIES			= libgtop_guile.la
 
-libgtop_guile_la_SOURCES	= $(BUILT_SOURCES)
+libgtop_guile_la_SOURCES	= main.c guile.h $(BUILT_SOURCES)
 
 libgtop_guile_la_LDFLAGS	= $(LT_VERSION_INFO)
 
 Makefile: $(BUILT_SOURCES)
 
-guile.c: guile.pl $(top_builddir)/config.h $(top_srcdir)/features.def \
+guile.c structures.h:	guile.pl $(top_builddir)/config.h \
-	 $(top_srcdir)/scripts/guile_types.pl
+			$(top_srcdir)/features.def \
-	$(PERL) -I $(top_srcdir)/scripts $(srcdir)/guile.pl < $(top_srcdir)/features.def > gnc-t
+			$(top_srcdir)/structures.def \
+			$(top_srcdir)/scripts/guile_types.pl
+	$(PERL) -I $(top_srcdir)/scripts $(srcdir)/guile.pl \
+		$(top_srcdir)/features.def $(top_srcdir)/structures.def \
+		structures.h > gnc-t
 	mv gnc-t guile.c
 
 guile.x: guile.c
 	guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
 
+main.x: main.c
+	guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
+
 EXTRA_DIST			= guile.pl
 
-CLEANFILES			= guile.c guile.x
+CLEANFILES			= $(BUILT_SOURCES)
 

sysdeps/guile/guile.h

@@ -0,0 +1,50 @@
+/* -*- Mode: C; tab-width: 8; indent-tabs-mode: t; c-basic-offset: 4 -*- */
+
+/* $Id$ */
+
+/* Copyright (C) 1998-99 Martin Baulig
+   This file is part of LibGTop 1.0.
+
+   Contributed by Martin Baulig <martin@home-of-linux.org>, April 1998.
+
+   LibGTop is free software; you can redistribute it and/or modify it
+   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.
+
+   LibGTop 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 LibGTop; see the file COPYING. If not, write to the
+   Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+   Boston, MA 02111-1307, USA.
+*/
+
+#ifndef __GLIBTOP_GUILE_H__
+#define __GLIBTOP_GUILE_H__
+
+#include <glibtop.h>
+#include <glibtop/xmalloc.h>
+#include <glibtop/sysdeps.h>
+#include <glibtop/union.h>
+
+#include <guile/gh.h>
+
+BEGIN_LIBGTOP_DECLS
+
+extern long scm_glibtop_smob_tags [];
+extern SCM scm_glibtop_global_server_smob;
+
+#ifdef _IN_LIBGTOP
+
+void
+glibtop_boot_guile_main (void);
+
+#endif
+
+END_LIBGTOP_DECLS
+
+#endif /* __GLIBTOP_GUILE_H__ */

sysdeps/guile/guile.pl

@@ -2,6 +2,8 @@
 
 require 'guile_types.pl';
 
+die "Usage: $0 features.def structures.def" unless $#ARGV == 2;
+
 $[ = 1;			# set array base to 1
 $, = ' ';		# set output field separator
 $\ = "\n";		# set output record separator
@@ -22,37 +24,92 @@ print '/* guile.c */';
 print "/* This is a generated file.  Please modify `guile.pl' */";
 print '';
 
-print '#include <glibtop.h>';
+print '#include "guile.h"';
-print '#include <glibtop/xmalloc.h>';
+print '#include "structures.h"';
-print '#include <glibtop/sysdeps.h>';
-print '#include <glibtop/union.h>';
-print '';
-print '#include <guile/gh.h>';
-
 print '';
 
 $feature_count = 0;
+$smob_count = 0;
 
-while (<>) {
+$smobs{$smob_count++} = 'glibtop';
+
+open FEATURESDEF, $ARGV[1] or
+  die "open ($ARGV[1]): $!";
+
+while (<FEATURESDEF>) {
   chop;				# strip record separator
   
   if (/^[^\#]/) {
-    &make_output($_);
+    &make_output ($_);
   }
 }
 
-$sep = '';
+close FEATURESDEF;
-$sysdeps = 'void|sysdeps|ulong(';
+
-for ($nr = 0; $nr < $feature_count; $nr++) {
+open STRUCTDEF, $ARGV[2] or
-    $sysdeps = $sysdeps . '' . $sep . '' . $feature_field{$nr};
+  die "open ($ARGV[2]): $!";
-    $sep = ',';
+
+while (<STRUCTDEF>) {
+  chop;				# strip record separator
+  
+  if (/^[^\#]/) {
+    &parse_structure_def ($_);
+  }
 }
-$sysdeps = $sysdeps . ')';
+
-&make_output($sysdeps);
+close STRUCTDEF;
-print 'void';
+
-print 'glibtop_boot_guile (void)';
+$init_smobs_code = sprintf
+  (qq[\tscm_glibtop_smob_tags [GLIBTOP_STRUCTURE_GLIBTOP] = scm_make_smob_type\n\t\t("glibtop", sizeof (glibtop));\n]);
+
+for ($nr = 0; $nr < $smob_count; $nr++) {
+  $smob = $smobs{$nr};
+
+  $init_smobs_code .= sprintf
+    (qq[\tscm_glibtop_smob_tags [GLIBTOP_STRUCTURE_%s] = scm_make_smob_type\n\t\t("%s", sizeof (%s));\n],
+     toupper($smob), $smob, $smob);
+}
+
+open OUTPUT, "> $ARGV[3]" or
+  die "open ($ARGV [3]): $!";
+select OUTPUT;
+
+print qq[/* structures.h */];
+print qq[/* This is a generated file.  Please modify \`guile.pl\' */];
+print '';
+print qq[\#ifndef __GLIBTOP_STRUCTURES_H__];
+print qq[\#define __GLIBTOP_STRUCTURES_H__];
+print '';
+print qq[\#include <glibtop.h>];
+print '';
+print qq[BEGIN_LIBGTOP_DECLS];
+print '';
+
+for ($nr = 0; $nr < $smob_count; $nr++) {
+  $smob = $smobs{$nr};
+
+  printf (qq[\#define %-40s\t%d\n], 'GLIBTOP_STRUCTURE_'.&toupper($smob), $nr);
+}
+
+print '';
+print qq[END_LIBGTOP_DECLS];
+print '';
+print qq[\#endif /* __GLIBTOP_STRUCTURES_H__ */];
+
+close OUTPUT;
+
+select STDOUT;
+
+print qq[void\n];
+print qq[glibtop_boot_guile (void)\n];
 print '{';
-print "#include \"guile.x\"";
+print qq[#ifndef SCM_MAGIC_SNARFER\n];
+print qq[#include "guile.x"\n];
+print qq[#endif\n\n];
+print $init_smobs_code;
+
+print '';
+printf qq[\tglibtop_boot_guile_main ();];
 print '}';
 
 sub make_output {
@@ -69,9 +126,10 @@ sub make_output {
   $feature_field{$feature_count} = $feature;
   $feature_count = $feature_count + 1;
 
+  $smobs{$smob_count++} = sprintf (qq[glibtop_%s], $feature);
+  
   $total_nr_params = 0;
   
-  $temp_list_count = 0;
   $temp_string_count = 0;
   $have_count_var = 0;
   
@@ -82,8 +140,9 @@ sub make_output {
   $pre_call_code = '';
   $post_call_code = '';
   
-  $local_var_decl_code = sprintf (qq[\tglibtop_%s %s;\n\tSCM list;\n],
+  $local_var_decl_code = sprintf (qq[\tglibtop_%s *%s;\n], $feature, $feature);
-				  $feature, $feature);
+  $local_var_decl_code .= sprintf (qq[\tSCM smob_answer;\n]);
+  $local_var_decl_code .= sprintf (qq[\tglibtop *server;\n]);
 
   $call_param = '';
   $param_decl = '';
@@ -120,8 +179,8 @@ sub make_output {
       }
     }
   }
-  if ($param_decl eq '') {
+  if (!($param_decl eq '')) {
-    $param_decl = 'void';
+    $param_decl = ', '.$param_decl;
   }
   
   $nr_params_field{$feature} = $total_nr_params;
@@ -129,12 +188,20 @@ sub make_output {
   $feature_name = $feature;
   $feature_name =~ s/_/-/;
 
+  $field_list_code = '';
+  
+  $init_server_code = sprintf
+    (qq[\tSCM_ASSERT ((SCM_FALSEP (server_smob) ||\n\t\t    (SCM_NIMP (server_smob)\n\t\t     && (SCM_CAR (server_smob) ==\n\t\t\t scm_glibtop_smob_tags [GLIBTOP_STRUCTURE_GLIBTOP]))),\n\t\t    server_smob, SCM_ARG1, "glibtop-get-%s");\n\n], $feature_name);
+
+  $init_server_code .= sprintf
+    (qq[\tserver = SCM_FALSEP (server_smob) ? glibtop_global_server :\n\t\t(glibtop *) SCM_SMOB_DATA (server_smob);\n\n]);
+  
   $scm_proc_code = sprintf
     (qq[SCM_PROC (s_%s, "glibtop-get-%s", %d, 0, 0, glibtop_guile_get_%s);],
-     $feature, $feature_name, $nr_params_field{$feature}, $feature);
+     $feature, $feature_name, $nr_params_field{$feature}+1, $feature);
 
   $func_decl_code = sprintf
-    (qq[static SCM\nglibtop_guile_get_%s (%s)], $feature, $param_decl);
+    (qq[static SCM\nglibtop_guile_get_%s (SCM server_smob%s)], $feature, $param_decl);
   
   if ($retval ne 'void') {
     $local_var_decl_code .= sprintf (qq[\t%s retval;\n], $retval);
@@ -147,14 +214,15 @@ sub make_output {
   }
 
   $libgtop_call_code = sprintf
-    (qq[\t%sglibtop_get_%s (&%s%s);\n\n], $prefix, $feature,
+    (qq[\tsmob_answer = scm_make_smob (scm_glibtop_smob_tags [GLIBTOP_STRUCTURE_GLIBTOP_%s]);\n], toupper($feature));
+
+  $libgtop_call_code .= sprintf
+    (qq[\t%s = (glibtop_%s *) SCM_SMOB_DATA (smob_answer);\n\n], $feature, $feature);
+  
+  $libgtop_call_code .= sprintf
+    (qq[\t%sglibtop_get_%s_l (server, %s%s);\n\n], $prefix, $feature,
      $feature, $call_param);
   
-  $temp_list_code = '';
-  
-  $create_list_code = sprintf
-    ("\tlist = gh_list (gh_ulong2scm (%s.flags),\n\t\t\t", $feature);
-  
   $nr_elements = (@elements = split(/:/, $element_def, 9999));
   for ($element = 1; $element <= $nr_elements; $element++) {
     $list = $elements[$element];
@@ -169,36 +237,36 @@ sub make_output {
 	$fields[$field] = $field_parts[1];
 	$field_parts[2] =~ s/\]//;
 	
-	if (!$have_count_var) {
+	$field_name = $field_parts[0];
-	  $local_var_decl_code .= sprintf (qq[\tlong _LIBGTOP_tmp_i;\n]);
-	  $have_count_var = 1;
-	}
-	
-	$local_var_decl_code .= sprintf
-	  (qq[\tSCM _LIBGTOP_TEMP_list%d;\n], ++$temp_list_count);
-	
-	$temp_list_code .= sprintf
-	  (qq[\t_LIBGTOP_TEMP_list%d = SCM_EOL;\n], $temp_list_count);
-	
-	$temp_list_code .= sprintf
-	  (qq[\tfor (_LIBGTOP_tmp_i = 0; _LIBGTOP_tmp_i < %s; _LIBGTOP_tmp_i++)\n\t\t_LIBGTOP_TEMP_list%d = gh_append2\n\t\t\t(_LIBGTOP_TEMP_list%d,\n\t\t\t gh_list\n\t\t\t (%s (%s.%s [_LIBGTOP_tmp_i]),\n\t\t\t  SCM_UNDEFINED));\n\n], $field_parts[2], $temp_list_count, $temp_list_count, $typeinfo->{$type}->[0], $feature, $fields[$field]);
-	
-	$create_list_code .= sprintf
-	  (qq[_LIBGTOP_TEMP_list%d,\n\t\t\t], $temp_list_count);
       } else {
-	$create_list_code .= sprintf
+	$field_name = $fields[$field];
-	  (qq[%s (%s.%s),\n\t\t\t], $typeinfo->{$type}->[0], $feature,
-	   $fields[$field]);
       }
+
+      $field_list_code .= sprintf
+	(qq[gh_symbol2scm ("%s"), \\\n\t\t\t\t], $field_name);
     }
   }
   
-  $create_list_code .= "SCM_UNDEFINED);\n";
+  $scm_fields_code = sprintf
+    (qq[SCM_GLOBAL_VCELL_INIT (s_%s_names, "glibtop-fields-%s", \\\n\t\t       gh_list (%sSCM_UNDEFINED));],
+    $feature, $feature_name, $field_list_code);
 
-  $total = sprintf ("%s\n\n%s\n{\n%s\n\n%s\n%s\n%s%s\n\n%s\n\treturn list;\n}\n",
+  $return_smob_code = sprintf
-		    $scm_proc_code, $func_decl_code, $local_var_decl_code,
+    (qq[\treturn smob_answer;]);
+  
+  $total = sprintf ("%s\n\n%s\n\n%s\n{\n%s\n\n%s\n%s\n%s%s\n\n%s\n%s\n}\n",
+		    $scm_proc_code, $scm_fields_code, $func_decl_code,
+		    $local_var_decl_code, $init_server_code,
 		    $pre_call_code, $libgtop_call_code, $post_call_code,
-		    $temp_list_code, $create_list_code);
+		    $return_smob_code);
   
   print $total;
 }
+
+sub parse_structure_def {
+  local($line) = @_;
+  @line_fields = split(/\|/, $line, 9999);
+  $name = $line_fields[1];
+
+  $smobs{$smob_count++} = $name;
+}

sysdeps/guile/main.c

@@ -0,0 +1,23 @@
+#include "guile.h"
+#include "structures.h"
+#include <libguile/snarf.h>
+
+SCM scm_glibtop_global_server_smob;
+
+SCM_GLOBAL_VCELL (s_glibtop_global_server, "glibtop-global-server");
+
+void
+glibtop_boot_guile_main (void)
+{
+#ifndef SCM_MAGIC_SNARFER
+#include "main.x"
+#endif
+
+    SCM_NEWSMOB (scm_glibtop_global_server_smob,
+		 scm_glibtop_smob_tags [GLIBTOP_STRUCTURE_GLIBTOP],
+		 glibtop_global_server);
+
+    glibtop_server_ref (glibtop_global_server);
+
+    SCM_SETCDR (s_glibtop_global_server, scm_glibtop_global_server_smob);
+}