gtpa3m0z | Application Requester User's Guide |
Segment QXRK is shown in Figure 28. The beginning of this program is a simple command front end interface. Segment QXRK parses the input message and passes the parameters to the back end program (segment QXRL in Figure 29). It also calculates the time it takes the back end program to complete by storing the time of day (TOD) clock before and after the call to the back end program. Before completing, this segment informs you if the function completed successfully, what the invocation parameters were, and how long it took to run. This application is started using a command, which can be ZTEST or any other command that points to this program. An example of a ZTEST command to start this application is:
ZTEST num_insert num_find num_com [text] [RDB-rdbname]
where:
Figure 28. TPF Program to Call the Insert Driver with the Values Passed
PRINT NOGEN ********************************************************************** * THIS PRODUCT CONTAINS "RESTRICTED MATERIALS OF IBM " * COPYRIGHT = 5748-T13 (C) COPYRIGHT IBM CORP 1979,1989 * LICENSED MATERIAL - PROGRAM PROPERTY OF IBM * REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083 ********************************************************************** BEGIN NAME=QXRK,VERSION=ZZ,IBM=YES CREATED 05/03/91 * *************************************************************** * * * MODULE NAME..... QXRK (PDS NAME) * * RELATED MODULE.. NONE * * DOCUMENT NAME... NONE * * DESCRIPTION..... ZTEST DRIVER TO START TPFAR INSERT PGM * * LEVEL........... VERSION 1 MODIFICATION 0 * * * * FUNCTION... THIS SEGMENT JUST CALLS THE TPFAR INSERT DRIVER * * WITH THE VALUES PASSED * * * * MODULE ATTRIBUTES.. * * TYPE.......... 'E' * * * * ECB-CONVENTIONS.......NONE * * REGISTER-CONVENTIONS..NONE * * * *************************************************************** * INTERFACE REQUIREMENTS: * * * * DEPENDENCIES... TPFAR MUST BE GENERATED IN SYSTEM. * * RESTRICTIONS... NONE * * * * ECB * INPUT.. * OUTPUT.. * * --------------*----------------------*----------------------* * WORK AREA.... * * * * DATA LEVELS.. * MESSAGE BLOCK * * * REGISTERS.... * * * * * *************************************************************** * * * EXTERNAL-REFERENCES.. NONE * * * * ACRONYMS... (& DEFINITIONS) * * * * EXIT-NORMAL.. PRINT OUT STATISTICS FOR INSERTS AND EXIT * * -ERROR... PRINT OUT ERROR MESSAGE AND EXIT * * * * * *************************************************************** SPACE 5 *************************************************************** * * * Parse the message block looking for the parameters. * * * * When finished, we can release the message block. * * * *************************************************************** SPACE 2 BPKDC EXECUTE=Y,BPKD=DB2IBPKD,HELP=QXRKHELP
*************************************************************** * * * The parameter area needs to be set up for the call to the * * insert program. The first parameter is the number of * * inserts the program is to do, the second is the number of * * finds the program is to do between inserts, the third is * * the number of inserts to do before inserting a log record * * and committing, the forth parameter is an optional field * * that is placed in the inserted record. The last parameter * * is a optional keyword parameter for the RDBNAME to be * * accessed. If not given, it will default to DB23TST. * * * *************************************************************** SPACE 2 DCTBPK REG=R1 Set up format of param list L R4,BPKOPM1 Set up the first parameter L R15,0(,R4) (Number of inserts) ST R15,EBX000 In EBX000 L R4,BPKOPM2 Set up the second parameter L R15,0(,R4) (Number of finds) ST R15,EBX004 In EBX004 L R4,BPKOPM3 Set up the third parameter L R15,0(,R4) (Number before commit) ST R15,EBX008 In EBX008 L R4,BPKOPM4 Set up the forth parameter * (Informational log) MVC EBX012(8),=C' ' Initialize field to blanks SR R15,R15 Clear for insert ICM R15,B'0001',0(R4) Get length of field BZ QXRKCONT No input, leave blank BCTR R15,0 Minus 1 for MVC EX R15,QXRKMVC Move the input field QXRKCONT DS 0H L R4,BPKOPM5 Set up the fifth parameter * (RDBNAME) SR R15,R15 Clear for insert ICM R15,B'0001',0(R4) Get length of field BZ QXRKCONT2 No input, use default MVC EBX020(16),=C' ' Init field to blnks BCTR R15,0 Minus 1 for MVC EX R15,QXRKMVC2 Move the input field B QXRKCONT3 Continue QXRKCONT2 DS 0H Move the default RDBNAME MVC EBX020(16),=C'DB23TST ' QXRKCONT3 DS 0H
*************************************************************** * * * Issue the message indicating that the inserts have started. * * * *************************************************************** SPACE 2 WTOPC PREFIX=QXRK,TIME=YES,NUM=02,LET=I,CHAIN=NO,ENDOFM=YES, X TEXT='STARTING INSERTS' *************************************************************** * * * Set up the interface register, R6, and release the block. * * * *************************************************************** SPACE 2 RELCC D0 Release the parse block LA R6,EBX000 Interface is in R6 *************************************************************** * * * Store the TOD clock before the call. On return from the * * insert, the clock time will be again stored so that the * * time that it took for all the inserts to work can be * * calculated. * * * *************************************************************** SPACE 2 STCK EBX040 ENTRC QXRL CALL THE INSERT STCK EBX048
*************************************************************** * * * In order to work with the STCK, we must change the format * * of the time to a long. This is done by inserting a x'4D' * * at the start. * * * *************************************************************** SPACE 2 MVC EBX080(15),EBX040 Copy for move MVC EBX041(15),EBX080 Copy back over one space MVI EBX040,X'4D' Insert a X'4D' in front of MVI EBX048,X'4D' both numbers LD 0,EBX048 Load double the ending time SD 0,EBX040 Subtract the starting time DD 0,=D'1000' Divide by 1000 to get * milliseconds AD 0,DUBB This add will shift the high * order fullword of a double to * last four bytes for usage as * an integer. STD 0,EBX040 Store the number. L R3,EBX044 Load the last four bytes. * This is the number of * milliseconds that elapsed. SR R2,R2 Clear R2 for divide. D R2,=F'1000' Divide by 1000 to get num. of * seconds. ST R3,EBX056 Save number of seconds. CVD R2,EBX080 Convert the remainder to printable UNPK EBX060(4),EBX086(2) characters. MVZ EBX061(3),EBX060 Set up the zone for the characters. MVI EBX060,C'.' Add the decimal point. * L R3,EBX044 Number of milliseconds SR R2,R2 Clear for divide D R2,EBX000 Divide by the number of inserts SR R2,R2 Clear for divide D R2,=F'1000' Divide to get seconds ST R3,EBX064 Save the number of seconds CVD R2,EBX080 Convert the remainder to printable UNPK EBX068(4),EBX086(2) characters. MVZ EBX069(3),EBX068 Set up the zone for the characters. MVI EBX068,C'.' Add the decimal point. LTR R6,R6 If the return was good, BZ QXRKGOOD issue the good message. WTOPC PREFIX=QXRK,TIME=YES,NUM=04,LET=E,CHAIN=NO,ENDOFM=YES, X TEXTA=QXRKERR,SUB=(DECA,EBX056,CHARA,EBX060, X DECA,EBX000,DECA,EBX004, X DECA,EBX008,CHARA,EBX012,CHARA,EBX020),COMP=YES EXITC QXRKGOOD DS 0H WTOPC PREFIX=QXRK,TIME=YES,NUM=03,LET=I,CHAIN=NO,ENDOFM=YES, X TEXTA=QXRKMSG1,SUB=(DECA,EBX056,CHARA,EBX060, X DECA,EBX064,CHARA,EBX068,DECA,EBX000,DECA,EBX004, X DECA,EBX008,CHARA,EBX012,CHARA,EBX020),COMP=YES EXITC QXRKHELP DS 0H WTOPC PREFIX=QXRK,TIME=YES,NUM=01,LET=E,CHAIN=NO,ENDOFM=YES, X TEXTA=QXRKMSG EXITC
QXRKMSG DC AL1(QXRKMSGE-QXRKMSG-1),AL1(#CAR) DC C'ZDB2I INSERTS FINDS LOGGING R-RDBNAME',AL1(#CAR) DC C' WHERE INSERTS - NUMBER OF INSERTS TO DO',AL1(#CAR) DC C' FINDS - NUMBER OF FINDS TO DO BEFORE INSERT',AL1(#CAR) DC C' LOGGING - AMOUNT TO WAIT BEFORE COMMITTING',AL1(#CAR) DC C' RDBNAME - RDBNAME TO CONNECT TO' QXRKMSGE EQU * QXRKMSG1 DC AL1(QXRKMSG1E-QXRKMSG1-1) DC C'DONE WITH INSERTS, TIME= .......... ....',AL1(#CAR) DC C'AVERAGE PER INSERT= .......... ....',AL1(#CAR) DC C'NUM INSERTS= ..........',AL1(#CAR) DC C'NUM FINDS= ..........',AL1(#CAR) DC C'LOGGING= ..........',AL1(#CAR) DC C'IDENTIFIER = ........',AL1(#CAR) DC C'RDBNAME= ..........' QXRKMSG1E EQU * QXRKERR DC AL1(QXRKERRE-QXRKERR-1) DC C'AN ERROR OCCURRED. ' DC C'TIME= .......... ....',AL1(#CAR) DC C'NUM INSERTS= ..........',AL1(#CAR) DC C'NUM FINDS= ..........',AL1(#CAR) DC C'LOGGING= ..........',AL1(#CAR) DC C'IDENTIFIER = ........',AL1(#CAR) DC C'RDBNAME= ..........' QXRKERRE EQU * QXRKMVC MVC EBX012(0),1(R4) QXRKMVC2 MVC EBX020(0),1(R4) DS 0D DUBB DC X'4F08000000000000' DB2IBPKD BPKDC (PRD,INSERTS,,8), X (PRD,FINDS,,8), X (PRD,LOGGING,,8), X (P,IDENT,,8), X (K,RDBNAME,1,16) LTORG FINIS QXRK END