Cpbufh
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
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
