SPL,L,O,M,C 
!     NAME:   CO..  
!     SOURCE: 92064-18154 
!     RELOC:  92064-16055 
!     PGMR:   G.A.A.
!     MOD:    G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
! 
      NAME CO..(7) " 92064-16055  REV.1650  760907" 
! 
!     CO.. IS A MODULE  OF THE RTE
!     FMP  PROGRAM  FMGR. 
!     CO  COPIES  ALL  DISC  FILES  ON
!     ONE  DISC   TO   SOME   OTHER DISC. 
!     THE   COMMAND  IS:
!     CO, CR, CR2 
!     WHERE:
!         CR IS THE FROM DISC ID
!         CR2  IS THE TO DISC ID
! 
! 
!     DEFINE  EXTERNALS 
! 
      LET  DR.RD, DU..,MSS.,IMESS,CREAT,CLOS.\
                         BE SUBROUTINE,EXTERNAL 
! 
      LET PK.DR,N.OPL, DS.LU BE INTEGER,EXTERNAL
      LET IDCB2     BE INTEGER ,EXTERNAL
! 
!     DEFINE   LOCALS 
! 
      LET SETAD   BE SUBROUTINE 
! 
      LET STLIS,FNAM(3),LTY,TNAM(3),\ 
            OPLS, SACD, DM(14)  BE INTEGER
CO..: SUBROUTINE (N, LIS,ER) GLOBAL 
                    !SET UP DU.. CALL ARRAY 
      FOR  T _ @ STLIS TO @ STLIS+23 DO  $T _0
      LTY,STLIS,OPLS_3 !SET TYPE FLAGS
! 
      SACD _ 51501K   ! SAVE  EOF  MARKS
! 
      LIS5 _ [LIS1 _ @ LIS+1]+4 
! 
!     SET UP THE OPTION   LIST ADDRESSES
! 
      OPS2_ [OPS1_[OPT2 _ [OPCR2_ [OPL_ [OPT1_ [\ 
                  OPCR1_ @N.OPL+1]+1]+3] \
                    + 1]+1]+1]+1
! 
      BLK_0 
      FOR T _  OPCR1  TO  OPS2  DO  $T _ 0
! 
      $ OPCR1 _ $ LIS1
      $ OPCR2 _ $ LIS5
      ADD_128  !SET UP ADDRESS INCREMENT
! 
      DRBF _      @PK.DR  ! SET PACK BUFADD.
! 
!     CHECK FOR LEGAL DISCS.
! 
      IF $ LIS5 THEN    [DR.RD(1,$LIS5,0)?[ \ 
                         GO TO NODES] ; LU_$$@DS.LU\
                         ;GO TO INCK] 
! 
NODES:DO[ER_21;RETURN]! NO DIS C EXIT 
! 
INCK: IFNOT $LIS1  THEN GO TO NODES 
! 
      SETAD ? [GO TO NODES] 
      IF LU = $$@ DS.LU THEN GO TO NODES
! 
!     BOTH DISCS ARE DEFINED AND
!     SEPERATE
! 
!     START TRANSFER
! 
XFER: SETAD? [RETURN   ]
      IF  $PKD<0  THEN GO TO XFER 
! 
      IFNOT  $PKD3  THEN GO TO XFER 
      IF $PKD5 AND 177400K THEN GOTO XFER !SKIP EXTENTS 
      IMESS (2, FNAM,3) ! SEND CURRENT NAME TO LOG
      CREAT(IDCB2,.E.R.,$PKD,$OPS1,$PKD3,$PKD8,$LIS5)! CREAT THE FILE 
      IF .E.R.<0 THEN [MSS.(.E.R.     );GO TO XFER] 
      ERR_-2  !SET COPY CALL FLAG FOR DU ROUTINE
      DU..(4, STLIS,ERR) !CALL STORE TO TRANSFER
! 
      IFNOT ERR THEN GO TO XFER 
! 
! 
BAD:  MSS. (ERR)         !PRINT MESSAGE 
! 
! 
      ER _ 22 
      RETURN
      END 
! 
! 
SETAD:SUBROUTINE  FEXIT   ! READ DIRECTORY
                          ! AND SET UP ST CALL
! 
      IF ADD = 128 THEN [ \ 
            DR.RD (1,$LIS1,BLK)?[FRETURN];\ 
                ADD_ 0; BLK_ BLK+1] 
! 
      PKD8_[PKD7_[PKD6_[PKD5_[PKD3_[PKD2_[PKD_ \
             DRBF+ADD]+2]+1]+2]+1]+1]+1 
! 
      ADD_ ADD+16   !SET ADD FOR NEXT TIME
      IFNOT   $PKD THEN FRETURN !END OF DIR.
      T1_@FNAM     !SET  TO MOVE
      T2_@ TNAM     !NAME  TO  CALL 
      FOR  T _ PKD TO PKD2 DO[$T1,$T2_ $T;\ 
                                T1_T1 +1; T2_T2+1]
! 
      N.OPL,$OPL_$PKD8  ! SET SECURITY CODES
! 
      $OPT1,$OPT2_$PKD3 ! SET TYPES 
      $OPS1_$PKD6/2  ! SET DEST SIZE
      $OPS2_$PKD7      ! SET DEST REC. SIZE 
      RETURN              ! DONE - RETURN 
      END 
      END 
      END$
                                                                                    