{* ASYNC1 *}
$standard_level 'ext_modcal'$
$list off$
{-------------------------------------------------------------------
   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.pub.sys'$
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 recv 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.
