summaryrefslogtreecommitdiff
path: root/sysdeps/guile
diff options
context:
space:
mode:
Diffstat (limited to 'sysdeps/guile')
-rw-r--r--sysdeps/guile/.cvsignore10
-rw-r--r--sysdeps/guile/ChangeLog61
-rw-r--r--sysdeps/guile/Makefile.am35
-rw-r--r--sysdeps/guile/guile.h50
-rw-r--r--sysdeps/guile/guile.pl328
-rw-r--r--sysdeps/guile/main.c24
-rw-r--r--sysdeps/guile/names/.cvsignore10
-rw-r--r--sysdeps/guile/names/Makefile.am25
-rw-r--r--sysdeps/guile/names/guile-names.pl197
9 files changed, 0 insertions, 740 deletions
diff --git a/sysdeps/guile/.cvsignore b/sysdeps/guile/.cvsignore
deleted file mode 100644
index 0f496656..00000000
--- a/sysdeps/guile/.cvsignore
+++ /dev/null
@@ -1,10 +0,0 @@
-.deps
-.libs
-Makefile
-Makefile.in
-guile.c
-so_locations
-libgtop_guile.la
-*.lo
-*.x
-structures.h
diff --git a/sysdeps/guile/ChangeLog b/sysdeps/guile/ChangeLog
deleted file mode 100644
index c767bfff..00000000
--- a/sysdeps/guile/ChangeLog
+++ /dev/null
@@ -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.
-
diff --git a/sysdeps/guile/Makefile.am b/sysdeps/guile/Makefile.am
deleted file mode 100644
index a89403cf..00000000
--- a/sysdeps/guile/Makefile.am
+++ /dev/null
@@ -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)
-
diff --git a/sysdeps/guile/guile.h b/sysdeps/guile/guile.h
deleted file mode 100644
index 2dd8143e..00000000
--- a/sysdeps/guile/guile.h
+++ /dev/null
@@ -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__ */
diff --git a/sysdeps/guile/guile.pl b/sysdeps/guile/guile.pl
deleted file mode 100644
index 55d59fcc..00000000
--- a/sysdeps/guile/guile.pl
+++ /dev/null
@@ -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;
-}
diff --git a/sysdeps/guile/main.c b/sysdeps/guile/main.c
deleted file mode 100644
index a4263969..00000000
--- a/sysdeps/guile/main.c
+++ /dev/null
@@ -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);
-}
diff --git a/sysdeps/guile/names/.cvsignore b/sysdeps/guile/names/.cvsignore
deleted file mode 100644
index f2bf91eb..00000000
--- a/sysdeps/guile/names/.cvsignore
+++ /dev/null
@@ -1,10 +0,0 @@
-.deps
-so_locations
-.libs
-Makefile
-guile-names.c
-Makefile.in
-libgtop_guile.la
-libgtop_guile_names.la
-*.lo
-*.x
diff --git a/sysdeps/guile/names/Makefile.am b/sysdeps/guile/names/Makefile.am
deleted file mode 100644
index 1e64cbb1..00000000
--- a/sysdeps/guile/names/Makefile.am
+++ /dev/null
@@ -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
-
diff --git a/sysdeps/guile/names/guile-names.pl b/sysdeps/guile/names/guile-names.pl
deleted file mode 100644
index bdfb2941..00000000
--- a/sysdeps/guile/names/guile-names.pl
+++ /dev/null
@@ -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 '';
-}
View Lorry Controller Status