Cpinf
<syntaxhighlight lang="asm">
- CPINF IST JETZT CONTINGENCY. TYPIOS GEHEN MIT LEVEL 5, REST LEVEL 10
- V1.3D40
- AENDERUNG CMD 'TYPE' AUF TYPIO-MAKRO WEGEN HAENGER (EVTL. CONSOLE
- BUSY)
- V1.3D30
CPINF CSECT
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
CPINF AMODE ANY CPINF RMODE ANY
- BAL OPSYN ##BAS
- BALR OPSYN ##BASR
- ---------------------------------------------------------------------*
USING *,R15
USING USEREIN,R4
- USING STATEIN,R3
STM R0,R13,SAVTAB
ST R14,SAV14
SPACE
USING UCPINF,R8,R9
UCPINF BASR R8,0
BCTR R8,R0
BCTR R8,R0
LA R1,4095
LA R9,1(R8,R1)
DROP 15
ST R15,SAV15
B BEG
- ----------------------------------------------------------------------*
- INFO - MODUL ***
- ----------------------------------------------------------------------*
CNOP 0,4
BEG EQU *
XR R1,R1
TRT 0(8,R7),TRTAB
BZ BEG1
STC R2,0(R1)
BEG1 EQU *
L R5,=X'00001F40'
CLI 8(R7),C'R'
BE CR1
CLI 8(R7),C'A'
BE CA1
- ----------------------------------------------------------------------*
- INFO - VIRTUELLE TERMINALS 'V' ***
- ----------------------------------------------------------------------*
CI1 EQU *
XC 0(1,R6),=X'00'
BNZ CI2
LA R6,9(R6)
BCT R5,CI1
CINOF1 EQU *
B CINOF2
CI2 ICM R4,B'1111',1(R6)
CLC 0(8,R7),USCPNAME
BE CI3
LA R6,9(R6)
BCT R5,CI1
CINOF2 EQU *
CNOP 0,4
MVC TCI3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT
CI3CMD TYPIO MSG=LCI3CMD
B CIRET
CI3 EQU *
ICM R4,B'1111',1(R6)
PRINT GEN,BASE
CNOP 0,4
MVC TCICMD+12(8),USCPNAME
MVC TCICMD+42(8),USPNA
MVC TCICMD+51(8),USPRO
MVC TCICMD+66(8),USTATPNA
MVC TCICMD+81(8),USTATPRO
MVC TCICMD+96(4),USTYP 59
CICMD TYPIO MSG=LCICMD
B CIRET
DS 0F
LCI3CMD DC Y(ECI3CMD-LCI3CMD)
DS CL2
TCI3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECI3CMD EQU *
DS 0F
LCICMD DC Y(ECICMD-LCICMD)
DS CL2
TCICMD DC C' % ZCP0060 CPTERMXX: CONNECTED WITH APPL=XXXXXXXX/XXX-
XXXXX; TERM=XXXXXXXX, PROC=XXXXXXXX, TYPE=XXXX.'
ECICMD EQU *
DS 0F
- ----------------------------------------------------------------------*
- INFO - REELLE TERMINALS 'R' ***
- ----------------------------------------------------------------------*
CR1 EQU *
XC 0(1,R6),=X'00'
BNZ CR2
LA R6,9(R6)
BCT R5,CR1
CRNOF1 EQU *
B CR2NOP
CR2 ICM R4,B'1111',1(R6)
CLC 0(8,R7),USTATPNA
BE CR3
CR2R LA R6,9(R6)
BCT R5,CR1
CR2NOP NOP CIRET CRNOF2 EQU *
MVC TCR3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT
CNOP 0,4
CR3CMD TYPIO MSG=LCR3CMD
B CIRET
CR3 EQU *
ICM R4,B'1111',1(R6)
PRINT GEN,BASE
MVC TCRCMD+12(8),USTATPNA
MVC TCRCMD+21(8),USTATPRO
MVC TCRCMD+36(8),USCPNAME
MVC TCRCMD+51(8),USPNA
CNOP 0,4
LEVCO NEWLV=5
CRCMD TYPIO MSG=LCRCMD
LEVCO NEWLV=10
MVI CR2NOP+1,X'F0'
B CR2R
B CIRET
DS 0F
LCR3CMD DC Y(ECR3CMD-LCR3CMD)
DS CL2
TCR3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECR3CMD EQU *
DS 0F
LCRCMD DC Y(ECRCMD-LCRCMD)
DS CL2
TCRCMD DC C' % ZCP0062 XXXXXXXX/XXXXXXXX VTERM:XXXXXXXX; APPL=XXX-
XXXXX'
ECRCMD EQU *
DS 0F
- ----------------------------------------------------------------------*
- INFO - APPLIKATIONEN 'A' ***
- ----------------------------------------------------------------------*
CA1 EQU *
XC 0(1,R6),=X'00'
BNZ CA2
LA R6,9(R6)
BCT R5,CA1
CANOF1 EQU *
B CA2NOP
CA2 ICM R4,B'1111',1(R6)
CLC 0(8,R7),USPNA
BE CA3
CA2R LA R6,9(R6)
BCT R5,CA1
CA2NOP NOP CIRET CANOF2 EQU *
MVC TCA3CMD+20(8),0(R7) ANGEFORDERTES OBJEKT
CNOP 0,4
CA3CMD TYPIO MSG=LCA3CMD
B CIRET
CA3 EQU *
ICM R4,B'1111',1(R6)
PRINT GEN,BASE
MVC TCACMD1+18(8),USCPNAME
MVC TCACMD1+33(8),USTATPNA
MVC TCACMD1+42(8),USTATPRO
CA3NOP1 NOP CA3NOPX
MVC TCACMD+24(8),USPNA
CNOP 0,4 59
CACMD TYPIO MSG=LCACMD CA3NOPX EQU *
CNOP 0,4 59
LEVCO NEWLV=5
CACMD1 TYPIO MSG=LCACMD1
LEVCO NEWLV=10
MVI CA2NOP+1,X'F0'
MVI CA3NOP1+1,X'F0'
B CA2R
B CIRET
DS 0F
LCA3CMD DC Y(ECA3CMD-LCA3CMD)
DS CL2
TCA3CMD DC C' % ZCP0061 ELEMENT XXXXXXXX NOT FOUND.' ECA3CMD EQU *
DS 0F
LCACMD DC Y(ECACMD-LCACMD)
DS CL2
TCACMD DC C' % ZCP0063 APPLICATION XXXXXXXX CONNECTED WITH:' ECACMD EQU *
DS 0F
LCACMD1 DC Y(ECACMD1-LCACMD1)
DS CL2 18 33 42
TCACMD1 DC C' % ZCP0063 VTERM=XXXXXXXX; TERM=XXXXXXXX/XXXXXXXX' ECACMD1 EQU *
DS 0F
- ----------------------------------------------------------------------*
CIRET EQU *
CNOP 0,4 59
MVI CR2NOP+1,X'00'
MVI CA2NOP+1,X'00'
MVI CA3NOP1+1,X'00'
L R15,SAV15
USING CPINF,R15
L R14,SAV14
LM R0,R13,SAVTAB
BR R14
- ----------------------------------------------------------------------*
DS 0F
SAVTAB DS 14F SAV15 DS F SAV14 DS F
DS 0D
TRTAB DC 256X'00'
ORG TRTAB
DC X'40'
ORG TRTAB+256
DS 0F
- ---------------------------------------------------------------------*
- D S E C T S ***
- ---------------------------------------------------------------------*
- ---- ZENTRALE TABELLEN ------------------------------------------*
STATEIN
EJECT
USEREIN
- ---------------------------------------------------------------------*
END