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