Mcp002
Zur Navigation springen
Zur Suche springen
<syntaxhighlight lang="asm">
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