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.
This commit is contained in:
Martin Baulig
committed by
Martin Baulig
Martin Baulig
parent
d48d48cafb
commit
ff9f90c7e6
@@ -7,3 +7,4 @@ so_locations
|
||||
libgtop_guile.la
|
||||
*.lo
|
||||
*.x
|
||||
structures.h
|
||||
|
||||
@@ -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'.
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
50
sysdeps/guile/guile.h
Normal file
50
sysdeps/guile/guile.h
Normal file
@@ -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__ */
|
||||
@@ -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 <glibtop/xmalloc.h>';
|
||||
print '#include <glibtop/sysdeps.h>';
|
||||
print '#include <glibtop/union.h>';
|
||||
print '';
|
||||
print '#include <guile/gh.h>';
|
||||
|
||||
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 (<FEATURESDEF>) {
|
||||
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 (<STRUCTDEF>) {
|
||||
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 <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 {
|
||||
@@ -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;
|
||||
}
|
||||
|
||||
23
sysdeps/guile/main.c
Normal file
23
sysdeps/guile/main.c
Normal file
@@ -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);
|
||||
}
|
||||
Reference in New Issue
Block a user