! 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
!>
%CONTROL 0
%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)
      %DYNAMICROUTINESPEC %C
GETAVFSYS(%INTEGERNAME N, %INTEGERARRAYNAME A)
      %DYNAMICINTEGERFNSPEC %C
GETUSNAMES(%INTEGERNAME N, %INTEGER ADR, FSYS)
      %DYNAMICINTEGERFNSPEC %C
DRETRIEVE(%STRING(6)TAPE,%INTEGER CHAPTER)
      %DYNAMICROUTINESPEC %C
PROMPT(%STRING(255)S)
      %SYSTEMROUTINESPEC %C
UCTRANSLATE(%INTEGER ADR, LEN)
      %EXTERNALSTRINGFNSPEC %C
UINFS(%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 TAPEID  = 36
%CONSTINTEGER CHAPID  = 37
!
! each entry gives: prompt ! default ! helptext
!
%CONSTSTRING(80)%ARRAY TABLE(1:37) = %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: !!",
"Tape:    !!Tape ID as found by SS Filenames",
"Chapter: !!Chapter as found by SS Filenames"
!
!
!
%CONSTINTEGER TOPFN = 36
%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",
"QUIT",
"Q",
"RETRIEVE"
!
!
!
%CONSTINTEGER TOPDSFI = 39
!
%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
!
%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
!
%CONSTSTRING(15)%ARRAY TXT(0:74) = %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"
!
!
!
%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:11)
%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
!
!
!
%ONEVENT 1,2,3,4,5,6,7,8,9 %START
   %STOP
%FINISH
!
!
!
!

%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
!
!
%STRINGFUNCTION CURCODEFILE
!   Returns the name of the object file which called this function.
   %INTEGER AD
   %SYSTEMSTRINGFUNCTIONSPEC CONFILE(%INTEGER AD)
   *LSS_(%LNB+2)
   *ST_AD
   %RESULT=CONFILE(AD)
%END                                   ; ! of string function CURCODEFILE
%STRINGFUNCTION CURCODE
!   Returns the name of the current object file as username.filename,
!   omitting _membername if it is a PDfile member
   %STRING(23)S,SS
   S=CURCODEFILE
   S=S%IF S->S.("_").SS
   %RESULT=S
%END                                   ; ! of string function 'CURCODE'
!
%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 = "" %C
         %THEN WRS(" there is no default") %C
         %ELSE %START
            WRS(" default is " . GIVEDEFAULT(D))
         %FINISH
         %RETURN
      %FINISH
!
      S -> ("*") . W
      J = STOI2(W, N)
      %RETURN %UNLESS J = 0 %AND 0 < N <= TOPSW
      -> SW(N)
SW(1):
      ZVIEW(CURCODE.",SOURCE")
      %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")
%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)
%STRING(15)MODE, U0
%INTEGERARRAY FLD(0:15)
%STRINGNAME U1, S
%INTEGERNAME I1
%BYTEINTEGERARRAY UNAMES(0:2400)
!
      %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
!
            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
            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:2400)
      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 FS)
%EXTERNALSTRINGFNSPEC VDUS(%INTEGER N)
%INTEGER N, F, C
%INTEGERARRAY FSYS(0:99)
      GET AV FSYS(N, FSYS)
      C = 0
      %CYCLE F = 0, 1, N-1
         J = DFSYS(USER, FSYS(F))
         %RESULT = J %IF 0 # J # 37
!
         %IF J = 0 %START
            %IF C = 0 %START
               PRINTCHS(VDUS(1))
               PRINTSTRING("User: ")
               PRINTSTRING(USER)
               PRINTSTRING("    Fsys: ")
               FS = FSYS(F)
            %FINISH
            C = C + 1
            WRITE(FSYS(F), 2)
         %FINISH
      %REPEAT
!
      %RESULT = 37 %IF C = 0
      %RESULT = 0
%END
!
!
!
%SYSTEMSTRING(8)%FNSPEC UNPACKDATE(%INTEGER I)
%SYSTEMSTRING(8)%FNSPEC UNPACKTIME(%INTEGER I)
%INTEGER J, T, FSYS, AI0, K
%INTEGERARRAY INT(0:15)
%STRING(15)W
%REAL R
%STRINGNAME S
%CONSTINTEGER TYPES = 16
%CONSTBYTEINTEGERARRAY TYP(1:TYPES) = %C
      18, 1, 0, 4, 30, 11, 12, 7, 5, 13, 14, 33, 37, 40, 6, 9
%CONSTSTRING(31)%ARRAY TAG(1:TYPES) = %C
"Surname:  ", "
Delivery: ", "
Basefile: ", "
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)
!
      J = GET FSYS(USER, FSYS)
      %RESULT = J %UNLESS J = 0
      NEWLINE
!
      AI0 = ADDR(INT(0))
      S == STRING(AI0)
      %CYCLE T = 1, 1, TYPES
         J = DSFI(USER, FSYS, TYP(T), 0, AI0)
         PRINTSTRING(TAG(T))
         -> SW(T) %IF J = 0
         ERROR(J)
         -> NEXT
SW(1):
SW(2):
SW(3):
SW(13):
      PRINTSTRING(S)
      -> NEXT
SW(4):
      WRITE(INT(0), 1)
      PRINTSTRING(" files, index size")
      WRITE(INT(3)+1, 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(5):
      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(6):
SW(7):
SW(8):
      WRITE(INT(0), 1)
      -> NEXT
SW(9):
      W = "----, ++++"
      MOVE(4, AI0, ADDR(W)+1)
      MOVE(4, AI0+4, ADDR(W)+7)
      PRINTSTRING(W)
      -> NEXT
SW(10):
      WRITE(INT(0), 3)
      WRITE(INT(1), 3)
      -> NEXT
SW(11):
      WRITE(INT(0), 3)
      WRITE(INT(1), 3)
      WRITE(INT(2), 3)
      -> NEXT
SW(12):
      R = INT(0) / 10000
      PRINT(R, 1, 2)
      -> NEXT
SW(14):
SW(15):
      %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(16):
      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
      NEWLINE
      %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)
      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(FROMF), SPROMPT(TOF), 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
                     NEWLINE
                     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))))
            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
!
F(34):        !QUIT
F(35):        !Q
%RETURN
!
F(36):        !RETRIEVE
!<RETRIEVE 
! %EXTERNALINTEGERFN DRETRIEVE(%STRING(6)TAPE,%INTEGER CHAPTER)
! Causes the reloading of a file stored on Tape (either a private tape or one
! of the regular backup copies because a file has been Archived or Cherished).
! The file is reloaded to the owner's index with the same attributes as it 
! had when it was copied to disc (i.e. permissions, archive/cherish flags etc.)
! The Tape and Chapter can be found by DFILENAMES for EMAS Tapes.
!>
   RES(DRETRIEVE(SPROMPT(TAPEID),IPROMPT(CHAPID)))
%RETURN
!
%END
%ENDOFFILE