RSB - DL/I General Purpose Macro

    MACRO NAME = DFHDLP
    DESCRIPTIVE NAME = CICS DL/I General Purpose Macro
          Licensed Materials - Property of IBM
           Restricted Materials of IBM 
          5655-Y04
          (C) Copyright IBM Corp. 1981, 2016 
    FUNCTION =
    NOTES :
     DEPENDENCIES = S/370
     RESTRICTIONS = NONE
     REGISTER CONVENTIONS = SEE COMMENTS IN CODE
     MODULE TYPE = EXECUTABLE
          A31849
          D96439 700 141031 HD2GJST: Fix DFHDLI info messages
          D97034 700 141117 HD2GJST: Fix Control block formatting
         R126793 710 160727 HDFVGMB: Save DBCTLID over disconnect
           REMOTE SCHEDULING BLOCK
Table 1.
Offset Hex Type Len Name (Dim) Description
(0) STRUCTURE 0 DFHRSBDS
(0) FULLWORD 4   STORAGE ACCOUNTING
(4) FULLWORD 4   STORAGE ACCOUNTING
(4) .... 1...   RSBSTART "*" START OF RSB
(8) ADDRESS 4 RSBPDIR A(REMOTE PDIR ENTRY)
(C) CHARACTER 4 RSBSYSID REMOTE SYSTEM ID 
         PLIST FOR IS CONVERSE
(10) FULLWORD 4 RSBISPL (0)
(10) CHARACTER 1 (0) REQUEST TYPE
(10) CHARACTER 1   RETURN CODE
(11) CHARACTER 1   MODIFIER, REQUEST INDEPENDENT
(12) CHARACTER 1   MODIFIER, REQUEST DEPENDENT
(13) CHARACTER 1   RESERVED
(14) FULLWORD 4   TCTTE ADDRESS
(18) FULLWORD 4 (0) XFR ADDRESS
(18) CHARACTER 4   TRANSACTION ID
(1C) CHARACTER 4   REMOTE SYSTEM ID
(20) CHARACTER 8   TRANSACTION ROUTING PROFILE
(28) HALFWORD 2   Number of send sessions
(2A) HALFWORD 2   Number of receive sessions
(2C) CHARACTER 8   Connectee NETNAME
(34) CHARACTER 8   Security name
(3C) FULLWORD 4   Address of LCL entry
(40) FULLWORD 4   Address of CRB 
         TRANSFORMER'S (DFHXFP'S) INTERFACE BLOCK
  CONTROL BLOCK NAME = DFHXFRDS
  NAME OF MATCHING PLS CONTROL BLOCK = None
  DESCRIPTIVE NAME = CICS TS Function Request Shipping Request
                               Control Block.
  STATUS = 7.1.0
  MACROS = DFHXFSTG
  FUNCTION =
         Defines the data transformation (XF) control block
         as used in batch and online environments.
(48) DBL WORD 8 XFRSTART (0) XF control block - start 
         FIELDS IN THE XF CONTROL BLOCK THAT ARE UNIQUE
         TO AN ONLINE ENVIRONMENT
         NOTE: There is a copy of this storage up to XFRFLAGA in
         DFHEPC and up to XFRAADPT in DFHEIIC. These programs
         must also be changed if the offset of XFRFLAGA (or
         XFRAADPT for DFHEIIC) changes. The field names in these
         programs are TFRFLAGA and TFRAADPT.

               SYSTEM/SESSION RELATED FIELDS
(48) CHARACTER 4 XFRSYSNM N(SYSID)
(4C) ADDRESS 4 XFRATCSE A(TCTSE)
(50) ADDRESS 4 XFRATCTE A(TCTTE) OR 0
(54) ADDRESS 4 XFRATIOA A(TIOA) OR 0
(58) CHARACTER 4 XFRLUCCD LU6.2 ERROR (SENSE) CODE
(5C) CHARACTER 4 XFRSTRAN Server transaction code
(60) BITSTRING 1 XFRFLAGA
(60) 1... ....   XFRSERVR "X'80'" Server transaction supplied
(60) .1.. ....   XFRNORM "X'40'" Normal transformer to be used
(60) ..1. ....   XFRSYNC "X'20'" SYNCONRETURN requested
(60) ...1 ....   XFRNOATN "X'10'" CONVERSE with NOATNI required
(60) .... 1...   XFRLINK "X'08'" LINK request
(60) .... .1..   XFRRTDST "X'04'" Dynamically routed START request
(60) .... ..1.   XFRRESUN "X'02'" RESUNAVAIL condition supported
(60) .... ...1   XFRCHAN "X'01'" CHANNEL request
(62) HALFWORD 2 XFRRTRLN Length of router commarea or 0
(64) ADDRESS 4 XFRRTRAD A(DFHDSRP) or 0
(68) BITSTRING 4 XFRCHTOK Channel Token
(6C) BITSTRING 1 XFRFLAGB
(6C) 1... ....   XFRRSTRT "X'80'" dynamic and routable start
(6C) .1.. ....   XFRRNKLQ "X'40'" IPIC NOCHECK local queueing
(6D) BITSTRING 1   reserved
(6E) HALFWORD 2 XFRADPLN Length of adapter data
(70) ADDRESS 4 XFRAADPT Address of adapter data
(74) FULLWORD 4 XFRFSPEC (0) Origin for function specific storage 
               DL/I RELATED FIELDS
(74) ADDRESS 4 XFRAUIB A(UIB)
(78) FULLWORD 4 XFRDLILN Maximum length os SETS I/O area so far 
               FILE CONTROL RELATED FIELDS
(7C) FULLWORD 4 FCBUFLEN Shipped buffer length
(80) HALFWORD 2 FCKEYLEN Shipped record identifier length
(82) BITSTRING 1 FCEID (9) ARG 0 OF EIP PARAMETER LIST (EID)
(8B) BITSTRING 1   RESERVED 
               TRANSACTION ENTRY POINT RELEATED FIELDS
(8C) FULLWORD 4 XFRATACD Addr. of TRANSACTION EP ACD
(90) HALFWORD 2 XFRLTACD Length of TRANSACTION EP ACD
(92) BITSTRING 1 (10) RESERVED
(9C) FULLWORD 4 (0) MAKE LENGTH MULTIPLE OF 4 
    This DSECT describes the entries required for remote program link
(9C) FULLWORD 4 DFHPCENT (0) PC LINK entries begin here
(9C) CHARACTER 4 XFR_PC_ATT_TRAN Transaction code - for mirror attach FMH
(A0) CHARACTER 4 XFR_PC_EIB_TRAN Transaction code - for mirror EIBTRNID
(A4) FULLWORD 4 XFR_PC_CCSID Character data conversion 0 => no conversion -1 => conversion required use client code page defined via DFHCNV n => conversion requird use n as override to code page defined via DFHCNV
(A8) FULLWORD 4 XFR_PC_NDIAN Binary data conversion 0 => no conversion X'01020304' => data held in big endian format X'04030201' => data held in little endian format
(AC) CHARACTER 8 XFRPNAME name of program
(B4) HALFWORD 2 XFRCOMML length of commarea
(B6) HALFWORD 2 XFRDATAL length of data to be sent
(B8) CHARACTER 4 XFRABCD Abend code returned from mirror
(BC) BITSTRING 1 XFRFLAG4 Flag byte
(BC) 1... ....   XFRHTRAN "X'80'" hex tranid present
(BC) .1.. ....   XFRDATAV "X'40'" valid DATALENGTH supplied
(BC) 1111 ....   ESCARGN "240" Special id for escape sequence 
   Fields used for passing terminal error information between
   MIRS/ISP and the transformer
(BD) BITSTRING 4 XFRTCERR Terminal error
(C1) CHARACTER 4 XFRTCABE Terminal control abend code
(C5) BITSTRING 4 XFRTCSNS Terminal control sense data
(D0) DBL WORD 8 CONTAINER_LIST (0)
(D0) ADDRESS 4 CONTAINER_LIST_P Address of container list
(D4) FULLWORD 4 CONTAINER_LIST_N Length of container list
(D8) FULLWORD 4 XFRCHOUT # outbound channel bytes
(DC) FULLWORD 4 XFRCHIN # inbound channel bytes 
         FIELDS IN THE XF CONTROL BLOCK THAT ARE UNIQUE
         TO A BATCH ENVIRONMENT
(48) ADDRESS 4 XFRASTG1 ADDRESS OF STG CONTAINING THE FLATTENED PLIST. THE TRANSFORMER GETS NEW STG IF XFRASTGE IS 0 OR REUSES THE CURRENT STG IF THIS PROVES LARGE ENOUGH
(4C) ADDRESS 4 XFRASTG4 ADDRESS OF THE FLATTENED REPLY IN THE BUFFERS OF BATCH DL/I.
(50) FULLWORD 4 XFRASTGL LENGTH OF THE FLATTENED REPLY IN THE DL/I BUFFERS 
         FIELDS IN THE XF CONTROL BLOCK THAT ARE COMMON
         TO A BATCH AND ONLINE ENVIRONMENTS
(E0) ADDRESS 4 XFRPLIST ADDRESS OF PLIST PASSED TO TRANSFORMER OR ADDRESS OF PLIST CREATED BY TRANSF'R
(E4) ADDRESS 4 XFRATABN A(1ST TABLE ENTRY) OR 0 - E.G. RPDIR OR DCTTE
(E8) ADDRESS 4 XFRATAB2 A(2ND TABLE ENTRY) - E.G. PDIR OR 0
(EC) CHARACTER 1 XFRFORMN THE TRANSFORMER INDEX - WITH VALUES SET AS FOLLOWS
(EC) .... ....   XFRTRAN1 "0" TRANSFORMER 1 - VERTICAL TO HORIZONTAL REQUESTS
(EC) .... ..1.   XFRTRAN2 "2" TRANSFORMER 2 - HORIZONTAL TO VERTICAL REQUESTS
(EC) .... .1..   XFRTRAN3 "4" TRANSFORMER 3 - VERTICAL TO HORIZONTAL REPLIES
(EC) .... .11.   XFRTRAN4 "6" TRANSFORMER 4 - HORIZONTAL TO VERTICAL REPLIES
(ED) CHARACTER 2 XFRARCHD USED TO SHOW CICS OR SNA ARCHITECTURE WHEN A CHOICE IS AVAILABLE
(EF) CHARACTER 1 XFRGROUP THE GROUP IDENTIFIER FOR THE CURRENT REQUEST
(EF) .... .11.   XFRFCGRP "X'06'" - THE CICS FC GROUP
(EF) .... 1...   XFRTDGRP "X'08'" - THE CICS TD GROUP
(EF) .... 1.1.   XFRTSGRP "X'0A'" - THE CICS TS GROUP
(EF) ...1 ....   XFRICGRP "X'10'" - THE CICS IC GROUP
(EF) ...1 .1..   XFRJCGRP "X'14'" - THE CICS JC GROUP
(EF) .1.. ....   XFRDLGRP "X'40'" - THE DL/I GROUP
(F0) CHARACTER 1 XFRFUNCT THE FUNCTION IDENTIFIER FOR THE CURRENT REQUEST
(F1) CHARACTER 1 XFRFLAGS PARAMETER LIST FLAGS - WITH VALUES SET AS FOLLOWS
(F1) 1... ....   XFREILST "X'80'" THE ARGUMENT LIST COMES FROM OR GOES TO EIP
(F1) .1.. ....   XFRDLLST "X'40'" THE ARGUMENT LIST COMES FROM OR GOES TO DL/I
(F1) ..1. ....   XFRDLCNT "X'20'" FIRST ARGUMENT IS A COUNT OF THE REMAINING ARGUMENTS
(F1) ...1 ....   XFRDLPLI "X'10'" THE DL/I REQUEST COMES FROM PL/I - INDIRECTION EXISTS
(F1) .... 1...   XFRATHDR "X'08'" AN ATTACH HEADER HAS BEEN PUT OUT BEFORE OTHER DATA
(F1) .... .1..   XFRLNGRN "X'04'" THE MIRROR TASK NEEDS TO BE LONG RUNNING
(F1) .... ..1.   XFRNRPLY "X'02'" THE REQUEST IS TO BE SHIPPED; HOWEVER NO REPLY IS EXPECTED
(F1) .... ...1   XFRPRTCT "X'01'" THE REQUEST IS TO BE SHIPPED PROTECTED
(F2) CHARACTER 1 XFRFLAG1 PARAMETER LIST FLAGS - WITH VALUES SET AS FOLLOWS
(F2) 1... ....   XFRLCLQ "X'80'" THE REQUEST MAY BE QUEUED BEFORE SHIPPING
(F2) .1.. ....   XFRFCTK "X'40'" FC Token can be shipped
(F2) ..1. ....   XFRFCRQ "X'20'" Shipped FC request
(F2) ...1 ....   XFRTMERR "X'10'" Terminal error in xformer layer
(F2) .... ..1.   XFRESCAP "X'02'" Escape sequence preceding 4-byte legths may be found
(F2) .... ...1   XFRCHANL "X'01'" This is a CHANNEL request
(F3) CHARACTER 1 XFRFLAG2 PARAMETER LIST FLAGS - WITH VALUES SET AS FOLLOWS
(F3) 1... ....   XFRHAENT "X'80'" DFHMIRVM has handled an abend; the abend code is to be found in the TACB
(F3) .1.. ....   XFRLENFD "X'40'" LENGTH parameter forced for a FILE READ request which didn't specify LENGTH parameter originally
(F3) ..1. ....   XFRCHNSP "X'20'" Other end of MRO link supports channels
(F3) ...1 ....   XFRICRX "X'10'" Other end of MRO link supports ICRXs
(F3) .... 1...   XFRLCHAN "X'08'" Link with prog or tran chan
(F3) .... .1..   XFRCACX "X'04'" Other end supports propagation of current app ctxt
(F3) .... ..1.   XFRODRP "X'02'" Other end supports propagation of Origin Data
(F3) .... ...1   XFRACTX "X'01'" Other end supports propagation of initial app ctxt
(F4) CHARACTER 1 XFRFLAG3 PARAMETER LIST FLAGS - WITH ALL VALUES RESERVED
(F5) CHARACTER 2 XFRCODES (0) FLAGS INDICATING WHERE CONTROL IS TO BE PASSED UPON RETURN FROM THE TRANSFORMER
(F5) CHARACTER 1 XFRCODE1 THE FIRST SET OF FLAGS - THE NEXT DEFINITIONS APPLY TO RETURN FROM TRANSFORMERS 1 AND 4 WITH VALUES SET AS FOLLOWS
(F5) .... .1..   XFR1TO4 "4" TRANSFORMER 1 HAS FOUND AN ERROR - CONTROL IS TO BE PASSED TO TRANSFORMER 4
(F5) .... 1...   XFR1TOC "8" TRANSFORMER 1 HAS FOUND ERROR - CONTROL IS TO BE PASSED BACK TO EIP OR DL/I
(F5) .... ..1.   XFR1XLNF "2" XLN failure THE NEXT DEFINITIONS APPLY TO RETURN FROM ISP WITH VALUES SET AS FOLLOWS
(F5) 11.1 1.11   XFRLNKUN "219" RESUNAVAIL condition raised in remote region
(F5) ...1 111.   XFRLNKAP "30" Allocate request in ISP has been purged
(F5) ...1 11..   XFRLNKAR "28" Allocate request in ISP has been rejected
(F5) ...1 1.1.   XFRLNKNI "26" no sessions immediately available for allocate request
(F5) ...1 1...   XFRLNKPF "24" ALLOCATE IN ISP HAS FAILED BECAUSE PROFILE DFHCICSF IS MISSING
(F5) ...1 .11.   XFRLNKSV "22" TRANSID invalid, we are already in session with a different mirror transaction.
(F5) ...1 .1.1   XFRDWNLV "21" The remote system does not support a keyword on this request
(F5) ...1 .1..   XFRLNKGP "20" ALLOCATE IN ISP HAS FAILED BECAUSE THE MODENAME IS INVALID
(F5) ...1 ..1.   XFRLNKSP "18" SYNCONRETURN invalid, we are already in session with a mirror
(F5) ...1 ....   XFRLNKLQ "16" LOCAL QUEUEING HAS FAILED - BAD RETURN FROM DFHICP TYPE=PUT
(F5) .... 111.   XFRLNKAB "14" xform 4 has processed ABCODE data
(F5) .... 11..   XFRLNKNA "12" ALLOCATE IN ISP HAS FAILED BECAUSE THE LINK IS NOT IN THE INTERSYSTEM TABLE
(F5) .... 1.1.   XFRLNKSF "10" CONVERSE in DFHISP has failed
(F5) .... 1..1   XFRLNKCP "9" Special for CPSM only equ of XFRLNKSH.
(F5) .... 1...   XFRLNKSH "8" ALLOCATE IN ISP HAS FAILED BECAUSE THE LINK, THOUGH EXISTING, IS OUT OF SERVICE
(F5) .... .11.   XFRLNKNS "6" Type of request (either LINK or START CHANNEL) is not supported over LU6.1 connections
(F5) .... .1..   XFRLNKSY "4" ALLOCATE IN ISP HAS FAILED BECAUSE NAME IS NOT THAT OF TCTSE
(F6) CHARACTER 1 XFRCODE2 THE SECOND SET OF FLAGS - APPLY TO RETURN FROM TRANSFORMERS 2 AND 3 WITH VALUES SET AS FOLLOWS
(F6) .... .1..   XFR2TO3 "4" TRANSFORMER 2 HAS FOUND AN ERROR - CONTROL IS TO BE PASSED TO TRANSFORMER 3
(F6) .... 1...   XFRNEGR "8" TRANSFORMER 2 HAS FOUND AN ERROR - A NEGATIVE RESPONSE IS TO BE SENT
(F7) CHARACTER 1 XFRABCDE ABEND CODE INDICATOR PASSED BACK FROM THE TRANSFORMER TO THE BATCH CONTROLLER PROGRAM
(F8) ADDRESS 4 XFRRESR9 resumption base for DL/I function shipping
(FC) ADDRESS 4 XFRRESRE resumption address for DL/I function shipping
(100) ADDRESS 4 XFRBEGOP address of Arg0 options bytes
(104) FULLWORD 4 XFRARGS (0) ORIGIN FOR ARGUMENTS
(104) 1.11 11..   XFRLNGTH "*-XFRSTART" 
         TRANSFORMER'S RESOURCE TABLE
(108) DBL WORD 8 DRXSTRT (0) START OF DFHDRX
(108) FULLWORD 4 DRXSSASZ MAX SSA SIZE AS PERCEIVED BY THIS SYSTEM
(10C) CHARACTER 8 DRXRPSB NAME OF PSB TO BE USED ON REMOTE SYSTEM
(114) ADDRESS 4 DRXPCBAL A(LOCAL PCB ADDRESS LIST) THIS FIELD IS SET BY XFR4 DURING SCHEDULE CALL AND IS USED DURING DB CALLS
(118) ADDRESS 4 DRXCHAIN CHAIN OF STORAGE SEGMENTS OBTAINED BY TRANSFORMER 4
(11C) ADDRESS 4 DRXIOAWK A(READ SET BUFFER); BEFORE DRXBUFAL SET ON CONTAINS LENGTH FOR BUFFER
(120) HALFWORD 2 DRXINDEX THE PCB INDEX FOR THE CURRENT DATABASE CALL
(122) BITSTRING 1 DRXISC ISC FLAGS
(122) 1... ....   DRXPCBM "X'80'" PRESENT TO RETAIN SDB - DL/I SIMILARITY
(122) .1.. ....   DRXBUFAL "X'40'" READ-SET BUFFER HAS BEEN ALLOCATED; THE ADDRESS IS IN DRXIOAWK
(122) ..1. ....   DRXCHKP "X'20'" PCB SCHED. ISSUED DURING CHKP CALL; XFR4 SHOULD USE STG FOR OLD PCBS AND LIST
(123) BITSTRING 1 DRXISCO ISC OUTBOUND FLAGS
(123) 1... ....   DRXSYNC "X'80'" PRESENT TO RETAIN SDB - DL/I SIMILARITY
(123) .1.. ....   DRXHLPI "X'40'" HLPI COMMAND WITH SSA AND I/O LENGTHS GIVEN
(124) BITSTRING 1 DRXISCI ISC INBOUND FLAGS
(124) 1... ....   DRXFUNC "X'80'" FUNCTION STRING INVALID
(124) .1.. ....   DRXCALL "X'40'" USER CALL PARM LIST INVALID
(124) ..1. ....   DRXLNKNA "X'20'" LINK DOES NOT EXIST
(124) ...1 ....   DRXLNKSH "X'10'" LINK IS OUT OF SERVICE
(124) .... 1...   DRXNOSTT "X'08'" PRESENT TO RETAIN SDB - DL/I SIMILARITY
(125) BITSTRING 1 DRXFCTR RESPONSE BYTE FROM CICS SYSTEM CORRESP TO TCAFCTR (SET BY XFR4)
(126) BITSTRING 1 DRXDLTR RESPONSE BYTE FROM CICS SYSTEM CORRESP TO TCADLTR (SET BY XFR4)
(127) BITSTRING 1 DRXLANG LANGUAGE TYPE, USED BY XFR1 ON SCHEDULE CALL. IF PL/I THEN LEVEL OF INDIRECTION ADDED TO PCB LIST
(127) 11.. ...1   DRXASM "C'A'" ASSEMBLER
(127) 11.. ..11   DRXCOB "C'C'" COBOL
(127) 11.1 .111   DRXPLI "C'P'" PL/I
(128) BITSTRING 1 DRXFLG1 FLAG BYTE
(128) 1... ....   DRXCMPT "X'80'" COMPAT OPTION USED (HENCE A DUMMY PCB MUST BE ADDED TO LIST, AND TAKEN ACCOUNT OF IN DB CALL)
(128) .1.. ....   DRXSPIE "X'40'" TELL SPIE THAT IF PGM CHECK OCCURS, THEN INVOKE RETRY
(128) ..1. ....   DRXDPCB "X'20'" THE DUMMY PCB HAS YET TO BE CREATED BY TRANSFORMER 4
(12C) FULLWORD 4 DRXRETAD ADDRESS OF POINT IN TRANSFORMER TO WHICH RETRY ROUTINE SHOULD RETURN
(130) FULLWORD 4 DRXIOLEN I/O AREA LENGTH FOR HLPI COMMAND - VALID IF DRXHLPI IS SET
(134) CHARACTER 1 DRXATPN TYPE LAST ATTACH HEADER LAST SENT. THERE IS PROBABLY A BETTER PLACE TO HOLD THIS. ONLINE THE INFO IS HELD IN THE TCTTE
(135) CHARACTER 6 DRXRCODE (0) RETURN CODE FROM AN EXEC CICS REQUEST
(135) CHARACTER 1 DRXRCDE1 RESPONSE CODE
(136) CHARACTER 1 DRXRCDE2 RESERVED
(137) CHARACTER 1 DRXRCDE3 RESERVED
(138) CHARACTER 1 DRXRCDE4 RESERVED
(139) CHARACTER 1 DRXRCDE5 RESERVED
(13A) CHARACTER 1 DRXRCDE6 RESERVED
(13A) ..11 ..11   DRXLEN "*-DRXSTRT" LENGTH OF DFHDRX
(13C) ADDRESS 4 RSBEXPRM ADDR OF EDP'S DBLWD FOR LOCATE MODE RETRIEVAL
(13C) 0 RSBLEN "*-RSBSTART" LENGTH OF RSB