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

New file.

Browse Source 
1998-10-10  Martin Baulig  <martin@home-of-linux.org>

	* typemap: New file.

	* perl.awk: Make it work with the new format of `features.def'.

	* Makefile.PL.in: Added typemap.

	* Libgtop.pm (new): New function.
This commit is contained in:
Martin Baulig
1998-10-10 17:23:52 +00:00
committed by Martin Baulig
parent 8014f2590b
commit 3af2e87c77
6 changed files with 116 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
perl/ChangeLog Normal file
View File

@@ -0,0 +1,10 @@
1998-10-10 Martin Baulig <martin@home-of-linux.org>
* typemap: New file.
* perl.awk: Make it work with the new format of `features.def'.
* Makefile.PL.in: Added typemap.
* Libgtop.pm (new): New function.

7
perl/Libgtop.pm
View File

@@ -20,6 +20,13 @@ bootstrap Libgtop $VERSION;
# Preloaded methods go here.
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = Libgtop::init ($class);
return $self;
}
# Autoload methods go after __END__, and are processed by the autosplit program.
1;

3
perl/Makefile.PL.in
View File

@@ -3,7 +3,8 @@ use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile('NAME' => 'Libgtop',
'VERSION_FROM' => 'Libgtop.pm',
'VERSION_FROM' => '@srcdir@/Libgtop.pm',
'TYPEMAPS' => ['@srcdir@/typemap' ],
'LIBS' => ['@LIBGTOP_GUILE_LIBS@'],
'DEFINE' => '',
'INC' => '@LIBGTOP_GUILE_INCS@',

9
perl/new.pl
View File

@@ -6,8 +6,11 @@ use blib;
use strict;
use Libgtop;
print "CPU Usage: ".join (':', Libgtop::cpu)."\n";
print "Memory Usage: ".join (':', Libgtop::mem)."\n";
print "Swap Usage: ".join (':', Libgtop::swap)."\n";
my $server = Libgtop->new;
print "CPU Usage: ".join (':', $server->cpu)."\n";
print "Memory Usage: ".join (':', $server->mem)."\n";
print "Swap Usage: ".join (':', $server->swap)."\n";
print "Process List: ".join (' ', $server->proclist (0,0))."\n";

89
perl/perl.awk
View File

@@ -17,33 +17,81 @@ BEGIN {
print "";
print "#include <glibtop.h>";
print "#include <glibtop/union.h>";
print "#include <glibtop/xmalloc.h>";
print "";
print "MODULE = Libgtop\t\tPACKAGE = Libgtop";
print "";
print "PROTOTYPES: ENABLE";
print "";
print "glibtop *";
print "init (CLASS)";
print "\tchar *CLASS;";
print "CODE:";
print "\tRETVAL = glibtop_calloc (1, sizeof (glibtop *));";
print "\tglibtop_init_s (&RETVAL, 0, 0);";
print "OUTPUT:";
print "\tRETVAL";
print "";
type_convert["long"] = "int64_t";
type_convert["ulong"] = "u_int64_t";
type_convert["pid_t"] = "pid_t";
type_convert["int"] = "int";
convert["long"] = "newSViv";
convert["ulong"] = "newSViv";
convert["double"] = "newSVnv";
}
/^(\w+)/ {
feature = $1;
function output(line) {
split (line, line_fields, /\|/);
retval = line_fields[1];
feature = line_fields[2];
element_def = line_fields[3];
param_def = line_fields[4];
print "void";
if (feature ~ /^proc_/) {
print feature"(pid)";
print "\tunsigned\tpid;";
orig = feature; sub(/^@/,"",feature);
space = feature; gsub(/./," ",space);
if (feature ~ /^proc_map/)
return;
else if (feature ~ /^mountlist/)
return;
else if (feature ~ /^fsusage/)
return;
if (param_def == "string") {
call_param = line_fields[5];
param_decl = "\tconst char *"line_fields[5]";\n";
} else {
print feature"()";
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, /,/);
for (field = 1; field <= count; field++) {
param_decl = param_decl"\t";
call_param = call_param", ";
param_decl = param_decl""type_convert[type]" "fields[field]";\n";
call_param = call_param""fields[field];
}
}
}
print "PREINIT:";
print "void";
print feature" (server"call_param")";
print "\tglibtop *server;";
print param_decl"PREINIT:";
print "\tglibtop_"feature" "feature";";
if (feature ~ /^proclist/) {
print "\tunsigned i, *ptr;";
print "PPCODE:";
print "\tptr = glibtop_get_proclist (&proclist);";
print "\tptr = glibtop_get_proclist (&proclist, which, arg);";
print "";
print "\tif (ptr) {";
print "\t\tfor (i = 0; i < proclist.number; i++)";
@@ -53,28 +101,27 @@ BEGIN {
print "\tglibtop_free (ptr);";
} else {
print "PPCODE:";
if (feature ~ /^proc_/) {
print "\tglibtop_get_"feature" (&"feature", pid);";
} else {
print "\tglibtop_get_"feature" (&"feature");";
}
if (call_param != "")
print "\tglibtop_get_"feature"_l (server, &"feature""call_param");";
else
print "\tglibtop_get_"feature"_l (server, &"feature");";
print "";
nr_elements = split ($2, elements, /:/);
nr_elements = split (element_def, elements, /:/);
for (element = 1; element <= nr_elements; element++) {
list = elements[element];
type = elements[element];
sub(/\(.*/, "", type);
sub(/^\w+\(/, "", list); sub(/\)$/, "", list);
sub(/^.*\(/, "", list); sub(/\)$/, "", list);
count = split (list, fields, /,/);
for (field = 1; field <= count; field++) {
if (type ~ /^str$/) {
print "\tXPUSHs (sv_2mortal (newSVpv ("$1"."fields[field]", 0)));";
print "\tXPUSHs (sv_2mortal (newSVpv ("feature"."fields[field]", 0)));";
} else {
if (type ~ /^char$/) {
print "\tXPUSHs (sv_2mortal (newSVpv (&"$1"."fields[field]", 1)));";
print "\tXPUSHs (sv_2mortal (newSVpv (&"feature"."fields[field]", 1)));";
} else {
print "\tXPUSHs (sv_2mortal ("convert[type]" ("$1"."fields[field]")));";
print "\tXPUSHs (sv_2mortal ("convert[type]" ("feature"."fields[field]")));";
}
}
}
@@ -84,3 +131,5 @@ BEGIN {
print "";
}
/^[^#]/ { output($0) }

22
perl/typemap Normal file
View File

@@ -0,0 +1,22 @@
TYPEMAP
int64_t T_IV
pid_t T_IV
const char * T_PV
glibtop * O_OBJECT
OUTPUT
# The Perl object is blessed into 'CLASS', which should be a
# char* having the name of the package for the blessing.
O_OBJECT
sv_setref_pv ($arg, CLASS, (void*)$var);
INPUT
O_OBJECT
if (sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG))
$var = ($type)SvIV((SV*)SvRV($arg));
else {
warn (\"${Package}::$func_name() -- \"
\"$var is not a blessed SV reference\");
XSRETURN_UNDEF;
}