HP OpenVMS Systems Documentation

 PROGRAM fortran_agent
C
C   This agent program allows the user to select tasks of all exchange I/O
C   methods except stream I/O or I/O involving the ACMS Request Interface
C   (RI).
C
        IMPLICIT NONE
C
 INCLUDE 'SYS$LIBRARY:ACMSFOR (ACMS$SUBMITTER)/LIST'

        RECORD / ACMS$SUBMITTER_ID / submitter_id
        RECORD / ACMS$EXCHANGE_IO_ID / exchange_io_id
        RECORD / ACMS$PROCEDURE_ID / procedure_id
        RECORD / ACMS$CALL_ID / call_id


     INTEGER*4 status
 INTEGER*4 LIB$SYS_TRNLOG, LIB$GET_INPUT, LIB$PUT_OUTPUT
C
C Variable declarations for ACMS$SIGN_IN
C
 CHARACTER*10 terminal_name
 INTEGER*4 terminal_name_desc (2)

C
C Variable declarations for ACMS$GET_PROCEDURE_INFO
C
 LOGICAL select_task
 LOGICAL need_task_info
C
 INTEGER*4 io_method
 CHARACTER*31 application_name
 CHARACTER*31 task_name
 INTEGER*4 task_name_desc (2)
 INTEGER*4 task_name_len

C
 INTEGER*2 task_info_list (14)
     EQUIVALENCE ( task_info_list (1), itm_io_bufsize )
     INTEGER*2 itm_io_bufsize
     EQUIVALENCE ( task_info_list (2), itm_io_itmcode )
     INTEGER*2 itm_io_itmcode
     EQUIVALENCE ( task_info_list (3), itm_io_bufadr )
     INTEGER*4 itm_io_bufadr
     EQUIVALENCE ( task_info_list (5), itm_io_retlen )
     INTEGER*4 itm_io_retlen

C
     EQUIVALENCE ( task_info_list (7), itm_proc_bufsize )
     INTEGER*2 itm_proc_bufsize
     EQUIVALENCE ( task_info_list (8), itm_proc_itmcode )
     INTEGER*2 itm_proc_itmcode
     EQUIVALENCE ( task_info_list (9), itm_proc_bufadr )
     INTEGER*4 itm_proc_bufadr
     EQUIVALENCE ( task_info_list (11), itm_proc_retlen )
     INTEGER*4 itm_proc_retlen
C
     EQUIVALENCE ( task_info_list (13), itm_last )
     INTEGER*4 itm_last


C
C Variable declarations for ACMS$START_CALL
C
 INTEGER*4 argument_list (4)

 CHARACTER*255 selection_string
 CHARACTER*80 status_string
     INTEGER*4 selection_string_desc (2)
     INTEGER*4 status_string_desc (2)


C***************************************************************************

C
C Sign in to ACMS, including terminal so that tasks ACMS can authenticate
C the terminal and the submitter can select tasks that use the terminal.
C
 status = LIB$SYS_TRNLOG ('TT', , terminal_name)
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL (%VAL (status) )
 END IF


 status = ACMS$SIGN_IN (  submitter_id,
 1                        ,
 2    terminal_name )

 IF (.NOT. status) THEN
     CALL LIB$SIGNAL (%VAL (status) )
 END IF


C
C Initialize the submitter to do exchange I/O on behalf of the tasks that it
C selects.  This submitter is written to do any kind of exchange I/O except
C stream I/O or I/O involving the ACMS Request Interface (RI).
C
        status = ACMS$INIT_EXCHANGE_IO ( submitter_id, exchange_io_id )
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL (%VAL (status) )
 END IF

C
C Construct the item list to get information about the task
C
     itm_io_bufsize = 4
     itm_io_itmcode = ACMS$K_PROC_IO_METHOD
     itm_io_bufadr = %LOC (io_method )
     itm_io_retlen = 0


     itm_proc_bufsize = ACMS$S_PROCEDURE_ID
     itm_proc_itmcode = ACMS$K_PROC_PROCEDURE_ID
     itm_proc_bufadr = %LOC ( procedure_id )
     itm_proc_retlen = 0
C
     itm_last = 0
C
C Loop for task selections, until user types EXIT instead of application name
C
 select_task = .TRUE.
 DO WHILE (select_task)

C
C Loop until we get a good application/task name.
C
     need_task_info = .TRUE.
     DO WHILE (need_task_info)

C
C Ask for application name and task name.
C
 status = LIB$GET_INPUT (application_name, 'Application name: ')
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL ( %VAL (status) )
 ELSE
     IF (application_name .EQ. 'EXIT') THEN
  select_task = .FALSE.
         GO TO 2000
     END IF
 END IF

 status = LIB$GET_INPUT (task_name, 'Task name: ', task_name_len)
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL ( %VAL (status) )
 END IF

 task_name_desc (1) = task_name_len
 task_name_desc (2) = %LOC (task_name)
C
C Get the procedure ID for the task.
C If we have a good application/task name, continue.  Otherwise,
C print error message and try again.
C

 status = ACMS$GET_PROCEDURE_INFO ( submitter_id,
1                                          task_name_desc,
    2               application_name,
    3                                          task_info_list )
 IF (.NOT. status) THEN
         CALL LIB$SIGNAL (%VAL( status ) )
 ELSE
     need_task_info = .FALSE.
 END IF
        END DO

C
C Get the selection string, if any.
C
        status = LIB$GET_INPUT (selection_string, 'Selection string: ')
         IF (.NOT. status) THEN
             CALL LIB$SIGNAL (%VAL (status) )
        END IF

C
C Set up argument list for the task.
C
C   - Selection string descriptor
C   - Extended status descriptor
C   - Exchange I/O ID
C
            argument_list (1) = 3

        selection_string_desc (1)= LEN (selection_string)
    selection_string_desc (2)= %LOC (selection_string)
    argument_list (2) = %LOC (selection_string_desc)
C
        status_string_desc (1) = LEN (status_string)
    status_string_desc (2) = %LOC (status_string)
    argument_list (3) = %LOC (status_string_desc)
C
            argument_list (4) = %LOC (exchange_io_id)

C
C Now start the task.
C
     status = ACMS$START_CALL ( submitter_id,
     1          procedure_id,
     2          call_id,
     3      argument_list )
     IF (.NOT. status) THEN
      CALL LIB$SIGNAL (%VAL (status) )
     END IF

C
C Wait for task to complete.
C
    status = ACMS$WAIT_FOR_CALL_END (submitter_id,
    1      call_id)
    IF (.NOT. status) THEN
      CALL LIB$SIGNAL (%VAL (status) )
    END IF

C Display final status for task.
C
 IF ((status_string .NE. ' ') .AND.
 1   (status_string .NE. 'Task completed normally')) THEN
     CALL LIB$PUT_OUTPUT (status_string)
 END IF

C
C We come here when the user wishes to exit the agent program.
C
2000 END DO


C
C Sign the submitter out.
C
     status = ACMS$SIGN_OUT ( submitter_id )
  IF (.NOT. status) THEN
     CALL LIB$SIGNAL (%VAL (status) )
  END IF
C
END

/*
 *  This agent program is a special-case agent that only handles tasks
 *  that do stream I/O in exchange steps.
 */


/** include descriptor declarations **/
#include "sys$library:descrip.h"


/** include ACMS definition files (from sys$library:acmscc.tlb) **/
#include acms$submitter
#include acms$stream


#define SUCCESS 1
#define TRUE 1
#define FALSE 0
#define NULL 0

/** define structure for item list **/
struct item {
    short int bufsize;
    short int itmcode;
    char *bufadr;
    int retlen;
};


main()
{

/*
 *      External routines
 */
int LIB$GET_INPUT();
int LIB$PUT_OUTPUT();

/*
 *      Variables for ACMS IDs
 */
struct ACMS$SUBMITTER_ID submitter_id;
struct ACMS$EXCHANGE_IO_ID exchange_io_id;
struct ACMS$CONNECT_ID connect_id;
struct ACMS$PROCEDURE_ID procedure_id;
struct ACMS$IO_ID io_id;


/*
 *      Variables for ACMS$INIT_EXCHANGE_IO
 */
struct item init_exch_io_list[2] =
    { ACMS$S_CONNECT_ID, ACMS$K_CONNECT_ID, &connect_id, 0,
      0, 0 };   /* zero the last longword (2 words) for list termination */
int io_enable_flags;


/*
 *      Variable declarations for ACMS$GET_PROCEDURE_INFO
 */
int io_method;

char task_name_string[39], appl_name_string[255];
$DESCRIPTOR(task_name_desc,task_name_string);
$DESCRIPTOR (appl_name_desc,appl_name_string);
$DESCRIPTOR (appl_prompt_desc,"Application name: ");
$DESCRIPTOR (task_prompt_desc,"Task name: ");


/*
 *     Item list structure to be used in ACMS$GET_PROCEDURE_INFO
 *
 * There are 2 elements specified in this item list:
 *  1) 4 bytes of data for ACMS$K_PROC_IO_METHOD, to be
 *     returned in variable io_method.
 *  2) 8 bytes data for ACMS$K_PROC_PROCEDURE_ID, to be
 *     returned in variable procedure_id.
 *  (This code omits the return length variable address, which
 *   could be specified to receive the actual length of data
 *   returned for each item.)
 *  Other possible items include:
 *   - ACMS$K_PROC_WORKSPACE_COUNT to receive count of TASK ARGUMENTS
 *        which the task could accept from the agent program
 *   - ACMS$K_PROC_WAIT_DELAY_ACTION to receive the wait/delay
 *        action specified in the task definition
 */


struct item task_info_list[3] =
    { 4, ACMS$K_PROC_IO_METHOD, &io_method, 0,
      ACMS$S_PROCEDURE_ID, ACMS$K_PROC_PROCEDURE_ID, &procedure_id, 0,
      0, 0 };   /* zero the last longword (2 words) for list termination */

/*
 * Variable declarations for ACMS$START_CALL
 */

struct ACMS$CALL_ID call_id;
int argument_list[4];
char selection_string[255], status_string[80];
$DESCRIPTOR(selection_string_desc,selection_string);
$DESCRIPTOR(status_string_desc,status_string);


/*
 * Variable declarations for ACMS$WAIT_FOR_STREAM_IO
 */
globalvalue int ACMS$_SENDER_DISCONN;
int sender_disconn;
short int processing_io;
char *input_string_addr, *output_string_addr;


/*
 *      Miscellaneous variables
 */
int status;
short int i, all_spaces;

/**************************************************************/


/*
 * Sign in to ACMS, no terminal IO, only stream IO
 */
    status = ACMS$SIGN_IN (&submitter_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

/*
 *      Set up the agent program to do only stream I/O in exchange steps.
 */
    io_enable_flags = ACMS$M_IO_DISABLE_TDMS + ACMS$M_IO_DISABLE_DECFORMS;

    status = ACMS$INIT_EXCHANGE_IO ( &submitter_id,
                                     &exchange_io_id,
                                     &io_enable_flags,
                                     &init_exch_io_list );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


/*
 * Get the procedure ID for the task
 *  - prompt the user for the task name
 *  - prompt the user for application logical name
 *    (These strings should be entered in upper case
 *     or converted to upper case.)
 *  - then call ACMS$GET_PROCEDURE_INFO
 */
    status = LIB$GET_INPUT ( &task_name_desc, &task_prompt_desc );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


    status = LIB$GET_INPUT ( &appl_name_desc, &appl_prompt_desc );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

    status = ACMS$GET_PROCEDURE_INFO (&submitter_id,
           &task_name_desc,
           &appl_name_desc,
           task_info_list);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


/*
 * Set up the argument list for the task
 */
    argument_list[0] = 3;
    argument_list[1] = &selection_string_desc;
    argument_list[2] = &status_string_desc;
    argument_list[3] = &exchange_io_id;

/*
 *  Now start the task.  This agent program does not supply TASK
 *  ARGUMENTS. If TASK ARGUMENTS were used, they would require
 *  the task_info_list structure to be expanded to include the item
 *  ACMS$K_PROC_WORKSPACE_COUNT, which returns the number of TASK
 *  ARGUMENTS (if any) declared in the task definition.  This agent
 *  program would then build descriptors pointing to C variables
 *  corresponding to the number of arguments to be supplied.  Then
 *  argument_list[4] would be supplied the address of the
 *  first argument descriptor, argument_list[5] the address of the
 *  second argument descriptor.  argument_list[0] would be amended to
 *  reflect the total argument count = 3 + NUMBER_OF_TASK_ARGUMENTS
 *  supplied to the task by the agent program.
 */


    status = ACMS$START_CALL (&submitter_id,
             &procedure_id,
             &call_id,
             argument_list);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

/*
 *  This agent program handles only tasks that do no exchange I/O and
 *  tasks that do stream I/O.  If it is a NO I/O task, skip the stream
 *  processing.
 */
    if (io_method == ACMS$K_IO_NONE)
        processing_io = FALSE;
    else
        {
        processing_io = TRUE;
        sender_disconn = ACMS$_SENDER_DISCONN;
        }


/*
 *      Process the stream task with the following algorithm:
 *
 *          - wait for notification to begin the I/O (WAIT_FOR_STREAM_IO
 *              completes)
 *          - do the I/O
 *          - reply that the I/O is finished (REPLY_TO_STREAM_IO)
 *          - wait for more notification - if there is no more I/O, the
 *              sender will disconnect and we will be finished
 */


    while (processing_io)
    {
     status = ACMS$WAIT_FOR_STREAM_IO (&connect_id,
          &output_string_addr,
          &input_string_addr,
          &io_id);
     if ((status & 1) != SUCCESS)
     {
            processing_io = FALSE;
            if (status != sender_disconn)
                LIB$SIGNAL (status);
     }
     else

        {
            /*
             *      We have been notified to do the I/O - do it
             */
            if ((output_string_addr != NULL) && (input_string_addr == NULL))
            {
                status = LIB$PUT_OUTPUT (output_string_addr);

     if ((status & 1) != SUCCESS) LIB$SIGNAL (status);
            }

            if (input_string_addr != NULL)
            {
                if (output_string_addr == NULL)
    status = LIB$GET_INPUT (input_string_addr);
   else
    status = LIB$GET_INPUT (input_string_addr,
       output_string_addr);
   if ((status & 1) != SUCCESS) LIB$SIGNAL (status);
            }


            /*
             *      Tell the application that we are done with
             *      the I/O
             */
            status = ACMS$REPLY_TO_STREAM_IO (&connect_id,
               &io_id);
            if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

        }   /* end of successful WAIT_FOR_STREAM_IO */

    } /*  end while loop  */

/*
 * Wait for the task to complete
 */
    status = ACMS$WAIT_FOR_CALL_END (&submitter_id, &call_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

/*
 *      Terminate the exchange I/O for the submitter
 */
    status = ACMS$TERM_EXCHANGE_IO (&exchange_io_id);


/*
 * Sign the submitter out
 */
    status = ACMS$SIGN_OUT (&submitter_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


/*
 * Display the final status
 */
    all_spaces = TRUE;
    for (i = 0; (i < 80) && (status_string[i] != NULL) && all_spaces; i++)
     if (status_string[i] != ' ')
      all_spaces = FALSE;

    if (!all_spaces)
     LIB$PUT_OUTPUT (status_string);
}

MODULE bliss_agent (IDENT = 'V2.1-000',
         MAIN = agent_main,
         ADDRESSING_MODE (EXTERNAL=GENERAL,
     NONEXTERNAL=LONG_RELATIVE)) =
BEGIN


!
! External References
!
EXTERNAL ROUTINE
    LIB$SYS_TRNLOG,
    LIB$GET_EF,
    LIB$FREE_EF,
    LIB$GET_INPUT,
    LIB$PUT_OUTPUT,
    STR$UPCASE;
EXTERNAL LITERAL
    ACMS$_SENDER_DISCONN,
    ACMS$_NORMAL;


!
! Library Files
!
LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'SYS$LIBRARY:ACMSBLI';


ROUTINE agent_main =
!
!   Agent's main routine
!
BEGIN

    LOCAL
 status,
 sub_id:              ACMS$SUBMITTER_ID,

!
! Variable declarations for ACMS$GET_PROCEDURE_INFO_A
!
 task_name:           BLOCK [ DSC$K_D_BLN, BYTE],
 application_name:    BLOCK [ DSC$K_D_BLN, BYTE],
 io_method,
     task_info_list:      $ITMLST_DECL ( ITEMS = 2 ),
     have_task_info,

!
! Variable declarations for ACMS$START_CALL_A
!
 proc_id:              CMS$PROCEDURE_ID,
 task_id:                ACMS$CALL_ID,
     argument_list:        VECTOR [4,LONG],
     selection_string:   BLOCK [ DSC$K_D_BLN, BYTE],
     status_string:      BLOCK [ DSC$K_D_BLN, BYTE],
     terminal_name:  BLOCK [ DSC$K_D_BLN, BYTE],

!
! Variable declarations for Stream Services
!
        stream_id:           ACMS$STREAM_ID,
        connect_id:          ACMS$CONNECT_ID,
 io_id:       ACMS$IO_ID,
 output_string_addr:  REF BLOCK [4, BYTE],
 input_string_addr:   REF BLOCK [4, BYTE],
     processing_io,

!
! Variable declarations for asychronous service arguments
!
     comp_status_block:   VECTOR [ 2, LONG ],
     event_flag;

    LITERAL
        TRUE = 1 EQL 1,
        FALSE = 0 EQL 1;

    BIND
     comp_status = comp_status_block [ 0 ];

!
! Initialize dynamic string descriptors
!
    $INIT_DYNDESC ( task_name );
    $INIT_DYNDESC ( application_name );
    $INIT_DYNDESC ( selection_string );
    $INIT_DYNDESC ( status_string );
    $INIT_DYNDESC ( terminal_name );

    status = LIB$GET_EF ( event_flag );
    IF NOT .status THEN SIGNAL ( .status );

    status = LIB$SYS_TRNLOG ( %ASCID'TT', 0, terminal_name );
    IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );
!
!   Sign in to ACMS
!
    status = $ACMS$SIGN_IN_A (SUBMITTER_ID = sub_id,
             DEVICE = terminal_name,
             COMP_STATUS = comp_status,
             EFN = event_flag );
    IF NOT .status
    THEN
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
    END;

!
! Set up item list
!
    $ITMLST_INIT ( ITMLST = task_info_list,
         ( ITMCOD = ACMS$K_PROC_PROCEDURE_ID,
           BUFSIZ = ACMS$S_PROCEDURE_ID,
           BUFADR = proc_id ),

         ( ITMCOD = ACMS$K_PROC_IO_METHOD,
           BUFSIZ = %UPVAL,
           BUFADR = io_method ) );


    have_task_info = FALSE;
!
! Loop until we get a good application/task name
!

    DO
        BEGIN
    !
    ! Ask for application name and task name.
    ! Convert names to all caps for comparisons in ACMS.
    !
 status = LIB$GET_INPUT (application_name, %ASCID 'Application name: ');
 IF NOT .status THEN SIGNAL (.status);

        status = STR$UPCASE (application_name, application_name);
        IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );


 status = LIB$GET_INPUT (task_name, %ASCID 'Task name: ');
 IF NOT .status THEN SIGNAL (.status);

        status = STR$UPCASE (task_name, task_name);
        IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );


        !
        ! Ask ACMS if task is known and get its ID
        !
        status = $ACMS$GET_PROCEDURE_INFO_A ( SUBMITTER_ID = sub_id,
                                              PROCEDURE = task_name,
                                              PACKAGE = application_name,
                                              ITEM_LIST = task_info_list,
                  EFN = event_flag,
                  COMP_STATUS = comp_status );
     IF NOT .status
     THEN
         SIGNAL ( .status )

     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF .comp_status EQL ACMS$_NORMAL
         THEN
      have_task_info = TRUE
         ELSE
      SIGNAL ( .comp_status );
         END;
     END
    UNTIL .have_task_info;

!
! Get the selection string
!
    status = LIB$GET_INPUT (selection_string, %ASCID 'Selection string: ');
    IF NOT .status THEN SIGNAL (.status);

!
! If the I/O method is stream, then setup the stream
!
    IF .io_method EQL ACMS$K_IO_STREAM
    THEN
 BEGIN


 status = $ACMS$CREATE_STREAM_A (MODE = %REF(ACMS$K_STRM_BIDIRECTIONAL),
            STREAM_ID = stream_id,
             COMP_STATUS = comp_status,
             EFN = event_flag );
     IF NOT .status
     THEN
         SIGNAL (.status)
     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;

 status = $ACMS$CONNECT_STREAM_A (STREAM_ID = stream_id,
             CONNECT_ID = connect_id,
           MODE = %REF(ACMS$K_STRM_PASSIVE),
              COMP_STATUS = comp_status,
                EFN = event_flag );
     IF NOT .status
     THEN
         SIGNAL (.status)
     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;

 END;

!
! Set up argument list for task
!
    argument_list [1] = selection_string;
    argument_list [2] = status_string;

    SELECTONE .io_method OF
 SET
 [ACMS$K_IO_NONE]:
     argument_list [0] = 2;
 [ACMS$K_IO_TERMINAL,
  ACMS$K_IO_REQUEST]:
     BEGIN
     argument_list [0] = 3;
     argument_list [3] = terminal_name;
     END;
 [ACMS$K_IO_STREAM]:
     BEGIN
     argument_list [0] = 3;
     argument_list [3] = stream_id;
     END;
 [OTHERWISE]:
     SIGNAL (SS$_ABORT);
 TES;

!
! Now start the task
!
    status = $ACMS$START_CALL_A (SUBMITTER_ID = sub_id,
          PROCEDURE_ID = proc_id,
                               ARGUMENTS = argument_list,
                               CALL_ID = task_id,
              COMP_STATUS = comp_status,
              EFN = event_flag );


    IF NOT .status
    THEN
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;

!
! If the task I/O method is stream, process the stream I/O in the following
! loop
    IF .io_method EQL ACMS$K_IO_STREAM
    THEN
     BEGIN
     processing_io = TRUE;
     WHILE .processing_io DO

            BEGIN

     status = $ACMS$WAIT_FOR_STREAM_IO_A
              ( CONNECT_ID = connect_id,
                                 OUTPUT_OBJECT = output_string_addr,
                                 INPUT_OBJECT = input_string_addr,
     IO_ID = io_id,
                COMP_STATUS = comp_status,
               EFN = event_flag );
     IF NOT .status
         THEN
          SIGNAL (.status)
         ELSE
             BEGIN
             $WAITFR ( EFN = .event_flag );
             IF .comp_status EQL ACMS$_SENDER_DISCONN
         THEN
             processing_io = FALSE
             THEN
            SIGNAL ( .comp_status )
        ELSE
            BEGIN

        !
        ! See what kind of EXCHANGE was in the task defintion
        !
         IF .output_string_addr NEQ 0 AND .input_string_addr EQL 0
         THEN

!
! Exchange step was a WRITE
!
        BEGIN
    status = LIB$PUT_OUTPUT (.output_string_addr);
    IF NOT .status THEN SIGNAL (.status);
    END;

    IF .input_string_addr NEQ 0
    THEN
    IF .output_string_addr EQL 0
    THEN
        !
        ! Exchange step was a READ
        !
        BEGIN
        status = LIB$GET_INPUT (.input_string_addr);
        IF NOT .status THEN SIGNAL (.status);
        END


    ELSE
        !
        ! Exchange step was a READ WITH PROMPT
        !
        BEGIN
        status = LIB$GET_INPUT (.input_string_addr,
              .output_string_addr );
        IF NOT .status THEN SIGNAL (.status);
        END;

           !
           ! Reply to the I/O request
           !
              status = $ACMS$REPLY_TO_STREAM_IO_A
              (CONNECT_ID = connect_id,
           IO_ID = io_id,
                         EFN = event_flag );
           IF NOT .status
           THEN
               SIGNAL (.status)
            ELSE
            BEGIN
            $WAITFR ( EFN = .event_flag );
            IF NOT .comp_status THEN SIGNAL ( .comp_status );
            END;

           END;        ! End of successful wait_for_stream_io completion

              END;        ! End of successful wait_for_stream_io starting

             END;  ! End of stream processing loop

    END; ! End of stream task

!
!   Wait for task to complete
!
    status = $ACMS$WAIT_FOR_CALL_END_A (SUBMITTER_ID = sub_id,
                                        CALL_ID = task_id,
                       COMP_STATUS = comp_status,
                       EFN = event_flag );
    IF NOT .status
    THEN
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;

!
! If a stream was used, disconnect it and delete it
!
    IF .io_method EQL ACMS$K_IO_STREAM
    THEN
 BEGIN

 status = $ACMS$DISCONNECT_STREAM_A (CONNECT_ID = connect_id,
                           COMP_STATUS = comp_status,
                   EFN = event_flag );
        IF NOT .status
        THEN
         SIGNAL (.status)
        ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;


 status = $ACMS$DELETE_STREAM_A (STREAM_ID = stream_id,
         COMP_STATUS = comp_status,
         EFN = event_flag );
        IF NOT .status
        THEN
         SIGNAL (.status)
        ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;

 END;

    status = $ACMS$SIGN_OUT_A ( SUBMITTER_ID = sub_id,
        COMP_STATUS = comp_status,
        EFN = event_flag );
    IF NOT .status
    THEN
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;
!
! Display final status
!
    IF CH$NEQ (.status_string [DSC$W_LENGTH], .status_string [DSC$A_POINTER],
            1, UPLIT (' '), %C' ')
    THEN
 LIB$PUT_OUTPUT (status_string);

    status = LIB$FREE_EF ( event_flag );
    IF NOT .status THEN SIGNAL ( .status );

    RETURN SS$_NORMAL;

    END;

END ELUDOM