Cpcopy

CPCOPY   CSECT
* SEQ-DATEI LAENGE VON 25 AUF 54 ERHOEHT.
** V3.0A00
* FILENAM WIRD UEBER V(KONST) AUS MCP002 GELESEN
** 90.09.14
         PRINT GEN,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
CPCOPY   AMODE ANY
CPCOPY   RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
         USING *,R15
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         SPACE
         USING CPCOPYA,R3,R4
CPCOPYA  BASR  R3,0
         BCTR  R3,R0
         BCTR  R3,R0
         LA    R1,4095
         LA    R4,1(R3,R1)
         DROP  15
         B     BEG
SAV14    DS    F
SAVTAB   DS    5F
*----------------------------------------------------------------------*
         DS    0F
BEG      EQU   *
         L     R8,=V(SEQ)
         MVC   CFSTAT+40(54),0(R8)     FILENAM AUS MCP002
         MVC   FDBCFN2L(54),0(R8)
CFSTAT   FSTAT (X,54),CMIST,160,VERSION=800,FCBTYPE=ISAM,SIZE=(1,)
         LTR   R15,R15
         BNZ   FSERR
CCATAL   CATAL CP.START.SEQ.SRC,STATE=U,SHARE=NO
         LTR   R15,R15
         BNZ   FSERR
         L     R1,=V(FCBSEQ)
         CLOSE (R1)
         MVC   CLCMD+55(25),0(R8)    FILE
CLCMD    CMD   'TYPE',' %  ZCP0014 FILE  XXXXXXXXXXXXXXXXXXXXXXXXX CLOS-
               ED.'
COPY     OPSYN
CCOPY    COPY  CP.START.SEQ.SRC,X,SAME
         LTR   R15,R15
         BZ    COFSOK
         BAS   R10,FEHLER
         MVC   COCMD+60(4),DMSERR
         MVC   COCMD+73(25),0(R8)    FILE
COCMD    CMD   'TYPE',' %  ZCP0020 DVS-ERROR: XXXX ON FILE XXXXXXXXXXXX-
               XXXXXXXXXXXXX.'     49         60           73
         B     COOPS
COFSOK   CMD   'TYPE',' %  ZCP0015 SEQ-FILE SUCCESSFULLY WRITTEN.'
COOPS    L     R1,=V(FCBSEQ)
         OPEN  (R1),INPUT
         MVC   OPCMD+55(25),0(R8)    FILE
OPCMD    CMD   'TYPE',' %  ZCP0014 FILE  XXXXXXXXXXXXXXXXXXXXXXXXX OPEN-
               ED.'
         B     INTRET
FSERR    EQU   *
         BAS   R10,FEHLER
         MVC   FSCMD+60(4),DMSERR
         MVC   FSCMD+73(25),0(R8)    FILE
FSCMD    CMD   'TYPE',' %  ZCP0020 DVS-ERROR: XXXX ON FILE XXXXXXXXXXXX-
               XXXXXXXXXXXXX.'     49         60           73
INTRET   EQU   *
         LM    R8,R12,SAVTAB
         L     R14,SAV14
         BR    R14
FEHLER   EQU   *
         ST    R15,ERR15
         UNPK  UERR15,ERR15(5)
         TR    UERR15,HX-240
         BR    R10
*----------------------------------------------------------------------*
         DS    0F
CMIST    DS    CL160
         DS    CL120
HX       DC    C'0123456789ABCDEF'
ERR15    DS    F
UERR15   DS    0L9
         DS    L4
DMSERR   DS    L4
         DS    L1
         ORG   CFSTAT
         IDFST ,F
         ORG
*
         ORG   CCOPY+4   +4 WEIL DER IDCOP-MACRO FALSCH IST
         IDCOP ,F
         ORG
         END