!TITLE Archive and Backup
!<ACREATE2
!%externalintegerfn ACREATE2(%string(18)INDEX, TAPE, %string(8)FDATE,
! %string(11)FILE, %integer FSYS, NKB, CHAPTER, TYPE)
!
! This procedure is provided for use by the archive program. A new
! archive index entry is created for USER, giving TAPE, CHAPTER and
! no-of-Kbytes attributes to be associated with FILE. (Access permission
! attributes are given to FILE by separate calls of DPERMISSION.)
!
! DATE should normally be left null, when the current date will be used.
!>
INTEGERFN VOL REQ(STRING (6)TSN, INTEGERNAME SNO,
INTEGER REQ, MODE)
INTEGER DACT, FLAG
RECORD (PARMF)P
CONSTINTEGER CLAIM DACT = 68, RELEASE DACT = 69
DACT = CLAIM DACT
DACT = RELEASE DACT IF REQ # 0
!
P=0
P_DEST=X'FFFF0000' ! DACT
! P_P1=ID - NOT REQUIRED
P_P2=4; ! TYPE, 3=DISC, 4=TAPE
P_P3=MODE; ! 1=READ, 2=WRITE
P_P3=SNO IF REQ#0
STRING(ADDR(P_P4))=TSN
FLAG=DPON3I("VOLUMS",P,0,1,PON AND SUSPEND)
IF FLAG=0 THEN SNO=P_P3 AND FLAG=P_P2
RESULT =FLAG
END ; ! VOL REQ
!
!-----------------------------------------------------------------------
!
INTEGERFN TOCDT(STRING (8) DATE)
! COMPACTED DATE FUNCTION
STRING (3) Y,M,D
INTEGER YI,MI,DI
UNLESS DATE->D.("/").M.("/").Y THEN RESULT =0
YI=STOI(Y) - 70
MI=STOI(M)
DI=STOI(D)
RESULT =YI<<9 ! MI<<5 ! DI
END ; ! TOCDT
!
!-----------------------------------------------------------------------
!
STRINGFN UNCDT(INTEGER I)
STRING (3) D,M
D=ITOS(I&31)
IF LENGTH(D)=1 THEN D="0".D
M=ITOS((I>>5)&15)
IF LENGTH(M)=1 THEN M="0".M
RESULT =D."/".M."/".ITOS(70+(I>>9)&63)
END ; ! UNCDT
!
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN APP(INTEGERNAME SEMA)
! RESULT = 0 IF ARCHIVE INDEX NOT ALREADY IN USE, OTHERWISE
! 77
INTEGER ASEM
ASEM=ADDR(SEMA)
*LXN_ASEM
*INCT_(XNB +0)
*JCC_8,<GOT>
*TDEC_(XNB +0)
RESULT =77
GOT:
RESULT =0
END ; ! APP
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE AVV(INTEGERNAME SEMA)
INTEGER ASEM
ASEM=ADDR(SEMA)
*LXN_ASEM
*TDEC_(XNB +0)
END ; ! AVV
!
!-----------------------------------------------------------------------
!
INTEGERFN VOLS REQUEST(STRING (6)TAPE, USER TO INFORM,
INTEGER FSYS, CHAPTER, TYPE)
RECORDFORMAT VF(INTEGER DEST,SRCE,STRING (6) TAPE,USER TO INFORM, C
BYTEINTEGER FSYS,TYPE,INTEGER CHAP,IDENT)
RECORD (VF)P
RECORD (PARMF)NAME PREPLY
INTEGER J
P = 0
P_DEST = X'FFFF0000' ! 70; ! TAPE TRANSFER DACT
P_TAPE = TAPE
P_USER TO INFORM = USER TO INFORM
P_FSYS = FSYS
P_TYPE = TYPE
P_CHAP = CHAPTER
!
IF SITE = ERCC START
J = DPON3I("VOLUMS", P, 0, SYNC1 TYPE, PON AND SUSPEND)
PREPLY == P
J = PREPLY_P1 IF J = 0
FINISH
!
IF SITE = KENT START
J = DPON3I("VOLUMS", P, 0, SYNC1 TYPE, PON AND CONTINUE)
FINISH
!
RESULT = J
END ; ! VOLS REQUEST
!
!-----------------------------------------------------------------------
!
integerfn TSN TO I(stringname TAPE)
! ERROR RESULT IS 0 (PRECLUDES TAPE="000000" !)
integer J, CH
LONGINTEGER K
result =0 unless LENGTH(TAPE)=6
UCTRANSLATE(ADDR(TAPE)+1, 6)
K = 0
cycle J=1,1,6
CH=BYTEINTEGER(ADDR(TAPE)+J)
unless '0'<=CH<='9' or 'A'<=CH<='Z' then result =0
if CH <= '9' then CH = CH - '0' else CH = CH - 55
K = 36 * K + CH
repeat
!
*LSD_K
*STUH_B
*EXIT_-64
end ; ! TSN TO I
!
!-----------------------------------------------------------------------
!
stringfn I TO TSN(integer TSN)
integer J, CH
LONGINTEGER LTSN, T
string (6)S
*LSS_TSN
*LUH_0
*ST_LTSN
cycle J = 6, -1, 1
T = LTSN // 36
CH = SHORTENI(LTSN - 36 * T)
if CH<10 then CH=CH+'0' else CH=CH+55
CHARNO(S, J) = CH
LTSN = T
repeat
LENGTH(S) = 6
result = S
end ; ! I TO TSN
!
!-----------------------------------------------------------------------
!
INTEGERFN VOLUMS REQUEST(STRING (19)OWNER, STRING (255)NEWNAME, INTEGER TYPE, TSN, CHAP)
STRING (255)MSG
RECORD (PARMF)P
CONSTSTRING (1)C = ","
MSG = ITOS(TYPE) . C . C
I TO TSN(TSN) . C . C
ITOS(CHAP) . C . C
PROCUSER . C . C
ITOS(PROCFSYS) . C . C
OWNER
MSG = MSG . C . NEWNAME UNLESS NEWNAME = ""
P = 0
RESULT = DSPOOLBODY("VOLUMS", P, LENGTH(MSG), ADDR(MSG)+1)
END ; ! VOLUMS REQUEST
!
!-----------------------------------------------------------------------
!
externalintegerfn NEWAINDA(string (18)INDEX, integer FSYS,
integername AFINDAD)
!
!
!
integerfn SUM(integer AFINDAD)
integer X, T, A, W
record (FF)name AF
AF==RECORD(AFINDAD)
X = AF_MAXFILE
X = AF_SIZE << 9 IF X = 0
result = -1 if VAL(AFINDAD, X, 0, 0) = 0
X=AFINDAD + X - 4
T=0
cycle A = AFINDAD, 4, X
unless A = ADDR(AF_CHKSUM) start
W = INTEGER(A)
T = (T + W>>16 + W<<16>>16)<<16>>16
finish
repeat
result =t
end ; ! SUM
!
!
!
integer T, J, ACRHERE, SEG, GAP
record (FF)name AF
RECORD (FF)NAME F
unless SAINDAD = 0 start ; ! some index is connected
unless INDEX = SINDEX andc
((FSYS = -1) or (FSYS = SFSYS)) c
start
! but not the one that we want
AF == RECORD(SAINDAD)
T = SUM(SAINDAD)
IF T >= 0 AND (SRES # 59 OR INDEX = "###") START ; ! checksum is computable
! INDEX = ### is used to force new checksum in
AF_CHKSUM = T unless AF_CHKSUM = T; ! reset checksum if changed
F == RECORD(SFINDAD)
F_AFILES = AF_FILES0
F_ATOTKB = AF_CHERKB
FINISH
J = DDISCONNECTI(SINDEX . ".#ARCH", SFSYS, 0)
SINDEX = ""
SAINDAD = 0
-> OUT unless J = 0
finish
finish
J = 0
-> OUT if LENGTH(INDEX) < 6; ! just getting current index disconnected
!
*LSS_(lnb +1)
*ST_J
ACRHERE = (J>>20) & 15
!
J = FINDA(INDEX, FSYS, SFINDAD, 0); ! to get fsys
-> OUT UNLESS J = 0
!
SEG = 0
GAP = 0
J = DCONNECTI(INDEX . ".#ARCH",FSYS,11,ACRHERE<<4!READACR, SEG, GAP)
J = 0 IF J = 34
-> OUT UNLESS J = 0
!
if SAINDAD = 0 start ; ! a new connection
SINDEX = INDEX
SFSYS = FSYS
SAINDAD = SEG << 18
AF == RECORD(SAINDAD)
T = SUM(SAINDAD)
unless AF_CHKSUM = T start
WRSNT(INDEX, FSYS, 5)
WRSNT(" AF_CHKSUM ", AF_CHKSUM, 5)
WRSN(" COMPUTED ", T)
J = 59
finish
SRES = J; ! save 0 or 59
!
J = LAST FD_PGS << 12
AF_MAXFILE = J UNLESS AF_MAXFILE = J
!
finish
!
AFINDAD = SAINDAD
J = SRES
OUT:
RESULT = J
end ; ! NEWAINDA
!
!-----------------------------------------------------------------------
!
INTEGERFN AFILENAMES(STRING (18)INDEX,
RECORD (AINFF)ARRAYNAME INFS,
INTEGERNAME FILENUM, MAXREC, NFILES,
INTEGER FSYS, ATYPE, GLOBAL)
INTEGER J, AFINDAD, STARTREC, NGIVEN, IP, FP
INTEGER K, I, NFD
RECORD (AFDF)NAME AFL
RECORD (FF)NAME AF
RECORD (AFDF)ARRAYNAME AFDS
RECORD (AINFF)NAME INF
!
IP = FILE INDEX PERM(INDEX, FSYS)
!
J=NEWAINDA(INDEX,FSYS, AFINDAD)
-> RES if J#0
!
STARTREC=FILENUM
AF==RECORD(AFINDAD)
!
! NFILES = INTEGER(ADDR(AF_FILES0) + ATYPE<<2)
J=8 and -> DFILOUT unless STARTREC = 0 OR 0 < STARTREC; ! < NFILES
!
NFD = (AF_MAXFILE - AF_FDSTART) // FDSIZE
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
NFILES = 0
NGIVEN = 0
cycle I = NFD, -1, 1; ! look at youngest first
AFL == AFDS(I)
if LENGTH(AFL_NAME) > 0 ANDC
AFL_NAME # ".NULL" ANDC
AFL_TYPE = ATYPE C
START {good name}
FP = NEWFILEPERM(AFINDAD, AFL, PROCUSER)
IF GLOBAL = YES OR FP > 0 OR (FP = -1 AND IP > 0) C
START {and we have permission}
NFILES = NFILES + 1
if NFILES > STARTREC ANDC
NGIVEN < MAXREC C
start ; ! this record is required
INF == INFS(NGIVEN)
INF = 0
INF_NAME = AFL_NAME
INF_NKB = AFL_PGS<<2
INF_DATE = UNCDT(AFL_DATE)
IF DTRYING & 2 > 0 START
INF_TAPE = I TO TSN(AFL_TSN)
INF_CHAP = AFL_CHAP
FINISH
INF_FLAGS = AFL_COUNT
NGIVEN = NGIVEN + 1
finish
finish
FINISH
repeat
!
MAXREC=NGIVEN
DFILOUT:
K=NEWAINDA("", 0, K); ! DISCONNECT #ARCH
J=K if J=0
RES:
RESULT = J
END ; ! AFILENAMES
!
!-----------------------------------------------------------------------
!
externalintegerfn NEWAFIND2(integer AFINDAD,stringname FILE,
string (11)DATE, integer TYPE)
! TYPE IS EITHER 0(ARCHIVE) OR 1(BACKUP).
! #ARCH ENTRIES MUST DIFFER IN ONE OF NAME, DATE OR TYPE ELSE WE
! HAVE A CONCURRENCY FAULT
! RESULT IS EITHER 0 DATE INVALID OR DOES NOT EXIST
! OR ADDRESS OF FILE DESCRIPTOR
integer NFD, I, IDATE, HITS, FDI
record (AFDF)name AFD
record (FF)name AF
record (AFDF)arrayname AFDS
result = 0 if S11OK(FILE) # 0; ! bad file name
!
IDATE = 0
HITS = 0
AF==RECORD(AFINDAD)
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
NFD = (AF_MAXFILE - AF_FDSTART) // FDSIZE
cycle I = NFD, -1, 1; ! look at youngest first
AFD == AFDS(I)
if EQUAL(AFD_NAME, FILE) = YES c
andc
AFD_TYPE = TYPE c
start
DATE = UNCDT(AFD_DATE) if DATE = ""
IDATE = TOCDT(DATE) if IDATE = 0
if IDATE = AFD_DATE start
HITS = HITS + 1
FDI = I
finish
finish
repeat
!
result = FDI if HITS = 1
monitor if HITS > 1
result = 0
end ; ! NEWAFIND2
!
!-----------------------------------------------------------------------
!
ROUTINE ARCH RECORD(STRING (18)DIRRT,INDEX,TAPE,FILE, C
INTEGER FSYS,NKB,CHAP,TYPE,RESULT)
PRINTSTRING("**ARCH ")
PRINTSTRING(DIRRT); SPACES(9-LENGTH(DIRRT))
PRINTSTRING(INDEX); SPACE
PRINTSTRING(TAPE); SPACES(7-LENGTH(TAPE))
PRINTSTRING(FILE); SPACES(11-LENGTH(FILE))
WRITE(FSYS,2)
WRITE(NKB,4)
WRITE(CHAP,4)
WRITE(TYPE,1)
WRITE(RESULT,2)
NEWLINE
END ; ! ARCH RECORD
!
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN ADESTROY(STRING (31)FULL,
STRING (8)DATE, INTEGER FSYS, TYPE)
!
!
!
integer J,FINDAD,AFINDAD,K,SAVETYPE,NOCHECK, NKB
STRING (31)UNA, INA, FNA, IND
record (FF)name F
record (FF)name AF
record (AFDF)arrayname AFDS
record (PDF)arrayname PDS
record (PDF)name PD
record (AFDF)name AFL
! BITS IN TYPE:
! 2**0,2**1 : ARCH SUBTYPE 0-3. 0=ARCHIVE, 1=BACKUP, 2 AND 3 UNUSED
! 2**2 : NOT USED. THE SUBTYPE FOR DDESTROY ARE TYPE+1
! SINCE 0 MEANS ONLINE
! 2**3 : NO CHECKSUM TO BE DONE AFTER ENTRY MADE. THIS IS
! FOR A BATCH OF ENTRIES FOR ONE USER TO BE DONE AT
! ONCE, ENDING WITH A CHECKSUM EITHER BY THE LAST
! ENTRY HERE, OR BY THE CHECKSUM ONLY ENTRY IN
! 'DMOD ARCH'.
! Called only from DDESTROY, so FULL is complete
!
SAVETYPE=TYPE
NOCHECK=(TYPE>>3)&1
TYPE=TYPE&3
!
J=8
IF TO CDT(DATE)=0 THEN -> OUT; ! EXPLICIT DATE REQUIRED
!
FULL -> IND . (".") . FNA
UNLESS IND -> UNA . (":") . INA START
UNA = IND
INA = ""
FINISH
!
-> AOK IF UNA = PROCUSER
-> AOK IF DTRYING < 0
-> AOK IF FILE INDEX PERM(IND, FSYS) & 2 > 0
J = 93
-> OUT
AOK:
J = FINDA(IND, FSYS, FINDAD, 0)
-> OUT UNLESS J = 0
!
F == RECORD(FINDAD)
!
J=NEWAINDA(IND, FSYS, AFINDAD)
if J#0 then -> OUT
!
AF==RECORD(AFINDAD)
!
J = 32
K = NEWAFIND2(AFINDAD,FNA,DATE,TYPE)
-> OUT1 IF K = 0
!
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
PDS == ARRAY(AFINDAD + AF_PDSTART, PDSF)
AFL==AFDS(K)
!
J=APP(F_ASEMA)
if J#0 then -> OUT1
!
J = AFL_PHEAD
while J > 0 cycle
PD == PDS(J)
J = PD_LINK
PD = 0
repeat
!
NKB = AFL_PGS << 2
IF TYPE = 0 START ; ! archive
AF_FILES0 = AF_FILES0 - 1
F_AFILES = AF_FILES0
AF_CHERKB = AF_CHERKB - NKB
F_ATOTKB = AF_CHERKB
FINISH ELSE START ; ! backup
AF_FILES1 = AF_FILES1 - 1
AF_TEMPKB = AF_TEMPKB - NKB
FINISH
!
AFL = 0
AFL_NAME = ".NULL"
AVV(F_ASEMA)
OUT1:
if NOCHECK=0 start ; ! BATCH. DONT DISCONNECT
K=NEWAINDA("",0,K)
J=K if J=0
finish
OUT:
UNLESS J = 0 C
THEN ARCH RECORD("ADESTROY",IND,"",FNA,FSYS,0,0,SAVETYPE,J)
!
RESULT =J
END ; ! ADESTROY
!
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN ACREATE2(STRING (18)INDEX, TAPE, STRING (8)FDATE,
STRING (11)FILE, INTEGER FSYS, NKB, CHAPTER, TYPE)
!
integer J,AFINDAD,ITODAY, I, K
integer POKE,NOCHECK,SAVETYPE,NFD
integer TSN, FINDAD
STRING (18)UNA, INA, IND
record (AFDF)name AFL
record (AFDF)SAVEAFL
record (FF)name AF, F
record (AFDF)arrayname AFDS
! BITS IN TYPE:
! 2**0,2**1 : ARCH SUBTYPE 0-3. 0=ARCHIVE, 1=BACKUP, 2 AND 3 UNUSED
! 2**2 : NOT USED (SEE COMMENT IN ADESTROY)
! 2**3 : NO CHECKSUM TO BE DONE AFTER ENTRY MADE. THIS IS
! FOR A BATCH OF ENTRIES FOR ONE USER TO BE DONE AT
! ONCE, ENDING WITH A CHECKSUM EITHER BY THE LAST
! ENTRY HERE, OR BY THE CHECKSUM ONLY ENTRY IN
! 'DMOD ARCH'.
! 2**4 : POKE ENTRY. IE AN ENTRY WITH DATE EARLIER THAN ONE
! OR MORE CURRENT ENTRIES WHICH NEED TO BE SHUFFLED
! DOWN TO MAINTAIN DATE ORDER. USED TO MERGE TWO OR
! MORE #ARCHS.
J=IN2(1)
-> RES IF J#0
!
IF INDEX = "" START ; ! Call with USER null is a special entry just to get current index
J=NEWAINDA("", FSYS, AFINDAD); ! disconnected (VOLUMS needs this when doing the archive).
-> RES
FINISH
!
J = 93
-> RES UNLESS DTRYING << 9 < 0
!
J = UIO(INDEX, UNA, INA, IND)
-> RES UNLESS J = 0
!
J = S11OK(FILE)
-> RES UNLESS J = 0
!
SAVETYPE=TYPE
POKE=(TYPE>>4)&1
NOCHECK=(TYPE>>3)&1
TYPE=TYPE&3; ! SUB TYPE
if FDATE="" then FDATE=DATE
ITODAY=TOCDT(FDATE)
!
TSN = TSN TO I(TAPE)
J=8
-> RES UNLESS TSN#0 AND ITODAY#0 AND 0<NKB AND C
0<CHAPTER<=4095 AND 0<=TYPE<=1; ! BAD PARAM
!
J = FINDA(IND, FSYS, FINDAD, 0)
-> OUT UNLESS J = 0
!
F == RECORD(FINDAD)
J=NEWAINDA(IND,FSYS, AFINDAD)
if J#0 then -> OUT
AF==RECORD(AFINDAD)
J=NEWAFIND2(AFINDAD,FILE,FDATE,TYPE)
if J>0 then J=16 and -> OUT; ! ALREADY EXISTS
!
J=APP(F_ASEMA)
if J#0 then -> OUT
!
NFD = (AF_MAXFILE - AF_FDSTART) // FDSIZE
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
cycle I = 1, 1, NFD; ! look for a never-used FD
-> OK if AFDS(I)_NAME = ""
repeat
J = 0; ! no never-used one so look for .null
cycle I = 1, 1, NFD
if AFDS(I)_NAME = ".NULL" START
J = J + 1
FINISH ELSE START
AFDS(I-J) = AFDS(I) if I > J > 0; ! compact entries
FINISH
repeat
if J > 0 start
I = NFD + 1
while J > 0 cycle
I = I - 1
J = J - 1
AFDS(I) = 0
repeat
-> OK
finish
!
J = DCHSIZE(IND, "#ARCH", FSYS, (AF_MAXFILE>>10)+4); ! extend by one page
-> VOUT unless J = 0
FILL(4096, AFINDAD+AF_MAXFILE, 0); ! clear the new page
AF_MAXFILE = AF_MAXFILE + 4096
I = NFD + 1; ! use the first of the frees
OK:
AFL == AFDS(I)
AFL = 0
AFL_NAME = FILE
AFL_TSN = TSN
NKB = (NKB+3) & (-4)
AFL_PGS = NKB >> 2
AFL_CHAP = CHAPTER
AFL_DATE = ITODAY
AFL_TYPE = TYPE
IF TYPE = 0 START ; ! archive
AF_FILES0 = AF_FILES0 + 1
F_AFILES = AF_FILES0
AF_CHERKB = AF_CHERKB + NKB
F_ATOTKB = AF_CHERKB
FINISH ELSE START ; ! backup
AF_FILES1 = AF_FILES1 + 1
AF_TEMPKB = AF_TEMPKB + NKB
FINISH
!
if POKE > 0 and I > 1 start ; ! new entry may be out of date-order
SAVEAFL = AFL; ! save new entry
K = I - 1
while K > 0 cycle
AFL == AFDS(K)
exit if AFL_TYPE = TYPE and AFL_DATE <= ITODAY AND AFL_NAME # ".NULL"
K = K - 1
repeat
!
! new entry to go after entry K, K=0 means put first
while I > K + 1 cycle
AFDS(I) = AFDS(I-1)
I = I - 1
repeat
AFL == AFDS(K + 1)
AFL = SAVEAFL
finish
VOUT:
AVV(F_ASEMA)
OUT:
ARCH RECORD("ACREATE2",IND,TAPE,FILE, C
FSYS,NKB,CHAPTER,SAVETYPE,J) UNLESS J = 0
RES:
RESULT = OUT(J, "SSSSIIII")
END ; ! ACREATE2
!
!-----------------------------------------------------------------------
!
!<DMODARCH
externalintegerfn DMOD ARCH(string (18)FILE INDEX, string (11)FILE,
string (8)DATE, record (AINFF)name ENT,
integer FSYS, TYPE)
!
! This procedure is provided for the System Manager to make amendments to
! archive index entries. FILE INDEX, FILE, DATE and FSYS determine the
! entry to be modified. Record ENT has the same format as that supplied
! by DFILENAMES (TYPE=1). Fields (other than NAME) which differ from
! those of the specified index entry will be used to update the entry.
! Bits in TYPE as for 'ADESTROY'.
!>
!
!
!
integer TSN,NKB
integer J,FINDAD, AFINDAD,W,CHAP,COUNT,K,NOCHECK,SAVETYPE
STRING (18)UNA, INA, IND
record (FF)name F
record (FF)name AF
record (AFDF)arrayname AFDS
record (AFDF)name AFL
J=IN2(42)
-> OUT IF J#0
!
J = 93
-> OUT UNLESS DTRYING << 9 < 0
!
J = UIO(FILE INDEX, UNA, INA, IND)
-> OUT UNLESS J = 0
!
J = S11OK(FILE)
-> OUT UNLESS J = 0 OR FILE = ""
!
SAVETYPE = TYPE
NOCHECK = (TYPE >> 3) & 1
TYPE = TYPE & 3
!
J = FINDA(IND, FSYS, FINDAD, 0)
-> OUT UNLESS J = 0
!
F == RECORD(FINDAD)
!
NKB = ENT_NKB
CHAP = ENT_CHAP
COUNT = ENT_FLAGS
J = NEWAINDA(IND, FSYS, AFINDAD)
!
if FILE = "" start ; ! NKB is byte displacement of word to be
! overwritten by CHAP
-> OUT unless J=0 or J=59
AF == RECORD(AFINDAD)
J = 8
-> OUT unless -2 <= NKB < 0 ORC
(NKB&3=0 and 0 < NKB < AF_MAXFILE)
J = APP(F_ASEMA)
-> OUT unless J = 0
INTEGER(AFINDAD + NKB) = CHAP UNLESS NKB < 0
finish else start
! modify specific entry
-> OUT unless J = 0
J = 8
!
TSN = TSN TO I(ENT_TAPE)
!
-> OUT if TSN = 0
-> OUT unless NKB > 0
-> OUT unless 0 < CHAP < 4096
!
J = 32
K = NEWAFIND2(AFINDAD, FILE, DATE, TYPE)
-> OUT if K = 0
!
AF == RECORD(AFINDAD)
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
AFL == AFDS(K)
!
J = APP(F_ASEMA)
-> OUT unless J = 0
!
AFL_TSN = TSN
AFL_CHAP = CHAP
AFL_COUNT = COUNT
NKB = (NKB + 3) & (-4)
W = NKB - (AFL_PGS << 2); ! adjust by
AFL_PGS = NKB >> 2
IF TYPE = 0 C
THEN AF_CHERKB = AF_CHERKB + W AND F_ATOTKB = AF_CHERKB C
ELSE AF_TEMPKB = AF_TEMPKB + W
finish
AVV(F_ASEMA)
if nocheck = 0 start
k = NEWAINDA("###", 0, J)
j = k if j = 0
finish
OUT:
RESULT = OUT(J, "SSS")
END ; ! DMOD ARCH
!
!-----------------------------------------------------------------------
!
!<DNEWARCHINDEX
externalintegerfn DNEW ARCH INDEX(string (18)FILE INDEX,
integer FSYS, KBYTES)
!
! This privileged procedure creates a new archive index of KBYTES Kbytes
! for file index FILE INDEX on disc FSYS. The minimum size allowed is 4
! Kbytes, allowing about 80 archive files to be described.
!>
! used only by MANAGR when creating or moving (i.e. copying) an archive index.
! If KBYTES is zero, this call is to make main and archive indexes
! consistent (archive index must already exist) e.g. after moveing a main
! index or after a re-prime of #ARCH.
!
!
!
integer J, FINDAD, AFINDAD, K, DA
STRING (18)UNA, INA, IND
record (FF)name F
constinteger TOPK = 4
constbyteintegerarray KB(0:TOPK) = 0, 4, 8, 16, 32
constintegerarray FD(1:TOPK) = 106, 234, 490, 1002
constinteger NPD = 64
J = IN2(46)
-> OUT UNLESS J = 0
!
J = 93
-> OUT UNLESS DTRYING << 9 < 0
!
J = UIO(FILE INDEX, UNA, INA, IND)
-> OUT UNLESS J = 0
!
J = FINDA(IND, FSYS, FINDAD, 0)
-> OUT UNLESS J = 0
!
KBYTES=4 if KBYTES<4
J = 8
cycle K = TOPK, -1, 0; ! validate Kbytes
exit if KBYTES = KB(K)
repeat
-> OUT if K = 0
!
! CREATE NORMAL(1),ZEROFILE(16),CHERISHED(32),SET EEP(64)=W+R+OVERRIDE(11)
! 128 = ARCH INHIB
J=DCREATEF(IND . ".#ARCH",FSYS,KBYTES,1!16!32!64!128 + 11<<24,LEAVE,DA)
-> OUT unless J = 0
!
J=NEWAINDA(IND, FSYS, AFINDAD)
if J#0 and J#59 then -> OUT
!
J = SET FILE INDEX(UNA, "#ARCH", FSYS, KBYTES<<1, c
NPD, FD(K), AFINDAD)
-> OUT unless J = 0
!
F == RECORD(FINDAD)
F_ASEMA=-1
F_AFILES = 0
F_ATOTKB = 0
J = NEWAINDA("###", 0, J)
OUT:
RESULT = OUT(J, "SII")
END ; ! DNEW ARCH INDEX
!
!-----------------------------------------------------------------------
!
!<DRESTORE
externalintegerfn DRESTORE(string (19)FILE INDEX, string (255)FILE,
string (8)ADATE, integer FSYS, TYPE)
!
! This procedure passes a restore request (if FILE exists on archive
! storage and is permitted to the caller) to VOLUMS. ADATE may be left
! null, when the most recently archived copy of FILE will be restored.
! The file is restored into the file owner's index FILE INDEX. TYPE
! is currently ignored and should be set to zero.
!>
!
!
!
integer J,K, FINDAD,AFINDAD,PRM, GLOBAL, IP
STRING (18)UNA, INA, IND
STRING (255)NEWNAME
record (FF)name F
record (FF)name AF
record (AFDF)arrayname AFDS
record (AFDF)name AFL
RECORDFORMAT PF(INTEGER DEST, SRCE, C
(INTEGER P1, P2 OR STRING (7)U), C
INTEGER P3, P4, P5, P6)
RECORD (PF)P
!
IF FILE = "" START
P = 0
P_DEST = X'FFFF0017'
P_U = PROCUSER
J = DPON3I("VOLUMS", P, 0, 1, 5)
RESULT = P_P1; ! 0 alldealt with
! 1 request refused, one already queued
FINISH ; ! get a reply when there are no restore requests
! outstanding for PROCUSER (see Volums 20C release
! note, 12 Dec 80)
!
J=IN2(75)
-> RES IF J#0
J = UIO(FILE INDEX, UNA, INA, IND)
-> RES UNLESS J = 0
!
NEWNAME = "" UNLESS FILE -> FILE . (",") . NEWNAME
UNLESS NEWNAME = "" START
J = S11OK(NEWNAME)
-> RES UNLESS J = 0
FINISH
!
J = S11OK(FILE)
-> RES UNLESS J = 0
!
J=8
UNLESS TYPE=0 THEN ->DRESOUT; ! ONLY ARCHIVE FOR NOW
!
GLOBAL = NO
GLOBAL = YES IF UNA = PROCUSER OR DTRYING << 23 < 0
IP = FILE INDEX PERM(IND, FSYS)
!
J=NEWAINDA(IND, FSYS, AFINDAD)
if J#0 then -> DRESOUT
AF==RECORD(AFINDAD)
!
J=NEWAFIND2(AFINDAD,FILE,ADATE,TYPE)
if J=0 then J=32 and -> DRESOUT1
!
AFDS == ARRAY(AFINDAD + AF_FDSTART, AFDSF)
AFL==AFDS(J)
!
J=32
PRM = NEW FILE PERM(AFINDAD, AFL, PROCUSER)
-> DRESOUT1 UNLESS GLOBAL = YES OR PRM > 0 OR (PRM = -1 AND IP > 0)
!
J=VOLS REQUEST(I TO TSN(AFL_TSN),PROCUSER,PROCFSYS, AFL_CHAP, 0) { DPON version }
! J = VOLUMS REQUEST(IND, NEWNAME, 0, AFL_TSN, AFL_CHAP) { DSPOOL version }
-> DRESOUT1 if J#0
!
J = FINDA(IND, FSYS, FINDAD, 0)
IF J = 0 START
F == RECORD(FINDAD)
J=APP(F_ASEMA)
if J=0 start
AFL_LAST RESTORE = TOCDT(DATE { todays })
AFL_COUNT = AFL_COUNT + 1 if AFL_COUNT < 255
AF_RESTORES = AF_RESTORES + 1
AVV(F_ASEMA)
finish
FINISH
DRESOUT1:
K=NEWAINDA("", 0, K)
J=K if J=0
DRESOUT:
ARCH RECORD("DRESTORE",IND,"",FILE,FSYS,0,0,TYPE,J) UNLESS J = 0
RES:
RESULT = OUT(J, "SSSII")
END ; ! DRESTORE
!
!-----------------------------------------------------------------------
!
!<DRETRIEVE
externalintegerfn DRETRIEVE(string (6)TAPE, integer CHAPTER)
!
! Provides an interface to VOLUMS for users to restore files which they
! have written to tape themselves.
!>
INTEGER J, TSN
CONSTINTEGER TYPE = 3; ! specially for this process
J = IN2(97)
-> OUT UNLESS J = 0
!
J = 8
TSN = TSN TO I(TAPE)
-> OUT IF TSN = 0
!
J = VOLUMS REQUEST(PROCUSER, "", TYPE, TSN, CHAPTER)
OUT:
RESULT = OUT(J, "SI")
END ; ! DRETRIEVE
!
!-------------------end-of-included-text---------------------------------
!