SYIPAM1: PROC(P_PCBTERM) OPTIONS(MAIN, NOEXECOPS);
/****** SYIPSAM1 - RPC REQUEST APPLICATION - PL/1 - IMS ************/
/* */
/* TRANID: SYM1 */
/* PROGRAM: SYIPSAM1 */
/* 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 executed via isql. The first parameter is a */
/* 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 enter the following commands: */
/* */
/* >isql -Usa -P -Sservername */
/* */
/* >exec SYM1 X, 100 */
/* */
/* This tran returns a 80 byte row containing the LTERM 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 PLIXOPT CHAR(50) VAR INIT(‘NOSPIE,NOSTAE’)
STATIC EXTERNAL;
DCL P_PCBTERM POINTER;
DCL P_ALTPCB POINTER;
/*------------------------------------------------------------------*/
/* POINTER TO ACTUAL PCB ADDRESS */
/*------------------------------------------------------------------*/
DCL P_PCBADDR POINTER BASED(P_PCBTERM);
/*------------------------------------------------------------------*/
/* 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);
/********************************************************************/
/* SERVER LIBRARY PL/1 COPY BOOK */
/********************************************************************/
%INCLUDE SYGWPLI;
/*------------------------------------------------------------------*/
/* SERVER LIB ROUTINES DECLARATIONS */
/*------------------------------------------------------------------*/
DCL
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);
/*------------------------------------------------------------------*/
/* 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_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
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);
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:
/*------------------------------------------------------------------*/
GWL_PROC = NULL;
GWL_SPA_PTR = NULL;
GWL_INIT_HANDLE = NULL;
GWL_RC = 0;
MORE_MSGS = TRUE;
/* ------------------------------------------------------------*/
/* establish gateway environment */
/* ------------------------------------------------------------*/
CALL TDINIT (P_PCBADDR, GWL_RC, GWL_INIT_HANDLE);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDINIT’;
CALL DISP_ERROR;
END;
/* ------------------------------------------------------------*/
/* set program type to MPP */
/* ------------------------------------------------------------*/
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;
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;
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 = PCBTERM.TERMNAME;
DO I = 1 TO 71;
WROW_PATTERN (I) = PARM_PATTERN;
END;
/*------------------------------------------------------------------*/
SEND_REPLY_ROWS:
/*------------------------------------------------------------------*/
ALL_DONE = ‘0’B;
CTR_ROWS = 0;
IF PARM_NR_ROWS = 0 THEN
ALL_DONE = ALL_DONE_YES;
ELSE
DO WHILE(^ ALL_DONE);
CALL TDSNDROW (GWL_PROC, GWL_RC);
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; /* END DO WHILE */
/*------------------------------------------------------------------*/
SEND_DONE:
/*------------------------------------------------------------------*/
CALL TDSNDDON (GWL_PROC, GWL_RC,
TDS_DONE_COUNT,
CTR_ROWS,
TDS_ZERO,
TDS_ENDRPC);
IF GWL_RC ^= 0 THEN
DO;
CALL_NAME = ‘TDSNDDON’;
CALL DISP_ERROR;
END;
IF PARM_NR_ROWS = 0 THEN
MORE_MSGS = FALSE;
ELSE
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)
MORE_MSGS = FALSE;
WHEN(TDS_RESULTS_COMPLETE)
MORE_MSGS = FALSE;
OTHERWISE
DO;
MORE_MSGS = FALSE;
CALL_NAME = ‘TDGETREQ’;
CALL DISP_ERROR;
END;
END; /* SELECT */
END; /* END ELSE */
END; /* DO WHILE MORE_MSGS = TRUE */
CALL FREE_STORAGE;
DISP_ERROR: PROC;
MORE_MSGS = FALSE;
CALL_MSG = ‘ERROR IN CALL RC=’;
CALL_RC = GWL_RC;
PUT FILE(SYSPRINT) DATA(ERROR_MSG);
END DISP_ERROR;
FREE_STORAGE: PROC;
RETURN;
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 SYIPAM1;
