RPM Program 2

$ standard_level 'HP3000', uslinit$
program creature(datafile);       {"datafile" must be an already
                                    existing file}
const
     maxdata    = 2000;
     maxmsg     = maxdata + 2;
     maxname    = 20;
     maxloc     = 20;type
     byte       = 0..255;
     shortint   = -32768..32767;
     datatype   =
         recordlen : shortint;
        msg : packed array[1..maxdata] of char;
        end;
     nametype = packed array[1..maxname] of char;
     loctype  = packed array[1..maxloc] of char;var
     datafile      : text;
     rpmstringlen : integer;
     socketname   : packed array [1..16] of char;
     nodename     : packed array [1..16] of char;
     destdesc     : integer;
     calldesc           : integer;
     vcdesc           : integer;
     result       : integer;
     data         : datatype;
     strdata      : string[maxdata];
     socknmlen  : integer;
     nodenmlen  : integer;
     y_data       : char;
     y_len        : integer;procedure terminate; intrinsic;{RPM and IPC intrinsic declarations}
procedure rpmgetstring; intrinsic;
procedure ipcerrmsg; intrinsic;
procedure ipclookup; intrinsic;
procedure ipccreate; intrinsic;
procedure ipcconnect; intrinsic;procedure ipcrecv; intrinsic;
procedure ipcsend; intrinsic;
procedure ipcshutdown; intrinsic;{error handling procedure}
procedure check (result : integer);
{error procedure}
begin
if result < > 0 then
     terminate;    {failed}
end;begin  {creature}
{get the creator process's socket name and node name, one at a time, from  the rpmstrings}
rpmstringlen:= maxname;
rpmgetstring (socketname, rpmstringlen, result);
socknmlen := rpmstringlen;
strmove (socknmlen, socketname, 1, strdata, 1);
rpmstringlen := maxloc;
rpmgetstring (nodename, rpmstringlen, result);
nodenmlen := rpmstringlen;
setstrlen(strdata,0);
strmove(nodenmlen, nodename, 1, strdata, 1);
{look up socket name to get destination descriptor}
ipclookup (socketname,socknmlen,nodename,nodenmlen,,destdesc, , ,result);check (result);    {error procedure}
{create a call socket for this process}
ipccreate (3, 4, , , calldesc, result);   {call socket, TCP protocol}
check (result);
{send a connection request to the creator process and receive the creator's
reply to complete the connection}ipcconnect (calldesc,  destdesc, , , vcdesc, result);
check (result);
ipcrecv (vcdesc, , , , ,result);
check (result);
ipcshutdown (alldesc);
ipcshutdown (destdesc);
{send messages on connection}
{ prompt for messages and send them }reset(datafile);                          {open input file}while not EOF(datafile) do
     begin
     setstrlen(strdata, 0);
     readln(datafile, strdata);                     {read message}
     data.len := strlen(strdata);                   {store message length}
     strmove(data.len, strdata, 1, data.msg, 1);    {store message}
     ipcsend(vcdesc, data, data.len+2, , , result); {send message,
                                                       including length
                                                         as first 2 bytes}check(result);     {failed}
end;
{connection shutdown procedure}data.len := 3;
data.msg := 'END';                      {termination request}
ipcsend(vcdesc, data, 5, , , result);
check(result);
y_len := 1;
ipcrecv (vcdesc, y_data, y_len, , , result);
if (y_data = 'Y') and (result = 0)
   then ipcshutdown(vcdesc)
   else
   check(result);

end.  {creature}