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

Return vector for functions returning arrays.

Browse Source
This commit is contained in:
Martin Baulig
1999-12-05 14:55:18 +00:00
parent ca27a66593
commit c40788c5b2
2 changed files with 47 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
sysdeps/guile/guile.pl
View File

@@ -91,6 +91,8 @@ for ($nr = 0; $nr < $smob_count; $nr++) {
printf (qq[\#define %-40s\t%d\n], 'GLIBTOP_STRUCTURE_'.&toupper($smob), $nr); printf (qq[\#define %-40s\t%d\n], 'GLIBTOP_STRUCTURE_'.&toupper($smob), $nr);
} }
print '';
printf (qq[\#define %-40s\t%d\n], 'GLIBTOP_MAX_STRUCTURES', $smob_count);
print ''; print '';
print qq[END_LIBGTOP_DECLS]; print qq[END_LIBGTOP_DECLS];
print ''; print '';
@@ -199,8 +201,8 @@ sub make_output {
$func_decl_code = sprintf $func_decl_code = sprintf
(qq[static SCM\nglibtop_guile_get_%s (SCM server_smob%s)], $feature, $param_decl); (qq[static SCM\nglibtop_guile_get_%s (SCM server_smob%s)], $feature, $param_decl);
if ($retval =~ /^array\((.*)\)$/) { if ($retval =~ /^(array|pointer)\((.*)\)$/) {
$retval_type = "$1 *"; $retval_type = "$2 *";
} elsif ($retval eq 'retval') { } elsif ($retval eq 'retval') {
$retval_type = 'int'; $retval_type = 'int';
} else { } else {
@@ -235,6 +237,48 @@ sub make_output {
(qq[\t*(glibtop_%s *) SCM_SMOB_DATA (smob_answer) = %s;\n\n], (qq[\t*(glibtop_%s *) SCM_SMOB_DATA (smob_answer) = %s;\n\n],
$feature, $feature); $feature, $feature);
if ($retval =~ /^(array|pointer)\((.*)\)$/) {
$array_type = $2; $which_type = $1;
$local_var_decl_code .= sprintf (qq[\tSCM smob_array;\n]);
$local_var_decl_code .= sprintf (qq[\tint i;\n]);
$make_array_code = sprintf
(qq[\tsmob_array = scm_make_vector (SCM_MAKINUM (%s.number), %s);\n],
$feature, 'SCM_BOOL_F');
$make_array_code .= sprintf
(qq[\tfor (i = 0; i < %s.number; i++) \{\n], $feature);
if ($which_type eq 'array') {
$make_array_code .= sprintf
(qq[\t\tSCM _smob;\n\n], $feature);
$make_array_code .= sprintf
(qq[\t\t_smob = scm_make_smob\n\t\t\t(scm_glibtop_smob_tags\n\t\t\t [GLIBTOP_STRUCTURE_%s]);\n], toupper($array_type));
$make_array_code .= sprintf
(qq[\t\t*(%s *) SCM_SMOB_DATA (_smob) = retval [i];\n], $array_type);
$make_array_code .= sprintf
(qq[\t\tscm_vector_set_x (smob_array, SCM_MAKINUM (i), _smob);\n]);
} else {
$make_array_code .= sprintf
(qq[\t\tscm_vector_set_x (smob_array, SCM_MAKINUM (i),\n\t\t\t\t %s (retval [i]));\n],
$typeinfo->{$array_type}->[0]);
}
$make_array_code .= "\t}\n\n";
$return_smob_code = $make_array_code;
$return_smob_code .= sprintf
(qq[\treturn scm_cons (smob_array, smob_answer);]);
} else {
$return_smob_code = sprintf
(qq[\treturn smob_answer;]);
}
$nr_elements = (@elements = split(/:/, $element_def, 9999)); $nr_elements = (@elements = split(/:/, $element_def, 9999));
for ($element = 1; $element <= $nr_elements; $element++) { for ($element = 1; $element <= $nr_elements; $element++) {
$list = $elements[$element]; $list = $elements[$element];
@@ -263,9 +307,6 @@ sub make_output {
(qq[SCM_GLOBAL_VCELL_INIT (s_%s_names, "glibtop-fields-%s", \\\n\t\t gh_list (%sSCM_UNDEFINED));], (qq[SCM_GLOBAL_VCELL_INIT (s_%s_names, "glibtop-fields-%s", \\\n\t\t gh_list (%sSCM_UNDEFINED));],
$feature, $feature_name, $field_list_code); $feature, $feature_name, $field_list_code);
$return_smob_code = sprintf
(qq[\treturn smob_answer;]);
$total = sprintf ("%s\n\n%s\n\n%s\n{\n%s\n\n%s\n%s\n%s%s\n\n%s\n%s\n%s\n%s\n}\n", $total = sprintf ("%s\n\n%s\n\n%s\n{\n%s\n\n%s\n%s\n%s%s\n\n%s\n%s\n%s\n%s\n}\n",
$scm_proc_code, $scm_fields_code, $func_decl_code, $scm_proc_code, $scm_fields_code, $func_decl_code,
$local_var_decl_code, $init_server_code, $local_var_decl_code, $init_server_code,

1
sysdeps/guile/main.c
View File

@@ -2,6 +2,7 @@
#include "structures.h" #include "structures.h"
#include <libguile/snarf.h> #include <libguile/snarf.h>
long scm_glibtop_smob_tags [GLIBTOP_MAX_STRUCTURES];
SCM scm_glibtop_global_server_smob; SCM scm_glibtop_global_server_smob;
SCM_GLOBAL_VCELL (s_glibtop_global_server, "glibtop-global-server"); SCM_GLOBAL_VCELL (s_glibtop_global_server, "glibtop-global-server");