|
|
|
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.
 |
NOTE: 3kRanger made changes marked by
comment {3k} to correct compile errors and simple enhancements. The PDF
manual contains the original code.
Example 2B had a hardcoded Nodename of
bigblue, you can see below.
The local Nodename is used.
|
Program 2A (Vector1)
Download
{NetIPC Example-2-Program2A}
{ pascalprep netipc2a, netipc2a.pub;info="set 'native=false'" }
{ MPEiX pasxllk netipc2a,netipc2x.pub,,,"set 'native=true'" }
$list off$
{********************************************************************}
{ 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' $} {3k}
$if 'native'$
$standard_level 'hp_modcal'$
$type_coercion 'conversion'$
$else$
$standard_level 'HP3000'$ {3k}
$uslinit$
$endif$
program vector1 ( input, output );
TYPE
byte = 0..255; { this is one byte long }
$if 'not native'$ {3k}
shortint = -32768..32767; { this is two bytes long }
$endif$ {3k}
CONST
$if 'native'$
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;
timeval_type = record case boolean of {3k}
true : (int : shortint); {3k}
false : (chars : packed array [1..30] of char); {3k}
end; {3k}
netipc_data_desc = packed record
{ This structure contains a maximum of two data descriptors. }
$if 'native'$
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 }
timeval : timeval_type; {3k}
procedure terminate; intrinsic;
{ NetIPC 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;
{===== error handling procedure =====} {3k}
{3k}
procedure leave ( result : integer; locat : integer ); {3k}
var {3k}
msg: string [80]; {3k}
i, len, newresult: integer; {3k}
begin {3k}
prompt ( '** ErrLoc ', locat:1, ': ' ); {3k}
ipcerrmsg ( result, msg, len, newresult ); {3k}
if newresult = 0 then begin {3k}
setstrlen (msg, len); {3k}
writeln (msg); {3k}
end else {3k}
writeln ( '** IpcErrMsg result is ', newresult:1 ); {3k}
terminate; {3k}
end; {3k}
{===== main of NetIPC Program 2A =====} {3k}
begin
writeln
('example program vector1 to show vectored data operation in ',
$if 'native'$
'Native Mode');
$else$
'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 begin {3k}
result := result16; {3k}
leave ( result, 1 ); {3k}
end; {3k}
{ add the option for specification of the socket's address }
addopt ( opt, 0, 128, 2, adrs, result16 );
if result16 <> 0 then begin {3k}
result := result16; {3k}
leave ( result, 2 ); {3k}
end; {3k}
{ 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 leave ( result, 3 ); {3k}
{wait for a connection request} {3k}
timeval.int:=300; { tenths } {3k}
ipccontrol ( sd_local, 3, timeval.chars, 2, , , result ); {3k}
if result <> 0 then leave ( result, 4 ); {3k}
{ Local side receives the connection }
writeln ( '-- Waiting for connect ', timeval.int:1, {3k}
' tenths on ', SOCK_ADDR:1, ' --' ); {3k}
ipcrecvcn ( sd_local, cd_local, , , result );
if result <> 0 then leave ( result, 5 ); {3k}
writeln ( '-- Connected --' ); {3k}
{ set up vectors, ready for sending and receiving data }
$if 'native'$
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 }
writeln ( '--- WaitRecv dlen=', dlen:1, ' --' ); {3k}
ipcrecv ( cd_local, vd, dlen, flags, , result );
if result <> 0 then leave ( result, 6 ); {3k}
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;
writeln ( '=== ', messag1:27 ); {3k}
{ 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;
writeln ( '=== ', messag2: dlen-27 ); {3k}
{ 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;
writeln ( '--- Send dlen=', dlen:1, ' --' ); {3k}
ipcsend ( cd_local, vd, dlen, flags, , result );
if result <> 0 then leave ( result, 7 ); {3k}
{ do a regular receive of the double vectored send }
messag1 := ' ';{ 46 }
dlen := 46; { max amount of data to receive }
writeln ( '--- WaitRecv dlen=', dlen:1, ' --' ); {3k}
ipcrecv ( cd_local, messag1, dlen, , , result );
if result <> 0 then leave ( result, 8 ); {3k}
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;
writeln ( '===', messag1:dlen ); {3k}
{ Clean up and shutdown }
{ shutdown the local connection descriptor }
ipcshutdown ( cd_local, , , result );
if result <> 0 then leave ( result, 9 ); {3k}
{ shutdown the local socket descriptor }
ipcshutdown ( sd_local, , , result );
if result <> 0 then leave ( result, 10 ); {3k}
end.
Program 2B (Vector2)
{NetIPC Example-2-Program2B}
{ pascalprep netipc2b,netipc2b.pub ;info="set 'native=false'" }
{ MPEiX pasxllk netipc2b,netipc2y.pub,,,"set 'native=true'" }
$list off$
{********************************************************************}
{ 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 = false'$ {3k}
$if 'native'$
$standard_level 'hp_modcal'$
$type_coercion 'conversion'$
$else$
$standard_level 'HP3000'$ {3k}
$uslinit$
$endif$
program vector2 ( input, output );
TYPE
byte = 0..255; { this is one byte long }
$if 'not native'$ {3k}
shortint = -32768..32767; { this is two bytes long }
$endif$ {3k}
CONST
$if 'native'$
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 }
maxloc = 52; {3k}
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'$
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 }
procedure terminate; intrinsic;
{ NetIPC 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;
{===== error handling procedure =====} {3k}
{3k}
procedure leave ( result : integer; locat : integer ); {3k}
var {3k}
msg: string [80]; {3k}
i, len, newresult: integer; {3k}
begin {3k}
prompt ( '** ErrLoc ', locat:1, ': ' ); {3k}
ipcerrmsg ( result, msg, len, newresult ); {3k}
if newresult = 0 then begin {3k}
setstrlen (msg, len); {3k}
writeln (msg); {3k}
end else {3k}
writeln ( '** IpcErrMsg result is ', newresult:1 ); {3k}
terminate; {3k}
end; {3k}
{===== main of NetIPC Program 2B =====} {3k}
begin
writeln
('example program vector2 to show vectored data operation in ',
$if 'native'$
'Native Mode');
$else$
'Compatibility Mode');
$endif$
{ create the remote socket normally }
ipccreate ( 3, 4, , , sd_remote, result );
if result <> 0 then leave ( result, 1 ); {3k}
location := 'bigblue';
{=== get local/current nodename ===} {3k}
i := maxloc; {3k}
ipccontrol ( sd_remote, 14,,, location, i,, result ); {3k}
if result <> 0 then leave ( result, 2 ); {3k}
location [i+1] := ' '; {3k}
writeln ( '--Node: ', location:i, ' --' ); {3k}
{=== get nodename ===}
{ 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 }
ipcdest ( 3, location, i, 4, adrs, 2,,, dd, result );
if result <> 0 then leave ( result, 2 ); {3k}
{ Connect to the local socket using the destination descriptor. }
ipcconnect ( sd_remote, dd, , , cd_remote, result );
if result <> 0 then leave ( result, 3 ); {3k}
{ remote side does a receive to complete the connection }
ipcrecv ( cd_remote, , , , , result );
if result <> 0 then leave ( result, 4 ); {3k}
{ set up vectors ready for sending and receiving data }
$if 'native'$
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 leave ( result, 5 ); {3k}
{ 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 leave ( result, 6 ); {3k}
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 leave ( result, 7 ); {3k}
{ do a dummy receive so that the other side can receive the last }
{ message before disconnection }
dlen := 1;
ipcrecv ( cd_remote, messag1, dlen,,, result ); {3k}
if result = 64 then {3k}
ipcshutdown ( cd_remote ) {3k}
else {3k}
leave ( result, 8 ); {3k}
{ sockets are released on process termination }
end.
3kRanger Runtime Example
Two sessions on the same machine. 2A should be run before 2B.
Fox 25:netipc2a.pub
example program vector1 to show vectored data operation in Compatibility Mode
-- Waiting for connect 300 tenths on 32000 --
-- Connected --
--- WaitRecv dlen=16 --
=== 40 four oh forty XL 40 four
=== tens fortify
--- Send dlen=8 --
--- WaitRecv dlen=46 --
===Abaracadabara magic!
Fox 25:
Fox 9:netipc2b.pub
example program vector2 to show vectored data operation in Compatibility Mode
--Node: FOX.TKRANGER.COM --
Fox 9:
|
