EXTERNALINTEGERFNSPEC DFILENAMES(STRING (6) USER, C
RECORDARRAYNAME INF, INTEGERNAME FN, MAX, NF, C
INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC DFINFO(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC OUTPOS
SYSTEMROUTINESPEC PHEX(INTEGER I)
RECORDFORMAT DFF(INTEGER NKB, RUP, EEP, MODE, USE, ARCH, FSYS, C
CONSEG, CCT, CODES, CODES2, SSBYTE, STRING (6) TRAN)
RECORDFORMAT RF(INTEGER SECTSI, NSECTS, LASTSECT, SPARE, C
INTEGERARRAY DA(0 : 255))
OWNINTEGER MINPAGES, MAXPAGES, BITSTART, LO, HI
!GENERAL PROGRAM TO ACCESS ALL USERS TO OPERATE ON THEM ALL
!THIS COMMAND MUST BE USED IN A PROCESS WITH ACR<=5
!R.MCLEOD 19.6.80
EXTERNALINTEGERFNSPEC DGETDA(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC DBITMAP2(INTEGERNAME LO, HI, INTEGER FSYS)
EXTERNALSTRINGFNSPEC UINFS(INTEGER N)
EXTERNALINTEGERFNSPEC DPERMISSION( C
STRING (6) OWNER, USER, STRING (8) DATE, C
STRING (11) FILE, INTEGER FSYS, TYPE, ADPRM)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, DESTROY)
EXTERNALINTEGERFNSPEC DNEWGEN(STRING (6) USER, C
STRING (11) FILE, NEWGENOFFILE, INTEGER FSYS)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER, C
STRING (11) FILE, STRING (8) DATE, INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
SYSTEMROUTINESPEC MOVE(INTEGER LEN, FROM, TO)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEG, GAP)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
EXTERNALROUTINESPEC GETAVFSYS(INTEGERNAME N, INTEGERARRAYNAME A)
EXTERNALINTEGERFNSPEC GETUSNAMES2(RECORDARRAYNAME UNN, C
INTEGERNAME N, INTEGER FSYS)
RECORDFORMAT USF(STRING (6) NAME, BYTEINTEGER NKB, INTEGER IN)
EXTERNALROUTINE HOWTIDY(STRING (255) S)
STRING (6) SELF
OWNINTEGER ROOM, RB, RA, RBA, FILECOUNT
INTEGER I
STRING (6) USER
INTEGERARRAY FSYS(0 : 63)
INTEGER TOPFSYS, F, FLAG, NUSERS, UP, FP
RECORDARRAY US(0 : 999)(USF)
GETAVFSYS(TOPFSYS,FSYS)
TOPFSYS = TOPFSYS-1; !ARRAY RUNS FROM ZERO
SELF = UINFS(1); !SET UP NAME OF SELF
PRINTSTRING("The following discs are on-line:
")
CYCLE FP = 0,1,TOPFSYS
WRITE(FSYS(FP),4)
REPEAT
NEWLINE
PROMPT("Fsys or -1:")
READ(F)
IF F # -1 START
CYCLE FP = 0,1,TOPFSYS
EXIT IF F = FSYS(FP)
IF FP = TOPFSYS THEN START
PRINTSTRING("Fsys ")
WRITE(F,1)
PRINTSTRING(" is not on-line")
NEWLINES(3)
RETURN
FINISH
REPEAT
FSYS(0) = F; !SET FIRST ELEMENT TO CHOSEN FSYS
TOPFSYS = 0; !AS IF THERE IS ONLY 1
FINISH
PROMPT("Min pages:")
READ(MINPAGES)
PROMPT("Max pages:")
READ(MAXPAGES)
CYCLE FP = 0,1,TOPFSYS
F = FSYS(FP)
NEWLINES(2)
PRINTSTRING("Processing FSYS:")
WRITE(F,2)
NEWLINES(2)
LO = 0
HI = 0
FLAG = DBITMAP2(LO,HI,F)
IF FLAG#0 THEN MONITOR AND STOP
BITSTART = LO&X'FFFF0000'; !ABS START OF BITLIST
FLAG = GETUSNAMES2(US,NUSERS,F); !GET USERNAMES FOR THIS FSYS
NUSERS = NUSERS-1; !ARRAY STARTS FROM ZERO
CYCLE UP = 0,1,NUSERS
USER = US(UP)_NAME
BEGIN
!**** INSERT CODE FOR PARTICULAR APPLICATION HERE ********
RECORDFORMAT INFF(STRING (11) NAME, C
INTEGER SP12, NKB, C
BYTEINTEGER ARCH, CODES, CCT, OWNP, EEP, USE, C
CODES2, SSBYTE, FLAGS, SP29, SP30, SP31)
RECORDARRAY INF(0 : 255)(INFF)
INTEGER FN, MAX, NF, FLAG, I, PAGES
ROUTINE CHECK(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB)
RECORD R(RF)
INTEGER BIT, ABITWORD, BITWORD, FLAG, PAGE, C
PAGES, ROOMBEFORE, ROOMAFTER
PAGES = NKB>>2
FLAG = DGETDA(USER,FILE,FSYS,ADDR(R_SECTSI))
PAGE = R_DA(0)&X'FFFFFF';!OR OFF THE FSYS
ABITWORD = PAGE//32
BIT = PAGE-32*ABITWORD
BITWORD = INTEGER(BITSTART+ABITWORD<<2)
ROOMBEFORE = 0
ROOMAFTER = 0
IF BIT # 0 START
IF (X'80000000'>>(BIT-1))&BITWORD = 0 C
THEN ROOMBEFORE = 1
FINISH
IF BIT+PAGES < 32 START ; !ROOM AT END OF WORD?
IF (X'80000000'>>(BIT+PAGES))&BITWORD = 0 C
THEN ROOMAFTER = 1
FINISH
FILECOUNT = FILECOUNT+1
IF ROOMBEFORE+ROOMAFTER # 0 START
!SOME ROOM
ROOM = ROOM+1
IF ROOMBEFORE = 1 THEN RB = RB+1
IF ROOMAFTER = 1 THEN RA = RA+1
IF ROOMBEFORE+ROOMAFTER = 2 THEN RBA = RBA+1
RETURN ; !TO SUPPRESS OUTPUT
PRINTSTRING(USER.".".FILE)
SPACE UNTIL OUTPOS > 27
WRITE(PAGES,1); !PAGES
SPACES(3)
PHEX(BITWORD)
WRITE(BIT,1)
SPACES(3)
IF ROOMBEFORE = 1 THEN PRINTSTRING( C
"SPACE BEFORE ")
IF ROOMAFTER = 1 THEN PRINTSTRING( C
"SPACE AFTER")
NEWLINE
FINISH
END ; !OF CHECK
MAX = 256; !MAX NO OF FILES ACCEPTED
FLAG = DFILENAMES(USER,INF,FN,MAX,NF,F,0)
IF FLAG = 0 THEN START
IF MAX > 0 START
CYCLE I = 0,1,MAX-1
PAGES = INF(I)_NKB>>2; !SIZE IN PAGES
IF MINPAGES <= PAGES <= MAXPAGES C
THEN CHECK(USER,INF(I)_NAME,F,INF(I) C
_NKB)
REPEAT
FINISH
FINISH
END
REPEAT
PRINTSTRING( C
"FILES ROOM BEFORE ROOM AFTER ROOM BOTH ROOM")
NEWLINES(2)
WRITE(FILECOUNT,1)
WRITE(RB,15)
WRITE(RA,15)
WRITE(RBA,15)
WRITE(ROOM,15)
NEWLINE
FILECOUNT = 0
ROOM = 0
RB = 0
RA = 0
RBA = 0
REPEAT
END ; !OF HOWTIDY
EXTERNALROUTINE TIDYDISC(STRING (255) S)
OWNINTEGER COPYNEEDED, COPIED, COPYNEEDEDCOUNT, FILECOUNT
STRING (6) SELF
STRING (6) USER
INTEGERARRAY FSYS(0 : 63)
INTEGER TOPFSYS, F, FLAG, NUSERS, UP, FP
RECORDARRAY US(0 : 999)(USF)
GETAVFSYS(TOPFSYS,FSYS)
TOPFSYS = TOPFSYS-1; !ARRAY RUNS FROM ZERO
SELF = UINFS(1); !SET UP NAME OF SELF
PRINTSTRING("The following discs are on-line:
")
CYCLE FP = 0,1,TOPFSYS
WRITE(FSYS(FP),4)
REPEAT
NEWLINE
PROMPT("Fsys or -1:")
READ(F)
IF F # -1 START
CYCLE FP = 0,1,TOPFSYS
EXIT IF F = FSYS(FP)
IF FP = TOPFSYS THEN START
PRINTSTRING("Fsys ")
WRITE(F,1)
PRINTSTRING(" is not on-line")
NEWLINES(3)
RETURN
FINISH
REPEAT
FSYS(0) = F; !SET FIRST ELEMENT TO CHOSEN FSYS
TOPFSYS = 0; !AS IF THERE IS ONLY 1
FINISH
PROMPT("Min pages:")
READ(MINPAGES)
PROMPT("Max pages:")
READ(MAXPAGES)
CYCLE FP = 0,1,TOPFSYS
F = FSYS(FP)
NEWLINES(2)
PRINTSTRING("Processing FSYS:")
WRITE(F,2)
NEWLINES(2)
LO = 0
HI = 0
FLAG = DBITMAP2(LO,HI,F)
IF FLAG#0 THEN MONITOR AND STOP
BITSTART = LO&X'FFFF0000'; !ABS START OF BITLIST
FLAG = GETUSNAMES2(US,NUSERS,F); !GET USERNAMES FOR THIS FSYS
NUSERS = NUSERS-1; !ARRAY STARTS FROM ZERO
CYCLE UP = 0,1,NUSERS
USER = US(UP)_NAME
BEGIN
!**** INSERT CODE FOR PARTICULAR APPLICATION HERE ********
RECORDFORMAT INFF(STRING (11) NAME, C
INTEGER SP12, NKB, C
BYTEINTEGER ARCH, CODES, CCT, OWNP, EEP, USE, C
CODES2, SSBYTE, FLAGS, SP29, SP30, SP31)
RECORDARRAY INF(0 : 255)(INFF)
INTEGER FN, MAX, NF, FLAG, I, PAGES
ROUTINE CHECK(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB)
RECORD R(RF)
INTEGER BIT, ABITWORD, BITWORD, FLAG, PAGE, C
PAGES, ROOMBEFORE, ROOMAFTER
COPYNEEDED = 0; !DEFAULT
PAGES = NKB>>2
FLAG = DGETDA(USER,FILE,FSYS,ADDR(R_SECTSI))
PAGE = R_DA(0)&X'FFFFFF';!OR OFF THE FSYS
ABITWORD = PAGE//32
BIT = PAGE-32*ABITWORD
BITWORD = INTEGER(BITSTART+ABITWORD<<2)
ROOMBEFORE = 0
ROOMAFTER = 0
IF BIT # 0 START
IF (X'80000000'>>(BIT-1))&BITWORD = 0 C
THEN ROOMBEFORE = 1
FINISH
IF BIT+PAGES < 32 START ; !ROOM AT END OF WORD?
IF (X'80000000'>>(BIT+PAGES))&BITWORD = 0 C
THEN ROOMAFTER = 1
FINISH
FILECOUNT = FILECOUNT+1
IF ROOMBEFORE+ROOMAFTER > 0 C
THEN COPYNEEDED = 1 AND COPYNEEDEDCOUNT = C
COPYNEEDEDCOUNT+1
END ; !OF CHECK
ROUTINE COPY(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB)
RECORD DF(DFF)
CONSTSTRING (2) TEMPNAME = "##"
INTEGER RGAP, RSEG, WGAP, WSEG, OLDEEP, FLAG, FLAG1
PRINTSTRING(USER.".".FILE)
FLAG = DFINFO(USER,FILE,FSYS,ADDR(DF_NKB))
IF FLAG # 0 THEN PRINTSTRING("DFINFO FAILS
" C
) AND RETURN
IF DF_CODES&X'0C' # 0 THEN PRINTSTRING( C
"TEMPORARY FILE") AND RETURN
RSEG = 0; !LET DIRECTOR CHOOSE
RGAP = 0; !MIN HOLE REQIRED
FLAG = DCONNECT(USER,FILE,FSYS,1,0,RSEG,RGAP)
IF FLAG # 0 START
!NOW TRY AND SET PERMISSION AND TRY AGAIN
OLDEEP = DF_EEP; !PRESERVE OLD EEP
FLAG = DPERMISSION(USER,"","",FILE,FSYS,1,1)
IF FLAG # 0 THEN PRINTSTRING( C
"SET PERMISSION FAILS
") C
AND WRITE(FLAG,1) AND RETURN
FLAG = DCONNECT(USER,FILE,FSYS,1,0,RSEG, C
RGAP)
!TRY AGAIN
!REGARDLESS OF SUCCESS NOW TRY AND RESET PERMISSION
FLAG1 = DPERMISSION(USER,"","",FILE,FSYS,1, C
OLDEEP)
!IGNORE RESULT
IF FLAG1#0 THEN MONITOR ANDSTOP ; !SHOULD NEVER FAIL!!
IF FLAG # 0 THEN START
PRINTSTRING("DCONNECT FAILS") C
AND NEWLINE AND RETURN
FINISH
FINISH
FLAG = DCREATE(USER,TEMPNAME,FSYS,NKB,0)
IF FLAG # 0 THEN START
PRINTSTRING("DCREATE FAILS")
NEWLINE
FLAG = DDISCONNECT(USER,FILE,FSYS,0)
RETURN
FINISH
FLAG = DPERMISSION(USER,SELF,"",TEMPNAME,FSYS,2, C
3)
IF FLAG # 0 THEN PRINTSTRING("PERMIT FAILS
")
WSEG = 0
WGAP = 0
FLAG = DCONNECT(USER,TEMPNAME,FSYS,3,0,WSEG, C
WGAP)
IF FLAG # 0 START
FLAG = DDISCONNECT(USER,FILE,F,0)
FLAG = DDESTROY(USER,TEMPNAME,"",F,0)
PRINTSTRING("DCONNECT WRITE FAILS")
NEWLINE
RETURN
FINISH
MOVE(1024*NKB,RSEG<<18,WSEG<<18)
!COPY CONTENS OF FILE
FLAG = DDISCONNECT(USER,FILE,FSYS,0)
FLAG = DDISCONNECT(USER,TEMPNAME,FSYS,0)
FLAG = DNEWGEN(USER,FILE,TEMPNAME,FSYS)
IF FLAG # 0 START
PRINTSTRING("DNEWGEN FAILS")
NEWLINE
RETURN
FINISH
PRINTSTRING(" - TIDIED
")
COPIED = COPIED+1
END ; !OF COPY
MAX = 256; !MAX NO OF FILES ACCEPTED
FLAG = DFILENAMES(USER,INF,FN,MAX,NF,F,0)
IF FLAG = 0 THEN START
IF MAX > 0 START
CYCLE I = 0,1,MAX-1
PAGES = INF(I)_NKB>>2; !SIZE IN PAGES
IF MINPAGES <= PAGES <= MAXPAGES START
CHECK(USER,INF(I)_NAME,F,INF(I)_NKB)
IF COPYNEEDED = 1 START
COPY(USER,INF(I)_NAME,F,INF(I)_NKB)
FINISH
FINISH
REPEAT
FINISH
FINISH
END
REPEAT
NEWLINES(2)
PRINTSTRING("FILES COPY NEEDED COPIED")
NEWLINE
WRITE(FILECOUNT,1)
WRITE(COPYNEEDEDCOUNT,0)
WRITE(COPIED,10)
FILECOUNT = 0
COPYNEEDEDCOUNT = 0
COPIED = 0
REPEAT
END ; !OF TIDYDISC
ENDOFFILE