SPL,L,O,M,C 
!     NAME:   DU..  
!     SOURCE: 92064-18044 
!     RELOC:  92064-16017 
!     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 DU..(7) " 92064-16017  REV.1650  761010"   
! 
!     THIS IS THE RTE FMP FMGR ROUTINE TO STORE 
!     AND DUMP FILES. 
! 
!     DU,NAME,LU,OP1,OP2,OP3
! 
!        O R
! 
!     ST,LU,NAME,OP1,OP2,OP3,OP4
! 
! 
!     W H E R E:
! 
!     ST            IS STORE. 
!     DU            IS DUMP.
! 
!     NAME
!     NAME          IS THE FILE TO BE DUMPED. 
! 
!     LU            IS EITHER THE SOURCE OR DESTINATION 
!                   DEVICE AND MAY BE A FILE REFERENCE. 
! 
!     OP1           IS A MEDIUM ASC CODE AS FOLLOWS:
!                     AS   ASCII DATA 
!                     BR   BINARY RELOCATABLE DATA
!                     BA   BINARY ABSOLUTE DATA 
!                     MT   MAG TAPE NORMAL FORMAT 
!                     MS   MAG TAPE SIO FORMAT
! 
!     OP2           IS AN END OF FILE OPTION
!                   FLAG -- TWO ASC CHARACTERS: 
!                     SA   SAVE END OF FILES IN THE 
!                          NEW FILE.
!                     IN   INHIBIT ALL LEADER, TRAILER, 
!                          END OF FILE TRANSFERS; 
!                          DOES NOT APPLY TO FINAL
!                          EOF ON A DISC FILE.
! 
!     OP3           IS THE NUMBER OF THE FIRST FILE 
!                   TO BE TRANSFERRED (APPLIES TO 
!                   FILES OF TYPE ZERO) (DEFAULT=1) 
! 
!     OP4           IS THE NUMBER OF FILES TO BE
!                   TRANSFERRED (APPLIES TO FILES 
!                   OF TYPE ZERO) (DEFAULT= ) 
! 
!     N O T E:      OP3 AND OP4 ARE RELATIVE TO CURRENT POSITION. 
! 
!     DEFINE EXTERNALS
! 
      LET IDCB1,IDCB2,BUF. BE INTEGER,EXTERNAL
! 
      LET N.OPL,.E.R       BE INTEGER,EXTERNAL
! 
      LET  OPEN.,LOCF,\ 
          EXEC,READF,WRITF,\
          MSS.,\
          IER.,CK.SM,CLOSE BE SUBROUTINE,EXTERNAL 
! 
      LET IFBRK            BE FUNCTION,EXTERNAL 
! 
      LET DU..             BE SUBROUTINE
! 
      LET SECT2     BE CONSTANT(1757K)
      LET AS        BE CONSTANT (40523K)
      LET BR        BE CONSTANT (41122K)
      LET BN        BE CONSTANT (41116K)
      LET BA        BE CONSTANT (41101K)
      LET MT        BE CONSTANT (46524K)
      LET MS        BE CONSTANT (46523K)
      LET IH        BE CONSTANT (44510K)
      LET SA        BE CONSTANT (51501K)
      LET B.A       BE CONSTANT (20101K)
      LET B.R       BE CONSTANT (20122K)
! 
! 
! 
DU..: SUBROUTINE(NPS,LISTS,ERS)  GLOBAL 
      LI12_[LIS8_[LIS4_@LISTS+4]+4]+4 
! 
      LIS21_[LIS17_[LIS13_[LIS9_[LIS5_[LIS1_\ 
        @LISTS+1]+4]+4]+4]+4]+4 
! 
!     PRESET DEFAULT OPTIONS
! 
      O2BF,SPDCB_@IDCB2      !SET DCB ADDRESS FOR SPACING 
      IDCBA_@IDCB1       !SET INPUT DCB ADDRESS 
      BUFF,BUFA,BF_@BUF.
      DO[F1,SIOI,EOFF,CK,SIO,FLG_0;LDR_0] 
      DO[SUBF_400K;F2,TYP_1]
      IF NPS<2 THEN [ERS_55;RETURN] 
      DT_3   !SET DEFAULT TYPE
! 
!     ANALYZE OPTIONS 
! 
!       FIRST THE TYPE FLAG 
! 
      IFNOT $LIS8 THEN GO TO ST3 !OPTION IS NULL GO TO CHECK NEXT 
      IF $LIS9 = MS THEN [SIO_1;BUFA_BF+1;\ 
                             LIS9_LIS9+1] 
      IF $LIS9="  " THEN GO TO ST3
         IF $LIS9 = AS THEN [SUBF_410K;GO TO ST3] 
         IF $LIS9 = BR THEN[CK,SUBF_310K;\
                       DT_5; GO TO ST3] 
         IF $LIS9 = BN THEN[SUBF_310K;   \
                             GO TO ST3] 
      IF $LIS9 = BA THEN[CK,SUBF_2310K;TYP_0;\
                        DT_7;GO TO ST3] 
      IF $LIS9 = MT THEN GO TO ST3
      IF $LIS9 = SA THEN[EOFF_1;GO TO ST2]
      IF $LIS9 = IH THEN[LDR_20000K;GO TO ST2]
! 
STER1:DO[ERS_56; RETURN]
! 
!     CHECK FOR OP2 
! 
ST3:  IF $LI12#3 THEN GO TO ST2 
! 
      IF $LIS13 = SA THEN[EOFF_1;GO TO ST5] 
      IF $LIS13 = IH THEN[LDR_20000K;GO TO ST5] 
! 
      GO TO STER1   !ILLEGAL OPTION 
!     OPT2          WAS FOUND IN OP1 LOCATION SO
!                   ADJUST ADDRESSES AND SKIP 
!                   OPT2 CHECK. 
! 
! 
ST2:  DO[LIS21_[LIS17_LIS13]+4] 
ST5:  OPEN.(IDCB1,$LIS1,N.OPL  ,SUBF+1) 
! 
!   SEE IF CHECK SUM REQUIRED 
! 
      IF [ID_ $ ( IDCBA +1)] =B.A THEN [TYP_0;CK_1;SUBF_2310K],\
                        ELSE[IF ID=B.R THEN [CK_1;SUBF_310K]] 
      IF $LIS17>0 THEN F1_$LIS17-1
      IF $LIS21>0 THEN F2_$LIS21
! 
ST6:  SUBF_(SUBF AND 100K)+LDR     !SET OUTPUT FUNCTION 
      IF $LIS9=AS THEN SUBF_SUBF AND 177677K
ST10:      OPEN.(IDCB2,$LIS5,$(@N.OPL+5),SUBF)
! 
!     BOTH IN AND OUT ARE OPEN -- 
!     LEADER HAS BEEN PUNCHED IF NOT SUPPRESSED.
! 
! 
      UNTIL F1=0 DO[READF($SPDCB,.E.R ,$BUFA,128,ALN);IER.;\
         IF ALN<1 THEN[F1_F1- 1; IF IFBRK() THEN GO TO BRK]]
ST15: READF(IDCB1,.E.R ,$BUFA,128,ALN)
      IF IFBRK() THEN[\  IF BREAK THEN
BRK:  MSS.(0);GO TO KILL]    ! SEND BREAK ERROR AND GO FLUSH THE FILE 
      IER.
      IF ALN>0 THEN GO TO ST20 ! DATA?
! 
!     NO DATA -- EITHER EOF OR ZERO REG 
! 
! 
!     END OF XFER?
! 
! 
      IF [F2_F2-1] THEN [IF EOFF THEN[ALN_-1;\
                GO TO ST22],ELSE GO TO ST25]
ST18: ALN_-1
      IFNOT LDR  THEN GO TO ST22   !  IF INHIBIT BIT SET-DONE 
! 
      GO TO KILL   !DONE - NO EOF REQUIRED
! 
ST20: DO            [IF SIOI THEN [ALN_[\ 
          IF $BUFA<0 THEN-$BUFA,ELSE\ 
           ($BUFA+1)>-1];ID_BUFA+1],ELSE\ 
             ID_BUFA ;IF CK THEN[\
                CK.SM($ID,TYP)?[GO TO ABO];ALN_($ID-<8)+(1-TYP)*3]] 
      FLG_1  !SET FLAG TO SAY WE WROTE A RECORD 
ST22: IF ALN>0 THEN[IF SIO THEN[$BUFF_-ALN;ALN_ALN+1]]
      WRITF(IDCB2,.E.R ,$BUFF,ALN)
      IER.
      IF ALN= -1 THEN[IFNOT F2 THEN GOTO KILL,\ 
                ELSE GO TO ST25  ]
      IF ALN THEN GO TO ST15
ST25: EXEC (13,$(IDCBA+3),EQT5) 
      IF(EQT5 AND 37400K)=400K THEN [MSS.(6);\
           EXEC(7)] 
      GO TO ST15
! 
ABO:  ERS_7         !SEND CHECK SUM ERROR 
KILL: RETURN              !EXIT 
      END 
! 
! 
      END 
      END$
                                                                                                                                                      