Replaced all awk scripts with perl scripts since it is more likely that
1999-02-18 Martin Baulig <martin@home-of-linux.org> * */*.awk: Replaced all awk scripts with perl scripts since it is more likely that people have a working perl interpreter than GNU awk on their system.
This commit is contained in:
Martin Baulig
committed by
Martin Baulig
Martin Baulig
parent
00f0791ebd
commit
2deb3c30c4
@@ -1,3 +1,9 @@
|
|||||||
|
1999-02-18 Martin Baulig <martin@home-of-linux.org>
|
||||||
|
|
||||||
|
* */*.awk: Replaced all awk scripts with perl scripts since it is
|
||||||
|
more likely that people have a working perl interpreter than GNU
|
||||||
|
awk on their system.
|
||||||
|
|
||||||
1999-02-18 Martin Baulig <martin@home-of-linux.org>
|
1999-02-18 Martin Baulig <martin@home-of-linux.org>
|
||||||
|
|
||||||
* sysdeps/common/error.c (glibtop_error_r, glibtop_warn_r): Define
|
* sysdeps/common/error.c (glibtop_error_r, glibtop_warn_r): Define
|
||||||
|
|||||||
@@ -52,6 +52,10 @@ dnl does not work for libgtop.
|
|||||||
AC_CHECK_PROGS(AWK, gawk awk, )
|
AC_CHECK_PROGS(AWK, gawk awk, )
|
||||||
test -z "$AWK" && AC_MSG_ERROR([Sorry, you need a working awk interpreter.])
|
test -z "$AWK" && AC_MSG_ERROR([Sorry, you need a working awk interpreter.])
|
||||||
|
|
||||||
|
dnl Most people should have a working perl interpreter on their system
|
||||||
|
AC_PATH_PROG(PERL,perl)
|
||||||
|
test -z "$PERL" && AC_MSG_ERROR([You need to have a working perl interpreter.])
|
||||||
|
|
||||||
AC_CHECK_TOOL(CC,gcc)
|
AC_CHECK_TOOL(CC,gcc)
|
||||||
AC_CHECK_TOOL(RANLIB,ranlib)
|
AC_CHECK_TOOL(RANLIB,ranlib)
|
||||||
AC_CHECK_TOOL(AS,as)
|
AC_CHECK_TOOL(AS,as)
|
||||||
|
|||||||
@@ -12,11 +12,11 @@ libgtop_la_LDFLAGS = $(LT_VERSION_INFO)
|
|||||||
|
|
||||||
BUILT_SOURCES = lib.c
|
BUILT_SOURCES = lib.c
|
||||||
|
|
||||||
lib.c: lib.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
lib.c: lib.pl $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||||
$(AWK) -f $(srcdir)/lib.awk < $(top_srcdir)/features.def > lib-t
|
$(PERL) $(srcdir)/lib.pl < $(top_srcdir)/features.def > lib-t
|
||||||
mv lib-t lib.c
|
mv lib-t lib.c
|
||||||
|
|
||||||
EXTRA_DIST = lib.awk
|
EXTRA_DIST = lib.pl
|
||||||
|
|
||||||
CLEANFILES = lib.c
|
CLEANFILES = lib.c
|
||||||
|
|
||||||
|
|||||||
167
lib/lib.awk
167
lib/lib.awk
@@ -1,167 +0,0 @@
|
|||||||
BEGIN {
|
|
||||||
print "/* lib.c */";
|
|
||||||
print "/* This is a generated file. Please modify `lib.awk' */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "#include <glibtop.h>";
|
|
||||||
print "#include <glibtop/open.h>";
|
|
||||||
print "";
|
|
||||||
print "#include <glibtop/sysdeps.h>";
|
|
||||||
print "#include <glibtop/union.h>";
|
|
||||||
print "";
|
|
||||||
print "#include <glibtop/command.h>";
|
|
||||||
|
|
||||||
print "";
|
|
||||||
print "/* Some required fields are missing. */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "static void";
|
|
||||||
print "_glibtop_missing_feature (glibtop *server, const char *feature,";
|
|
||||||
print "\t\t\t const u_int64_t present, u_int64_t *required)";
|
|
||||||
print "{";
|
|
||||||
print "\tswitch (server->error_method) {";
|
|
||||||
print "\tcase GLIBTOP_ERROR_METHOD_WARN_ONCE:";
|
|
||||||
print "\t\t*required &= present;";
|
|
||||||
print "\tcase GLIBTOP_ERROR_METHOD_WARN:";
|
|
||||||
print "\t\tglibtop_warn_r (server,";
|
|
||||||
print "\t\t\t\t_(\"glibtop_get_%s (): Client requested \"";
|
|
||||||
print "\t\t\t\t \"field mask %05Lx, but only have %05Lx.\"),";
|
|
||||||
print "\t\t\t\t feature, required, present);";
|
|
||||||
print "\t\tbreak;";
|
|
||||||
print "\tcase GLIBTOP_ERROR_METHOD_ABORT:";
|
|
||||||
print "\t\tglibtop_error_r (server,";
|
|
||||||
print "\t\t\t\t _(\"glibtop_get_%s (): Client requested \"";
|
|
||||||
print "\t\t\t\t \"field mask %05x, but only have %05x.\"),";
|
|
||||||
print "\t\t\t\t feature, required, present);";
|
|
||||||
print "\t\tbreak;";
|
|
||||||
print "\t}";
|
|
||||||
print "}";
|
|
||||||
|
|
||||||
print "";
|
|
||||||
print "/* Library functions. */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
convert["long"] = "int64_t";
|
|
||||||
convert["ulong"] = "u_int64_t";
|
|
||||||
convert["pid_t"] = "pid_t";
|
|
||||||
convert["int"] = "int";
|
|
||||||
convert["ushort"] = "unsigned short";
|
|
||||||
convert["unsigned"] = "unsigned";
|
|
||||||
}
|
|
||||||
|
|
||||||
function output(line) {
|
|
||||||
split (line, line_fields, /\|/);
|
|
||||||
retval = line_fields[1];
|
|
||||||
feature = line_fields[2];
|
|
||||||
param_def = line_fields[4];
|
|
||||||
|
|
||||||
orig = feature; sub(/^@/,"",feature);
|
|
||||||
space = feature; gsub(/./," ",space);
|
|
||||||
|
|
||||||
print retval;
|
|
||||||
if (retval !~ /^void$/) {
|
|
||||||
prefix = "retval = ";
|
|
||||||
prefix_space = " ";
|
|
||||||
} else {
|
|
||||||
prefix = "";
|
|
||||||
prefix_space = "";
|
|
||||||
}
|
|
||||||
|
|
||||||
if (param_def == "string") {
|
|
||||||
call_param = ", "line_fields[5];
|
|
||||||
param_decl = ",\n "space" const char *"line_fields[5];
|
|
||||||
send_ptr = "\n\tconst void *send_ptr = "line_fields[5]";";
|
|
||||||
send_size = "\n\tconst size_t send_size =\n\t\tstrlen ("line_fields[5]") + 1;";
|
|
||||||
} else {
|
|
||||||
call_param = "";
|
|
||||||
param_decl = "";
|
|
||||||
send_size = "";
|
|
||||||
send_ptr = "";
|
|
||||||
nr_params = split (param_def, params, /:/);
|
|
||||||
for (param = 1; param <= nr_params; param++) {
|
|
||||||
list = params[param];
|
|
||||||
type = params[param];
|
|
||||||
sub(/\(.*/, "", type);
|
|
||||||
sub(/^.*\(/, "", list); sub(/\)$/, "", list);
|
|
||||||
count = split (list, fields, /,/);
|
|
||||||
for (field = 1; field <= count; field++) {
|
|
||||||
if (param_decl == "")
|
|
||||||
param_decl = ",\n "space" ";
|
|
||||||
else
|
|
||||||
param_decl = param_decl", ";
|
|
||||||
param_decl = param_decl""convert[type]" "fields[field];
|
|
||||||
call_param = call_param", "fields[field];
|
|
||||||
if (send_ptr == "")
|
|
||||||
send_ptr = "\n\tconst void *send_ptr = &"fields[field]";";
|
|
||||||
if (send_size == "")
|
|
||||||
send_size = "\n\tconst size_t send_size =\n\t\t";
|
|
||||||
else
|
|
||||||
send_size = send_size" + ";
|
|
||||||
send_size = send_size"sizeof ("fields[field]")";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (send_size != "")
|
|
||||||
send_size = send_size";";
|
|
||||||
else
|
|
||||||
send_size = "\n\tconst size_t send_size = 0;";
|
|
||||||
if (send_ptr == "")
|
|
||||||
send_ptr = "\n\tconst void *send_ptr = NULL;";
|
|
||||||
}
|
|
||||||
|
|
||||||
print "glibtop_get_"feature"_l (glibtop *server, glibtop_"feature" *buf"param_decl")";
|
|
||||||
|
|
||||||
print "{"send_ptr""send_size;
|
|
||||||
if (retval !~ /^void$/)
|
|
||||||
print "\t"retval" retval = ("retval") 0;";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "\tglibtop_init_r (&server, (1 << GLIBTOP_SYSDEPS_"toupper(feature)"), 0);";
|
|
||||||
|
|
||||||
print "";
|
|
||||||
print "\t/* If neccessary, we ask the server for the requested";
|
|
||||||
print "\t * feature. If not, we call the sysdeps function. */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "\tif ((server->flags & _GLIBTOP_INIT_STATE_SERVER) &&";
|
|
||||||
print "\t (server->features & (1 << GLIBTOP_SYSDEPS_"toupper(feature)")))";
|
|
||||||
print "\t{";
|
|
||||||
|
|
||||||
print "\t\t"prefix"glibtop_call_l (server, GLIBTOP_CMND_"toupper(feature)",";
|
|
||||||
print "\t\t\t\t"prefix_space"send_size, send_ptr,";
|
|
||||||
print "\t\t\t\t"prefix_space"sizeof (glibtop_"feature"), buf);";
|
|
||||||
|
|
||||||
print "\t} else {";
|
|
||||||
|
|
||||||
if (orig !~ /^@/)
|
|
||||||
print "#if (!GLIBTOP_SUID_"toupper(feature)")";
|
|
||||||
|
|
||||||
print "\t\t"prefix"glibtop_get_"feature"_s (server, buf"call_param");";
|
|
||||||
|
|
||||||
if (orig !~ /^@/) {
|
|
||||||
print "#else";
|
|
||||||
print "\t\terrno = ENOSYS;";
|
|
||||||
print "\t\tglibtop_error_io_r (server, \"glibtop_get_"feature"\");";
|
|
||||||
print "#endif";
|
|
||||||
}
|
|
||||||
|
|
||||||
print "\t}";
|
|
||||||
|
|
||||||
print "";
|
|
||||||
print "\t/* Make sure that all required fields are present. */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "\tif (buf->flags & server->required."feature")";
|
|
||||||
print "\t\t_glibtop_missing_feature (server, \""feature"\", buf->flags,";
|
|
||||||
print "\t\t\t\t\t &server->required."feature");";
|
|
||||||
|
|
||||||
if (retval !~ /^void$/) {
|
|
||||||
print "\n\t/* Now we can return. */";
|
|
||||||
print "\n\treturn retval;";
|
|
||||||
}
|
|
||||||
|
|
||||||
print "}";
|
|
||||||
print "";
|
|
||||||
}
|
|
||||||
|
|
||||||
/^[^#]/ { output($0) }
|
|
||||||
|
|
||||||
227
lib/lib.pl
Executable file
227
lib/lib.pl
Executable file
@@ -0,0 +1,227 @@
|
|||||||
|
#!/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 '/* lib.c */';
|
||||||
|
print "/* This is a generated file. Please modify `lib.pl' */";
|
||||||
|
print '';
|
||||||
|
|
||||||
|
print '#include <glibtop.h>';
|
||||||
|
print '#include <glibtop/open.h>';
|
||||||
|
print '';
|
||||||
|
print '#include <glibtop/sysdeps.h>';
|
||||||
|
print '#include <glibtop/union.h>';
|
||||||
|
print '';
|
||||||
|
print '#include <glibtop/command.h>';
|
||||||
|
|
||||||
|
print '';
|
||||||
|
print '/* Some required fields are missing. */';
|
||||||
|
print '';
|
||||||
|
|
||||||
|
print 'static void';
|
||||||
|
print '_glibtop_missing_feature (glibtop *server, const char *feature,';
|
||||||
|
print "\t\t\t const u_int64_t present, u_int64_t *required)";
|
||||||
|
print '{';
|
||||||
|
print "\tswitch (server->error_method) {";
|
||||||
|
print "\tcase GLIBTOP_ERROR_METHOD_WARN_ONCE:";
|
||||||
|
print "\t\t*required &= present;";
|
||||||
|
print "\tcase GLIBTOP_ERROR_METHOD_WARN:";
|
||||||
|
print "\t\tglibtop_warn_r (server,";
|
||||||
|
print "\t\t\t\t_(\"glibtop_get_%s (): Client requested \"";
|
||||||
|
print "\t\t\t\t \"field mask %05Lx, but only have %05Lx.\"),";
|
||||||
|
print "\t\t\t\t feature, required, present);";
|
||||||
|
print "\t\tbreak;";
|
||||||
|
print "\tcase GLIBTOP_ERROR_METHOD_ABORT:";
|
||||||
|
print "\t\tglibtop_error_r (server,";
|
||||||
|
print "\t\t\t\t _(\"glibtop_get_%s (): Client requested \"";
|
||||||
|
print "\t\t\t\t \"field mask %05x, but only have %05x.\"),";
|
||||||
|
print "\t\t\t\t feature, required, present);";
|
||||||
|
print "\t\tbreak;";
|
||||||
|
print "\t}";
|
||||||
|
print '}';
|
||||||
|
|
||||||
|
print '';
|
||||||
|
print '/* Library functions. */';
|
||||||
|
print '';
|
||||||
|
|
||||||
|
$convert{'long'} = 'int64_t';
|
||||||
|
$convert{'ulong'} = 'u_int64_t';
|
||||||
|
$convert{'pid_t'} = 'pid_t';
|
||||||
|
$convert{'int'} = 'int';
|
||||||
|
$convert{'ushort'} = 'unsigned short';
|
||||||
|
$convert{'unsigned'} = 'unsigned';
|
||||||
|
|
||||||
|
while (<>) {
|
||||||
|
chop; # strip record separator
|
||||||
|
|
||||||
|
if (/^[^#]/) {
|
||||||
|
&output($_);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub output {
|
||||||
|
local($line) = @_;
|
||||||
|
@line_fields = split(/\|/, $line, 9999);
|
||||||
|
$retval = $line_fields[1];
|
||||||
|
$feature = $line_fields[2];
|
||||||
|
$param_def = $line_fields[4];
|
||||||
|
|
||||||
|
$orig = $feature;
|
||||||
|
$feature =~ s/^@//;
|
||||||
|
$space = $feature;
|
||||||
|
$space =~ s/./ /g;
|
||||||
|
|
||||||
|
print $retval;
|
||||||
|
if ($retval !~ /^void$/) {
|
||||||
|
$prefix = 'retval = ';
|
||||||
|
$prefix_space = ' ';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$prefix = '';
|
||||||
|
$prefix_space = '';
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($param_def eq 'string') {
|
||||||
|
$call_param = ', ' . $line_fields[5];
|
||||||
|
$param_decl = ",\n " . $space . ' const char *' .
|
||||||
|
|
||||||
|
$line_fields[5];
|
||||||
|
$send_ptr = "\n\tconst void *send_ptr = " . $line_fields[5] . ';';
|
||||||
|
$send_size = "\n\tconst size_t send_size =\n\t\tstrlen (" .
|
||||||
|
|
||||||
|
$line_fields[5] . ') + 1;';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$call_param = '';
|
||||||
|
$param_decl = '';
|
||||||
|
$send_size = '';
|
||||||
|
$send_ptr = '';
|
||||||
|
$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));
|
||||||
|
for ($field = 1; $field <= $count; $field++) {
|
||||||
|
if ($param_decl eq '') {
|
||||||
|
$param_decl = ",\n " . $space . ' ';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$param_decl = $param_decl . ', ';
|
||||||
|
}
|
||||||
|
$param_decl = $param_decl . '' . $convert{$type} . ' ' .
|
||||||
|
|
||||||
|
$fields[$field];
|
||||||
|
$call_param = $call_param . ', ' . $fields[$field];
|
||||||
|
if ($send_ptr eq '') {
|
||||||
|
$send_ptr = "\n\tconst void *send_ptr = &" .
|
||||||
|
|
||||||
|
$fields[$field] . ';';
|
||||||
|
}
|
||||||
|
if ($send_size eq '') {
|
||||||
|
$send_size = "\n\tconst size_t send_size =\n\t\t";
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$send_size = $send_size . ' + ';
|
||||||
|
}
|
||||||
|
$send_size = $send_size . 'sizeof (' . $fields[$field] . ')';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($send_size ne '') {
|
||||||
|
$send_size = $send_size . ';';
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$send_size = "\n\tconst size_t send_size = 0;";
|
||||||
|
}
|
||||||
|
if ($send_ptr eq '') {
|
||||||
|
$send_ptr = "\n\tconst void *send_ptr = NULL;";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
print 'glibtop_get_' . $feature . '_l (glibtop *server, glibtop_' .
|
||||||
|
|
||||||
|
$feature . ' *buf' . $param_decl . ')';
|
||||||
|
|
||||||
|
print '{' . $send_ptr . '' . $send_size;
|
||||||
|
if ($retval !~ /^void$/) {
|
||||||
|
print "\t" . $retval . ' retval = (' . $retval . ') 0;';
|
||||||
|
}
|
||||||
|
print '';
|
||||||
|
|
||||||
|
print "\tglibtop_init_r (&server, (1 << GLIBTOP_SYSDEPS_" .
|
||||||
|
|
||||||
|
&toupper($feature) . '), 0);';
|
||||||
|
|
||||||
|
print '';
|
||||||
|
print "\t/* If neccessary, we ask the server for the requested";
|
||||||
|
print "\t * feature. If not, we call the sysdeps function. */";
|
||||||
|
print '';
|
||||||
|
|
||||||
|
print "\tif ((server->flags & _GLIBTOP_INIT_STATE_SERVER) &&";
|
||||||
|
print "\t (server->features & (1 << GLIBTOP_SYSDEPS_" .
|
||||||
|
|
||||||
|
&toupper($feature) . ')))';
|
||||||
|
print "\t{";
|
||||||
|
|
||||||
|
print "\t\t" . $prefix . 'glibtop_call_l (server, GLIBTOP_CMND_' .
|
||||||
|
|
||||||
|
&toupper($feature) . ',';
|
||||||
|
print "\t\t\t\t" . $prefix_space . 'send_size, send_ptr,';
|
||||||
|
print "\t\t\t\t" . $prefix_space . 'sizeof (glibtop_' . $feature .
|
||||||
|
|
||||||
|
'), buf);';
|
||||||
|
|
||||||
|
print "\t} else {";
|
||||||
|
|
||||||
|
if ($orig !~ /^@/) {
|
||||||
|
print '#if (!GLIBTOP_SUID_' . &toupper($feature) . ')';
|
||||||
|
}
|
||||||
|
print "\t\t" . $prefix . 'glibtop_get_' . $feature . '_s (server, buf' .
|
||||||
|
|
||||||
|
$call_param . ');';
|
||||||
|
|
||||||
|
if ($orig !~ /^@/) {
|
||||||
|
print '#else';
|
||||||
|
print "\t\terrno = ENOSYS;";
|
||||||
|
print "\t\tglibtop_error_io_r (server, \"glibtop_get_" . $feature .
|
||||||
|
|
||||||
|
"\");";
|
||||||
|
print '#endif';
|
||||||
|
}
|
||||||
|
|
||||||
|
print "\t}";
|
||||||
|
|
||||||
|
print '';
|
||||||
|
print "\t/* Make sure that all required fields are present. */";
|
||||||
|
print '';
|
||||||
|
|
||||||
|
print "\tif (buf->flags & server->required." . $feature . ')';
|
||||||
|
print "\t\t_glibtop_missing_feature (server, \"" . $feature .
|
||||||
|
|
||||||
|
"\", buf->flags,";
|
||||||
|
print "\t\t\t\t\t &server->required." . $feature . ');';
|
||||||
|
|
||||||
|
if ($retval !~ /^void$/) {
|
||||||
|
print "\n\t/* Now we can return. */";
|
||||||
|
print "\n\treturn retval;";
|
||||||
|
}
|
||||||
|
|
||||||
|
print '}';
|
||||||
|
print '';
|
||||||
|
}
|
||||||
@@ -14,14 +14,14 @@ libgtop_guile_la_LDFLAGS = $(LT_VERSION_INFO)
|
|||||||
|
|
||||||
Makefile: $(BUILT_SOURCES)
|
Makefile: $(BUILT_SOURCES)
|
||||||
|
|
||||||
guile.c: guile.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
guile.c: guile.pl $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||||
$(AWK) -f $(srcdir)/guile.awk < $(top_srcdir)/features.def > gnc-t
|
$(PERL) $(srcdir)/guile.pl < $(top_srcdir)/features.def > gnc-t
|
||||||
mv gnc-t guile.c
|
mv gnc-t guile.c
|
||||||
|
|
||||||
guile.x: guile.c
|
guile.x: guile.c
|
||||||
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
|
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
|
||||||
|
|
||||||
EXTRA_DIST = guile.awk
|
EXTRA_DIST = guile.pl
|
||||||
|
|
||||||
CLEANFILES = guile.c guile.x
|
CLEANFILES = guile.c guile.x
|
||||||
|
|
||||||
|
|||||||
@@ -1,220 +0,0 @@
|
|||||||
BEGIN {
|
|
||||||
print "/* guile.c */";
|
|
||||||
print "/* This is a generated file. Please modify `guile.awk' */";
|
|
||||||
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
function make_output(line) {
|
|
||||||
split (line, line_fields, /\|/);
|
|
||||||
retval = line_fields[1];
|
|
||||||
element_def = line_fields[3];
|
|
||||||
feature = line_fields[2];
|
|
||||||
param_def = line_fields[4];
|
|
||||||
|
|
||||||
sub(/^@/,"",feature);
|
|
||||||
features[feature] = feature;
|
|
||||||
|
|
||||||
feature_field[feature_count] = feature;
|
|
||||||
feature_count = feature_count+1;
|
|
||||||
|
|
||||||
total_nr_params = 0;
|
|
||||||
|
|
||||||
if (param_def == "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 = split (param_def, params, /:/);
|
|
||||||
for (param = 1; param <= nr_params; param++) {
|
|
||||||
list = params[param];
|
|
||||||
type = params[param];
|
|
||||||
sub(/\(.*/, "", type);
|
|
||||||
sub(/^.*\(/, "", list); sub(/\)$/, "", list);
|
|
||||||
count = split (list, fields, /,/);
|
|
||||||
total_nr_params = total_nr_params + count;
|
|
||||||
for (field = 1; field <= count; field++) {
|
|
||||||
if (param_decl != "")
|
|
||||||
param_decl = param_decl", ";
|
|
||||||
param_decl = param_decl"SCM "fields[field];
|
|
||||||
call_param = call_param", "backconv[type]" ("fields[field]")";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (param_decl == "")
|
|
||||||
param_decl = "void";
|
|
||||||
}
|
|
||||||
|
|
||||||
nr_params_field[feature] = total_nr_params;
|
|
||||||
|
|
||||||
feature_name = feature; sub(/_/,"-",feature_name);
|
|
||||||
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 != "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 != "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 = split (element_def, elements, /:/);
|
|
||||||
for (element = 1; element <= nr_elements; element++) {
|
|
||||||
list = elements[element];
|
|
||||||
type = elements[element];
|
|
||||||
sub(/\(.*/, "", type);
|
|
||||||
sub(/^.*\(/, "", list); sub(/\)$/, "", list);
|
|
||||||
count = split (list, fields, /,/);
|
|
||||||
for (field = 1; field <= count; field++) {
|
|
||||||
if (fields[field] ~ /^(\w+)\[([0-9]+)\]$/) {
|
|
||||||
split(fields[field], field_parts, /\[/);
|
|
||||||
fields[field] = field_parts[1];
|
|
||||||
sub(/\]/, "", field_parts[2]);
|
|
||||||
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 "";
|
|
||||||
}
|
|
||||||
|
|
||||||
/^[^#]/ { make_output($0) }
|
|
||||||
|
|
||||||
END {
|
|
||||||
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 "}";
|
|
||||||
}
|
|
||||||
274
sysdeps/guile/guile.pl
Normal file
274
sysdeps/guile/guile.pl
Normal file
@@ -0,0 +1,274 @@
|
|||||||
|
#!/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 '';
|
||||||
|
}
|
||||||
@@ -12,14 +12,14 @@ libgtop_guile_names_la_LDFLAGS = $(LT_VERSION_INFO)
|
|||||||
|
|
||||||
Makefile: $(BUILT_SOURCES)
|
Makefile: $(BUILT_SOURCES)
|
||||||
|
|
||||||
guile-names.c: guile-names.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
guile-names.c: guile-names.pl $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||||
$(AWK) -f $(srcdir)/guile-names.awk < $(top_srcdir)/features.def > gnc-t
|
$(PERL) $(srcdir)/guile-names.pl < $(top_srcdir)/features.def > gnc-t
|
||||||
mv gnc-t guile-names.c
|
mv gnc-t guile-names.c
|
||||||
|
|
||||||
guile-names.x: guile-names.c
|
guile-names.x: guile-names.c
|
||||||
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
|
guile-snarf $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@
|
||||||
|
|
||||||
EXTRA_DIST = guile-names.awk
|
EXTRA_DIST = guile-names.pl
|
||||||
|
|
||||||
CLEANFILES = guile-names.c guile-names.x
|
CLEANFILES = guile-names.c guile-names.x
|
||||||
|
|
||||||
|
|||||||
@@ -1,152 +0,0 @@
|
|||||||
BEGIN {
|
|
||||||
print "/* guile_names.c */";
|
|
||||||
print "/* This is a generated file. Please modify `guile-names.awk' */";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
print "#include <glibtop.h>";
|
|
||||||
print "#include <glibtop/sysdeps.h>";
|
|
||||||
print "#include <glibtop/union.h>";
|
|
||||||
print "";
|
|
||||||
print "#include <guile/gh.h>";
|
|
||||||
|
|
||||||
print "";
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
function output(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 "\tint i;";
|
|
||||||
print "\tSCM list;";
|
|
||||||
print "";
|
|
||||||
|
|
||||||
out = "\tlist = gh_list (";
|
|
||||||
|
|
||||||
nr_elements = split (element_defs[feature], elements, /:/);
|
|
||||||
for (element = 1; element <= nr_elements; element++) {
|
|
||||||
list = elements[element];
|
|
||||||
type = elements[element];
|
|
||||||
sub(/\(.*/, "", type);
|
|
||||||
sub(/^.*\(/, "", list); sub(/\)$/, "", list);
|
|
||||||
count = split (list, fields, /,/);
|
|
||||||
for (field = 1; field <= count; field++) {
|
|
||||||
if (fields[field] ~ /^(\w+)\[([0-9]+)\]$/) {
|
|
||||||
split(fields[field], field_parts, /\[/);
|
|
||||||
fields[field] = field_parts[1];
|
|
||||||
sub(/\]/, "", field_parts[2]);
|
|
||||||
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 "";
|
|
||||||
}
|
|
||||||
|
|
||||||
/^[^#]/ {
|
|
||||||
line = $0;
|
|
||||||
split (line, line_fields, /\|/);
|
|
||||||
feature = line_fields[2];
|
|
||||||
element_def = line_fields[3];
|
|
||||||
sub(/^@/,"",feature);
|
|
||||||
|
|
||||||
features[feature] = feature;
|
|
||||||
element_defs[feature] = element_def;
|
|
||||||
}
|
|
||||||
|
|
||||||
END {
|
|
||||||
features["sysdeps"] = "sysdeps";
|
|
||||||
|
|
||||||
for (feature in features) {
|
|
||||||
output(feature);
|
|
||||||
}
|
|
||||||
|
|
||||||
for (feature in features) {
|
|
||||||
feature_name = feature; sub(/_/, "-", feature_name);
|
|
||||||
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\"";
|
|
||||||
for (feature in 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 "}";
|
|
||||||
}
|
|
||||||
|
|
||||||
198
sysdeps/guile/names/guile-names.pl
Normal file
198
sysdeps/guile/names/guile-names.pl
Normal file
@@ -0,0 +1,198 @@
|
|||||||
|
#!/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 "\tint i;";
|
||||||
|
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