slang-pvm 0.1.5-13 / usr / share / slsh / local-packages / pvm.sl

%-*- mode: slang; mode: fold; -*-
import ("pvm");

#iffalse
require ("xpvm");
#ifexists xpvm_setup
% optionally support using XPVM for process tracing
xpvm_setup ();
#endif
#endif

public define pvm_psend () %{{{
{
   variable objs = __pop_args (_NARGS-2);
   variable msgid = ();
   variable tid = ();

   () = pvm_initsend (PvmDataDefault);
   foreach (objs)
     {
	variable data = ();
	pvm_pack (data.value);
     }
   pvm_send (tid, msgid);
}

%}}}

static define pack_item ();
static define unpack_item ();

static define unpack_strings (num) %{{{
{
   if (num == 0)
     return String_Type[0];

   variable s = DataType_Type[num];

   s[*] = String_Type;
   return array_map (String_Type, &pvm_unpack, s);
}

%}}}

static define pack_strings (a) %{{{
{
   if (length (a) > 0)
     array_map (Void_Type, &pvm_pack, a);
}

%}}}

static define unpack_one_struct (i) %{{{
{
   variable names, s;

   names = unpack_item ();
   if (typeof(names) != Array_Type)
     names = [names];   
   eval (sprintf ("define __atos__(){return struct {%s};}",
		                    strjoin (names, ",")));
   s = eval ("__atos__()");

   foreach (names)
     {
	variable n = ();
	set_struct_field (s, n, unpack_item());
     }

   return s;
}

%}}}

static define pack_one_struct (s) %{{{
{
   variable names, value;

   names = get_struct_field_names (s);
   pack_item (names);

   foreach (names)
     {
	variable name = ();
	value = get_struct_field (s, name);
	pack_item (value);
     }
}

%}}}

static define unpack_struct (num) %{{{
{
   if (num == 0)
     return Struct_Type[0];

   return array_map (Struct_Type, &unpack_one_struct, [0:num-1]);
}

%}}}

static define pack_struct (a) %{{{
{
   array_map (Void_Type, &pack_one_struct, a);
}

%}}}

static define unpack_one_assoc (num) %{{{
{
   variable names = unpack_item ();

   if (length(names) == 1)
     names = [names];

   variable a = Assoc_Type[];

   foreach (names)
     {
	variable n = ();
	a[n] = unpack_item ();
     }

   return a;
}

%}}}

static define pack_one_assoc (a) %{{{
{
   variable names = assoc_get_keys (a);

   pack_item (names);
   foreach (names)
     {
	variable n = ();
	pack_item (a[n]);
     }
}

%}}}

static define unpack_assoc (len) %{{{
{
   if (len == 0)
     return Assoc_Type[];

   return unpack_one_assoc (len);
}

%}}}

static define pack_assoc (a) %{{{
{
   pack_one_assoc(a);
}

%}}}

static define unpack_item () %{{{
{
   variable type, num, item;

   type = __datatype(pvm_unpack (Int_Type, 1)[0]);
   num = pvm_unpack (Int_Type, 1)[0];

   switch (type)
     {
      case String_Type:
	item = unpack_strings (num);
     }
     {
      case Struct_Type:
	item = unpack_struct (num);
     }
     {
      case Assoc_Type:
	item = unpack_assoc (num);
     }
     {
      case Null_Type:
	item = Null_Type[num];
     }
     {
	% default
	item = pvm_unpack (type, num);
     }

   if (num == 1 and type != Assoc_Type)
     return item[0];

   return item;
}

%}}}

static define pack_item (item) %{{{
{
   variable type;

   if (is_struct_type (item))
     type = typeof (struct{x});
   else
     type = _typeof(item);

   pvm_pack (__class_id(type));
   pvm_pack (length(item));

   switch (type)
     {
      case String_Type:
	pack_strings (item);
     }
     {
      case Struct_Type:
	pack_struct (item);
     }
     {
      case Assoc_Type:
	pack_assoc (item);
     }
     {
      case Null_Type:
	return;
     }
     {
	% default:
	pvm_pack (item);
     }
}

%}}}

public define pvm_send_obj () %{{{
{
   variable objs = __pop_args (_NARGS-2);
   variable msgid = ();
   variable tid = ();

   () = pvm_initsend (PvmDataDefault);
   foreach (objs)
     {
	variable data = ();
	pack_item (data.value);
     }
   pvm_send (tid, msgid);
}

%}}}

public define pvm_recv_obj () %{{{
{
   return unpack_item ();
}

%}}}

public define pvm_addhosts () %{{{
{
   variable args = __pop_args (_NARGS);
   variable hosts = [__push_args (args)];

   return array_map (Int_Type, &pvm_addhost, hosts);
}

%}}}

public define pvm_delhosts () %{{{
{
   variable args = __pop_args (_NARGS);
   variable hosts = [__push_args (args)];

   array_map (Void_Type, &pvm_delhost, hosts);
}

%}}}

provide ("pvm");

#ifexists add_doc_file
$1 = path_concat (path_concat (path_dirname (__FILE__), "help"),
		  "pvm.hlp");
if (NULL != stat_file ($1))
  add_doc_file ($1);
#endif