Cpinf

Aus SiWiki
Wechseln zu: Navigation, Suche
* 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