Cpbufh: Unterschied zwischen den Versionen

CPBUFH   CSECT RESIDENT
* MANUELLE ANPASSUNG BETR. ADDR0-FALLE ->> SIEHE DSECT STATEIN.
** V3.0AK3
* FEHLERAUSGABE FUER LOG DATEI MIT FDBK.
* AENDERUNGEN FUER TYP 'PDN' = CATS-VERBINDUNG. GEKENNZEICHNET
* MIT 'CATS'.
** V2.1B00
* WENN 'WAIT FOR GO' WIRD DER LEVEL BEIM SOLSIG NUN NICHT MEHR
* GESENKT WEEGEN TEILWEISE CP ABSTURTZ (WAEHREND DEM SOLSIG KONNTE
* ES VORKOMMEN DASS FUER DIESEN PARTNER DIE LOSCON ROUTIENE ANLIEF
* UND SOMIT DIE SEITEN FREIGEGEBEN WURDEN, DANN HATS GKNALLT).
** V1.3D61
* DA WAEHREND DEM SOLSIG LEVEL 5 GILT, KANN IN DER ZWISCHENZEIT DIE
* SEITE WEG SEIN ->> DUMP. JETZT WIRD DER ZUSTAND DER SEITE MIT MINF
* ABGEFRAGT.
** V1.3D60
* FEHLER 'CPBUFH-ERROR(ABSTURZ)' BEHOBEN. RETCO -> B   RETCO.
* BEI RETCO WURDE RUECKSPRUNGADR ZERSTOERT. (LABEL=BACK)
** V1.3D20
* ANPASSUNGEN AN 31-BIT ADR-MODUS
** V1.3D10
* DIE K3 SEND UND KDCLAST MELDUNG
* WERDEN EIN PAR BITS IM NK ANGEPASST DA EVENTUELLE
* PROBLEME BEIM EDT EINSTEHEN ??
** 89.03.09 O.K
* WENN EINMAL EIN K3/ ODER EIN KDCLAST AN EINEN
* PARTNER GESCHICKT WIRD, WIRD NEABT PROTOKOLL AUF
* '36' GESETZT UM BEI DER NAECHSTEN EINGABE EINE ASYCHRONE
* EINGABE NACHRICHT ZU ERREICHEN
* 89.03.06 O.K **
* WEGWN ADRESSFEHLER BEI VIRTUELLEM OVERFLOW (O.A.??) WIRD
* EINE ADRESSVALIDIERUNG AN 3 KRITISCHEN STELLEN GEMACHT
* 89.02.08 P.S  (V1.2C06)
* AENDRURN IM UCONHEAD
* WAR - ZEICHEN IM PAR00L WAR MIT 00 VORBELEGT
* SIEHE MCP002 (V1.2C01)
* 89.01.12 O.K ***
* ABFRAGE BEI NACHRICHT AUF TERMINAL WEITERLEITEN WAR FALSCH;
* ES WURDE XAKTPID AUF <> 0 ABGEFRAGT , OB PARTNER NOCH AKTIV
* WAR IST NICHT ABGEFRAGT WORDEN (GEAENDERT AUF ZUSFREE)
* 88.11.03 P.S ***
* LIFETIME AUF 10 SEK ERHHOEHT.
* FEHLER1 AUSGANG EINGEFUHERT UM AKT CELL AUF NULL SETZEN BEI FEHLER
* NEUAUFBAU
* 88.10.19 P.S ***
* DA SICH DAS CP AB UND AN VERABSCHIEDETE
* WERDEN DIE FEHLERAUSGAENGE (WENN SOLSIG ABGELAUFEN)
* UM DENN ANSPRUNG DER FEHLERROUTINE ERWEITERT
* (ANSTELLE RETCO --> B FEHLER, BEI X00S11U,X00S11,X00S11X,X00S11Y)
* DA UNTER UMSTAENDEN DER ASYN RECEIVE FUER DIE TERMINALS VERLOREN GING
* WEITERHIN WURDE EIN AUSGANG "BACK" GESCHAFFEN DER NUR RETCO MACHT,
* FUER DEN FALL DAS DIE LOSCON ROTINE DURCHLAUFEN WIRD WAEHREND
* DER TASK AUF DEM SOLSIG STEHT
* 88.10.12 O.K
* WEGEN UEBERSCHREIBEN LA1 PARAM-BEREICHE BEI AUSGABE MIT PARAM0
* AUF PAR00L UMSTELLEN
* 88.11.14 P.S ***
         PRINT NOGEN,BASE
*----------------------------------------------------------------------*
****     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
CPBUFH   AMODE ANY
CPBUFH   RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
         USING *,R15
         USING ZUSZTAB,R4
         USING XSTATAB,R3
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         SPACE
         USING DSSIMANF,R8,R9
DSSIMANF BASR  R8,0
         BCTR  R8,R0
         BCTR  R8,R0
         LA    R1,4095
         LA    R9,1(R8,R1)
         DROP  15
         B     BEG
*----------------------------------------------------------------------*
***      PUFFER-VERWALTUNG                                           ***
*----------------------------------------------------------------------*
         CNOP  0,4
BEG      EQU   *
         CNOP  0,4
X000     EQU  *
         L    R5,ZUSRES
         CH   R5,=H'3'
         BE   NEUAUF
         L     R5,ZAAREA1X
*        CLC   ZUSTYP,=C'TIAM'
*        BE    ISSYSNU
*        CLC   ZUSTYP,=C'U/D*'
*        BE    NOMSKUDU
         CLC   ZUSTYP,=C'UCON'       AUCH PDN  ** CATS -> ISSYSNU
         BNE   ISSYSNU
         SH    R5,=H'22'                                      14.11.88
         MVC   0(22,R5),UCONHEAD                              14.11.88
* KORREKTUR FEHLERHAFTE UCON AUSGABE (NORMAL HELL/ HALBHELL)
*      FUER "%" ERSTES ZEICHEN UCONNACHRICHT
*               WIRD HALBHELLGESTEUERT (1DC8)
*      FUER "?"  NORMALHELL  (1D7C)
* AM ENDE UCONNACHRICHT WIRD GENERELL AUF HALBHELL GESTELLT 
* (1DC8)
         MVC   20(2,R5),=X'1DC8'       * HALBHELL              14.11.88
* BIST DU FRAGE "?"
         CLI   22(R5),C'?'                                     14.11.88
         BNE   W0
         MVC   20(2,R5),=X'1D7C'                               14.11.88
W0       EQU   *
         L     R6,ZAAREALN
* ACHTUNG LAENGE UM 2 FGROESSER
         LA    R6,26(R6)                                       14.11.88
         ST    R6,ZAAREALN
         LA    R6,0(R5,R6)
         SH    R6,=H'4'
         MVC   0(4,R6),=X'1DC81ED7'
* ENDE KORR
ISSYSNU  ST    R5,ZAAREA1
         L     R10,ZAAREA1
         B     NOMSK
NOMSKUDU EQU   *
         ICM   R15,B'0001',0(R5)
         X     R15,=A(X'40')
         LA    R15,2(R15)
         SH    R5,=H'1'
         ST    R5,ZAAREA1
         STCM  R15,B'0001',0(R5)
         L     R5,ZAAREALN
         LA    R5,1(R5)
         ST    R5,ZAAREALN
NOMSK    EQU   *
         L     R5,ZUSECELA
         LTR   R5,R5             1. ZELLE IM BUFFER??
         BNZ   NCELLDA
*---     1. CELL IN BUFFER   -----------------------------------------*
FCELL    L     R5,ZUSECELA
         LA    R5,1(R5)          + 1 CELL
         ST    R5,ZUSECELA
         L     R15,ZBUFANF       JA !!
         ST    R15,ZACTCELA      SAVE ACT CELL  IF 1. CELL
         ST    R15,ZFRECELA      1. FREE CELL
         ST    R15,ZLSTCELA      LAST CELL
         XR    R2,R2
         STCM  R2,3,8(R15)    LETZTE ZELLE   BYTE 8-9 =0
         L     R14,ZAAREALN
         LA    R15,10(R14,R15)
         XR    R14,R14
         B     FCNHAC1
NCELLDA  EQU   *
*---     N. CELL IN BUFFER   -----------------------------------------*
         LA    R5,1(R5)          + 1 CELL
         ST    R5,ZUSECELA
         L     R5,ZLSTCELA
         LA    R1,1
         LNR   R2,R1
         STCM  R2,3,8(R5)        NICHT LETZTE ZELLE
*---     PUFFER AUSLAST PRUEFEN   -----------------------------------*
*----    VERWALTUNS INFO GESPLITTET ??  ---*
         L     R15,ZFRECELA
         L     R13,ZBUFEND
         SR    R13,R15
         LA    R1,10          VERWALT.INFO
         CR    R13,R1          WIRD VERWALT. INFO GESPLITTET (OFLOW)??
         BNL   NOSPLVI         NO !!
SPLVI    L     R1,ZBUFANF      JA !! # BYTES < 10 BIS BUFEND
         ST    R1,ZFRECELA     ZELLE AUF BUFFANF SETZEN
         MVI   OKZ,X'10'        ERGIBT OFLOW
         L     R2,ZLSTCELA
         STCM  R1,15,0(R2)    ZEIGER AUS LETZTER ZELLE KORRIG.
         LA    R15,1
         LNR   R14,R15
         STCM  R14,3,6(R2)     LEN 2 X'FFFF' IF SPLIT ; NEUE ZELLE
*                              = BUFFER ANFANG
*---     VERW.INFO NICHT GESPL. ---*
NOSPLVI  EQU   *
         L     R15,ZFRECELA
         L     R14,ZAAREALN       DATENLAENGE
         LA    R15,10(R14,R15)     + 10 BYTE VERW.FOLGEZ.
         L     R13,ZBUFEND        BUFFER END
         CR    R13,R15
         BH    NBOFLOW            NO
*---     ZELLEN UEBERLAPPUNG  BEI OFLOW ???   ------------------------*
         MVI   LKZ,X'10'
         SR    R15,R13            . [A(ZFRECELA) + ZAAREALN + 8
         L     R13,ZBUFANF        .  -A(ZBUFEND) + A(ZBUFANF) ]
         LA    R15,0(R13,R15)     .
         L     R13,ZACTCELA
         ST    R15,NFRECEL
         LR    R1,R13
Z1       CLI   OKZ,X'00'
         BE    XA000
* ZWEUTER OFLOW ACTCEL = 1 NACH IM BUFFER
XA002    XR    R2,R2
         XR    R1,R1
         ICM   R1,3,8(R13)       LEZTZE ZELLE ??
         BZ    XFCNHAC            JA
         ICM   R2,3,6(R13)       ACTCELL OVERFLOW ??
         BNZ   XA003             JA !!
         XR    R1,R1
         XR    R5,R5
         ICM   R5,B'1000',ZBUFANF   |
         ICM   R1,B'1000',0(R13)    |
         XR    R1,R5                 >  ADRESSVALIDIERUNG
         BNZ   ADRERR               |
         ICM   R1,15,0(R13)             NO !!
*----    UEBERSCHR. ZELLEN ABZAEHLEN **
         L     R5,ZUSECELA
         SH    R5,=H'1'           - 1 CELL
         ST    R5,ZUSECELA
         LR    R13,R1            NEXT ACT CELL
         CLI   OKZ,X'00'
         BE    XA000
         CR    R15,R1
         BL    XA002
         B     XA000             WEITER PRUEFEN
XA003    XR    R1,R1
         XR    R5,R5
         ICM   R5,B'1000',ZBUFANF   |
         ICM   R1,B'1000',0(R13)    |
         XR    R1,R5                 >  ADRESSVALIDIERUNG
         BNZ   ADRERR               |
         ICM   R1,15,0(13)       CELL GESPLITTET / NEXT ACTCELL LADEN
*----    UEBERSCHR. ZELLEN ABZAEHLEN **
         L     R5,ZUSECELA
         SH    R5,=H'1'           - 1 CELL
         ST    R5,ZUSECELA
         CR    R15,R1            BUFANF / NEW FREE CELL > ACT CELL ??
         BL    SFCNHAC            NEIN !!
OKX001   MVI   OKZ,X'00'     NEXT ACT CELL VOR FREE CELL
         LR    R13,R1            NEXT ACT CELL
         B     XA002             NACH OFLOW WEITERE ZELLEN UEBERSCHR.
*
XA000    CR    R15,R1            BUFANF / NEW FREE CELL > ACT CELL ??
         BL    SFCNHAC            NEIN !!
         LR    R13,R1            NEXT ACT CELL
         B     XA002             NACH OFLOW WEITERE ZELLEN UEBERSCHR.
*---     MVCL LLEN BEI OFLOW   ---*
XFCNHAC  L     R15,ZFRECELA
         ST    R15,ZACTCELA      MOMENTANE ZELLE ZU ACTCELL (EINZIGE)
         B     FCNHAC
SFCNHAC  ST    R1,ZACTCELA       SICHERN
FCNHAC   EQU   *
         L     R15,ZFRECELA
         ST    R15,ZLSTCELA       LAST CELL SICHERN
         L     R13,ZBUFEND
         SR    R13,R15
         SH    R13,=H'10'          - VORSPANN
         STCM  R13,B'0011',4(R15)
         ST    R13,MVCLR1         LAENGE 1.TEIL
         L     R14,ZAAREALN
         SR    R14,R13
         STCM  R14,3,6(R15)       LEN 2. TEIL IN ZELLE
         XR    R1,R1
         XR    R10,R10
         XR    R12,R12
         STCM  R1,3,8(R15)        LETZTE ZELLE
         ST    R14,MVCLR2         LAENE 2.TEIL
         L     R12,ZAAREA1        SENDADR1
         L     R10,ZFRECELA       EMPFADR1
         LA    R10,10(R10)         VORSPANN
         L     R11,MVCLR1
         L     R13,MVCLR1
         MVCL  R10,R12
         L     R12,ZAAREA1        SENDADR1
         L     R11,MVCLR1
         LA    R12,0(R11,R12)     SENDADR2
         XR    R10,R10
         L     R10,ZBUFANF        EMPFADR2
         L     R11,MVCLR2
         L     R13,MVCLR2
         MVCL  R10,R12
         L     R1,NFRECEL
         L     R10,ZFRECELA
         STCM  R1,B'1111',0(R10)  UPDATE FOLGEZELLE
         MVI   OKZ,X'10'          ACTCEL NACH FRECELL
         ST    R1,ZFRECELA       SAVE  NEXT FREE CELL
         B     XWOHIN
*---     ZELLEN UEBERLAPPUNG  OHNE OFLOW  ????   ---------------------*
NBOFLOW  EQU   *
         MVI   LKZ,X'00'
         CLI   OKZ,X'00'
         BE    FCNHAC1
         L     R14,ZACTCELA
         CR    R15,R14            NEW FREE CELL > ACT CELL ?
         BL    FCNHAC1            NO !
************
X00PR    XR    R1,R1
         ICM   R1,3,8(R14)        LETZTE ZELLE ??
         BZ    XFCNHAC1            JA
         XR    R1,R1
         XR    R5,R5
         ICM   R5,B'1000',ZBUFANF  ||
         ICM   R1,B'1000',0(R14)   ||
         XR    R1,R5                >>  ADRESSVALIDIERUNG
         BNZ   ADRERR              ||
         ICM   R1,15,0(R14)       NEXT ACT CELL
*----    UEBERSCHR. ZELLEN ABZAEHLEN **
         L     R5,ZUSECELA
         SH    R5,=H'1'           - 1 CELL
         ST    R5,ZUSECELA
         CR    R15,R1             NEW FREE CELL > NEXT ACTCELL      ?
         BL    X00NOA               NO !
         XR    R2,R2
         ICM   R2,3,6(R14)       ACTCELL GESPLITTET ??
         BZ    X00Y1A             NO !!
OKZ002   MVI   OKZ,X'00'
         B     X00NOA             JA !!
X00Y1A   LR    R14,R1
         B     X00PR              WEITER PRUEFEN
X00NOA   LR    R12,R1             NEW ACTCELL
         ST    R12,ZACTCELA       NEUE AKT. ZELLE
         B     FCNHAC1
XFCNHAC1 L     R14,ZFRECELA
         ST    R14,ZACTCELA       EINZIGE ZELLE IN BUFFER
FCNHAC1  EQU   *
         L     R14,ZFRECELA
         ST    R14,ZLSTCELA         SAVE LASTCELL
         STCM  R15,B'1111',0(R14)  UPDATE FOLGEZELLE
         ST    R15,NFRECEL        SAVE FOR NEXT FREE CELL
         XR    R1,R1
         STCM  R1,3,8(R14)        LETZTE ZELLE
         L     R15,ZAAREALN
         STCM  R15,3,4(R14)       DATENLAENGE 2 BYTES
         XR    R15,R15
         STCM  R15,3,6(R14)       KEIN SPLITTING  BIT 16-32 = 0
*----    MVCL  OHNE OFLOW     ------*
         LR    R10,R14
         LA    R10,10(R10)         + VORSPANN
         L     R11,ZAAREALN
         LR    R13,R11
         L     R12,ZAAREA1
         MVCL  R10,R12
         L     R14,NFRECEL
         ST    R14,ZFRECELA         SAV NEXT FREE CELL
         B     XWOHIN
*----------------------------------------------------------------------*
XWOHIN   EQU   *
         CLC   ZPIDAKT,XAKTPID     AKTUELLER PID ZUGESCH.??
         BE    X001                NEIN !
         B     RETCO
*----    TERMINAL-PUFFER AKTUALISIEREN    ---------------------------*
X001     EQU   *
         CLI   LKZ,X'10'
         BE    X001Z
         MVI   OKZ,X'00'
X001Z    EQU   *
         L     R5,ZLSTCELA
         ST    R5,ZACTCELA
         XR    R6,R6
         ST    R6,ZUSECELA
         L     R5,ZAAREALN         AAREALN
         L     R6,ZAAREA1
         L     R10,XSRPBA         RPB
         LA    R11,XSTATEI        EVENT EID
********************
         L     R14,XAIDCP
         L     R12,XSTATCID
         CLC   ZUSTYP,=C'TIAM'
         BE    W230
         CLC   ZUSTYP,=C'U/D '
         BE    W230
         CLC   ZUSTYP,=C'PDN '
         BE    W230PDN
* VOR AUSGABE GEHE IN LINE MODE (UCON)
YSENDBHU CLI   ZUSFREE,':'
         BNE   BACK
         CLC   ZPIDAKT,XAKTPID     AKTUELLER PID ZUGESCH.??
         BNE   X00S11U
         CLI   ZUSREF,C'*'
         BE    X004U
         YSEND RPB=(R10),AREA=(R6),AREALN=(R5),EID=(R11),AID=(R14),    C
               CID=(R12)
         CLM   R15,B'1110',=X'10040C'
         BNE   CLMU
         MVI   XSOL,X'FF'      SOLSIG IST
*        MVC   XSOLPID(2),ZPIDAKT     MIT DIESEM PID
*         L     R13,XUSRPAGA       SAVE FALLS PAGE NACH SOLSIG WEG IST
*         LEVCO NEWLV=5
         SOLSIG EIID=(R11),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BNE   X00S11U
*         LEVCO NEWLV=10
*         L     R15,XUSRPAGA
*>> WENN DIE SEITE WEG IST DANN KNALLT'S HIER --> STXERR-MODUL
*STXT1    NOP   REQMERR                        PAGE NOCH ALLOCATED ????
*                                             NEIN !! SOFORT RETCO
         XC    XSOL(1),XSOL
*        XC    XSOLPID(2),XSOLPID    LOESCHEN
         B     YSENDBHU
X00S11U  EQU   *  LEVCO NEWLV=10
*        L     R15,XUSRPAGA
*>> WENN DIE SEITE WEG IST DANN KNALLT'S HIER --> STXERR-MODUL
*STXT2    NOP   REQMERR                        PAGE NOCH ALLOCATED ????
*                                             NEIN !! SOFORT RETCO
         XC    XSOL(1),XSOL
*        XC    XSOLPID(2),XSOLPID    LOESCHEN
         MVC   ZUSERR,=CL15'BUF/SO/YSENDBHU'
         B     FEHLER
CLMU     CLM   R15,B'1001',=X'0000'
         BE    X004U
         MVC   ZUSERR,=CL15'BUF/SE/YSENDBHU'
         B     FEHLER
X004U    EQU   *
         B     RETCO
W230PDN  EQU   *                          ** CATS
         SH    R6,=H'9'             ** CATS
         MVC   0(10,R6),CATSHEAD    ** CATS    NK VOR PAG
         LA    R5,9(R5)        +9   ** CATS
         B     YSENDBH
W230     EQU   *
         SH    R5,=H'9'        - NEABT
         LA    R6,9(R6)        -NEABT
YSENDBH  CLI   ZUSFREE,C':'
         BNE   BACK
         CLC   ZPIDAKT,XAKTPID     AKTUELLER PID ZUGESCH.??
         BNE   X00S11
         YSEND RPB=(R10),AREA=(R6),AREALN=(R5),EID=(R11),AID=(R14),    C
               CID=(R12)
         CLM   R15,B'1110',=X'10040C'
         BNE   CLM
         MVI   XSOL,X'FF'      SOLSIG IST
*        MVC   XSOLPID(2),ZPIDAKT     MIT DIESEM PID
*HANG1    L     R13,XUSRPAGA       SAVE FALLS PAGE NACH SOLSIG WEG IST
*        LEVCO NEWLV=5
         SOLSIG EIID=(R11),COND=UNCOND,LIFETIM=10
HANG2    CLM   R15,B'0001',=X'00'
         BNE   X00S11
*        LEVCO NEWLV=10
*        L     R15,XUSRPAGA
*>> WENN DIE SEITE WEG IST DANN KNALLT'S HIER --> STXERR-MODUL
*STXT3    NOP   REQMERR                        PAGE NOCH ALLOCATED ????
*                                             NEIN !! SOFORT RETCO
         XC    XSOL(1),XSOL
*        XC    XSOLPID(2),XSOLPID    LOESCHEN
         B     YSENDBH
X00S11   EQU   *  LEVCO NEWLV=10
*        L     R15,XUSRPAGA
*>> WENN DIE SEITE WEG IST DANN KNALLT'S HIER --> STXERR-MODUL
*STXT4    NOP   REQMERR                        PAGE NOCH ALLOCATED ????
*                                             NEIN !! SOFORT RETCO
         XC    XSOL(1),XSOL
*        XC    XSOLPID(2),XSOLPID    LOESCHEN
         MVC   ZUSERR,=CL15'BUF/SO/YSENDBH'
         B     FEHLER
BACK     LEVCO NEWLV=10
         B     RETCO
CLM      CLM   R15,B'1001',=X'0000'
         BE    X004
         MVC   ZUSERR,=CL15'BUF/SE/YSENDBH'
         B     FEHLER
X004     EQU   *
         B     RETCO
         CNOP  0,4
NEUAUF   EQU   *
*        MVI   MSK,X'00'
         L     R10,ZUSECELA
         LTR   R10,R10
         BNZ   X00ISYS
         CLC   ZUSTYP,=C'PDN '        ** CATS !!!!!!
         BE    X00PSYS
         CLI   ZNEABT,X'37'       BEI CATS <> X'37'  ** CATS
         BNE   X00ISYS
         CLI   ZUSREF,C'Y'
         BE    X00ISYS
*        MVI   MSK,X'FF'         MASKE
X00NSYS  L     R10,Z00XAID
         L     R11,ZCIDANW
         CLC   ZUSTYP,=C'U/D '
         MVC   DSEND(8),ZNEABT
         BE    UDIS
         XI    DSEND,X'20'
         MVC   DSEND+8(11),K3SEND
         LA    R5,DSEND
         LA    R6,TRPB
         YSEND RPB=(R6),CID=(R11),AID=(R10),AREA=(R5),AREALN=19
         LTR   R15,R15
         BZ    X00NF
         MVC   ZUSERR,=CL15'BUF/SE/X00NSYS'
         B     FEHLER
X00NF    XR    R6,R6
         ST    R6,ZUSECELA
* USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
         MVI   ZNEABT,X'36'
*
         B     RETCO
X00PSYS  L     R10,Z00XAID       ** CATS   CATS   CATS
         L     R11,ZCIDANW
         MVC   DSEND(11),K3CATS
         LA    R5,DSEND
         LA    R6,TRPB
         YSEND RPB=(R6),CID=(R11),AID=(R10),AREA=(R5),AREALN=11
         LTR   R15,R15
         BZ    X00PF
         MVC   ZUSERR,=CL15'BUF/SE/X00PSYS'
         B     FEHLER
X00PF    XR    R6,R6
         ST    R6,ZUSECELA
* USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
*        MVI   ZNEABT,X'36'
*
         B     RETCO
UDIS     MVC   DSEND+8(18),KDCSEND
         XI    DSEND,X'20'
         LA    R5,DSEND
         LA    R6,TRPB
         YSEND RPB=(R6),CID=(R11),AID=(R10),AREA=(R5),AREALN=26
         LTR   R15,R15
         BZ    UDISNF
         MVC   ZUSERR,=CL15'BUF/SE/UDIS'
         B     FEHLER
UDISNF   XR    R6,R6
         ST    R6,ZUSECELA
* USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
         MVI   ZNEABT,X'36'
*
         B     RETCO
X00ISYS  L     R15,ZACTCELA
         CNOP  0,4
X0011    EQU   *
         XR    R14,R14
         LR    R2,R15
X0012    XR    R14,R14
         ICM   R14,B'1111',0(R15)
         ST    R14,FOLGSAV
         XR    R14,R14
         ICM   R14,B'0011',6(R15)
         BZ    NSP1
         B     NEUSPLIT
NSP1     XR    R10,R10
         LA    R12,19(R15)            DATEN
         LR    R6,R12              DATEN
HIER     XR    R5,R5
         ICM   R5,B'0011',4(R15)   AAREALN
         LA    R5,0(R5,R10)        1.+2. LEN ; VON NEUSPLIT BEIDE BEL.
********************
         LA    R10,TRPB
         LA    R11,XSTATEI        EVENT EID
         L     R14,XAIDCP
         L     R12,XSTATCID
         CLC   ZUSTYP,=C'TIAM'
         BE    W230Y
         CLC   ZUSTYP,=C'U/D '
         BE    W230Y
W229     EQU   *
* VOR AUSGABE GEHE IN LINE MODE (UCON)
         SH    R6,=H'9'
YSENDBHX YSEND RPB=(R10),AREA=(R6),AREALN=(R5),EID=(R11),AID=(R14),    C
               CID=(R12)
         CLM   R15,B'1110',=X'10040C'
         BNE   CLMX
         SOLSIG EIID=(R11),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BNE   X00S11X
         B     YSENDBHX
X00S11X  EQU   *
         MVC   ZUSERR,=CL15'BUF/SO/YSENDBHX'
         B     FEHLER1
CLMX     CLM   R15,B'1001',=X'0000'
         BE    X004X
         MVC   ZUSERR,=CL15'BUF/SE/YSENDBHX'
         B     FEHLER1
X004X    EQU   *
         XR    R1,R1
         ICM   R1,3,8(R2)     LETZTE ZELLE ?
         BZ    RETCO1
         L     R15,FOLGSAV
         B     X0011
W230Y    EQU   *
         SH    R5,=H'9'        - NEABT
YSENDBHY YSEND RPB=(R10),AREA=(R6),AREALN=(R5),EID=(R11),AID=(R14),    C
               CID=(R12)
         CLM   R15,B'1110',=X'10040C'
         BNE   CLMY
         SOLSIG EIID=(R11),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BNE   X00S11Y
         B     YSENDBHY
X00S11Y  EQU   *
         MVC   ZUSERR,=CL15'BUF/SO/YSENDBHY'
         B     FEHLER1
CLMY     CLM   R15,B'1001',=X'0000'
         BE    X0041
         MVC   ZUSERR,=CL15'BUF/SE/YSENDBHY'
         B     FEHLER1
X0041    EQU   *
         L     R15,FOLGSAV
X00NOP   EQU   *
         XR    R1,R1
         ICM   R1,3,8(R2)     LETZTE ZELLE ?
         BZ    RETCO37
         B     X0011
RETCO37  EQU   *
         CLI   ZNEABT,X'37'
         BE    RETCO1
         B     RETCO
         DS    0F
NEUSPLIT EQU   *
         CLM   R14,B'0011',=X'FFFF'
         BE    NSP1         VIRTUELLER OVERFLOW !#$??+*!!
         XR    R10,R10
         ICM   R10,B'0011',4(R15)          AAREALN
         LR    R13,R10
         LA    R12,10(R15)            DATEN
         L     R10,ZDSSBUFA        AAREA1
         LR    R11,R13              LEN
         MVCL  R10,R12             BUFFER -> AAREA1
         XR    R10,R10
         XR    R11,R11
         ICM   R11,3,4(R15)       1.TEIL
         ICM   R10,3,6(R15)       2.TEIL
         LR    R13,R10
         L     R12,ZBUFANF        ANF REST DATEN
         L     R10,ZDSSBUFA        AAREA1
         LA    R10,0(R10,R11)      DIST 2.TEIL
         LR    R11,R13             LENGTH
         MVCL  R10,R12            2.TEIL BUFFER -> AAREA1
         XR    R10,R10
         ICM   R10,3,6(R15)
         L     R6,ZDSSBUFA
         LA    R6,9(R6)
         B     HIER
FEHLER1  EQU   *
         ST    R15,ZUSRC
*        CMD   '/D %MR'
         MVC   ERRMSG1Z+3(15),ZUSERR
         UNPK  ERRMSG1R,ZUSRC(5)
         TR    ERRMSG1R,BHHX-240
         WROUT ERRMSG1,TERME1
TERME1   EQU   *
         B     RETCO1
         DS    0F
FEHLER   EQU   *
         ST    R15,ZUSRC
         MVC   ERRMSGZ+3(15),ZUSERR
         UNPK  ERRMSGR,ZUSRC(5)
         TR    ERRMSGR,BHHX-240
         WROUT ERRMSG,TERME
TERME    EQU   *
         B     RETCO
         DS    0F
ADRERR   EQU   *
         MVI   OKZ,X'00'
         MVI   LKZ,X'00'
         XR    R15,R15
         ST    R15,ZUSRC
         MVC   ZUSERR,=CL15'CPBUFH ADR-ERR'
         WROUT ERRMSG2,TERME2
TERME2   B     RETCO1
         WROUT ERRMSG3,RETCO
         RETCO                 HIER MUSS RETCO GEMACHT WERDEN WEIL
*                              KEINE SEITE MEHR ALLOCIERT IST !!!!!!
RETCO1   L     R5,ZLSTCELA
         ST    R5,ZACTCELA
         XR    R6,R6
         ST    R6,ZUSECELA
RETCO    EQU   *
         LM    R8,R12,SAVTAB
         L     R14,SAV14
         BR    14
*
*---------------------------------------------------------------------*
***      DEFINITIONEN                                               ***
*---------------------------------------------------------------------*
         DS    0F
UCONHEAD DC    X'10401B20614040456254005000004121278427981ED8'
         DS    0F
CATSHEAD DC    X'0A484F0000004D000000'    NK VOR PAG (FST3 40->4D)
*
* ZEICHEN 4 VOM NK (AUSG) UND ZEICHEN 6 (ZZ2) GEAENDERT
*      67 --> 40                   43 -- > 41
*K3SEND   DC    X'4040480040306740435544'         9
K3SEND   DC    X'4040480040304040415544'         9
K3CATS   DC    X'6400C8D67CF04A7CC1E400'     11
KDCSEND  DS    0CL18
*        DC    X'4040480040306740436644'      9
         DC    X'4040480040304040416644'      9
         DC    C'KDCLAST'
         DS    0F
DSEND    DS    CL30
         LTORG
         DS    0F
ERRMSG   DC    Y(ERRMSGE-ERRMSG)                                                   
         DC    C'   %  ZCP0006 CPBUFH ERROR'                                       
ERRMSGZ  DC    C' / 123456789012345'
         DC    C'   RC:'
ERRMSGR  DS    L9
ERRMSGE  EQU   *-1                                                                 
         ORG
ERRMSG1  DC    Y(ERRMSGE1-ERRMSG1)                                                 
         DC    C'   %  ZCP0006 CPBUFH1 ERROR'                                      
ERRMSG1Z DC    C' / 123456789012345'
         DC    C'   RC:'
ERRMSG1R DS    L9
ERRMSGE1 EQU   *-1                                                                 
         ORG
ERRMSG2  DC    Y(ERRMSGE2-ERRMSG2)                                                 
         DC    C'   %  ZCP0006 CPBUFH ERROR (ADRESS-VALIDIERUNG)'                  
ERRMSGE2 EQU   *                                                                   
         DS    0F
ERRMSG3  DC    Y(ERRMSGE3-ERRMSG3)                                                 
         DC    C'   %  ZCP0006 CPBUFH ERROR (PAGE NOT ALLOCATED)'                  
ERRMSGE3 EQU   *                                                                   
BHHX     DC    C'0123456789ABCDEF'
TRPB     YRPB
*
MINF     DS    0F
MINF1    DS    F
MINF2    DC    F'8'
MINF3    DS    F
MINF4    DS    F
*
BITTAB   DS    CL4    NUR MIST  VON MINF
*---------------------------------------------------------------------*
***      D S E C T S                                                ***
*---------------------------------------------------------------------*
*----    ZENTRALE TABELLEN  ------------------------------------------*
ZUSZTAB  DSECT                 USER SPEC
ZUSCPNAM DS    CL8
ZUSPRO   DS    CL8
Z00XAID  DC    F'0'         AID FOR CP000X (AKT)   DSS <-> ANW
ZCIDANW  DC    F'0'         CID FOR ANWENDUNG X
ZUSPNA   DS    CL8
ZUSTYP   DS    F
ZPIDAKT  DS    H            AKT. PID
ZUSREF   DC    X'00'
OKZ      DC    XL1'00'
*----    BUFFER SPEZ.  ----*
ZBUFANF  DC    A(0)     0      BUFFER-ANF
ZBUFEND  DC    A(0)    +4      BUFFER-END
ZDSSBUFA DC    A(0)    +8      ADR TERMINAL BUFFER  4100 B  AAREA SEND
ZAAREA1X DC    A(0)   +16      PR INPUT  DCAM INPUT
ZAAREALN DS    F      +24      PR INPUT DCAM INPUT LENGTH
ZACTCELA DC    A(0)    +8      ADR. 1.ACT CELL FOR OUTPUT
ZFRECELA DC    A(0)   +12      ADR. NEXT FREE CELL
ZUSECELA DC    A(0)   +16      ADR. # OF USED CELLS
ZLSTCELA DC    A(0)            ADR. LAST CELL
*--------------------------*
         DS    CL4
ZNEABT   DS    CL8          NEABT PROTOKOLL SAVE
ZUSRES   DS    F            X'00000001'  ASY RECEIVE EINGETR.
*                           X'00000002'  ACK VON TERMINAL EING.
*                           X'00000003'  NEUAUFBAU GEWUENSCHT
ZUSRC    DS    F
ZUSERR   DS    CL15
ZUSFREE  DS    CL1
ZUSCO    DS    F
ZUSEI    DS    F
ZUSRPBA  DS    F
ZUSCCBA  DS    F
FOLGSAV  DS    F
NFRECEL  DS    F
MVCLR1   DS    F
MVCLR2   DS    F
MSK      DS    XL1
LKZ      DS    XL1
         DS    CL2
ZAAREA1  DC    A(0)
SAVTAB   DS    5F
SAV14    DC    A(0)
*
XSTATAB  DSECT              STATIONS SPEC    REG.2
XSTATPNA DS    CL8
XSTATPRO DS    CL8
XAIDCP   DS    F            AID --> CP
XSTATPW  DS    CL8
XTERMTYP DS    F
XSTATCID DS    F            CID UER TERMINAL --> CP
XAKTPID  DS    H            AKTUELLER PID
XSTATTID DS    H
XSTATZZ  DS    CL1
XSTATK   DS    CL1
XSRPBAD  DC    A(0)
XCCBA    DS    F
XSTATEI  DS    F
XSRPBA   DC    A(0)
XSOL     DC    X'00'        X'FF'=SOLSIG IN BEA.  SONST X'00'
         DS    CL1          RESERVE
XSOLPID  DS    H            PID FUER SOLSIG
XSTATFRE DS    CL1
XSTATADM DS    CL1
XUSRPAGA DS    F        A(ANFANG BUFFERSEITE FUER PARTNERVERWALTUNG)
XUSRPAGE DS    F        A(ENDE BUFFERSEITE)
XSTATPWS DS    CL8         PW SAVE
STATDEV  DS    CL8      DEVICE NAME FUER HC
STATFORM DS    CL8      FORMULAR NAME FUER HC
STATHCPG DS    F        3 SEITEN FUER HC UND SO
STATHCTY DS    CL1       'P' = 80 CHAR / REST = 82 CHAR
STATCLK  DS    F        CLOCK TIME LAST ENTRY
         DS    0F
CPBUFH   CSECT
*---------------------------------------------------------------------*
NEABT    DS    0XL8
         DS    0D
***
*---------------------------------------------------------------------*
*            - - - - - - - - - - - - - - - - - - BUFFERANF <--------+
*                                                                   |
*                                                                   |
*         0   ================== <------------------------------+   |
*                                                               |   |
*               A(FOLGEZELLE)    ------+                        |   |
*                                      |                        |   |
*         4   ==================       |                        |   |
*                      | LEN/0   --+   |                        |   |
*      +-----   LEN/0  |--------   |   |                        |   |
*      |               | LEN/0   ----+ |                        |   |
*      |  8   ==================   | | |                        |   |
*      |    |                    | | | |                        |   |
*      |    |                    |-+ | |                        |   |
*      |----|      DATEN         |   | |                        |   |
*           | - - - - - - - - - - - -|-|- - - -  BUFFEREND <----|--+|
*           |                    |---+ |                        |  ||
*           |                    |     |                        |  ||
*             ================== <-----+                        |  ||
*                                                               |  ||
*               A(FOLGEZELLE)                                   |  ||
*                                                               |  ||
*             ==================                                |  ||
*                      | LEN/0                                  |  ||
*               LEN/0  |--------                                |  ||
*                      | LEN/0                                  |  ||
*             ==================                                |  ||
*                                                               |  ||
*                  DATEN                                        |  ||
*                                                               |  ||
*             ================== <---------------------------+  |  ||
*                                                            |  |  ||
*                                ------------------          |  |  ||
*                                  A(BUFFERANF)    ----------|--|--|+
*                                ------------------          |  |  |
*                                  A(BUFFEREND)    ----------|--|--+
*                                ------------------          |  |
*                                  A(1.ACT.CELL)   ----------|--+
*                                ------------------          |
*                                  A(1.FREE.CELL)  ----------+
*                                ------------------
         END