Cpbufh
<syntaxhighlight lang="asm">
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