! The first parameter of the command SS is the particular function
! to be executed. Each one is described in full below.
!
!<General
! If you reply to the 'Function: ' prompt with 'HELP', you will be
! directed to this file
!>
RECORDFORMAT OF(STRING (11)NAME, INTEGER SP12, NKB, C
BYTEINTEGER ARCH, CODES, CCT, OWNP, C
EEP, USE, CODES2, SSBYTE, FLAGS, POOL, DAYNO, SP31)
RECORDFORMAT AF(STRING (11)NAME, INTEGER NKB, STRING (8)DATE, C
STRING (6)TAPE, INTEGER CHAP, COUNT)
RECORDFORMAT C
DFINF(INTEGER NKB, RUP, EEP, APF, USE, ARCH, FS, SEG, CCT, CDS, C
BYTEINTEGER SP, DAY, POL, CD2, C
INTEGER SS, C
STRING (6)OFF)
!
!
!
DYNAMICINTEGERFNSPEC C
DCHACCESS(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, NEWMODE)
DYNAMICINTEGERFNSPEC C
DCHSIZE(STRING (6)U, STRING (15)F, INTEGER FS,NKB)
DYNAMICINTEGERFNSPEC C
DCONNECT(STRING (6)USER, STRING (15)FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEG, GAP)
DYNAMICINTEGERFNSPEC C
DCREATE(STRING (6)USER, STRING (15)FILE, INTEGER FSYS, NKB, TYPE)
DYNAMICINTEGERFNSPEC C
DDELUSER(STRING (6)USER, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DDESTROY(STRING (6)USER, STRING (11)FILE, STRING (8)DATE, C
INTEGER FSYS, TYPE)
DYNAMICINTEGERFNSPEC C
DDISCONNECT(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, DESTROY)
DYNAMICINTEGERFNSPEC C
DDONATE(STRING (6)USER, INTEGER FSYS, UNITS)
EXTERNALSTRINGFNSPEC C
DERRS(INTEGER N)
DYNAMICINTEGERFNSPEC C
FBASE(INTEGERNAME LO, HI, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DFILENAMES(STRING (6)U, RECORD (OF)ARRAYNAME INFS, C
INTEGERNAME FILENUM, MAXREC, NFILES, INTEGER FSYS, TYPE)
DYNAMICINTEGERFNSPEC C
DFINFO(STRING (6)U, STRING (15)F, INTEGER FS, ADR)
DYNAMICINTEGERFNSPEC C
DFSTATUS(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, ACT, VALUE)
DYNAMICINTEGERFNSPEC C
DFSYS(STRING (6)USER, INTEGERNAME FSYS)
DYNAMICINTEGERFNSPEC C
DGETDA(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, ADR)
DYNAMICINTEGERFNSPEC C
DNEWGEN(STRING (6)USER, STRING (11)FROM, TO, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DNEWUSER(STRING (6)USER, INTEGER FSYS, NKB)
DYNAMICINTEGERFNSPEC C
DOFFER(STRING (6)USER, OFFERTO, STRING (11)FILE, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DPERMISSION(STRING (6)OWNER, USER, STRING (8)DATE, STRING (15)FILE, C
INTEGER FSYS, TYPE, ADR)
DYNAMICINTEGERFNSPEC C
DPRG(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, STRING (6)LABEL,
INTEGER SITE)
DYNAMICINTEGERFNSPEC C
DPROCS(INTEGERNAME MAXPROCS, INTEGER ADR)
DYNAMICINTEGERFNSPEC C
DRENAME(STRING (6)USER, STRING (11)FROM, TO, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DRENAMEINDEX(STRING (6)OLD, NEW, INTEGER FSYS)
DYNAMICINTEGERFNSPEC C
DSFI(STRING (6)USER, INTEGER FSYS, TYPE, SET, ADR)
DYNAMICINTEGERFNSPEC C
DRESTORE(STRING (6)USER, STRING (11)FILE, STRING (8)DATE, INTEGER FSYS, TYPE)
DYNAMICINTEGERFNSPEC C
DSYSAD(INTEGER TYPE, ADR, FSYS)
DYNAMICINTEGERFNSPEC C
DTRANSFER(STRING (6)USER1,USER2, STRING (11)FILE1,FILE2, C
INTEGER FSYS1, FSYS2, TYPE)
DYNAMICINTEGERFNSPEC C
DUNPRG(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, STRING (6)LABEL,
INTEGER SITE)
DYNAMICINTEGERFNSPEC C
DUSERINDEXES(STRING (6)USER, INTEGER FSYS, ADR, INTEGERNAME N)
DYNAMICROUTINESPEC C
GETAVFSYS(INTEGERNAME N, INTEGERARRAYNAME A)
DYNAMICINTEGERFNSPEC C
GETUSNAMES(INTEGERNAME N, INTEGER ADR, FSYS)
DYNAMICROUTINESPEC C
PROMPT(STRING (255)S)
SYSTEMROUTINESPEC C
UCTRANSLATE(INTEGER ADR, LEN)
EXTERNALSTRINGFNSPEC C
UINFS(INTEGER N)
EXTERNALSTRINGFNSPEC C
VDUS(INTEGER N)
SYSTEMROUTINESPEC C
ZVIEW(STRING (255)S)
!
!
CONSTINTEGER FUNCTION = 1
CONSTINTEGER USER = 2
CONSTINTEGER FILE = 3
CONSTINTEGER FSYS = 4
CONSTINTEGER MODE = 5
CONSTINTEGER NKB = 6
CONSTINTEGER APF = 7
CONSTINTEGER SEG = 8
CONSTINTEGER GAP = 9
CONSTINTEGER TYPECR = 10
CONSTINTEGER TYPEDE = 11
CONSTINTEGER DATE = 12
CONSTINTEGER DSTROY = 13
CONSTINTEGER FUNDS = 14
CONSTINTEGER FILENUM = 15
CONSTINTEGER ACTFSTAT = 16
CONSTINTEGER VALUE = 17
CONSTINTEGER FROM U = 18
CONSTINTEGER TO U = 19
CONSTINTEGER FROM F = 20
CONSTINTEGER TO F = 21
CONSTINTEGER FROM FSYS = 22
CONSTINTEGER TO FSYS = 23
CONSTINTEGER OFFER TO = 24
CONSTINTEGER TYPE PRM = 25
CONSTINTEGER TYPE TR = 26
CONSTINTEGER TYPE DSFI = 27
CONSTINTEGER PERMISSION = 28
CONSTINTEGER SETDSFI = 29
CONSTINTEGER OPTNFILE = 30
CONSTINTEGER TYPE REST = 31
CONSTINTEGER LABEL = 32
CONSTINTEGER SITE = 33
CONSTINTEGER OLDNAME = 34
CONSTINTEGER NEWNAME = 35
CONSTINTEGER PRESS RETURN = 36
!
! each entry gives: prompt ! default ! helptext
!
CONSTSTRING (80)ARRAY TABLE(1:36) = C
"Function: !?!*1", {complicated HELP info}
"User: !*1!6 character user name",
"File: !!up to 11 charac name",
"Fsys: !-1!0 <= Fsys < 100",
"Mode: !1!*2",
"NKB: !4!Number of Kbytes",
"APF: !0!X'EWR'",
"Seg: !0!seg < 256",
"Gap: !0!no of segs to reserve",
"Type: !0!1=temp 2=Vtemp 4=0@create 8=cherish", {for create}
"Type: !0!0=on-line 1=archive 2=backup", {for dfilenames and destroy}
"Date: !nodate!reqd only if file not on-line",
"Destroy: !0!1 for DESTROY after disconnecting",
"Units: !10000!hundredths of pence, default 1 pound",
"Filenum: !0!from where to start (off-line files)",
"Act: !!*3", {for dfstatus}
"Value: !0!Depends on Act",
"From User: !*1!",
"To User: !*1!",
"From File: !!",
"To File: !!",
"From Fsys: !-1!",
"To Fsys: !!",
"Offer to: !!",
"Type: !!*4", {for dpermission}
"Type: !!0=Accept,1=Transfer,2=Transfer & resite,3=Copy",
"Type: !!*5", {for DSFI}
"Permission: !5!1=read,2=write,4=execute",
"Set: !0!0=Get, 1=Set",
"Option file: !SS#OPT!",
"Type: !0!0=archive", {for drestore}
"Label: !!6 character disc label",
"Site: !1!disc site eg X2C0",
"Oldname: !!",
"Newname: !!",
"Press return: !-999!just press it! "
!
!
!
CONSTINTEGER TOPFN = 33
CONSTSTRING (31)ARRAY E(1:TOPFN) = C
"CHACCESS",
"CHSIZE",
"CONNECT",
"CREATE",
"DELUSER",
"DESTROY",
"DISCONNECT",
"DISCS",
"DONATE",
"FBASE",
"FILENAMES",
"FINFO",
"FSTATUS",
"FSYS",
"GETDA",
"NEWGEN",
"NEWUSER",
"OFFER",
"OPTIONS",
"PERMISSION",
"PERMS",
"PRG",
"PROCS",
"RENAME",
"RENAMEINDEX",
"RESTORE",
"SETPASSWORD",
"SFI",
"SUBMIT",
"TRANSFER",
"UNPRG",
"USERS",
"WHO"
!
!
!
CONSTINTEGER TOPDSFI = 44
!
CONSTINTEGERARRAY NI(0:TOPDSFI) = C
0, 0, 0, 0,-8,-2,-1, 1, 1,-9,
1, 1, 1,-2, 3, 1, 1, 1, 0, 0,
2, 1,-1, 2, 1, 1, 1, 2, 1, 1,
-6, 2, 1, 1, 1, 0, 0, 0, 1, 0,
2, 1,16, 1, 0
!
CONSTBYTEINTEGERARRAY T(0:TOPDSFI) = C
0, 1, 2, 3, 4,16,18,19,20,21,
33,34,35,36,38,41,42,43,44,45,
46,48,49,50,52,53,54,55,57,58,
59,65,67,68,69,70,71,72,73,74,
75,77,78,94,95
!
CONSTSTRING (15)ARRAY TXT(0:95) = C
"Basefile",
"Delivery",
"Control file",
"Data",
"No of files",
"FDs in use",
"Free FDs",
"Index size",
"No SDs",
"Free SDs",
"No PDs",
"Free PDs",
"","","","",
"","",
"Last log-on",
"ACR",
"Dirvsn",
"No of A files",
"A Kbytes",
"No of B files",
"B Kbytes",
"#ARCH Kb",
"No FDs",
"Free FDs",
"No PDs",
"Free PDs",
"","","",
"Stacksize",
"MaxKb",
"Max file size",
"Cur I procs",
"Cur B procs",
"Imax",
"Bmax",
"Tmax",
"Privacy",
"Dirmon",
"Sigmon",
"I.Surname",
"Logfile",
"Kinstrs(int)",
"Kinstrs(batch)",
"Kinstrs(cur)",
"Kinstrs(Dir)",
"Ptrns(int)",
"Ptrns(batch)",
"Ptrns(cur)",
"Kbytes(output)",
"Kbytes(input)",
"Msecs(int)",
"Msecs(batch)",
"Msecs(cur)",
"Connect time",
"No of files",
"Disc Kbytes",
"Cherfiles",
"CherKbytes",
"Tempfiles",
"TempKbytes",
"Archfiles",
"ArchKbytes",
"Session length",
"Funds",
"Gp Hldrs fsys",
"Test SS",
"Batch SS",
"Group Holder",
"Privileges",
"Default LP",
"Fdate",
"Bdate",
"Junk",
"Iinstrs",
"Binstrs",
"Iptrns",
"Bptrns",
"Nkbout",
"Nkbin",
"Imsecs",
"Bmsecs",
"Connectt",
"Afiles",
"Atotkb",
"Files",
"Totkb",
"Cherfiles",
"Cherkb",
"Dapsecs",
"Mailcount",
"Supervisor"
!
!
!
EXTERNALROUTINE SS(STRING (255)P)
STRING (255)FN
SWITCH F(1:TOPFN)
INTEGER RSEG, RGAP
INTEGER LO, HI
INTEGER TYPEV, FILENUMV, MAXREC, NFILES, J, X
INTEGER FSYSV
STRING (11)S11, USERV
BYTEINTEGERARRAY B(0:8039); ! used in DFILENAMES
INTEGER ADR, ADDRDSFI, NOP
INTEGERARRAY IP(1:10)
STRING (15)ARRAY SP(1:10)
INTEGERARRAY DSFII(0:31)
INTEGERARRAYNAME I
INTEGERARRAYFORMAT IFT(0:31)
STRINGNAME S0
INTEGERARRAY AA(-4:255)
RECORDFORMAT PRMSF(STRING (6)USER, BYTEINTEGER PRM)
RECORDFORMAT PRMF(INTEGER B, OWNP, EEP, S, C
RECORD (PRMSF)ARRAY PRMS(0:15))
RECORD (PRMF) PRM
RECORD (OF)ARRAYNAME OS
RECORD (AF)ARRAYNAME AS
RECORD (OF)ARRAYFORMAT OSF(0:200)
RECORD (AF)ARRAYFORMAT ASF(0:200)
RECORD (OF)NAME O
RECORD (AF)NAME A
RECORD (DFINF) DFIN
INTEGER RESULT
!
!
!
!
!
!
!
STRINGFN HTOS(INTEGER VALUE, PLACES)
INTEGER I
STRING (8)S
CONSTBYTEINTEGERARRAY H(0:15) = C
'0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
PLACES = 8 IF PLACES > 8
I = 64 - 4 * PLACES
*LD_S
*LSS_PLACES
*ST_(DR )
*INCA_1
*STD_TOS
*STD_TOS
*LSS_VALUE
*LUH_0
*USH_I
*MPSR_X'24'
*SUPK_L =8
*LD_TOS
*ANDS_L =8,0,15
*LSS_H+4
*LUH_X'18000010'
*LD_TOS
*TTR_L =8
RESULT = S
END
!
!-----------------------------------------------------------------------
!
STRINGFN ITOS(INTEGER N)
STRING (16)S
INTEGER D0, D1, D2, D3
*LSS_N
*CDEC_0
*LD_S
*INCA_1
*CPB_B
*SUPK_L =15,0,32
*STD_D2
*JCC_8,<WASZERO>
*LSD_TOS
*ST_D0
*LD_S
*INCA_1
*MVL_L =15,15,48
BYTEINTEGER(D1) = '-' AND D1 = D1 - 1 IF N < 0
BYTEINTEGER(D1) = D3 - D1 - 1
RESULT = STRING(D1)
WASZERO:
RESULT = "0"
END
!
!-----------------------------------------------------------------------
!
INTEGERFN STOI2(STRING (255) S, INTEGERNAME I2)
STRING (63) P
INTEGER TOTAL, SIGN, AD, I, J, HEX
!MON MON(1) = MON(1) + 1
HEX = 0; TOTAL = 0; SIGN = 1
AD = ADDR(P)
A: IF S -> (" ").S THEN -> A; !CHOP LEADING SPACES
IF S -> ("-").S THEN SIGN = -1
IF S -> ("X").S THEN HEX = 1 AND -> A
P = S
UNLESS S -> P.(" ").S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 C
AND 'A' <= J <= 'F')
IF HEX = 0 THEN TOTAL = 10*TOTAL C
ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15; I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN I2 = SIGN*TOTAL AND RESULT = 0
FAULT:
I2 = 0
RESULT = 1
END ; ! STOI2
!
!-----------------------------------------------------------------------
!
!
!
ROUTINE WRS(STRING (255)S)
PRINTSTRING(S)
NEWLINE
END
!
ROUTINE WRSN(STRING (255)S, INTEGER N)
PRINTSTRING(S)
PRINTSTRING(" =")
WRITE(N, 1)
NEWLINE
END
!
ROUTINE WRSNT(STRING (255)S, INTEGER N, TYPE)
INTEGER J
SWITCH SW(0:3)
!
! type & 3 = 0 decimal if small else hex
! 1 decimal
! 2 hex
! 3 decimal and hex
! type & 4 = 1 dont put NL at end
! type & X70 gives number of digits, 0=8
PRINTSTRING(S)
SPACE
-> SW(TYPE & 3)
SW(0): -> SW(2) IF IMOD(N) > 255
SW(3):
SW(1): PRINTSTRING(ITOS(N))
-> OUT IF TYPE & 2 = 0
SPACE
SW(2): PRINTSTRING("X'")
J = TYPE >> 4 & 7
J = 8 IF J = 0
PRINTSTRING(HTOS(N, J))
OUT:
NEWLINE IF TYPE & 4 = 0
END ; ! OF WRSNT
!
!-----------------------------------------------------------------------
!
!
!
ROUTINE RSTRG(STRINGNAME S)
INTEGER I
S = ""
CYCLE
READSYMBOL(I)
RETURN IF I = NL
S = S . TOSTRING(I)
REPEAT
END
!
!
!
ROUTINE RDINT(INTEGERNAME N)
STRING (63)S
N = -1
CYCLE
RSTRG(S)
RETURN IF STOI2(S, N) = 0
REPEAT
END
!
!
!
! PROCEDURES FOR DOING PROMPTS
!
!
STRINGFN PROMPTS(STRING (255)S)
STRING (255)T
IF LENGTH(P) > 0 START
T = P AND P = "" UNLESS P -> T . (",") . P
FINISH ELSE PROMPT(S) AND RSTRG(T)
RESULT = T
END
!
!
INTEGERFN PROMPTI(STRING (255)S)
INTEGER T
STRING (255)S0
IF LENGTH(P) > 0 START
S0 = P AND P = "" UNLESS P -> S0 . (",") . P
RESULT = -1 UNLESS STOI2(S0, T) = 0
RESULT = T
FINISH
PROMPT(S)
RDINT(T)
RESULT = T
END
!
!
STRINGFN GIVE DEFAULT(STRING (255)S)
INTEGER J, N
STRING (15)W
CONSTINTEGER TOPSW = 1
SWITCH SW(1 : TOPSW)
RESULT = S UNLESS LENGTH(S) > 1 AND CHARNO(S, 1) = '*'
S -> ("*") . W
J = STOI2(W, N)
RESULT = "" UNLESS J = 0 AND 0 < N <= TOPSW
-> SW(N)
SW(1): RESULT = UINFS(1); ! procuser
END
!
!
!
ROUTINE GIVEHELP(STRING (255)S, D)
INTEGER J, N
STRING (63)W
CONSTINTEGER TOPSW = 5
SWITCH SW(1:TOPSW)
IF S = "" OR CHARNO(S, 1) # '*' START
PRINTSTRING(S)
IF D = "-999" C
THEN NEWLINE C
ELSEIF D = "" C
THEN WRS(" there is no default") C
ELSE WRS(" default is " . GIVEDEFAULT(D))
RETURN
FINISH
!
S -> ("*") . W
J = STOI2(W, N)
RETURN UNLESS J = 0 AND 0 < N <= TOPSW
-> SW(N)
SW(1):
ZVIEW("MANAGR.SSPD,1")
RETURN
SW(2):
WRS("The bits in MODE may be set as follows")
WRS(" 1=read 2=write 4=execute 8=write shared")
WRS(" 16=newcopy 64=not drum 128=process stack")
WRS("256=Disconnect, change access, change size NOT allowed")
WRS("512=advisory sequential")
WRS("2**31=non-slaved")
RETURN
SW(3): ! DFSTATUS
WRS("Values for Act are")
RETURN
SW(4): ! DPERMISSION
WRS("Type: 0=set OWNP 1=set EEP")
WRS(" 2=user into FILE list 3=remove 4=return list 5=destroy")
WRS(" 6=user into INDX list 7 8 9")
WRS("10=give user's access to file")
RETURN
SW(5): ! DSFI
WRS(" 0=Basefile 1=Delivery 2=Control file 3=Data")
WRS(" 4=index use 5=passwords 6=last log on 7=ACR")
WRS(" 8=Dirvsn 9=#arch use 10=stack size 11=MaxKb")
WRS("12=Maxfile 13=Iprocs etc 14=Imax etc 15=Privacy")
WRS("16=Dirmon 17=Sigmon 18=I.Surname 19=Logfile")
WRS("20=KinstrsT 21=KinstrsC 22=KinstrsD 23=PtrnsT")
WRS("24=Ptrns(cur) 25=Kbytes o/p 26=Kbytes i/p 27=Msecs(tot)")
WRS("28=Msecs(cur) 29=Connecttime 30=files 31=Afiles")
WRS("32=Sess len 33=Funds 34=GpFsys 35=TestSS")
WRS("36=BatchSS 37=GpHolder 38=Privileges 39=DefaultLP")
WRS("40=Dates passwords changed 41=Password data42=Accounts")
WRS("43=Mailcount 44=Supervisor")
END
!
!
!
INTEGERFN IPROMPT(INTEGER N)
INTEGER J, RES
STRING (80)T, PTXT, DTXT, HTXT
TABLE(N) -> PTXT . ("!") . DTXT . ("!") . HTXT
!
T = P AND P = "" UNLESS P -> T . (",") . P
!
CYCLE
PROMPT(PTXT) AND RSTRG(T) IF T = ""
IF T = "?" OR T = "HELP" START
GIVEHELP(HTXT, DTXT)
FINISH ELSE START
T = GIVE DEFAULT(DTXT) IF T = ""
J = STOI2(T, RES)
!
IF J = 0 START
NOP = NOP + 1
SP(NOP) <- T
IP(NOP) = RES
RESULT = RES
FINISH
!
WRS("that wasn't a number")
FINISH
T = ""
REPEAT
END
!
!
STRINGFN SPROMPT(INTEGER N)
STRING (80)T, PTXT, DTXT, HTXT
TABLE(N) -> PTXT . ("!") . DTXT . ("!") . HTXT
!
T = P AND P = "" UNLESS P -> T . (",") . P
!
CYCLE
PROMPT(PTXT) AND RSTRG(T) IF T = ""
IF T = "?" OR T = "HELP" START
GIVEHELP(HTXT, DTXT)
T = ""
FINISH ELSE START
T = GIVE DEFAULT(DTXT) IF T = ""
UNLESS T = "" START
NOP = NOP + 1
! UCTRANSLATE(ADDR(T)+1, LENGTH(T))
SP(NOP) <- T
RESULT = T
FINISH
FINISH
REPEAT
END
!
!
INTEGERFN IDCONNECT(STRING (6)USER, STRING (11)FILE,
INTEGER FSYS, MODE, APF, SEG, GAP,
INTEGERNAME RSEG, RGAP)
RSEG = SEG
RGAP = GAP
RESULT = DCONNECT(USER, FILE, FSYS, MODE, APF, RSEG, RGAP)
END
!
!
!
INTEGERFN IDFSYS(STRING (6)USER)
INTEGER FOUND, N, I, J
INTEGERARRAY F(0:99)
FOUND = 37
GET AV FSYS(N, F)
CYCLE I = 0, 1, N-1
J = DFSYS(USER, F(I))
RESULT = J IF 0 # J # 37
WRSN("Fsys", F(I)) AND FOUND = 0 IF J = 0
REPEAT
RESULT = FOUND
END
!
!
!
ROUTINE IDISCS
INTEGER FSYS, J, LO, HI, N, W, A, LOW
INTEGER AU, NU, AF, U, K
INTEGERARRAY BITS(0:5119)
CONSTINTEGER TOPC = 5
INTEGERARRAY DS(1:TOPC)
STRING (6)ARRAY US(1:TOPC)
INTEGERARRAY FLD(0:15)
STRINGNAME U1
INTEGERNAME I1
BYTEINTEGERARRAY UNAMES(0:9555)
!
CYCLE FSYS = 0, 1, 99
J = FBASE(LO, HI, FSYS)
IF J = 0 START
WRITE(FSYS, 2)
!
IF LO > X'40' C
THEN PRINTSTRING("*") C
ELSE SPACE
!
PRINTSTRING(" 80 Mb") IF HI = X'3F1F'
PRINTSTRING("100 Mb") IF HI = X'59F3'
PRINTSTRING("160 Mb") IF HI = X'8F6F'
PRINTSTRING("200 Mb") IF HI = X'B3E7'
PRINTSTRING("640 Mb") IF HI > X'B3E7'
!
A = ADDR(BITS(0))
AU = ADDR(UNAMES(0))
J = GETUSNAMES(NU, AU, FSYS)
IF J = 0 C
THEN WRITE(NU, 3) C
ELSE PRINTSTRING(" ??")
PRINTSTRING(" users")
!
J = DSYSAD(0, A, FSYS)
IF J = 0 START
LOW = (LO + X'100') >> 5
HI = HI >> 5
N = 0
CYCLE J = LOW, 1, HI
W = BITS(J)
WHILE W # 0 CYCLE
N = N + 100
*LSS_W
*ST_TOS
*USB_1
*AND_TOS
*ST_W
REPEAT
REPEAT
WRITE(N//(HI-LOW+1)<<5, 2)
PRINTSTRING("%")
FINISH
!
IF P = "" START
AF = ADDR(FLD(0))
I1 == FLD(1)
!
CYCLE J = 1, 1, TOPC
DS(J) = 0
US(J) = ""
REPEAT
!
CYCLE U = 0, 7, (NU-1)*7
U1 == STRING(AU+U)
K = DSFI(U1, FSYS, 30, 0, AF)
IF K = 0 START
W = I1 // 1000
CYCLE J = 1, 1, TOPC
IF W > DS(J) START
K = TOPC
WHILE K > J CYCLE
DS(K) = DS(K-1)
US(K) = US(K-1)
K = K - 1
REPEAT
DS(J) = W
US(J) = U1
EXIT
FINISH
REPEAT
FINISH
REPEAT ; ! through users
!
CYCLE J = 1, 1, TOPC
EXIT IF DS(J) = 0
SPACE
PRINTSTRING(US(J))
WRITE(DS(J), 2)
REPEAT
FINISH
NEWLINE
FINISH
REPEAT
END
!
!-----------------------------------------------------------------------
!
INTEGERFN IOPTIONS(STRING (6)USER, STRING (11)FILE)
CONSTINTEGER KSHIFT = 10
CONSTINTEGER MAXKEY = 14
CONSTINTEGER MAXSEARCHDIRCOUNT = 16
CONSTSTRING (12) ARRAY KEY(1 : MAXKEY) = C
"BRACKETS","NOBRACKETS","NORECALL","TEMPRECALL","PERMRECALL",
"NOFSTARTFILE","?","NOBLANKLINES","BLANKLINES","NOBSTARTFILE",
"INITPARMS","NOECHO","PARTECHO","FULLECHO"
!
!
!
ROUTINE OUTI(STRING (255) S, INTEGER N)
PRINTSTRING(S." :")
WRITE(N,1)
NEWLINE
END
!
!
!
ROUTINE OUTS(STRING (255) S, T)
PRINTSTRING(S." : ".T)
NEWLINE
END
!
!
!
CONSTSTRING (9)ARRAY PARMS(0:63) = C
"","I8","L8","R8",""(4),"MAXDICT",""(5),"MINSTACK",""(17),
"QUOTES", "NOLIST", "NODIAG", "STACK",
"NOCHECK", "NOARRAY", "NOTRACE", "PROFILE",
"IMPS", "INHIBIOF", "ZERO", "XREF",
"LABELS", "LET", "CODE", "ATTR",
"OPT", "MAP", "DEBUG", "FREE",
"DYNAMIC","","EBCDIC","NOLINE",
""(2),"PARMZ","PARMY",
"PARMX","MISMATCH",""(2)
ROUTINE PRINTPARMS(LONGINTEGER P)
INTEGER I, FOUND
FOUND = 0
FOR I=0,1,63 CYCLE
IF P&1 = 1 START
IF PARMS(I) # "" START ; !IGNORE BLANK PARMS
IF FOUND = 0 THEN FOUND = 1 ELSE PRINTSYMBOL(',')
PRINTSTRING(PARMS(I))
FINISH
FINISH
P = P>>1
REPEAT
IF FOUND = 0 THEN PRINTSTRING("DEFAULTS")
END ; ! OF PRINTPARMS
!
!
!
RECORD FORMAT C
CONTF (INTEGER DATAEND,DATASTART,PSIZE,FILETYPE, C
SUM,DATETIME,SPARE1,SPARE2,MARK, NULL1, UGLA, ASTK, USTK, C
NULL2, ITWIDTH, LDELIM, RDELIM, JOURNAL, SEARCHDIRCOUNT, C
ARRAYDIAG,INITWORKSIZE,SPARE,ITINSIZE,ITOUTSIZE, C
NOBL, ISTK, LONGINTEGER INITPARMS, INTEGER DATAECHO, C
TERMINAL, I23, I24, I25, I26, I27, I28, I29, I30, I31, I32, C
STRING (31) FSTARTFILE, BSTARTFILE, PRELOADFILE, MODDIR, C
CFAULTS, S6, S7, S8, S9, S10, S11, S12, S13, S14, S15, C
S16, S17, S18, S19, S20, S21, S22, S23, S24, S25, S26, S27, C
S28, S29, S30, S31, S32, C
STRING (31) ARRAY SEARCHDIR(1:16));!1/2/79
!
!
!
INTEGER J, FSYS, SEG, GAP
INTEGER DPFLAG, DCFLAG
STRING (6)SELF
RECORD (CONTF)NAME C
INTEGER I
SELF = UINFS(1)
FSYS = -1
J = DFSYS(USER, FSYS)
RESULT = J UNLESS J = 0
!
DPFLAG = DPERMISSION(USER, SELF, "", "", FSYS, 7, 0)
OUTI("Remove prm flag", DPFLAG) UNLESS DPFLAG = 0 OR DPFLAG = 50
J = DPERMISSION(USER, SELF, "", "", FSYS, 6, 1)
OUTI("Give prm flag", J) AND RESULT = J UNLESS J = 0
!
SEG = 0
GAP = 0
DCFLAG = DCONNECT(USER, FILE, FSYS, 1, 0, SEG, GAP)
OUTI("Connect flag", DCFLAG) AND -> OUT IF 34 # DCFLAG # 0
!
C == RECORD(SEG << 18)
OUTS("Analysis of", USER.".".FILE)
!
IF 0 <= C_JOURNAL <= 2 C
THEN WRS(KEY(3+C_JOURNAL)) C
ELSE OUTI("C_JOURNAL", C_JOURNAL); ! NORECALL ETC
!
IF C_LDELIM = ' ' THEN PRINTSTRING("NO")
WRS("BRACKETS")
!
IF C_NOBL = 1 THEN PRINTSTRING("NO")
WRS("BLANKLINES")
!
OUTI("ITWIDTH",C_ITWIDTH)
OUTI("ARRAYDIAG",C_ARRAYDIAG)
OUTI("ITINSIZE",C_ITINSIZE>>KSHIFT)
OUTI("ITOUTSIZE",C_ITOUTSIZE>>KSHIFT)
OUTI("USERSTACKSIZE",C_USTK>>KSHIFT)
IF C_ISTK >= 0 THEN OUTI("INITSTACKSIZE",C_ISTK>>KSHIFT)
OUTI("AUXSTACKSIZE",C_ASTK>>KSHIFT)
IF C_INITWORKSIZE#0 C
THEN OUTI("INITWORKSIZE",C_INITWORKSIZE>>KSHIFT)
IF LENGTH(C_MODDIR) < 32 C
THEN OUTS("ACTIVEDIR",C_MODDIR) C
ELSE OUTI("Length(MODDIR)", LENGTH(C_MODDIR))
!
IF LENGTH(C_FSTARTFILE) < 32 START
IF C_FSTARTFILE#"" C
THEN OUTS("FSTARTFILE",C_FSTARTFILE) C
ELSE WRS("NOFSTARTFILE")
FINISH ELSE OUTI("Length(FSTARTFILE)", LENGTH(C_FSTARTFILE))
!
IF LENGTH(C_BSTARTFILE) < 32 START
IF C_BSTARTFILE#"" C
THEN OUTS("BSTARTFILE",C_BSTARTFILE) C
ELSE WRS("NOBSTARTFILE")
FINISH ELSE OUTI("Length(BSTARTFILE)", LENGTH(C_BSTARTFILE))
!
PRINTSTRING("INITPARMS : "); PRINTPARMS(C_INITPARMS)
NEWLINE
!
IF LENGTH(C_CFAULTS) < 32 START
IF C_CFAULTS # "" THEN OUTS("CFAULTS",C_CFAULTS)
FINISH ELSE OUTI("Length(CFAULTS)", LENGTH(C_CFAULTS))
!
IF 0 <= C_DATAECHO <= 2 C
THEN WRS(KEY(12+C_DATAECHO)) C
ELSE OUTI("Dataecho",C_DATAECHO)
!
IF C_SEARCHDIRCOUNT <= MAXSEARCHDIRCOUNT START
IF C_SEARCHDIRCOUNT > 0 START
NEWLINE
FOR I=1,1,C_SEARCHDIRCOUNT CYCLE
OUTS("SEARCHDIR ".ITOS(I),C_SEARCHDIR(I))
REPEAT
FINISH
FINISH ELSE OUTI("Searchdircount",C_SEARCHDIRCOUNT)
OUT:
J = DDISCONNECT(USER, FILE, FSYS, 0) IF DCFLAG = 0
J = DPERMISSION(USER, SELF, "", "", FSYS, 7, 0) IF DPFLAG=50
RESULT = DCFLAG IF 0 # DCFLAG # 34
RESULT = 0
END
!
!-----------------------------------------------------------------------
!
INTEGERFN OPERMS(STRING (6)USER)
INTEGER J, A, N, JUNK, NFILES, I
STRING (127)LINE
RECORDFORMAT F1(STRING (6)USER, BYTEINTEGER PRM)
RECORDFORMAT F2(INTEGER N, OWNP, EEP, X, RECORD (F1)ARRAY IP(0:15))
RECORDFORMAT F3(STRING (11)NAME, INTEGER X1, KB, C
BYTEINTEGER X2, X3, X4, OWNP, EEP, X5, X6, X7, X8, X9, XA, XB)
!
RECORD (F2)P
RECORD (F1)NAME IP
RECORD (F3)ARRAY INF(0:1023)
RECORD (F3)NAME FL
!
!
!
STRINGFN Z(INTEGER P)
STRING (7)W
W = ""
W = "N" IF P = 0
W = W . "P" IF P & 8 > 0
W = W . "E" IF P & 4 > 0
W = W . "W" IF P & 2 > 0
W = W . "R" IF P & 1 > 0
W = "?" . W IF P >> 4 > 0
RESULT = W
END
!
!
!
WRS("On-line files:")
A = ADDR(P)
J = DPERMISSION(USER, "", "", "", -1, 8, A)
-> OUT UNLESS J = 0
!
N = P_N-24
UNLESS N < 0 START
N = N // 8
LINE = "Index list: "
CYCLE J = N, -1, 0
IP == P_IP(J)
LINE = LINE . "..." . IP_USER . ":" . Z(IP_PRM)
WRS(LINE) AND LINE = "" IF LENGTH(LINE) > 56
REPEAT
WRS(LINE) UNLESS LINE = ""
FINISH
!
JUNK = 0
N = 1024
J = DFILENAMES(USER, INF, JUNK, N, NFILES, -1, 0)
-> OUT UNLESS J = 0
!
CYCLE I = 0, 1, N-1
FL == INF(I)
J = DPERMISSION(USER, "", "", FL_NAME, -1, 4, A)
IF J = 0 AND FL_NAME#"#MSG" START
UNLESS C
FL_OWNP = 7 C
ANDC
FL_EEP = 0 C
ANDC
P_N = 16 C
START
LINE = FL_NAME . " "
LENGTH(LINE) = 12
LINE = LINE . "OWNP:" . Z(FL_OWNP) UNLESS FL_OWNP = 7
LINE = LINE . "EEP:" . Z(FL_EEP) UNLESS FL_EEP = 0
!
IF P_N > 16 START
CYCLE J = (P_N-24)//8, -1, 0
IP == P_IP(J)
LINE = LINE . "....".IP_USER . ":" . Z(IP_PRM)
WRS(LINE) AND LINE = "" IF LENGTH(LINE) > 56
REPEAT
FINISH
WRS(LINE) UNLESS LINE = ""
FINISH
FINISH
REPEAT
!
J = 0
OUT:
RESULT = J
END
!
!-----------------------------------------------------------------------
!
INTEGERFN APERMS(STRING (6)USER)
INTEGER J, A, N, JUNK, NFILES, I, TYPE
STRING (127)LINE
RECORDFORMAT F1(STRING (6)USER, BYTEINTEGER PRM)
RECORDFORMAT F2(INTEGER N, OWNP, EEP, X, RECORD (F1)ARRAY IP(0:15))
RECORDFORMAT F3(STRING (11)NAME, INTEGER KB, C
STRING (8)DATE, STRING (6)TAPE, INTEGER CHAPTER, FLAGS)
!
RECORD (F2)P
RECORD (F1)NAME IP
RECORD (F3)ARRAY INF(0:1023)
RECORD (F3)NAME FL
!
!
STRINGFN Z(INTEGER P)
STRING (7)W
W = ""
W = "N" IF P = 0
W = W . "P" IF P & 8 > 0
W = W . "E" IF P & 4 > 0
W = W . "W" IF P & 2 > 0
W = W . "R" IF P & 1 > 0
W = "?" . W IF P >> 4 > 0
RESULT = W
END
!
!
!
WRS("Off-line files:")
A = ADDR(P)
J = DPERMISSION(USER, "", "", "", -1, 24, A)
-> OUT UNLESS J = 0
!
N = P_N-24
UNLESS N < 0 START
N = N // 8
LINE = "Index list: "
CYCLE J = N, -1, 0
IP == P_IP(J)
LINE = LINE . "..." . IP_USER . ":" . Z(IP_PRM)
WRS(LINE) AND LINE = "" IF LENGTH(LINE) > 56
REPEAT
WRS(LINE) UNLESS LINE = ""
FINISH
!
CYCLE TYPE = 1, 1, 2
JUNK = 0
N = 1024
J = DFILENAMES(USER, INF, JUNK, N, NFILES, -1, TYPE)
-> OUT UNLESS J = 0
!
CYCLE I = 0, 1, N-1
FL == INF(I)
J = DPERMISSION(USER, "", FL_DATE, FL_NAME, -1, 20, A)
IF J = 0 AND P_N > 16 START
LINE = FL_NAME . " "
LENGTH(LINE) = 12
LINE = LINE . FL_DATE
!
CYCLE J = (P_N-24)//8, -1, 0
IP == P_IP(J)
LINE = LINE . " ....".IP_USER . ":" . Z(IP_PRM)
WRS(LINE) AND LINE = "" IF LENGTH(LINE) > 56
REPEAT
WRS(LINE) UNLESS LINE = ""
FINISH
REPEAT
REPEAT
!
J = 0
OUT:
RESULT = J
END
!
!
!
INTEGERFN IPERMS(STRING (6)USER)
INTEGER J
J = OPERMS(USER)
J = APERMS(USER) IF J = 0
RESULT = J
END
!
!
!
INTEGERFN IDPROCS
INTEGER J, MAX, ADR, L, K
BYTEINTEGERARRAY PLIST(0:32*256)
STRINGNAME USER
ADR = ADDR(PLIST(0))
J = DPROCS(MAX, ADR)
-> OUT UNLESS J = 0
L = 0
CYCLE K = 0, 1, MAX-1
USER == STRING(ADDR(PLIST(32*K)))
UNLESS USER = "" START
WRITE(K, 3)
SPACE
PRINTSTRING(USER)
L = L + 1
L = 0 AND NEWLINE IF L = 6
FINISH
REPEAT
NEWLINE UNLESS L = 0
OUT:
RESULT = J
END
!
!
!
INTEGERFN IUSERS(INTEGER FSYS)
INTEGER ADR, N, J
BYTEINTEGERARRAY B(0:9555)
ADR = ADDR(B(0))
N = 0
J = GETUSNAMES(N, ADR, FSYS)
IF N > 0 = J START
WRSN("No of users", N)
CYCLE
PRINTSTRING(STRING(ADR))
IF J = 9 C
THEN J = 0 AND NEWLINE C
ELSE J = J + 1 AND SPACE
ADR = ADR + 7
N = N - 1
EXIT IF N = 0
REPEAT
J = 0
FINISH
NEWLINE
RESULT = J
END
!
!-----------------------------------------------------------------------
!
INTEGERFN IWHO(STRING (6)USER)
!
ROUTINE ERROR(INTEGER N)
PRINTSTRING("Flag = ")
PRINTSTRING(DERRS(N))
END
!
!
!
ROUTINE PRINTCHS(STRING (255)S)
SYSTEMINTEGERFNSPEC IOCP(INTEGER EP, PARM)
INTEGER LEN, ADR, RES; ! KEEP IN THIS ORDER !!!!
RETURN IF LENGTH(S) = 0
LEN = LENGTH(S)
ADR = ADDR(S) + 1
RES = IOCP(19, ADDR(LEN))
END
!
!
!
ROUTINE MOVE(INTEGER L, FROM, TO)
*LDTB_X'18000000'
*LDB_L
*LDA_FROM
*CYD_0
*LDA_TO
*MV_L =DR
END ; ! MOVE
!
!
!
INTEGERFN GET FSYS(STRING (6)USER, INTEGERNAME NI, INTEGER I)
INTEGER N, F, J, I0, FS
STRINGNAME S
I0 = I
FS = -1
J = D USER INDEXES(USER, -1, I, N)
RESULT = J UNLESS J = 0
RESULT = 37 UNLESS N > 0
NI = N
!
WHILE N > 0 CYCLE
S == STRING(I)
F = INTEGER(I + 12)
IF S = "" START ; ! a main index
IF FS < 0 START ; ! put first main index first
FS = F
UNLESS I = I0 START
MOVE(16, I0, I)
STRING(I0) = ""
INTEGER(I0 + 12) = FS
FINISH
FINISH
FINISH
I = I + 16
N = N - 1
REPEAT
RESULT = 0
END
!
!
!
SYSTEMSTRING (8)FNSPEC UNPACKDATE(INTEGER I)
SYSTEMSTRING (8)FNSPEC UNPACKTIME(INTEGER I)
INTEGER J, T, FSYS, AI0, K, NI, I, I0
INTEGERARRAY INT(0:15)
STRING (15)W
STRING (18)INDEX
REAL R
STRINGNAME S, INA
BYTEINTEGERARRAY IS(0:255)
CONSTINTEGER TYPES = 17
CONSTBYTEINTEGERARRAY TYP(1:TYPES) = C
18, 1, 0, 44, 4, 30, 11, 12, 7, 5, 13, 14, 33, 37, 40, 6, 9
CONSTBYTEINTEGERARRAY HONLY(1:TYPES) = C
1,1,1,1,0,0,0,0,1,1,1,1,1,1,1,1,0
CONSTBYTEINTEGERARRAY L(1:TYPES) = C
1,1,1,1,2,3,4,4,4,5,6,7,8,1,9,9,10
CONSTSTRING (31)ARRAY TAG(1:TYPES) = C
"Surname: ", "
Delivery: ", "
Basefile: ", " Supervisor: ", "
Index use: ", "
Files: ", "
Limits: MaxKb",
" Maxfilesize", "
ACR: ", " ", "
Current procs: ", " max procs: ", "
Funds: ", " Gpholder: ", "
Dates passwords changed: ", "
Last log on: ", "
#ARCH use: index size"
SWITCH SW(1:TYPES)
!
I0 = ADDR(IS(0))
I = I0
J = GET FSYS(USER, NI, I)
RESULT = J UNLESS J = 0
!
AI0 = ADDR(INT(0))
S == STRING(AI0)
!
CYCLE
INA == STRING(I)
FSYS = INTEGER(I + 12)
!
UNLESS I = I0 START
PRINTSTRING("User also has ")
IF INA = "" C
THEN PRINTSTRING("an index") C
ELSE PRINTSTRING("a file index " . INA)
PRINTSTRING(" on fsys")
WRITE(FSYS, 1)
NEWLINE
J = IPROMPT(PRESS RETURN)
FINISH
!
PRINTCHS(VDUS(1))
PRINTSTRING("User: ")
PRINTSTRING(USER)
PRINTSTRING(" Index: " . INA) UNLESS INA = ""
PRINTSTRING(" on fsys")
WRITE(FSYS, 1)
NEWLINE
!
I = I + 16
NI = NI - 1
INDEX = USER
INDEX = USER . ":" . INA UNLESS INA = ""
!
CYCLE T = 1, 1, TYPES
-> NEXT IF INA # "" AND HONLY(T) = 1
J = DSFI(INDEX, FSYS, TYP(T), 0, AI0)
PRINTSTRING(TAG(T)) AND -> SW(L(T)) IF J = 0
-> NEXT IF T = 10; ! password stuff
IF T=17 AND J=32 C
THEN PRINTSTRING("No #ARCH") C
ELSE ERROR(J)
-> NEXTI
SW(1):
PRINTSTRING(S)
-> NEXT
SW(2):
WRITE(INT(0), 1)
PRINTSTRING(" files, index size")
WRITE(INT(3), 1)
PRINTSTRING("Kb")
NEWLINE
!
WRITE(INT(1), 3); PRINTSTRING(" FDs used")
WRITE(INT(4)-INT(5), 3); PRINTSTRING(" SDs used")
WRITE(INT(6)-INT(7), 3); PRINTSTRING(" PDs used")
NEWLINE
!
WRITE(INT(2), 3); PRINTSTRING(" FDs free")
WRITE(INT(5), 3); PRINTSTRING(" SDs free")
WRITE(INT(7), 3); PRINTSTRING(" PDs free")
-> NEXT
SW(3):
WRITE(INT(0), 1)
PRINTSTRING(" disc files,")
WRITE(INT(1), 1)
PRINTSTRING(" Kb,")
WRITE(INT(4), 1)
PRINTSTRING(" Temp files,")
WRITE(INT(5), 1)
PRINTSTRING(" Temp Kb")
-> NEXT
SW(4):
WRITE(INT(0), 1)
-> NEXT
SW(5):
W = "----, ++++"
MOVE(4, AI0, ADDR(W)+1)
MOVE(4, AI0+4, ADDR(W)+7)
PRINTSTRING(W)
-> NEXT
SW(6):
WRITE(INT(0), 3)
WRITE(INT(1), 3)
-> NEXT
SW(7):
WRITE(INT(0), 3)
WRITE(INT(1), 3)
WRITE(INT(2), 3)
-> NEXT
SW(8):
R = INT(0) / 10000
PRINT(R, 1, 2)
-> NEXT
SW(9):
CYCLE J = 0, 1, 1
K = INT(J)
IF K = 0 C
THEN PRINTSTRING("????") C
ELSE PRINTSTRING(UNPACKDATE(K)." ".UNPACKTIME(K))
PRINTSTRING(" / ") IF J = 0
REPEAT
-> NEXT
SW(10):
WRITE(INT(4), 1)
NEWLINE
WRITE(INT(0), 6); PRINTSTRING(" A files ")
WRITE(INT(2), 6); PRINTSTRING(" B files ")
WRITE(INT(5)-INT(6), 4); PRINTSTRING(" FDs used")
WRITE(INT(7)-INT(8), 4); PRINTSTRING(" PDs used")
NEWLINE
WRITE(INT(1), 6); PRINTSTRING(" A Kbytes")
WRITE(INT(3), 6); PRINTSTRING(" B Kbytes")
WRITE(INT(6), 4); PRINTSTRING(" FDs free")
WRITE(INT(8), 4); PRINTSTRING(" PDs free")
NEXT:
REPEAT
NEXTI:
NEWLINE
EXIT IF NI = 0
REPEAT
RESULT = 0
END
!
!-----------------------------------------------------------------------
!
INTEGERFN IDTRANSFER(STRING (6)FROMU, STRING (11)FROM F, INTEGER FROM FSYS,
STRING (6)TO U, STRING (11)TO F, INTEGER TO FSYS, TYPE)
RESULT = DTRANSFER(FROMU, TOU, FROMF, TOF, FROMFSYS, TOFSYS, TYPE)
END
!
!
!
INTEGERFN ADRPRM
INTEGER J
J = IP(6) & 15; ! type
IF 0 <= J <= 2 OR J = 6 C
THEN RESULT = IPROMPT(PERMISSION) C
ELSE RESULT = ADDR(PRM)
END
!
!
!
INTEGERFN ADRDSFI
INTEGER TYPE, J, K
TYPE = IP(3)
IF IP(4) = 1 AND 0 <= TYPE <= TOPDSFI START
K = NI(TYPE); ! 0=string n>0 integers, <0 can't do
IF K = 0 C
THEN S0 = PROMPTS(TXT(T(TYPE)) . ": ") C
ELSE START
IF K > 0 START
CYCLE J = 0, 1, K-1
I(J) = PROMPTI(TXT(T(TYPE)+J) . ": ")
REPEAT
FINISH
FINISH
FINISH
!
RESULT = ADDRDSFI
END
!
ROUTINE RES(INTEGER R)
RESULT = R
!
IF R = 0 START
WRS("Done")
FINISH ELSE START
PRINTSTRING("Flag = ")
WRS(DERRS(R))
FINISH
END
!
!-------------------------------------------------- START OF MAIN PROGRAM ------
!
ADDRDSFI = ADDR(DSFII(0))
I == ARRAY(ADDRDSFI, IFT)
S0 == STRING(ADDRDSFI)
NOP = 0; ! count parameters
FNLOOP:
FN = SPROMPT(FUNCTION)
UCTRANSLATE(ADDR(FN)+1, LENGTH(FN)) UNLESS FN = ""
NOP = 0; ! reset
CYCLE J = 1, 1, TOPFN
-> F(J) IF FN = E(J)
REPEAT
WRS("Invalid function, reply ? for help info")
P = ""
-> FNLOOP
F(1):
!<CHACCESS
! %EXTERNALINTEGERFN DCHACCESS(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, NEWMODE)
!
!This procedure is used to change the access mode (Segment table
!access permission field, APF) for connected file FILE belonging to
!USER on FSYS. Bits in NEWMODE have the following meanings (as in
!the MODE parameter to procedure DCONNECT):
! 2**0 set - read access to be allowed
! 2**1 set - write access to be allowed
! 2**2 set - execute access to be allowed
!The file must be permitted to the caller in the appropriate mode
!- error result 32 is returned otherwise.
!Possible error results: 8, 32, 39
!>
!%EXTERNALROUTINE KCHACCESS(%STRING(255)S)
RES(DCHACCESS(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS), IPROMPT(MODE)))
RETURN ; !%END
!
!
!
F(2):
!<CHSIZE
! %EXTERNALINTEGERFN DCHSIZE(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, NEWSIZE KB)
!
!The physical size of file FILE belonging to user USER on disc-pack
!FSYS is altered (if necessary) so that its new size (in Kbytes)
!is NEWSIZE.! The size may not be reduced to zero. The file may
!be connected in the caller's virtual memory (only).
!Note 1 applies.
!Note 2 applies.
!Possible error results: 11, 30, 32, 37, 41
!>
!%EXTERNALROUTINE KCHSIZE(%STRING(255)S)
RES(DCHSIZE(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS), IPROMPT(NKB)))
RETURN ; !%END
!
!
!
F(3):
!<CONNECT
!%EXTERNALINTEGERFN DCONNECT(%STRING(6) USER, %C
! %STRING(11) FILE,%INTEGER FSYS,MODE,APF,%INTEGERNAME SEG,GAP)
!
! Provided that the file is suitably permitted to the process owner
! calling the procedure, the file of name FILE belonging to user
! USER on disc-pack FSYS is connected into the caller's virtual
! memory.
! Note 2 applies.
! The bits in the parameter MODE have the following meanings (when
! set):
! 2**0 Read access required
! 1 Write access required
! 2 Execute access required
! 3 Write access by other processes to be allowed
! 4 New copy of file to be written
! 5 Communications mode
! 6 Not to be allocated space on the drum
! 7 Segment to be used as a process stack
! The purpose of bit 2**3 is to allow (read and) write access by more
! than one process to be achieved only when each user specifically
! allows the situation (by setting the bit in his request).
! Bits 2**1 or 2**3 may not be set in the request if bit 2**2 (execute
! access) is also set.
! SEG either specifies the segment number at which the file is to be
! connected (in the range 34 to 127), or is zero, indicating that the
! choice of segment number is to be left to Director. If the result
! of the function is 0 or 34 (file already connected), SEG is set
! to the chosen segment number.
! GAP specifies the number of segments which are to be reserved for
! the file, even though the current size of the file may be less
! than that number of segments. Attempts to specify a value of
! SEG which conflicts with this GAP, in subsequent connect
! requests before this file is disconnected, will be rejected.
! If GAP is set to zero then no segments of virtual memory,
! other than those required by the current file size, are
! reserved for the file. If the result of the function is 0 or 34
! (file already connected), GAP is set to the number of segments
! reserved for the file.
! APF may be used to specify the access permission field in the
! segment(s) being connected. The bottom 9 bits are significant:
! 1 4 4
! EXE- WRITE READ
! CUTE ACR ACR
! The read and write ACR values supplied must be greater than or equal
! to the ACR at which the calling program (subsystem) is running.
! If the APF parameter is set to zero, a value of X'1nn' is used,
! where n is the ACR at which the caller is executing.
! Possible error results: 5, 6, 26, 28, 30, 32, 34, 35, 36, 37, 47
!>
RES(IDCONNECT(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
IPROMPT(MODE), IPROMPT(APF), IPROMPT(SEG), IPROMPT(GAP),
RSEG, RGAP))
!
IF RESULT = 0 OR RESULT = 34 START
WRSNT("Connected at ", RSEG<<18, 6)
WRSN(" Seg", RSEG)
FINISH
RETURN ; !%END
!
!
F(4):
!<CREATE2
! %EXTERNALINTEGERFN DCREATE2(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, NKB, TYPE, %INTEGERNAME DA)
!
!A file of name FILE is created, for user USER on disc-pack FSYS, of
!E Epages, where E is the smallest number of Epages containing NKB
!Kbytes.
!
!The maximum size of file allowed is 16 Mbytes. Subsystems requiring
!larger files should arrange that they be made up of subfiles
!comprising files created by this procedure.
!
!Note 1 applies.
!Note 2 applies.
!
!Bits in TYPE may be set:
!
! 2**0 For a temporary file (destroyed when the creating process
! stops if the file was connected, or at System start-up).
!
! 2**1 For a very temporary file (destroyed when the file is
! disconnected).
!
! 2**2 For a file which is to be zeroed when created.
!
! 2**3 To set "CHERISHed" status for the file.
!
!
!Temporary files may be created only in the process owner's file
!index, and may be connected only into a virtual memory of the
!process owner. In particular, temporary files may not be shared.
!
!Temporary files are made into ordinary files (that is, the
!"temporary" attribute is removed) on being RENAMEd, OFFERed,
!TRANSFERred or PERMITted, and also explicitly by an appropriate
!call on procedure DFSTATUS.
!
!Possible error results: 11, 15, 16, 17, 18, 26, 28, 37, 41, 47
!>
!%EXTERNALROUTINE KCREATE(%STRING(255)S)
RES(DCREATE(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
IPROMPT(NKB), IPROMPT(TYPECR)))
RETURN ; !%END
!
!
F(5):
!<DELUSER
! %EXTERNALINTEGERFN DDELUSER(%STRING(6)USER, %INTEGER FSYS)
!
!Destroys all the users files and then deletes the index
!>
!%EXTERNALROUTINE KDELUSER(%STRING(255)S)
RES(DDELUSER(SPROMPT(USER), IPROMPT(FSYS)))
RETURN ; !%END
!
!
!
F(6):
!<DESTROY
! %EXTERNALINTEGERFN DDESTROY(%STRING(6)USER, %STRING(11)FILE,
! %STRING(8)DATE, %INTEGER FSYS, TYPE)
!
!The file, of name FILE belonging to user USER on disc-pack FSYS, is
!destroyed. TYPE should be set to 1 to destroy a file from archive
!storage, otherwise it should be set to zero. When TYPE=1, DATE
!should be set to the archive date. DATE is ignored if TYPE=0.
!
!Note 1 applies.
!Note 2 applies.
!Note 3 applies.
!
!The procedure fails if the file owner has made access permission
!zero for 'self'.
!
!Possible error results: 5, 8, 11, 18, 20, 21, 22, 25, 32, 37, 47, 59, 75
!>
!%EXTERNALROUTINE KDESTROY(%STRING(255)S)
RES(DDESTROY(SPROMPT(USER), SPROMPT(FILE), SPROMPT(DATE),
IPROMPT(FSYS), IPROMPT(TYPEDE)))
RETURN ; !%END
!
!
!
F(7):
!<DISCONNECT
! %EXTERNALINTEGERFN DDISCONNECT(%STRING(6)USER, %STRING(11)FILE
! %INTEGER FSYS, DSTRY)
!
!The file of name FILE belonging to user USER on disc-pack FSYS is
!disconnected from the caller's virtual memory. Parameter DESTROY
!should be set either to 0 or 1. If set to 1 the file will be
!destroyed, provided that it belongs to the process owner (not
!necessary if the process is privileged) and the "use-count"
!for the file is zero after disconnection. Otherwise the
!parameter is ignored.
!Note 2 applies.
!Possible error results: 30, 32, 37, 38, 39, 47
!>
!%EXTERNALROUTINE KDISCONNECT(%STRING(255)S)
RES(DDISCONNECT(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
IPROMPT(DSTROY)))
RETURN ; !%END
!
!
!
F(8):
!<DISCS
!Lists the discs that are mounted and their characteristics
!>
IDISCS
RETURN
!
!
!
F(9):
!<DONATE
! %EXTERNALINTEGERFN DDONATE(%STRING(6)USER, %INTEGER FSYS, UNITS)
!
!Allows a process owner, who has no group holder, to transfer
!some of his funds to USER on FSYS or, if USER has a group holder,
!to the group holder.
!>
!%EXTERNALROUTINE KDONATE(%STRING(255)S)
RES(DDONATE(SPROMPT(USER), IPROMPT(FSYS), IPROMPT(FUNDS)))
RETURN ; !%END
!
F(10):
!<FBASE
! %EXTERNALINTEGERFN FBASE(%INTEGERNAME FSYSSTART, HIBIT, %INTEGER FSYS)
!
!This procedure allows a privileged process to determine the
!characteristics of an on-line disc. Typically LO = X40 or X800
!and HI = X59F3 or XB3E7
!>
!%EXTERNALROUTINE KFBASE(%STRING(255)S)
FSYSV = IPROMPT(FSYS)
RES(FBASE(LO, HI, FSYSV))
RETURN UNLESS RESULT = 0
WRSNT("LO=", LO, 6)
WRSNT(" HI=X", HI, 2)
RETURN ; !%END
!
!
F(11):
!<FILENAMES
! %EXTERNALINTEGERFN DFILENAMES(%STRING(6)USER,
! %RECORD(AINFF)%ARRAYNAME INF,
! %INTEGERNAME FILENO,MAXREC,NFILES,
! %INTEGER FSYS,TYPE)
!
! This procedure delivers, in the record array INF (which should be
!declared (0:n)), a sequence of records describing the on-line
!files (for TYPE=0), archived files (for TYPE=1) or backed-up files
!(for TYPE=2) belonging to user USER on fsys FSYS (or -1 if not known).
!Note 1 applies.
!Note 2 applies.
!Note 3 applies.
! MAXREC is set by the caller to specify the maximum number of
!records he is prepared to accept in the array INF, and is set by
!Director to be the number of records actually returned.
! NFILES is set by Director to be the number of files actually held on
!on-line storage or on archive storage, depending on the value of TYPE.
!Parameter FILENUM is used only for TYPE=1. Filenames are stored in
!chronological order (by archive date). FILENUM is set by the caller
!to specify the "file-number" from which descriptions are to be
!returned, zero represents the most recently archived file. (The
!intention here is to allow the caller to receive subsets of
!descriptions of a possibly very large number of files.)
!
!The format of the records delivered in the array INF is as follows:
!
!For on-line files:
! string(11) NAME, integer SP12, KBYTES, byteinteger ARCH, CODES,
! CCT, OWNP, EEP, USE, CODES2, SSBYTE, FLAGS, POOL, DAYNO, SP31)
! (32 bytes)
!
!and for off-line files:
! string(11) NAME, integer KBYTES, string(8) DATE, string(6) TAPE,
! integer CHAPTER, FLAGS)
! (40 bytes)
!
!TAPE and CHAPTER are returned null to unprivileged callers.
!
! Possible error results: 11, 37, 45, 59, 61
!>
!%EXTERNALROUTINE KFILENAMES(%STRING(255)S)
USERV = SPROMPT(USER)
FILENUMV = IPROMPT(FILENUM)
FSYSV = IPROMPT(FSYS)
TYPEV = IPROMPT(TYPEDE)
OS == ARRAY(ADDR(B(0)), OSF)
AS == ARRAY(ADDR(B(0)), ASF)
MAXREC = 200
IF TYPEV = 0 THEN C
RES(DFILENAMES(USERV, OS, FILENUMV, MAXREC, NFILES, FSYSV, TYPEV)) C
ELSE C
RES(DFILENAMES(USERV, AS, FILENUMV, MAXREC, NFILES, FSYSV, TYPEV))
RETURN UNLESS RESULT = 0
!
WRSNT("Maxrec", MAXREC, 5)
WRSN(" Nfiles", NFILES)
RETURN IF MAXREC = 0
!
MAXREC = MAXREC - 1
IF TYPEV = 0 START ; ! on-line files
WRS("file NKB OWNP EEP Use")
CYCLE J = 0, 1, MAXREC
O == OS(J)
S11 <- O_NAME . " "
PRINTSTRING(S11)
WRITE(O_NKB, 4)
WRITE(O_OWNP, 5)
WRITE(O_EEP, 4)
WRITE(O_USE, 4)
NEWLINE
REPEAT
FINISH ELSE START
! archive files
WRS("file NKB Date Tape Chapter")
CYCLE J = 0, 1, MAXREC
A == AS(J)
S11 <- A_NAME . " "
PRINTSTRING(S11)
WRITE(A_NKB, 4)
SPACES(2)
PRINTSTRING(A_DATE)
SPACES(2)
PRINTSTRING(A_TAPE)
WRITE(A_CHAP, 6)
NEWLINE
REPEAT
FINISH
RETURN ; !%END
!
!
!
F(12):
!<FINFO
! %EXTERNALINTEGERFN DFINFO(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, ADR)
!
!This procedure returns detailed information about the attributes of
!file FILE belonging to user USER on disc-pack FSYS, in a record
!written to address ADR.
!
!Note 2 applies.
!
!A non-privileged caller of the procedure having no permitted access
!to the file will receive an error result of 32, as though the file
!did not exist.
!
!The format of the record returned is:
!integer
! NKB the number of Kbytes (physical file size)
!
! RUP the caller's permitted access modes
!
! EEP the general access permission
!
! APF 1-4-4 bits, right-justified, giving respectively
! the Execute, Write and Read fields of APF, if
! the file is connected in this virtual memory
!
! USE the current number of users of the file
!
! ARCH the value of the archive byte for the file (see
! procedure DFSTATUS, below)
!
! FSYS disc-pack number on which the file resides
!
! CONSEG the segment number at which the file is connected
! in the caller's virtual memory, zero if not
! connected
!
! CCT the number of times the file has been connected
! since the connect count was last zeroed (see
! procedure DFSTATUS)
!
! CODES information for privileged processes
! byteinteger
! SP1 = 0
!
! DAYNO Day number when file last connected
!
! POOL
!
! CODES2 information for internal use
! integer
! SSBYTE information for the subsystem's exclusive use
!
! string(6) OFFER the username to which the file has been offered
! (see procedure DOFFER), otherwise null
!
!Possible error results: 18, 32, 37, 45
!>
!%EXTERNALROUTINE KFINFO(%STRING(255)S)
RES(DFINFO(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS), ADDR(DFIN)))
!
IF RESULT = 0 START
WRSNT("NKB", DFIN_NKB, 5)
WRSNT(",RUP", DFIN_RUP, 5)
WRSNT(",EEP", DFIN_EEP, 5)
WRSNT(",APF ", DFIN_APF, X'36')
WRSNT(",USE", DFIN_USE, 1)
!
WRSNT("ARCH ", DFIN_ARCH, X'26')
WRSNT(",FSYS", DFIN_FS, 5)
WRSNT(",SEG", DFIN_SEG, 5)
WRSNT(",CCT", DFIN_CCT, 5)
WRSNT(",CODES ", DFIN_CDS, X'22')
!
WRSNT("DAY", DFIN_DAY, 5)
WRSNT(",CODES2 ", DFIN_CD2, X'26')
WRSNT(",SS", DFIN_SS, 5)
WRS(",ON OFFER TO " . DFIN_OFF)
FINISH
RETURN ; !%END
!
!
F(13):
!<FSTATUS
! %EXTERNALINTEGERFN DFSTATUS(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, ACT, VALUE)
!
!This procedure is supplied to enable the attributes of file FILE
!belonging to user USER on disc-pack FSYS to be modified, as follows.
!
!Parameter VALUE is for use by the archive/backup program (ACT=13),
!and by the subsystem (ACT=18), otherwise it should be set to zero.
!
!Note 1 applies.
!Note 2 applies.
!
! ACT ACTION
!
! 0 HAZARD Remove CHERISHed attribute.
!
! 1 CHERISH Make subject to automatic System back-up
! procedures.
!
! 2 UNARCHIVE Remove the "to-be-archived" attribute.
!
! 3 ARCHIVE Mark the file for removal from on-line to
! archive storage.
!
! 4 NOT TEMP Remove the "temporary" attribute.
!
! 5 TEMPFI Mark the file as "temporary", that is, to be
! destroyed when the process belonging to the
! file owner stops (if the file is connected at
! that time), or at system start-up.
!
! 6 VTEMPFI Mark the file as "very temporary", that is, to
! be destroyed when it is disconnected from the
! owner's virtual memory.
!
! 7 NOT PRIVATE May now be written to magnetic tape either for
! back-up or archive. May be called only by
! privileged programs.
!
! 8 PRIVATE Not to be written to magnetic tape either for
! back-up or archive. May be called only by
! privileged programs.
!
! 9 SET CCT Set the connect count for the file to the
! bottom 8 bits of VALUE.
!
! 10 ARCH Operation 0 (PRIVILEGED).
! Shift ARCH byte usage bits (2**2 to 2**6
! inclusive) left one place. If A is the
! resulting value of the ARCH byte, set bit
! 2**7 if (A>>2)&B'11111' = VALUE.
!
! 11 ARCH Operation 1 (PRIVILEGED).
! Set currently-being-backed-up bit (bit 2**1 in
! ARCH byte), unless the file is currently
! connected in write mode, when error result 52
! is given.
!
! 12 ARCH Operation 2 (PRIVILEGED).
! Clear currently-being-backed-up bit (2**1) and
! has-been-connected-in-write-mode bit (2**0).
!
! 13 ARCH Operation 3 (PRIVILEGED).
! Set archive byte to be bottom 8 bits of VALUE
! and clear the UNAVAilable bit in CODES.
!
! 14 ARCH Operation 4 (PRIVILEGED).
! Clear the UNAVAilable and privacy VIOLATed bits
! in CODES. Used by the back-up and archive
! programs when the file has been read in from
! magnetic tape.
!
! 15 CLR USE Clear file use-count and WRITE-CONNECTED status
! (PRIVILEGED).
!
! 16 CLR NOARCH Clear archive-inhibit bit in CODES.
!
! 17 SET NOARCH Set archive-inhibit bit in CODES
!
! 18 SSBYTE Set SSBYTE to be the bottom 8 bits of VALUE
! (byte for a subsystem's exclusive use).
!
! 19 ARCH Operation 5 (PRIVILEGED). Set the WRCONN bit in
! CODES2. Used to prevent any user connecting
! the file in write mode during back-up or
! archive.
!
! 20 ARCH Operation 6 (PRIVILEGED). Clear the WRCONN bit
! in CODES2. Used when back-up is complete.
!
! 21 DAYNO Set DAYNO to bottom 8 bits of VALUE
!
! Possible error results: 8, 11, 18, 20, 37, 47, 52
!>
!%EXTERNALROUTINE KFSTATUS(%STRING(255)S)
RES(DFSTATUS(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
IPROMPT(ACTFSTAT), IPROMPT(VALUE)))
RETURN ; !%END
!
!
!
F(14): ! FSYS
!<FSYS
! %EXTERNALINTEGERFN DFSYS(%STRING(6)USER, %INTEGERNAME FSYS)
!
! This procedure may be used to determine on which disk
!pack user USER resides. If FSYS is set to -1 before the procedure
!is called, it is set with the first disc-pack number on which USER
!is found. If FSYS is set non-negative, only that disc-pack number
!is searched. If USER is not found, FSYS is unchanged and error
!result 37 is returned.
!
!Possible error results: 8, 23, 37
!>
RES(IDFSYS(SPROMPT(USER)))
RETURN
!
!
!
F(15):
!<GETDA
! %EXTERNALINTEGERFN DGETDA(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, ADR)
!
!This procedure, available only to privileged processes, provides the
!disc addresses of the sections of file FILE belonging to USER
!on disc-pack FSYS. Data is written from address ADR in the form
!
! (integer SECTSI, NSECTS, LASTSECT, SPARE, integerarray DA(0:255))
!
!where SECTSI is the size (in epages) of the sections (except
! possibly the final section)
!
! NSECTS is the number of sections, and hence the number
! of entries returned in array DA
!
! LASTSECT is the size (in epages) of the final section
!
!In each entry in the DA array, the top byte contains the FSYS number.
!
!Possible error results: 5, 30, 32, 37, 45
!>
!%EXTERNALROUTINE KGETDA(%STRING(255)S)
ADR = ADDR(AA(-4))
RES(DGETDA(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS), ADR))
RETURN UNLESS RESULT = 0
!
WRSNT("Sectsi", AA(-4), 5)
WRSNT(" Nsects", AA(-3), 5)
WRSN(" PGS in last sect", AA(-2))
!
J = 0
WHILE J < AA(-3) CYCLE
WRSNT("DA ", J+1, 5)
WRSNT(" ", AA(J), 2)
J = J + 1
REPEAT
RETURN ; !%END
!
!
!
F(16):
!<NEWGEN
! %EXTERNALINTEGERFN DNEWGEN(%STRING(6)USER,
! %STRING(11)FILE, NEWGEN OF FILE, %INTEGER FSYS)
!
!This procedure provides a means of introducing an updated version
!(i.e. a new generation) of file FILE even though it may be
!connected in other users' virtual memories.
!
!If FILE is not connected in any virtual memory, a call on DNEWGEN is
!equivalent to destroying FILE and then renaming NEWGEN OF FILE to
!FILE, except that the new version of FILE retains the former FILE's
!access permissions.
!
!If FILE is connected in some virtual memory, then the filename
!NEWGEN OF FILE "disappears", and any subsequent connection of FILE
!into a virtual memory yields the contents of the new generation
!formerly held in NEWGEN OF FILE.
!
!When the number of users of a former copy of FILE becomes zero
!(i.e. when it is not connected in any virtual memory), that copy is
!destroyed.
!
!Note 1 applies.
!Note 2 applies.
!
!Possible error results: 5, 6, 11, 15, 18, 32, 37, 40
!>
!%EXTERNALROUTINE KNEWGEN(%STRING(255)S)
RES(DNEWGEN(SPROMPT(USER), SPROMPT(TOF), SPROMPT(FROMF), IPROMPT(FSYS)))
RETURN ; !%END
!
!
!
F(17):
!<NEWUSER
! %EXTERNALINTEGERFN DNEWUSER(%STRING(6)USER, %INTEGER FSYS, NKB)
!
!Possible result codes
! 7 No Index space
! 8 Length of USER not 6 or has bad characters
! 12 NKB wrong
! 13 No space in NNT
! 14 Already present
! 23 Fsys not available
! 26 Bad parameters from SCONNECT
! 28 CBT full
!>
!%EXTERNALROUTINE KNEWUSER(%STRING(255)S)
RES(DNEWUSER(SPROMPT(USER), IPROMPT(FSYS), IPROMPT(NKB)))
RETURN ; !%END
!
!
!
F(18):
!<OFFER
! %EXTERNALINTEGERFN DOFFER(%STRING(6)USER, OFFERTO,
! %STRING(11)FILE, %INTEGER FSYS)
!
!This procedure causes file FILE belonging to user USER on disc-pack
!FSYS to be marked as being "on offer" to user OFFERTO. The file
!may not be connected in any virtual memory either at the time of
!the call of this procedure or subsequently while the file is on
!offer. The procedure DACCEPT is used by user OFFERTO to accept the
!file from user USER. A file may be on offer to at most one user.
!An offer may be withdrawn by calling this procedure with OFFERTO
!set as a null string.
!
!Note 1 applies.
!Note 2 applies.
!
!Possible error results: 11, 17, 20, 30, 32
!>
!%EXTERNALROUTINE KOFFER(%STRING(255)S)
RES(DOFFER(SPROMPT(USER), SPROMPT(OFFERTO), SPROMPT(FILE), IPROMPT(FSYS)))
RETURN ; !%END
!
!
!
F(19):
!<OPTIONS
! INTEGERFN OPTION(%STRING(6)USER, %STRING(11)FILE)
!
!Validates the nominated 'option' file and lists the fields
!>
RES(IOPTIONS(SPROMPT(USER), SPROMPT(OPTNFILE)))
RETURN
!
!
!
F(20):
!<PERMISSION
! %EXTERNALINTEGERFN DPERMISSION(%STRING(6)OWNER, USER,
! %STRING(8)DATE, %STRING(11)FILE, %INTEGER FSYS, TYPE, ADRPRM)
!
!
! This function allows the owner of file FILE on disc-pack FSYS to set
! access permissions, or specific preventions, for file connection to
! individual users, groups of users or to all users. It also allows a
! user to determine the modes (if any) in which he may access the
! file.
!
! Note 2 applies.
! Note 3 applies.
!
! TYPE determines the service required of the procedure:
!
!
! TYPE Action
!
! 0 set OWNP (not for files on archive storage)
!
! 1 set EEP
!
! 2 put USER into the file list (see "Use of file
! access permissions", below)
!
! 3 remove USER from file list
!
! 4 return the file list
!
! 5 destroy the file list
!
! 6 put USER into the index list (see "Use of file
! access permissions", below)
!
! 7 remove USER from the index list
!
! 8 return the index list
!
! 9 destroy the index list
!
! 10 give modes of access available to USER for FILE
!
!
! TYPEs 0 to 9 are available only to the file owner and to privileged
! processes. For TYPE 10, ADRPRM (see below) should be the address
! of an integer into which the access permission of USER to the file
! is returned. If USER has no access to the file, error result 32
! will be returned from the function, as though the file did not
! exist. If the file is on archive storage, TYPE should be set to 16
! plus the above values to obtain the equivalent effects.
!
!
! ADRPRM is either the permission being attached to the file, bit
! values interpreted as follows:
!
!
! all bits zero prevent access
! 2**0 allow READ access
! 2**1 allow WRITE access not allowed for files
! 2**2 allow EXECUTE access on archive storage
! 2**3 If TYPE = 0, prevent the file from being
! destroyed by e.g. DDESTROY, DDISCONNECT (and
! destroy).
!
! or, except for type 10, it is the address of an area into which
! access permission information is to be written, in the format
!
! (integer BYTES RETURNED, OWNP, EEP, SPARE, recordarray c
! INDIV PRMS(0:15) (string(6) USER, byteinteger UPRM))
!
! where:
!
! BYTES indicates the amount of data returned.
! RETURNED
!
! OWNP is the file owner's own permission to the file, or the
! requesting user's "net" permission if the caller of the
! procedure is not the file owner (see "Use of file access
! permissions", below).
!
! EEP is the general (all users) access permission to the file
! ("everyone else's permission").
!
! UPRM The UPRM values in the sub-records are the permissions
! for corresponding users or groups of users denoted by
! USER. Up to16 such permissions may be attached to a
! file.
!
!
!
! Use of file access permissions
!
! The general scheme for permissions is as follows. With each file
! there are associated:
!
! OWNP the permission of the owner of the file to access it
!
! EEP everyone else's permission to access it (other than users
! whose names are explicitly or implicitly attached to the
! file)
!
! INDIV PRMS a list of up to 16 items describing permissions for
! individual users, e.g. ERCC00, or groups of users, e.g.
! ERCC?? (specifying all usernames of which the first four
! characters are "ERCC")
!
!
! In addition, a user may attach a similar list of up to 16 items to
! his file index as a whole, and the permissions in this list apply
! to any file described in the index along with those attached to
! that particular file.
!
! In determining the mode or modes in which a particular user may access a
! file, the following rules apply:
!
! 1. If the user is the file owner then OWNP applies.
!
! 2. Otherwise, if the user's name appears explicitly in the list for the
! file, the corresponding permission applies.
!
! 4. Otherwise, if the user's name is a member of a group of users
! represented by a list item for the file, the corresponding permission
! applies.
!
! 6. Otherwise EEP applies.
!
! 3. Otherwise, if the user's name appears explicitly in the list for the
! index, the corresponding permission applies.
!
! 5. Otherwise, if the user's name is a member of a group of users
! represented by a list item for the index, the corresponding permission
! applies.
!
!
! In the event of a user's name appearing more than once (implicitly)
! within groups specified in a single list, the actual list item to be
! selected to give the permission should be regarded as indeterminate.
!
!
! Possible error results: 8, 11, 17, 32, 37, 45, 46, 59, 75
!
!
!
!>
!%EXTERNALROUTINE KPERMISSION(%STRING(255)S)
RES(DPERMISSION(SPROMPT(USER), SPROMPT(TO U), SPROMPT(DATE), SPROMPT(FILE),
IPROMPT(FSYS), IPROMPT(TYPEPRM), ADRPRM))
!
IF RESULT = 0 START
J = IP(6) & 15
IF J = 10 START
WRSNT("PERM=", PRM_B, 26)
FINISH ELSE START
IF J = 4 START
WRSNT("OWNP=", PRM_OWNP, 26)
WRSNT(" EEP=", PRM_EEP, 26)
FINISH
IF J = 4 OR J = 8 START
J = (PRM_B-16)>>3
IF J > 0 START
CYCLE X = 0, 1, J-1
WRSNT(PRM_PRMS(X)_USER, PRM_PRMS(X)_PRM, 26)
REPEAT
FINISH
FINISH
FINISH
NEWLINE
FINISH
RETURN ; !%END
!
!
!
F(21):
!<PERMS
! %INTEGERFN PERMS(%STRING(6)USER)
! Lists any non default permissions on the users files and index
!>
RES(IPERMS(SPROMPT(USER)))
RETURN
!
!
!
F(22): ! PRG
!<PRG
! %EXTERNALINTEGERFN DPRG(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, %STRING(6)LABEL, %INTEGER SITE)
!
!This procedure, available only to privileged processes, moves the
!contents of file FILE belonging to user USER 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 site
!X'380').
!
!Note 2 applies.
!
!Possible error results: 2, 5, 27, 30, 32, 37
!>
RES(DPRG(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
SPROMPT(LABEL), IPROMPT(SITE)))
RETURN
!
!
!
F(23): ! PROCS
!<PROCS
! Describes the active processes, as seen by Director
!>
RES(IDPROCS)
RETURN
!
!
!
F(24):
!<RENAME
! %EXTERNALINTEGERFN DRENAME(%STRING(6)USER,
! %STRING(11)OLDNAME, NEWNAME, %INTEGER FSYS)
!
!The file of name OLDNAME belonging to user USER on disc-pack FSYS is
!renamed NEWNAME.
!
!Note 1 applies.
!Note 2 applies.
!
!A file may not be renamed while it is connected in any virtual
!memory.
!
!Possible error results: 5, 11, 16, 17, 18, 32, 40
!>
!%EXTERNALROUTINE KRENAME(%STRING(255)S)
RES(DRENAME(SPROMPT(USER), SPROMPT(FROMF), SPROMPT(TOF), IPROMPT(FSYS)))
RETURN ; !%END
!
!
!
F(25): ! RENAME INDEX
!<RENAMEINDEX
!>
RES(DRENAMEINDEX(SPROMPT(OLDNAME), SPROMPT(NEWNAME), IPROMPT(FSYS)))
RETURN
!
!
!
F(26): ! RESTORE
!<RESTORE
EXTERNALINTEGERFNSPEC DRESTORE(STRING (6)USER, STRING (11)FILE,
STRING (8)DATE, INTEGER FSYS, TYPE)
!
!This procedure passes a restore request (if FILE exists on archive
!storage and is permitted to the caller) to VOLUMS. DATE may be left
!null, when the most recently archived copy of FILE will be
!restored. The file is restored into the file owner's on-line
!index. TYPE is currently ignored and should be set to zero.
!
!Possible error results: 8, 15, 16, 32, 37, 59, 75
!>
RES(DRESTORE(SPROMPT(USER), SPROMPT(FILE), SPROMPT(DATE),
IPROMPT(FSYS), IPROMPT(TYPE REST)))
RETURN
!
!
!
F(27): ! SET PASSWORD
!<SETPASSWORD
!>
RETURN
!
!
!
F(28):
!<SFI
! %EXTERNALINTEGERFN DSFI(%STRING(6)USER, %INTEGER FSYS, TYPE, SET, ADR)
!
! (Etymology: SFI - System File Information)
!
! This procedure is used to set or read information in the file index
! of USER on disc-pack FSYS. TYPE specifies which data item is to be
! referenced (see list below). SET must be 1 to write the data item
! into the index, or 0 to read the item from the index. ADR is the
! address of an area, which must be available in write or read mode,
! to or from which the data item is to be transferred.
!
! Note 1 applies.
! Note 2 applies.
!
! TYPE Data item Data type & size
!
! 0 BASEFILE name (the file to be connected
! and entered at process start-up) string(31)
!
! 1 DELIVERY information (to identify string(31)
! slow-device output requested by the
! index owner)
!
! 2 CONTROLFILE name (a file for use by the
! subsystem for retaining control information) string(31)
!
! 3 ADDRTELE address and telephone number of user string(63)
!
! 4 INDEX USE (may not be reset)
! Gives (in successive integers from ADR):
! a) number of files
! b) number of file descriptors currently in use
! c) number of free bytes currently available
! for file descriptors (allow say 32 per new
! file descriptor)
! d) index size (Kbytes)
! e) 4 (maxcells, freecells) pairs, each com-
! prising 2 integers, unused pairs are zero 12xinteger
!
! 5 Foreground and background passwords
! (reading is a privileged operation), a zero
! value means "do not change" 2xinteger
!
! 6 Date last logged-in: (Y-70)<<9 ! (M<<5) ! D and
! date last started (non-interactive) (same)
! (may not be reset) 2xinteger
!
! 7 ACR level at which the process owning this
! index is to run (may be set only by privileged
! processes) integer
!
! 8 Director Version (may be set only by privileged
! processes) 2xinteger
!
! 9 ARCHIVE INDEX USE (may not be reset)
! Gives (in successive integers from ADR):
! a) number of files
! b) number of file descriptors currently in use
! c) number of free bytes currently available
! for file descriptors (allow say 32 per new
! file descriptor)
! d) index size (Kbytes)
! e) 4 (maxcells, freecells) pairs, each com-
! prising 2 integers, unused pairs are zero 12xinteger
!
! 10 Stack size (Kbytes) integer
!
! 11 Limit for total size of all files in disc
! storage (Kbytes) (may be set only by privileged
! processes integer
!
! 12 Maximum file size (Kbytes) (may be set only by
! privileged processes) integer
!
! 13 Current numbers of interactive and batch
! processes, respectively, for the user (may
! not be reset) 2xinteger
!
! 14 Process concurrency limits (may be set only
! by privileged processes). The three words denote
! respectively the maximum number of interactive, batch
! and total processes which may be concurrently running
! for the user. (Setting the fields to -1 implies
! using the default values, currently 1, 1 and 1.) 3xinteger
!
! 15 When bit 2**0 is set, TELL messages to the index owner are
! rejected with flag 48. integer
!
! 16 Set Director monitor level (may be set only
! by privileged processes) 2xinteger
!
! 17 Set SIGNAL monitor level (may be set only
! by privileged processes) integer
!
! 18 Initials and surnames of user (may
! be set only by privileged processes) string(31)
!
! 19 Director monitor file string(31)
!
!METERING INFORMATION (cumulative over process sessions
! except where shown)
!
! 20 Thousands of instructions executed, interactive
! and batch modes (may be reset only by
! privileged processes) 2xinteger
!
! 21 Thousands of instructions executed (current
! session only) integer
!
! 22 Thousands of instructions executed in Director
! procedures (current process session only)
! (may not be reset) integer
! 23 Page-turns, interactive and batch modes
! (may be reset only by privileged processes) 2xinteger
!
! 24 Page-turns (current process session only)
! (may be reset only by privileged processes) integer
!
! 25 Thousands of bytes output to slow-devices
! (local or remote) (may be reset only by
! privileged processes) integer
!
! 26 Thousands of bytes input from slow-devices
! (local or remote) (may be reset only by
! privileged processes) integer
!
! 27 Milliseconds of OCP time used, interactive
! and batch modes (may be reset only by
! privileged processes) 2xinteger
!
! 28 Milliseconds of OCP time used (current
! session only) integer
!
! 29 Seconds of interactive terminal connect time
! (may be reset only by privileged processes) integer
!
! 30 No. of disc files, total disc Kbytes, no. of
! cherished files, total cherished Kbytes, no.
! of temporary files, total temporary Kbytes
! (cannot be reset) 6xinteger
!
! 31 No. of archive files, total archive Kbytes 2xinteger
!
! 32 Interactive session length in minutes integer
! 0 or 5 <= x <= 240
!
! 33 Funds integer
!
! 34 The FSYS of the Group Holder of the index owners integer
! funds, if he has a GH
!
! 35 Test BASEFILE name string(31)
!
! 36 Batch BASEFILE name string(31)
!
! 37 Group Holder of funds for scarce resources string(6)
!
! 38 Privileges integer
!
! 39 Default LP string(15)
!
! 40 Dates passwords last changed 2xinteger
! (may not be reset)
!
! 41
!
! 42
!
! 43 Mail count integer
! (may be reset only by privileged processes)
!
!
! Possible error results: 8, 37, 45
!
!
!>
RES(DSFI(SPROMPT(USER), IPROMPT(FSYS), IPROMPT(TYPEDSFI),
IPROMPT(SETDSFI), ADRDSFI))
IF RESULT = 0 = IP(4) START
X = NI(IP(3))
IF X = 0 START
PRINTSTRING(TXT(T(IP(3))))
PRINTSTRING(": ")
WRS(S0)
FINISH ELSE START
X = -X IF X < 0; ! X is the number of integers to print
CYCLE J = 0, 1, X-1
WRSNT(TXT(T(IP(3))+J).":", I(J), 3)
REPEAT
FINISH
FINISH
RETURN
F(29): ! SUBMIT
RETURN
!
!
!
F(30):
!<TRANSFER
! %EXTERNALINTEGERFN DTRANSFER(%STRING(6)USER1, USER2,
! %STRING(11)FILE1, FILE2, %INTEGER FSYS1, FSYS2, TYPE)
!
!This procedure transfers FILE1 belonging to user USER1 on FSYS1 to
!the ownership of user USER2 on FSYS2 under name FILE2.
!
!TYPE = 0 'accepts' a file which has been 'offered'. This call
! is non-privileged.
! 1 a privileged call to transfer a file.
! 2 like 1, but, in addition, forces a re-allocation of the
! disc space.
! 3 a privileged call to copy the file.
!
!Possible error results: 3, 5, 8, 15, 16, 17, 18, 32, 37
!>
RES(IDTRANSFER(SPROMPT(FROM U), SPROMPT(FROM F), IPROMPT(FROM FSYS),
SPROMPT(TO U), SPROMPT(TO F), IPROMPT(TO FSYS),
IPROMPT(TYPETR)))
RETURN
!
!
!
F(31): ! UNPRG
!<UNPRG
! %EXTERNALINTEGERFN DUNPRG(%STRING(6)USER, %STRING(11)FILE,
! %INTEGER FSYS, %STRING(6)LABEL, %INTEGER SITE)
!
!This procedure is available only to privileged processes. It
!creates a 256 Kbyte file FILE belonging to user USER on disc-pack
!FSYS and copies into it 256 Kbytes from site SITE on the EMAS 2900
!disc-pack labelled LABEL.
!
!Note 2 applies.
!
!Possible error results: 2, 5, 16, 27, 30, 32, 37
!>
RES(DUNPRG(SPROMPT(USER), SPROMPT(FILE), IPROMPT(FSYS),
SPROMPT(LABEL), IPROMPT(SITE)))
RETURN
!
!
!
F(32): ! USERS
!<USERS
! %INTEGERFN USERS(%INTEGER FSYS)
!Lists the users on fsys FSYS
!>
RES(IUSERS(IPROMPT(FSYS)))
RETURN
!
!
!
F(33): ! WHO
!<WHO
! %INTEGERFN WHO(%STRING(6)USER)
! Gives pertinent data about user USER
!>
RES(IWHO(SPROMPT(USER)))
RETURN
!
!
!
END
ENDOFFILE