OpenTP1 Version 7 Programming Reference COBOL Language

[Contents][Index][Back][Next]

CBLDCRPC('POLLANYR') - Receive processing results in asynchronous mode

Format

PROCEDURE DIVISION specification

CALL  'CBLDCRPC'  USING  unique-name-1

DATA DIVISION specification

01  unique-name-1.
    02  data-name-A    PIC X(8) VALUE 'POLLANYR'.
    02  data-name-B    PIC X(5).
    02  FILLER        PIC X(3).
    02  data-name-C    PIC S9(9) COMP VALUE ZERO.
    02  data-name-D    PIC S9(9) COMP.
    02  data-name-E    PIC S9(9) COMP.
    02  data-name-F    PIC S9(9) COMP.

Description

CBLDCRPC('POLLANYR') receives the processing results of a service requested through an asynchronous-response-type RPC.

To receive a particular asynchronous response, specify 1 or 17 for data-name-C. If one of these values is specified, CBLDCRPC('POLLANYR') receives the response from an asynchronous-response-type RPC which has returned the descriptor specified by data-name-E.

To receive any asynchronous response, specify 0 or 16 for data-name-C. In this case, the value assigned to data-name-E is ignored. When CBLDCRPC('POLLANYR') with 0 or 16 specified for data-name-C normally ends, it returns the same value as the descriptor of the asynchronous response it has received.

CBLDCRPC('POLLANYR') returns in the following cases:

When CBLDCRPC('POLLANYR') terminate normally, a response is set to CBLDCRPC('CALL ') in asynchronous-response-type RPC.

The following items are described after the list of status codes. See each description for details on CBLDCRPC('POLLANYR').

(1) data-name-F of CBLDCRPC('POLLANYR')

(2) Timing when CBLDCRPC('POLLANYR') results in error

(3) Specification for the return of status code 00378

(4) Relationship between status codes and synchronization point processing

(5) When a response cannot be received by CBLDCRPC('POLLANYR')

(6) Notes on using CBLDCRPC('POLLANYR')

Data areas whose values are set in the UAP

data-name-A

Specify VALUE 'POLLANYR' for the request code indicating processing results are asynchronously received.

data-name-C

Specify one of the following:

0
The wait time is specified in seconds and CBLDCRPC('POLLANYR') will receive any asynchronous response.

1
The wait time is specified in seconds and CBLDCRPC('POLLANYR') will receive the response from an asynchronous-response-type RPC which returns the descriptor specified by data-name-E.

16
The wait time is specified in milliseconds and CBLDCRPC('POLLANYR') will receive any asynchronous response.

17
The wait time is specified in milliseconds and CBLDCRPC('POLLANYR') will receive the response from an asynchronous-response-type RPC which returns the descriptor specified by data-name-E.

data-name-E

Specify the descriptor which was returned when CBLDCRPC('CALL ') (2 specified for data-name-C) carried on an asynchronous-response-type RPC terminated normally. If 0 or 16 is specified for data-name-C, the value specified here is ignored.

data-name-F

Specify the wait time in seconds from the calling of CBLDCRPC('POLLANYR') to the return of a response. The specified wait time must be in the range from -1 to the maximum value which can be indicated by S9(9) COMP.

When CBLDCRPC('POLLANYR') receives an asynchronous response, the response waiting interval specified in the UAP is not referenced.

If 0 is specified here, 0 or 1 is specified for data-name-C, and no response is returned, then CBLDCRPC('POLLANYR') will immediately return with the status code 00307. If 16 or 17 is specified for data-name-C, the wait time will be 50 milliseconds.

When -1 is specified, CBLDCRPC('POLLANYR') continues to wait until a response is returned.

data-name-D

Specify 0.

Data areas whose values are returned from OpenTP1

data-name-B

A status code of 5 digits is returned.

data-name-D

The descriptor of the received asynchronous response is returned. This descriptor is returned when CBLDCRPC('POLLANYR') with 0 or 16 specified for data-name-C ends normally. If CBLDCRPC('POLLANYR') with 1 or 17 specified for data-name-C ends normally, 0 is set here.

Status codes

Status code Explanation
00000 Normal termination.
00321 The results of processing for the service requested with asynchronous response-type RPCs are received completely.
00322 The descriptor specified for data-name-E does not exist. This value is returned when 1 is specified for data-name-C.
00301 The value specified for the data-name is invalid. This error also occurs if the status code (data-name-A) is invalid.
00302 CBLDCRPC('OPEN ') was not called.
00304 The memory became insufficient.
00306 A network error occurred.
00307 CBLDCRPC('CALL ') encountered timeout.
An SPP to which the service request was addressed terminated abnormally before completion of the requested service.
00308 The input parameter length specified for data-name-G of CBLDCRPC('CALL ') exceeded the maximum.
00309 The returned response is longer than the area prepared by the client UAP.
00310 The service group name specified for data-name-F of CBLDCRPC('CALL ') is not defined.
00311 The service name specified for data-name-E of CBLDCRPC('CALL ') is not defined.
00312 The service group containing the service of which name is specified for data-name-E of CBLDCRPC('CALL ') is in shutdown state.
00313 The service specified for data-name-E of CBLDCRPC('CALL ') is being terminated.
00314 The UAP process of the service specified for data-name-E of CBLDCRPC('CALL ') is not active.
An SPP to which the service request was addressed terminated abnormally before completion of the requested service when -1 is specified for data-name-F.
00315 The OpenTP1 at the node containing the service specified for data-name-E of CBLDCRPC('CALL ') is not active. The cause may be one of the following: abnormal termination, being-suspended, being-terminated, or communication error.
00316 A system error occurred in the specified service for CBLDCRPC('CALL ').
00317 The memory became insufficient in the specified service for CBLDCRPC('CALL ').
00318 A system error occurred.
00319 The length of the response returned from the service function to the OpenTP1 is not in the range from 1 to DCRPC_MAX_MESSAGE_SIZE#.
00320 The OpenTP1 at the node to which the service request is addressed is being started.
00323 The memory became insufficient. If this status code is returned, the transaction branch cannot be committed.
00324 A system error occurred. If this status code is returned, the transaction branch cannot be committed.
00325 A system error occurred when the specified service was executed. If this status code is returned, the transaction branch cannot be committed.
00326 The returned response is too large to be stored in the area prepared by the client UAP. If this status code is returned, the transaction branch cannot be committed.
00327 The transaction attributes of multiple SPPs do not match in an environment where the inter-node load-balancing facility and the extended internode load-balancing facility are in use. This status code will be returned only when the service request is addressed to an SPP which uses the inter-node load-balancing facility and the extended internode load-balancing facility.
00328 The domain name of the service group name with domain qualification is invalid.
00329 When a service is requested with domain qualification, the port number of the domain-alternate schedule service is not found.
00356 The server that receives requests from the socket to which the service request is addressed cannot receive the service request.
00366 When the online tester was in use, a service was requested from a UAP in test mode to an SPP in nontest mode or from a UAP in nontest mode to an SPP in test mode.
00370 An SPP to which the service request is addressed is protected with the security facility. The UAP that requests the service by using CBLDCRPC('CALL ') has no access permission for the SPP.
00372 The transaction branch cannot be started since it exceeds the maximum number of transaction branches which can be activated concurrently.
The transaction branch cannot be started since it exceeds the maximum number of child transaction branches which can be activated from one transaction branch.
Transaction branching cannot start because the resource manager (RM) has encountered an error.
00378 The SPP that was asked to offer its service abnormally terminated before processing was completed. This status code will be returned only when 00000001 is assigned to the rpc_extend_function operand in the user service definition of the client UAP. If nothing or 00000000 is assigned to the rpc_extend_function operand, the status code 00307 or 00314 will be returned, instead of 00378.

#: If you used the rpc_max_message_size operand, the value of this data area is the value specified in the rpc_max_message_size operand and not the value of DCRPC_MAX_MESSAGE_SIZE (1 megabyte).

(1) data-name-C of CBLDCRPC('POLLANYR')

The monitoring time for receiving an asynchronous response is reset each time a response is returned. Therefore, when a specific asynchronous response received is designated (If 1 or 17 is specified for data-name-C), a response may be received even if the time specified for data-name-F has elapsed. Alternatively, CBLDCRPC('POLLANYR') may not return with an error, giving the status code 00307 even if the time specified for data-name-F has elapsed.

(2) Timing when CBLDCRPC('POLLANYR') results in error

The following explains the timing when an error is returned from the client UAP if the SPP to which the service request is addressed terminates abnormally.

If an SPP to execute a service terminates abnormally before completion of the processing, CBLDCRPC('POLLANYR') returns with an error, giving the status code 00307. If -1 is specified for data-name-F of CBLDCRPC('POLLANYR'), CBLDCRPC('POLLANYR') returns with an error, giving the status code 00314.

When CBLDCRPC('POLLANYR') results in error due to time monitoring for CBLDCRPC('POLLANYR')

In the following cases, CBLDCRPC('POLLANYR') returns with an error, giving the status code 00307, after the time specified for data-name-F of CBLDCRPC('POLLANYR') has elapsed:

(3) Specification for the return of status code 00378

You can use the status code 00378 instead of 00307 or 00314 to check whether the SPP that was asked to offer its service abnormally terminated before processing was completed. For this purpose, assign 00000001 to the rpc_extend_function operand in the user service definition. With this specification, the status code 00378 will return if the above error occurs. If nothing or 00000000 is assigned to the rpc_extend_function operand, the status code 00307 or 00314 will be returned, instead of 00378.

(4) Relationship between status codes and synchronization point processing

The relationship between status codes of CBLDCRPC('POLLANYR') and synchronization point processing (commitment and rollback) is explained below. The description applies to the service request which is a transactions, rather than service requests which are not transactions (including the case when 32 is added to the value of data-name-C of CBLDCRPC('CALL ')).

If commitment is performed even though CBLDCRPC('POLLANYR') returns with an error

The status code 00307 may be returned due to abnormal termination of the service program which the service request is addressed, a node error, or network error. However, when the client UAP is not a transaction, the SPP which the service request is addressed may terminate normally and database may be updated.

Status codes which require rollback processing

If CBLDCRPC('POLLANYR') called from a transaction returns with an error, some status codes always require rollback processing for the transaction (the server UAP enters in rollback_only state). In this case, rollback processing is always performed even if either of commitment or rollback processing is executed. The following status codes of CBLDCRPC('POLLANYR') always require rollback processing for the transaction:

00309

00311

00317

00319

(5) When a response cannot be received by CBLDCRPC('POLLANYR')

CBLDCRPC('POLLANYR') cannot receive a response if either of the following COBOL-UAP creation programs is called by the UAP requesting a service with an asynchronous response-type RPC.

  1. The receiving of asynchronous responses is rejected by CBLDCRPC('DISCARDF')
  2. Commitment or rollback processing is performed in the COBOL-UAP creation program for synchronization point processing when a service is requested from a transaction.

The response returned after the above COBOL-UAP creation program is called is discarded. Receive all required asynchronous responses by using CBLDCRPC('POLLANYR') before calling the above COBOL-UAP creation program when an asynchronous response-type RPC is used.

(6) Notes on using CBLDCRPC('POLLANYR')

  1. When CBLDCRPC('POLLANYR') is called with 0 specified for the wait time (0 specified for data-name-F), the response may not be received even if it arrives, due to the scheduling of the multi-thread environment. Note that the UAP may fall into an endless loop, which calls CBLDCRPC('POLLANYR') to receive all responses with 0 specified for the wait time.
  2. If CBLDCRPC('POLLANYR') without a specific descriptor identified returns with an error, the descriptor of the response involving the error cannot be identified. Specify 1 or 17 for data-name-C if you want to identify the descriptor when CBLDCRPC('POLLANYR') returns with an error.