COPY ASMMSP ADKASM CSECT *********************************************************************** ** CHANGE CONTROL: * *********************************************************************** * * * NAME: ADKASM * * * * DESCRIPTION: * * * * This program demonstrates Dynatrace IMS ADK APIs. * * * * One group of APIs contains functions for starting and * * ending a distributed trace for the transaction and associated tagging * * functions. A newer group of APIs permits nodes to be inserted * * into a distributed trace that is already in progress and to capture * * its arguments or return value. The two groups of APIs are * * unrelated, but they can be used within the same transaction. * * * * TRANSACTION : ADKASM * * * * PSB : ADKASM * * * * DATABASE : DFSIVD1 * * * * INPUT: ADKASMbbb * * * *---------------------------------------------------------------------* * EQUATE REGISTERS AND USAGE OF REGISTERS * *---------------------------------------------------------------------* R0 EQU 0 R1 EQU 1 ORIGINAL PCBLIST ADDRESS R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 I/O OR DB PCB ADDRESS R9 EQU 9 BAL REGISTER R10 EQU 10 R11 EQU 11 SECOND BASE REGISTER R12 EQU 12 FIRST BASE REGISTER R13 EQU 13 SAVE AREA ADDRESS R14 EQU 14 R15 EQU 15 *---------------------------------------------------------------------* * HOUSE KEEPING * *---------------------------------------------------------------------* USING ADKASM,R12,R11 SAVE (14,12) SAVE REGISTER LR R12,R15 LOAD FIRST BASE REGISTER LA R11,2048(,R12) LA R11,2048(,R11) GET SECOND BASE ST R13,SAVEAREA+4 SET BACKWARD POINTER LA R2,SAVEAREA NEW SAVEAREA ST R2,8(,R13) FORWARD CHAIN LR R13,R2 MVI SW1,X'00' INITIALIZE SW1 *---------------------------------------------------------------------* * SAVE PCB ADDRESSES * *---------------------------------------------------------------------* ST R1,PCBALST SAVE PCB ADDRESS LIST USING PCBNAME,R8 MAP PCB FOR INPUT AND ALTERNATE L R8,0(,R1) GET FIRST ENTRY LA R8,0(,R8) MAKE SURE HIGHEST BIT IS OFF ST R8,IOPCB SAVE I/O PCB ADDRESS L R8,4(,R1) GET SECOND ENTRY LTR R8,R8 LAST ENTRY? BM P0005 THEN, MUST BE DBPCB ST R8,ALTPCB SAVE ALTPCB ADDRESS L R8,8(,R1) GET THIRD ENTRY P0005 DS 0H LA R8,0(,R8) MAKE SURE HIGHEST BIT IS OFF ST R8,DBPCB SAVE DBPCB ADDRESS *---------------------------------------------------------------------* * OBTAIN INPUT DATA * *---------------------------------------------------------------------* P0010 DS 0H XC IN_LL,IN_LL L R8,IOPCB POINT TO IOPCB * CALL ASMTDLI,(GU,(R8),INPUT),VL GET INPUT MESSAGE * CLC STATUS,BLANK CHECK STATUS BYTES BE PROGMSG MSG RECEIVED CLC STATUS,INFONLY INFO. ONLY STATUS CODE! BE PROGMSG ELSE, SOMETHING IS WRONG... OI SW1,SW1ABND ALLOW PGM TO TERMINATE CLC STATUS,NOMSGS NO MESSAGES? BNE MSERALL ELSE, SOMETHING IS WRONG... B FINISH *---------------------------------------------------------------------* * CHECK THE MESSAGE * *---------------------------------------------------------------------* PROGMSG DS 0H MVC OUTPUT1,BLANK CLEAR OUTPUT AREA MVC IODATA,BLANK CLEAR I/O WORK AREA * * Start an initial path for this transaction. * * Note that a transaction that receives a tag from a program * running on another platform should start a linked path instead * so it can set a tag. For an example, see subroutine SUB1 * below. * -------------------------------------------------------------* CALL DTSPTF,(PATHNAME,PATH_LEN,CCSID),MF=(E,PLIST) LTR R15,R15 BZ DTSPTFOK MVC MSG_API,=CL8'DTSPTF' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DTSPTFOK DS 0H * -------------------------------------------------------------* * Note: * Any activity that occurs in this transaction between a start * path or start linked path API and the next DTEP API will be * associated with the started path. Optionally, insert link APIs * can be used to create tags to represent subpaths for children * of this transaction. The IMS agent automatically tags IMS * transactions started by program switch requests made by any * traced transaction, so insert link is typically used to tag * service requests made to programs running on non-IMS * platforms. * * The IMS agent does not automatically support tracing calls * to programs using a synchronous program-to-program switch. * Programs doing a synchronous program-to-program switch using * the ICAL DL/I call will need to implement the Dynatrace ADK * using the synchronous insert link and start linked path API * calls. We suggest passing a custom tag in the request_area of * the ICAL DL/I call to the called program. See the ADKICAL * sample assembler program for an example. * * -------------------------------------------------------------* * -------------------------------------------------------------* * Insert a link for a child path to trace a service request to a * program that will run on another platform. The tag length * must be initialized to the size of the buffer where the tag * will be returned. * -------------------------------------------------------------* LHI R4,L'BUFFER ST R4,TAG_LEN CALL DTILTF,(BUFFER,TAG_LEN),MF=(E,PLIST) LTR R15,R15 BZ DTILTFOK MVC MSG_API,=CL8'DTILTF' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DTILTFOK DS 0H * -------------------------------------------------------------* * Note: * Pass the tag that was obtained above to the service to * identify the path that it will set to report its activity. * -------------------------------------------------------------* * -------------------------------------------------------------* * End the initial path early because one transaction can't be * linked to two paths at once. Normally this API would be used * when the transaction is finished or when it wants to start * another path to trace a new unit of work. * -------------------------------------------------------------* CALL DTEP LTR R15,R15 BZ DTEPOK MVC MSG_API,=CL8'DTEP' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DTEPOK DS 0H * -------------------------------------------------------------* * To avoid the inconvenience of defining additional transactions * and programs, we will call an embedded subroutine here instead * of making a request to an external service. * -------------------------------------------------------------* LA R15,SUB1 CALL (15),(BUFFER,TAG_LEN),MF=(E,PLIST) * -------------------------------------------------------------* * Send a message to the terminal and return to IMS. * -------------------------------------------------------------* XC OUT_ZZ,OUT_ZZ MVC OUT_RESP,TERM_MSG MVC OUT_LL,=H'31' * MVC ECALL,ISRT SAVE CALL TYPE L R15,IOPSGNO SEGMENT# ON IOPCB LA R15,1(,R15) +1 ST R15,IOPSGNO UPDATE SEGMENT# CVD R15,WORKD CONVERT TO DECIMAL UNPK OUTSEGNO,WORKD+6(2) UNPACK OI OUTSEGNO+3,C'0' SET SIGN L R8,IOPCB POINT IOPCB * CALL ASMTDLI,(ISRT,(R8),OUTEZT),VL * MVC PCBM,0(R8) CLC STATUS,BLANK NORMAL? BNE MSERALL WTO * B FINISH SUB1 DS 0D STM R14,R12,12(R13) LA R15,SUBSAVEA ST R13,4(,R15) ST R15,8(,R13) LR R13,R15 LM R4,R5,0(R1) * -------------------------------------------------------------* * Start the linked path. If your IMS transaction receives a * Dynatrace tag from another platform, a DTSLP* API is all that * is required to trace the transaction and any other IMS * transactions that it starts through a supported protocol. * -------------------------------------------------------------* CALL DTSLPTF,((R4),(R5)),MF=(E,PLIST) LTR R15,R15 BZ SLPTFOK MVC MSG_API,=CL8'DTSLPTF' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) SLPTFOK DS 0H * -------------------------------------------------------------* * Simulate calling another program by inserting another node * into the distributed trace here. A Data Capture API is used to specify * a string argument. Note that these functions are unrelated * to the tagging functions that are also being demonstrated * elsewhere in this program. * * The token value must be retained and supplied on the matching * Exit API. If nested nodes are created, each will have its own * token and the most recent one must be exited first. * * Start by capturing an argument for the simulated program node. * -------------------------------------------------------------* CALL DTDCTF,(ARGUMENT,ARGLEN,ARGCCSID),MF=(E,PLIST) LTR R15,R15 BZ DCIARGOK MVC MSG_API,=CL8'DTDCTF' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DCIARGOK DS 0H * -------------------------------------------------------------* * Enter the simulated program. * -------------------------------------------------------------* CALL DTENTF,(NODENAME,NAMELEN,TOKEN),MF=(E,PLIST) LTR R15,R15 BZ ENTFOK MVC MSG_API,=CL8'DTENTF' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) ENTFOK DS 0H * -------------------------------------------------------------* * The application work associated with this program goes here. * -------------------------------------------------------------* * -------------------------------------------------------------* * End the program node that we added with a return code 8. * * Start by capturing the return value. * -------------------------------------------------------------* CALL DTDCI,(RC8),MF=(E,PLIST) LTR R15,R15 BZ DCIRETOK MVC MSG_API,=CL8'DTDCI' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DCIRETOK DS 0H * -------------------------------------------------------------* * Exit from the simulated program using the token from the most * recent Enter API. * -------------------------------------------------------------* CALL DTEX,(TOKEN),MF=(E,PLIST) LTR R15,R15 BZ EXOK MVC MSG_API,=CL8'DTEX' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) EXOK DS 0H * -------------------------------------------------------------* * End the linked path before returning. * -------------------------------------------------------------* CALL DTEP LTR R15,R15 BZ DTEP2OK MVC MSG_API,=CL8'DTEP' MVC MSG_TEXT,=CL16'API returned RC ' CVD R15,DWORD UNPK MSG_RC,DWORD OI MSG_RC+L'MSG_RC-1,X'F0' If LTR,R15,R15,M MVI MSG_RC,C'-' EndIf , SR R0,R0 LA R1,ERR_MSG WTO MF=(E,(1)) DTEP2OK DS 0H L R15,RC8 L R13,4(,R13) L R14,12(,R13) LM R0,R12,20(R13) BR R14 * *---------------------------------------------------------------------* * DATA BASE SEGMENT READ (GET UNIQUE) REQUEST HANDLER * *---------------------------------------------------------------------* GUDB DS 0H MVC ECALL,GU SAVE CALL TYPE L R8,DBPCB POINT DBPCB * CALL ASMTDLI,(GU,(R8),IODATA,SSA),VL * MVC PCBM,0(R8) CLC STATUS,BLANK ANY ERROR BNER R9 YES B 4(,R9) RETURN *---------------------------------------------------------------------* * ISRT FOR IOPCB REQUEST HANDLER * *---------------------------------------------------------------------* ISRTIO DS 0H MVC ECALL,ISRT SAVE CALL TYPE L R15,IOPSGNO SEGMENT# ON IOPCB LA R15,1(,R15) +1 ST R15,IOPSGNO UPDATE SEGMENT# CVD R15,WORKD CONVERT TO DECIMAL UNPK OUTSEGNO,WORKD+6(2) UNPACK OI OUTSEGNO+3,C'0' SET SIGN L R8,IOPCB POINT IOPCB CALL ASMTDLI,(ISRT,(R8),OUTPUT),VL MVC PCBM,0(R8) CLC STATUS,BLANK ANY ERROR BNER R9 YES B 4(,R9) RETURN *---------------------------------------------------------------------* * RETURN REPLY MESSAGE TO THE TERMINAL * *---------------------------------------------------------------------* RETURN DS 0H BAL R9,ISRTIO SEND REPLY MESSAGE TO IOPCB B MSERALL WRITE ERROR TO OPERATOR *---------------------------------------------------------------------* * TERMINATION ROUTINE * *---------------------------------------------------------------------* FINISH DS 0H TM SW1,SW1ABND ABORT SWITCH SET? BNO P0010 NO, GO ISSUE GU L R13,4(,R13) RESTORE SAVE AREA ADDRESS LM R14,R12,12(R13) RESTORE THE REGISTER XR R15,R15 RETURN-CODE ZERO BR R14 RETURN BACK *---------------------------------------------------------------------* * WRITE ERROR-MESSAGES * *---------------------------------------------------------------------* NODATA DS 0H MVC OUTMSG,MNODATA SET ERROR DATA B RETURN MSERALL EQU * BAL R14,SENDE MESSAGE RETURN B FINISH SENDE DS 0H MVC EST,STATUS STATUS INTO THE MESSAGE CNOP 0,4 BAL R1,WTO WRITE TO OPERATOR DCMSG DC H'30' DC H'0' DCTXT DS 0CL26 DC C'STATUS ' EST DS CL2 DC C', DLI CALL = ' ECALL DS CL4 WTO WTO MF=(E,(1)) BR R14 RETURN * LTORG DS 0F BLANK DC 256C' ' *-------------------------------------------------------------- * TERMINAL INPUT ERROR MESSAGES *-------------------------------------------------------------- MNODATA DC CL40'NO DATA WAS INPUT. PLEASE KEY IN MORE' * *-------------------------------------------------------------- * FUNCTION CODES USED *-------------------------------------------------------------- GU DC CL4'GU ' ISRT DC CL4'ISRT' CHNG DC CL4'CHNG' PURG DC CL4'PURG' DLET DC CL4'DLET' *-------------------------------------------------------------- * DLI STATUS CODES *-------------------------------------------------------------- *BLANK DC CL2' ' NORMAL COMPLETION * BLANK is shown here as a comment for documentation only. * It is used for clearing buffers as well as for comparing * completion status, and is defined elsewhere as: *BLANK DC 256C' ' NOMSGS DC CL2'QC' NO MORE MESSAGES INFONLY DC CL2'CF' INFORMATION ONLY MESSAGE NOTFND DC CL2'GE' SEGMENT NOT IN DATA BASE DUPSEG DC CL2'II' DUPLICATE SEGMENT IN DATA BASE SW1 DC X'00' REPLY SWITCH SW1TADD EQU X'80' 'TADD' REQUEST IN PROGRESS SW1ABND EQU X'40' ABORT IN PROGRESS SW1DATA EQU X'20' SOME DATA IS TYPED IN SW1OUTP EQU X'10' INSERT TO ALTPCB IN PROGRESS SW1DEST EQU X'08' DESTINATION IS SETUP IOPSGNO DC F'0' SEGMENT# ON IOPCB ALTPSGNO DC F'0' SEGMENT# ON ALTPCB WORKD DS D WORKAREA PCBALST DC F'0' A(PCBLIST) IOPCB DC F'0' A(IOPCB) ALTPCB DC F'0' A(ALTPCB) DBPCB DC F'0' A(DBPCB) SAVEAREA DC 18F'0' SUBSAVEA DC 18F'0' PCBM DS CL52 *---------------------------------------------------------------------* * DATA AREA FOR TERMINAL INPUT * *---------------------------------------------------------------------* INPUT DS 0CL59 INLL DS CL2 DS CL2 INTRAN DS CL10 INCMD DS CL8 PROCESS REQUEST (COMMAND) INDATA1 DS 0CL37 INNAME1 DS CL10 LAST NAME INNAME2 DS CL10 FIRST NAME INEXT# DS CL10 EXTENTION # INZIP DS CL7 INTERNAL ZIP CODE ORG INPUT * ezt 01 REQUEST. IN_LL DS XL2 ezt 05 IN-LL PIC S9(3) COMP. IN_ZZ DS XL2 ezt 05 IN-ZZ PIC S9(3) COMP. IN_TRCD DS CL9 ezt 05 IN-TRCD PIC X(9). IN_CCNBR DS CL20 ezt 05 IN-CREDITCARDNUMBER PIC X(20). ORG , InputMax EQU 4096 Pad to 4K ORG Input+InputMax SSA DS 0F DC CL8'A1111111' SSAT DC C'(' DC CL8'A1111111' DC CL2' =' SSAKEY DS CL10 LAST NAME DC C')' SSA1 DS 0F DC CL8'A1111111' DC C' ' *---------------------------------------------------------------------* * I/O AREA FOR DATA BASE HANDLING * *---------------------------------------------------------------------* DS 0F IODATA DS 0CL48 IODATA1 DS 0CL37 IONAME1 DS CL10 LAST NAME IONAME2 DS CL10 FIRST NAME IOEXT# DS CL10 EXTENTION# IOZIP DS CL7 INTERNAL ZIP CODE DS CL3 IOCMD DS CL8 *---------------------------------------------------------------------* * DATA AREA FOR TERMINAL OUTPUT * *---------------------------------------------------------------------* DS 0F OUTPUT DS 0CL89 OUTLL DC H'93' LENGTH OF THE OUTPUT MESSAGE OUTZ1Z2 DC XL2'0000' Z1 Z2 OUTPUT1 DS 0CL89 OUTMSG DS CL40 OUTCMD DS CL8 REQUEST CODE OUTDATA1 DS 0CL37 OUTNAME1 DS CL10 LAST NAME OUTNAME2 DS CL10 FIRST NAME OUTEXT# DS CL10 EXTENTION# OUTZIP DS CL7 INTERNAL ZIP CODE OUTSEGNO DS CL4 OUTPUT SEGMENT NUMBER * ezt 01 RESPONSE. DS 0F OUTEZT DS 0CL48 OUT_LL DS H ezt 05 OUT-LL PIC S9(3) COMP. OUT_ZZ DS H ezt 05 OUT-ZZ PIC S9(3) COMP. OUT_RESP DS CL44 ezt 05 OUT-RESULT PIC X(10). DS 0F OUT_ALT DS 0CL24 OUT_ALL DS H OUT_AZZ DS H OUT_TRAN DS CL8 OUT_PRT# DS CL12 OUT_DEST DS CL8 * Optional name to describe the initial path. PATHNAME DC CL24'Started from tagging ADK' PATH_LEN DC A(L'PATHNAME) CCSID DC F'0' NODENAME DC CL8'TESTPROG' Program name for the new node NAMELEN DC F'8' Program name length - up to 8 bytes ARGUMENT DC CL6'Hello.' Argument value associated with TESTPROG ARGLEN DC F'6' Length of argument above ARGCCSID DC F'0' Default CCSID RC8 DC F'8' Return value associated with TESTPROG TERM_MSG DC CL27'Assembler TAGTEST complete.' ERR_MSG DS 0CL31 DC AL2(31) WTO TEXT LENGTH DC AL2(0) WTO MCSFLAGS MSG_API DS CL8 MSG_TEXT DS CL16'API returned RC ' MSG_RC DS CL3 DWORD DS D TAG_LEN DS F TOKEN DS F Value that identifies the node on exit PLIST CALL ,(,,,),MF=L * Buffer to hold the tag that will identify a child path. * Note: Dynatrace requires a buffer of at least 77 bytes. BUFFER DS CL100 * PCBNAME DSECT TNAME DS CL8 TRANSACTION-NAME TC DS CL2 STATUS DS CL2 STATUS DBPRO DS CL4 PROC OPTION DS F RESERVED DBSFB DS CL8 SEGMENT NAME FEEDBACK DBLKA DS F CURRENT LENGTH OF KEY FEEDBACK AREA DBNSS DS F NO OF SENSITIVE SEGMENTS DBKFA DS CL17 KEY FEEDBACK AREA DS CL3 END ADKASM