Moved all Guile code to the libgtop-bindings module.
1999-12-05 Martin Baulig <martin@home-of-linux.org> Moved all Guile code to the libgtop-bindings module. * sysdeps/guile/*: Removed. * sysdeps/guile/names/*: Removed. * libgtopConf.sh.in: Removed all guile variables. * configure.in: Don't check for guile any longer.
This commit is contained in:
Martin Baulig
committed by
Martin Baulig
Martin Baulig
parent
117af5f59b
commit
8e9a0fbe99
11
ChangeLog
11
ChangeLog
@@ -1,3 +1,14 @@
|
||||
1999-12-05 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
Moved all Guile code to the libgtop-bindings module.
|
||||
|
||||
* sysdeps/guile/*: Removed.
|
||||
* sysdeps/guile/names/*: Removed.
|
||||
|
||||
* libgtopConf.sh.in: Removed all guile variables.
|
||||
|
||||
* configure.in: Don't check for guile any longer.
|
||||
|
||||
1999-12-05 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* lib/structures.pl: New script to create `structures.h' which will
|
||||
|
||||
@@ -64,10 +64,6 @@ libgtopConf.sh: libgtopConf.sh.in Makefile
|
||||
-e 's#\@LIBGTOP_INCS\@#$(LIBGTOP_INCS)#g' \
|
||||
-e 's#\@LIBGTOP_NAMES_LIBS\@#$(LIBGTOP_NAMES_LIBS)#g' \
|
||||
-e 's#\@LIBGTOP_NAMES_INCS\@#$(LIBGTOP_NAMES_INCS)#g' \
|
||||
-e 's#\@LIBGTOP_GUILE_LIBS\@#$(LIBGTOP_GUILE_LIBS)#g' \
|
||||
-e 's#\@LIBGTOP_GUILE_INCS\@#$(LIBGTOP_GUILE_INCS)#g' \
|
||||
-e 's#\@LIBGTOP_GUILE_NAMES_LIBS\@#$(LIBGTOP_GUILE_NAMES_LIBS)#g' \
|
||||
-e 's#\@LIBGTOP_GUILE_NAMES_INCS\@#$(LIBGTOP_GUILE_NAMES_INCS)#g' \
|
||||
-e 's#\@LIBGTOP_BINDIR\@#$(LIBGTOP_BINDIR)#g' \
|
||||
-e 's#\@LIBGTOP_SERVER\@#$(LIBGTOP_SERVER)#g' \
|
||||
-e 's#\@LIBGTOP_MAJOR_VERSION\@#$(LIBGTOP_MAJOR_VERSION)#g' \
|
||||
@@ -79,7 +75,6 @@ libgtopConf.sh: libgtopConf.sh.in Makefile
|
||||
-e 's#\@libgtop_sysdeps_dir\@#$(libgtop_sysdeps_dir)#g' \
|
||||
-e 's#\@libgtop_need_server\@#$(libgtop_need_server)#g' \
|
||||
-e 's#\@libgtop_use_machine_h\@#$(libgtop_use_machine_h)#g' \
|
||||
-e 's#\@libgtop_guile_found\@#$(libgtop_guile_found)#g' \
|
||||
< $(srcdir)/libgtopConf.sh.in > libgtopConf.tmp \
|
||||
&& mv libgtopConf.tmp libgtopConf.sh
|
||||
|
||||
|
||||
@@ -122,7 +122,6 @@
|
||||
#undef HAVE_LIBZ
|
||||
#undef HAVE_LIBPNG
|
||||
#undef HAVE_GMP2_INCLUDE_DIR
|
||||
#undef HAVE_GUILE
|
||||
|
||||
#undef ssize_t
|
||||
#undef u_int64_t
|
||||
@@ -131,8 +130,6 @@
|
||||
#undef HAVE_GLIBTOP_MACHINE_H
|
||||
|
||||
#undef GLIBTOP_NAMES
|
||||
#undef GLIBTOP_GUILE
|
||||
#undef GLIBTOP_GUILE_NAMES
|
||||
#undef GLIBTOP_EXAMPLES
|
||||
#undef GLIBTOP_INODEDB
|
||||
|
||||
|
||||
54
configure.in
54
configure.in
@@ -113,14 +113,6 @@ AM_CONDITIONAL(CROSS_COMPILING, test "x$cross_compiling" = xyes)
|
||||
GNOME_LIBGTOP_SYSDEPS
|
||||
GNOME_LIBGTOP_TYPES
|
||||
|
||||
AC_ARG_WITH(libgtop-guile,
|
||||
[ --with-libgtop-guile Build the libgtop guile interface (default=no)],
|
||||
[build_guile="$withval"], [build_guile=yes])
|
||||
|
||||
if test x$build_guile != xno ; then
|
||||
GNOME_CHECK_GUILE
|
||||
fi
|
||||
|
||||
AC_ARG_WITH(libgtop-inodedb,
|
||||
[ --with-libgtop-inodedb Build the inodedb stuff (default=no)],
|
||||
[build_inodedb="$withval"], [build_inodedb=no])
|
||||
@@ -139,21 +131,9 @@ fi
|
||||
|
||||
AC_DEFINE(GLIBTOP_NAMES)
|
||||
|
||||
if test x$ac_cv_guile_found = xyes ; then
|
||||
AC_DEFINE(GLIBTOP_GUILE)
|
||||
AC_DEFINE(GLIBTOP_GUILE_NAMES)
|
||||
libgtop_guile_found=yes
|
||||
guile_subdirs='guile'
|
||||
else
|
||||
libgtop_guile_found=no
|
||||
guile_subdirs=
|
||||
fi
|
||||
|
||||
AM_CONDITIONAL(ENABLE_STATIC, test x$enable_static = xyes)
|
||||
AM_CONDITIONAL(ENABLE_SHARED, test x$enable_static = xyes)
|
||||
|
||||
AC_SUBST(guile_subdirs)
|
||||
|
||||
AM_PROG_LIBTOOL
|
||||
|
||||
AM_PATH_GLIB(1.2.0,,AC_MSG_ERROR(GLIB >= 1.2.0 is required for LibGTop))
|
||||
@@ -353,23 +333,12 @@ fi
|
||||
|
||||
LIBGTOP_INCS="$LIBGTOP_INCS $SUPPORTINCS $GLIB_CFLAGS"
|
||||
|
||||
LIBGTOP_GUILE_LIBS="$LIBGTOP_LIBS"
|
||||
LIBGTOP_GUILE_INCS="$LIBGTOP_INCS"
|
||||
LIBGTOP_BINDIR='$(bindir)'
|
||||
LIBGTOP_SERVER='$(bindir)/libgtop_server'
|
||||
|
||||
sysdeps_dir="$libgtop_sysdeps_dir"
|
||||
AC_SUBST(sysdeps_dir)
|
||||
|
||||
if test x$ac_cv_guile_found = xyes ; then
|
||||
LIBGTOP_GUILE_LIBS="$LIBGTOP_GUILE_LIBS -lgtop_guile"
|
||||
libgtop_guile_found=yes
|
||||
else
|
||||
libgtop_guile_found=no
|
||||
fi
|
||||
|
||||
AC_SUBST(libgtop_guile_found)
|
||||
|
||||
if test -z "$LIBGTOP_EXTRA_LIBS" ; then
|
||||
LIBGTOP_EXTRA_LIBS="$libs_xauth"
|
||||
else
|
||||
@@ -379,34 +348,19 @@ fi
|
||||
LIBGTOP_EXTRA_LIBS="$LIBGTOP_EXTRA_LIBS $GLIB_LIBS"
|
||||
|
||||
LIBGTOP_LIBS="$LIBGTOP_LIBS -lgtop -lgtop_sysdeps -lgtop_common"
|
||||
LIBGTOP_GUILE_LIBS="$LIBGTOP_GUILE_LIBS -lgtop -lgtop_sysdeps -lgtop_common"
|
||||
|
||||
LIBGTOP_NAMES_LIBS="$LIBGTOP_LIBS -lgtop_names"
|
||||
LIBGTOP_GUILE_NAMES_LIBS="$LIBGTOP_GUILE_LIBS -lgtop_guile_names -lgtop_names"
|
||||
|
||||
LIBGTOP_LIBS="$LIBGTOP_LIBS"
|
||||
LIBGTOP_NAMES_LIBS="$LIBGTOP_NAMES_LIBS"
|
||||
LIBGTOP_GUILE_LIBS="$LIBGTOP_GUILE_LIBS"
|
||||
LIBGTOP_GUILE_NAMES_LIBS="$LIBGTOP_GUILE_NAMES_LIBS"
|
||||
|
||||
LIBGTOP_GUILE_LIBS="$LIBGTOP_GUILE_LIBS $GUILE_LIBS"
|
||||
LIBGTOP_GUILE_INCS="$LIBGTOP_GUILE_INCS $GUILE_INCS -DGLIBTOP_GUILE"
|
||||
|
||||
LIBGTOP_NAMES_INCS="$LIBGTOP_INCS -DGLIBTOP_NAMES"
|
||||
LIBGTOP_GUILE_NAMES_INCS="$LIBGTOP_GUILE_INCS -DGLIBTOP_GUILE_NAMES"
|
||||
LIBGTOP_GUILE_NAMES_INCS="$LIBGTOP_GUILE_INCS -DGLIBTOP_NAMES"
|
||||
|
||||
machine_incs="-I\$(top_srcdir)/sysdeps/$sysdeps_dir"
|
||||
|
||||
AC_SUBST(machine_incs)
|
||||
|
||||
if test x$libgtop_guile_found = xyes ; then
|
||||
guile_def="-DGLIBTOP_GUILE -DGLIBTOP_GUILE_NAMES $GUILE_INCS "
|
||||
else
|
||||
guile_def=""
|
||||
fi
|
||||
|
||||
INCLUDES="-D_IN_LIBGTOP -D_GNU_SOURCE -DGLIBTOP_NAMES -I\$(top_builddir) -I\$(top_srcdir) -I\$(top_srcdir)/sysdeps/$sysdeps_dir -I\$(top_srcdir)/include -I\$(top_srcdir)/intl $SUPPORTINCS $GLIB_CFLAGS $CFLAGS $X_CFLAGS $guile_def "'-DGTOPLOCALEDIR=\"$(datadir)/locale\" -DLIBGTOP_VERSION=\"'"$LIBGTOP_VERSION"'\" -DLIBGTOP_SERVER_VERSION=\"'"$LIBGTOP_SERVER_VERSION"'\" -DLIBGTOP_VERSION_CODE='$LIBGTOP_VERSION_CODE' -DLIBGTOP_SERVER=\"'"$LIBGTOP_SERVER"'\"'
|
||||
INCLUDES="-D_IN_LIBGTOP -D_GNU_SOURCE -DGLIBTOP_NAMES -I\$(top_builddir) -I\$(top_srcdir) -I\$(top_srcdir)/sysdeps/$sysdeps_dir -I\$(top_srcdir)/include -I\$(top_srcdir)/intl $SUPPORTINCS $GLIB_CFLAGS $CFLAGS $X_CFLAGS "'-DGTOPLOCALEDIR=\"$(datadir)/locale\" -DLIBGTOP_VERSION=\"'"$LIBGTOP_VERSION"'\" -DLIBGTOP_SERVER_VERSION=\"'"$LIBGTOP_SERVER_VERSION"'\" -DLIBGTOP_VERSION_CODE='$LIBGTOP_VERSION_CODE' -DLIBGTOP_SERVER=\"'"$LIBGTOP_SERVER"'\"'
|
||||
|
||||
AC_SUBST(INCLUDES)
|
||||
|
||||
@@ -416,10 +370,6 @@ AC_SUBST(LIBGTOP_LIBS)
|
||||
AC_SUBST(LIBGTOP_INCS)
|
||||
AC_SUBST(LIBGTOP_NAMES_LIBS)
|
||||
AC_SUBST(LIBGTOP_NAMES_INCS)
|
||||
AC_SUBST(LIBGTOP_GUILE_LIBS)
|
||||
AC_SUBST(LIBGTOP_GUILE_INCS)
|
||||
AC_SUBST(LIBGTOP_GUILE_NAMES_LIBS)
|
||||
AC_SUBST(LIBGTOP_GUILE_NAMES_INCS)
|
||||
AC_SUBST(LIBGTOP_BINDIR)
|
||||
AC_SUBST(LIBGTOP_SERVER)
|
||||
|
||||
@@ -577,8 +527,6 @@ include/glibtop/Makefile
|
||||
sysdeps/Makefile
|
||||
sysdeps/common/Makefile
|
||||
sysdeps/names/Makefile
|
||||
sysdeps/guile/Makefile
|
||||
sysdeps/guile/names/Makefile
|
||||
sysdeps/stub/Makefile
|
||||
sysdeps/stub_suid/Makefile
|
||||
sysdeps/sun4/Makefile
|
||||
|
||||
@@ -10,6 +10,10 @@ libgtop_la_SOURCES = init.c open.c close.c command.c read.c \
|
||||
|
||||
libgtop_la_LDFLAGS = $(LT_VERSION_INFO)
|
||||
|
||||
glibtopdir = $(includedir)/glibtop
|
||||
|
||||
glibtop_HEADERS = structures.h
|
||||
|
||||
BUILT_SOURCES = lib.c structures.h
|
||||
|
||||
lib.c: lib.pl $(top_builddir)/config.h $(top_srcdir)/features.def $(top_srcdir)/scripts/c_types.pl
|
||||
|
||||
@@ -92,7 +92,7 @@ sub parse_features_def {
|
||||
$feature =~ s/^@//;
|
||||
$features{$feature} = $feature;
|
||||
|
||||
$structures{$structure_count++} = $feature;
|
||||
$structures{$structure_count++} = 'glibtop_'.$feature;
|
||||
}
|
||||
|
||||
sub parse_structure_def {
|
||||
|
||||
@@ -15,12 +15,6 @@ LIBGTOP_INCS="@LIBGTOP_INCS@"
|
||||
LIBGTOP_NAMES_LIBS="@LIBGTOP_NAMES_LIBS@"
|
||||
LIBGTOP_NAMES_INCS="@LIBGTOP_NAMES_INCS@"
|
||||
|
||||
LIBGTOP_GUILE_LIBS="@LIBGTOP_GUILE_LIBS@"
|
||||
LIBGTOP_GUILE_INCS="@LIBGTOP_GUILE_INCS@"
|
||||
|
||||
LIBGTOP_GUILE_NAMES_LIBS="@LIBGTOP_GUILE_NAMES_LIBS@"
|
||||
LIBGTOP_GUILE_NAMES_INCS="@LIBGTOP_GUILE_NAMES_INCS@"
|
||||
|
||||
LIBGTOP_BINDIR="@LIBGTOP_BINDIR@"
|
||||
LIBGTOP_SERVER="@LIBGTOP_SERVER@"
|
||||
|
||||
@@ -39,6 +33,4 @@ libgtop_sysdeps_dir="@libgtop_sysdeps_dir@"
|
||||
libgtop_need_server="@libgtop_need_server@"
|
||||
libgtop_use_machine_h="@libgtop_use_machine_h@"
|
||||
|
||||
libgtop_guile_found="@libgtop_guile_found@"
|
||||
|
||||
libgtop_want_examples="@libgtop_want_examples@"
|
||||
|
||||
@@ -1,10 +1,4 @@
|
||||
if GUILE
|
||||
guile_SUBDIRS = guile
|
||||
else
|
||||
guile_SUBDIRS =
|
||||
endif
|
||||
SUBDIRS = @sysdeps_dir@ common names
|
||||
|
||||
SUBDIRS = @sysdeps_dir@ common names $(guile_SUBDIRS)
|
||||
|
||||
DIST_SUBDIRS = common guile linux kernel names osf1 \
|
||||
DIST_SUBDIRS = common linux kernel names osf1 \
|
||||
stub stub_suid sun4 freebsd solaris
|
||||
|
||||
@@ -1,10 +0,0 @@
|
||||
.deps
|
||||
.libs
|
||||
Makefile
|
||||
Makefile.in
|
||||
guile.c
|
||||
so_locations
|
||||
libgtop_guile.la
|
||||
*.lo
|
||||
*.x
|
||||
structures.h
|
||||
@@ -1,61 +0,0 @@
|
||||
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'.
|
||||
|
||||
1999-01-22 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* names/guile-names.awk: Use a `(TYPE . DIMENSION)' pair for
|
||||
array types in `glibtop-types-*'.
|
||||
|
||||
1998-12-09 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* guile.awk: For arrays, make a gh_list out of it and add this list
|
||||
to the returned list instead of adding all array fields there.
|
||||
|
||||
1998-12-08 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* guile.awk (glibtop-get-sysdeps): New guile function.
|
||||
|
||||
* guile.awk (glibtop_get_proc_map): Make a gh_list for each map
|
||||
entry and append all of them to the returned list.
|
||||
(glibtop_get_mountlist): Likewise.
|
||||
|
||||
1998-10-20 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* guile.awk: If the features.def contains something like
|
||||
`fieldname[number]' we interpret this as an array and add all
|
||||
members of this array.
|
||||
|
||||
1998-10-12 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* Makefile.am: Let the `Makefile' depend upon $(BUILT_SOURCES).
|
||||
This is required to get dependencies correctly.
|
||||
* names/Makefile.am: Likewise.
|
||||
|
||||
1998-10-11 Martin Baulig <martin@home-of-linux.org>
|
||||
|
||||
* names/Makefile.am (BUILT_SOURCES, CLEANFILES): Added
|
||||
`guile-names.x' here and a rule to make it from `guile-names.c'
|
||||
using guile-snarf.
|
||||
|
||||
* names/guile-names.awk: Use the SCM_GLOBAL_VCELL macros and
|
||||
guile-snarf here; declared all `glibtop_guile_*' functions static.
|
||||
|
||||
* guile.awk: Declared all `glibtop_guile_get_*' functions static.
|
||||
|
||||
* Makefile.am (BUILT_SOURCES, CLEANFILES): Added `guile.x'.
|
||||
Added rule to make `guile.x' from `guile.c' using guile-snarf.
|
||||
|
||||
* guile.awk: Use the SCM_PROC macros and guile-snarf here.
|
||||
|
||||
@@ -1,35 +0,0 @@
|
||||
SUBDIRS = names
|
||||
|
||||
LINK = $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@
|
||||
|
||||
INCLUDES = @INCLUDES@
|
||||
|
||||
BUILT_SOURCES = guile.c guile.x main.x
|
||||
|
||||
lib_LTLIBRARIES = libgtop_guile.la
|
||||
|
||||
libgtop_guile_la_SOURCES = main.c guile.h $(BUILT_SOURCES)
|
||||
|
||||
libgtop_guile_la_LDFLAGS = $(LT_VERSION_INFO)
|
||||
|
||||
Makefile: $(BUILT_SOURCES)
|
||||
|
||||
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 = $(BUILT_SOURCES)
|
||||
|
||||
@@ -1,50 +0,0 @@
|
||||
/* -*- 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__ */
|
||||
@@ -1,328 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
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
|
||||
|
||||
sub toupper {
|
||||
local($_) = @_;
|
||||
tr/a-z/A-Z/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
sub tolower {
|
||||
local($_) = @_;
|
||||
tr/A-Z/a-z/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
print '/* guile.c */';
|
||||
print "/* This is a generated file. Please modify `guile.pl' */";
|
||||
print '';
|
||||
|
||||
print '#include "guile.h"';
|
||||
print '#include "structures.h"';
|
||||
print '';
|
||||
|
||||
$feature_count = 0;
|
||||
$smob_count = 0;
|
||||
|
||||
$smobs{$smob_count++} = 'glibtop';
|
||||
|
||||
open FEATURESDEF, $ARGV[1] or
|
||||
die "open ($ARGV[1]): $!";
|
||||
|
||||
while (<FEATURESDEF>) {
|
||||
chop; # strip record separator
|
||||
|
||||
if (/^[^\#]/) {
|
||||
&make_output ($_);
|
||||
}
|
||||
}
|
||||
|
||||
close FEATURESDEF;
|
||||
|
||||
open STRUCTDEF, $ARGV[2] or
|
||||
die "open ($ARGV[2]): $!";
|
||||
|
||||
while (<STRUCTDEF>) {
|
||||
chop; # strip record separator
|
||||
|
||||
if (/^[^\#]/) {
|
||||
&parse_structure_def ($_);
|
||||
}
|
||||
}
|
||||
|
||||
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 '';
|
||||
printf (qq[\#define %-40s\t%d\n], 'GLIBTOP_MAX_STRUCTURES', $smob_count);
|
||||
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 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 {
|
||||
local($line) = @_;
|
||||
@line_fields = split(/\|/, $line, 9999);
|
||||
$retval = $line_fields[1];
|
||||
$element_def = $line_fields[3];
|
||||
$feature = $line_fields[2];
|
||||
$param_def = $line_fields[4];
|
||||
|
||||
$feature =~ s/^@//;
|
||||
$features{$feature} = $feature;
|
||||
|
||||
$feature_field{$feature_count} = $feature;
|
||||
$feature_count = $feature_count + 1;
|
||||
|
||||
$smobs{$smob_count++} = sprintf (qq[glibtop_%s], $feature);
|
||||
|
||||
$total_nr_params = 0;
|
||||
|
||||
$temp_string_count = 0;
|
||||
$have_count_var = 0;
|
||||
|
||||
$pre_call_code = '';
|
||||
$post_call_code = '';
|
||||
|
||||
$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));
|
||||
for ($param = 1; $param <= $nr_params; $param++) {
|
||||
$list = $params[$param];
|
||||
$type = $params[$param];
|
||||
$type =~ s/\(.*//;
|
||||
$list =~ s/^.*\(//;
|
||||
$list =~ s/\)$//;
|
||||
$count = (@fields = split(/,/, $list, 9999));
|
||||
$total_nr_params = $total_nr_params + $count;
|
||||
for ($field = 1; $field <= $count; $field++) {
|
||||
if ($param_decl ne '') {
|
||||
$param_decl = $param_decl . ', ';
|
||||
}
|
||||
$param_decl = $param_decl . 'SCM ' . $fields[$field];
|
||||
if ($type eq 'string') {
|
||||
$local_var_decl_code .= sprintf
|
||||
(qq[\tchar *_LIBGTOP_TEMP_str%d;\n], ++$temp_string_count);
|
||||
|
||||
$pre_call_code .= sprintf
|
||||
(qq[\t_LIBGTOP_TEMP_str%d = gh_scm2newstr (%s, NULL);\n],
|
||||
$temp_string_count, $fields[$field]);
|
||||
|
||||
$post_call_code .= sprintf
|
||||
(qq[\tfree (_LIBGTOP_TEMP_str%d);\n], $temp_string_count);
|
||||
|
||||
$call_param .= sprintf
|
||||
(qq[, _LIBGTOP_TEMP_str%d], $temp_string_count);
|
||||
} else {
|
||||
$call_param .= sprintf
|
||||
(qq[, %s (%s)], $typeinfo->{$type}->[2], $fields[$field]);
|
||||
}
|
||||
}
|
||||
}
|
||||
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}+1, $feature);
|
||||
|
||||
$func_decl_code = sprintf
|
||||
(qq[static SCM\nglibtop_guile_get_%s (SCM server_smob%s)], $feature, $param_decl);
|
||||
|
||||
if ($retval =~ /^(array|pointer)\((.*)\)$/) {
|
||||
$retval_type = "$2 *";
|
||||
} elsif ($retval eq 'retval') {
|
||||
$retval_type = 'int';
|
||||
} else {
|
||||
$retval_type = $retval;
|
||||
}
|
||||
|
||||
if ($retval ne 'void') {
|
||||
$local_var_decl_code .= sprintf (qq[\t%s retval;\n], $retval_type);
|
||||
}
|
||||
|
||||
if ($retval ne 'void') {
|
||||
$prefix = 'retval = ';
|
||||
} else {
|
||||
$prefix = '';
|
||||
}
|
||||
|
||||
$libgtop_call_code = sprintf
|
||||
(qq[\t%sglibtop_get_%s_l (server, &%s%s);\n\n], $prefix, $feature,
|
||||
$feature, $call_param);
|
||||
|
||||
if ($retval eq 'retval') {
|
||||
$check_retval_code = sprintf
|
||||
(qq[\tif (retval < 0)\n\t\treturn SCM_BOOL_F;\n]);
|
||||
} elsif ($retval =~ /^(array|pointer)\((.*)\)$/) {
|
||||
$check_retval_code = sprintf
|
||||
(qq[\tif (retval == NULL)\n\t\treturn SCM_BOOL_F;\n]);
|
||||
} else {
|
||||
$check_retval_code = '';
|
||||
}
|
||||
|
||||
$make_smob_code = sprintf
|
||||
(qq[\tsmob_answer = scm_make_smob\n\t\t(scm_glibtop_smob_tags [GLIBTOP_STRUCTURE_GLIBTOP_%s]);\n], toupper($feature));
|
||||
|
||||
$make_smob_code .= sprintf
|
||||
(qq[\t*(glibtop_%s *) SCM_SMOB_DATA (smob_answer) = %s;\n\n],
|
||||
$feature, $feature);
|
||||
|
||||
if ($retval =~ /^(array|pointer)\((.*)\)$/) {
|
||||
$array_type = $2; $which_type = $1;
|
||||
|
||||
$local_var_decl_code .= sprintf (qq[\tSCM smob_array;\n]);
|
||||
$local_var_decl_code .= sprintf (qq[\tint i;\n]);
|
||||
|
||||
$make_array_code = sprintf
|
||||
(qq[\tsmob_array = scm_make_vector (SCM_MAKINUM (%s.number), %s);\n],
|
||||
$feature, 'SCM_BOOL_F');
|
||||
|
||||
$make_array_code .= sprintf
|
||||
(qq[\tfor (i = 0; i < %s.number; i++) \{\n], $feature);
|
||||
|
||||
if ($which_type eq 'array') {
|
||||
$make_array_code .= sprintf
|
||||
(qq[\t\tSCM _smob;\n\n], $feature);
|
||||
|
||||
$make_array_code .= sprintf
|
||||
(qq[\t\t_smob = scm_make_smob\n\t\t\t(scm_glibtop_smob_tags\n\t\t\t [GLIBTOP_STRUCTURE_%s]);\n], toupper($array_type));
|
||||
|
||||
$make_array_code .= sprintf
|
||||
(qq[\t\t*(%s *) SCM_SMOB_DATA (_smob) = retval [i];\n], $array_type);
|
||||
|
||||
$make_array_code .= sprintf
|
||||
(qq[\t\tscm_vector_set_x (smob_array, SCM_MAKINUM (i), _smob);\n]);
|
||||
} else {
|
||||
$make_array_code .= sprintf
|
||||
(qq[\t\tscm_vector_set_x (smob_array, SCM_MAKINUM (i),\n\t\t\t\t %s (retval [i]));\n],
|
||||
$typeinfo->{$array_type}->[1]);
|
||||
}
|
||||
|
||||
$make_array_code .= "\t}\n\n";
|
||||
|
||||
$return_smob_code = $make_array_code;
|
||||
|
||||
$return_smob_code .= sprintf
|
||||
(qq[\treturn scm_cons (smob_array, smob_answer);]);
|
||||
} else {
|
||||
$return_smob_code = sprintf
|
||||
(qq[\treturn smob_answer;]);
|
||||
}
|
||||
|
||||
$nr_elements = (@elements = split(/:/, $element_def, 9999));
|
||||
for ($element = 1; $element <= $nr_elements; $element++) {
|
||||
$list = $elements[$element];
|
||||
$type = $elements[$element];
|
||||
$type =~ s/\(.*//;
|
||||
$list =~ s/^.*\(//;
|
||||
$list =~ s/\)$//;
|
||||
$count = (@fields = split(/,/, $list, 9999));
|
||||
for ($field = 1; $field <= $count; $field++) {
|
||||
if ($fields[$field] =~ /^(\w+)\[([^\]]+)\]$/) {
|
||||
@field_parts = split(/\[/, $fields[$field], 9999);
|
||||
$fields[$field] = $field_parts[1];
|
||||
$field_parts[2] =~ s/\]//;
|
||||
|
||||
$field_name = $field_parts[0];
|
||||
} else {
|
||||
$field_name = $fields[$field];
|
||||
}
|
||||
|
||||
$field_list_code .= sprintf
|
||||
(qq[gh_symbol2scm ("%s"), \\\n\t\t\t\t], $field_name);
|
||||
}
|
||||
}
|
||||
|
||||
$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\n%s\n%s\n%s%s\n\n%s\n%s\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,
|
||||
$check_retval_code, $make_smob_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;
|
||||
}
|
||||
@@ -1,24 +0,0 @@
|
||||
#include "guile.h"
|
||||
#include "structures.h"
|
||||
#include <libguile/snarf.h>
|
||||
|
||||
long scm_glibtop_smob_tags [GLIBTOP_MAX_STRUCTURES];
|
||||
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);
|
||||
}
|
||||
@@ -1,10 +0,0 @@
|
||||
.deps
|
||||
so_locations
|
||||
.libs
|
||||
Makefile
|
||||
guile-names.c
|
||||
Makefile.in
|
||||
libgtop_guile.la
|
||||
libgtop_guile_names.la
|
||||
*.lo
|
||||
*.x
|
||||
@@ -1,25 +0,0 @@
|
||||
LINK = $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@
|
||||
|
||||
INCLUDES = @INCLUDES@
|
||||
|
||||
lib_LTLIBRARIES = libgtop_guile_names.la
|
||||
|
||||
BUILT_SOURCES = guile-names.c guile-names.x
|
||||
|
||||
libgtop_guile_names_la_SOURCES = $(BUILT_SOURCES)
|
||||
|
||||
libgtop_guile_names_la_LDFLAGS = $(LT_VERSION_INFO)
|
||||
|
||||
Makefile: $(BUILT_SOURCES)
|
||||
|
||||
guile-names.c: guile-names.pl $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||
$(PERL) $(srcdir)/guile-names.pl < $(top_srcdir)/features.def > gnc-t
|
||||
mv gnc-t guile-names.c
|
||||
|
||||
guile-names.x: guile-names.c
|
||||
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
|
||||
|
||||
EXTRA_DIST = guile-names.pl
|
||||
|
||||
CLEANFILES = guile-names.c guile-names.x
|
||||
|
||||
@@ -1,197 +0,0 @@
|
||||
#!/usr/bin/perl
|
||||
|
||||
$[ = 1; # set array base to 1
|
||||
$, = ' '; # set output field separator
|
||||
$\ = "\n"; # set output record separator
|
||||
|
||||
sub toupper {
|
||||
local($_) = @_;
|
||||
tr/a-z/A-Z/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
sub tolower {
|
||||
local($_) = @_;
|
||||
tr/A-Z/a-z/;
|
||||
return $_;
|
||||
}
|
||||
|
||||
print '/* guile_names.c */';
|
||||
print "/* This is a generated file. Please modify `guile-names.pl' */";
|
||||
print '';
|
||||
|
||||
print '#include <glibtop.h>';
|
||||
print '#include <glibtop/sysdeps.h>';
|
||||
print '#include <glibtop/union.h>';
|
||||
print '';
|
||||
print '#include <guile/gh.h>';
|
||||
|
||||
print '';
|
||||
|
||||
while (<>) {
|
||||
chop; # strip record separator
|
||||
|
||||
if (/^[^#]/) {
|
||||
$line = $_;
|
||||
@line_fields = split(/\|/, $line, 9999);
|
||||
$feature = $line_fields[2];
|
||||
$element_def = $line_fields[3];
|
||||
$feature =~ s/^@//;
|
||||
|
||||
$features{$feature} = $feature;
|
||||
$element_defs{$feature} = $element_def;
|
||||
}
|
||||
}
|
||||
|
||||
$features{'sysdeps'} = 'sysdeps';
|
||||
|
||||
foreach $feature (keys %features) {
|
||||
&output($feature);
|
||||
}
|
||||
|
||||
foreach $feature (keys %features) {
|
||||
$feature_name = $feature;
|
||||
$feature_name =~ s/_/-/;
|
||||
print 'SCM_GLOBAL_VCELL (s_names_' . $feature . ", \"glibtop-names-" .
|
||||
|
||||
$feature_name . "\");";
|
||||
print 'SCM_GLOBAL_VCELL (s_labels_' . $feature . ", \"glibtop-labels-" .
|
||||
|
||||
$feature_name . "\");";
|
||||
print 'SCM_GLOBAL_VCELL (s_types_' . $feature . ", \"glibtop-types-" .
|
||||
|
||||
$feature_name . "\");";
|
||||
print 'SCM_GLOBAL_VCELL (s_descriptions_' . $feature .
|
||||
|
||||
", \"glibtop-descriptions-" . $feature_name . "\");";
|
||||
}
|
||||
print '';
|
||||
|
||||
print 'void';
|
||||
print 'glibtop_boot_guile_names (void)';
|
||||
print '{';
|
||||
print "#include \"guile-names.x\"";
|
||||
foreach $feature (keys %features) {
|
||||
print 'SCM_SETCDR (s_names_' . $feature . ', glibtop_guile_names_' .
|
||||
|
||||
$feature . ' ());';
|
||||
print 'SCM_SETCDR (s_labels_' . $feature . ', glibtop_guile_labels_' .
|
||||
|
||||
$feature . ' ());';
|
||||
print 'SCM_SETCDR (s_types_' . $feature . ', glibtop_guile_types_' .
|
||||
|
||||
$feature . ' ());';
|
||||
print 'SCM_SETCDR (s_descriptions_' . $feature .
|
||||
|
||||
', glibtop_guile_descriptions_' . $feature . ' ());';
|
||||
}
|
||||
print '}';
|
||||
|
||||
sub output {
|
||||
local($feature) = @_;
|
||||
print 'static SCM';
|
||||
print 'glibtop_guile_names_' . $feature . ' (void)';
|
||||
print '{';
|
||||
print "\tint i;";
|
||||
print "\tSCM list;";
|
||||
print '';
|
||||
print "\tlist = gh_list (SCM_UNDEFINED);";
|
||||
print '';
|
||||
print "\tfor (i = 0; i < GLIBTOP_MAX_" . &toupper($feature) . '; i++)';
|
||||
print "\t\tlist = scm_append";
|
||||
print "\t\t\t(gh_list (list,";
|
||||
print "\t\t\t\t gh_list (gh_str02scm ((char *) glibtop_names_" . $feature
|
||||
|
||||
. ' [i])),';
|
||||
print "\t\t\t\t SCM_UNDEFINED));";
|
||||
print '';
|
||||
print "\treturn list;";
|
||||
print '}';
|
||||
|
||||
print '';
|
||||
|
||||
print 'static SCM';
|
||||
print 'glibtop_guile_types_' . $feature . ' (void)';
|
||||
print '{';
|
||||
print "\tSCM list;";
|
||||
print '';
|
||||
|
||||
$out = "\tlist = gh_list (";
|
||||
|
||||
$nr_elements = (@elements = split(/:/, $element_defs{$feature}, 9999));
|
||||
for ($element = 1; $element <= $nr_elements; $element++) {
|
||||
$list = $elements[$element];
|
||||
$type = $elements[$element];
|
||||
$type =~ s/\(.*//;
|
||||
$list =~ s/^.*\(//;
|
||||
$list =~ s/\)$//;
|
||||
$count = (@fields = split(/,/, $list, 9999));
|
||||
for ($field = 1; $field <= $count; $field++) {
|
||||
if ($fields[$field] =~ /^(\w+)\[([0-9]+)\]$/) {
|
||||
@field_parts = split(/\[/, $fields[$field], 9999);
|
||||
$fields[$field] = $field_parts[1];
|
||||
$field_parts[2] =~ s/\]//;
|
||||
$number = $field_parts[2];
|
||||
$out = $out . "gh_cons\n\t\t\t";
|
||||
$out = $out . '(gh_ulong2scm (glibtop_types_' . $feature .
|
||||
|
||||
' [' . ($field - 1) . "]),\n\t\t\t";
|
||||
$out = $out . ' gh_ulong2scm (' . $number . ")),\n\t\t\t";
|
||||
}
|
||||
else {
|
||||
$out = $out . 'gh_ulong2scm (glibtop_types_' . $feature . ' ['
|
||||
|
||||
. ($field - 1) . "]),\n\t\t\t";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
print $out . 'SCM_UNDEFINED);';
|
||||
print '';
|
||||
print "\treturn list;";
|
||||
print '}';
|
||||
|
||||
print '';
|
||||
|
||||
print 'static SCM';
|
||||
print 'glibtop_guile_labels_' . $feature . ' (void)';
|
||||
print '{';
|
||||
print "\tint i;";
|
||||
print "\tSCM list;";
|
||||
print '';
|
||||
print "\tlist = gh_list (SCM_UNDEFINED);";
|
||||
print '';
|
||||
print "\tfor (i = 0; i < GLIBTOP_MAX_" . &toupper($feature) . '; i++)';
|
||||
print "\t\tlist = scm_append";
|
||||
print "\t\t\t(gh_list (list,";
|
||||
print "\t\t\t\t gh_list (gh_str02scm (_(glibtop_labels_" . $feature .
|
||||
|
||||
' [i]))),';
|
||||
print "\t\t\t\t SCM_UNDEFINED));";
|
||||
print '';
|
||||
print "\treturn list;";
|
||||
print '}';
|
||||
|
||||
print '';
|
||||
|
||||
print 'static SCM';
|
||||
print 'glibtop_guile_descriptions_' . $feature . ' (void)';
|
||||
print '{';
|
||||
print "\tint i;";
|
||||
print "\tSCM list;";
|
||||
print '';
|
||||
print "\tlist = gh_list (SCM_UNDEFINED);";
|
||||
print '';
|
||||
print "\tfor (i = 0; i < GLIBTOP_MAX_" . &toupper($feature) . '; i++)';
|
||||
print "\t\tlist = scm_append";
|
||||
print "\t\t\t(gh_list (list,";
|
||||
print "\t\t\t\t gh_list (gh_str02scm (_(glibtop_descriptions_" . $feature
|
||||
|
||||
. ' [i]))),';
|
||||
print "\t\t\t\t SCM_UNDEFINED));";
|
||||
print '';
|
||||
print "\treturn list;";
|
||||
print '}';
|
||||
|
||||
print '';
|
||||
}
|
||||
Reference in New Issue
Block a user