Mcp002
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Version vom 19. Januar 2016, 16:47 Uhr von Sigi (Diskussion | Beiträge) (Die Seite wurde neu angelegt: «<syntaxhighlight lang="asm"> MCP002 START 0,PAGE,RESIDENT ************************************************************************ *…»)
MCP002 START 0,PAGE,RESIDENT ************************************************************************ * * * COPYRIGHT (C) SIEMENS-ALBIS AG 1988 * * COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG 1991 * * ALL RIGHTS RESERVED * * * ************************************************************************ */ * RELM AUF ADDR0 USEBERPRUEFEN. ** V3.0AK4 * FALLE FUER ADDR0-FEHLER ->> SIEHE DSECT STATEIN. ** V3.0AK3 * AENDERUNG IM MODUL HCPRCO * ABFRAGE ALLTERM=YES UND VERZWEIGEN IN LEERES CP-MENU ** V3.0AK2 * NEUE VERSION 3.0 * ANMELDEN OHNE MSG * DATEINAMENSAENDERUNGEN NACH BS2000 KONVENTION 500.22 * LAENGE DER SEQ-DATEI VON 25 AUF 54 * DYNAMISCHER DUMP ENTFERNT ** V3.0A00 * BEI LANVERBINDUNGEN WURDE KEINE EVENT-ID MEHR BEKOMMEN, WEIL DER NAME * DER EREIGNISKENNUNG DER STATIONSNAME WAR UND DIESER MIT $$$. BEGINNT. * DAS FUEHRTE BEIM WAIT-FOR-GO SOLSIG ZUM ABSTURZ DES CP ?#$?!!. * JETZT WIRD HALT EIN NAME GENERIERT MIT PRAEFIX 'EI' UND EINER * 6-STELLIGEN FORTLAUFENDEN NUMMER (MAX. 1*10^6-1 EVENT-ID'S). ** V2.1C13 * SAW IN 'HCINIT' MODIFIZIERT. S. DORT. ** V2.1C12 * LOGGING-ERWEITERUNG ** V2.1C11 * PATCH ENTFERNT, LOESCHEN USIN,USEI,USCO,USAID IN YOPNCON BEI TIMEOUT ** V2.1C10 * CHANGE-REQUEST 'BULLETIN'-FUNKTION. NACH PASSWORTEINGABE WIRD * EIN BULLETIN AUS DER DATEI 'CP.BULLETIN' AUSGEGEBEN. * BEI DD33 WERDEN DIREKT DIE PAC'S AUSGEGEBEN. * EINLESEN UND AUSGEBEN BULLETIN IN CPBLTIN. ** V2.1C02 * (VERGLEICH OB ASY REC MEHRFACH AUFGEZOGEN WIRD. (CRECCNT)) * (TEMPORAERE KORREKTUR ) * (TEMPORAERE KORR B51, RELM AUF ADR 0 ENTFERNT) ** (V2.1B52) * KORREKTUR BEG0042X BEI AUSWERTUNG PTAST-PARAM. BEI NEUEN 975X * TERMINALS WIRD ESC-SP-N AUFS TERMINAL GEGEBEN UND VERSCHIEBT DEN * BILDSCHIRM. ** V2.1B50 * CSTAT-MAKROS AUSGELAGERT IN MODUL CPCSTAT. ** V2.1B40 * BIBLIOTHEK(ELEMENT) FUER LIB-PARAMETER WEGEN V10, 4STELLIGE CAT-ID * AUF 55 STELLEN ERWEITERT. BIBLIOTHEK(ELEMENT) OHNE USER-ID DARF NICHT * LAENGER ALS 39 ZEICHEN SEIN. BIBLIOTHEK MAX.45, ELEMENT MAX.25 BYTE. ** V2.1B30 * UNTERSCHEIDEN ZWISCHEN SAW=4F UND SAW=50 BEI CATS FUER H120-SVP BEI * ASCII - EBCDIC UMSETZUNG. ** V2.1B20 * KORREKTUR FUER SAP ANWENDUNGEN DIE 8-K NACHRICHTEN UMHERSCHICKEN: * USIN NEU 8704B; USTERMS NEU 8704B; USTEXTA NEU 18944B; REST NEU 494B. * DIE NEUEN LAENGEN WERDEN AUCH DEMENTSPRECHEND AN CPBUFH GELEITET. * DA JETZT 9 SEITEN ANGEFORDERT WERDEN MUSS AUCH DAS DUMMY MODUL AUF * 9 SEITEN ERHOEHT WERDEN. ** V2.1B10 * EINBRINGEN NEUER TYP 'PDN' FUER CATS. ES WIRD EINE NACHRICHTENKOPF * UMSETZUNG GEMACHT UND FELDER FUER MULTIKOS-SIMULATION EINGEFUEGT * WUERG AECHZ !! SIEHE AUCH -> CPBUFH MODUL. ** V2.1B00 * DA SICH DAS CP AB UND ZU, SINNLOSERWEISE, SELBER FREIGIBT, RELM AUF * PAGE 0, WERDEN AM ANFANG HALT 6 SEITEN NULLEN EINGEFUEGT. ** V2.0A05 *-BEI CODIERUNG DER PTASTEN KANN JETZT N(GROSS) ANGEGEBEN WERDEN FUER * KEINE AKTION, D.H DIESE TASTE WIRD NICHT GELADEN. *-MENU MASKE KORRIGIERT ( MODUL CPKMASK). ** V2.0A04 (PILOT) * KORREKTUR IN CPKMASK, SIHE DORT.. ** V2.0A03 * SIEHE MODUL CPKMASKE (REGISTER UEBERSCHREIBER) ** V2.0A02 (PILOT) *-LINELEN FUER HARDCOPY KANN UBER CPAUSER ODER TERMINALDATEI EINGE- * STELLT WERDEN (STATHCTY). *-KORR. FALSCHER RUECKSPRUNG VON STXIT-ROUTINE(REGISTER FALSCH VERS.). ** V2.0A01 (PILOT) *-HARDCOPY-FUNKTION REAL. BEI 'K9'=ESC-? WIRD DER BILDSCHIRM MIT * PAR00L GELESEN (MODUL = HCINIT) UND EINE CONTI FUER MODUL 'HCPRCO' * ANGEKICKT. DOERT WIRD IN IDLE-ZEIT (PRIO 8) DER HARDCOPY AUFBEREITET * D.H. STEUERZEICHEN ANALYSIERT UND ELIMINIERT. DRUCK OHNE VORSCHUB- * STEUERZ. UEBER RSO. *-MODUL CPAUSER NEU. HIER WIRD DYNAMISCH DEVICE-NAME GES HC GEAENDERT. * EINGABE IN CP-MASKE /HC XXXXXXXX. *-AUT. LOCK BETR. CHANGE-REQUEST ETAT DU VALAIS. JEDE MINUTE WIRD * UEBER STXIT TIMER MODUL 'CPCLOCK' GESTARTET UND NACH 'LOCKTIME=XX' * XX=MINUTEN DAS TERMINAL MIT STAPWSAV GELOCKT. * A C H T U N G !!! BEI ANSPRUNG VON CPKMASK MUSS R15 I M M E R MIT * TERMOUTA VERSORGT SEIN. ** V2.0A00 *-ABLAUFFAEHIG IN BCAM V10/ BS2 V10. *-FUER PAGING-ERROR GIBTS JETZT EINE STXIT --> MODUL STXERR. *-ADMIN-SS AM TERMINAL WIRD EINGEFUEHRT -> MODUL 'CPADMIN'. AM * ADMINISTRATORTRERMINAL KOENNEN MIT '//KDO' KOMMANDOS EINGEGEBEN * WERDEN. DIE /INTR -SS WIRD SPAETER ABGELOEST. ** V1.4A00 * IN CPBUFH WIRD DER LEVEL NUN NICHT MEHR AUF 5 GESENKT SONDRN * ES WIRD GEWARTET BIS GO-SIGNAL KOMMMT. ** V1.3D61 * NEUER START-PARAMETER 'SEQ=' FUER DIE ORIGINAL SEQ-DATEI DAMIT * DAS CP MEHFACH GELADEN WERDEN KANN. DER DATEINAME(25 CHAR.) WIRD * VOM MODUL CPCOPY UEBER V(KONST) GELESEN. * WEITER WIRD IN CPBUFH BEI STATSTOP=FF PAGE ABGEFRAGT ->> CPBUFH ** V1.3D60 >>>>> ACHTUNG LADBAR NUR AB BS2 V8.0 <<<< * WENN NUR DER STRING 'LOCK' EINGEGEBEN WIRD DAS PASSWORT AUS DER LIB * GEHOLT. ** V1.3D52 * UP KMASKE AUSGELAGERT ALS MODUL CPKMASK. ** V1.3D51 * DIAGNOSE TABELLE 'DIAG-TAB' TRACED DIV. REG.INHALTE MIT. TRACEPUNKTE * '** DIAG-TAB'. CXXX=CONTI-REGISTER/ UXXX=UP-AUFRUFE/ EEEE=ENDE ** V1.3D50 * DA DER TYPIO IN MOD. CPINF NACH CA. 10 WIEDERHOLNGEN IN PASS GEHT * UND SO DAS CP WEGEN PRIO 127 (STXIT) STEHT WIRD IN STXIT ROUTIENE * EINE CONTI MIT GLEICHER PRIO WIE ALLE ANGEKIKT. IN MOD. CPINF WIRD * DANN VOR TYPIO DER LEVEL VON 10 AUF 5 GESENKT, DAMIT DIE RECEIVE * CONTI ANLAUFEN KANN. CONTI=INFCO. ** V1.3D40 * KORREKTUR IN MOD. CPINF (CMD -> TYPIO) ** V1.3D30 * KORREKTUR IN CPBUFH. CPBUFH-ERROR MIT DUMP. ** V1.3D20 * ANPASSUNGEN AN 31-BIT ADRESSIERUNGSMODUS (ALLE MODULE) ** V1.3D10 * PAR00E BEI SEQ-ABARBEITUNG GEAENDERT.SAW00->SAW40. WEGEN SIS USW. * NEU: INFO-MODUL FUER ABFRAGEN /INTR..,SH-VT CP0000XX;/INTR..,SH-RT * H15025B0; /INTR..,SH-AP APPLIKATION * (MOD: CPINF) ** V1.3C00 * NEU: CP NACHRICHTENTRACE. 4 TRACE-PUNKTE.EINSCHALTEN MIT * /INTR ..,TRC.ON AUS MIT /INTR ..,TRC.OFF . LISTE: CP.TRACELISTE * NEU: CP.SYSOUT. WIRD NUN IM PROGRAMM ZUGWIESEN. DURCH /INTR CH-LOG * WIRD EINE NEUE LOG-DATEI EROEFFNET(MOD: CPSYSFL) * AEND: /INTR CHANGE --> /INTR CH-SEQ. ** V1.3B00 * WEGEN VERSPAETET EINTREFFENDEN NACHRICHTEN NACH YCLOSE/RELM (CP-DUMP) * ABFRAGEERWEIT. UEBER VERBINDUNGSZUST. ANFANG CONTIES YRECASY + TERMA ** V1.3A11 * NEUER PARAMETER PTAST. P-TASTEN VARIABEL VON P7-P20 ** V1.3A10 * DA DURCH EINIGE FORMATE DIE SYSTEMZEILE DUNKELGEST. WIRD MUSS * 1D7C (HELL) EINGEFUEGT WERDEN. ** V1.3A01 * AEND: CONTXT MAKRO WEGEN DUMP BEI SHUTDOWN AUS ENDE-CONTI ENTFERNT. * NEU: DER AKTUELLE PAC WIRD JETZT IN DIE SYSTEMZEILE GESCHRIEBEN * (NACHBILDUNG ANZEIGEZEILE (LTG/TAST)). * PAR00D MIT AZL=41 IN KMASKANS, PAR00D MIT AZL=40 (RESET) * IN KMASKANF EIGEFUEGT. *** V1.3A00 * AENDERUNG IN CPBUFH WEGEN K3 UND KDCLAST ** V1.2D03 * AENDERUNG DER NEABT HANDLING * NEU: * ES WERDEN NUR DIE SSH 00 01 (K2 BEI TIAM) 11 13 15 17 * AN DIE PARTNER GESCHICKT, ALLES ANDERE WIRD AUF 41 * ASYN EINGABENACHRICHT GEANDERT *** V1.2D02 * EINFUEHEREN DES PAR ALLTERM FUER UIT * WENN ALLTERM = N DUERFEN NUR TERMNIAL MIT TS * MIT CP ARBEITEN ** * NEABT PROTOKOLL WIRD AUCH NACH YSEND AUF PARTNER BEI START * SEQUENC AUF 36 GESETZT UM BEI EINER TERMINALL EINGABE * ASYN EINGABENACHRICHT ZU ERREICHEN ** V1.2D01 * TERMINAL STARTDATEI WERDEN NEU UEBER SYSDTA GELESEN * STARTPARAMETER LAN/PRE/VT/LIB (ANGABE EINER PLAM BIB) * FUER TERMINAL STARTDATEIEN WERDEN VON SYSDTA GELESEN ** V1.2D00 * OPNMES UND LMSG WERDEN AUF WORDGRENZE AUSGERICHTET ** V1.2C11 * FEHLER:BEI PROGRAMM DIE STICKT FUER ESCBRKP DEFINIERT HABEN, * LAEUF STICK NUR EINMAL AB. * LOESUNG:NACH YSEND AUF PARTNER WIRD NEABT PROTOKOLL AUF '36' * GEAENDERT UM NAECHSTE TERMINALEINGABE ALS * ASYN. NACHRICHT AN PARTNER WEITERZUREICHEN ** V1.2C10 * WENN PARTNERTYP EINE APPL GIBS STAT REJLOG EIN YMOD ** V1.2C09 * HELPTEXT AUSGELAGERT IN CPHELP / CPHELPD ** V1.2C08 * CHANGE-REQUEST BETR. ENGLISCHE HELP-FUNKTION REALISIERT ** V1.2C07 ** V1.2C06 (CPBUFH) * BEI DCAM FEHLER WURDE CMD 'D %MR' ENTFERNT WEGEN SYSTEMDUMP * DURCH UEBERLAUFEN CL-5 SPEICHER (SYSLST) * 1.2C05 * IN LOGCP WIRD PARTNERTYPE ABGEFRAGT BEI APPL * GIBT ES REJLOG * MVC MIT CONSTANTET VERKUERZT UM PLATZ ZU SPAREN ** 1.2V04 * AUF VIELFACHEN WUNSCH WIRD DAS "ENDCP" KOMMANDO EINGEFUEHRT ** 1.2V03 * DA LA TASTEN NUR BEI EDITIN/EDITOUT=LINE VOM SYSTEM GELADEN * WERDEN, ERFOLGT ZUERST VOM TERMINAL DER VERBINDUNGSAUFBAU * MIT EDIT = LINE / NACHER GIBTS YSEND MIT EDIT LINE * UND DANN ENDLICH GIBTS YCHANGE AUF EDITIN/OUT=PHYS ** 1.2C02 * PAG ANGABEN (WAR-ZEICHEN IN 1.2C00 OFFENSICHTLICH IMMER NOCH * FALSCH) GEAENDERT (KMASNANF / U . A) * DIREKT NACH VERBINDUNGSAUFBAU WIRD AUCH EIN PAR01L * ZUSAETZLICH MITGESCHICKT UM LA/P - TASTEN FREI ZU GEBEN ** 1.2C01 * EINFUEHRUNG DES VIRTUELLEN TERMINAL * AUFRUF VON CP --> O CP01,MSG=C'VT:(MAX 8 STELLEN)' * CP VERSUCHT DIE STARTSEQUENZEN AUS DER DATEI * CP.V.T.(MAX 8 STELLEN) ZU LESEN * SCHALTER VTERM WIRD EINGEFUEHRT * WENN 'Y' SIND WIRD MSG OPERAND AUGEWERTET, SONST NICHT ** 1.2C00 * AENDERUNG IN CPBUFH * IN ZUISAMMENHANG MIT NEWLV UND SOLSIG ** 1.2B03 * CP SENDET AB SOFORT EIN BLANK ALS VERBINDUNGSNACHRICHT * SEQEUNEZ ZUM PTASTEN LADEN WIRD IN DER ERSTEN MELDUNG MITGESCHICKT * OUTPUT1 ** 1.2B02 * TYPE NACH COPY CMD IN INTR ROUTINE VERLAENGERT ** 1.2B01 * INTR KOMMANDO CHANGE ZUM WECHSELN DER START-SEQUENCE AUFGENOMMEN ** 1.2B00 * GEN AENDERUNG: REIHENFOLGE MUSS IMMER FTZ/ASZ (1E/1D) * WEGEN ALTEN GERAETEN SEIN ** A42 * EINFUEHREN EINER ZENTRALEN VERSIONNUMMER * CPVER ** A41 * NEUFBAU NUR MOEGLICH SOFERN PARTNER AUF RECEIVE * STEHT, D.H. DIE ERSTEND VIER (!) ZEICHEN WERDEN AUF "SEND" * ABGEPRUEFT ** A40 * IM ENACO BEI ASY YOPNCON FEHLTE DAS KOMMA, * SO DASS LEVEL=1 EINGESTELLT WORDEN IST * D.H. ASY YOPNCON KONNTE VON ALLEN UNTERBROCHEN WERDEN ** A39 * BEI UNKONTROLIIERTEN EINGABE VON DER TASTATUR, D.H * O AAAAAAAAAAAAAAAAA WURDE DIE LEANEG DES GENERIERTEN MVC * NICHT GEPRUEFT--> FUEHERTE UNTER ANDERM ZU UEBERSCHREIBSER * BEIM HOSTNAME *** A38 * EINFUEHEREN DER VARIABLE "CPNAME" --> ENTAHELT * DEN PREFIX FUER DIE CP-TERMINALS (BEIM OPNCON CMD) *** A37 * CP LOESCHT BEI EINER CP-AUSGABE DIE LA-TASTEN * UMSTELLUNG AUF PAG , DADURCH VERGROESSERUNG VON "KMASKANF" * UND "UCONFREE" ** * NACH GROESSER AENDERUNG IN CPBUFH WIRD VERSION NUMMER GEAENDERT *** * SEND AUF PARTNER NUR MOEGLICH SOFERN (USFREE UNGL 'D'/'F'/'O') *** * SOFERN VOR EINEM ASY KEINE ORDENTLICH MELDUNG (USFREE ':'ODER 'Y') * WIRD YRECASY VERWORFEN *** * STATION TABLE FUER CIRKA 250 EINTRAGE * PARTNER TABLE FUER GENAU 44 EINTRAEGE *** * PID WIRD IN KMASKE NICHT MEHR GEBRACHT * HELPTEXT STAT BLANK MIT LZE AUFGEFUELLT ** * LIFTIME AUF 10 SEC HOCHGESETZT **** * EINFUEHREN VON MEDLUNG ZCP0011 **** * SOFERN NUR DER STRING "LOCK " EINGEGEBEN WIRD * DARF NICHT IN DIE LOCK ROUTINE VERZZWEIGT WERDEN **** * SOFER DIE MELDUNG CP IS LOCKED (ZCP0010) * DARF AUCH BEIM LOSCON KEINE CPMASKE AUSGEGEBEN WERDEN **** * PROBLEM BEI LANGSAM YOPNCON: * - O KOMMANDO ABGESETZT * - DUE GEDRUECKT * - CPMASKE ERSCHEINT (DA NOCH KEINE VERBINDUNG BESTEHT) * - OPNCON TRIFFT EIN (CONTI YOPNCON) UND WIRD AKTUELLER PARTNER * - NECHSTE EINGABE WIRD ALS CPCMD INTERPRETIERT * DA DAS FELD STATK IN DER CONTI NICHT GELOEACHT WURDE *** * DCAM APPLIKATIONEN DIE NACH DEM YOPNCON ERF * KEINE NACHRICHT SCHICKEN , BEKAMMEN DAS NEABT PROTOKOLL * X'000000..' BEIM ERSTEN SEND GESCHICKT, DA DAS FELD USNEA * MIT LOW-VALUE VORBELEGT WIRD. * LOESUNG: USNEA WIRD MIT MIN-NEABT PROT VORBELEGT (X'365035..) * WEGEN SIDIAS UND UDS-DCAM ****** * EINFUEHRUNG VON CMD LOCK ****** * LINK IN ACB VON CP EINGEFUEHRT ****** * PROBLEM BEI WRTRD: * - PROGRAM SCHAFT MIT WRTRD * - WECHSEL AUF MASKE * - WECHSEL AUF PROGRAM * - K3 WIRD VON CPBUFH GESCHICKT * --> FOLGE BIS ZUR NAECHSTEN AUSGABE VOM PROGRAMM * IST KEINE EINGABE MOEGLICH (K2 ODER SO) * LOESUNG: NEUAFBAU VON CPBUFH WIRD NUR ANGESPRUNGEN * WENN OPNCON IO, ODER PARTNER AUF YRECEIVE STEHT ****** * VERSIONSZUSAMMENFUEHRUNG 75 BIS 92 * TYPE'S WERDEN ENTFERNT ****** * EIN YSEND AN EINEN PARTNER WID NUR WEITERGELEITET * WENN PARTER READY (USFREE = : ODER D) IST ****** * VERBINDUNGSNACHRICHT LAENGER * FDBK ABFRGAE BEI YRECASY FALSCH * TOVAL WURDE NICHT NEU AUFGEZOGEN * O.K 88.09.02 ****** * DECLARIERTE PARTNER WRDEN NICH GELOESCHT * EINFUEHREN VON STATSTOP (WIRD DURCH CPBUFH (FF) GESETZT WENN R * WARTEN AUF GO-SIGNAL RC:10040C ****** * NACH HELPMASKE WIRD NUR DER STRING "CMD:" * AUSGEGEBEN ****** * SOFERN BEIM ASY YRECEIVE VOM TERMNIAL EIN FEHLER AUFTTRITT * WIRD SOFORT AUF RETCO VERZWEIGT (AUSNAHME TOVAL ABGELAUFEN) ****** * * WENN NULLNACHRICHT VBON TERMINAL EMPFANGEN WIRD (D.H. * USERFIELD = ZERO) WIRD EINE ENTSPRECHENDE MELDUNG * AUSGEGEBEN ****** * FEHLER CODE WIRD WIEDER MIT WROUT AUSGEGEBEN * (AUCH TOVAL ABGELAUFEN) * 29.08.88 O.K. ****** * EINFUEGEN VON # !!! NICHT VOLSTAENDIG REALISIERT !!! * FUER EDIT=USER BEIM VERBINDUNGSAUFBAU ***** * AENDERN VON EDIT=SYSTEM AUF EDIT=USER FUER $CONSOLE * 25.08.88 O.K. * STATAKTP WIRD ERST NACH ! ERFOLGREICHEN YOPNCON VERSORGT * (FUEHRTE ZU DCAM RC 0C04) ****** * STATIONTAB WIRD GELOESCHT (190X00) * USERTAB WIRD GELOESCHR (190X00) * 23.08.88 O.K. * WENN AN $CONSOLE EINE KTASTE GESCHIVKT WIRD STOPT * MELDUNGSAUGABE UND NEW-LINE WIRD ANS TERMINAL GESCHIVKT * MELDUNG ZCP0003/7/8 ****** * EINFUEHREN CONT COMEND FUE BCLOSE * SYN YOPNCON WARTET 10 SEC * BEI AUFBAUF VON OMNIS ZU CP HAENGT CP ****** * * HELPMASKE WIRD AUCH MIT EID ABGESETZT * * CONTI YRECASY (ASY YREC VOM PARTNER $DIALOG) LEVEL 10 * BEI YSEND AUF TERMINAL LEVEL 5 * CONTI YOPNCON (ASY YOPNCON ERFOLGREICH) LEVEL 10 * CONTI LOSCO (VERBINDUNGSABAU DURCH PARTNER /LOGOFF) LEVEL 10 * CONTI LOGCP (VERBINDUNGSAUFBAU VOM TERMINAL ZUM CP) LEVEL 10 * CONTI LOSCP (VERBINDUNGSABAU VOM TERMINAL ZUM CP) LEVEL 10 * CONTI TERMA (ASY REC VON ALLEN TERMINALS) LEVEL 10 * CONTI ENDE (COMMEND) * CONTI INFCO (FUER SH-.. AUSGABEN IN CPINF AUF CONSOLE) LEVEL 10 * BEI TYPIO LEVEL 5 * CONTI STXERR (STXIT ROUTINE FUER PAGING-ERROR (IW48)) LEVEL 127 * LIFO-PRINZIP * CONTI CPCLOCK (STXIT MODUL FUER REALZEITGEBER ALLE 2 MIN.) LEVEL 127 * FIFO-PRINZIP 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 MCP002 AMODE ANY MCP002 RMODE ANY ##BAL OPSYN ##BAS ##BALR OPSYN ##BASR *---------------------------------------------------------------------* TITLE 'V O R L A U F ' ANF BASR R8,0 BCTR R8,0 BCTR R8,0 USING ANF,R8,R9,R10,R11,R12 LA R1,4095 LA R9,1(R8,R1) LA R10,1(R9,R1) LA R11,1(R10,R1) LA R12,1(R11,R1) USING STATEIN,R3 USING USEREIN,R4 *--- 8 SEITEN RESIDENT -----* L R15,CPCSTATA BASR R14,R15 *------------------------------------- OPEN LOGGING DATEI L R15,CPSYSFLA BASR R14,R15 *-------------------------------------- REQM 18 | FUER USER-PAG-TAB CLM R15,B'0001',=X'00' | BE REQUPGOK | TERMD | REQUPGOK EQU * | MVC 0(12,R1),=CL12'USER-PAG-TAB' LA R1,12(R1) | ST R1,USPGTBA | * ------ DIAGNOSE-TABELLE ------------------------------- REQM 4 | FUER DIAG-TAB CLM R15,B'0001',=X'00' | BE REQDTBOK | TERMD | REQDTBOK EQU * | MVC 0(16,R1),=CL16'DIAG-TAB-DIAG-T*' LA R1,16(R1) | ST R1,UDIATBA | ST R1,DIATABA LAUFEND | A R1,=A(X'2F00') LAENGE 12032 BYTE (CA. 150 EINTR.) ST R1,DIATABE TAB ENDE *----------------------------------------------------- L R4,=V(STXERR) STXIT ERROR=((R4),127) *----------------------------------------------------- B BEG FREE0 DC C'REP BEREICH ' DS CL50 DC C'REP BEREICH ENDE' DS 0F DS 0F SPACE TITLE 'L O S C O / ABBAU/LOGOFF' LOSCO EQU * BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CLOS ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CLOS' *DIA BAS R13,UPDIAUP *DIA ** ** LR R7,R6 LOSCON INFO LR R6,R5 USERFIELD L R3,STATANFA L R4,STATENDA LOSCOOP EQU * * A R3,=A(X'100') LA R3,256(R3) + X'100' CLM R6,B'0011',STATTID BE LOSCOT CR R3,R4 BL LOSCOOP RETCO LOSCOT EQU * L R4,USERPAGA L R5,USERPAGE LOSCOP EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLM R6,B'1100',USPID BE LOSCPX CR R4,R5 BL LOSCOP RETCO LOSCPX EQU * ******* AUSTRAG AUS USER-PAG-TAB BAS R14,ERUSPGTB ****** MVC USERROR,=CL15'CONNECTION LOST' MVI USFREE,C'F' ST R7,USRC ST R7,SAVRC L R7,USAID YCLOSE AID=(R7) CLM R15,B'1001',=X'0000' BE W167 MVC ERRTEXT,=CL20'A/YLOSCO/YCLOSE' BAS R14,FEHLER W167 EQU * LA R7,USEI DISEI EIID=(R7) LA R7,USCO DISCO COID=(R7) * CLI STATSTOP,X'FF' WARTEN AUF GO-SIGNAL IN CPBUFH ?? * BNE LOSNGO * CLC STASTPID(2),USPID MIT DIESEM PID ??? * BE A00 DANN DARF NICHT FREIGEGEBEN WERDEN *LOSNGO EQU * L R6,USIN * TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R6,12 LTR R6,R6 BNZ MCRELM1 MVC ERRTEXT,=CL20'A/LOSCON/RELM1/0' BAS R14,FEHLER B A00 MCRELM1 EQU * RELM 9,(R6) CLM R15,B'0001',=X'00' BE A00 MVC ERRTEXT,=CL20'A/LOSCON/RELM' BAS R14,FEHLER A00 EQU * XC USIN(4),USIN XC USAID(4),USAID XC USEI(4),USEI XC USCO(4),USCO L R15,TERMOUTA L R14,=F'38' MVC 0(38,R15),KMASKANF * A R15,=F'38' LA R15,38(R15) + 38 MVI Z2,X'FF' MVI Z3,X'FF' MVI Z4,X'FF' MVI Z5,X'FF' CLC STATPW,=XL8'00' BE P99 CLC STATPW,=CL8' ' BE P99 * CLI STATK,X'10' KMASKE AUF SCHIRM?? * BE P99 JA RETCO P99 CLI SAVRC+3,X'00' LOSCON EREIGNIS 00 ?? YDDFDB BNE P99RET BAS R13,KMASKE P99RET RETCO SAVRC DS F SPACE TITLE 'L O G C P / VERB AUFBAU VON TERMINAL ZU CP' LOGCP BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CLOG ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CLOG' *DIA BAS R13,UPDIAUP *DIA ** ** MVC OPNMES(11),=CL80' ' YGENCB BLK=RPB,OPTCD=(Q,ANY,SYN,NTACK),AAREA=OPNMES, - AAREALN=11 LR R6,R1 YGENCB BLK=CCB,PTNNAME=PNAMLOG,PRONAME=PROLOG,EDIT=SYSTEM, - EDITIN=(LINE,LCASE),EDITOUT=LINE,PROC=SIGNAL,MAXLN=12288 LR R7,R1 YINQUIRE RPB=(R6),AID=(R3),LID=(R4),CCB=(R7) CLM R15,B'1001',=X'0000' BE W8 MVC ERRTEXT,=CL20'A/YOPN/LOGIN' BAS R14,FEHLER W8 EQU * **V3 CLI VTERM,C'Y' **V3 BE Q3 **V3 MVC OPNMES(11),=CL80' ' Q3 XR R0,R0 YTESTCB BLK=CCB,BLKADDR=(R7),ERET=Q10,PTNTYPE=TERM Q10 CL R0,=F'0' BE Q11 YMODCB BLK=CCB,BLKADDR=(R7),EDIT=USER CLM R15,B'1000',=X'00' BE Q11 MVC ERRTEXT,=CL20'A/YOPN/YMODX/USER' BAS R14,FEHLER RETCO * YREJLOG AID=(R3),RPB=(R6),AAREA=PNAMLOG,AREA=PROLOG * RETCO Q11 L R3,STATANFA L R4,STATENDA XR R5,R5 LOOP EQU * AH R5,=H'1' * A R3,=A(X'100') LA R3,256(R3) + X'100' CLI STATPNA,X'00' BE GOTONE CR R3,R4 BL LOOP STATF MVC OUTPUT,=CL26'ZCP0001 STATION TABLE FULL' B LOGSENDB GOTONE REQM 3 CLM R15,B'0001',=X'00' BE LOGREQ MVI STATPNA,X'00' MVC OUTPUT,=CL26'ZCP0002 REQM MEMORY ERROR' B LOGSENDB LOGREQ ST R1,USERPAGA A R1,=A(X'2C00') ST R1,USERPAGE YMODCB BLK=CCB,BLKADDR=(R7),USERFLD=(R5) CLM R15,B'1000',=X'00' BE W9 MVC ERRTEXT,=CL20'A/YOPN/YMOD0/USER' BAS R14,FEHLER W9 EQU * YOPNCON RPB=(R6),CCB=(R7),AREALN=1,AREA=BL,TOVAL=30 CLM R15,B'1001',=X'0000' BE W10 MVC ERRTEXT,=CL20'A/YOPN/YOPN' BAS R14,FEHLER MVI STATPNA,X'00' L R5,USERPAGA SRA R5,12 LTR R5,R5 BNZ MCRELM2 MVC ERRTEXT,=CL20'A/RELM/RELM2/0' BAS R14,FEHLER B MCRELM2N MCRELM2 EQU * RELM 3,(R5) MCRELM2N EQU * RETCO W10 EQU * LA R2,STATEI *** ENAEI NAME GENERIEREN GENENAM EQU * L R1,ENANUM LA R1,1(R1) ST R1,ENANUM CVD R1,DOWO1 UNPK RES1,DOWO1 MVZ RES1+8(1),=X'F0' MVC EINAMOP(2),=C'EI' MVC EINAMOP+2(6),RES1+3 *** ENAEI EINAMAD=EINAMOP,EIIDRET=(R2) Y01 YSEND RPB=(R6),CCB=(R7),AREALN=1,AREA=BL,EID=(R2) CLM R15,B'1001',=X'0000' BE Y03 MVC ERRTEXT,=CL20'A/YOPN/1SEND' CLM R15,B'1110',=X'10040C' BNE Y02 SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10 CLM R15,B'0001',=X'00' BE Y01 MVC ERRTEXT,=CL20'A/YOPN/1SEND/SOL' Y02 BAS R14,FEHLER Y03 EQU * YMODCB BLK=CCB,BLKADDR=(R7), - EDITIN=(PHYS,LCASE),EDITOUT=PHYS CLM R15,B'1000',=X'00' BE X1 MVC ERRTEXT,=CL20'A/YOPN/YMOD0/EDIT' BAS R14,FEHLER X1 EQU * YCHANGE RPB=(R6),CCB=(R7) CLM R15,B'1001',=X'0000' BE X2 MVC ERRTEXT,=CL20'A/YOPN/YCHANGE' BAS R14,FEHLER X2 EQU * L R15,TERMOUTA MVC 0(46,R15),KMASKAN1 * A R15,=F'46' F'32' LA R15,46(R15) + 46 MVC 0(80,R15),OUTPUT11 YSHOWCB BLK=RPB,BLKADDR=(R6),WAREA=CIDLOG,LENGTH=4, - FIELDS=(CID) CLM R15,B'1001',=X'0000' BE W11 MVC ERRTEXT,=CL20'A/YOPN/YSHO/CID' BAS R14,FEHLER W11 EQU * ** OPNMES TRANSLATEN FALLS ALTE FORM TR OPNMES(11),TRANST ** STATIONSTABBEL VERSORGEN MVC STAIDCP,AIDCP MVC STATPNA,PNAMLOG MVC STATPRO,PROLOG MVC STATCID,CIDLOG YGENCB BLK=RPB,OPTCD=(Q,ANY,SYN,NTACK) ST R1,STATRPB1 ST R6,STATRPBA ST R7,STATCCBA STH R5,STATTID MVI STATK,X'10' MVI STATZZ,X'00' MVC STATAKTP,=H'0' MVC TERMTYP,=F'0' MVC STATSTOP,=F'0' MVC STATPW,=XL8'00' MVI STATFREE,X'00' MVI STATADM,X'00' MVC Z1(80),=CL80' ' MVC Z1(20),=CL20'ZCP0004 TERMINAL: ' MVC Z1+20(8),PNAMLOG MVI Z1+28,C'/' MVC Z1+29(8),PROLOG MVC Z1+37(4),='TID:' CVD R5,DOWO UNPK RES,DOWO MVZ RES+8(1),=X'F0' MVC Z1+41(3),RES+6 L R4,USERPAGA L R5,USERPAGE XR R6,R6 MVC LD1FILE(25),=CL80' ' MVC LD1FILE(3),=C'CP.' MVC LD1FILE+3(8),PROLOG LA R14,LD1FILE C000 AH R14,=H'1' CLI 0(R14),C' ' BNE C000 MVI 0(R14),C'.' MVC 1(8,R14),PNAMLOG ** TROZTDEM MSG ?? CLC OPNMES(3),=C'VT:' BNE C001 ** JA. DANN WIE BISHER MVC LD1FILE(25),=CL25'CP.V.T.' MVC LD1FILE+7(8),OPNMES+3 MVC STATVT(8),OPNMES+3 C001 EQU * MVC Z2(80),=CL80' ' MVC Z2(25),LD1FILE * SOFER KEIN LIB PARAMETER WIRD NACH DER DATEI ALEINE GESUCHT CLI LIB,C' ' BE Q0 MVC Z2(45),LIB VON 30 AUF 45 V2.1B30 LA R14,Z2 C002 AH R14,=H'1' CLI 0(R14),C' ' BNE C002 MVI 0(R14),C'(' MVC 1(25,R14),LD1FILE LA R14,Z2 C0 AH R14,=H'1' CLI 0(R14),C' ' BNE C0 MVI 0(R14),C')' PRINT GEN,BASE Q0 MVC SYSF+47(55),Z2 LEN VON 40 AUF 55 V2.1B30 * VERSORGEN IN VORBELEGUNG SYSF SYSFL 'SYSDTA=123456789012345678901234567890123456789012345678- 9012345' PRINT NOGEN,BASE ** MSG ODER PRONAM.STATNAM ??? CLM R15,B'0001',=X'00' BNE C20 ** JA C1 MVC LOPAC(20),=CL80' ' RDATA LODAT,C10,80 * GET FCBLOG,LODAT CLC LOPAC(12),=CL12'*CP01-PARAM:' BNE P30DEV MVC STATPW,LOTERM MVC STATFREE,LOFREE MVC STATADM,LOADM ADMINSTR ?? Y/N P30DEV EQU * CLC LOPAC(12),=CL12'*CP01-HCDEV:' BNE P30 MVC STATDEV(8),LOTERM HC-DEVICE NAME MVC STATFORM(8),=C'STD ' FORMULAR NAME MVC STATHCTY(1),LOTERM+16 CLC LOPAC+20(8),=CL8' ' BE P30 MVC STATFORM(8),LOTERM+8 FORMULAR NAME P30 CLI LOPAC,C'*' BE C1 C2 EQU * AH R6,=H'1' * A R4,=A(X'100') LA R4,256(R4) + X'100' CLI USPID+1,X'00' BE C3 CR R4,R5 BL C2 B C10 C3 EQU * CLC LOTERM,=CL8' ' BNE C4 L R15,OPENUM LA R15,1(R15) + 1 ST R15,OPENUM CVD R15,DOWO UNPK RES,DOWO MVZ RES+8(1),=X'F0' MVC LOTERM(2),CPNAME MVC LOTERM+2(6),RES+3 C4 EQU * MVC USCPNAME,LOTERM MVC USPRO,LOPRO MVC USAID,=F'0' MVC USCID,=F'0' MVC USREF,LOREF MVC USPNA,LOPAR MVC USTYP,LOTYP STH R6,USPID MVI USOKZ,X'00' MVC USLEN,=F'0' MVC USADR1,=F'0' MVC USADR2,=F'0' MVC USADR3,=F'0' MVC USADR4,=F'0' MVC USLOE1,LOMSG MVC USLOE1SA,LOMSG MVC USRC,=F'0' CVD R6,DOWO UNPK RES,DOWO MVZ RES+8(1),=X'F0' MVC USPAC,RES+5 CLC LOPAC,=CL4' ' BE C11 MVC USPAC,LOPAC C11 MVC USNEA,=XL8'3650350000000000' MVC USERROR,=CL15'DECL SEQ:' MVC USERROR+10(4),LOSEQ MVC USSEQ,LOSEQ MVC USSEQSA,LOSEQ MVC USKEY1,=C'0000' MVI USFREE,C'D' MVI USDEC,C'D' MVC USLOE2,LOPASS MVC USLOE2SA,LOPASS XC USLOE3(25),USLOE3 MVC USTEXTA,=F'0' MVC USTEXTE,=F'0' MVC USTERMS,=F'0' MVC USIN,=F'0' MVC USLEN,=F'0' MVC USRES,=F'0' MVC USCO,=F'0' MVC USEI,=F'0' MVC USRPBA,=F'0' MVC USCCBA,=F'0' B C1 *C10 CLOSE FCBLOG C10 SYSFL 'SYSDTA=(PRIMARY)' MVC Z1+44(16),=CL16'/START-SEQ PERF.' CLC OPNMES(3),=C'VT:' BNE Q1 MVC Z1+65(11),OPNMES Q1 B LOGSEND C20 EQU * ** BISHER KEIN TERM-ELEMENT GEFUNDEN. AUSGABE V3 MASKE LOGINPRC EQU * L R15,TERMOUTA * NICHT FUER LOGIN XR R14,R14 * NICHT FUER LOGIN MVI Z2,X'FF' * NO TEXT MVI Z3,X'00' * KEIN CMD MVI Z4,X'00' * KEINE KMASK MVI Z5,X'00' * DUNKEL MVI STATANM,X'FF' * LOGIN-MENU BAS R13,KMASKE * RETCO * **KEEP ---------------------------------------------------**KEEP * **KEEPC20 MVC Z1+44(16),=CL16'/NO START-SEQ' **KEEP CLI ALLTERM,C'N' **KEEP BNE LOGSEND L R15,TERMOUTA L R14,=F'126' * A R15,=F'126' F'112' LA R15,126(R15) + 126 MVC 0(10,R15),=X'2798279827981ED81DC8' * A R15,=F'10' LA R15,10(R15) + 10 * A R14,=F'10' LA R14,10(R14) + 10 MVC 0(40,R15),=CL40'ZCP0041 REJECT: TERMINAL NOT DECLARED' * A R15,=F'40' LA R15,40(R15) + 40 * A R14,=F'40' LA R14,40(R14) + 40 MVI Z2,X'FF' * KEIN TEXT* MVI Z3,X'00' * KEIN CMD * MVI Z4,X'00' * KEINE KMASK * MVI Z5,X'FF' * NICHT DUNKEL BAS R13,KMASKE L R5,USERPAGA SRA R5,12 LTR R5,R5 BNZ MCRELM3 MVC ERRTEXT,=CL20'A/RELM/RELM3/0' BAS R14,FEHLER B MCRELM3N MCRELM3 EQU * RELM 3,(R5) MCRELM3N PASS L R6,STATRPBA YCLSCON RPB=(R6) XC STATPNA(250),STATPNA RETCO *------------------------------------ **KEEP BIS HIER LOGSEND EQU * * TYPIO MSG=ZCP8MSG L R15,TERMOUTA L R14,=F'206' F'192' * A R15,=F'126' F'112' LA R15,126(R15) + 126 MVC 0(80,R15),Z1 * A R15,=F'80' LA R15,80(R15) + 80 * P-TASTEN WERDEN GELADEN MVC 0(27,R15),OUTPUT1 * A R15,=F'27' LA R15,27(R15) * A R14,=F'27' LA R14,27(R14) MVI Z2,X'FF' MVI Z3,X'FF' MVI Z4,X'FF' MVI Z5,X'FF' CLC STATPW,=XL8'00' BE P6 CLC STATPW,=CL8' ' BE P6 LA R1,STATPW LA R2,STATPW+8 P10 CLI 0(R1),C' ' BE P11 AH R1,=H'1' CR R1,R2 BL P10 B P12 P11 MVI 0(R1),X'00' B P10 P12 EQU * *12 MVC Z2(4),=X'1ED81DC2' * MVC Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK' * MVC Z2+45(4),=X'1ED71DC4' MVI Z3,X'00' * KEIN CMD * MVI Z4,X'00' * KEINE KMASK * MVI Z5,X'00' * DUNKEL GEST * MVC STAPWSAV,STATPW P6 BAS R13,KMASKE *-------------3 PAGES FUER HCPRINT ------------------ REQMHCP REQM 3 PAGE 1-2 INPUT LTR R15,R15 BE HCPRROK MVC ERRTEXT,=CL20'A/YOPN/HC/REQM' BAS R14,FEHLER B REQMHCP HCPRROK EQU * ST R1,STATHCPG PAGE 3 OUTPUT *-------------3 PAGES FUER HCPRINT ------------------ RETCO LOGSENDB EQU * YOPNCON RPB=(R6),CCB=(R7),AREALN=26,AREA=OUTPUT,TOVAL=3 CLM R15,B'1001',=X'0000' BE W12 BAS R14,FEHLER W12 PASS YCLSCON RPB=(R6) CLM R15,B'1001',=X'0000' BE W131 BAS R14,FEHLER W131 RETCO * * SPACE TITLE 'Y O P N C O N / ASY OPNCON COMPLETED' YOPNCON BASR R15,0 USING *,R15 LR R5,R1 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CYOP ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CYOP' *DIA BAS R13,UPDIAUP *DIA ** ** ST R5,RPBAOP YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=FDBKOP,LENGTH=4, - FIELDS=(FDBK) CLM R15,B'1000',=X'00' BE W900 MVC ERRTEXT,=CL20'A/YOPNT/YSHO/FDBK' BAS R14,FEHLER RETCO W900 YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=MVCFOP,LENGTH=4, - FIELDS=(USER) CLM R15,B'1001',=X'0000' BE W13 MVC ERRTEXT,=CL20'A/YOPNT/YSHO/USER' BAS R14,FEHLER W13 YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=CCBOP,LENGTH=4, - FIELDS=(CCB) CLM R15,B'1001',=X'0000' BE W14 MVC ERRTEXT,=CL20'A/YOPNT/YSHO/USER' BAS R14,FEHLER W14 XR R5,R5 XR R6,R6 LH R5,MVCFOP+2 (STATTID) LH R6,MVCFOP (USPID) L R3,STATANFA L R4,STATENDA YOPLOOP EQU * * A R3,=A(X'100') LA R3,256(R3) + X'100' CLM R5,B'0011',STATTID BE YOPGOT CR R3,R4 BL YOPLOOP RETCO YOPGOT EQU * L R4,USERPAGA L R5,USERPAGE YOPPOP EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLM R6,B'0011',USPID BE YOTOP CR R4,R5 BL YOPPOP RETCO YOTOP EQU * L R15,FDBKOP CLM R15,B'1000',=X'00' BE YOTOP1 ST R15,USRC MVC USERROR,=CL15'OPNCON ERROR' MVI USFREE,C'F' L R7,USAID YCLOSE AID=(R7) CLM R15,B'1001',=X'0000' BE W200 MVC ERRTEXT,=CL20'A/YOPNPN/YCLOSE' BAS R14,FEHLER W200 EQU * LA R7,USEI DISEI EIID=(R7) LA R7,USCO DISCO COID=(R7) L R7,USIN * TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R7,12 LTR R7,R7 BNZ MCRELM4 MVC ERRTEXT,=CL20'A/RELM/RELM4/0' BAS R14,FEHLER B A02 MCRELM4 EQU * RELM 9,(R7) CLM R15,B'0001',=X'00' * CMD '/D %7' REQM TRACE BE A02 MVC ERRTEXT,=CL20'A/YOPNPN/RELM' BAS R14,FEHLER A02 EQU * XC USIN(4),USIN | XC USAID(4),USAID > LOESCHEN WENN TIMEOUT VON PART XC USEI(4),USEI | XC USCO(4),USCO | RETCO YOTOP1 L R5,RPBAOP YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=OPCID,LENGTH=4, - FIELDS=(CID) CLM R15,B'1001',=X'0000' BE W16 MVC ERRTEXT,=CL20'A/YOPNT/YSHO/CID' BAS R14,FEHLER W16 MVC USCID,OPCID MVC STATAKTP,USPID * BEI ERFOLGREICHEM YOPNCON WIRD CPMASKE ZURUECKGESTETZT MVI STATK,X'00' MVC USERROR,=CL15'OPNCON ACCEPTED' MVI USFREE,C'Y' MVC YOPEI,USEI MVC YOPCO,USCO DISEI EIID=YOPEI CLM R15,B'1001',=X'0400' BE W17 MVC ERRTEXT,=CL20'A/YOPNT/DISEI' BAS R14,FEHLER W17 DISCO COID=YOPCO CLM R15,B'1001',=X'0400' BE W18 MVC ERRTEXT,=CL20'A/YOPNT/DISCO' BAS R14,FEHLER * 1 ASY YREC W18 MVC REECON+2(8),USCPNAME MVC REEEI+2(8),USCPNAME ENAEI EINAMAD=REEEI,EIIDRET=REEI CLM R15,B'1001',=X'0400' BE W19 MVC ERRTEXT,=CL20'A/YOPNT/ENAEI' BAS R14,FEHLER W19 LA R5,RPBAOP ENACO CONAMAD=REECON,COADAD=RECA,COMAD=(R5),COIDRET=RECO, - LEVEL=10 CLM R15,B'1001',=X'0400' BE W20 MVC ERRTEXT,=CL20'A/YOPNT/ENACO' BAS R14,FEHLER W20 EQU * MVC USEI,REEI MVC USCO,RECO W21 EQU * L R5,USRPBA L R6,MVCFOP YMODCB BLK=RPB,BLKADDR=(R5),EIDREF=(R6) CLM R15,B'1000',=X'00' BE W165 MVC ERRTEXT,=CL20'A/YOPNT/YMOD/EIDREF' BAS R14,FEHLER W165 EQU * L R2,USIN L R5,USRPBA L R6,USAID L R7,USCID YRECEIVE RPB=(R5),AAREA=(R2),EID=REEI,AID=(R6),CID=(R7) CLM R15,B'1001',=X'0000' BE W22 MVC ERRTEXT,=CL20'A/YOPNT/YREC' BAS R14,FEHLER W22 EQU * *** EINTRAG IN USER-PAG-TAB L R5,USPGTBA L R2,=A(X'1F40') 8000 X 9B W22X1 EQU * XC 0(1,R5),=X'00' BZ W22X2 LA R5,9(R5) BCT R2,W22X1 W22X2 EQU * MVI 0(R5),X'FF' STCM R4,B'1111',1(R5) MVC USTATPNA(8),STATPNA MVC USTATPRO(8),STATPRO MVC USTATVT(8),STATVT **** LA R5,USEI LA R6,USCO SOLSIG EIID=(R5),COID=(R6),LIFETIM=43200 CLM R15,B'1001',=X'0000' BE W23 MVC ERRTEXT,=CL20'A/YOPNT/SOLSIG' BAS R14,FEHLER W23 RETCO * SPACE TITLE 'L O S C P / VERB ABBAU VON TERMINAL ZU CP' LOSCP BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CLCP ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CLCP' *DIA BAS R13,UPDIAUP *DIA ** ** L R3,STATANFA L R4,STATENDA LOSLOOP EQU * * A R3,=A(X'100') LA R3,256(R3) + X'100' CLM R5,B'0011',STATTID BE LOSGOT CR R3,R4 BL LOSLOOP * USERFIELD NICHT GEFUNDEN RETCO LOSGOT EQU * BAS R13,FREEALL RETCO FREEALL MVC STATTID,=X'0000' MVI STATPNA,X'00' L R4,USERPAGA L R5,USERPAGE LOSCOK EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLI USPID+1,X'00' BE LOSCOKN ICM R6,B'1111',USAID BZ LOSCOKN L R7,USCID YCLSCON RPB=RPBCLOS,AID=(R6),CID=(R7) CLM R15,B'1001',=X'0000' BE W170 MVC ERRTEXT,=CL20'A/YLOSCP/YCLSCON' BAS R14,FEHLER W170 EQU * YCLOSE AID=(R6) CLM R15,B'1001',=X'0000' BE W110 MVC ERRTEXT,=CL20'A/YLOSCP/YCLOSE' BAS R14,FEHLER W110 EQU * ******* AUSTRAG AUS USER-PAG-TAB BAS R14,ERUSPGTB ******* LA 6,USEI DISEI EIID=(R6) LA 6,USCO DISCO COID=(R6) LA R6,STATEI DISEI EIID=(R6) * CLI STATSTOP,X'FF' WARTEN AUF GO-SIGNAL IN CPBUFH ?? * BNE LOSCNGO * CLC STASTPID(2),USPID MIT DIESEM PID ??? * BE A03 DANN DARF NICHT FREIGEGEBEN WERDEN *LOSCNGO EQU * L R6,USIN SRA R6,12 LTR R6,R6 BNZ MCRELM5 MVC ERRTEXT,=CL20'A/RELM/RELM5/0' BAS R14,FEHLER B A03 MCRELM5 EQU * RELM 9,(R6) CLM R15,B'0001',=X'00' BE A03 MVC ERRTEXT,=CL20'A/LOSCP/RELM' BAS R14,FEHLER A03 EQU * LOSCOKN CR R4,R5 BL LOSCOK L R5,STATHCPG SRA R5,12 LTR R5,R5 BNZ MCRELM6 MVC ERRTEXT,=CL20'A/RELM/RELM6/0' BAS R14,FEHLER B A05HCPG MCRELM6 EQU * RELM 3,(R5) HCPAGE WIRD FREIGEGEBEN CLM R15,B'0001',=X'00' BE A05HCPG MVC ERRTEXT,=CL20'A/LOSCON/RELM/HC' BAS R14,FEHLER A05HCPG L R5,USERPAGA * USERPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R5,12 LTR R5,R5 BNZ MCRELM7 MVC ERRTEXT,=CL20'A/RELM/RELM7/0' BAS R14,FEHLER B A05 MCRELM7 EQU * RELM 3,(R5) CLM R15,B'0001',=X'00' BE A05 MVC ERRTEXT,=CL20'A/LOSCON/RELM/US' BAS R14,FEHLER A05 EQU * XC STATPNA(250),STATPNA BR R13 * *********************************************************** DS 3F KMASKE EQU * ST R13,KMASKE-4 SAVEN ST R7,KMASKE-8 ST R2,KMASKE-12 L R13,CPKMASKA BASR R7,R13 LTR R15,R15 <> 0 FEHLER GES. IN MODUL CPKMASK?? BZ KMASKEE BAS R14,FEHLER KMASKEE L R13,KMASKE-4 L R7,KMASKE-8 L R2,KMASKE-12 BR R13 DS 0F *---------------------------------------------------------------------* * E N T R I E S *---------------------------------------------------------------------* ENTRY ERRTEXT ENTRY Z2 ENTRY Z3 ENTRY Z4 ENTRY Z5 ENTRY Z6 ENTRY TEXT1 ENTRY OUTPUT2 ENTRY ERR15 ENTRY TERMOUTA ENTRY KMASKE ENTRY LOCKTIM *---------------------------------------------------------------------* *********************************************************** DS 0F BEG EQU * MVC Z1(80),=CL80' ' RDATA Z1,BEG090,49 CLI Z1+4,C' ' BE BEG090 CLI Z1+4,C'/' BE BEG090 CLC Z1+4(3),=C'END' BE BEG090 CLC Z1+4(4),=C'LAN=' BNE BEG001 MVC LANGUE,Z1+8 BEG001 CLC Z1+4(4),=C'PRE=' BNE BEG002 MVC CPNAME,Z1+8 BEG002 CLC Z1+4(3),=C'VT=' BNE BEG003 MVC VTERM,Z1+7 BEG003 CLC Z1+4(8),=C'ALLTERM=' BNE BEG004 MVC ALLTERM,Z1+12 BEG004 CLC Z1+4(6),=C'PTAST=' BNE BEG005 CLI Z1+10,X'D5' P20< D4 = P20, D5 = KEINE AKTION (N) BH BEG005 CLI Z1+10,X'D1' BNL BEG0041 CLI Z1+10,X'C9' BH BEG005 CLI Z1+10,X'C1' BNL BEG0041 CLI Z1+10,X'7C' BNE BEG005 BEG0041 CLI Z1+12,X'D5' P20< BH BEG005 CLI Z1+12,X'D1' BNL BEG0042 CLI Z1+12,X'C9' BH BEG005 CLI Z1+12,X'C1' BNL BEG0042 CLI Z1+12,X'7C' BNE BEG005 BEG0042 EQU * MVC ESCN(1),Z1+10 MENU MVC ESCO(1),Z1+12 BLAETTER MVC ESCW(1),Z1+14 HARDCOPY CLI Z1+10,X'D5' (N) NO ACTION BE BEG00421 BEI (N) WIRD DAFUER EINE ANDERE MVC ESCSAV(3),ESCN BELEGTE PTASTE 2 MAL GELADEN BEG00421 CLI Z1+12,X'D5' BE BEG00422 MVC ESCSAV(3),ESCO BEG00422 CLI Z1+14,X'D5' BE BEG00423 MVC ESCSAV(3),ESCW BEG00423 CLI Z1+10,X'D5' BNE BEG00425 MVC ESCN(3),ESCSAV BEG00425 CLI Z1+12,X'D5' BNE BEG00426 MVC ESCO(3),ESCSAV BEG00426 CLI Z1+14,X'D5' BNE BEG005 MVC ESCW(3),ESCSAV B BEG005 BEG005 CLC Z1+4(4),=C'LIB=' BNE BEG006 MVC LIB,Z1+8 BEG006 CLC Z1+4(8),=C'LOCKTIM=' BNE BEG007 CLC Z1+12(2),=C'01' BL BEG007 CLC Z1+12(2),=C'99' BH BEG007 PACK LOCKTIM1(8),Z1+12(2) CVB R14,LOCKTIM1 MH R14,=H'60' ST R14,LOCKTIM LOCKTIME BINAER L R14,=V(CPCLOCK) STXIT RTIMER=((R14),0) SETIC REALTIM=CPUTIM BEG007 CLC Z1+4(4),=C'SEQ=' BNE BEG MVC SEQ,Z1+8 MVC FD1FILE(54),SEQ B BEG BEG090 STXIT INTR=INTRC,INTRBUF=INTRTXT ENAEI EINAME=INFENACP,EIIDRET=EIRETI ENACO CONAME=INFCONCP,COADAD=INFCOA,COIDRET=IDINFCP,LEVEL=10 SOLSIG EIID=EIRETI,COID=IDINFCP *------- HC-CONTI ENAEI EINAME=HCENACP,EIIDRET=EIIDHC ENACO CONAME=HCCONCP,COADAD=HCPRCOA,COIDRET=IDHCOCP,LEVEL=8 SOLSIG EIID=EIIDHC,COID=IDHCOCP,LIFETIM=43000 MVC CPHELPA,CPHELPAD CLI LANGUE,C'D' BE BEG0 MVC CPHELPA,CPHELPAE BEG0 MVC CPVER2,CPVER MVC CPVER3,CPVER MVC CPVER4,CPVER MVC CPNAMED,CPNAME MVC CPLAN,LANGUE MVC CPVT,VTERM MVC CPALL,ALLTERM MVC CPSEQ(54),SEQ WROUT ZCP3MSG,W31 W31 ENACO CONAME=COMCP,COADAD=ENDEA,COIDRET=IDENDECP,LEVEL=20 CLM R15,B'1001',=X'0400' BE A100 MVC ERRTEXT,=CL20'S/BEG/ENACO0' BAS R14,FEHLER A100 ENACO CONAME=LOGCP,COADAD=ALOGCP,COIDRET=IDLOGCP,LEVEL=10 CLM R15,B'1001',=X'0400' BE W32 MVC ERRTEXT,=CL20'S/BEG/ENACO1' BAS R14,FEHLER W32 ENACO CONAME=LOSCP,COADAD=ALOSCP,COIDRET=IDLOSCP,LEVEL=10 CLM R15,B'1001',=X'0400' BE W33 MVC ERRTEXT,=CL20'S/BEG/ENACO1' BAS R14,FEHLER W33 ENACO CONAME=LOSCO,COADAD=ALOSCO,COIDRET=IDLOSCO,LEVEL=10 CLM R15,B'1001',=X'0400' BE W132 MVC ERRTEXT,=CL20'S/BEG/ENACO1' BAS R14,FEHLER W132 REQM 40 CLM R15,B'0001',=X'00' BE W34 MVC ERRTEXT,=CL20'S/BEG/REQM' BAS R14,FEHLER TERMD W34 ST R1,STATANFA A R1,=A(X'01FE00') ST R1,STATENDA ST R1,SAVTABA * A R1,=A(X'200') LA R1,512(R1) + X'200' ST R1,DCAMTESA LR R15,R1 A R15,=A(X'2500') >SAP ST R15,TERMOUTA * A R1,=A(X'8') LA R1,8(R1) + X'8' ST R1,DCAMTEA YOPEN ACB=ACBCP CLM R15,B'1001',=X'0000' BE W35 MVC ERRTEXT,=CL20'S/BEG/YOPEN' BAS R14,FEHLER W35 YSHOWCB BLK=ACB,BLKADDR=ACBCP,WAREA=AIDCP,LENGTH=4, - FIELDS=(AID) CLM R15,B'1001',=X'0000' BE START MVC ERRTEXT,=CL20'S/BEG/YSHOW/AID' BAS R14,FEHLER * 1 ASY REC FUER TERMINAL EINGABEN START EQU * * TYPIO MSG=ZCP3MSG OPEN FCBSEQ,INPUT * 1 ASY YREC ENAEI EINAME=TERMEI,EIIDRET=TEREI CLM R15,B'1001',=X'0400' BE W500 MVC ERRTEXT,=CL20'S/START/ENAEI' BAS R14,FEHLER W500 EQU * ENACO CONAME=TERMCON,COADAD=TERMA,COIDRET=TERCO,LEVEL=10 CLM R15,B'1001',=X'0400' BE W501 MVC ERRTEXT,=CL20'A/START/ENACO' BAS R14,FEHLER W501 EQU * L R14,DCAMTEA YRECEIVE RPB=RPBSYN,AAREA=(R14),AAREALN=4100, - CCB=CCBSYN,EID=TEREI,ACB=ACBCP CLM R15,B'1000',=X'00' BE W502 MVC ERRTEXT,=CL20'S/START/YREC' BAS R14,FEHLER W502 SOLSIG EIID=TEREI,COID=TERCO,LIFETIM=43200 CLM R15,B'1001',=X'0000' BE W504 MVC ERRTEXT,=CL20'A/START/SOLSIG' BAS R14,FEHLER * HAUPTPROGAMM W504 SUSPEND B W504 SPACE TITLE 'T E R M / ASY REC VON ALLEN TERMINALS ' TERM EQU * BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CTER ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CTER' *DIA BAS R13,UPDIAUP *DIA * * L R14,CRECCNT | * SH R14,=H'1' > ASYN REC ZAEHLER (-1) * ST R14,CRECCNT | ** ** YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=FDBKSY,LENGTH=4, - FIELDS=(FDBK) L R15,FDBKSY * CLM R15,B'1010',=X'0410' * SOFERN TOVAL ABGE * BE SCHLEIFE SETZE NEUEN YREC AB * CLM R15,B'1000',=X'08' VERBIND.ZUST. FALSCH? ZB YCLOSE * BNE TFDBKN08 * CLM R15,B'0100',=X'40' ANW EXISTIERT NICHT * BL SCHLEIFE TFDBKN08 CLM R15,B'1000',=X'00' BE W38 MVC ERRTEXT,=CL20'A/TERM/FDBK' BAS R14,FEHLER B SCHLEIFE W38 YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=USERFLD,LENGTH=4, - FIELDS=(USER) CLM R15,B'1001',=X'0000' BE W39 MVC ERRTEXT,=CL20'S/SCH/YSHO/USER' BAS R14,FEHLER W39 EQU * L R5,USERFLD CLM R5,B'0011',=X'0000' BNE CX XR R15,R15 MVC ERRTEXT,=CL20'A/TERM/USER=0' BAS R14,FEHLER B SCHLEIFE CX YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=NRTLEN,LENGTH=4, - FIELDS=(ARECLN) CLM R15,B'1001',=X'0000' BE W40 MVC ERRTEXT,=CL20'S/SCH/YSHO/LEN' BAS R14,FEHLER W40 L R3,STATANFA L R4,STATENDA L R5,USERFLD SYNLOOP EQU * * A R3,=A(X'100') LA R3,256(R3) + X'100' CLM R5,B'0011',STATTID BE SYNGOT CR R3,R4 BL SYNLOOP * USERFIELD NICHT GEFUNDEN B SCHLEIFE SYNGOT EQU * ** LOGIN PROCEDERE ?? CLI STATANM,X'00' BNE LOGIPR ** NEIN STCK CREQTIM LOCK TIMER AKT L R14,CREQTIM ST R14,STATCLK * WENN VERBINDUNG GESTOERT (WARTEN AUF GO SIGNAL) * WIRD EINGABENACHRICHT VORTGEWORFEN CLI STATSTOP,X'FF' BE SCHLEIFE * HABE ICH KMASKE AUF SCHIRM CLI STATK,X'10' BE CPCMD SENDPID EQU * MVI Z2,X'FF' CLC STATAKTP,=H'0' BE PUTMASKE * SOFERN NACH OPN GE"DUE" WIRD * GEBEN WIR HALT DIE MASKE AUS L R4,USERPAGA L R5,USERPAGE SENDOP EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLC STATAKTP,USPID BE SENDP CR R4,R5 BL SENDOP B SCHLEIFE SENDP EQU * W90 L R14,DCAMTEA MVI Z2,X'FF' CLI 9(R14),X'4E' "K7" BE PUTMASKE CLI 9(R14),X'4F' "K8" BE GETNEXT CLI 9(R14),X'3F' "K9" HC HARDCOPY BE HCROUT CLI 9(R14),X'54' "K2" BNE W91 * CLC USTYP,=C'TIAM' BNE W91 MVI USNEA,X'21' W91 EQU * L R7,NRTLEN L R5,USAID L R6,USCID MVI Z2,X'FF' CLI USFREE,C'D' * SOFERN AKT PARTNER DECLARED BE PUTMASKE * (MOEGLICH SOFERN GERADE LOSCO ROUTINE * DURCHLAUFEN WIRD KMASKE AUSGEGEBEN CLI USFREE,C'F' * SOFERN AKT PARTNER DISCON BE PUTMASKE * WIRD KMASKE AUSGEGEBEN CLI USFREE,C'O' * SOFERN AKT PARTNER NOCH NICHT * VERBUNDEN BE PUTMASKE * WIRD KMASKE AUSGEGEBEN MVC USERROR,=CL15'SEND' MVI USFREE,C':' CLC USTYP,=C'UCON' BE SENDUC * CLC USTYP,=C'U/D*' * BE W140 AH R7,=H'8' L R14,DCAMTESA MVC 0(8,R14),USNEA XI 0(R14),X'20' CLI 0(R14),X'00' BE W140 CLI 0(R14),X'01' BE W140 CLI 0(R14),X'11' BE W140 CLI 0(R14),X'13' BE W140 CLI 0(R14),X'15' BE W140 CLI 0(R14),X'17' BE W140 * CLI 0(R14),X'16' * AUF USER WRITE X'36' WIRD MIT X'41' GEANTWORT (GEN BEI DCAM) * BNE W140 MVI 0(R14),X'41' W140 EQU * CLC USTYP,=C'PDN ' ** CATS BNE W140NPDN LA R14,8(R14) +8 FUER MULTIKOS (CATS) SH R7,=H'8' LEN -8 MVC 0(2,R14),=X'6400' FUER MULTIKOS (CATS) CLI 2(R14),X'50' PAR00E + PAR01E ???? BE W140TR50 JA !! ZB BEI H120-SVP TR 2(9,R14),TRASCII 9 BYTE PROTOKOLL ASCII --> EBCDIC * UMWANDELN FUER MULTIKOS (CATS) B W140NPDN NUR MIT PAR00E, SAW=4F W140TR50 EQU * TR 2(17,R14),TRASCII 17 BYTE PROTOKOLL MIT PAR01E (CATS) * W140NPDN YSEND RPB=RPBSYN,AID=(R5),CID=(R6),AREALN=(R7),AREA=(R14) * USNEA WIRD MIT ASYN NACHRICHT VORBELEGT MVI USNEA,X'36' * CLM R15,B'1001',=X'0000' BE TRACE2 ST R15,USRC MVC USERROR,=CL15'SEND ERROR' MVI USFREE,C':' MVC ERRTEXT,=CL20'S/SCH/YSEND/PAR' BAS R14,FEHLER * TRACE ********************* TRACE2 B TRACE2E B / NOP MVC TRBOUT(4),=C'OUT:' L R2,DCAMTESA BAS R14,TRACROUT TRACE2E EQU * * TRACE ********************* B W41 SENDUC EQU * L R15,DCAMTEA L R14,DCAMTEA MVI USREF,C'N' CLI 9(R14),X'66' "DUE AN $CONSOLE" BE A101 MVI USREF,C'*' A102 L R6,STATRPBA L R7,STATCID L R14,STAIDCP LA R2,STATEI YSEND RPB=(R6),CID=(R7),AREA=OUTPUTUC,AREALN=22,AID=(R14), - EID=(R2) CLM R15,B'1001',=X'0000' BE TRACE3 MVC ERRTEXT,=CL20'S/SCH/SEND/NEW' CLM R15,B'1110',=X'10040C' BNE A103 SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10 CLM R15,B'0001',=X'00' BE A102 MVC ERRTEXT,=CL20'S/SCH/SEND/NEW/SOL' A103 BAS R14,FEHLER * TRACE ********************* TRACE3 B TRACE3E B / NOP MVC TRBOUT(4),=C'OUT:' L R2,DCAMTEA BAS R14,TRACROUT TRACE3E EQU * * TRACE ********************* A104 B SCHLEIFE A101 EQU * AH R14,=H'11' SH R7,=H'11' CLI 3(R15),X'00' BE W400 AH R14,=H'4' SH R7,=H'4' W400 EQU * TR 0(250,R14),TRANST YSEND RPB=RPBSYN,AID=(R5),CID=(R6),AREALN=(R7),AREA=(R14) CLM R15,B'1001',=X'0000' BE TRACE4 ST R15,USRC MVC USERROR,=CL15'SEND ERROR' MVI USFREE,C':' MVC ERRTEXT,=CL20'S/SCH/YSEND/PAR' BAS R14,FEHLER * TRACE ********************* TRACE4 B TRACE4E B / NOP MVC TRBOUT(4),=C'OUT:' L R2,DCAMTEA BAS R14,TRACROUT TRACE4E EQU * * TRACE ********************* W41 B SCHLEIFE PUTMASKE EQU * MVI Z5,X'FF' MVI Z3,X'FF' MVI Z4,X'FF' CLI Z2,X'FF' BNE PUTMASK1 L R15,TERMOUTA L R14,=F'38' MVC 0(38,R15),KMASKANF * A R15,=F'38' LA R15,38(R15) PUTMASK1 BAS R13,KMASKE B SCHLEIFE CPCMD EQU * L R15,DCAMTEA L R5,DCAMTEA TR 0(200,R5),TRANST A R5,NRTLEN XC 0(30,R5),0(R5) L R6,DCAMTEA AH R6,=H'15' CLI 3(R15),X'00' BNE W310 L R6,DCAMTEA AH R6,=H'11' W310 EQU * CLC STATPW,=XL8'00' BE P0 CLC STATPW,=CL8' ' BE P0 LR R1,R6 LR R2,R6 AH R2,=H'9' P50 CLI 0(R1),C' ' BE P51 AH R1,=H'1' CR R1,R2 BL P50 B P52 P51 MVI 0(R1),X'00' B P50 P52 EQU * CLC 0(8,R6),STATPW BE P4 * MVC Z2(4),=X'1ED81DC2' * MVC Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK' * MVC Z2+45(4),=X'1ED71DC4' L R15,TERMOUTA <=== MUSS IMMER VERSORGT SEIN (CPKMASK) * L R14,=F'38' * MVC 0(38,R15),KMASKANF * A R15,=F'38' MVI Z3,X'00' * KEIN CMD * MVI Z4,X'00' * KEINE KMASK * MVI Z5,X'00' * DUNKEL GEST * BAS R13,KMASKE B SCHLEIFE P4 MVC STATPW,=XL8'00' MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVI Z2,X'FF' * NO TEXT * MVI STATANM,STATANMP * * NACH UNLOCK WIRD BULLETIN AUSGEGEBEN L R15,CPBLTINA BULLETIN V2.1C BASR R14,R15 BULLETIN V2.1C B SCHLEIFE ******** B PUTMASKE * NACH UNLOCK WIRD MASKE AUSGEGEBEN P0 EQU * CLC 0(4,R6),=C'LOCK' BNE P1 * SOFERN NUR DER STRING "LOCK " EINGEGEBEN WIRD * DARF IN DIE LOCK ROUTINE VERZZWEIGT WERDEN CLI 5(R6),X'00' BNE P01 MVC 5(8,R6),STAPWSAV PW AUS DATEI P01 EQU * PW IN LOCK-CMD CLI 5(R6),C' ' FALLS BLANK DARF NICHT GELOCKT WERDEN BE P1 MVC STATPW,5(R6) LA R14,STATPW LA R15,STATPW+8 P60 CLI 0(R14),C' ' BE P65 AH R14,=H'1' CR R14,R15 BL P60 B P70 P65 MVI 0(R14),X'00' AH R14,=H'1' CR R14,R15 BL P65 P70 EQU * *70 MVC Z2(4),=X'1ED81DC2' * MVC Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK' * MVC Z2+45(4),=X'1ED71DC4' L R15,TERMOUTA * L R14,=F'38' * MVC 0(38,R15),KMASKANF * A R15,=F'38' MVI Z3,X'00' * KEIN CMD * MVI Z4,X'00' * KEINE KMASK * MVI Z5,X'00' * DUNKEL GEST * BAS R13,KMASKE B SCHLEIFE P1 EQU * CLC 0(5,R6),=C'ENDCP' BNE X100 * NACH EINGABE DER STRING "ENDCP" WIRD DIE VRBINDUNG ZUM TERMIAL * ABGEBAUT L R6,STATRPBA L R7,STATCID L R14,STAIDCP XR R13,R13 LH R13,ENDTLE X101 LA R2,STATEI L R14,STAIDCP YSEND RPB=(R6),CID=(R7),AID=(R14),AREA=ENDT1,AREALN=(R13), - EID=(R2) CLM R15,B'1001',=X'0000' BE X102 MVC ERRTEXT,=CL20'S/ENDCP/YSEND' CLM R15,B'1110',=X'10040C' BNE X103 SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10 CLM R15,B'0001',=X'00' BE X101 MVC ERRTEXT,=CL20'S/ENDCP/YSEND/SOLS' X103 BAS R14,FEHLER X102 EQU * L R14,STAIDCP YCLSCON RPB=(R6),CID=(R7),AID=(R14) CLM R15,B'1001',=X'0000' BE X110 MVC ERRTEXT,=CL20'S/ENDCP/YCLSCON' BAS R14,FEHLER X110 EQU * * SPRUNG ZUMFREIGEBEN BAS R13,FREEALL B SCHLEIFE X100 CLC 0(2,R6),=C'O ' BE OPENPID CLC 0(2,R6),=C'O,' BE OPENPID CLC 0(2,R6),=X'D600' BE OPENPID CLI 0(R6),C'?' BE HELPTEXT * CLC 0(8,R6),=C'//CH-BUL' ADMIN CH BULLETIN IN CPGETBL * BE CPCHBL CLC 0(2,R6),=C'//' ADMIN BE CPADMRT CLI 0(R6),C'/' ADMIN-USER Z. PRINTER DEV. BE CPADMRTU X100NADM LR R13,R6 CLC 0(2,R6),=C'C ' BNE GOTOPID MVI KILL,C' ' AH R6,=H'2' LR R1,R6 AH R1,=H'1' * TEST AUF STRING ,KILL CLC 0(2,R1),=C',K' BE Z90 AH R1,=H'1' CLC 0(2,R1),=C',K' BE Z90 AH R1,=H'1' CLC 0(2,R1),=C',K' BE Z90 AH R1,=H'1' CLC 0(2,R1),=C',K' BNE GOTOPID Z90 XC 0(12,R1),0(R1) MVI KILL,C'Y' GOTOPID EQU * MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVI Z2,X'FF' * NO TEXT * LA R2,EINPAC MVC EINPAC,=C'0000' L R4,USERPAGA L R15,DCAMTEA CLI 9(R15),X'4F' "K8" BE GETNEXT CLI 9(R15),X'3F' "K9" HC HARDCOPY BE HCROUT CLI 0(R6),X'00' BE PUTMASKE * BEI LEERE EINGABE WIRD MASKE AUSGEGEBEN CLI 0(R6),C'0' BE W160 CLI 0(R6),C'1' BE W160 CLI 0(R6),C'2' BE W160 CLI 0(R6),C'3' BE W160 CLI 0(R6),C'4' BE W160 CLI 0(R6),C'5' BE W160 CLI 0(R6),C'6' BE W160 CLI 0(R6),C'7' BE W160 CLI 0(R6),C'8' BE W160 CLI 0(R6),C'9' BE W160 MVC EINPAC,0(R6) LP09 CLI EINPAC+1,X'00' BNE LP10 MVC EINPAC+1(3),=C' ' B LP19 LP10 CLI EINPAC+2,X'00' BNE LP13 MVC EINPAC+2(2),=C' ' B LP19 LP13 CLI EINPAC+3,X'00' BNE LP19 LP14 MVI EINPAC+3,C' ' LP19 EQU * B W161 W160 CLI 1(R6),X'00' BNE GOTOW1 LH R5,=H'0' LA R2,EINPAC+3 B GOTOW5 GOTOW1 CLI 2(R6),X'00' BNE GOTOW2 LH R5,=H'1' LA R2,EINPAC+2 B GOTOW5 GOTOW2 CLI 3(R6),X'00' BNE GOTOW3 LH R5,=H'2' LA R2,EINPAC+1 B GOTOW5 GOTOW3 CLI 4(R6),X'00' LA R2,EINPAC LH R5,=H'3' GOTOW5 EQU * GOTOPIDM STCM R5,B'0001',GOTOMVC+1 GOTOMVC MVC 0(0,R2),0(R6) W161 EQU * GOTOPID1 L R4,USERPAGA L R5,USERPAGE GOTOOP EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLC EINPAC,USPAC BE GOTOP00 CR R4,R5 BL GOTOOP GOTOPXN EQU * MVC Z2(80),=CL80' ' MVC Z2(22),=CL22'CHANGE/CLOSCON TO PAC:' MVC Z2+22(4),EINPAC MVC Z2+26(15),=CL15' NOT POSSIBLE' BACKXY EQU * * EINSPRUNG FUR FEHLER UND KMASKE L R15,TERMOUTA L R14,=F'38' MVC 0(38,R15),KMASKANF * A R15,=F'38' LA R15,38(R15) W42 B PUTMASKE ********* ADMIN ADMIN ADMIN ****************************** CPADMRT EQU * ADMIN. FUNKTIONEN --> MOD. CPADMIN CLI STATADM,C'Y' BNE X100NADM KEINE BERECHTIGUNG LA R6,2(R6) +2 '//' L R15,CPADMINA BASR R14,R15 (R4=USEREIN, R3=STATEIN,R6=PARAM,R14=RET) B SCHLEIFE *********************************************************** ********* HC HC HC HC HC HC ****************************** HCROUT EQU * HARDCOPY MOD. HCPRINT L R15,HCINITA BASR R14,R15 CLI STATK,X'10' BE PUTMASKE B SCHLEIFE *********************************************************** ********* ADMIN USER -ADMIN USER ************************* CPADMRTU EQU * (ADMIN)-FUNKTIONEN FUER USER--> MOD. CPAUSER LA R6,1(R6) +1 '/' L R15,CPAUSERA BASR R14,R15 (R4=USEREIN, R3=STATEIN,R6=PARAM,R14=RET) B SCHLEIFE *********************************************************** ********* LOGIN PROCEDERE ************************* LOGIPR EQU * L R5,DCAMTEA A R5,NRTLEN XC 0(40,R5),0(R5) L R5,DCAMTEA TR 0(36,R5),TRANST L R15,CPLOGINA BASR R14,R15 (R5=PARAM, R4=USEREIN, R3=STATEIN) ** RC AUSWERTEN LTR R15,R15 BNZ LOGINOK ** LOGINPROCEDERE OK ** STATUS USERTAB UPDATED ** PW VERARBEITUNG PWL0 EQU * CLC STATPW,=XL8'00' BE PWP4 CLC STATPW,=CL8' ' BE PWP4 L R6,DCAMTEA ** VT-NAME AUSBLENDEN LA R6,27(R6) LR R1,R6 LR R2,R6 AH R2,=H'8' PWL50 CLI 0(R1),C' ' BE PWL51 AH R1,=H'1' CR R1,R2 BL PWL50 B PWL52 PWL51 MVI 0(R1),X'00' B PWL50 PWL52 EQU * CLC 0(8,R6),STATPW BE PWP4 LOGINOK EQU * ** PW FALSCH ** ABFRAGE FALLS ALLTERM=YES -> LEERES MENUE CLI ALLTERM,C'N' BE LOGINOK1 ** KEINE PASSWORTEINGABE (ALLTERM) CLI 27(R5),X'40' BH LOGINOK1 ** KEIN VT-NAME (ALLTERM) CLI 15(R5),X'40' BNH PWP4 LOGINOK1 EQU * ** OPENUM WIRD NICHT ZURUECKGESETZT !!!!!! ** USERPAGE LOESCHEN 44 * 256 LA R5,44 L R2,USERPAGA UPGLOE XC 0(255,R2),0(R2) LA R2,255(R2) BCT R5,UPGLOE ** STATTAB RUECKSETZEN XC STAPWSAV(8),STAPWSAV XC STATFREE(1),STATFREE XC STATADM(1),STATADM XC STATDEV(8),STATDEV XC STATFORM(8),STATFORM XC STATHCTY(1),STATHCTY XC STATPW(8),STATPW XC STATVT(8),STATVT ** LOGIN-MASKE NEU AUSGEBEN L R15,TERMOUTA MVI STATANM,STATANMA LOGIN MENU MVI Z2,X'FF' MVI Z3,X'00' MVI Z4,X'00' MVI Z5,X'00' BAS R13,KMASKE B SCHLEIFE ** UNLOCK , HCPAGE UND AB GEHTS PWP4 EQU * *-------------3 PAGES FUER HCPRINT ------------------ REQMHCPL REQM 3 PAGE 1-2 INPUT LTR R15,R15 BE HCPRROKL MVC ERRTEXT,=CL20'A/YOPN/HCL/REQM' BAS R14,FEHLER B REQMHCPL HCPRROKL EQU * ST R1,STATHCPG PAGE 3 OUTPUT *-------------3 PAGES FUER HCPRINT ------------------ B P4 *********************************************************** HELPTEXT EQU * L R13,SAVTABA AH R6,=H'2' ST R6,PAR1A LA R1,PARA L R15,CPHELPA BASR R14,R15 B HELPW CPHELPA DS F HELPW L R6,STATRPBA L R7,STATCID L R14,STAIDCP W699 XR R13,R13 L R5,PAR1A LH R13,0(R5) AH R5,=H'2' LA R2,STATEI L R14,STAIDCP YSEND RPB=(R6),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R13), - EID=(R2) CLM R15,B'1001',=X'0000' BE W700 MVC ERRTEXT,=CL20'S/HELP/YSEND/SOL' CLM R15,B'1110',=X'10040C' BNE W777 SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10 CLM R15,B'0001',=X'00' BE W699 MVC ERRTEXT,=CL20'S/HELP/YSEND/SOLS' W777 BAS R14,FEHLER W700 EQU * B SCHLEIFE GOTOP00 EQU * CLI USFREE,C':' * SOFERN PARTNER AKTIV BE B5 ODER CLI USFREE,C'Y' * OPNCON ERFOGLREICH BE B5 * WIRD CLI USFREE,C'D' * ODER DEKL. IST BE B5 * WECHSEL ODER CLOSCON MOEGLIC B GOTOPXN B5 CLC 0(2,R13),=C'C ' * CHECK OB CLOSCON AUF PARTNER BNE GOTOPX * GEGEBEN WURDE CLI KILL,C'Y' * WENN KILL GEGEBEN WURDE BE KILLPID * IST ALLES MOEGLICH CLI USFREE,C'D' * SONST WIRD CLOSCON AUF EIN BE GOTOPXN * IM STATUS DECLARED AB GELEHNT B CLOSPID GOTOPX CLI USFREE,C':' BE Z1X CLI USFREE,C'Y' BE Z1X CLI USFREE,C'D' BE C500 B GOTOPXN * DECALARIERTEN PARTNER WIRD EROEFFNET C500 MVC OPEPN,USPNA MVC OPETYP,USTYP MVC OPEPRO,USPRO MVC OPEAPPL,USCPNAME MVC PAC,USPAC XR R6,R6 LH R6,USPID MVC LMSG,USLOE1 MVC PW,USLOE2 MVC PW1,PW+2 MVC ST,USREF B GOTOP Z1X EQU * MVC Z2(80),=CL80' ' MVC Z2(14),=CL14'CHANGE TO PAC:' MVC Z2+15(4),EINPAC L R15,TERMOUTA L R14,=F'126' MVC 0(126,R15),KMASKANS FRUEHER 0(24,R15)... * A R15,=F'126' LA R15,126(R15) ST R4,SAV4 ST R3,SAV3 MVI Z3,X'00' * KEIN CMD * MVI Z4,X'00' * KEINE KMASK * MVI Z5,X'FF' MVI Z6,X'FF' * PAC -> SYSZ BAS R13,KMASKE L R4,SAV4 L R3,SAV3 WECHEND EQU * CLC USTYP,=C'UCON' "SOFERN LETZTE UCON NACHRICHT K2" BNE A120 "WIRD SIE ZURUEGSETZTZ" MVI USREF,C'N' A120 MVC STATAKTP,USPID MVI STATK,X'00' MVC USRES,=F'3' CLC USERROR(4),=CL4'SEND' * SOFERN DEM PARTNER BEREITS EINE BE BACK * NACHRICHT GESCHICKT WURD MUSS AUF DEN * YRECEIVE GEWARTET WERDEN CLI USFREE,C'Y' * SOFERN NUR DER YOPN EINGETROFFEN IST BE BACK ST R15,R15SAV L R15,CPBUFHA BASR R14,R15 L R15,R15SAV W44 B BACK GETNEXT EQU * LR R7,R4 L R5,USERPAGE GETNEXT1 EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLI USPID+1,X'00' BNE GETNEXT6 CR R4,R5 BL GETNEXT1 GETNEXT2 EQU * L R4,USERPAGA GETNEXT3 EQU * * A R4,=A(X'100') LA R4,256(R4) + X'100' CLI USPID+1,X'00' BNE GETNEXT6 CR R4,R7 BL GETNEXT3 MVI Z2,X'FF' B PUTMASKE GETNEXT6 EQU * MVC EINPAC,USPAC W112 B GOTOPX OPENPID EQU * CLI STATFREE,C'N' BNE P100 MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVC Z2(80),=CL80' ' MVC Z2(30),=CL30'ZCP0011 OPEN CMD NOT ALLOWED' L R15,TERMOUTA L R14,=F'38' MVC 0(38,R15),KMASKANF * A R15,=F'38' LA R15,38(R15) B PUTMASKE P100 EQU * MVC OPEPAC,=CL4' ' MVC OPEPRO,=CL8' ' MVI EDIT,C'S' MVC T,=CL8' ' MVI ST,'N' MVC LMSG(16),=CL80' ' MVC PW,=CL7' ' MVC PAC,=CL4' ' MVC OPETYP,=C'TIAM' MVC OPEPN,=CL8' ' LR R1,R6 OLOOPOP AH R1,=H'1' CLI 0(R1),X'00' BE OLOOPE "OP" ALLEINE CLI 0(R1),C',' "OP," (PARTNER=$DIALOG) BE TESTKEY CLI 0(R1),C' ' "OP " (SUCHE ERSTEN BUSTABEN VOM PARTNER BNE OLOOPOP Z0 AH R1,=H'1' CLI 0(R1),X'00' BE OLOOPE "OP " ALLEINE CLI 0(R1),C',' "OP ," (PARTNER=$DIALOG) BE TESTKEY CLI 0(R1),C' ' "OP " SUCHE ERSTEN BUCHSTABEN BE Z0 CLI 0(R1),C'.' "OP " SUCHE ERESTEN BUCHSTABEN BE Z0 OLOOPW0 EQU * LR R5,R1 XR R2,R2 OLOOPON CLI 0(R1),X'00' "OP NAME" ALLEINE BE OLOOPONE CLI 0(R1),C',' "OP NAME," PROZ FOLGT BE OLOOPONE CLI 0(R1),C' ' "OP NAME " PROZ FOLGT BE OLOOPONE CLI 0(R1),C'.' "OP NAME." PROZ FOLGT BE OLOOPONE AH R1,=H'1' AH R2,=H'1' B OLOOPON OLOOPONE EQU * BCTR R2,R0 CLM R2,B'0011',=H'8' BL I10 LH R2,=H'7' I10 STCM R2,B'0001',OMVC1+1 OMVC1 MVC OPEPN(0),0(R5) TESTKEY CLC 1(3,R1),=C'PW=' SOFERN HINTER "OP NAME," BE OLOOPE DIREKT EIN KEYWORD FOLGT CLC 1(2,R1),=C'T=' "T=,PW=,MSG=,PAC=" BE OLOOPE CLI 1(R1),C'*' BE OLOOPE * CLC 1(1,R1),=C'#' * BE OLOOPE CLC 1(4,R1),=C'MSG=' BE OLOOPE CLC 1(4,R1),=C'PAC=' BE OLOOPE OLOOPPR1 AH R1,=H'1' CLI 0(R1),X'00' "OP NAME," ALLEINE BE OLOOPE CLI 0(R1),C' ' "OP NAME "SUCHE ERSTEN BUCSTABEN VON PROZ BE OLOOPPR1 LR R5,R1 XR R2,R2 CLI 0(R1),C',' "OP NAME,," PROZ--> HOST BE OLOOPE OLOOPPR3 AH R1,=H'1' AH R2,=H'1' CLI 0(R1),X'00' "OP NAME,PROZ" ALLEINE BE OLOOPPR4 CLI 0(R1),C',' "OP NAME,PROZ," BE OLOOPPR4 CLI 0(R1),C' ' "OP NAME,PROZ " BE OLOOPPR4 CLI 0(R1),C'.' BE OLOOPPR4 "OP NAME,PROZ." B OLOOPPR3 OLOOPPR4 EQU * BCTR R2,R0 CLM R2,B'0011',=H'8' BL I11 LH R2,=H'7' I11 STCM R2,B'0001',OMVC2+1 OMVC2 MVC OPEPRO(0),0(R5) SH R1,=H'1' OLOOPE EQU * CLC 0(3,R1),=C'PW=' BE OLOOPPW CLC 0(2,R1),=C'T=' BE OLOOPT CLI 0(R1),C'*' BE OLOOPST * CLC 0(1,R1),=C'#' * BE OLOOPU CLC 0(4,R1),=C'MSG=' BE OLOOPMSG CLC 0(4,R1),=C'PAC=' BE OLOOPPAC AH R1,=H'1' CLI 0(R1),X'00' ENDE BE OLOOPEE B OLOOPE OLOOPMSG MVC LMSG(16),4(R1) AH R1,=H'4' B OLOOPE * "PBNB,C'PBNB1234'" OLOOPPAC MVC PAC(4),4(R1) AH R1,=H'4' B OLOOPE * PAC OLOOPPW MVC PW(7),3(R1) AH R1,=H'3' B OLOOPE * PW OLOOPT MVC T(8),2(R1) AH R1,=H'2' B OLOOPE * TERMINAL OLOOPST MVI ST,'Y' AH R1,=H'1' B OLOOPE * TERMINAL OLOOPU MVI EDIT,'U' AH R1,=H'1' B OLOOPE * TERMINAL OLOOPEE EQU * CLC PW,=CL7' ' BE LX9 LA R1,PW LA R2,PW+7 LX1 CLI 0(R1),X'7D' BE LX3 AH R1,=H'1' CR R1,R2 BL LX1 B LX9 LX3 AH R1,=H'1' CR R1,R2 BL LX4 B LX9 LX4 CLI 0(R1),X'7D' BNE LX3 LX5 AH R1,=H'1' CR R1,R2 BL LX6 B LX9 LX6 MVI 0(R1),C' ' B LX5 LX9 EQU * MVC PW1,PW+2 * CLC LMSG(16),=CL80' ' BE LE9 LA R1,LMSG LA R2,LMSG+16 LE1 CLI 0(R1),X'7D' BE LE3 AH R1,=H'1' CR R1,R2 BL LE1 B LE9 LE3 AH R1,=H'1' CR R1,R2 BL LE4 B LE9 LE4 CLI 0(R1),X'7D' BNE LE3 LE5 AH R1,=H'1' CR R1,R2 BL LE6 B LE9 LE6 MVI 0(R1),C' ' B LE5 LE9 EQU * CLC PAC,=CL4' ' BE LE19 CLI PAC+1,X'00' BE LE10 CLI PAC+1,C',' BNE LE11 LE10 MVC PAC+1(3),=C' ' B LE19 LE11 CLI PAC+2,X'00' BE LE12 CLI PAC+2,C',' BNE LE13 LE12 MVC PAC+2(2),=C' ' B LE19 LE13 CLI PAC+3,X'00' BE LE14 CLI PAC+3,C',' BNE LE19 LE14 MVI PAC+3,C' ' LE19 EQU * CLC T,=CL8' ' BE LT9 LA R1,T LA R2,T+8 LT1 CLI 0(R1),C',' BE LT3 CLI 0(R1),X'00' BE LT3 AH R1,=H'1' CR R1,R2 BL LT1 B LT9 LT3 EQU * LT4 MVI 0(R1),C' ' AH R1,=H'1' CR R1,R2 BL LT4 LT9 EQU * CLC T,=CL8' ' BE LW10 MVC OPEAPPL,T B LW11 LW10 L R1,OPENUM * A R1,=F'1' LA R1,1(R1) ST R1,OPENUM CVD R1,DOWO UNPK RES,DOWO MVZ RES+8(1),=X'F0' MVC OPEAPPL(2),CPNAME MVC OPEAPPL+2(6),RES+3 LW11 CLC OPEPRO,=CL8' ' BNE OPW1 MVC OPEPRO,PRONAM OPW1 CLC OPEPN,=CL8' ' BNE OPW2 MVC OPEPN,=CL8'$DIALOG' OPW2 EQU * CLC OPEPN,=CL8'$DIALOG' BNE OPW3 MVC OPETYP,=CL4'TIAM' B OPW4 OPW3 EQU * CLC OPEPN,=CL8'$CONSOLE' BNE OPW31 MVC OPETYP,=CL4'UCON' B OPW4 OPW301 EQU * * CLC OPEPN,=CL8'CATS' ** CATS * BNE OPW31 * MVC OPETYP,=CL4'PDN ' * B OPW4 OPW31 EQU * MVC OPETYP,=CL4'U/D ' CLI EDIT,C'S' BE OPW4 MVC OPETYP,=CL4'U/D*' OPW4 EQU * L R4,USERPAGA L R5,USERPAGE XR R6,R6 LOOPOP EQU * AH R6,=H'1' * A R4,=A(X'100') LA R4,256(R4) + X'100' CLI USPID+1,X'00' BE GOTOPX0 CR R4,R5 BL LOOPOP MVC Z2(80),=CL80' ' MVC Z2(37),=CL37'ZCP0005 PARTNER TABLE FULL' B BACKXY GOTOPX0 EQU * MVI USDEC,C' ' XC USLOE1SA(12),USLOE1SA XC USLOE2SA(7),USLOE2SA MVC USSEQ,=C'0000' MVC USSEQSA,=C'0000' MVC USKEY1,=C'0000' GOTOP MVC APPNAMX,OPEAPPL MVI Z3,X'00' * KEINE CMD:* MVI Z4,X'00' * KEINE KMASK * MVC OUTPUT2(80),=CL80' ' MVC OUTPUT2(23),=CL23'CONNECTION REQUEST TO ' MVC OUTPUT2+23(8),OPEPN MVI OUTPUT2+31,C'/' MVC OUTPUT2+32(8),OPEPRO MVC OUTPUT2+40(5),=C',TYP=' MVC OUTPUT2+45(4),OPETYP MVC OUTPUT2+49(9),=CL9' ACCEPTED' REQM 9 CLM R15,B'0001',=X'00' BE OPREQ MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVC Z2(80),=CL80' ' MVC Z2(26),=CL26'ZCP0002 REQM MEMORY ERROR' B BACKXY * DS F *REQDUMP1 EQU * * TERM DUMP=Y,MODE=ABNORMAL OPREQ EQU * ST R1,OPREQ-4 | * LTR R1,R1 * BZ REQDUMP1 * LR R14,R1 | * CMD '/D %14' > REQM TRACE * L R1,OPREQ-4 | * A R1,=A(X'16') DCAMINPUT + 22 (FUER UCONHEAD) LA R1,22(R1) + X'16' ST R1,USIN A R1,=A(X'2200') DCAMINPUT = 8704 BYTES ST R1,USTERMS A R1,=A(X'2200') PARTNERSEITE = 8704 BYTES (WORKAREA) ST R1,USTEXTA A R1,=A(X'4A00') BUFFER = 18944 BYTES ST R1,USTEXTE 494 BYTES FREE FUER UEBERSCHREIBER MVC USKEY1,=C'0000' YOPEN ACB=ACBCPX CLM R15,B'1001',=X'0000' BE W133 MVC ERRTEXT,=CL20'S/SCH/YOPEN' ST R15,USRC MVC USCPNAME,OPEAPPL MVC USPNA,OPEPN MVC USTYP,OPETYP STH R6,USPID MVC USPRO,OPEPRO MVC USERROR,=CL15'OPEN ERROR' MVI USFREE,C'F' MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVC Z2(80),=CL80' ' MVC Z2(40),=CL40'OPEN ERROR: VIRT. STATION ALREADY USED' L R6,USIN * TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R6,12 LTR R6,R6 BNZ MCRELM8 MVC ERRTEXT,=CL20'A/RELM/RELM8/0' BAS R14,FEHLER B A07 MCRELM8 EQU * RELM 9,(R6) CLM R15,B'0001',=X'00' * CMD '/D %6' REQM TRACE BE A07 MVC ERRTEXT,=CL20'S/SCH/RELM' BAS R14,FEHLER A07 EQU * B BACKXY W133 YSHOWCB BLK=ACB,BLKADDR=ACBCPX,WAREA=AIDCPX,LENGTH=4, - FIELDS=(AID) CLM R15,B'1001',=X'0000' BE W45 MVC ERRTEXT,=CL20'S/SCH/YOPEN/YSH/CID' BAS R14,FEHLER W45 MVC USCPNAME,OPEAPPL MVC OPECON+2(8),OPEAPPL MVC OPEEI+2(8),OPEAPPL MVC USPRO,OPEPRO MVC USAID,AIDCPX MVC USCID,=F'0' MVC USREF,ST MVC USPNA,OPEPN MVC USTYP,OPETYP STH R6,USPID MVI USOKZ,X'00' MVC USLEN,=F'0' MVC USADR1,=F'0' MVC USADR2,=F'0' MVC USADR3,=F'0' MVC USADR4,=F'0' XC USLOE1(12),USLOE1 XC USLOE2(7),USLOE2 XC USLOE3(25),USLOE3 MVC USRC,=F'0' CVD R6,DOWO UNPK RES,DOWO MVZ RES+8(1),=X'F0' MVC USPAC,RES+5 CLC PAC,=CL4' ' BE W120 CLC PAC,=X'00000000' BE W120 MVC USPAC,PAC W120 EQU * MVC USNEA,=XL8'3650350000000000' MVC USERROR,=CL15'OPNCON STARTED' MVI USFREE,C'O' * EROEFFNEN DER VERBINDUNGEN (ASY) YGENCB BLK=RPB,OPTCD=(CA,Q,ACQUIRE,ASY),EID=OPEI, - AAREALN=8200,TOVAL=32767 CLM R15,B'1000',=X'00' BE W46 MVC ERRTEXT,=CL20'S/SCH/YOPEN/YGEN0' BAS R14,FEHLER W46 ST R1,RPBA ST R1,USRPBA CLC USTYP,=C'TIAM' BE W73 CLC USTYP,=C'U/D ' BE W73 CLC USTYP,=C'PDN ' ** CATS BE W73PDN ** CATS YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO, - EDIT=USER B W74 W73PDN YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO,EDIT=USER, - DEPROT=USER,PTNCHLN=8,APTNCH=PARTCHAR,EDITIN=LCASE, - PROC=SYSCODE B W74 ** CATS W73 YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO,EDIT=DSSIM, - DEPROT=USER,PTNCHLN=8,APTNCH=PARTCHAR,EDITIN=LCASE W74 EQU * CLM R15,B'1000',=X'00' BE W47 MVC ERRTEXT,=CL20'S/SCH/YOPEN/YGEN1' BAS R14,FEHLER W47 ST R1,CCBA ST R1,USCCBA ENAEI EINAMAD=OPEEI,EIIDRET=OPEI CLM R15,B'1001',=X'0400' BE W48 MVC ERRTEXT,=CL20'S/SCH/YOPEN/EINAEI' BAS R14,FEHLER W48 LA R5,RPBA ENACO CONAMAD=OPECON,COADAD=OPENA,COMAD=(R5),COIDRET=OPCO, - LEVEL=10 CLM R15,B'1001',=X'0400' BE W49 MVC ERRTEXT,=CL20'S/SCH/YOPEN/EINACO' BAS R14,FEHLER W49 MVC USEI,OPEI MVC USCO,OPCO MVC MVCF(2),USPID MVC MVCF+2(2),STATTID * AKTUELLER PARNTER WIRD ERST BEIM ERFOLGREICHEN YOPN * VERSORGT * MVC STATAKTP,USPID * L R5,CCBA L R6,RPBA CLC PW1,=CL4' ' BE W150 L R7,PW1 YMODCB BLK=CCB,BLKADDR=(R5),LOGPW=(R7) CLM R15,B'1001',=X'0000' BE W150 MVC ERRTEXT,=CL20'S/SCH/YOPEN/YMOD0' BAS R14,FEHLER W150 EQU * * L R7,MVCF YMODCB BLK=CCB,BLKADDR=(R5),USERFLD=(R7) CLM R15,B'1001',=X'0000' BE W50 MVC ERRTEXT,=CL20'S/SCH/YOPEN/YMOD' BAS R14,FEHLER W50 EQU * CLC LMSG(16),=CL80' ' BE W70 LA R1,LMSG LA R2,LMSG+16 XR R7,R7 XXX CLI 0(R1),X'00' BE XX1 AH R1,=H'1' AH R7,=H'1' CR R1,R2 BL XXX XX1 YOPNCON ACB=ACBCPX,CCB=(R5),RPB=(R6),AREA=LMSG,AREALN=(R7), - AAREA=BN80 B W71 *W70 CLC USTYP,=C'TIAM' | * BNE W70OP | NEU FUER BCAM V10 MUSS LMSG * MVC LMSG(8),USCPNAME > FUER $DIALOG ANGEGEBEN WERDEN. * MVI LMSG+8,X'35' | BYTE 0-7: TERM.NAME,BYTE 8:TERM-TYP * LA R7,9 | LAENGE 9BYTES W70 YOPNCON ACB=ACBCPX,CCB=(R5),RPB=(R6),AAREA=BN80 W71 EQU * CLM R15,B'1000',=X'00' BE W51 ST R15,USRC MVC USERROR,=CL15'OPNCON ERROR' MVI USFREE,C'F' MVI Z3,X'FF' * CMD:* MVI Z4,X'FF' * KMASK * MVC Z2(80),=CL80' ' MVC Z2(35),=CL35'OPNCON ERROR:PARTNER NOT AVAILABLE' MVC ERRTEXT,=CL20'S/SCH/YOPEN/YOPCON' BAS R14,FEHLER L R7,USAID YCLOSE AID=(R7) CLM R15,B'1001',=X'0000' BE W201 MVC ERRTEXT,=CL20'S/SCH/YCLOSE' BAS R14,FEHLER W201 EQU * DISEI EIID=OPEI DISCO COID=OPCO L R7,USIN * TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R7,12 LTR R7,R7 BNZ MCRELM9 MVC ERRTEXT,=CL20'A/RELM/RELM9/0' BAS R14,FEHLER B A09 MCRELM9 EQU * RELM 9,(R7) CLM R15,B'0001',=X'00' * CMD '/D %7' REQM TRACE BE A09 MVC ERRTEXT,=CL20'S/SCH/YCLOS/RELM' BAS R14,FEHLER A09 EQU * B BACKXY BAS R14,FEHLER W51 SOLSIG EIID=OPEI,COID=OPCO,LIFETIM=43200 CLM R15,B'1001',=X'0000' BE BACKX MVC ERRTEXT,=CL20'S/SCH/YOPEN/SOLSIG' BAS R14,FEHLER BACKX EQU * L R15,TERMOUTA L R14,=F'126' MVC 0(126,R15),KMASKANS * A R15,=F'126' LA R15,126(R15) MVC Z2,OUTPUT2 MVI Z5,X'FF' MVI Z6,X'FF' * PAC --> SYSZ BAS R13,KMASKE W52 B BACK KILLPID EQU * MVI USDEC,C' ' * DEKL. BYTE ZURUECKGESETZT CLI USFREE,C'D' * WENN PARTNER NUR DEKL BNE CLOSPID * SONST NORMAL BEHANDLUB XC USCPNAME(250),USCPNAME MVC Z2(80),=CL80' ' MVC Z2(20),=CL20'PARTNER ERASED PAC:' MVC Z2+20(4),EINPAC B BACKXY CLOSPID EQU * MVC Z2(80),=CL80' ' MVC Z2(26),=CL26'PARTNER DISCONNECTED PAC:' MVC Z2+25(4),EINPAC XR R15,R15 ST R15,USRC MVC USERROR,=CL15'CLOSCON STARTED' MVI USFREE,C'F' L R7,USAID YCLOSE AID=(R7) CLM R15,B'1001',=X'0000' BE B0 MVC ERRTEXT,=CL20'S/SCH/CLS/YCLOSE' BAS R14,FEHLER B0 EQU * ******* AUSTRAG AUS USER-PAG-TAB BAS R14,ERUSPGTB ******* LA R7,USEI DISEI EIID=(R7) LA R7,USCO DISCO COID=(R7) L R7,USIN * TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM) SRA R7,12 LTR R7,R7 BNZ MCRELM10 MVC ERRTEXT,=CL20'A/RELM/RELM10/0' BAS R14,FEHLER B B1 MCRELM10 EQU * RELM 9,(R7) CLM R15,B'0001',=X'00' BE B1 MVC ERRTEXT,=CL20'S/SCH/CLS/RELM' BAS R14,FEHLER B1 EQU * B BACKXY * BACK MVI STATK,X'00' W54 EQU * W55 B SCHLEIFE SCHLEIFE EQU * * L R14,CRECCNT | * LA R14,1(R14) > ASYN REC ZAEHLER (+1) * ST R14,CRECCNT | * C R14,=H'1' | >1 ? * BNH TMPCNT1 | * TERM DUMP=Y,MODE=ABNORMAL *MPCNT1 EQU * | NEIN L R13,DCAMTEA MVC 0(10,R13),=CL80' ' L R14,AIDCP YRECEIVE RPB=RPBSYN,AAREA=(R13),AAREALN=4100, - CCB=CCBSYN,EID=TEREI,AID=(R14) CLM R15,B'1000',=X'00' BE W510 MVC ERRTEXT,=CL20'S/SCH/YREC' BAS R14,FEHLER W510 EQU * SOLSIG EIID=TEREI,COID=TERCO,LIFETIM=43200 CLM R15,B'1001',=X'0000' BE W511 MVC ERRTEXT,=CL20'S/SCH/SOLSIG' BAS R14,FEHLER W511 RETCO DS 0H ENTRY SCHLEIFE FEHLER EQU * ST 14,BRBACK ST 15,ERR15 UNPK ERRR15,ERR15(5) TR ERRR15,HX-240 WROUT ERRMSG,TERME * CMD '/D %MR' * BEI TOVAL ABGELAUFEN (CIRKA ALLE 6 STUNDEN) * WIRD KEINE FM AUSGEGEBEN CLC ERR15,=X'04001000' BE TERME * TYPIO MSG=ERRMSG CLC ERR15,=X'10040800' BNE TERME PASS PASS PASS PASS MVC ERRTEXT,=CL20'WAIT ' WROUT ERRMSG,TERME * TYPIO MSG=ERRMSG TERME L R14,BRBACK BR R14 ******************** AUSTRAG AUS USER-PAGING-TABELLE (INFO) ***** DS 2F ERUSPGTB EQU * STM R6,R7,ERUSPGTB-8 L R6,USPGTBA L R7,=A(X'1F40') ERUSX1 EQU * CLM R4,B'1111',1(R6) BE ERUSX2 LA R6,9(R6) BCT R7,ERUSX1 ERUSX2 EQU * XC 0(9,R6),0(R6) LOESCHEN / FREI 9BYTE LM R6,R7,ERUSPGTB-8 BR R14 ******************* EINTRAG IN DIAG-TAB **************************** UPDIAUP1 EQU * LA R14,4(R14) STM 0,15,0(R14) REGISTER VOR UP-AUFRUF (NUR 64 BYTE!!) B UPDIAUPW UPDIAUP EQU * LA R14,4(R14) *DIA CONTXT SAVE=(R14),PROCESS=LAST *DIA UPDIAUPW LA R14,68(R14) LEN 68 BYTES *DIA CL R14,DIATABE BL UPDIAUPE L R14,UDIATBA UPDIAUPE ST R14,DIATABA WRAP AROUND IN DIAG-TAB MVC 0(4,R14),=C'EEEE' EEEE NACH LETZTEM EINTRAG BR R13 *********************************** TRACE ************************* TRACROUT EQU * ST 14,BRBACK 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,TERME L R14,BRBACK BR R14 TITLE 'E N D E ' ENDE EQU * BASR R15,0 USING *,R15 TERM SPACE TITLE 'I N T R C / INTR CONTI' ******************************* /INTR CONTI ********************** ENTRY FCBSEQ INTRC EQU * BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CINT ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CINT' *DIA BAS R13,UPDIAUP *DIA ** ** CLC INTRTXT(6),=C'CH-SEQ' BNE INTRC1 L R15,CPCOPYA BASR R14,R15 B INTRET EXTRN TRACE1 INTRC1 EQU * CLC INTRTXT(6),=C'TRC-ON' BNE INTRC2 SYSFL 'SYSLST=CP.TRACELIST' CMD 'TYPE',' % ZCP0050 CP-TRACE: FILE CP.TRACELIST OPENED' L R14,=A(TRACE1) USING TRACE1,R14 MVZ TRACE1+1(1),=X'00' DROP R14 MVZ TRACE2+1(1),=X'00' MVZ TRACE3+1(1),=X'00' MVZ TRACE4+1(1),=X'00' B INTRET INTRC2 EQU * CLC INTRTXT(7),=C'TRC-OFF' BNE INTRC3 SYSFL 'SYSLST=(PRIMARY)' CMD 'TYPE',' % ZCP0051 CP-TRACE: FILE CP.TRACELIST CLOSED' L R14,=A(TRACE1) USING TRACE1,R14 MVZ TRACE1+1(1),=X'FF' DROP R14 MVZ TRACE2+1(1),=X'FF' MVZ TRACE3+1(1),=X'FF' MVZ TRACE4+1(1),=X'FF' B INTRET INTRC3 EQU * CLC INTRTXT(6),=C'CH-LOG' BNE INTRC4 ST R15,R15SAV L R15,CPSYSFLA BASR R14,R15 L R15,R15SAV B INTRET INTRC4 EQU * CLC INTRTXT(5),=C'SH-VT' BNE INTRC41 MVI ITEMP,C'V' B INTRC4B INTRC41 CLC INTRTXT(5),=C'SH-RT' BNE INTRC42 MVI ITEMP,C'R' B INTRC4B INTRC42 CLC INTRTXT(5),=C'SH-AP' BNE INTRET MVI ITEMP,C'A' INTRC4B EQU * INTNOP NOP INTRET MVI INTNOP+1,X'F0' INTR SH-.. CONTI GESPERRT POSSIG EIID=EIRETI MVC IVTNAM+8(1),ITEMP MVC IVTNAM(8),INTRTXT+6 B INTRET INTSAV DS 11F INTRET EQU * MVC INTRTXT(14),=CL80' ' EXIT DS 0F SPACE TITLE 'I N F C O / INFO CONTI' INFCO EQU * BASR R15,0 USING *,R15 CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12) DROP R15 ** CINF ** DIAG-TAB *DIA L R14,DIATABA *DIA MVC 0(4,R14),=CL4'CINF' *DIA BAS R13,UPDIAUP *DIA ** ** LTR R2,R2 BNZ INFCORET L R6,USPGTBA LA R7,IVTNAM L R15,CPINFA BASR R14,R15 INFCORET EQU * SOLSIG EIID=EIRETI,COID=IDINFCP MVI INTNOP+1,X'00' INTR SH-.. CONTI FREI RETCO DS 0F *---------------- GLOBAL-TABELLE ----------------------------* DS 0F DC C'*GLOBAL-TAB*' STATANFA DS F STATENDA DS F SAVTABA DS F DCAMTESA DS F DCAMTEA DS F TERMOUTA DS F * USPGTBA DS F UDIATBA DS F DIATABA DS F DIATABE DS F OPEAPPL DC CL8'CP00000' OPENUM DC F'0' APLNAM DC CL8'CP01 ' PRONAM DS CL8 CPNAME DC C'CP' VTERM DC C'Y' CPVER DC C'V3.0AK4' LANGUE DC C'D' D=DEUTSCH / E=ENGLISH ALLTERM DC C'Y' Y=ALLE TERMINAL / N = NUR TERMINAL MIT TS ENTRY CPVER ENTRY STATANFA ENTRY STATENDA ENTRY APLNAM ENTRY USPGTBA FUER MOD CPADMIN (V(KONST)) ENTRY UDIATBA YRECASY ENTRY DIATABA YRECASY ENTRY DIATABE YRECASY ENTRY PUTMASKE CPBLTIN ENTRY LIB CPLOGIN ENTRY OPENUM CPLOGIN ENTRY CPNAME CPLOGIN *----------------- V-KONSTANTEN FUER UP'S --------------------* CPCSTATA DC V(CPCSTAT) CPSYSFLA DC V(CPSYSFL) CPINFA DC V(CPINF) CPCOPYA DC V(CPCOPY) CPKMASKA DC V(CPKMASK) CPBUFHA DC V(CPBUFH) HCPRCOA DC V(HCPRCO) RECA DC V(YRECASY) CPBLTINA DC V(CPBLTIN) CPADMINA DC V(CPADMIN) HCINITA DC V(HCINIT) CPAUSERA DC V(CPAUSER) CPHELPAD DC V(CPHELP) CPHELPAE DC V(CPHELPE) CPLOGINA DC V(CPLOGIN) *----------------- A-KONSTANTEN CONTINGENCIES ----------------* ALOGCP DC A(LOGCP) ALOSCP DC A(LOSCP) ALOSCO DC A(LOSCO) INFCOA DC A(INFCO) OPENA DC A(YOPNCON) ENDEA DC A(ENDE) TERMA DC A(TERM) *------------------------------------------------------------* COGAGA DC F'0' R15SAV DC A(0) BRBACK DS F DS 0D LOCKTIM1 DC PL8'0' LOCKTIM DS F CPUTIM DC CL6'000100' 1 MIN CREQTIM DS D *CRECCNT DC F'0' TEMP ZAEHLER ASYN REC DS 0F TRCTAB DC C'0123456789ABCDEF' 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 INTRTXT DS CL14 DS 0F FSBER1 DS CL10 DS 0F OPEEI DC CL10'OP' OPECON DC CL10'EI' IVTNAM DS CL9 ITEMP DS CL1 DS 0F OPEPRO DS CL8 T DS CL8 MVCF DS F FDBKOP DS F MVCFOP DS F RPBA DS F CCBA DS F OPEPN DS CL8 OPEPAC DS CL4 OPETYP DS CL4 OPCID DS F DS 0F ACBCP YACB APPNAME=APLNAM,ATTR=(LOGON),ENB=ENBCP, - PRONAME=PRONAM,DCAMVER=8.0,LINK=APLNAM ENBCP YENB LOGON=IDLOGCP,LOSCON=IDLOSCP,COMEND=IDENDECP X6SAVL DS F EIRETI DS F IDINFCP DS F EIIDHC DS F IDHCOCP DS F ENTRY EIIDHC ENTRY IDHCOCP IDENDECP DS F AIDCP DS F AIDCPX DS F EINPAC DS F RES1 DS CL9 DS 0F ENANUM DC F'0' EINAMOP DC CL8'EI000000' DOWO DS D DOWO1 DS D RES DS CL9 DS 0F PARA DS 0F PAR1A DS F IDLOGCP DS F RPBAOP DS F SAV4 DS F SAV3 DS F CCBOP DS F CCBYR DS F FDBKSY DS F CIDLOG DS F IDLOSCP DS F IDLOSCO DS F *TERA DC A(TERMNEU) PNAMLOG DS CL8 PROLOG DS CL8 ENDTLE DC Y(ENDTTE-ENDT1) ENDT1 DC X'10401B206140404562540040000041212798279827981ED81DC8' DC C'ZCP0030 CP NORMAL END' ENDTTE EQU * KMASKAN1 DC X'26401B206140404562540040000041' DC X'004040404048000021' DC X'1B206148400000004040000000' PAR00D ANZ-ZEILE DC X'21278227821ED81DC8' KMASKANF DC X'1E401B20614040456254004000004121' DC X'1B206148400000004040000000' PAR00D ANZ-ZEILE DC X'21278227821ED81DC8' KMASKANS DC X'1E401B20614040456254004000004121' DC X'1B20614840000000404100000021' PAR00D SYS-ZEILE DC X'2740817CD7' LADEN SYSTEMZEILE MIT PAC DC X'1D7C' HELL DC C'LTG' DC CL52' ' DC C'TAST' * LEN 126 DC CL17' ' PACSYSZ DC CL4' ' =+112 DC X'19' DC X'278227821ED81DC8' *KMASKANF DC X'10401B20614040456254004000000021278227821ED81DC8' * PAG ANGABEN (WAR-ZEICHEN IN 1.2C00 OFFENSICHTLICH IMMER NOCH * FALSCH) *KMASKANF DC X'0A484566540040000000278227821DC81ED8' * MIT DIESEM NACHRICHTEN KOPF WURDEN DIE LA TASTEN GELOESCHT * DA DURCH VERWENDUNG VON NK + PARAM0 DIE RESTLICHEN BEREICHE GELOESCHT * WERDEN * ENTRY KMASKANF Z3 DS CL1 Z4 DS CL1 Z5 DS CL1 Z6 DC XL1'00' KILL DS CL1 ESCSAV DC XL3'C927D5' ESCN WENN KEINE PTASTE DEFINIERT Z1 DS CL80 Z2 DS CL80 OUTPUT2 DC CL80' ' OUTPUT DC CL26' ' OUTPUT1 DC X'2791' PROG BETRIEB EIN * LAENGE NEU = 27 DC X'2740' P16 ESCN DC X'C9' P16 VOREINSTELL DC X'27D5' K7 (ESC N) DC X'2791' PROG BETRIEB AUS DC X'2791' PROG BETRIEB EIN DC X'2740' P17 ESCO DC X'D1' P17 VOREINST DC X'27D6' K8 (ESC O) DC X'2791' PROG BETRIEB AUS DC X'2791' PROG BETRIEB EIN DC X'2740' P18 ESCW DC X'D2' P18 VOREINST DC X'276F' K9 (ESC ?) DC X'2791' PROG BETRIEB AUS * DC X'2784' LSP * DC X'2798' LZE * DC X'2784' LSP OUTPUTUC DC X'10401B20614040456254004000004121278427981ED7' OUTPUT11 DC CL26'ZCP0000 CONNECTED WITH CP ' CPVER2 DC C'VX.XXXX' DC CL47' ' DC X'2798' LZE EDIT DC C'S' ST DC C'N' DS 0H BL DC C' ' ENTRY OUTPUT1 *RPBLOG YRPB CCB=CCBLOG,OPTCD=(NQ,ANY,SYN,NTACK) *CCBLOG YCCB PTNNAME=PNAMLOG,PRONAME=PROLOG,EDIT=SYSTEM, - * EDITOUT=PHYS,EDITIN=(PHYS,LCASE) USERFLD DS F RPBCLOS YRPB RPBSYN YRPB CCB=CCBSYN,OPTCD=(ASY,Q,ANY,ACCEPT),TOVAL=32767, - EID=TEREI,ACB=ACBCP CCBSYN YCCB EDIT=SYSTEM,EDITIN=(PHYS,LCASE),EDITOUT=PHYS ACBCPX YACB APPNAME=APPNAMX,ATTR=(NLOGON),DCAMVER=8.0,ENB=ENBX ENBX YENB LOSCON=IDLOSCO APPNAMX DS CL8 DS 0F PARTCHAR DS 0CL8 PARTTYP DC X'01' STATTYP DC X'35' ZEICH DC X'A0' ZUSGR DC X'00' ZEILL DC X'0050' ZEILZ DC X'18' ZUINFO DC X'00' DS 0F EIDK DS F OPCO DS F OPEI DS F TECO DS F TEEI DS F YOPCO DS F YOPEI DS F TEREI DS F TERCO DS F REECON DC CL10'RO' REEEI DC CL10'RE' DS 0F LMSG DS CL16 PAC DS CL4 PW DS CL7 DS 0F PW1 DS F REEI DS F RECO DS F SCHALT DC C'A' DS 0F OPNMES DS CL11 NRTLEN DS F DS 0F ** ------------------ TERMLIB-SATZ * MUSS IDENTISCH MIT LODAT AUS CPLOGIN SEIN !!!!! LODAT DS F LOPAC DS CL4 LOPRO DS CL8 LOTERM DS CL8 LOMSG DS CL16 ORG LOMSG+5 LOFREE DS CL1 LOADM DS CL1 ORG LOMSG+16 LOPASS DS CL7 LOPAR DS CL8 LOTYP DS CL4 DS CL1 LOSEQ DS CL4 LOREF DS CL1 LOFREEX DS CL50 ** ------------------------------- LD1FILE DS CL25 DS 0F SEQ DC CL54' ' SEQ-DATEI ENTRY SEQ FCBSEQ FCB FCBTYPE=ISAM,RECFORM=V,OPEN=INPUT,EXIT=FCBSEQEX, - RECSIZE=88,FILE=X,KEYARG=SEKEY,KEYPOS=5,KEYLEN=8 ORG FCBSEQ IDFCB ,F ORG FCBSEQEX EXLST NOFIND=C200 ENTRY FCBSEQ YRECASY EXTRN SEKEY EXTRN C200 YRECASY TRANST DC X'000102030405060708090A0B0C0D0E0F' DC X'101112131415161718191A1B1C1D1E1F' DC X'202122232425262728292A2B2C2D2E2F' DC X'303132333435363738393A3B3C3D3E3F' DC X'404142434445464748494A4B4C4D4E4F' DC X'505152535455565758595A5B5C5D5E5F' DC X'606162636465666768696A6B6C6D6E6F' DC X'707172737475767778797A7B7C7D7E7F' DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' DC X'90D1D2D3D4D5D6D7D8D9DA9B9C9D9E9F' DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' DS 0F TRASCII DC X'00010203372D2E2F1605250B0C0D0E0F' ASCII -> EBCDIC DC X'101112133C3D322618193F271C1D1E1F' DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' DC X'D7D8D9E2E3E4E5E6E7E8E9BBBCBD6A6D' DC X'4A818283848586878889919293949596' DC X'979899A2A3A4A5A6A7A8A9FB4FFDFF07' LTORG OUT15 DS L9 ERR15 DS F ERRMSG DC Y(ERRMSGE-ERRMSG) DC C' % ZCP0006 CP-ERROR AT:' ERRTEXT DS CL20 DC C' RC:' ERRR15 DS L9 ERRMSGE EQU *-1 ORG ZCP3MSG DC Y(ZCP3MSGE-ZCP3MSG) DC C' CP-' CPVER4 DC C'VX.XXXX' DC C' PREFIX:' CPNAMED DC C'XX' DC C' LAN:' CPLAN DC C'X' DC C' TERM-MSG:' CPVT DC C'X' DC C' ALLTERM:' CPALL DC C'X' DC C' LIB:' LIB DC CL45' ' DC C' SEQ:' CPSEQ DC CL54' ' ZCP3MSGE EQU * TEXT1 DC X'1ED81D7C' DC CL41'PAC PARTNER STATION HOST TYPE TEXT' DC CL32' CP-MENU ' CPVER3 DC C'VX.XXXX' DC X'1ED81DC8' * DC X'2798' LZE HX DC C'0123456789ABCDEF' BN80 DS CL80 EJECT *---------------------------------------------------------------------* * D S E C T ' S * *---------------------------------------------------------------------* ** STATION-ENTRY STATEIN EJECT ** USER-ENTRY USEREIN *STATEIN DSECT (STATIONEINTRAG 1 FUER TERMINAL) *STATPNA DS CL8 H1500350 *STATPRO DS CL8 V217H15 *STAIDCP DS F AID --> CP *USERPAGA DS F A(ANFANG BUFFERSEITE FUER PARTNERVERWALTUNG) *USERPAGE DS F A(ENDE BUFFERSEITE) *TERMTYP DS F X'00000000' *STATCID DS F CID FUER TERMINAL --> CP *STATAKTP DS H AKTUELLER PID *STATTID DS H TID FUER TERMINAL X'00000001' *STATZZ DS CL1 X'00' *STATK DS CL1 AUSLOESUNG DER DUE *STATK10 EQU X'10' K-TASTE GEDRUECKT *STATK00 EQU X'00' NORMAL DUE *STATRPBA DS F *STATCCBA DS F *STATEI DS F EVENT ID FOR STATION *STATRPB1 DS F *STATSTOP DS 0F SOLSIG KZ * DS H *STATSTFF EQU X'FF' SOLSIG IN USE IN CPBUFH *STATST00 EQU X'00' SOLSIG NOT IN USE IN CPBUFH *STASTPID DS H *STATFREE DS CL1 OPEN COMMAND FUER BENUTZER (AUS TERMLIB) *STATFREY EQU 'Y' OPEN COMMAND ALLOWED *STATFREN EQU 'N' OPEN COMMAND NOT ALLOWED *STATADM DS CL1 ADMINISTRATOR FUNCTION *STATADMY EQU 'Y' ADMINISTRATOR *STATADMN EQU 'N' NORMAL USER *STATPW DS CL8 *STAPWSAV DS CL8 PW SAVE AUS LIB *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 CHARS/LINE FUER HC-DRUCKER *STATHCTP EQU 'P' DRUCKER MIT 80 CHAR/LINE *STATHCTN EQU 'N' DRUCKER KANN 82 CHAR/LINE *STATCLK DS F CLOCK TIME LAST ENTRY *STATVT DS CL8 VTNAME AUS OPNCON *STATANM DS CL1 LOGIN- ODER PW-MWNU *STATANMA EQU X'FF' ANMELDEMENU (LOGIN) *STATANMP EQU X'00' PASSWORTMENU *STATFUTU DS CL3 ####### FOR FUTURE USE ##### *USEREIN DSECT (PARTNEREINTRAG 1 FUER YOPNCON) *USCPNAME DS CL8 CP000001 *USPRO DS CL8 V217H21 *USAID DS F AID --> CP00001 *USCID DS F CID FUER CP00001 -- > CP *USPNA DS CL8 $DIALOG *USTYP DS CL4 TYP OF PARTNER **USTYPD EQU 'U/D ' PARTNER IST UTM ODER DCAM **USTYPT EQU 'TIAM' PARTNER IST TIAM-APPL. ($DIALOG ETC) **USTYPU EQU 'UCON' PARTNER IST $CONSOLE **USTYPP EQU 'PDN ' PARTNER IST PDN-APPL. (CATS ETC) *USPID DS H PID X'01' *USREF DS CL1 REFRESH GEWUENSCHT ? *USREFY EQU 'Y' JA - REFRESH DURCH CP *USREFN EQU 'N' NEIN - K3 / KDCLAST *USOKZ DS CL1 USED IN CPBUFH *USOKZV EQU X'00' ACTCELL VOR FRECELL *USOKZN EQU X'10' ACTCELL NACH FRECELL *USTEXTA DS F A(ANFNANG BUFFER FUER YRECEIVE) *USTEXTE DS F A(ENDE BUFFER FUER YRECEIVE) *USTERMS DS F A(ANFANG BUFFER FUER TERMINAL/PARTNERSEITE) *USIN DS F A(DCAM INPUT) *USLEN DS F A(DCAM LAENGE) *USADR1 DS F * *USADR2 DS F * *USADR3 DS F * *USADR4 DS F * *USPAC DS CL4 PAC DES PARTNERS *USNEA DS CL8 NEABT-PROT ** -->*<-- WIRD VOM MODUL VERSORGT UND GEFLEGT *USRES DS F REASON X'00000001' --> ASY YRECEIVE EINGETROF N ** X'00000002' --> ACK VON TERMINAL ** X'00000003' --> NEUAUFBAU VON GEWUENSCH ** REG 1 -- > STATIONSTABELLENEINTRAG ** REG 2 -- > PARTNERTABELLEN EINTRAG ** BEI REASON 1 / BUFFERVERWALTUNG / TERMINALBUFFERVERWALTUNG / ** YSEND AUF TERMINAL SOFERN AKTUELLER PID = YRECEIVE / VERSORGUNG USACK ** BEI REASON 2 / BUFFERVERWALTUNG / TERMINALBUFFERENTWERTUNG / ** YSEND AUFS TERMINAL ** BEI REASON 3 / VERSORGUNG USACK ? ** YSEND AUFS TERMINAL *USRC DS F *USERROR DS CL15 *USFREE DS CL1 *USFREED EQU 'D' AKT PARTNER DECLARED (AUCH BEI DURCHLAUFEN ** DISCON ROUTINE) *USFREEF EQU 'F' AKT PARTNER DISCON *USFREEO EQU 'O' AKT PARTNER NOCH NICHT VERBUNDEN *USFREE# EQU ':' PARTNER AKTIV *USFREEY EQU 'Y' OPNCON ERFOLGREICH *USCO DS F *USEI DS F *USRPBA DS F *USCCBA DS F *USLOE1 DS CL16 *USLOE2 DS CL7 *USLOE3 DS CL25 *USSEQ DS F *USKEY1 DS F *USSEQSA DS F *USDEC DS CL1 STATUS OF PAC *USDECD EQU 'D' DECLARED *USDECND EQU ' ' NOT DECLARED (CONNECTED) *USLOE1SA DS CL16 *USLOE2SA DS CL7 * DS CL20 *USTATPNA DS CL8 *USTATPRO DS CL8 *USTATVT DS CL8 VT-NAME AUS STATVT END
