!TITLE Moving System Software to Disc Sites
!<DPRG
externalintegerfn  DPRG(string (31)FILE INDEX, FILE,
      integer  FSYS, string (6)LABEL, integer  SITE)
!
! This privileged procedure moves the contents of file FILE belonging to
! file index FILE INDEX on disc-pack FSYS to site SITE on the EMAS 2900
! disc-pack labelled LABEL.
!
! SITE is an epage number which must be X'40'-aligned.  The physical
! size of the file must not exceed 256 Kbytes (512 Kbytes for sites
! X'380', X'400' and X'480'.
!>
INTEGER  J
STRING (31)UNAME, INAME, FNAME, INDEX, FULL
      J = IN2(66)
      -> OUT UNLESS  J = 0
!
      J = 93
      -> OUT UNLESS  DTRYING << 6 < 0
!
      J = UFO(FILE INDEX, FILE, UNAME, INAME, FNAME, INDEX, FULL)
      -> OUT UNLESS  J = 0
!
      J = DPRGP(INDEX, FNAME, LABEL, FSYS, SITE, 0)
OUT:
      RESULT  = OUT(J, "SSISX")
END ; ! DPRG
!
!-----------------------------------------------------------------------
!
!<DUNPRG
externalintegerfn  DUNPRG(string (31)FILE INDEX, FILE,
      integer  FSYS, string (6)LABEL, integer  SITE)
!
! This privileged procedure creates a 256 Kbyte file FILE belonging to
! file index FILE INDEX on disc-pack FSYS and copies into it 256 Kbytes
! from site SITE on the EMAS 2900 disc-pack labelled LABEL.  [For sites
! X'380, X'400 and X'480, the size has been extended to 512 Kbytes]
!>
INTEGER  J, DA, NKB, SEG, GAP, K
STRING (31)UNAME, INAME, FNAME, INDEX, FULL
RECORD (FHDRF)NAME  FHDR
      J = IN2(85)
      -> OUT UNLESS  J = 0
!
      J = 93
      -> OUT UNLESS  DTRYING << 6 < 0
!
      J = UFO(FILE INDEX, FILE, UNAME, INAME, FNAME, INDEX, FULL)
      -> OUT UNLESS  J = 0
!
      NKB = 256
      NKB = 512 IF  SITE = X'380' OR  SITE = X'400'; ! bigger file for SS
      J = DCREATEF(FULL, FSYS, NKB, 1, LEAVE, DA)
      J = DPRGP(INDEX, FNAME, LABEL, FSYS, SITE, 1) IF  J = 0
      -> OUT UNLESS  J = 0
!
      -> OUT UNLESS  NKB = 512
!
      SEG = 0  { trim subsys }
      GAP = 0
      J = DCONNECTI(FULL, FSYS, 1, 0, SEG, GAP)
      -> OUT UNLESS  J = 0
!
      FHDR == RECORD(SEG << 18)
      NKB = (FHDR_NEXTFREEBYTE + 1023) >> 10
      J = DCHSIZE(INDEX, FNAME, FSYS, NKB)
      K = DDISCONNECTI(FULL, FSYS, 0)
OUT:
      RESULT  = OUT(J, "SSISI")
END ; ! DUNPRG
!
!-----------------------------------------------------------------------
!
INTEGERFN  DPRGP(STRING (18)INDEX, STRING (11)FNAME, STRING (6)LABEL,
      INTEGER  FSYS, SITE, DIRECTION)
    ! DIRECTION = 0   PRG
    !             1   UNPRG
integer  TOFSYS, SYS START, EP, NP, FINDAD, LINK
integer  PAGS,FLAG,CHECKPAGS
integer  STARTP
integer  J,OMIT PAGES, NSD
record (FDF)name  FL
record (FF)name  F
record (FDF)arrayname  FDS
integername  SD
integerarrayname  SDS
conststring (5)FN = "DPRGP"
      FLAG = 8
      -> OUT UNLESS  LENGTH(LABEL) = 6
      -> OUT UNLESS  STOI2(FROMSTRING(LABEL, 5, 6), TO FSYS) = 0
!
      FLAG = 23; ! DISC NOT AVAILABLE
      -> OUT IF  AV(TOFSYS, 1) = NO
!
      FLAG = SYSBASE(SYS START, TOFSYS)
      -> OUT UNLESS  FLAG = 0
!
      FLAG = MAP FILE INDEX(INDEX, FSYS, FINDAD, FN)
      -> OUT UNLESS  FLAG = 0
!
      F == RECORD(FINDAD)
!
      FLAG = 32; ! file does not exist
      J = NEWFIND(FINDAD, 0, FNAME)
      -> VOUT IF  J = 0
!
      FDS == ARRAY(FINDAD+F_FDSTART, FDSF)
      FL == FDS(J)
!
      FLAG = 5; ! not available
      -> VOUT UNLESS  FL_CODES & UNAVA = 0
!
      PAGS = FL_PGS
      SDS == ARRAY(FINDAD + F_SDSTART, SDSF)
      NSD = (F_FDSTART - F_SDSTART) >> 2
      OMIT PAGES = 0
      OMIT PAGES = 1 AND  SITE = 0 IF  SITE = -1
!
      FLAG = 1; ! SITE NOT X40-aligned
      -> VOUT UNLESS  SITE & X'3F' = 0
!
      FLAG = 27; ! file too big
      CHECKPAGS = 64
      CHECKPAGS = 128 IF  SITE = X'400'; ! SUBSYS
      CHECKPAGS = 256 IF  SITE = X'380'
      -> VOUT IF  PAGS > CHECKPAGS
      SD == FL_SD; ! proceed down sections chain
      EP = PAGS
      WHILE  EP > 0 CYCLE 
         NP = EP
         NP = 32 IF  NP > 32
         EP = EP - NP
         LINK = SD >> 19
         STARTP = (SD << 13) >> 13
         STARTP = STARTP + OMIT PAGES
         NP = NP - OMIT PAGES
         OMIT PAGES = 0
         if  DIRECTION = 0 c 
         then  J = MOVE SECTION(FSYS,STARTP,TO FSYS,SITE+SYS START,NP) c 
         else  J = MOVE SECTION((1<<31)!TO FSYS,SITE+SYS START,FSYS,STARTP,NP)
          ! top bit set in param1 to suppress active block check
         FLAG = 25 and  -> VOUT unless  J = 0
!
         SITE = SITE + NP
!
         EXIT  UNLESS  0 < LINK <= NSD
         SD == SDS(LINK)
      repeat 
      FL_CODES = FL_CODES & (¬VIOLAT)
      FLAG = 0
VOUT:
      VV(ADDR(F_SEMA), F_SEMANO)
OUT:
      RESULT =FLAG
END ; ! DPRGP
!
!-------------------end-of-included-text--------------------------------
!