HPlogo NetIPC 3000/XL Programmer's Reference Manual: HP 3000 MPE/iX Computer Systems > Chapter 4 NetIPC Examples

Example 2

» 

Technical documentation

Complete book in PDF
» Feedback

 » Table of Contents

 » Glossary

 » Index

This pair of programs show the differences in compiler options for writing NetIPC programs to run in compatibility mode and native mode. The programs are designated vector1 and vector2. You can compile them in either compatibility mode or native mode as described in the comments preceding the programs.

Program 2A (Vector1)

{**********************************************************************}{ This program pair, vector1 and vector2, gives an example of how to   }
{ send and receive vectored data, both in Compatibility Mode and       }
{ Native Mode.  To compile in Native Mode, set the native_mode flag to }
{ true; compile with "pasxl svector1,,$null" and link with             }
{ "link $oldpass,nvector1".  Run nvector1 before running nvector2.     }
{ To compile in Compatibility mode, set the native_mode flag to false; }
{ compile with "pascal svector1,,$null" and link with                  }
{ "prep $oldpass,pvector1".  Run pvector1 before pvector2.  You can    }
{ run pvector1 with nvector2, or nvector1 with pvector2.               }
{**********************************************************************}
$set 'native_mode = true '$
$stats off$
$code_offsets on$
$tables on$
$lines 120$
$if 'native_mode'$
  $standard_level 'hp_modcal'$
   $type_coercion 'conversion'$
$else$
   $uslinit$
$endif$
program vector1 (input,output);
 
TYPE
   byte     =      0..255;             { this is one byte long         }
   shortint = -32768..32767;           { this is two bytes long        }
 
CONST
$if 'native_mode'$
   DESC_TYPE    =     4;               { descriptor type for 64b ptr   }
   DESC_LEN     =    12;               { length of NM vector descriptor}
$else$
   DESC_TYPE    =     0;               { descriptor type for CM stack  }
   DESC_LEN     =     8;               { length of CM vector descriptor}
$endif$
 
   F_VECTORED   =    31;               { vectored data                 }
 
TYPE
   flags_type       = set of 0..31;
   msg_type         = packed array [1..80] of char;
 
   netipc_data_desc = packed record
      { This structure contains a maximum of two data descriptors.     }
$if 'native_mode'$
      d_desc_type1      : shortint;       { type of data desc - use 4  }
      d_desc_len1       : shortint;       { length in bytes of area 1  }
      d_desc_dataptr1   : globalanyptr;   { pointer to area 1          }
 
      d_desc_type2      : shortint;       { type of d_d - use 4        }
      d_desc_len2       : shortint;       { length in bytes of area 2  }
      d_desc_dataptr2   : globalanyptr;   { pointer to area 2          }
$else$
      d_desc_type1      : shortint;       { type of data desc - use 0  }
      d_desc_dst1       : shortint;       { dst is 0 for stack         }
      d_desc_dataptr1   : shortint;       { pointer to area 1          }
      d_desc_len1       : shortint;       { length in bytes of area 1  }
 
      d_desc_type2      : shortint;       { type of d_d - use 0        }
      d_desc_dst2       : shortint;       { dst is 0 for stack         }
      d_desc_dataptr2   : shortint;       { pointer to area 2          }
      d_desc_len2       : shortint;       { length in bytes of area 2  }
$endif$
      end;
CONST
   SOCK_ADDR = 32000;                 { socket's address               }
 
VAR
   sd_local:     integer;             { local socket descriptor        }
   cd_local:     integer;             { local connection descriptor    }
   dlen:         integer;             { data length                    }
   flags:        flags_type;          { flags parameter                }
   result:       integer;             { back from IPC call             }
   result16:     shortint;            { back from opt calls            }
   i:            integer;             { loop counter for messages      }
   messag1:      msg_type;            { for printed messages           }
   messag2:      msg_type;            { for printed messages           }
   expect :      msg_type;            { expected message               }
   vd:           netipc_data_desc;    { vectored data desc             }
   error:        boolean;             { set if an error occurred       }
   adrs: packed array [0..1] of byte; { socket's address               }
   opt:  packed array [0..31] of byte;{ options array                  }
{ IPC intrinsics used }
procedure addopt;      intrinsic;
procedure initopt;     intrinsic;
procedure ipccheck;    intrinsic;
procedure ipcconnect;  intrinsic;
procedure ipccontrol;  intrinsic;
procedure ipccreate;   intrinsic;
procedure ipcdest;     intrinsic;
procedure ipcerrmsg;   intrinsic;
procedure ipcget;      intrinsic;
procedure ipcgive;     intrinsic;
procedure ipcrecv;     intrinsic;
procedure ipcrecvcn;   intrinsic;
procedure ipcsend;     intrinsic;
procedure ipcshutdown; intrinsic;
begin
$if 'native_mode'$
writeln
('example program vector1 to show vectored data operation in Native Mode');
$else$
writeln
('example program vector1 to show vectored data operation in Compatibility Mode'
 );
$endif$
 
{ specify the address of the local socket }
adrs[0] := SOCK_ADDR div 256;   { first 8 bits of 32000                }
adrs[1] := SOCK_ADDR mod 256;   { last 8 bits of 32000                 }
 
{ initialize opt array for one entry }
initopt ( opt, 1, result16 );
if result16 <> 0 then
   writeln ('initopt failed');
 
{ add the option for specification of the socket's address             }
addopt ( opt, 0, 128, 2, adrs, result16 );
if result16 <> 0 then
   writeln ('addopt failed');
 
{ Create the local socket by using the special option 128 which allows }
{ specification of the socket's address using the opt array.           }
ipccreate ( 3, 4, , opt, sd_local, result );
if result <> 0 then
   writeln ('ipccreate of local socket failed ',  result );
{ Local side receives the connection }
ipcrecvcn ( sd_local, cd_local, , , result );
if result <> 0 then
   writeln ('ipcrecvcn failed');
 
{ set up vectors, ready for sending and receiving data                 }
$if 'native_mode'$
vd.d_desc_dataptr1 := globalanyptr ( addr ( messag1 ) );
vd.d_desc_dataptr2 := globalanyptr ( addr ( messag2 ) );
$else$
vd.d_desc_dst1     := 0;    { this is ignored                          }
vd.d_desc_dataptr1 := baddress ( messag1 );
vd.d_desc_dst2     := 0;    { this is ignored                          }
vd.d_desc_dataptr2 := baddress ( messag2 );
 $endif$
vd.d_desc_type1    := DESC_TYPE;
vd.d_desc_type2    := DESC_TYPE;
flags              := [ F_VECTORED ];
{ Receive the message in a double vector                               }
messag1 := '                                              ';      { 46 }
messag2 := '                                              ';      { 46 }
vd.d_desc_len1 := 27;               { max we are willing to receive    }
vd.d_desc_len2 := 80;               { max we are willing to receive    }
dlen := DESC_LEN * 2;               { 2 vectors                        }
ipcrecv ( cd_local, vd, dlen, flags, , result );
if result <> 0 then
   writeln ('ipcrecv data failed');
if dlen <> 40 then
   writeln ('dlen was not = 40');
 
{ Check that the correct data was received in the first vector       }
expect  := '40 four oh forty XL 40 four ';
error := false;
for i := 1 to 27 do
   if messag1[i] <> expect[i] then
      error := true;
if error then
   begin
   writeln ('did not receive expected first vector data, got:');
   writeln ( messag1 );
   end;
{ Check that the correct data was received in the second vector      }
expect  := ' tens fortify';
error := false;
for i := 1 to (dlen - 27) do
   if messag2[i] <> expect[i] then
      error := true;
if error then
   begin
   writeln ('did not receive expected second vector data, got:');
   writeln ( messag2 );
   end;
{ Now send a single vectored message to the local side }
messag1         := '.';              { This means GREETINGS          }
vd.d_desc_len1  := 1;                { byte size of message          }
dlen            := DESC_LEN;
ipcsend ( cd_local, vd, dlen, flags, , result );
if result <> 0 then
   writeln ('ipcsend failed');
 
{ do a regular receive of the double vectored send                     }
messag1 := '                                              ';      { 46 }
dlen    := 46;                         { max amount of data to receive }
ipcrecv ( cd_local, messag1, dlen, , , result );
if result <> 0 then
   writeln ('ipcrecv data failed');
if dlen <> 21 then
   writeln ('dlen was not = 21');
 
{ Check that the correct data was received }
expect  := 'Abaracadabara  magic!';
error := false;
for i := 1 to dlen do
   if messag1[i] <> expect[i] then
      error := true;
if error then
   begin
   writeln ('did not receive expected data, got:');
   writeln ( messag1 );
   end;
 
{ Clean up and shutdown }
 
{ shutdown the local connection descriptor }
ipcshutdown ( cd_local, , , result );
if result <> 0 then
   writeln ('ipcshutdown cd_local failed');
{ shutdown the local socket descriptor }
ipcshutdown ( sd_local, , , result );
if result <> 0 then
   writeln ('ipcshutdown sd_local failed');
 
end.

Program 2B (Vector2)

{**********************************************************************}
{ This program pair, vector1 and vector2, gives an example of how to   }
{ send and receive vectored data, both in Compatibility Mode and       }
{ Native Mode.  To compile in Native Mode, set the native_mode flag to }
{ true; compile with "pasxl svector2,,$null" and link with             }
{ "link $oldpass,nvector2".  Run nvector1 before running nvector2.     }
{ To compile in Compatibility mode, set the native_mode flag to false; }
{ compile with "pascal svector2,,$null" and link with                  }
{ "prep $oldpass,pvector2".  Run pvector1 before pvector2.  You can    }
{ run pvector1 with nvector2 or nvector1 with pvector2.                }
{**********************************************************************}
$set 'native_mode = true '$
$stats off$
$code_offsets on$
$tables on$
$lines 120$
$if 'native_mode'$
   $standard_level 'hp_modcal'$
   $type_coercion 'conversion'$
$else$
   $uslinit$
$endif$
 
program vector2 (input,output);
TYPE
   byte     =      0..255;             { this is one byte long         }
   shortint = -32768..32767;           { this is two bytes long        }
 
CONST
$if 'native_mode'$
   DESC_TYPE    =     4;               { descriptor type for 64b ptr   }
   DESC_LEN     =    12;               { length of NM vector descriptor}
$else$
   DESC_TYPE    =     0;               { descriptor type for CM stack  }
   DESC_LEN     =     8;               { length of CM vector descriptor}
$endif$
 
   F_VECTORED   =    31;               { vectored data                 }
 
TYPE
   flags_type       = set of 0..31;
   location_type    = packed array [1..50] of char;
   msg_type         = packed array [1..80] of char;
 
   netipc_data_desc = packed record
      { This structure contains a maximum of two data descriptors.     }
$if 'native_mode'$
      d_desc_type1      : shortint;     { type of data desc - use 4    }
      d_desc_len1       : shortint;     { length in bytes of area 1    }
      d_desc_dataptr1   : globalanyptr; { pointer to area 1            }
 
      d_desc_type2      : shortint;     { type of d_d - use 4          }
      d_desc_len2       : shortint;     { length in bytes of area 2    }
      d_desc_dataptr2   : globalanyptr; { pointer to area 2            }
$else$
      d_desc_type1      : shortint;     { type of data desc - use 0    }
      d_desc_dst1       : shortint;     { dst is 0 for stack           }
      d_desc_dataptr1   : shortint;     { pointer to area 1            }
      d_desc_len1       : shortint;     { length in bytes of area 1    }
 
      d_desc_type2      : shortint;     { type of d_d - use 0          }
      d_desc_dst2       : shortint;     { dst is 0 for stack           }
      d_desc_dataptr2   : shortint;     { pointer to area 2            }
      d_desc_len2       : shortint;     { length in bytes of area 2    }
$endif$
      end;
 
CONST
   SOCK_ADDR = 32000;                   { socket's address             }
 
VAR
   sd_remote:    integer;               { remote socket descriptor     }
   cd_remote:    integer;               { remote connection descriptor }
   dd:           integer;               { destination descriptor       }
   dlen:         integer;               { data length                  }
   flags:        flags_type;            { flags parameter              }
   result:       integer;               { back from IPC call           }
   result16:     shortint;              { back from opt calls          }
   i:            integer;               { loop counter for messages    }
   messag1:      msg_type;              { for printed messages         }
   messag2:      msg_type;              { for printed messages         }
   expect :      msg_type;              { expected message             }
   vd:           netipc_data_desc;      { vectored data desc           }
   error:        boolean;               { set if an error occurred     }
   location:     location_type;         { other programs location node }
 
   adrs: packed array [0..1] of byte;   { socket's address             }
 
   opt:  packed array [0..31] of byte;  { options array                }
 
{ IPC intrinsics used }
procedure addopt;      intrinsic;
procedure initopt;     intrinsic;
procedure ipccheck;    intrinsic;
procedure ipcconnect;  intrinsic;
procedure ipccontrol;  intrinsic;
procedure ipccreate;   intrinsic;
procedure ipcdest;     intrinsic;
procedure ipcerrmsg;   intrinsic;
procedure ipcget;      intrinsic;
procedure ipcgive;     intrinsic;
procedure ipcrecv;     intrinsic;
procedure ipcrecvcn;   intrinsic;
procedure ipcsend;     intrinsic;
procedure ipcshutdown; intrinsic;
begin
$if 'native_mode'$
writeln
('example program vector2 to show vectored data operation in Native Mode');
$else$
writeln
('example program vector2 to show vectored data operation in 
  Compatibility Mode');
$endif$
 { create the remote socket normally }
ipccreate ( 3, 4, , , sd_remote, result );
if result <> 0 then
   writeln ('ipccreate of remote socket failed');
 
{ Get the destination descriptor to the local socket from the remote   }
{ socket.  Notice that the remote must know the address of the local   }
{ socket.  This arrangement must be made beforehand.                   }
 
{ specify the address of the local socket                              }
adrs[0] := SOCK_ADDR div 256;   { first 8 bits of 32000                }
adrs[1] := SOCK_ADDR mod 256;   { last 8 bits of 32000                 }
location := 'bigblue';
ipcdest ( 3, location, 7, 4, adrs, 2, , , dd, result );
if result <> 0 then
   writeln ('ipcdest failed ' , result );
 
{ Connect to the local socket using the destination descriptor.         }
ipcconnect ( sd_remote, dd, , , cd_remote, result );
 if result <> 0 then
   writeln ('ipcconnect failed ', result );
 
{ remote side does a receive to complete the connection }
ipcrecv ( cd_remote, , , , , result );
if result <> 0 then
   writeln ('ipcrecv to complete connection failed');
 
{ set up vectors ready for sending and receiving data                 }
$if 'native_mode'$
vd.d_desc_dataptr1 := globalanyptr ( addr ( messag1 ) );
vd.d_desc_dataptr2 := globalanyptr ( addr ( messag2 ) );
$else$
vd.d_desc_dst1     := 0;    { this is ignored               }
vd.d_desc_dataptr1 := baddress ( messag1 );
vd.d_desc_dst2     := 0;    { this is ignored               }
vd.d_desc_dataptr2 := baddress ( messag2 );
$endif$
vd.d_desc_type1    := DESC_TYPE;
vd.d_desc_type2    := DESC_TYPE;
flags              := [ F_VECTORED ];
 
{ send a non-vectored message to the local side                        }
 
messag1  := '40 four oh forty XL 40 four tens fortify';
ipcsend ( cd_remote, messag1, 40, , , result );
if result <> 0 then
   writeln ('ipcsend failed');
 
{ receive a message in a single vector                                 }
messag1 := '                                              ';      { 46 }
vd.d_desc_len1  := 46;              { max we are willing to receive    }
dlen            := DESC_LEN;
 
ipcrecv ( cd_remote, vd, dlen, flags, , result );
if result <> 0 then
   writeln ('ipcrecv data failed');
if dlen <> 1 then
   writeln ('dlen was not = 1');
 
{ Check that the correct data was received }
expect := '.';
error := false;
for i := 1 to dlen do
   if messag1[i] <> expect[i] then
      error := true;
if error then
   begin
   writeln ('did not receive expected single vector data, got:');
   writeln ( messag1 );
   end;
{ send a double vectored message to the local side                     }
messag1 := 'Abaracadabara  ';
messag2 := 'magic!';
vd.d_desc_len1     := 15;              { byte size of message          }
vd.d_desc_len2     :=  6;              { byte size of message          }
dlen := DESC_LEN * 2;                  { there are 2 descriptors       }
ipcsend ( cd_remote, vd, dlen, flags, , result );
if result <> 0 then
   writeln ('ipcsend failed');
 
{ do a dummy receive so that the other side can receive the last       }
{ message before disconnection                                         }
dlen := 1;
ipcrecv ( cd_remote, messag1, dlen );
 
{ sockets are released on process termination                          }
end.
Feedback to webmaster