 |
» |
|
|
|
$standard_level 'ext_modcal'$
{-----------------------------------------------------------------------
program ASYNC1
------------------------------------------------------------------------
PURPOSE:
This is a simple program to illustrate the use of asynchronous ports.
1. Call GETPRIVMODE to gain user privilege level 2.
2. Create and open an asynchronous port using AIFPORTOPEN.
3. Create and open a synchronous port using AIFPORTOPEN.
4. Send message with AIFPORTSEND to notify the other process the
asynchronous port exists.
5. Pause to wait for a message.
6. The other program will send multiple messages to the asynchronous
port which will cause the interrupt handler to run.
7. Use AIFPORTINT to disable/enable interrupts in the handler.
8. Call AIFPORTRECEIVE to receive the message in the handler.
9. Use AIFPORTCLOSE and close each port.
10. Call GETUSERMODE.
PARAMETERS: None.
------------------------------------------------------------------------}
program ASYNC1 (input,output);
type
status_type = record
case boolean of
true : (all : integer);
false : (info : shortint;
subsys : shortint);
end;
bit32 = packed array [1..32] of boolean;
item_array_type = array [1..5] of globalanyptr;
itemnum_array_type = array [1..5] of integer;
item_status_array_type = array [1..5] of status_type;
message_buffer_type = packed array [1..80] of char;
name_type = packed array [1..16] of char;
|
{-----------------------------------------------------------------------
declare structured constants to initialize arrays used in various
AIF procedure calls
-----------------------------------------------------------------------}
const
Init_Item_Array = item_array_type
[5 of nil];
Init_Itemnum_Array = itemnum_array_type
[5 of 0];
Init_Item_Status_Array = item_status_array_type
[5 of status_type
[info : 0,
subsys : 0]];
var
accessmode : integer;
createoptions : integer;
createhandler : bit32;
createstate : boolean;
envelope_code : 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;
newstates : array [1..2] of boolean;
overall_status : status_type;
portid1 : integer;
portid2 : integer;
portlist : array [1..2] of integer;
oldstates : array [1..2] of integer;
portname : name_type;
portpass : name_type;
proc_name : packed array [1..13] of char;
proc_file : packed array [1..8] of char;
user_id : integer;
timeoutseconds : integer;
|
procedure GETPRIVMODE; intrinsic;
procedure GETUSERMODE; intrinsic;
procedure HPGETPROCPLABEL; intrinsic;
procedure PAUSE; intrinsic;
procedure QUIT; intrinsic;
$sysintr 'aifintr'$
procedure AIFPORTCLOSE; intrinsic;
procedure AIFPORTINT; 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 }
|
{-----------------------------------------------------------------------
procedure PORTHANDLER
------------------------------------------------------------------------
PURPOSE:
This procedure is the handler for the asynchronous port. It
illustrates the use of AIFPORTINT to disable port interrupts.
It will use AIFPORTRECEIVE to get the message. It will reissue
the AIFPORTRECEIVE to check if messages with pending interrupts
have arrived. AIFPORTINT will enable port interrupts before
exiting the handler.
PARAMETERS:
portid - contains the portid of the port with the incoming message
this is a required parameter
-----------------------------------------------------------------------}
procedure PORTHANDLER ( portid : integer);
var
env_code : integer;
hand_status : status_type;
index : integer;
item_porth : item_array_type;
item_status_porth : item_status_array_type;
itemnum_porth : itemnum_array_type;
msg_buf : message_buffer_type;
msg_id : integer;
msg_len : integer;
newstates : array[1..2] of boolean;
oldstates : array[1..2] of boolean;
pending : boolean;
portlist : array[1..2] of integer;
timeout : integer;
begin { PORTHANDLER }
|
{-----------------------------------------------------------------------
7. AIFPORTINT is setup to disable interrupt handling on the current port.
This is done when an application is accessing global data or has a
critical section of code to protect.
It is not necessary to call AIFPORTINT inside a handler. If new messages
arrive, the interrupt handlers will nest. It is recommended the
processing done in the handler be kept at a minimum.
-----------------------------------------------------------------------}
hand_status.all := 0;
newstates[1] := False;
portlist[1] := portid;
portlist[2] := 0;
AIFPORTINT ( hand_status,
portlist,
newstates,
oldstates);
if hand_status.all <> 0 then
writeln ('AIFPORTINT 1 - Bad Status: info =',hand_status.info,
' subsys =', hand_status.subsys)
else
if oldstates[1] then
writeln('AIFPORTINT 1 (handler) - Previous state of port is ENABLED.')
else
writeln('AIFPORTINT 1 (handler) - Previous state of port is DISABLED.');
|
{-----------------------------------------------------------------------
8. AIFPORTRECEIVE is called to get the original message which caused
the handler to be invoked. Variables should be initialized before
the AIFPORTRECEIVE call.
-----------------------------------------------------------------------}
msg_len := 80;
env_code := 0;
msg_id := 0;
msg_buf := ' ';
itemnum_porth := Init_Itemnum_Array; { zero array }
item_porth := Init_Item_Array;
item_status_porth := Init_Item_Status_Array;
timeout := -1; { nowait receive }
itemnum_porth[1] := 11002; { next element initialized to 0 }
item_porth[1] := addr(timeout);
AIFPORTRECEIVE ( hand_status,
portid,
msg_buf,
msg_len,
env_code,
msg_id,
itemnum_porth,
item_porth,
item_status_porth);
if hand_status.all <> 0 then
begin
writeln ('AIFPORTRECEIVE - Bad Status: info=' ,
hand_status.info, ' subsys =', hand_status.subsys);
if hand_status.info > 0 then
for index := 1 to hand_status.info do
writeln ('Index: ',index,' info =',item_status_porth[index].info,
' subsys =',item_status_porth[index].subsys);
end
else
writeln('AIFPORTRECEIVE (complete) - ' , msg_buf );
|
{-----------------------------------------------------------------------
The AIFPORTRECEIVE can be used to check if there are messages with
pending interrupts. If the message is successfully received the
pending interrupt will not occur when item 11007 is used.
-----------------------------------------------------------------------}
msg_len := 80;
env_code := 0;
msg_id := 0;
msg_buf := ' ';
itemnum_porth := Init_Itemnum_Array; { zero array }
item_porth := Init_Item_Array;
item_status_porth := Init_Item_Status_Array;
timeout := -1; { nowait receive }
itemnum_porth[1] := 11002;
item_porth[1] := addr(timeout);
pending := True;
itemnum_porth[2] := 11007; { next element initialized to 0 }
item_porth[2] := addr(pending);
while pending do
begin { while pending }
AIFPORTRECEIVE ( hand_status,
portid,
msg_buf,
msg_len,
env_code,
msg_id,
itemnum_porth,
item_porth,
item_status_porth);
if hand_status.all <> 0 then
begin
writeln ('AIFPORTRECEIVE - Bad Status: info=' ,
hand_status.info, ' subsys =', hand_status.subsys);
if hand_status.info > 0 then
for index := 1 to hand_status.info do
writeln ('Index: ',index,' info =',item_status_porth[index].info,
' subsys =',item_status_porth[index].subsys);
pending := False;
end
else
writeln('AIFPORTRECEIVE (pending) - ' , msg_buf );
end; { while pending }
|
{-----------------------------------------------------------------------
Call AIFPORTINT to enable/arm interrupt handling
-----------------------------------------------------------------------}
newstates[1] := oldstates[1];
AIFPORTINT ( hand_status,
portlist,
newstates,
oldstates);
if hand_status.all <> 0 then
writeln ('AIFPORTINT 2 - Bad Status: info =',hand_status.info,
' subsys =', hand_status.subsys)
else
if oldstates[1] then
writeln('AIFPORTINT 2 (handler) - Previous state of port is ENABLED.')
else
writeln('AIFPORTINT 2 (handler) - Previous state of port is DISABLED.');
end; { PORTHANDLER }
begin {ASYNC1}
{-----------------------------------------------------------------------
1. Call GETPRIVMODE to gain user privilege level 2
-----------------------------------------------------------------------}
GETPRIVMODE;
|
{-----------------------------------------------------------------------
2. Create and open an asynchronous port using AIFPORTOPEN.
-----------------------------------------------------------------------}
writeln('Enter a valid user id:');
readln(user_id);
portname := 'aifport1 ';
portpass := 'aifpass1 ';
accessmode := 1; { receive access }
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
createoptions := 2; { create new }
itemnum_ports [1] := 11201;
item_ports [1] := addr(createoptions);
maxmsgsize := 80; { message size }
itemnum_ports [2] := 11202;
item_ports [2] := addr(maxmsgsize);
proc_name := '#PORTHANDLER#';
proc_file := '#ASYNC1#';
HPGETPROCPLABEL (proc_name,
createhandler,
overall_status,
proc_file,
False);
if overall_status.all <> 0 then
ERROR_IN_CALL('HPGETPROCPLABEL',overall_status);
itemnum_ports [3] := 11206;
item_ports [3] := addr(createhandler); { handler address }
createstate := True;
itemnum_ports [4] := 11207; { next element initialized to 0 }
item_ports [4] := addr(createstate); { handler enabled }
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',overall_status,item_status_ports);
{-----------------------------------------------------------------------
3. Create and open a synchronous port using AIFPORTOPEN.
-----------------------------------------------------------------------}
portname := 'aifport2 ';
portpass := 'aifpass2 ';
accessmode := 2; { send access }
itemnum_ports [3] := 0; { terminate item list }
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);
|
{-----------------------------------------------------------------------
4. Send message with AIFPORTSEND to notify the other process the
asynchronous port exists. Once the asynchronous port exists the
other process can open the port. The asynchronous port creator
is the only receiver and must be the first opener.
-----------------------------------------------------------------------}
message_buffer := 'Asynchronous port open OK to send messages ';
message_length := 80;
itemnum_ports := Init_Itemnum_Array; { zero array }
item_ports := Init_Item_Array;
item_status_ports := Init_Item_Status_Array;
timeoutseconds := 0; { wait for other process to receive message }
item_ports[1] := ADDR(timeoutseconds);
itemnum_ports[1] := 11101; { next element initialized to 0 }
AIFPORTSEND (overall_status,
portid2,
message_buffer,
message_length,
,
,
itemnum_ports,
item_ports,
item_status_ports);
if overall_status.all <> 0 then
ERROR_IN_CALL('AIFPORTSEND',overall_status,item_status_ports);
{-----------------------------------------------------------------------
5. Pause to wait for a message. In a true application there would be
real processing taking place. Otherwise, a synchronous port should
be used if there is no work for the application to do.
6. The other program will send a message which will cause the interrupt
handler to run.
-----------------------------------------------------------------------}
interval := 60.0;
PAUSE (interval);
|
{-----------------------------------------------------------------------
9. 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);
{-----------------------------------------------------------------------
10. Call GETUSERMODE
-----------------------------------------------------------------------}
GETUSERMODE;
writeln ('ASYNC1 terminated')
end.
|
|
