SYIXAM1: PROC OPTIONS(MAIN, NOEXECOPS);
/******* SYIXSAM1 - RPC REQUEST APPLICATION - PL/1 - IMS ************/
/* */
/* TRANID: SYIXSAM1 */
/* PROGRAM: SYIXSAM1 */
/* PLAN NAME: n/a */
/* FILES: n/a */
/* TABLES: n/a */
/* */
/* The purpose of the program is to stress test the IMS Open Server*/
/* This program is can be invoked by isql. The first parameter is a*/
/* one byte character parm that is used to set up a dummy results*/
/* row. The second parameter is the number of rows to return. To */
/* execute, setup an RPC, SYIXSAM1 to invoke mainframe transaction */
/* SYIXSAM1. Remote_lu is the VTAM APPLID of the LU6.2 */
/* APPLID that IMS is known by if running implicit mode. Security */
/* is none, user id, or both. */
/* */
/* >isql -Usa -P -Sservername */
/* */
/* >exec sgw_addrpc SYIXSAM1,SYIXSAM1,remote_lu,security */
/* */
/* >go */
/* */
/* >exec SYIXSAM1 X, 100 */
/* */
/* >go */
/* */
/* This tran returns a 80 byte row containing the name of */
/* the client that initiated the RPC and a 71 byte pattern. */
/* */
/* Server Library calls: */
/* TDACCEPT accept request from client */
/* TDESCRIB describe a column */
/* TDGETREQ Get next RPC */
/* TDFREE free TDPROC structure */
/* TDINIT establish environment */
/* TDRCVPRM retrieve rpc parameter from client */
/* TDRESULT describe next communication */
/* TDSETPT set program type */
/* TDSNDDON send results-completion to client */
/* TDSNDMSG send message to client */
/* TDSNDROW send row to client */
/* TDTERM free all storage */
/* */
/********************************************************************/
DCL P_PCBTERM POINTER;
DCL P_ALTPCB POINTER;
DCL PLIXOPT CHAR(50) VAR INIT(‘NOSPIE,NOSTAE’)
STATIC EXTERNAL;
/*------------------------------------------------------------------*/
/* IMS TERMINAL PCB */
/*------------------------------------------------------------------*/
DCL 1 PCBTERM BASED(P_PCBTERM),
5 TERMNAME CHAR(8),
5 RESERVED BIT(16),
5 STATUS CHAR(2),
5 DATE FIXED(7),
5 TIME FIXED(7),
5 MSGCOUNT FIXED BIN(31),
5 MODNAME CHAR(8);
/********************************************************************/
%INCLUDE SYGWPLI;
/*------------------------------------------------------------------*/
/* SERVER LIB ROUTINES DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
SRRCMIT ENTRY OPTIONS(INTER ASSEMBLER),
TDACCEPT ENTRY OPTIONS(INTER ASSEMBLER),
TDESCRIB ENTRY OPTIONS(INTER ASSEMBLER),
TDFREE ENTRY OPTIONS(INTER ASSEMBLER),
TDGETREQ ENTRY OPTIONS(INTER ASSEMBLER),
TDINIT ENTRY OPTIONS(INTER ASSEMBLER),
TDRCVPRM ENTRY OPTIONS(INTER ASSEMBLER),
TDRESULT ENTRY OPTIONS(INTER ASSEMBLER),
TDSETPT ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDDON ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDMSG ENTRY OPTIONS(INTER ASSEMBLER),
TDSNDROW ENTRY OPTIONS(INTER ASSEMBLER),
TDTERM ENTRY OPTIONS(INTER ASSEMBLER);
/*------------------------------------------------------------------*/
/* AIB INTERFACE DECLARATIONS */
/*------------------------------------------------------------------*/
DCL AIBTDLI ENTRY OPTIONS(INTER ASSEMBLER);
DCL TWO FIXED BIN(31) INIT(2);
DCL APSB CHAR(4) INIT(‘APSB’);
DCL DPSB CHAR(4) INIT(‘DPSB’);
DCL
01 AIB,
5 AIBID CHAR(08),
5 AIBLEN FIXED BIN(31),
5 AIBSFUNC CHAR(08),
5 AIBRSNM1 CHAR(08),
5 FILLER1 CHAR(16),
5 AIBOALEN FIXED BIN(31),
5 AIBOAUSE FIXED BIN(31),
5 FILLER2 CHAR(12),
5 AIBRETRN FIXED BIN(31),
5 AIBREASN FIXED BIN(31),
5 FILLER3 CHAR(04),
5 AIBRSA1 POINTER,
5 FILLER4 CHAR(44);
DCL
01 PCB_ADDRESS BASED(AIBRSA1),
5 PCB1_PTR POINTER,
5 PCB2_PTR POINTER,
5 PCB3_PTR POINTER;
/*------------------------------------------------------------------*/
/* BUILT IN FUNCTIONS DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
ADDR BUILTIN,
NULL BUILTIN,
STG BUILTIN;
/*------------------------------------------------------------------*/
/* WORK AREAS */
/*------------------------------------------------------------------*/
DCL
01 GW_LIB_MISC_FIELDS,
05 GWL_SPA_PTR PTR,
05 GWL_PROC PTR,
05 GWL_INIT_HANDLE PTR,
05 GWL_RC FIXED BIN(31),
05 GWL_SEND_DONE FIXED BIN(31),
05 GWL_WAIT_OPTION FIXED BIN(31),
05 GWL_REQ_TYPE FIXED BIN(31),
05 GWL_PROG_TYPE CHAR(04) INIT(‘MPP ‘),
05 GWL_TRAN_NAME CHAR(30);
DCL CPIC_RC FIXED BIN(31) INIT(0);
DCL
01 SNA_FIELDS,
05 SNA_SUBC FIXED BIN(31),
05 SNA_CONNECTION_NAME CHAR(08) INIT(‘ ‘);
DCL
01 PARM_FIELDS,
05 PARM_PATTERN CHAR(01),
05 BANANA CHAR(06) INIT(‘BANANA’),
05 I FIXED BIN(31) INIT(1),
05 PARM_NR_ROWS FIXED BIN(31) INIT(1),
05 PARM_ID1 FIXED BIN(31) INIT(1),
05 PARM_ID2 FIXED BIN(31) INIT(2),
05 PARM_L FIXED BIN(31);
DCL WROW CHAR(80);
DCL
01 WROW_R DEFINED WROW,
05 WROW_LU CHAR(08),
05 WROW_FILL CHAR(01),
05 WROW_PATTERN (71) CHAR(01);
DCL
01 COUNTER_FIELDS,
05 CTR_COLUMN FIXED BIN(31) INIT(1),
05 CTR_ROWS FIXED BIN(31) INIT(0);
DCL
01 DESCRIBE_BIND_FIELDS,
05 DB_NULL_INDICATOR FIXED BIN(15) INIT(0);
DCL
01 WORK_FIELDS,
05 WRKLEN1 FIXED BIN(31),
05 WRKLEN2 FIXED BIN(31);
DCL SYSPRINT FILE EXTERNAL;
DCL 01 ERROR_MSG,
05 FILL_1 CHAR(01),
05 CALL_NAME CHAR(09),
05 FILL_2 CHAR(01),
05 CALL_MSG CHAR(20),
05 CALL_RC PIC ‘-ZZZ9’,
05 FILL_3 CHAR(01),
05 CALL_RC2 PIC ‘-ZZZ9’,
05 FILL_4 CHAR(01);
DCL
01 SWITCHES,
05 FALSE BIT(01) INIT(‘0’B),
05 TRUE BIT(01) INIT(‘1’B),
05 ALL_DONE BIT(01) INIT(‘0’B),
05 ALL_DONE_YES BIT(01) INIT(‘1’B),
05 MORE_MSGS BIT(01) INIT(‘1’B);
/*------------------------------------------------------------------*/
INITIALIZE_PROGRAM:
/*------------------------------------------------------------------*/
P_PCBTERM = NULL;
GWL_PROC = NULL;
GWL_SPA_PTR = NULL;
GWL_INIT_HANDLE = NULL;
GWL_RC = 0;
MORE_MSGS = TRUE;
/*------------------------------------------------------------------*/
/* ALLOCATE AIB for IMS LOG access */
/*------------------------------------------------------------------*/
AIBID = ‘DFSAIB ‘;
AIBRSNM1 = ‘SYIPSAM1’;
AIBLEN = STG(AIB);
CALL AIBTDLI (TWO, APSB, AIB);
IF AIBRETRN = 0 THEN
P_PCBTERM = PCB1_PTR;
ELSE
DO;
CALL_NAME = ‘APSB’;
CALL_MSG = ‘APSB CALL ERROR RC=’;
CALL_RC = AIBRETRN;
CALL_RC2 = AIBREASN;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
RETURN;
END;
/* ------------------------------------------------------------*/
/* establish gateway environment */
/* ------------------------------------------------------------*/
CALL TDINIT (P_PCBTERM, GWL_RC, GWL_INIT_HANDLE);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDINIT’;
CALL DISP_ERROR;
RETURN;
END;
/* ------------------------------------------------------------*/
/* set program type to EXPL */
/* ------------------------------------------------------------*/
GWL_PROG_TYPE = ‘EXPL’;
CALL TDSETPT (GWL_INIT_HANDLE, GWL_RC, GWL_PROG_TYPE,
GWL_SPA_PTR, TDS_NULL, TDS_NULL);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDSETPT’;
CALL DISP_ERROR;
RETURN;
END;
/* ------------------------------------------------------------*/
/* accept client request */
/* ------------------------------------------------------------*/
CALL TDACCEPT (GWL_PROC, GWL_RC, GWL_INIT_HANDLE,
SNA_CONNECTION_NAME,
SNA_SUBC);
IF GWL_RC ^= 0 THEN
DO;
MORE_MSGS = FALSE;
CALL_NAME = ‘TDACCEPT’;
CALL DISP_ERROR;
RETURN;
END;
DO WHILE(MORE_MSGS);
/*------------------------------------------------------------------*/
/* GET PATTERN TO SEND */
/*------------------------------------------------------------------*/
WRKLEN1 = STG(PARM_PATTERN);
CALL TDRCVPRM (GWL_PROC, GWL_RC, PARM_ID1,
PARM_PATTERN, TDSCHAR, WRKLEN1, PARM_L);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDRCVPRM’;
CALL DISP_ERROR;
END;
/*------------------------------------------------------------------*/
/* GET NUMBER OF ROWS TO SEND */
/*------------------------------------------------------------------*/
WRKLEN1 = STG(PARM_NR_ROWS);
CALL TDRCVPRM (GWL_PROC, GWL_RC,
PARM_ID2,
PARM_NR_ROWS, TDSINT4, WRKLEN1, PARM_L);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDRCVPRM2’;
CALL DISP_ERROR;
END;
IF PARM_NR_ROWS = 0 THEN
GO TO SEND_DONE;
SETUP_REPLY_COLUMN:
WRKLEN1 = 80;
WRKLEN2 = STG(BANANA);
CALL TDESCRIB (GWL_PROC, GWL_RC,
CTR_COLUMN,
TDSCHAR, WRKLEN1, WROW,
DB_NULL_INDICATOR, TDS_FALSE,
TDSCHAR, WRKLEN1, BANANA, WRKLEN2);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDESCRIB’;
CALL DISP_ERROR;
END;
WROW = ‘ ‘;
WROW_LU = ‘BANANA ‘;
DO I = 1 TO 71;
WROW_PATTERN (I) = PARM_PATTERN;
END;
/*------------------------------------------------------------------*/
SEND_REPLY_ROWS:
/*------------------------------------------------------------------*/
ALL_DONE = ‘0’B;
CTR_ROWS = 0;
DO WHILE(^ ALL_DONE);
CALL TDSNDROW (GWL_PROC, GWL_RC);
IF GWL_RC = TDS_CANCEL_RECEIVED THEN
ALL_DONE = ALL_DONE_YES;
ELSE
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDSNDROW’;
CALL DISP_ERROR;
END;
ELSE
CTR_ROWS = CTR_ROWS + 1;
IF CTR_ROWS >= PARM_NR_ROWS THEN
ALL_DONE = ALL_DONE_YES;
END;
/*-----------------------------------------------------------------*/
SEND_DONE:
/*-----------------------------------------------------------------*/
IF GWL_RC = TDS_CANCEL_RECEIVED THEN
DO;
MORE_MSGS = FALSE;
GWL_SEND_DONE = TDS_ENDRPC;
END;
ELSE
IF PARM_NR_ROWS = 0 THEN
DO;
MORE_MSGS = FALSE;
GWL_SEND_DONE = TDS_ENDRPC;
END;
ELSE
GWL_SEND_DONE = TDS_ENDREPLY;
CALL TDSNDDON (GWL_PROC, GWL_RC,
TDS_DONE_COUNT,
CTR_ROWS, TDS_ZERO,
GWL_SEND_DONE);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDSNDDON’;
CALL DISP_ERROR;
END;
IF PARM_NR_ROWS > 0 THEN
DO;
GWL_WAIT_OPTION = TDS_TRUE;
GWL_REQ_TYPE = 0;
GWL_TRAN_NAME = ‘ ‘;
CALL TDGETREQ (GWL_PROC, GWL_RC,
GWL_WAIT_OPTION,
GWL_REQ_TYPE,
GWL_TRAN_NAME);
SELECT (GWL_RC);
WHEN(TDS_OK);
WHEN(TDS_CONNECTION_TERMINATED)
DO;
MORE_MSGS = FALSE;
CALL FREE_STORAGE;
END;
WHEN(TDS_RESULTS_COMPLETE)
DO;
MORE_MSGS = FALSE;
CALL FREE_STORAGE;
END;
OTHERWISE
DO;
MORE_MSGS = FALSE;
CALL_NAME = ‘TDGETREQ’;
CALL DISP_ERROR;
END;
END; /* SELECT */
END; /* IF */
END; /* DO WHILE MORE_MSGS = TRUE */
CALL SRRCMIT(CPIC_RC);
IF CPIC_RC ^= 0 then
DO;
CALL_NAME = ‘SRRCMIT’;
CALL_MSG = ‘SRRCMIT ERROR RC=’;
CALL_RC = CPIC_RC;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
END;
AIBID = ‘DFSAIB ‘;
AIBRSNM1 = ‘SYIPSAM1’;
AIBLEN = STG(AIB);
CALL AIBTDLI (TWO, DPSB, AIB);
IF AIBRETRN ^= 0 THEN
DO;
CALL_NAME = ‘DPSB’;
CALL_MSG = ‘DPSB CALL ERROR RC=’;
CALL_RC = AIBRETRN;
CALL_RC2 = AIBREASN;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
END;
IF PARM_NR_ROWS = 0 then
CALL FREE_STORAGE;
DISP_ERROR: PROC;
CALL_MSG = ‘ERROR IN CALL RC=’;
CALL_RC = GWL_RC;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
CALL FREE_STORAGE;
END DISP_ERROR;
FREE_STORAGE: PROC;
CALL TDFREE (GWL_PROC, GWL_RC);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDFREE ‘;
CALL_MSG = ‘ERROR IN CALL RC=’;
CALL_RC = GWL_RC;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
END;
CALL TDTERM (GWL_INIT_HANDLE, GWL_RC);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDTERM ‘;
CALL_MSG = ‘ERROR IN CALL RC=’;
CALL_RC = GWL_RC;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
END;
END FREE_STORAGE;
END SYIXAM1;
