diff --git a/ChangeLog b/ChangeLog index f8d16519..7c109b18 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +1999-02-18 Martin Baulig + + * */*.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 * sysdeps/common/error.c (glibtop_error_r, glibtop_warn_r): Define diff --git a/configure.in b/configure.in index 196ed339..9b470083 100644 --- a/configure.in +++ b/configure.in @@ -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) diff --git a/lib/Makefile.am b/lib/Makefile.am index 1ab3f33c..7120f4ca 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -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 diff --git a/lib/lib.awk b/lib/lib.awk deleted file mode 100644 index 31a07008..00000000 --- a/lib/lib.awk +++ /dev/null @@ -1,167 +0,0 @@ -BEGIN { - print "/* lib.c */"; - print "/* This is a generated file. Please modify `lib.awk' */"; - print ""; - - print "#include "; - print "#include "; - print ""; - print "#include "; - print "#include "; - print ""; - print "#include "; - - 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) } - diff --git a/lib/lib.pl b/lib/lib.pl new file mode 100755 index 00000000..5fb09eac --- /dev/null +++ b/lib/lib.pl @@ -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 '; +print '#include '; +print ''; +print '#include '; +print '#include '; +print ''; +print '#include '; + +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 ''; +} diff --git a/sysdeps/guile/Makefile.am b/sysdeps/guile/Makefile.am index fff3f0e6..53c06703 100644 --- a/sysdeps/guile/Makefile.am +++ b/sysdeps/guile/Makefile.am @@ -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 diff --git a/sysdeps/guile/guile.awk b/sysdeps/guile/guile.awk deleted file mode 100644 index 615b40e8..00000000 --- a/sysdeps/guile/guile.awk +++ /dev/null @@ -1,220 +0,0 @@ -BEGIN { - print "/* guile.c */"; - print "/* This is a generated file. Please modify `guile.awk' */"; - print ""; - - print "#include "; - print "#include "; - print "#include "; - print "#include "; - print ""; - print "#include "; - - 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 "}"; -} diff --git a/sysdeps/guile/guile.pl b/sysdeps/guile/guile.pl new file mode 100644 index 00000000..7a272ebc --- /dev/null +++ b/sysdeps/guile/guile.pl @@ -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 '; +print '#include '; +print '#include '; +print '#include '; +print ''; +print '#include '; + +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 ''; +} diff --git a/sysdeps/guile/names/Makefile.am b/sysdeps/guile/names/Makefile.am index 3d10c066..1e64cbb1 100644 --- a/sysdeps/guile/names/Makefile.am +++ b/sysdeps/guile/names/Makefile.am @@ -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 diff --git a/sysdeps/guile/names/guile-names.awk b/sysdeps/guile/names/guile-names.awk deleted file mode 100644 index 8a91a226..00000000 --- a/sysdeps/guile/names/guile-names.awk +++ /dev/null @@ -1,152 +0,0 @@ -BEGIN { - print "/* guile_names.c */"; - print "/* This is a generated file. Please modify `guile-names.awk' */"; - print ""; - - print "#include "; - print "#include "; - print "#include "; - print ""; - print "#include "; - - 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 "}"; -} - diff --git a/sysdeps/guile/names/guile-names.pl b/sysdeps/guile/names/guile-names.pl new file mode 100644 index 00000000..07fcdffc --- /dev/null +++ b/sysdeps/guile/names/guile-names.pl @@ -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 '; +print '#include '; +print '#include '; +print ''; +print '#include '; + +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 ''; +}