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>
|
||||
|
||||
* 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, )
|
||||
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(RANLIB,ranlib)
|
||||
AC_CHECK_TOOL(AS,as)
|
||||
|
||||
@@ -12,11 +12,11 @@ libgtop_la_LDFLAGS = $(LT_VERSION_INFO)
|
||||
|
||||
BUILT_SOURCES = lib.c
|
||||
|
||||
lib.c: lib.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||
$(AWK) -f $(srcdir)/lib.awk < $(top_srcdir)/features.def > lib-t
|
||||
lib.c: lib.pl $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||
$(PERL) $(srcdir)/lib.pl < $(top_srcdir)/features.def > lib-t
|
||||
mv lib-t lib.c
|
||||
|
||||
EXTRA_DIST = lib.awk
|
||||
EXTRA_DIST = lib.pl
|
||||
|
||||
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)
|
||||
|
||||
guile.c: guile.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||
$(AWK) -f $(srcdir)/guile.awk < $(top_srcdir)/features.def > gnc-t
|
||||
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.awk
|
||||
EXTRA_DIST = guile.pl
|
||||
|
||||
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)
|
||||
|
||||
guile-names.c: guile-names.awk $(top_builddir)/config.h $(top_srcdir)/features.def
|
||||
$(AWK) -f $(srcdir)/guile-names.awk < $(top_srcdir)/features.def > gnc-t
|
||||
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.awk
|
||||
EXTRA_DIST = guile-names.pl
|
||||
|
||||
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