Cplogin

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Wechseln zu: Navigation, Suche
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
*
CPLOGIN  CSECT
*
         PRINT NOGEN
*---------------------------------------------------------------------*
***      INIT REGISTERS                                             ***
*---------------------------------------------------------------------*
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
CPLOGIN  AMODE ANY
CPLOGIN  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
* > REGISTERUEBERGABE <
* R3  STATEIN
* R4  USERPAGA
* R5  PARAM    
* R6  TEILW. FUER PID   
* R7  USERPAGE
* R8  DIV. BASIS-REG
* R14 RET. ADRES   (BASR R14,R15)
* > BENUTZTE REGISTER <
* R9  BASISREG
* 
*---------------------------------------------------------------------*
         USING *,R15
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         USING CPLOGI,R9     
         USING STATEIN,R3
         USING USEREIN,R4
CPLOGI   BASR  R9,0
         BCTR  R9,R0
         BCTR  R9,R0
         DROP  R15
         B     BEG    
SAV14    DS    F
SAVTAB   DS    5F
*---------------------------------------------------------------------*
*        E X T R N ' S   /  E N T R I E S
*---------------------------------------------------------------------*
         EXTRN LIB
         EXTRN OPENUM
         EXTRN CPNAME 
*---------------------------------------------------------------------*
BEG      EQU   *
         L     R4,USERPAGA
         L     R7,USERPAGE
         XR    R6,R6
         L     R8,=A(LIB)
         USING LIB,R8
* LIB PARAMETER ANGEGEBEN ?
         CLI   LIB,C' '
         BNE   LLIB                
** KEINE LIB
LNOLIB   EQU   *
         MVC   LG1FILE(25),=CL25'CP.V.T.'
         MVC   LG1FILE+7(8),15(R5)     
         MVC   STATVT(8),15(R5)     
L001     EQU   *
         MVC   Z2(80),=CL80' '
         MVC   Z2(25),LG1FILE
         B     LGQ0
** LIBRARY BEARBEITUNG
LLIB     EQU   *
         MVC   LG1FILE(25),=CL25'CP.V.T.'
         MVC   LG1FILE+7(8),15(R5)     
         MVC   STATVT(8),15(R5)     
         MVC   Z2(80),=CL80' '
         MVC   Z2(45),LIB         VON 30 AUF 45  V2.1B30
         LA    R14,Z2
L002     AH    R14,=H'1'
         CLI   0(R14),C' '
         BNE   L002
         MVI   0(R14),C'('
         MVC   1(25,R14),LG1FILE
         LA    R14,Z2
LGC0     AH    R14,=H'1'
         CLI   0(R14),C' '
         BNE   LGC0
         MVI   0(R14),C')'
         PRINT GEN,BASE
LGQ0     MVC   SYSF+47(55),Z2    LEN VON 40 AUF 55   V2.1B30
* VERSORGEN IN VORBELEGUNG
         CNOP  0,4
SYSF     SYSFL 'SYSDTA=123456789012345678901234567890123456789012345678-
               9012345'
         PRINT NOGEN,BASE
         CLM   R15,B'0001',=X'00'
         BNE   RETNOF
C1       MVC   LOPAC(20),=CL80' '
** EINLESEN TERMLIB SAETZE , INIT USERTAB UND STATTAB
         RDATA LODAT,C10,80
         CLC   LOPAC(12),=CL12'*CP01-PARAM:'
         BNE   P30DEV
         MVC   STATPW,LOTERM
** STATPW MIT X'00' FUELLEN
         LA    R1,STATPW
         LA    R2,STATPW+8
C1P10    CLI   0(R1),C' '
         BE    C1P11
         LA    R1,1(R1)
         CR    R1,R2
         BL    C1P10
         B     C1P12
C1P11    MVI   0(R1),X'00'
         B     C1P10
C1P12    EQU   *
         MVC   STAPWSAV(8),STATPW
**
         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'
         LA    R4,256(R4)         + X'100'
         CLI   USPID+1,X'00'
         BE    C3
         CR    R4,R7
         BL    C2     
         B     C10
C3       EQU   *
         CLC   LOTERM,=CL8' '
         BNE   C4
         L     R8,=A(OPENUM)
         USING OPENUM,R8
         L     R15,OPENUM
         LA    R15,1(R15)          + 1
         ST    R15,OPENUM
         CVD   R15,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         L     R8,=A(CPNAME)
         USING CPNAME,R8
         MVC   LOTERM(2),CPNAME
         MVC   LOTERM+2(6),RES+3
C4       EQU   *
         MVC   USCPNAME,LOTERM
         MVC   USPRO,LOPRO
         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   USLEN,=F'0'
         MVC   USRES,=F'0'
         MVC   USRPBA,=F'0'
         MVC   USCCBA,=F'0'
         XC    USIN(4),USIN     
         XC    USAID(4),USAID   
         XC    USEI(4),USEI     
         XC    USCO(4),USCO     
         B     C1
C10      SYSFL 'SYSDTA=(PRIMARY)'
** R15=00  POSITIVER RET-CODE
** USERTAB UPDATED
         XR    R15,R15
         B     RET
RETNOF   SYSFL 'SYSDTA=(PRIMARY)'
** NEGATIVER RET-CODE
         LA    R15,255            X'FF' INS LSBYTE
         B     RET
*----------------------------------------------------------------------*
RET      L     R14,SAV14
         LM    R8,R12,SAVTAB
         BR    R14
*----------------------------------------------------------------------*
         DS    F
FEHLER   EQU   *
         ST    R13,FEHLER-4
         ST    R15,ERR15
         UNPK  ERRR15,ERR15(5)
         TR    ERRR15,HX-240
         WROUT ERRMSG,TERME
TERME    L     R13,FEHLER-4
         BR    R13
*----------------------------------------------------------------------*
ERRMSG   DC    Y(ERRMSGE-ERRMSG)
         DC    C'   %  ZCP0006 CP-ERROR AT:'
ERRTEXT  DS    CL20
         DC    C'  RC:'
ERRR15   DS    L9
ERRMSGE  EQU   *-1
         ORG
         DS    0F
HX       DC    C'0123456789ABCDEF'
ERR15    DS    F
*----------------------------------------------------------------------*
** ------------------ TERMLIB-SATZ
* MUSS IDENTISCH MIT LODAT AUS MCP002 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 
** -------------------------------
         DS    0F
DOWO     DS    D
RES      DS    CL9
         DS    0F
LG1FILE  DS    CL25
Z2       DS    CL80
*----------------------------------------------------------------------*
*        D S E C T ' S                                                 *
*----------------------------------------------------------------------*
         STATEIN
         EJECT
         USEREIN
*---------------------------------------------------------------------*
         END