 |
» |
|
|
|
$standard_level 'ext_modcal'$
{-----------------------------------------------------------------------
program ASYNC2
------------------------------------------------------------------------
PURPOSE:
This is a simple program to illustrate the use of asynchronous ports.
1. Call GETPRIVMODE to gain user privilege level 2
2. Open a synchronous port named 'aifport2' for receive access.
3. Call AIFPORTRECEIVE on 'aifport2' to wait for message to open
asynchronous port 'aifport1'.
4. After message arrives, AIFPORTOPEN the asynchronous port named
'aifport1' for send access.
5. Use AIFPORTSEND to send multiple messages to 'aifport1'.
6. Close the ports.
7. Call GETUSERMODE.
PARAMETERS: None.
------------------------------------------------------------------------}
program ASYNC2 (input,output);
type
status_type = record
case boolean of
true : (all : integer);
false : (info : shortint;
subsys : shortint);
end;
item_array_type = array [1..3] of globalanyptr;
itemnum_array_type = array [1..3] of integer;
item_status_array_type = array [1..3] of status_type;
name_type = packed array [1..16] of char;
message_buffer_type = packed array [1..80] of char;
|
{-----------------------------------------------------------------------
declare structured constants to initialize arrays used in various
AIF procedure calls
------------------------------------------------------------------------}
const
Init_Item_Array = item_array_type
[3 of nil];
Init_Itemnum_Array = itemnum_array_type
[3 of 0];
Init_Item_Status_Array = item_status_array_type
[3 of status_type
[info : 0,
subsys : 0]];
var
accessmode : integer;
base : integer;
count_string : string[6];
envelope_code : integer;
index : integer;
interval : real;
itemnum_ports : itemnum_array_type;
item_ports : item_array_type;
item_status_ports : item_status_array_type;
maxmsgsize : integer;
message_buffer : message_buffer_type;
message_id : integer;
message_length : integer;
message_string : string[40];
numchar : shortint;
overall_status : status_type;
portid1 : integer;
portid2 : integer;
portname : name_type;
portpass : name_type;
timeoutseconds : integer;
user_id : integer;
|
function ASCII : shortint; intrinsic;
procedure GETPRIVMODE; intrinsic;
procedure GETUSERMODE; intrinsic;
procedure PAUSE; intrinsic;
procedure QUIT; intrinsic;
$sysintr 'aifintr'$
procedure AIFPORTCLOSE; intrinsic;
function AIFPORTOPEN : integer; intrinsic;
procedure AIFPORTRECEIVE; intrinsic;
procedure AIFPORTSEND; intrinsic;
{-----------------------------------------------------------------------
procedure ERROR_IN_CALL
------------------------------------------------------------------------
PURPOSE:
This procedure will accept an intrinsic call name and status
variable. It will output a message naming the offending call
and status information and subsystem parameters. It will call
QUIT to terminate the calling program and child processes.
PARAMETERS:
name - name of erroring AIF or intrinsic call
status - status of call
item_status_array - array of status values for item list
-----------------------------------------------------------------------}
procedure ERROR_IN_CALL ( name : name_type;
status : status_type;
var item_status_array : item_status_array_type)
option extensible 2;
var
index : shortint;
quitnum : integer;
begin { ERROR_IN_CALL }
writeln ('Error in ',name);
writeln ('Overall status info =',status.info, ' subsys =',
status.subsys);
if status.info > 0 then
for index := 1 to status.info do
writeln ('Index: ',index,' info =',item_status_array[index].info,
' subsys =',item_status_array[index].subsys);
quitnum := 516;
QUIT (quitnum);
end; { ERROR_IN_CALL }
|
begin {ASYNC2 body}
{-----------------------------------------------------------------------
1. Call GETPRIVMODE to gain user privilege level 2
------------------------------------------------------------------------}
GETPRIVMODE;
{-----------------------------------------------------------------------
2. Open a synchronous port named 'aifport2' for receive access.
------------------------------------------------------------------------}
writeln ('Enter a valid user ID:');
readln(user_id);
portname := 'aifport2 ';
portpass := 'aifpass2 ';
accessmode := 1; { receive access }
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
maxmsgsize := 80; { message size }
itemnum_ports [1] := 11202; { next element initialized to 0 }
item_ports [1] := addr(maxmsgsize);
portid2 := AIFPORTOPEN(overall_status,
portname,
portpass,
accessmode,
user_id,
itemnum_ports,
item_ports,
item_status_ports);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTOPEN #2',overall_status,item_status_ports);
{-----------------------------------------------------------------------
3. Call AIFPORTRECEIVE on 'aifport2' to wait for message to open
asynchronous port 'aifport1'. Defaults to waited receive.
------------------------------------------------------------------------}
message_buffer := ' ';
message_length := 80;
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
AIFPORTRECEIVE ( overall_status,
portid2,
message_buffer,
message_length);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTRECEIVE',overall_status,item_status_ports);
writeln ('AIFPORTRECEIVE (complete) - ', message_buffer );
|
{-----------------------------------------------------------------------
4. After message arrives, AIFPORTOPEN the asynchronous port named
'aifport1' for send access.
------------------------------------------------------------------------}
portname := 'aifport1 ';
portpass := 'aifpass1 ';
accessmode := 2; { send access }
user_id := 555;
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
maxmsgsize := 80; { message size }
itemnum_ports [1] := 11202; { next element initialized to 0 }
item_ports [1] := addr(maxmsgsize);
portid1 := AIFPORTOPEN(overall_status,
portname,
portpass,
accessmode,
user_id,
itemnum_ports,
item_ports,
item_status_ports);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTOPEN #1',overall_status,item_status_ports);
for index := 1 to 32 do
begin { for repeat send messages }
message_buffer := '';
message_string := '';
base := 10;
numchar := ASCII(index,base,count_string);
SETSTRLEN(count_string,numchar);
message_string := 'AIFPORT1 send message # ' + count_string;
STRMOVE (STRLEN(message_string),message_string,1,message_buffer,1);
message_length := 40;
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
timeoutseconds := -1; { nowait send }
itemnum_ports[1] := 11101; { next element initialized to 0 }
item_ports[1] := ADDR(timeoutseconds);
AIFPORTSEND ( overall_status,
portid1,
message_buffer,
message_length,
,
,
itemnum_ports,
item_ports,
item_status_ports);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTSEND',overall_status);
end; { for repeat send messages }
{-----------------------------------------------------------------------
6. Close the ports.
-----------------------------------------------------------------------}
AIFPORTCLOSE ( portid2,
accessmode,
overall_status);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTCLOSE',overall_status);
AIFPORTCLOSE ( portid1,
accessmode,
overall_status);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTCLOSE #2',overall_status);
{-----------------------------------------------------------------------
7. Call GETUSERMODE
------------------------------------------------------------------------}
GETUSERMODE;
writeln ('ASYNC2 terminated')
end.
|
|
