Yrecasy

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Zur Navigation springen Zur Suche springen

<syntaxhighlight lang="asm">

YRECASY CSECT RESIDENT

  • *
  • COPYRIGHT (C) SIEMENS AG 1988 *
  • COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG 1991 *
  • ALL RIGHTS RESERVED *
  • * 
        PRINT NOGEN,BASE
  • RELM AUF ADDR0 UEBERPRUEFEN
    • V3.0AK4
  • CDUMP USFREE ENTFERNT
    • V3.0A00
  • RELM AUF 9 SEITEN AENDERN WEGEN SAP 8-K NACHRICHTEN. SIEHE MCP002.
    • V2.1B10
  • ----------------------------------------------------------------------*
        • INIT REGISTERS ****
  • ----------------------------------------------------------------------*
        SPACE

R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15

  • ---------------------------------------------------------------------*
        GPARMOD 31

YRECASY AMODE ANY YRECASY RMODE ANY

    1. BAL OPSYN ##BAS
    2. BALR OPSYN ##BASR
  • ---------------------------------------------------------------------*
  • E X T R N S *
  • ---------------------------------------------------------------------*
        EXTRN TERMOUTA
        EXTRN UDIATBA
        EXTRN DIATABE
        EXTRN FCBSEQ
        EXTRN DIATABA
        EXTRN STATANFA
        EXTRN STATENDA
        EXTRN KMASKANF
        EXTRN DIATABA
        EXTRN Z2
        EXTRN Z3
        EXTRN Z4
        EXTRN Z5
  • ---------------------------------------------------------------------*
        TITLE 'Y R E C A S Y   / ASYN REC VON PARTNER/$DIALOG'

YRANF BASR R8,0 

        BCTR  R8,0
        BCTR  R8,0
        LR    R5,R1           R1  COMAD =RPBADRESS
  • R3 EIDREF = USPID/STATTID
        USING YRANF,R8,R9,R10,R11
        LA    R1,4095
        LA    R9,1(R8,R1)
        LA    R10,1(R9,R1)
        LA    R11,1(R10,R1)
        USING STATEIN,R3
        USING USEREIN,R4
    • CYRE ** DIAG-TAB *DIA
        L     R12,=A(DIATABA)
        USING DIATABA,R12
        L     R14,DIATABA                             *DIA
        MVC   0(4,R14),=CL4'CYRE'                     *DIA
        BAS   R13,YUPDIAUP                            *DIA
    • **
        ST    R3,MVCFYR
        MVI   MVCFYR,X'00'
        ST    R5,RPBAYR
        YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=FDBKYR,LENGTH=4,           -
              FIELDS=(FDBK)
        L     R15,FDBKYR
        CLM   R15,B'1000',=X'00'
        BE    W1     
        CLM   R15,B'1000',=X'08'
        BNE   FDBKN08
        CLM   R15,B'0100',=X'40'  * SOFERN ANW.ZUST FALSCH Z.B YCLOSE
        BL    W7                  * SOFORT AUF RETCO

FDBKN08 EQU * 

        MVC   YERRTEXT,=CL20'A/YREC/FDBK'
        BAS   R14,YFEHLER
        L     R15,FDBKYR               * FBK WIRD NEU GELADEN SONST
  • FOLGENDE ABFRGAE FALSCH
        CLM   R15,B'1010',=X'0410'     * SOFERN TOVAL ABGE
        BE    W2                       * WIRD NEUER YREC ABGESETZT
        B     W7                       * SONST RETCO

W1 YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=MVCFYR,LENGTH=4, - 

              FIELDS=(USER)
        CLM   R15,B'1001',=X'0000'
        BE    W2     
        MVC   YERRTEXT,=CL20'A/YREC/USER'
        BAS   R14,YFEHLER

W2 EQU * W3 XR R5,R5 

        XR    R6,R6
        LH    R5,MVCFYR+2        (STATTID)
        LH    R6,MVCFYR          (USPID)
        L     R12,=A(STATANFA)
        USING STATANFA,R12
        L     R3,STATANFA
        L     R12,=A(STATENDA)
        USING STATENDA,R12
        L     R4,STATENDA

YRELOOP EQU *

  • A R3,=A(X'100')
        LA    R3,256(R3)        + X'100'
        CLM   R5,B'0011',STATTID
        BE    YREGOT
        CR    R3,R4
        BL    YRELOOP
        RETCO

YREGOT EQU * 

        L     R4,USERPAGA
        L     R5,USERPAGE

YREPOP EQU *

  • A R4,=A(X'100')
        LA    R4,256(R4)         + X'100'
        CLM   R6,B'0011',USPID
        BE    YRTOP
        CR    R4,R5
        BL    YREPOP
        RETCO

YRTOP EQU *

  • SOFERN DAVOR KEINE ORDENTLICH MELDUNG (D.H USFREE <> : ODER Y)
  • WIRD YRECASY VERWORFEN
        CLI   USFREE,C':'
        BE    C777
        CLI   USFREE,C'Y'
        BE    C777
        MVC   YERRTEXT,=CL20'A/YREC/USFRE'
        MVC   YERRTEX1(8),STATPNA        EINTRAG STATION BEI ERR
        MVC   YERRTEX1+10(8),USPRO           "   PROZ.    "   "
        MVC   YERRTEX1+20(8),USPNA            "   ANWEND   "   "
        MVC   YERRTEX1+30(1),USFREE           "   BELEGUNG "
  • CDUMP
        BAS   R14,YFEHLER       ^ DYN.DUMP BEI NACHR.+FREIG.
        RETCO

C777 CLC FDBKYR,=X'04001000' * SOFERN TOVAL ABGE 

        BE    YRNOS                     SETZE NEUEN YREC AB
        L     R5,USRPBA
        YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=YRLEN,LENGTH=4,            -
              FIELDS=(ARECLN)
        CLM   R15,B'1000',=X'00'
        BE    W4      
        MVC   YERRTEXT,=CL20'A/YREC/ARECLN'
        BAS   R14,YFEHLER

W4 EQU * 

        L     R2,USIN
        MVC   USNEA,0(R2)
        MVC   USLEN,YRLEN
        MVC   YREEI,USEI
        MVC   YRECO,USCO
        MVC   USRC,=F'0'
        MVC   USERROR,=CL15'RECEIVE   '
        MVI   USFREE,C':'
        L     R2,STAIDCP
        L     R6,STATCID
        L     R7,YRLEN
        L     R14,USIN
        CLI   FDBKYR,X'00'           * SOFERN FDBKYR IO 
        BE    YRW0                      LETS GO !
        MVC   USERROR,=CL15'RECEIVE ERROR'
        MVI   USFREE,C'F'
        MVC   USRC,FDBKYR
        L     R7,USAID
        YCLOSE AID=(R7)
        CLM   R15,B'1001',=X'0000'
        BE    W202
        MVC   YERRTEXT,=CL20'A/YREC/YCLOSE'
        BAS   R14,YFEHLER

W202 EQU * 

        LA    R7,USEI
        DISEI EIID=(R7)
        LA    R7,USCO
        DISCO COID=(R7)
        L     R7,USIN
  • CLI STATSTOP,X'FF' WARTEN AUF GO-SIGNAL IN CPBUFH ??
  • BNE CCNGO
  • CLC STASTPID(2),USPID MIT DIESEM PID ???
  • BE A01 DANN DARF NICHT FREIGEGEBEN WERDEN
  • CCNGO EQU *
  • TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
        SRA   R7,12
  • LTR R7,R7
  • BNZ NODUMP7
  • TERM DUMP=Y,MODE=ABNORMAL
  • NODUMP7 EQU *
        LTR   R7,R7
        BNZ   YRELM1
        XR    R15,R15
        MVC   YERRTEXT,=CL20'A/YREC/RELM/0'
        BAS   R14,YFEHLER
        B     A01

YRELM1 EQU * 

        RELM  9,(R7)
        CLM   R15,B'0001',=X'00'
  • CMD '/D %7' REQM TRACE
        BE    A01
        MVC   YERRTEXT,=CL20'A/YREC/RELM'
        BAS   R14,YFEHLER

A01 EQU * 

        L     R12,=A(TERMOUTA)
        USING TERMOUTA,R12
        L     R15,TERMOUTA
        L     R14,=F'38'
        L     R12,=A(KMASKANF)
        USING KMASKANF,R12
        MVC   0(38,R15),KMASKANF
  • A R15,=F'38'
        LA    R15,38(R15)        + 38
        L     R12,=A(Z2)
        USING Z2,R12
        MVI   Z2,X'FF'
        L     R12,=A(Z3)
        USING Z3,R12
        MVI   Z3,X'FF'
        L     R12,=A(Z4)
        USING Z4,R12
        MVI   Z4,X'FF'
        L     R12,=A(Z5)
        USING Z5,R12
        MVI   Z5,X'FF'
        BAS   R13,YKMASKE
        B     W7

YRW0 EQU *

  • SPRUNG MIT RESON = 1 (FUER ASY REC)
  • TRACE *********************

TRACE1 B TRACE1E B / NOP 

        MVC   TRBOUT(4),=C'IN :'
        L     R2,USIN
        BAS   R14,YTRACOUT

TRACE1E EQU * 

        CNOP  0,4
        ENTRY TRACE1
  • TRACE *********************
        MVC   USRES,=F'1'
        ST    R15,YR15SAV
    • UBUF ** DIAG-TAB *DIA
        L     R12,=A(DIATABA)
        USING DIATABA,R12
        L     R14,DIATABA                             *DIA
        MVC   0(4,R14),=CL4'UBUF'                     *DIA
        BAS   R13,YUPDIAUP                            *DIA
    • **
        L     R15,YCPBUFHA
        BASR  R14,R15
        L     R15,YR15SAV
        B     YRNOS
        DS    0F

YR15SAV DS F YCPBUFHA DC V(CPBUFH)

    • ---------------------------- AB INS MOD
    • ---------------------------- AB INS MOD

YRNOS EQU * 

        L     R2,USIN
        L     R5,USRPBA
        LA    R6,USEI
        L     R7,USAID
        L     R14,USCID
        CLC   USSEQ,=C'0000'
        BE    C300 
        CLC   USTYP,=C'UCON'    
        BE    C120
        CLC   USTYP,=C'U/D '
        BE    C100
        CLC   USTYP,=C'PDN '             ** CATS
        BE    C100
        CLI   USNEA,X'33'
        BE    C100
        CLI   USNEA,X'37'
        BE    C100
        B     C300

C100 MVC SEKEY(4),USSEQ 

        MVC   SEKEY+4(4),USKEY1
        L     R12,=A(FCBSEQ)
        USING FCBSEQ,R12
        GETKY FCBSEQ,SEDAT
        GET   FCBSEQ,SEDAT
        CLC   USSEQ(4),SEKEY
        BNE   C200
        MVC   USKEY1,SEKEY+4
        MVC   SENDCMD,USNEA
        MVC   SENDCMD1,SECMD
        XI    SENDCMD,X'20'
        XR    R13,R13
        LH    R13,=H'7'
        AH    R13,SELEN
        CLI   SENDCMD,X'00'
        BE    C101
        CLI   SENDCMD,X'01'
        BE    C101
        CLI   SENDCMD,X'11'
        BE    C101
        CLI   SENDCMD,X'13'
        BE    C101
        CLI   SENDCMD,X'15'
        BE    C101
        CLI   SENDCMD,X'17'
        BE    C101
  • CLI SENDCMD,X'16'
  • AUF USER WRITE X'36' WIRD MIT X'41' GEANTWORT (GEN BEI DCAM)
  • BNE C101
        MVI   SENDCMD,X'41'

C101 L R14,USCID 

        YSEND RPB=(R5),AREA=SENDCMD,AREALN=(R13),AID=(R7),CID=(R14)
        CLM   R15,B'1001',=X'0000'
        BNE   C900
  • USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
        MVI   USNEA,X'36'

        B     C300

C900 MVC YERRTEXT,=CL20'A/YREC/YSEN/SEQ' 

        BAS   R14,YFEHLER
        B     C200

C120 MVC SEKEY(4),USSEQ 

        MVC   SEKEY+4(4),USKEY1
        L     R12,=A(FCBSEQ)
        USING FCBSEQ,R12
        GETKY FCBSEQ,SEDAT
        GET   FCBSEQ,SEDAT
        CLC   USSEQ(4),SEKEY
        BNE   C200
        MVC   USKEY1,SEKEY+4
        MVC   SENDCMD1,SECMD
        XR    R13,R13
        LH    R13,SELEN
        SH    R13,=H'12'

C121 L R14,USCID 

        YSEND RPB=(R5),AREA=SENDCMD1,AREALN=(R13),AID=(R7),CID=(R14)
        CLM   R15,B'1001',=X'0000'
        BE    C300
        MVC   YERRTEXT,=CL20'A/YREC/YSEN/SEQ/UC'
        BAS   R14,YFEHLER
        B     C200

C200 MVC USSEQ,=C'0000'  !!!!!!!!!!!!!!!! 

        MVC   USKEY1,=C'0000'

        ENTRY C200    MCP002  !!!!!!!!!!!!!

C300 EQU * 

        L     R14,USCID
        YRECEIVE RPB=(R5),AAREA=(R2),EID=(R6),AID=(R7),CID=(R14)
        CLM   R15,B'1000',=X'00'
        BE    W6
        MVC   YERRTEXT,=CL20'A/YREC/YREC'
        BAS   R14,YFEHLER

W6 LA R7,USCO 

        SOLSIG EIID=(R6),COID=(R7),LIFETIM=43200
        CLM   R15,B'1001',=X'0000'
        BE    W7
        MVC   YERRTEXT,=CL20'A/YREC/SOLS'
        BAS   R14,YFEHLER

W7 RETCO 

        SPACE
  • --------------------------------- FEHLER ------------------------*

YFEHLER EQU * 

        ST    14,YBRBACK
        ST    15,YERR15
        UNPK  YERRR15,YERR15(5)
        TR    YERRR15,YHX-240
        WROUT YERRMSG,YTERME
        MVC   YERRTEX1,=CL32' '              FELD LOESCHEN
  • BEI TOVAL ABGELAUFEN (CIRKA ALLE 6 STUNDEN)
  • WIRD KEINE FM AUSGEGEBEN
        CLC   YERR15,=X'04001000'
        BE    YTERME
        CLC   YERR15,=X'10040800'
        BNE   YTERME
        PASS
        PASS
        PASS
        PASS
        MVC   YERRTEXT,=CL20'WAIT '
        WROUT YERRMSG,YTERME

YTERME L R14,YBRBACK 

        BR    R14
  • ------------------ EINTRAG IN DIAG-TAB ----------------------------*

YUPDIAUP EQU * 

        LA    R14,4(R14)
        STM   0,15,0(R14)      REGISTER VOR UP-AUFRUF (NUR 64 BYTE!!)
        LA    R14,68(R14)               LEN 68 BYTES  *DIA
        L     R12,=A(DIATABE)
        CL    R14,0(R12)
        BL    YUPDIAUE
        L     R12,=A(UDIATBA)
        L     R14,0(R12)       TABANFANG

YUPDIAUE EQU * 

        L     R12,=A(DIATABA)  AKT. POINTER DIAGTAB
        ST    R14,0(R12)       WRAP AROUND IN DIAG-TAB
        MVC   0(4,R14),=C'EEEE'    EEEE NACH LETZTEM EINTRAG
        BR    R13
        DROP  R12
  • --------------------------------- KMASKE ------------------------*
        DC    3A(0)

YKMASKE EQU * 

        ST    R13,YKMASKE-4    SAVEN
        ST    R7,YKMASKE-8
        ST    R2,YKMASKE-12
        L     R13,YKMASKA
        BASR  R7,R13
        LTR   R15,R15   <> 0       FEHLER GES. IN MODUL CPKMASK??
        BZ    YKMASKEE
        BAS   R14,YFEHLER

YKMASKEE L R13,YKMASKE-4 

        L     R7,YKMASKE-8
        L     R2,YKMASKE-12
        BR    R13
        DS    0F
  • ---------------------------------- TRACE ------------------------*

YTRACOUT EQU * 

        ST    14,YTRACOUT-4
        GDATE TOD=TRTIM
        MVC   TRBOUT+4(8),TRTIM
        MVC   TRBOUT+12(1),=C':'
        MVC   TRBOUT+13(4),USPAC
        MVC   TRBOUT+17(1),=C':'
        MVC   TRBOUT+18(8),USCPNAME
        MVC   TRBOUT+26(1),=C':'

        UNPK  TRCH(15),0(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+27(14),TRCH
        UNPK  TRCH(15),7(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+41(14),TRCH
        UNPK  TRCH(15),14(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+55(14),TRCH
        UNPK  TRCH(15),21(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+69(14),TRCH
        UNPK  TRCH(15),28(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+83(14),TRCH
        UNPK  TRCH(15),35(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+97(14),TRCH
        UNPK  TRCH(15),42(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+111(14),TRCH
        UNPK  TRCH(15),49(8,R2)
        TR    TRCH,TRCTAB-240
        MVC   TRBOUT+125(14),TRCH
        MVC   TRBOUT+139(1),=C':'
        MVC   TRBOUT+140(56),0(R2)
        WRLST TRBOUTL,YTRACEE

YTRACEE L R14,YTRACOUT-4 

        BR    R14
        SPACE
  • -------------------------------------------------------------------*
  • DEFINITIONEN *
  • -------------------------------------------------------------------*
        DS    0F

YKMASKA DC V(CPKMASK) CPKMASK MVCFYR DS F RPBAYR DS F FDBKYR DS F YRLEN DS F YRECO DS F YREEI DS F

  • -- FEHLER ---*

YBRBACK DC A(0) SAVE YERR15 DS F 

        DS    0F

YHX DC C'0123456789ABCDEF' 

        DS    0F

YERRMSG DC Y(YERRMSGE-YERRMSG) 

        DC    C'   %  ZCP0006 CP-ERROR AT:'

YERRTEXT DS CL20 

        DC    C'  RC:'

YERRR15 DS L9 YERRTEX1 DC CL32' ' YERRMSGE EQU *-1 

        ORG
  • --------------*
        DS    0F

TRCTAB DC C'0123456789ABCDEF' 

        DS    0F

TRTIM DS CL8 TRCH DS CL16 

        DS    0F

TRBOUTL DC Y(TRBOUTLE-TRBOUTL) 

        DS    CL2
        DC    X'01'

TRBOUT DS CL196 TRBOUTLE EQU * 

        DS    0F
  • -- SEQ DAT --*

SENDCMD DS CL8 

        DC    X'4040484040306740436644'

SENDCMD1 DS CL72 

        DS    F

SEDAT DS 0CL84 SELEN DS H 

        DS    CL2

SEKEY DS CL8 SECMD DS CL72 SEFREE DS CL50 

        ENTRY SEKEY
  • -------------------------------------------------------------------*
  • D S E C T S *
  • -------------------------------------------------------------------*
  • ZENTRALE TABELLEN *
        STATEIN
        EJECT
        USEREIN
        END
Von «https://wiki.zweiernet.ch/mediawiki/index.php?title=Yrecasy&oldid=310»