SPL,L,O,M 
!     NAME:   ST.DU 
!     SOURCE: 92070-18033 
!     RELOC:  92070-16033 
!     PGMR:   G.A.A.
!     MOD:    M.L.K.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 ST.DU(7) "  92070-1X033  REV.1941  790712" 
! 
!     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 STORED OR 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. 
! 
!  EXTERNAL SUBROUTINES 
      LET CK.SM     BE SUBROUTINE,EXTERNAL
      LET CLOSE     BE SUBROUTINE,EXTERNAL
      LET CREA.     BE SUBROUTINE,EXTERNAL
      LET EXEC      BE SUBROUTINE,EXTERNAL
      LET IER.      BE SUBROUTINE,EXTERNAL,DIRECT 
      LET LOCF      BE SUBROUTINE,EXTERNAL
      LET MSS.      BE SUBROUTINE,EXTERNAL
      LET OPEN.     BE SUBROUTINE,EXTERNAL
      LET READF     BE SUBROUTINE,EXTERNAL
      LET RWNDF     BE SUBROUTINE,EXTERNAL
      LET WRITF     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET IFBRK     BE FUNCTION,EXTERNAL
!  EXTERNAL INTEGERS
      LET .E.R      BE INTEGER,EXTERNAL 
      LET BUF.      BE INTEGER,EXTERNAL 
      LET I.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET O.BUF     BE INTEGER,EXTERNAL 
! 
      LET DU..,ST..        BE SUBROUTINE
! 
      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)
! 
ST..: SUBROUTINE(NPD,LISTO,ERD)  GLOBAL 
      ERD_ -1                                    !SET DUMP FLAG 
      DU..(NPD,LISTO,ERD)                        !CALL DUMP SUBR
      RETURN
      END 
! 
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 
      COPY_ 0                                    !SET COPY FLAG FALSE 
! 
!     PRESET DEFAULT OPTIONS
! 
      OBUF,SPDCB_@O.BUF                          !SET DCB ADDRESS FOR SPACING 
      IBUF_ @I.BUF                               !SET INPUT DCB ADDRESS 
      BUFF,BUFA,BF_@BUF.
      DO[F1,SIOI,EOFF,CK,SIO,FLG,LDR_0] 
      DO[SUBF_410K;F2,TYP,DUMP_1] 
      IFNOT ERS+1 THEN [ERS,DUMP_0;SPDCB_IBUF]   !SET STORE OPTIONS 
      IF NPS<2 THEN [ERS_55;RETURN] 
      DT_3                                       !SET DEFAULT TYPE
! 
!     ANALYZE OPTIONS 
! 
!       FIRST THE TYPE FLAG 
! 
      IFNOT $LIS8 THEN GO TO ST3                 !NULL,SO 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_110K;\
                       DT_5; GO TO ST3] 
         IF $LIS9 = BN THEN[SUBF_110K;   \
                             GO TO ST3] 
      IF $LIS9 = BA THEN[CK,SUBF_2110K;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.(I.BUF,$LIS1,N.OPL  ,SUBF+1) 
      LOCF(I.BUF,.E.R ,ID,ID,ID,ISZ,ILU,INTY,ISZ2)
      IER.
      IF $LIS17>0 THEN F1_$LIS17-1
      IF $LIS21>0 THEN F2_$LIS21, ELSE \
         [IFNOT $LIS21 THEN [IF$LIS17>0 THEN GOTO ST6,ELSE[\
                             IF    INTY THEN F2_9999]]] 
! 
ST6:  SUBF_(SUBF AND 110K)+LDR     \SET OUTPUT FUNCTION 
         OR[IF (INTY AND 177775K)=5 THEN 110K,ELSE 0] 
      IF INTY=6  THEN SUBF_ SUBF OR 110K
      IF $LIS9=AS THEN SUBF_SUBF AND 177677K
! 
!     IF A STORE OPERATION CREAT THE FILE 
! 
      SZ1_[SZ_[TY_[OPLS_@N.OPL+5]+2]+1]+1 
! 
      IFNOT ERS+2 THEN[                          \COPY, THE FILE IS OPEN
         ERS_ 0;                                 \
         COPY_ 1;                                \
         GOTO ST12]                              !
      IF DUMP THEN GO TO ST10                    !DUMP, DON'T CREATE THE FILE 
! 
!     SET DEFAULTS
! 
      IFNOT $TY THEN $TY_[IF INTY THEN INTY,\ 
         ELSE DT] 
      IFNOT $SZ THEN $SZ_[IF INTY THEN ISZ->1,\ 
                           ELSE 24 ]             !NOTE THIS DEFAULT 
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      IFNOT $SZ1 THEN[IF INTY THEN $SZ1_ISZ2] 
! 
!     CREAT THE FILE
! 
      CREA.(O.BUF,$LIS5,$OPLS)?[GO TO ST10] 
      GO TO ST12
ST10: IFNOT SUBF AND 177760K  THEN SUBF_ SUBF AND 7 
      OPEN.(O.BUF,$LIS5,$OPLS,SUBF)              !OPEN FILE FOR DUMP
ST12: LOCF(O.BUF,.E.R ,ID,ID,ID,ISZ,OLU,OUTY) 
      IER.
      IF INTY=6 THEN $(IBUF+2),INTY_1 
      IF OUTY=6 THEN $(OBUF+2),OUTY_1 
! 
!     BOTH IN AND OUT ARE OPEN -- 
!     LEADER HAS BEEN PUNCHED IF NOT SUPPRESSED.
! 
!     IF SIO STORE THEN SET IT UP 
! 
      IF SIO THEN [IFNOT DUMP THEN[\
         SIO_0; SIOI_1;BUFF_[BUFA_BF]+1]] 
! 
      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(I.BUF,.E.R ,$BUFA,128,ALN)
      IF IFBRK() THEN[                           \IF BREAK THEN 
BRK:     MSS.(0);                                \SEND BREAK ERROR
         GOTO KILL]                              !AND FLUSH FILE
      IF .E.R = -12 THEN [ALN_ -1;GO TO ST16] 
      IER.
      IF ALN>0 THEN GO TO ST20                   !DATA? 
! 
!     NO DATA -- EITHER EOF OR ZERO REG 
!     END OF XFER?
! 
ST16: IFNOT ALN+1 THEN[IF INTY THEN[F2_0;\
                GO TO ST18]]                     !TRUE EOF-QUIT 
! 
      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 NOT REQUESTED--EO
      GO TO EXIT                                 !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                                      !INDICATE RECORD WRITTEN 
ST22: IF ALN>0 THEN[IF SIO THEN[$BUFF_-ALN;ALN_ALN+1]],\
        ELSE[IF F2 THEN[IF OUTY THEN ALN_0]]
      WRITF(O.BUF,.E.R ,$BUFF,ALN)
      IF .E.R  = -6 THEN[MSS.(.E.R );GO TO KILL]
      IER.
      IF ALN= -1 THEN[IFNOT F2 THEN GOTO EXIT,\ 
                ELSE GO TO ST25  ]
      IF ALN THEN GO TO ST15
ST25: EXEC (13, ILU,DVT6)                        !GET THE DEVICE TYPE 
      IF(DVT6 AND 37400K)=6000K  THEN[           \IF PHOTO-READER 
         MSS.(2006);                             \PRINT ERROR 
           EXEC(7)]                              !PAUSE FOR NEXT TAPE 
      GO TO ST15
! 
ABO:  MSS.(7)                                    !SEND CHECK SUM ERROR
KILL: ID_ -1                                     !SET TO ABORT THE FILE 
      IF COPY  THEN [ERS_22; RETURN]             !NOTIFY COPY OF BREAK
ENDIT:IF DUMP THEN RETURN 
      IFNOT OUTY THEN RETURN
      IF ID<0 THEN RWNDF(O.BUF)                  !REWIND TO BE SURE OF PURGE
      CLOSE(O.BUF,.E.R ,$SZ-ID-1)                !CLOSE AND 
      IER.
      RETURN
! 
EXIT: LOCF(O.BUF,.E.R ,T,ID,IOF)
      IER.
      IF OUTY < 3  THEN[                              \IF TYPE 1 OR 2 
         IFNOT IOF  THEN ID_ ID-1]                    !ADJUST RB FOR 0
                                                      !OFFSET 
      IFNOT FLG THEN ID_-1
      GO TO ENDIT 
      END 
! 
! 
      END 
      END$