EXTERNALINTEGERFNSPEC DCONNECT(STRING (6)USER, STRING (11)F, C
INTEGER FSYS, MODE, APF, INTEGERNAME SEG, GAP)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6)U, STRING (11)F, C
INTEGER FSYS, ZERO)
EXTERNALINTEGERFNSPEC DFSYS(STRING (6)USER, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DINDNO(STRING (6)USER, INTEGER FSYS, C
INTEGERNAME INDNO)
EXTERNALINTEGERFNSPEC DLOWERACR(INTEGER ACR)
EXTERNALINTEGERFNSPEC DNINDA(INTEGER FSYS, INDNO, INTEGERNAME INDAD)
SYSTEMROUTINESPEC DUMP(INTEGER A, B)
EXTERNALROUTINESPEC CLEAR(STRING (255)S)
EXTERNALROUTINESPEC DEFINE(STRING (255)S)
EXTERNALROUTINESPEC PROMPT(STRING (255)S)
CONSTINTEGER ENDLIST = 255
CONSTINTEGER OLDGE = 4
CONSTSTRING (15)ARRAY FNS(0:7) = "DREPLACE","DINDEX2", C
"DFSYS", "SETIND2", "DINDNO", "DOARCHI", "DNINDA", "DOPROCI"
!
!TITLE Record Formats
!
! This chapter contains the record formats used by Director. Where
! appropriate, the fields are described. The record formats are
! given in alphabetical order. There are also the following constants:
!
constinteger ISEPCH = '@'; conststring (1) ISEP = "@"
constinteger NSEPCH = ':'; conststring (1) NSEP = ":"
!
!STOP
!<AFDF
recordformat c
AFDF (string (11)NAME, integer TSN,
halfinteger PGS, DATE, LAST RESTORE,
byteinteger S0, S1, COUNT, EEP, PHEAD, TYPE,
integer CHAP)
!
! This the format of a file descriptor in archive index
!
ownrecord (AFDF)arrayformat c
AFDSF (1:32768)
!
! This is the format of the record array
!>
!<COMF
!
! This is the Supervisor Communications Record Format, defined in EMAS
! 2900 Supervisor Note 15.
!
recordformat c
CDRF(byteinteger DAP NO, DAP BLKS, DAP PROCESS, DAP STATE,
integer DAP1, DAP INT)
!
recordformat c
COMF(integer OCPTYPE, IPLDEV, SBLKS, SEPGS,
NDISCS, DLVNADDR, GPCTABSIZE, GPCA,
SFCTABSIZE, SFCA, SFCK, DIRSITE,
DCODEDA, SUPLVN, TOJDAY, DATE0,
DATE1, DATE2, TIME0, TIME1,
TIME2, EPAGESIZE, USERS, CATTAD,
SERVAAD, byteinteger NSACS, RESV1, SACPORT1, SACPORT0,
NOCPS, RESV2, OCPPORT1, OCPPORT0,
integer ITINT,
CONTYPEA, GPCCONFA, FPCCONFA, SFCCONFA,
BLKADDR, RATION, SMACS, TRANS,
longinteger KMON, integer DITADDR, SMACPOS,
SUPVSN, PSTVA, SECSFRMN, SECSTOCD,
SYNC1DEST, SYNC2DEST, ASYNCDEST, MAXPROCS,
KINSTRS, ELAPHEAD, COMMSRECA, STOREAAD,
PROCAAD, SFCCTAD, DRUMTAD, TSLICE,
FEPS, MAXCBT, PERFORMAD,
record (CDRF)array CDR(1 : 2),
integer LSTL, LSTB, PSTL,
PSTB, HKEYS, HOOT, SIM,
CLKX, CLKY, CLKZ, HBIT,
SLAVEOFF, INHSSR, SDR1, SDR2,
SDR3, SDR4, SESR, HOFFBIT,
BLOCKZBIT, BLKSHIFT, BLKSIZE, END)
!
constrecord (COMF)name COM = X'80000000' + 48 << 18
!>
!<DDTF
!
! The Disc Device Table Format, described in EMAS 2900 Supervisor
! Note 18.
!
recordformat c
DDTF(integer SER, PTS, PROPADDR, STICK,
CCA, RQA, LBA, ALA,
STATE, IW1, CONCOUNT, SENSE1,
SENSE2, SENSE3, SENSE4, REPSNO,
halfinteger SBASE, BASE, integer ID, DLVN, MNEMONIC,
string (6) LAB, byteinteger MECH)
!
ownbyteintegerarrayformat DLVNAF(0:99)
!>
!<DIRCOM
! On the IPL disc, the first X'900 pages are not covered by the 'BITMAP'
! this means that as many bits (=288 bytes) may be used for other
! purposes. All discs have X'140 bits (40 bytes) available. The
! remaining 248 bytes are described by this format. The address of the
! record is given by SYSAD(DIRCOMKEY, -1).
!
constinteger DIRCOM KEY = 5
constinteger DIRCOMSIZE = 80
!
recordformat c
DIRCOMF(integer DIRLOG SEMA, FEP SEMA,
{..8} string (6)DAP SOLE USER1, DAP SOLE USER2,
{.22} byteinteger B1, CLAIMQ LIMIT,
{.24} integer DAP BATCH LIMIT, DAP INTER LIMIT,
{.32} integer SUBSYS SITE COUNT, string (19)DEFAULT SUBSYS,
{.56} integer STUDENT SITE COUNT, string (19)DEFAULT STUDENT,
{.80} string (6)DAP BATCH USER1, DAP BATCH USER2)
{.8E}
!>
!<DISCDATAF
!
recordformat c
DISCDATAF(integer START, BITSIZE, NNTSTART, NNTSIZE,
NNTTOP, NNTHASH, INDEXSTART, FILESTART,
END)
!
! This format is used in the procedure FBASE2 to return a record giving
! addresses and lengths of the various parts of the disc.
!
! START indicates whether an IPL disc or not, value X40 or X800
!
! BITSIZE size of the bitmap, X1000, X2000 or X5000
!
! NNTSTART where the NNT starts
!
! NNTSIZE the size of the name-number table, X1000, X2000 or X4000
!
! NNTTOP the NNT is a record array declared 0:n, this is n: 340, 681 or 1364
!
! NNTHASH the largest prime less than NNTTOP, 331, 677 or 1361
!
! INDEXSTART the total number of pages used for bitmaps and NNTs
!
! FILESTART the number of pages used for bitmaps, NNTs and indexes
!
! END the highest numbered page
!>
!<FDF
!
recordformat c
FDF (string (11)NAME,
integer SD,
halfinteger PGS, PREFIX,
byteinteger CODES, CODES2, DAYNO, USE,
OWNP, EEP, PHEAD, ARCH,
CCT, SSBYTE, S0, S1)
!
! This the format of a file descriptor in an online file index
!
!
!
!
! Note:
!
! CODES CODES2
! 1 unava wrconn
! 2 offer
! 4 temp oldgen
! 8 vtemp wsallow
! 16 chersh comms ???
! 32 privat disc ???
! 64 violat stack ???
!128 noarch dead ???
!
!
constinteger FDSIZE = 32
!
ownrecord (FDF)arrayformat c
FDSF (1:32768)
!>
!<FF
recordformat c
FF (integer SDSTART, PDSTART, FDSTART, SEMA,
RESERVE1, RESERVE2, SEMANO, RESTORES,
string (6)OWNER, byteinteger SIZE, string (11)NAME,
byteinteger FSYS, FIPHEAD, TEMPFILES, EEP,
integer FILES, MAXFILE, MAXKB, CHERFILES,
CHERKB, TOTKB, TEMPKB, CHKSUM,
FILES0, FILES1, AFILES, ATOTKB,
ASEMA,
byteinteger ATTRIBUTES, DAY42)
! only 26 more bytes spare
! PDSTART etc Add to FINDAD to get addr of array
! FILES Number of usable files, ie not 'oldgens'
!>
!<HH
recordformat c
HF (string (6)OWNER, byteinteger MARK,
integer SPARE1, MSGSEMA,
SPARE2, SPARE3, INUTS, IINSTRS,
byteinteger ACR, DIRVSN, SIGMON, PASSFAILS,
IMAX, BMAX, TMAX, STKKB,
IUSE, BUSE, ISESSM, GPFSYS,
FSYS, SB0, SB1, TYPE,
integer TOP, DWSPK, BWSPK, BINSTRS,
TRYING, DINSTRS, IPTRNS, BPTRNS,
IMSECS, BMSECS, NKBIN, NKBOUT,
MAIL COUNT, CONNECTT, DIRMON, LASTLOGON,
LAST NON INT START, TELL REJ, DWSPDT, BWSPDT,
SPARE4, SPARE5, DAPSECS, SI3,
longinteger DWSP, BWSP,
string (6)GPHOLDR,
string (31)SURNAME, DELIVERY,
string (18)BATCHSS, BASEFILE, STARTF, TESTSS,
string (11)LOGFILE, MAIN,
string (15)DEFAULTLP,
string (63)DATA,
string (6)SUPERVISOR,
string (15)GATEWAY ACCESS ID)
!>
!<Logfile formats
constinteger TOPLOG = 5
constinteger TOP FE NO = 7
constinteger NSI = 0
constinteger X25 = 1
constinteger FEP IO BUFF SIZE = 2048; ! bytes in each control buffer
constinteger MAXTCPNAME = 15 {TCP-name length}
{Kent TCP names have max 15 chars).
recordformat c
FEP DETAILF(integer INPUT STREAM, OUTPUT STREAM,
IN BUFF DISC ADDR, OUT BUFF DISC ADDR,
IN BUFF DISC BLK LIM, OUT BUFF DISC BLK LIM,
IN BUFF CON ADDR, OUT BUFF CON ADDR,
IN BUFF OFFSET, OUT BUFF OFFSET, IN BUFF LENGTH, OUT BUFF LENGTH,
INPUT CURSOR, OUTPUT CURSOR)
!
recordformat c
FEPF(record (FEP DETAILF)array FEP DETAILS(NSI:X25), integer AVAILABLE)
!
recordformat c
LF(string (11)NAME, integer FSYS, DISC ADDR, STATE)
!
recordformat C
PROCDATF(string (6)USER, string (MAXTCPNAME)TCPNAME, byteinteger LOGKEY,
byteinteger INVOC, PROTOCOL, NODENO, FSYS,
integer LOGSNO,
byteinteger SITE, REASON, CONSOLE1, CONSOLE2,
integer ID, PROCESS, PREV WARN, SESSEND,
byteinteger GETMODE, PREEMPT, BLNK, LINK)
!
recordformat c
LOGF HDF(integer LOGMAPST,SPARE0,
byteinteger FREEHD,LIVEHD,BACKHD,SPARE,
integer FES FOUND,
byteintegerarray FE USECOUNT(0:TOP FE NO),
record (LF)array LOGS(0:TOPLOG),
record (FEPF)array FEPS(0:TOP FE NO),
record (PROCDATF)array PROCLIST(0:255),
integer LEND)
!
recordformat c
TMODEF(halfinteger FLAGS1, FLAGS2,
{.04} byteinteger PROMPTCHAR, ENDCHAR,
{.06} bytearray BREAKBIT1(0:3) {%or %halfintegerarray BREAKBIT2(0:1))} ,
{.0A} byteinteger PADS, RPTBUF, LINELIMIT, PAGELENG,
{.0E} byteintegerARRAY TABVEC(0:7),
{.16} byteinteger CR, ESC, DEL, CAN,
{.1A} byteinteger FLAGS, INTERNAL STATE, LEADIN1, LEADIN2, XLO, XHI)
{.20}
!>
!<NNF
recordformat c
NNF(string (6)NAME, byteinteger KB, TAG, MARKER, halfinteger INDNO)
!>
!<PARMF
!
! The standard format for system messages
recordformat c
PARMF(integer DEST, SRCE,
(integer P1, P2, P3, P4, P5, P6 or string (23)S))
!>
!<PDF
recordformat c
PDF (string (6)NAME, byteinteger PERM, LINK)
!
constinteger PDSIZE = 9
!
ownrecord (PDF)arrayformat PDSF(1:512)
!>
!<SDF
! %recordformat SDF(13-bit LINK, 19-bit DA)
ownintegerarrayformat SDSF(1:8191)
!>
!<UINFF
recordformat c
UINFF (string (6)USER, string (31)JOBDOCFILE,
{.28} integer MARK, FSYS,
{.30} PROCNO, ISUFF, REASON, BATCHID,
{.40} SESSICLIM, SCIDENSAD, SCIDENS, STARTCNSL,
{.50} AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST,
{.60} ASYNC DEST, AACCT REC, AIC REVS,
{.6C} string (15)JOBNAME,
{.7C} string (31)BASEFILE,
{.9C} integer PREVIC,
{.A0} ITADDR0, ITADDR1, ITADDR2, ITADDR3,
{.B0} ITADDR4, STREAM ID, DIDENT, SCARCITY,
{.C0} PREEMPTAT, string (11)SPOOLRFILE,
{.D0} integer FUNDS, SESSLEN, PRIORITY, DECKS,
{.E0} DRIVES, PART CLOSE,
{.E8} record (TMODEF)TMODES,
{108} integer PSLOT,
{10C} string (63)ITADDR,
{14C} integerarray FCLOSING(0:3), integer CLO FES,
{160} integer OUTPUT LIMIT, DAPSECS, longinteger DAPINSTRS,
{170} integer OUT, string (15)OUTNAME,
{184} integer HISEG,
{188} string (31)FORK,
{1A8} integer INSTREAM, OUTSTREAM,
{1B0} integer DIRVSN,
integer UEND)
ENDOFLIST
!
!
!
! USER The six-character name of the process owner.
!
! JOBDOCFILE For a batch process (see REASON) the name of a file
! containing commands to be executed.
!
! MARK Currently 1, to be used in achieving forward
! compatibility if this record format is to be
! drastically changed.
!
! FSYS The file system (disc number) on which the user's
! file index and files reside.
!
! PROCNO The process number.
!
! ISUFF The "invocation number" for the process. This number
! is appended to the names of workfiles so that, in the
! case of multiple invocations of a process, each
! invocation uses a unique set of names.
!
! REASON This gives the reason for the creation of the
! process:
!
! 0 = interactive log-on
! 1 = started from an OPER console
! 2 = started as a batch (non-interactive) process by
! SPOOLR.
! 3 = test process
! 4 = D/NEWSTART from OPER console
!
! BATCH ID A unique integer identifier associated with the
! batch job (for REASON=2).
!
! SESS IC LIM The maximum number of thousands of machine
! instructions which may be executed during the
! current session by the process. For interactive
! sessions this is currently a very large number. For
! batch sessions it is a number given when a job is
! submitted to the SPOOLR process for queuing and
! subsequent execution. If this limit is reached by
! the process, it is terminated with a message at the
! main Oper console:
!
! SIGNAL FAIL 4
!
! A subsystem should preferably guard against this
! occurrence by keeping an eye on the number of
! instructions executed in the current session, using
! Director procedure DSFI (TYPE=21).
!
! SC IDENS AD, These are used to acquire access to the Director
! SC IDENS procedures, as described in Chapter 4.
!
! STARTCNSL Gives the logical number of the Oper console from
! which the process was started (for REASON=1).
!
! AIOSTAT The address of a record describing interactive I/O
! status. The format of the record is:
!
! (integer IAD, string(15) INTMESS,
! integer INBUFLEN, OUTBUFLEN, INSTREAM, OUTSTREAM)
!
! SCT DATE This may be used in conjunction with SC IDENS AD and
! SC IDENS.
!
! SYNC1 DEST The three service numbers allocated by the
! SYNC2 DEST Supervisor to the local process (see Ref. 10).
! ASYNC DEST
!
! AACCTREC The address of a record, visible at ACR 15, of
! format:
!
! (longinteger MICROSECS, integer PTURNS, KINSTRS)
!
! The MICROSECS field holds the number of microseconds
! of OCP time used by the process.
!
! The KINSTRS field of this record contains the number
! of K instructions (1K=1024) executed during the
! current session, it is updated only at calls of
! certain Director functions.
!
! The PTURNS field contains the total number of page
! turns performed on behalf of the process.
!
! AICREVS The address of a word containing the number of
! "revolutions" of the IC machine register (or
! "IC-register-fulls") to be expended (in addition to
! the current value of the IC register) before an
! instruction-counter interrupt is given to the user
! process.
!
! The fields above may be used to determine a number of K instructions
! executed during the current session using the formula:
!
! AACCTREC_KINSTRS + (UINF_PREVIC - GETIC)
!
! where GETIC is
!
! (Image store 6)>>10 + integer(UINF-AICREVS)<<14
!
! (with certain modifications depending on the state of the IC carry
! bit).
! JOBNAME A character string identifier associated with the
! batch job when it was submitted to the SPOOLR
! process (for REASON=2).
!
! BASEFILE NAME The name of the basefile in use by the process.
!
! PREVIC The value of the current instruction-execution limit
! (in K instructions) at the time the KINSTRS field in
! the ACCT REC field was last updated.
!
!
!
! ITADDR0-4 Reserved for a full network address of the process's
! interactive terminal.
! STREAM ID
!
! D IDENT
!
!
! SCARCITY The number of users on the System at and above
! which the machine resource is deemed to be scarce
! (the funds field of the process owner's index header
! is decremented according to the local charging
! formula for interactive sessions while the number of
! System users is greater than or equal to this value)
! This value is kept in the RATION field of the COM
! record (in public segment 48), see below.
!
! PREEMPT AT The number of users on the System at and above which
! an interactive user currently having no funds
! is eligible for pre-emption (i.e. automatic
! logging-off) by interactive users with positive
! funds. This value is also kept in
! the RATION field in the COM record (in public
! segment 48).
!
!
! The four bytes of the integer COM_RATION hold the following data
! (most significant byte = byte zero):
!
! 0 number of interactive users at and above which
! resources for interaction are deemed to be scarce
! (SCARCITY)
!
! 1 number of interactive users at and above which a
! user having no scarce resource units may be pre
! -empted (logged off with 5 minutes' warning)
! because a new user with some scarce-resource units
! has logged on (PREEMPT A)
!
! 2 spare (zero)
!
! 3 current number of interactive processes
!
! These values should be used in preference to those in the UINF
! record, the fields in UINF are to be withdrawn.
!
!
! SPOOLR FILE is used by Director during batch process
! start up and has no subsequent relevance
!
! FUNDS the current number of funds
! held by the process owner (or his group-holder)
! This field is relevant only when resources are
! deemed to be scarce.
! SESSLEN is the limit in minutes of the session, i.e. the
! maximum duration of the process in elapsed minutes.
! A value of zero implies no limit. Relevant only for
! interactive sessions.
!
! PRIORITY For a batch job, the priority as specified by the
! user:
! 1 = very low
! 2 = low
! 3 = standard
! 4 = high
! 5 = very high
!
! DECKS The number of tape decks to be available to this
! (batch) job.
!
! DRIVES The number of disc drives to be available to this
! (batch) job.
!
! PARTCLOSE Set -1 at process startup if a partial close is in
! force otherwise zero.
!
! TMODES Describes the terminal characteristics. This record
! is zero until a DGETMODE has been issued.
! Subsequently it contains data from the TCP.
!
! UEND marks the end of the record.
!>
LIST
!>
!
!---------------end-of-included-file-------------------------------------
!
!
!
INTEGERFN STOI(STRING (255)S, INTEGERNAME I)
STRING (63)P
INTEGER TOTAL, SIGN, AD, J, HEX
HEX = 0
TOTAL = 0
SIGN = 1
AD = ADDR(P)
A: IF S -> P.(" ").S AND P="" THEN -> A; !CHOP LEADING SPACES
IF S -> P.("-").S AND P="" THEN SIGN = -1
IF S -> P.("X").S AND P="" 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 C
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 I = SIGN*TOTAL AND RESULT = 0
FAULT:
I = 0
RESULT = 1
END
ROUTINE RSTRG(STRINGNAME S)
INTEGER I
S = ""
CYCLE
READSYMBOL(I)
IF I = NL START
RETURN UNLESS S = ""
FINISH ELSE S = S . TOSTRING(I)
REPEAT
END
ROUTINE RDINT(INTEGERNAME I)
STRING (255)S
CYCLE
RSTRG(S)
RETURN IF STOI(S, I) = 0
REPEAT
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
!
!
EXTERNALROUTINE PROBE(STRING (255)USER); ! ******************* PRI ***************
!
!
!
INTEGER LINES
RECORD (PDF)ARRAYNAME PDS
RECORD (FDF)ARRAYNAME FDS
RECORD (FDF)ARRAYFORMAT FDSF(1:32768)
INTEGERARRAYNAME SDS
!
!
INTEGER J, NPDS, NSDS
!
!
ROUTINE NL
LINES = LINES + 1
NEWLINE
END
!
!
!
STRING (8)FN HTOS(INTEGER VALUE, PLACES)
STRING (8)S
INTEGER I
CONSTBYTEINTEGERARRAY HEX(0:15) = C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
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'; ! SET CC=1
*SUPK_L =8
*LD_TOS ; *ANDS_L =8,0,15; ! THROW AWAY ZONE CODES
*LSS_HEX+4; *LUH_X'18000010'
*LD_TOS ; *TTR_L =8
RESULT = S
END ; ! OF HTOS
!
!-----------------------------------------------------------------------
!
ROUTINE WSS(STRING (255)S1, S2)
PRINTSTRING(S1)
PRINTSTRING(": ")
PRINTSTRING(S2)
PRINTSTRING(" ")
END
!
!
ROUTINE WSN(STRING (255)S1, INTEGER N, P)
!
! P=0 decimal
! >0 hex to P places
PRINTSTRING(S1)
PRINTSTRING(": ")
IF P = 0 C
THEN WRITE(N, 1) C
ELSE PRINTSTRING("X".HTOS(N, P))
PRINTSTRING(" ")
END
!
!
!
ROUTINE WN(INTEGER N, P)
PRINTSTRING(" X" . HTOS(N, P))
END
!
!
!
ROUTINE PERMS(INTEGER P, NPD)
INTEGER N
INTEGER PERM, LINK
STRING (255)NAME
RECORD (PDF)PD
RETURN IF P = 0; ! no permissions
WSS("permissions","")
NL
N = 0
WHILE P > 0 CYCLE
N = N + 1; ! count perms
NPDS = NPDS + 1
IF P < NPD START
PD = PDS(P)
NAME = PD_NAME
PERM = PD_PERM
LINK = PD_LINK
WSS(" name", NAME)
WSN(" perm", PERM, 0)
P = LINK
FINISH ELSE START
WSN("------INVALID LINK", P, 0)
P = 0
FINISH
PRINTSTRING("**** > 16 permissions") IF N > 16
NL
RETURN IF N > 16
REPEAT
END
!
!
!
STRINGFN UNCDT(INTEGER I)
STRING (3) D,M
D=ITOS(I&31)
IF LENGTH(D)=1 THEN D="0".D
M=ITOS((I>>5)&15)
IF LENGTH(M)=1 THEN M="0".M
RESULT =D."/".M."/".ITOS(70+(I>>9)&63)
END ; ! UNCDT
!
!
!
stringfn I TO TSN(integer TSN)
integer J, CH
LONGINTEGER LTSN, T
string (6)S
*LSS_TSN
*LUH_0
*ST_LTSN
!
cycle J = 6, -1, 1
T = LTSN // 36
CH = SHORTENI(LTSN - 36 * T)
if CH<10 then CH=CH+'0' else CH=CH+55
CHARNO(S, J) = CH
LTSN = T
repeat
LENGTH(S) = 6
result = S
end ; ! I TO TSN
!
!
INTEGER ARCH, SEG, GAP
INTEGER I, FINDAD, NFD, NSD, NPD, D, NON NULL, N, E
RECORD (HF)NAME H
RECORD (FF)NAME F
RECORD (FDF)NAME FD
RECORD (AFDF)NAME AFD
INTEGER INDAD, INDNO, FN, FSYS
STRING (15)W
CONSTSTRING (255)FHDR = " Name SD Pgs C C2 Day Use Own Eep P Arch CCT"
CONSTSTRING (255)AHDR = " Name Kb Date LastRest TSN Chap Cnt Eep T"
LINES = 12
ARCH = 0
!
D = 0
D = 1 IF USER -> USER . (",") . W
!
IF USER = "" START
PROMPT("User: ")
RSTRG(USER)
FINISH
!
FN = 2
PROMPT("Fsys: ")
RDINT(FSYS)
J = DFSYS(USER, FSYS)
-> OUT UNLESS J = 0
!
FN = 4
J = DINDNO(USER, FSYS, INDNO)
-> OUT UNLESS J = 0
!
FN = 6
J = DNINDA(FSYS, INDNO, INDAD)
-> OUT UNLESS J < 1
!
DEFINE("61,T#OUT,1023")
SELECT OUTPUT(61)
!
H == RECORD(INDAD)
WSS("PROCESS INDEX FOR", H_OWNER)
WSN("MARK", H_MARK, 0)
NL
!
-> CLOSE UNLESS H_MARK = 1
!
IF D = 1 START
F == RECORD(INDAD + 512)
DUMP(INDAD, INDAD+512+F_SIZE<<9)
-> CLOSE
FINISH
!
J = DLOWERACR(2)
WSN("MSGSEMA", H_MSGSEMA, 0)
NL
!
WSN("INUTS", H_INUTS, 0)
WSN("IINSTRS", H_IINSTRS, 0)
NL
!
WSN(" ACR", H_ACR, 0)
WSN("DIRVSN", H_DIRVSN, 0)
WSN("SIGMON", H_SIGMON, 8)
WSN("PASSFAILS", H_PASSFAILS, 0)
NL
!
WSN(" IMAX", H_IMAX, 0)
WSN("BMAX", H_BMAX, 0)
WSN("TMAX", H_TMAX, 0)
NL
!
WSN(" IUSE", H_IUSE, 0)
WSN("BUSE", H_BUSE, 0)
WSN("ISESSM", H_ISESSM, 0)
WSN("GPFSYS", H_GPFSYS, 0)
NL
!
WSN(" TOP", H_TOP, 0)
WSN("BINSTRS", H_BINSTRS, 0)
NL
!
WSN(" TRYING", H_TRYING, 8)
WSN("DINSTRS", H_DINSTRS, 0)
WSN("IPTRNS", H_IPTRNS, 0)
WSN("BPTRNS", H_BPTRNS, 0)
NL
!
WSN(" IMSECS", H_IMSECS, 0)
WSN("BMSECS", H_BMSECS, 0)
WSN("NKBIN", H_NKBIN, 0)
WSN("NKBOUT", H_NKBOUT, 0)
NL
!
WSN(" CONNECTT", H_CONNECTT, 0)
WSN("DIRMON", H_DIRMON, 8)
WSN("LASTLOGON", H_LASTLOGON, 8)
NL
!
WSS(" GPHOLDR", H_GPHOLDR); NL
WSS(" SURNAME", H_SURNAME); NL
WSS(" DELIVERY", H_DELIVERY); NL
WSS(" BATCHSS", H_BATCHSS); NL
WSS(" BASEFILE", H_BASEFILE); NL
WSS(" STARTF", H_STARTF); NL
WSS(" TESTSS", H_TESTSS); NL
WSS(" LOGFILE", H_LOGFILE); NL
WSS(" MAIN", H_MAIN); NL
WSS(" DATA", H_DATA); NL
!
FINDAD = INDAD + 512
AGAIN:
F == RECORD(FINDAD)
!
NFD = (F_SIZE << 9 - F_FDSTART) >> 5
NSD = (F_FDSTART - F_SDSTART) >> 2
NPD = (F_SDSTART - F_PDSTART) // 9
!
PDS == ARRAY(FINDAD + F_PDSTART, PDSF)
SDS == ARRAY(FINDAD + F_SDSTART, SDSF)
FDS == ARRAY(FINDAD + F_FDSTART, FDSF)
NPDS = 0
NSDS = 0
!
IF LINES < 60 C
THEN NL AND NL AND NL C
ELSE NEWPAGE AND LINES = 0
!
WSS("FILE INDEX FOR", F_OWNER)
WSN("SIZE", F_SIZE, 0)
WSS("NAME", F_NAME)
NL
!
WSN(" FSYS", F_FSYS, 0)
WSN("FIPHEAD", F_FIPHEAD, 0)
WSN("TEMPFILES", F_TEMPFILES, 0)
WSN("EEP", F_EEP, 2)
NL
!
WSN(" PDSTART", F_PDSTART, 0)
WSN("SDSTART", F_SDSTART, 0)
WSN("FDSTART", F_FDSTART, 0)
WSN("FILES", F_FILES, 0)
NL
!
WSN(" MAXFILE", F_MAXFILE, 0)
WSN("MAXKB", F_MAXKB, 0)
WSN("CHERFILES", F_CHERFILES, 0)
WSN("CHERKB", F_CHERKB, 0)
NL
!
WSN(" TOTKB", F_TOTKB, 0)
WSN("TEMPKB", F_TEMPKB, 0)
WSN("RESTORES", F_RESTORES, 0)
WSN("CHKSUM", F_CHKSUM, 0)
NL
!
WSN(" FILES0", F_FILES0, 0)
WSN("FILES1", F_FILES1, 0)
NL
!
WSN(" NFD", NFD, 0)
WSN("NSD", NSD, 0)
WSN("NPD", NPD, 0)
NL
!
PERMS(F_FIPHEAD, NPD)
!
NL
NL
IF ARCH = 0 THEN PRINTSTRING(FHDR) ELSE PRINTSTRING(AHDR)
NL
!
CYCLE I = 1, 1, NFD
FD == FDS(I)
EXIT IF FD_NAME = ""
CONTINUE IF FD_NAME = ".NULL"
WRITE(I, 3)
SPACE
PRINTSTRING(FD_NAME)
SPACES(11-LENGTH(FD_NAME))
!
IF ARCH = 1 START
AFD == RECORD(ADDR(FD))
WRITE(AFD_PGS<<2, 4)
SPACE
PRINTSTRING(UNCDT(AFD_DATE))
SPACE
IF AFD_LAST RESTORE = 0 C
THEN SPACES(8) C
ELSE PRINTSTRING(UNCDT(AFD_LAST RESTORE))
SPACE
PRINTSTRING(I TO TSN(AFD_TSN))
WRITE(AFD_CHAP, 4)
WRITE(AFD_COUNT, 3)
WN(AFD_EEP, 2)
SPACE
PRINTSYMBOL('A' + AFD_TYPE)
NL
IF LINES > 60 START
NEWPAGE
LINES = 0
NL
PRINTSTRING(AHDR)
NL
FINISH
FINISH ELSE START
WN(FD_SD, 8)
!
N = FD_SD >> 19; ! link
WHILE N > 0 CYCLE
IF N > NSD START
PRINTSTRING("!!!!!! invalid SD link !!!!!!")
EXIT
FINISH
NSDS = NSDS + 1
N = SDS(N) >> 19
REPEAT
!
WRITE(FD_PGS, 4)
WN(FD_CODES, 2)
WN(FD_CODES2, 2)
WRITE(FD_DAYNO, 3)
WRITE(FD_USE, 3)
SPACE
WN(FD_OWNP, 2)
SPACE
WN(FD_EEP, 2)
WRITE(FD_PHEAD, 3)
SPACE
WN(FD_ARCH, 2)
WRITE(FD_CCT, 3)
NL
IF LINES > 50 START
NEWPAGE
PRINTSTRING(FHDR)
LINES = 0
NL
FINISH
FINISH
PERMS(FD_PHEAD, NPD)
REPEAT
!
NON NULL = 0
N = 0
E = 0
CYCLE I = NFD, -1, 1
FD == FDS(I)
IF FD_NAME = "" START
E = E + 1 IF NON NULL > 0
FINISH ELSE START
NON NULL = NON NULL + 1
N = N + 1 UNLESS FD_NAME = ".NULL"
FINISH
REPEAT
!
WSN("FDs used", N, 0)
IF E = 0 THEN PRINTSTRING(" no errors") ELSE WSN("errors!!!!", E, 0)
NL
!
N = 0; ! now do a PD check
CYCLE I = 1, 1, NPD
N = N + 1 IF PDS(I)_NAME = ""
REPEAT
IF NPD = N + NPDS START
PRINTSTRING("PDs OK")
WRITE(NPDS, 4)
PRINTSTRING(" used")
FINISH ELSE PRINTSTRING("PD errors !!!!")
NL
!
N = 0; ! SD check
CYCLE I = 1, 1, NSD
N = N + 1 IF SDS(I) = 0
REPEAT
IF NSD = N + NSDS START
PRINTSTRING("SDs OK")
WRITE(NSDS, 4)
PRINTSTRING(" used")
FINISH ELSE PRINTSTRING("SD errors !!!!")
NL
!
IF ARCH = 0 START
PRINTSTRING("End of main file index")
NL
SEG = 0
GAP = 0
J = DCONNECT(USER, "#ARCH", FSYS, 1, 0, SEG, GAP)
IF J = 0 OR J = 34 START
FINDAD = SEG << 18
ARCH = 1
-> AGAIN
FINISH
WSN("Connect #ARCH gives ", J, 0)
NL
FINISH
!
J = DDISCONNECT(USER, "#ARCH", FSYS, 0) IF ARCH = 1
!
CLOSE:
PRINTSTRING("PRI complete")
NEWLINE
SELECT OUTPUT(0)
CLOSE STREAM(61)
CLEAR("61")
PRINTSTRING("T#OUT written")
RETURN
OUT:
WSN(FNS(FN), J, 0)
END ; ! PRINT INDEX
!
ENDOFFILE