diff --git a/sysdeps/guile/.cvsignore b/sysdeps/guile/.cvsignore index db2bb60f..0f496656 100644 --- a/sysdeps/guile/.cvsignore +++ b/sysdeps/guile/.cvsignore @@ -7,3 +7,4 @@ so_locations libgtop_guile.la *.lo *.x +structures.h diff --git a/sysdeps/guile/ChangeLog b/sysdeps/guile/ChangeLog index 7e59c460..c767bfff 100644 --- a/sysdeps/guile/ChangeLog +++ b/sysdeps/guile/ChangeLog @@ -1,3 +1,14 @@ +1999-12-05 Martin Baulig + + 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-' 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 * names/guile-names.awk: Use `_' instead of `gettext'. diff --git a/sysdeps/guile/Makefile.am b/sysdeps/guile/Makefile.am index 16dc42dc..a89403cf 100644 --- a/sysdeps/guile/Makefile.am +++ b/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 \ - $(top_srcdir)/scripts/guile_types.pl - $(PERL) -I $(top_srcdir)/scripts $(srcdir)/guile.pl < $(top_srcdir)/features.def > gnc-t +guile.c structures.h: guile.pl $(top_builddir)/config.h \ + $(top_srcdir)/features.def \ + $(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) diff --git a/sysdeps/guile/guile.h b/sysdeps/guile/guile.h new file mode 100644 index 00000000..2dd8143e --- /dev/null +++ b/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 , 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 +#include +#include +#include + +#include + +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__ */ diff --git a/sysdeps/guile/guile.pl b/sysdeps/guile/guile.pl index d85599e7..ee6c4d75 100644 --- a/sysdeps/guile/guile.pl +++ b/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 '; -print '#include '; -print '#include '; -print '#include '; -print ''; -print '#include '; - +print '#include "guile.h"'; +print '#include "structures.h"'; print ''; $feature_count = 0; +$smob_count = 0; -while (<>) { +$smobs{$smob_count++} = 'glibtop'; + +open FEATURESDEF, $ARGV[1] or + die "open ($ARGV[1]): $!"; + +while () { chop; # strip record separator if (/^[^\#]/) { - &make_output($_); + &make_output ($_); } } -$sep = ''; -$sysdeps = 'void|sysdeps|ulong('; -for ($nr = 0; $nr < $feature_count; $nr++) { - $sysdeps = $sysdeps . '' . $sep . '' . $feature_field{$nr}; - $sep = ','; +close FEATURESDEF; + +open STRUCTDEF, $ARGV[2] or + die "open ($ARGV[2]): $!"; + +while () { + chop; # strip record separator + + if (/^[^\#]/) { + &parse_structure_def ($_); + } } -$sysdeps = $sysdeps . ')'; -&make_output($sysdeps); -print 'void'; -print 'glibtop_boot_guile (void)'; + +close STRUCTDEF; + +$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 ]; +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 { @@ -68,10 +125,11 @@ 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,9 +140,10 @@ sub make_output { $pre_call_code = ''; $post_call_code = ''; - $local_var_decl_code = sprintf (qq[\tglibtop_%s %s;\n\tSCM list;\n], - $feature, $feature); - + $local_var_decl_code = sprintf (qq[\tglibtop_%s *%s;\n], $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 = ''; $nr_params = (@params = split(/:/, $param_def, 9999)); @@ -120,21 +179,29 @@ sub make_output { } } } - if ($param_decl eq '') { - $param_decl = 'void'; + if (!($param_decl eq '')) { + $param_decl = ', '.$param_decl; } $nr_params_field{$feature} = $total_nr_params; $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); @@ -145,16 +212,17 @@ sub make_output { } else { $prefix = ''; } - + $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) { - $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); + $field_name = $field_parts[0]; } else { - $create_list_code .= sprintf - (qq[%s (%s.%s),\n\t\t\t], $typeinfo->{$type}->[0], $feature, - $fields[$field]); + $field_name = $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); + + $return_smob_code = sprintf + (qq[\treturn smob_answer;]); - $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", - $scm_proc_code, $func_decl_code, $local_var_decl_code, + $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; +} diff --git a/sysdeps/guile/main.c b/sysdeps/guile/main.c new file mode 100644 index 00000000..c906e8a6 --- /dev/null +++ b/sysdeps/guile/main.c @@ -0,0 +1,23 @@ +#include "guile.h" +#include "structures.h" +#include + +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); +}