Compaq ACMS for OpenVMS
Systems Interface Programming


Previous Contents Index

7.2 FORTRAN General-Purpose Agent Program

The FORTRAN program in Example 7-2 is a general-purpose agent program that handles all types of exchange I/O except stream I/O and Request Interface I/O.

Example 7-2 FORTRAN General-Purpose Agent Program

 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 

7.3 C Agent Program that Performs Stream I/O or No I/O

The C agent program in Example 7-3 submits tasks that perform stream I/O or no I/O. The agent program disables the use of DECforms and TDMS in exchange steps.

Example 7-3 C Agent Program that Performs Stream I/O or No I/O

/* 
 *  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); 
} 

7.4 BLISS Agent Program that Uses Superseded Services

Example 7-4 contains a BLISS agent program that uses superseded exchange I/O services and the method of constructing argument lists used in ACMS versions earlier than Version 3.1.

Note

Example 7-4 is provided for the convenience of programmers who need to maintain agent programs written for earlier versions of ACMS. Do not use the techniques shown in this example when developing new agent programs.

Example 7-4 BLISS Agent Program that Uses Superseded Services

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 


Previous Next Contents Index