oxmc/libgtop
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

removed guile

Browse Source 
2003-10-20  Bastien Nocera  <hadess@hadess.net>

	* sysdeps/Makefile.am:
	* sysdeps/guile/ChangeLog:
	* sysdeps/guile/Makefile.am:
	* sysdeps/guile/guile.pl:
	* sysdeps/guile/names/.cvsignore:
	* sysdeps/guile/names/Makefile.am:
	* sysdeps/guile/names/guile-names.pl: removed guile
This commit is contained in:
Bastien Nocera
2003-10-20 12:57:18 +00:00
committed by Bastien Nocera
parent 21c4e155dd
commit cdfa0dfa1f
8 changed files with 12 additions and 590 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
ChangeLog
View File

@@ -1,3 +1,13 @@
2003-10-20 Bastien Nocera <hadess@hadess.net>
* sysdeps/Makefile.am:
* sysdeps/guile/ChangeLog:
* sysdeps/guile/Makefile.am:
* sysdeps/guile/guile.pl:
* sysdeps/guile/names/.cvsignore:
* sysdeps/guile/names/Makefile.am:
* sysdeps/guile/names/guile-names.pl: removed guile
2003-10-20 Bastien Nocera <hadess@hadess.net>
* Makefile.am:

9
sysdeps/Makefile.am
View File

@@ -1,10 +1,5 @@
## if GUILE
## guile_SUBDIRS = guile
## else
guile_SUBDIRS =
## endif
SUBDIRS = common @sysdeps_dir@ names $(guile_SUBDIRS)
SUBDIRS = common @sysdeps_dir@ names
DIST_SUBDIRS = common guile linux kernel names osf1 \
DIST_SUBDIRS = common linux kernel names osf1 \
stub stub_suid sun4 freebsd solaris aix

50
sysdeps/guile/ChangeLog
View File

@@ -1,50 +0,0 @@
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.

27
sysdeps/guile/Makefile.am
View File

@@ -1,27 +0,0 @@
SUBDIRS = names
LINK = $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@
INCLUDES = @INCLUDES@
BUILT_SOURCES = guile.c guile.x
lib_LTLIBRARIES = libgtop_guile-2.0.la
libgtop_guile_2_0_la_SOURCES = $(BUILT_SOURCES)
libgtop_guile_2_0_la_LDFLAGS = $(LT_VERSION_INFO)
Makefile: $(BUILT_SOURCES)
guile.c: guile.pl $(top_builddir)/config.h $(top_srcdir)/features.def
$(PERL) $(srcdir)/guile.pl < $(top_srcdir)/features.def > gnc-t
mv gnc-t guile.c
guile.x: guile.c
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
EXTRA_DIST = guile.pl
CLEANFILES = guile.c guile.x

274
sysdeps/guile/guile.pl
View File

@@ -1,274 +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.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 '';
$convert{'long'} = 'gh_long2scm ';
$convert{'ulong'} = 'gh_ulong2scm ';
$convert{'double'} = 'gh_double2scm';
$convert{'str'} = 'gh_str02scm ';
$convert{'char'} = 'gh_char2scm ';
$backconv{'int'} = 'gh_scm2long';
$backconv{'pid_t'} = 'gh_scm2ulong';
$backconv{'long'} = 'gh_scm2long';
$backconv{'ulong'} = 'gh_scm2ulong';
$backconv{'unsigned'} = 'gh_scm2ulong';
$feature_count = 0;
while (<>) {
chop; # strip record separator
if (/^[^#]/) {
&make_output($_);
}
}
$sep = '';
$sysdeps = 'void|sysdeps|ulong(';
for ($nr = 0; $nr < $feature_count; $nr++) {
$sysdeps = $sysdeps . '' . $sep . '' . $feature_field{$nr};
$sep = ',';
}
$sysdeps = $sysdeps . ')';
&make_output($sysdeps);
print 'void';
print 'glibtop_boot_guile (void)';
print '{';
print "#include \"guile.x\"";
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;
$total_nr_params = 0;
if ($param_def eq 'string') {
$call_param = ', gh_scm2newstr( ' . $line_fields[5] . ', NULL)';
$param_decl = 'SCM ' . $line_fields[5];
$total_nr_params = 1;
}
else {
$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];
$call_param = $call_param . ', ' . $backconv{$type} . ' (' .
$fields[$field] . ')';
}
}
if ($param_decl eq '') {
$param_decl = 'void';
}
}
$nr_params_field{$feature} = $total_nr_params;
$feature_name = $feature;
$feature_name =~ s/_/-/;
$output = 'SCM_PROC (s_' . $feature . ", \"glibtop-get-" . $feature_name .
"\",";
$output = $output . ' ' . $nr_params_field{$feature} . ', 0, 0, ';
$output = $output . 'glibtop_guile_get_' . $feature . ");\n\n";
$output = $output . "static SCM\nglibtop_guile_get_" . $feature . ' (' .
$param_decl . ")\n{\n";
$output = $output . "\tglibtop_" . $feature . ' ' . $feature . ";\n";
if ($retval ne 'void') {
$output = $output . "\t" . $retval . " retval;\n";
}
if ($feature =~ /^(proc(list|_map|_args))|mountlist$/) {
$output = $output . "\tunsigned i;\n";
}
if ($feature =~ /^proc_args$/) {
$output = $output . "\tSCM list, scm_args, args_list;\n";
$output = $output . "\tchar *start;\n\n";
}
else {
$output = $output . "\tSCM list;\n\n";
}
if ($retval ne 'void') {
$prefix = 'retval = ';
}
else {
$prefix = '';
}
$output = $output . "\t" . $prefix . 'glibtop_get_' . $feature . ' (&' .
$feature . '' . $call_param . ");\n\n";
$output = $output . "\tlist = gh_list (gh_ulong2scm (" . $feature .
".flags),\n\t\t\t";
$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+)\[([0-9]+)\]$/) {
@field_parts = split(/\[/, $fields[$field], 9999);
$fields[$field] = $field_parts[1];
$field_parts[2] =~ s/\]//;
$number = $field_parts[2];
$output = $output . "gh_list\n\t\t\t(";
for ($nr = 0; $nr < $number; $nr++) {
$output = $output . '' . $convert{$type} . ' (' . $feature
. '.' . $fields[$field] . ' [' . $nr . "]),\n\t\t\t ";
}
$output = $output . "SCM_UNDEFINED),\n\t\t\t";
}
else {
$output = $output . '' . $convert{$type} . ' (' . $feature .
'.' . $fields[$field] . "),\n\t\t\t";
}
}
}
$output = $output . "SCM_UNDEFINED);\n";
print $output;
if ($feature =~ /^proclist$/) {
print "\tif (retval == NULL)";
print "\t\treturn list;";
print '';
print "\tfor (i = 0; i < proclist.number; i++)";
print "\t\tlist = scm_append";
print "\t\t\t(gh_list (list,";
print
"\t\t\t\t gh_list (gh_ulong2scm ((unsigned long) retval [i])),";
print "\t\t\t\t SCM_UNDEFINED));";
print '';
print "\tglibtop_free (retval);\n";
}
if ($feature =~ /^proc_map$/) {
print "\tif (retval == NULL)";
print "\t\treturn list;";
print '';
print "\tfor (i = 0; i < proc_map.number; i++) {";
print "\t\tglibtop_map_entry *entry = &(retval [i]);";
print "\t\tSCM scm_entry = gh_list";
print "\t\t\t(gh_ulong2scm ((unsigned long) entry->flags),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->start),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->end),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->offset),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->perm),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->inode),";
print "\t\t\t gh_ulong2scm ((unsigned long) entry->device),";
print "\t\t\t gh_str02scm (entry->filename), SCM_UNDEFINED);";
print "\t\tSCM entry_list = gh_list (scm_entry, SCM_UNDEFINED);\n";
print
"\t\tlist = scm_append (gh_list (list, entry_list, SCM_UNDEFINED));";
print "\t};\n";
print "\tglibtop_free (retval);\n";
}
if ($feature =~ /^proc_args$/) {
print "\tif (retval == NULL)";
print "\t\treturn list;";
print '';
print "\tstart = retval;";
print "\tscm_args = gh_list (SCM_UNDEFINED);\n";
print "\tfor (i = 0; i <= proc_args.size; i++) {";
print "\t\tSCM arg_list;\n";
print "\t\tif (retval [i]) continue;\n";
print "\t\targ_list = gh_list (gh_str02scm (start), SCM_UNDEFINED);";
print "\t\tscm_args = scm_append";
print "\t\t\t(gh_list (scm_args, arg_list, SCM_UNDEFINED));\n;";
print "\t\tstart = &(retval [i+1]);";
print "\t};\n";
print "\targs_list = gh_list (scm_args, SCM_UNDEFINED);";
print
"\tlist = scm_append (gh_list (list, args_list, SCM_UNDEFINED));\n";
print "\tglibtop_free (retval);\n";
}
if ($feature =~ /^mountlist$/) {
print "\tif (retval == NULL)";
print "\t\treturn list;";
print '';
print "\tfor (i = 0; i < mountlist.number; i++) {";
print "\t\tglibtop_mountentry *entry = &(retval [i]);";
print "\t\tSCM scm_entry = gh_list";
print "\t\t\t(gh_ulong2scm ((unsigned long) entry->dev),";
print "\t\t\t gh_str02scm (entry->devname),";
print "\t\t\t gh_str02scm (entry->mountdir),";
print "\t\t\t gh_str02scm (entry->type), SCM_UNDEFINED);";
print "\t\tSCM entry_list = gh_list (scm_entry, SCM_UNDEFINED);\n";
print
"\t\tlist = scm_append (gh_list (list, entry_list, SCM_UNDEFINED));";
print "\t};\n";
print "\tglibtop_free (retval);\n";
}
print "\treturn list;";
print '}';
print '';
}

10
sysdeps/guile/names/.cvsignore
View File

@@ -1,10 +0,0 @@
.deps
so_locations
.libs
Makefile
guile-names.c
Makefile.in
libgtop_guile.la
libgtop_guile_names.la
*.lo
*.x

25
sysdeps/guile/names/Makefile.am
View File

@@ -1,25 +0,0 @@
LINK = $(LIBTOOL) --mode=link $(CC) $(CFLAGS) $(LDFLAGS) -o $@
INCLUDES = @INCLUDES@
lib_LTLIBRARIES = libgtop_guile_names-2.0.la
BUILT_SOURCES = guile-names.c guile-names.x
libgtop_guile_names_2_0_la_SOURCES = $(BUILT_SOURCES)
libgtop_guile_names_2_0_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

197
sysdeps/guile/names/guile-names.pl
View File

@@ -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 '';
}