{"id":176,"date":"2023-07-18T03:09:04","date_gmt":"2023-07-18T03:09:04","guid":{"rendered":"https:\/\/www-c.covariant-systems.com\/?page_id=176"},"modified":"2023-07-18T03:09:04","modified_gmt":"2023-07-18T03:09:04","slug":"asmada9","status":"publish","type":"page","link":"https:\/\/www-c.covariant-systems.com\/?page_id=176","title":{"rendered":"ASMADA9"},"content":{"rendered":"\n<pre class=\"wp-block-code\"><code>        TITLE 'ASMADA9 - READ ADABAS DATA WITH MULTIFETCH'\n**********************************************************************\n*                                                                     *\n*  Description  : Reads ADABAS data using multifetch feature          *\n*                                                                     *\n*                 Version 8 ACBX and link routine                     *\n*                 (uses the V8 APLX, ACBX and ABDs)                   *\n*                                                                     *\n*  Note           ADABDX macro is enhanced version of the one         *\n*                 supplied by Software AG. It includes a macro        *\n*                 macro parameter TYPE=&lt;buffer_type|EQ&gt;               *\n*                                                                     *\n***********************************************************************\n*                                                                     *\n*  RETURN CODES:                                                      *\n*                                                                     *\n*          0   - SUCCESSFUL                                           *\n*          4   - WARNING                                              *\n*          8   - ERROR                                                *\n*         12   - SERIOUS ERROR                                        *\n*         16   - CATASTROPHIC FAILURE                                 *\n*                                                                     *\n***********************************************************************\n         IHASAVER DSECT=YES,SAVER=YES,SAVF4SA=YES,SAVF5SA=YES,TITLE=NO\n*\n         ADACBX DSECT=YES\n*\n         ADABDX TYPE=EQ\n*\n         ADABDX TYPE=FB\n         ADABDX TYPE=RB\n         ADABDX TYPE=SB\n         ADABDX TYPE=VB\n         ADABDX TYPE=IB\n         ADABDX TYPE=MB\n*\nMBDSECT  DSECT                    Multifetch segment as found in MBAREA\nMBRECL   DS    F\nMBRESP   DS    F\nMBISN    DS    F\nMBISNQ   DS    F\n*\nWORKAREA DSECT\n         ds    Xl(SAVF4SA_LEN)\n*\nWKSAVSUB DS  18fd                 Internal routine register save area\n*\nWKTIMWRK DS   0XL16\nWKDBLWRK DS    D                  Doubleword work area\nWKDBLWK  DS    D                  Doubleword work area\n*\nWKPRINT  DS    XL131              Print line\nWKTRACE  DS    CL1                Tracing\n         DS   0F\nWKREENT  DS    XL256              Reentrant workarea\n*\nWKEOF    DS    CL1\n         DS    XL1\n         DS    H\n*\n         DS    0F\nOUTDCB   DS    XL(outfilel)       Reentrant DCB and DCBE areas\n*\nWKWTOPRM WTO   TEXT=(R2),MF=L\nWKWTOLEN EQU   *-WKWTOPRM\n*\nADAPAL   DS   0F\n         DS  11F\n*\nLINKWORK DS    XL256              Workarea for ADABAS link routine\nAPLXLINK DS    F                  Reentrancy token\nWKCID    DS   0F                  Adabas command ID\nWKCID1   DS    X\nWKCID23  DS    XL2\nWKCID4   DS    X\nWKAADA   DS    F\nWKRETC   DS    F\nWKRECNUM DS    F\nWKRECCNT DS    F\nWKBUFCNT DS    F\nWKDBLWK2 DS    XL08               Doubleword work area\n*\nCB       DS    XL(ACBXQLL)\n*\nFB       DS    XL(FBDXQLL)\n         DS    CL56\n*\nSB       DS    XL(SBDXQLL)\n         DS    CL56\n*\nVB       DS    XL(VBDXQLL)\n         DS    CL56\n*\nIB       DS    XL(IBDXQLL)\n         DS    XL100\n*\nMB       DS    XL(MBDXQLL)\nMBCOUNT  DS    F\nMBAREA   DS (NREC)CL(MISN)        100 * 16 byte ISN areas\n*\nRB       DS    XL(RBDXQLL)\nRBAREA   DS (NREC)CL(LREC)        100 * 96 byte records\n*\nWORKLEN  EQU   (*-WORKAREA)\n*\nLREC     EQU   68                 LENGTH OF FIELDS IN RECORD\nNREC     EQU   100                NUMBER OF RECORDS PER CALL\nMISN     EQU   16                 LENGTH OF MULTIFETCH SEGMENTS IN MB\n*\n         print off\n         SYSSTATE ARCHLVL=2\n         COPY  ASMMSP\nLEAVE    OPSYN ASM_LEAVE\n         asmmrel on\n         print on\n*\n*\n***********************************************************************\n*                                                                     *\n*        REGISTER EQUATES:                                            *\n*                                                                     *\n***********************************************************************\n*\n         YREGS\n*\n         PRINT nogen\n*\nASMADA   RMODE 24\nASMADA   AMODE 31\nASMADA   CSECT\n         J     CODE\n         DC    CL8'ASMADA',CL8'&amp;SYSDATC',CL6'&amp;SYSTIME'\n*\nstatic   loctr            set up the static loctr\ncode     loctr            followed by the code loctr\n*\n         using savf4sa,r13        Map the save area\n         stm   R14,R12,12(R13)\n*\n         llgtr R12,r15            Base (static loctr)\n         USING (ASMADA,code),R12\n*\n         lghi  R0,WORKLEN+16      Work area size\n         STORAGE OBTAIN,LENGTH=(0),LOC=24,CHECKZERO=YES GET WORKAREA\n         cije  r15,14,a0002       If already zeroed, bypass this...\n         lr  r10,r1               Hold address\n         lr  R0,R1                Zero work area\n         lghi R1,WORKLEN+16\n         xr  R14,R14\n         xr  R15,R15\n         MVCL R0,R14\n         lr  r1,r10               Restore pointer\n*\nA0002    EQU    *\n         MVC   0(8,R1),=CL8'ASMADAME' spycatcher in memory\n         MVC   8(8,R1),=CL8'&amp;SYSDATC' assembly date\n         ahi   r1,16              Move pointer past\n         drop  r13\n         USING WORKAREA,R1\n         using savf4sa,ASMADA\n         llgtr r13,r13\n         stg   r13,savf4saprev    save current r13\n         mvc   savf4said(4),=a(savf4said_value) set 'F4SA' in area\n         llgtr R13,r1             Get new workarea into r13\n         J     MAINLINE           BEGIN\n*\n*\nCHAIN    ds    0h\n         stg   r13,savf4saprev    save current r13\n         llgtr R13,r1             Get new workarea into r13\n         drop  r1\n         using WORKAREA,r13\n         using savf4sa,ASMADA\n*\n***********************************************************************\nMAINLINE DS    0H\n***********************************************************************\n         XC    WKRETC,WKRETC\n*\n***********************************************************************\n*  OPEN MESSAGE FILE                                                  *\n***********************************************************************\n*      open message file\n         LA    R14,outfile               MODEL DCB\nd1       using ihadcb,outdcb\n         MVC   outdcb(outfilel),0(R14)\n         lay   R0,outdcb                 DCBE ADDRESS\n         aghi  R0,outfile0\n         sty   R0,d1.DCBDCBE\n*\n         LAY   R2,OUTDCB\n         MVC   WKREENT(8),OPENPARM\n         OPEN  ((R2),(OUTPUT)),MODE=31,MF=(E,WKREENT)\n*                                                                \u00d0I1015\n*\n         USING ADACBX,CB\n         USING FBBDX,FB\n         USING RBBDX,RB\n         USING SBBDX,SB\n         USING VBBDX,VB\n         USING IBBDX,IB\n         USING MBBDX,MB\n*\n         LAY   R3,CB\n         LAY   R4,FB\n         LAY   R5,RB\n         LAY   R6,SB\n         LAY   R7,VB\n         LAY   R8,IB\n         LAY   R9,MB\n*                                                                \u00d0I1015\n         ST    R3,ADAPAL+00\n         LA    R0,APLXLINK\n         ST    R0,ADAPAL+04\n         LA    R0,LINKWORK\n         ST    R0,ADAPAL+08\n         STM   R4,R9,ADAPAL+12            ADABAS PARAMETER LIST\n         OI    ADAPAL+32,X'80'\n*\n*\n         LOAD  EPLOC=LINKNAME,ERRET=A0010\n         OILH  R0,MODE31\n         ST    R0,WKAADA\n         J     A0011\nA0010    EQU   *\n         WTO 'ASMADA8: ADABAS LINK MODULE NOT LOADED'\n         MVC   WKRETC,=F'16'\n         J     RETURNX\nA0011    EQU   *\n*\n*\n         MVI   ACBXVERT,ACBXVERE\n         MVI   ACBXVERN,ACBXVERC\n         MVC   ACBXLEN,=Y(ACBXQLL)\n         MVC   ACBXDBID,DBID300\n         MVC   ACBXFNR,FNR0002\n*\n         MVI   WKCID1,C'F'\n         MVC   WKCID23,=X'0001'\n         MVI   WKCID4,C'S'\n*\n         MVI   FBDXLOC,C' '\n         MVC   FBDXLEN,=Y(FBDXQLL)\n         MVI   FBDXVERT,ABDXVERE\n         MVI   FBDXVERN,ABDXVERC\n         MVI   FBDXID,ABDXQFB\n         MVC   FBDXSIZE+4(4),=F'56'\n*\n         MVI   RBDXLOC,C' '\n         MVC   RBDXLEN,=Y(RBDXQLL)\n         MVI   RBDXVERT,ABDXVERE\n         MVI   RBDXVERN,ABDXVERC\n         MVI   RBDXID,ABDXQRB\n         MVC   RBDXSIZE+4(4),=A(LREC*NREC)\n*\n         MVI   MBDXLOC,C' '\n         MVC   MBDXLEN,=Y(MBDXQLL)\n         MVI   MBDXVERT,ABDXVERE\n         MVI   MBDXVERN,ABDXVERC\n         MVI   MBDXID,ABDXQMB\n         MVC   MBDXSIZE+4(4),=A(4+MISN*NREC)  ISN QTY THEN MISN AREA\n*\n         MVI   SBDXLOC,C' '\n         MVC   SBDXLEN,=Y(SBDXQLL)\n         MVI   SBDXVERT,ABDXVERE\n         MVI   SBDXVERN,ABDXVERC\n         MVI   SBDXID,ABDXQSB\n         MVC   SBDXSIZE+4(4),=F'56'\n*\n         MVI   VBDXLOC,C' '\n         MVC   VBDXLEN,=Y(VBDXQLL)\n         MVI   VBDXVERT,ABDXVERE\n         MVI   VBDXVERN,ABDXVERC\n         MVI   VBDXID,ABDXQVB\n         MVC   VBDXSIZE+4(4),=F'56'\n*\n         MVI   IBDXLOC,C' '\n         MVC   IBDXLEN,=Y(IBDXQLL)\n         MVI   IBDXVERT,ABDXVERE\n         MVI   IBDXVERN,ABDXVERC\n         MVI   IBDXID,ABDXQIB\n         MVC   IBDXSIZE+4(4),=F'100'\n*\n*\n         MVC   ACBXCMD,=CL2'OP'\n         MVC   ACBXCID,WKCID\n         MVC   ACBXADD3,SPACES\n         MVC   ACBXADD4,SPACES\n         MVC   ACBXADD5,SPACES\n         MVC   RBDXDATA(06),=CL6'ACC=2.'\n         MVC   RBDXSEND+4(4),=F'6'\n         LA    R1,ADAPAL\n         L     R15,WKAADA\n         BASR  R14,R15\n         CLC   ACBXRSP,=H'0'\n         JE    A0012\n*\n         MVC   WKPRINT(131),=CL131'ASMADA: Open Error xxxx\/xxxx'\n         LH    R15,ACBXRSP\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+19(4),NUMMSK+8\n         MVI   WKPRINT+19,C' '\n         ED    WKPRINT+19(4),WKDBLWK2+6\n         LH    R15,ACBXERRC\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+24(4),NUMMSK+8\n         MVI   WKPRINT+24,C' '\n         ED    WKPRINT+24(4),WKDBLWK2+6\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n         MVC   WKRETC,=F'8'\n         J     RETURNX\n*\nA0012    EQU   *\n         MVC   WKPRINT(131),=CL131'ASMADA: OPEN DONE'\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n*\n         MVC   ACBXCMD,=CL2'L3'\n         MVI   ACBXCOP1,C'M'\n         MVI   ACBXCOP2,C'V'\n         MVC   ACBXADD1,=CL8'AA      '\n         XC    ACBXISN,ACBXISN\n         XC    ACBXISL,ACBXISL\n         XC    ACBXISQ,ACBXISQ\n*\n         MVC   FBDXDATA(12),=CL12'AA,AC,AD,AE.'\n         MVC   FBDXSEND+4(4),=F'12'\n*\n         XC    RBDXSEND,RBDXSEND\n         MVC   RBDXRECV+4(4),=A(LREC*NREC)\n*\n         XC    MBDXSEND,MBDXSEND\n         MVC   MBDXRECV+4(4),=A(4+MISN*NREC)\n*\n         MVC   SBDXDATA(03),=CL3'AA.'\n         MVC   SBDXSEND+4(4),=F'3'\n*\n         MVC   VBDXDATA(08),=CL8'00000000'\n         MVC   VBDXSEND+4(4),=F'8'\n*\nA0013    EQU   *\n         LA    R1,ADAPAL\n         L     R15,WKAADA\n         BASR  R14,R15\n         CLC   ACBXRSP,=H'0'\n         JE    A0014\n         CLC   ACBXRSP,=H'3'\n         JE    A0015\n*\n         MVC   WKPRINT(131),=CL131'ASMADA: Read Error xxxx\/xxxx'\n         LH    R15,ACBXRSP\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+19(4),NUMMSK+8\n         MVI   WKPRINT+19,C' '\n         ED    WKPRINT+19(4),WKDBLWK2+6\n         LH    R15,ACBXERRC\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+24(4),NUMMSK+8\n         MVI   WKPRINT+24,C' '\n         ED    WKPRINT+24(4),WKDBLWK2+6\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n         MVC   WKRETC,=F'8'\n         J     RETURNX\n*\nA0014    EQU   *\n         ASI   WKBUFCNT,1\n         MVC   WKPRINT(131),=CL131'ASMADA: READ DONE '\n         XC    WKRECNUM,WKRECNUM\n         USING MBDSECT,R10\n         LAY   R10,MBAREA\n         LAY   R11,RBAREA\nA001400  EQU   *\n         CLC   MBRESP,=F'0'\n         JE    A001402\n         CLC   MBRESP,=F'3'\n         JE    A0015\n*\n         MVC   WKPRINT(131),=CL131'ASMADA: Read Error xxxx\/xxxx (multife+\n               tch)'\n         LH    R15,ACBXRSP\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+19(4),NUMMSK+8\n         MVI   WKPRINT+19,C' '\n         ED    WKPRINT+19(4),WKDBLWK2+6\n         LH    R15,ACBXERRC\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+24(4),NUMMSK+8\n         MVI   WKPRINT+24,C' '\n         ED    WKPRINT+24(4),WKDBLWK2+6\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n         MVC   WKRETC,=F'8'\n         J     RETURNX\n*\nA001402  EQU   *\n         MVC   WKPRINT+18(LREC),0(R11)\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n         LA    R10,16(,R10)\n         LA    R11,LREC(,R11)\n         ASI   WKRECNUM,1\n         CLC   WKRECNUM,MBCOUNT\n         JL    A001400\n         L     R0,WKRECCNT\n         A     R0,WKRECNUM\n         ST    R0,WKRECCNT\n         J     A0013\n*\nA0015    EQU   *\n         L     R0,WKRECCNT\n         A     R0,WKRECNUM\n         ST    R0,WKRECCNT\n*\n         MVC   WKPRINT(131),=CL131'ASMADA: END OF DATA'\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n*\n         MVC   ACBXCMD,=CL2'CL'\n         XC    FBDXSEND,FBDXSEND\n         XC    RBDXSEND,RBDXSEND\n         XC    SBDXSEND,SBDXSEND\n         XC    VBDXSEND,VBDXSEND\n         XC    RBDXRECV,RBDXRECV\n         LA    R1,ADAPAL\n         L     R15,WKAADA\n         BASR  R14,R15\n         CLC   ACBXRSP,=H'0'\n         JE    A0016\n         CLC   ACBXRSP,=H'3'\n         JE    A0015\n*\n         MVC   WKPRINT(131),=CL131'ASMADA: Close Error xxxx\/xxxx'\n         LH    R15,ACBXRSP\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+20(4),NUMMSK+8\n         MVI   WKPRINT+20,C' '\n         ED    WKPRINT+20,WKDBLWK2+6\n         LH    R15,ACBXERRC\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+25(4),NUMMSK+8\n         MVI   WKPRINT+25,C' '\n         ED    WKPRINT+25(4),WKDBLWK2+6\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n         MVC   WKRETC,=F'4'\n         J     RETURNX\n*\nA0016    EQU   *\n         MVC   WKPRINT(131),=CL131'ASMADA: CLOSE DONE'\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n*\n         MVC   WKPRINT,SPACES\n         MVC   WKPRINT(131),=CL131'ASMADA9: Records read: '\n         L     R15,WKRECCNT\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+23(7),NUMMSK+5\n         MVI   WKPRINT+23,C' '\n         ED    WKPRINT+23(7),WKDBLWK2+5\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n         MVC   WKPRINT,SPACES\n         MVC   WKPRINT(131),=CL131'ASMADA9: Using L3 commands: '\n         L     R15,WKBUFCNT\n         CVD   R15,WKDBLWK2\n         MVC   WKPRINT+28(7),NUMMSK+5\n         MVI   WKPRINT+28,C' '\n         ED    WKPRINT+28(7),WKDBLWK2+5\n         LA    R2,OUTDCB\n         LA    R0,WKPRINT\n         PUT   (R2),(R0)\n*\n*\nRETURNX  DS    0H\n         LLGT  R15,WKRETC\n*\n         lg    r13,savf4saprev         restore caller save area\n         st    r15,16(,r13)\n         lm    r14,r12,12(r13)         restore caller's registers\n         BR    R14              RETURN\n*\nSTATIC   LOCTR\n*\n* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n*                                                                     *\n*        C O N S T A N T S                                            *\n*                                                                     *\n* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n*\nSTATIC   LOCTR\n         DS   0D\nMODE31   equ   X'8000'\n         DS   0D\nOPENPARM DC    XL8'8000000000000000'\n*\nDBID300  DC    F'300'\nFNR0002  DC    F'2'\nLINKNAME DC    CL8'ADAUSER'\nNUMMSK   DC    XL12'402020202020202020202021'\nSPACES   DC    CL256' '\nHIVAL    DC  256X'FF'\n*\n* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n*                                                                     *\n*        D A T A   C O N T R O L   B L O C K S                        *\n*                                                                     *\n* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n*\noutfile  DCB   DSORG=PS,DDNAME=DDODATA,MACRF=(PM),DCBE=outfdcbe,       x\n               RECFM=FB,LRECL=131\noutfile0 EQU   *-outfile\noutfdcbe DCBE  RMODE31=BUFF\noutfilel EQU   *-outfile\n*\n         LTORG ,\n         DS   0F\n         DCBD  DSORG=PS\n*\n         IHADCBE\n         END\n\u001a<\/code><\/pre>\n","protected":false},"excerpt":{"rendered":"","protected":false},"author":2,"featured_media":0,"parent":0,"menu_order":0,"comment_status":"closed","ping_status":"closed","template":"","meta":{"footnotes":""},"class_list":["post-176","page","type-page","status-publish","hentry"],"_links":{"self":[{"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/pages\/176","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/pages"}],"about":[{"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/types\/page"}],"author":[{"embeddable":true,"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=176"}],"version-history":[{"count":2,"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/pages\/176\/revisions"}],"predecessor-version":[{"id":182,"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=\/wp\/v2\/pages\/176\/revisions\/182"}],"wp:attachment":[{"href":"https:\/\/www-c.covariant-systems.com\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=176"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}