!MAINT14--MAINT14--MAINT14--MAINT14--MAINT14--MAINT14
!
CONSTSTRING (21) VSN= "MAINT14 Vsn 1 May 83"
!
!
!
!
!File System Maintenance Utilities
!
!
!This document describes the utilities for the maintenance and
!repair of EMAS 2900 file systems available in release 7 of MANAGR's
!file system maintenance programs. The source is held in
!MANAGR.MANPRGS_MAINT07 and the object in MANAGR.MANPRGY_MAINTY.
!A description of each utility is held in the source file which
!has been made VIEWable.
! Note that for readability some of the command names have embedded
!spaces. These must not be there when the command is called.
!Colin McCallum.
!
!
!
!
!
!<ARCHOFF
! Operation: Prompts for <user>, <fsys>, <filename>.
! Effect: Marks a file to prevent archiving.
!>
!
!
!<ARCHON
! Operation: Prompts for <user>, <fsys>, <filename>.
! Effect: Marks a file for resumption of archiving.
!>
!
!
!<BAD PAGES
! Operation: Prompts for <Fsys (or -1)>
! Effect: Generates a table giving details of the bad pages on
! <fsys>
!>
!
!
!<CCKOUT
! Operation: Prompts for <fsys>, <output file or device>.
! Effect: Copies the data recording progress of file system
! consistency checks, from the circular file maintained by
! the DIRECT process into a standard text file. The maximum filesize
! generated is 256K.
!>
!
!
!<CHECK DAS
! Operation: Prompts for <low page no:> and <Fsys (or -1)>
! Effect: Calls 'TO DO ALL FILES' and for each file for each user for
! each fsys calls DGETDA and, if the disc address of a section
! is less than (low page no>, prints
! user.file
!>
!
!
!<COPY INDEX
! Operation: Prompts for <user>, <fsys>, <new user>, <new fsys>,
! <new index size (Kbytes)>.
! Effect: Creates a new index for <new user> on <new fsys>, unless
! one already exists. Index attributes (delivery, basefile,
! file limits etc.) are copied from the old to the new
! index. For each file in the original index, the
! corresponding file in the new index is destroyed (if it
! exists), a file of the same name and of the same size is
! created in the new index, and data are copied in from the
! original file. The file is given the same attributes as
! the original file.
! Purpose: To run some important file system utilities (e.g. MOVE
! INDEX) following corruption on a file system, it is
! generally necessary to complete the file system
! consistency check first. In the case where corruption has
! occurred on the disc containing MANAGR (and hence the
! utilities also), this can be difficult. If COPY INDEX is
! used (say once per week, or after updates) to copy the
! contents of MANAGR's index to a second disc, then the
! utilities should be available to deal with the original
! disc, even if the original MANAGR index is inaccessible.
! In addition, the copied index forms an on-line backup of
! the original.
!>
!
!
!<CREATE LOG FILE
! Operation: Prompts for <user>, <fsys> and <logfile>
! Effect: Creates <logfile>, permits it to MANAGR, initialises
! <logfile> as a circular file and calls DSFI to set
! the LOGFILE field in <user>s index. The contents
! of the file are made available by LOGOUT (q.v.)
!>
!
!
!<DELUSER
! Operation: Prompts for <user> and <fsys>
! Effect: Deletes the file index for <user> on <fsys>, hence
! removing <user> from the System. This routine requires
! the user to confirm the username to be deleted before actually
! doing so. If <fsys> is given as -1 then all occurrences
! of the given username will be deleted automatically.
! If not then all other fsys's will be searched for
! other occurrences of the username. Any found will be reported
! and the user asked if they should also be deleted.
!>
!
!
!<DEREGISTER CLASS
! Operation: Prompts for a "base" username, e.g. ERCC01 (in which the
! last two characters are decimal digits), <fsys> and a
! number, N, of usernames to be deleted.
! Effect: The "base" username and N-1 consecutive usernames (last
! two digits being incremented) are deleted from the System.
! (Equivalent to repeated calls of DELUSER, q.v.)
!>
!
!
!<DIRLOG
! Operation: No parameters
! Effect: Copies the information from DIRECTORS
! monitoring file VOLUMS.#DIRLOG into a character file T#OUT
! which can then be further edited if desired.
!>
!
!
!<DO ALL INDEXES
! Skeleton routine a copy of which can be used to surround
! code which is meant to be executed for all indexes on an fsys.
!>
!
!
!<ENV
! Operation: No parameters
! Effect: Prints the current Supervisor and Director versions, the
! process number of the calling user and the discs currently
! on-line. (N.B. The first disc specified is the SLOAD disc.)
!>
!
!
!<FSYS START
! Operation: Prompts for <fsys>
! Effect: Prints the range of pages available for files on <fsys>
!>
!
!
!<GET
! Operation: Prompts for <what>, <user> and <fsys>
! Effect: <what> is one of
! ACR ADDRTELE AFILES
! ARCHINDUSE BASEFILE BATCHSS
! CODES CONNECTT CONTROLFILE
! CUMINSTRS CUMMSECS CUMPTRNS
! CURRPROCS DEFAULTLP DELIVERY
! DINSTRS DIRMON DIRVSN
! FILES FUNDS GPFSYS
! GPHOLDR INDEXUSE ISESSM
! LASTLOGON LOGFILE MAXFILE
! MAXKB MAXPROCS NKBIN
! NKBOUT PRIVILEGES SESSINSTRS
! SESSMSECS SESSPTRNS SIGMON
! SPECIALSS STKKB SURNAME
! Reports the value or values of the index attribute specified
! (Some have multiple values associated).
! For the significance of the index attribute, current Director
! documentation on the function DSFI should be consulted for
! all except PRIVILEGES. See SET for a full description of
! available PRIVILEGES.
!>
!
!
!<HOLES HIST
! Operation: Prompts for <fsys>
! Effect: Generates a histogram showing how many free areas there
! are of each size (1 to 32 Epages) on <fsys> and how
! many sections
!>
!
!
!<HOW FULL
! Operation: Prompts for <fsys>.
! Effect: Reports the current fullness (%) of the specified <fsys>.
! (The figure reported when the System is open to users is
! not strictly comparable with the corresponding figures
! given by the FCHECK process at System start-up, in that a
! considerable quantity of temporary file-space will be
! included in the figure for a running System.)
!>
!
!
!<HOW FRAG
! Operation: Prompts for <fsys> (or -1)
! Effect: Calculates the degree of fragmentation on specified <fsys>
! The degree of fragmentation is defined to be the percentage
! of the total disc space available for user files which
! is occupied by sections which have sizes less than a full
! section. (i.e. 1 to 31 Epages)
!>
!
!
!<INACTIVE USERS
! Operation: Prompts for <trigger date> in the format DD/MM/YY and
! <op file/dev>
! Effect: Produces a sorted table (oldest to youngest) of entries
! of the form date process last used, user, fsys,
! surname and delivery info of those users who have not
! accessed their process since the trigger date.
!>
!
!
!<LIST NNT
! This is a synonym for command USERNAMES (q.v.).
!>
!
!
!<LOG OUT
! Operation: Prompts for <user>, <fsys> and <file>
! Effect: Connects <user>s logfile, if it exists, and copies
! it to <file> (see 'CREATE LOG FILE')
!>
!
!
!<LOST FILES
! Operation: Prompts for <fsys>
! Effect: Lists the contents of VOLUMS.LOSTFILES on <fsys>
!>
!
!
!<MOVE INDEX
! Operation: Prompts for <user>, <fsys>, <new fsys>,
! <new index size (Kbytes)>.
! Effect: The program first checks <fsys> and <new fsys>. If these
! are different then the routine will operate in COPY mode
! when copies are made of the files on <fsys> to <new fsys>.
! When <fsys> and <new fsys> are the same then the program
! can potentially operate in two modes COPY or TRANSFER. In
! TRANSFER mode the files are not copied, ownership is merely
! transferred. This route is faster but less safe in that
! a crash occurring during file transfer will leave two
! partial indexes and possibly result in the loss of files.
! In practice the TRANSFER route is only obligatory if there
! is not sufficient space on the disc to hold a copy of
! all the <user>'s files. The routine checks whether this
! is possible given the current state of the disc and if so
! offers <C/T?> to the caller otherwise the move can only
! proceed via the TRANSFER route.
! After mode has been decided a new index of <new index size>
! named NEWZZZ is first created on <new fsys> and <user>'s index
! is renamed to OLDZZZ. The <user>'s index attributes are
! then copied to the new index, and all the files are
! transferred or copied from the old to the new index.
! If the mode was COPY then at this point a final chance
! is offered to the caller to abandon the move with no side
! effects. If the response is to continue or mode is TRANSFER
! then finally the OLDZZZ index is deleted and the NEWZZZ index is
! renamed to belong to <user>. Note that if the original
! index was corrupted, or if some files are marked as being
! in use (either because the owner's process had terminated
! in disorder or because the owner or other users are
! actually using the files), then the program reports the
! number of files it is unable to transfer and prompts
! "Continue?", before commencing the index move.
! If the reply is "N" or "NO" the move is abandoned, with no
! side-effects. If the reply is "Y" or "YES" those files
! which cannot be transferred are lost when the original
! index is deleted. In general it is preferable not to
! proceed with the operation if it is likely that one or
! more files are actually in use by a currently existing
! process. The file pages which are actually in use will
! not be re-used before the next IPL, but the process(es)
! using the file(s) will be unable to disconnect the files.
! Purposes: One or more of the following:
! 1) To transfer as many files as possible from a corrupted
! index into a new index.
! 2) To move an index onto a different disc.
! 3) To change the size of an index.
! Apart from possible software errors, indexes become
! corrupt mainly when a hardware error or machine stop
! occurs during updating of an index. Corruption is often
! first noticed during the file system consistency check at
! System start-up, when the message
! <user> CORRUPT? FSYS <fsys> or
! <user> CELLS? FSYS <fsys>
! is given at the main OPER. In the former case the System
! remains closed to users until explicity opened, preferably
! following a move (or re-creation) of the affected
! index(es). The latter message indicates that some
! list-cells are not attached to any list, correction is not
! normally urgent.
! If the System is inadvertently or otherwise opened and
! processes are started following a "CORRUPT?" message, the
! affected indexes should be destroyed, and the users
! re-accreditted, corruption of other users' files could
! otherwise occur.
!>
!
!
!<MOVE INDEXES
! Operation: Prompts for <from fsys> and <to fsys>
! Effect: Moves each users index on <from fsys> to <to fsys>
! with the exception of SPOOLR and VOLUMS
!>
!
!
!<NEW USER
! Operation: The program prompts for the following data:
! Username
! File system
! Index size (Kbytes) (reply 4 or 8, for about 70 or 140
! files respectively)
! Mark (reply 0 for OLD index, 1 for NEW)
! Initials and surname
! Delivery information
! Foreground password (4 chars)
! Background password (4 chars).
! Maximum total filespace (Kbytes)
! Maximum single filesize (Kbytes)
! Maximum process concurrencies allowed for the user, for
! interactive, batch and total numbers of processes.
! Effect: A new user with the specified attributes is created.
!>
!
!
!<REGISTER CLASS
! Operation: Prompts for a "base" username (in which the last two
! characters are decimal digits), e.g. ERCC01, <fsys> and a
! number N of usernames to be accreditted. The program
! further prompts for
! File system
! Index size (Kbytes) (reply 4 or 8, for about 70 or 140
! files respectively)
! Initials and Surname
! Delivery information
! Password (sets the 4 characters input as both
! foreground and background passwords)
! Maximum total filespace (Kbytes)
! Maximum single filesize (Kbytes)
! Maximum process concurrencies allowed for the user, for
! interactive, batch and total numbers of processes.
! Effect: The "base" username and N-1 consecutive usernames (last
! two digits being incremented) are accreditted to the
! System, all with the same process details as input
! initially. The program reports each username successfully
! accreditted, if any username cannot be accreditted (e.g.
! because the file system index area is full, or because the
! username already exists) the program terminates at that
! point.
!>
!
!
!<REFRESH FILE
! Operation: Prompts for <user>, <fsys> and <file>
! Effect: Forces a resiting of <file> owned by <user> on <fsys>.
!>
!
!
!<REFRESH FILES
! Operation: Prompts for <low page no> and <fsys>
! Effect: Will resite all files on <fsys> which have sections whose
! disc addresses are less than <low page no>.
! Used ,for example, in reformatting a disc as a system disc.
!>
!
!
!<REFRESH INDEX
! Operation: Prompts for <user> and <fsys>.
! Effect: Equivalent to MOVE INDEX with oldfsys = newfsys, old index
! size = new index size and MODE = TRANSFER.
! Resites an index on the same <fsys> with the same attributes.
! See MOVE INDEX.
! N.B. Should not be done on the same <fsys> as the routine
! is running from.
!>
!
!
!<REFRESH INDEXES
! Operation: Prompts for <fsys>.
! Effect: Does a REFRESH INDEX for each user on the <fsys> specified.
!>
!
!
!<RENAME INDEX
! Operation: Prompts for <user>, <fsys> and <newname>
! Effect: Calls 'DRENAME INDEX'
!>
!
!
!<SET
! Operation: Prompts for <what>, <user>, <fsys> and <new value>
! (or <new values> as appropriate to the fields)
! Effect: <what> is one of
! ACR ADDRTELE AFILES
! ARCHINDUSE BASEFILE BATCHSS
! CODES CONNECTT CONTROLFILE
! CUMINSTRS CUMMSECS CUMPTRNS
! CURRPROCS DEFAULTLP DELIVERY
! DINSTRS DIRMON DIRVSN
! FILES FUNDS GPFSYS
! GPHOLDR INDEXUSE ISESSM
! LASTLOGON LOGFILE MAXFILE
! MAXKB MAXPROCS NKBIN
! NKBOUT PRIVILEGES SESSINSTRS
! SESSMSECS SESSPTRNS SIGMON
! SPECIALSS STKKB SURNAME
! Sets the new value or values of the index attribute specified
! Some have multiple values associated and will prompt appropriately.
! For the significance of the index attribute, current Director
! documentation on the function DSFI should be consulted for
! all except PRIVILEGES which are described below.
! Note that in some cases it is not sensible and in other cases
! not permitted to SET certain attributes. See current DSFI
! documentation.
!< PRIVILEGES.
! It is possible to SET or GET PRIVILEGES. If the operation
! is GET then the individual PRIVILEGES enjoyed by <user> will
! either be listed in the form PRIVxx where 0 <= xx <= 31 or
! if none are enjoyed, given as *NONE*.
! If the operation is SET then the current PRIVILEGES are first
! given as for GET then the caller is prompted <PRIV:>. This
! should be responded to by a reply of the form PRIVxx where
! 0 <= xx <= 31 (spaces are not significant). The caller is then
! prompted <G/R:> and the appropriate reply should be given
! depending on whether the PRIVILEGE is to be given or removed.
! This sequence continues until the reply .END is received to
! <PRIV:> when the new set of PRIVILEGES is reported.
! PRIVILEGES currently available are as follows:
! PRIV 04 DPRINTSTRING, DDUMP
! PRIV 06 Use of chargeable FTP
! PRIV 07 DSFI 7
! PRIV 08 DPERMISSION, DFINFO, DFSTATUS, DFILENAMES on other
! users' files
! PRIV 09 DCHECKBPASS
! PRIV 10 DSFI for privileged calls and DSETPASSWORD other users
! PRIV 12 Ability to set BASEFILE, CONTROLFILE, TESTBASEFILE
! and BATCHBASEFILE
! PRIV 14 Use of DDAP
! PRIV 15 Interactive use of magnetic tapes (DMAGCLAIM)
! PRIV 17 DSFI 38
! PRIV 18 DPON, DPON3, DOUT, DOUT11, DOUT18, DTOFF, DLOCK
! PRIV 20 BADPAGE, DSYSAD, FBASE, GETAVFSYS
! PRIV 22 ACREATE2, DMODARCH, DNEWARCHINDEX
! PRIV 24 DCONNECT, DDISCONNECT on # files
! PRIV 25 DPRG, DUNPRG, DTRANSFER, DOFFER
! PRIV 26 DEMPTYI, DRENAMEINDEX, DNEWUSER, DDELUSER,
! VALIND, DDUMPI, DXDUMPI, GETUSNAMES
! PRIV 31 Allows ADESTROY, DCHSIZE, DCREATE, DDESTROY,
! DNEWGEN, DRENAME to be used on someone else's file
! without full index permission
!>
!>
!<SET H NOARCH
! Operation: Prompts for <fsys> (or -1).
! Effect: For each user on <fsys> sets the NOARCH bit in file
! descriptor of file #ARCH.
!>
!
!
!<SET MSG EEP
! Operation: Prompts for <fsys> (or -1).
! Effect: For each user on <fsys> sets EEP to 11 in file descriptors
! of files #ARCH and #MSG.
!>
!
!
!<SET SSBYTE
! Operation: The program prompt is for <user>, <fsys>, <filename> and
! <values>.
! Effect: For the specified file the "ssbyte" is set to (the
! rightmost 8 bits of) <value>. The "ssbyte" is a byte in
! the file descriptor reserved for exclusive use of
! subsystems.
!>
!
!
!<SSDESTROY
! Operation: The program prompts for <user>, <fsys> and then repeatedly
! for <filename> until a response ".END" or ".E" is given.
! Effect: After each input <filename> an attempt is made to destroy
! <filename> belonging to <user>. A result code and brief
! text describe the success or failure of each "destroy".
!>
!
!
!<SSFFILES
! Operation: The program prompts for <user>, <fsys> and <output file or
! device>.
! Effect: The result is exactly as for SSFILES (see below), except
! that extra details - largely as described under SSFINFO -
! are additionally printed for each file. ("SSFFILES"
! stands for "SS Full FILES".)
!>
!
!
!<SSFILES
! Operation: The program prompts for <user>, <fsys> and
! <output file or device>.
! Effect: A list (in alphabetical order) of all the files belonging
! to <user> is placed in the <output file or device>.
!>
!
!
!<SSFINFO
! Operation: The program prompts for <user>, <fsys> and <filename>
!
! Effect: Prints out a concise synopsis of the file's attributes,
! namely:
! "*" if "cherished"
! "+" if marked for archive
! <filename>
! connect address in caller's virtual memory, or zero if
! not connected in same
! physical size in epages
! access permission to file owner (OWNP)
! general access permission to all other users (EEP,
! "everyone else's permission")
! access permission field (APF) from segment table, if
! file connected in caller's virtual memory, otherwise
! zero
! current number of users of the file
! list pool number to which descriptor cells belong in
! <user>'s file index
! the user to whom the file is "on offer", if any
! whether the file is marked:
! PRIVacy VIOLated
! TEMPorary
! VTEMPorary
! NOt to be ARCHived
! as having more than one generation
! Current DIRECTOR documentation further explains
! this terminology.
! SSFSTATUS
! Operation: Prompts for <user>, <fsys>, <file>, <act>, and <value>.
! Effect: Allows attributes of <file> belonging to <user> on <fsys>
! to be modified by calling the Director function DFSTATUS.
! N.B. This routine should NOT be used unless you are absolutely
! sure that you know what you're doing!!
!>
!
!
!<SSIPERMIT
! Operation: Prompts for <user>, <fsys>, <file), <to user> and <prm 1-15>.
! Effect: Gives <to user> permission to access <file> owned by <user>
! on <fsys> as specified by the response to <prm 1-15>.
! If <file> is specified as .ALL then the appropriate
! whole index permission is granted.
! (See also SSREMOVEPRM)
!>
!
!
!<SSNKB
! Operation: The program prompts for <user> and <fsys>.
! Effect: The following data are printed from <user>'s file index:
! Total file space (Kbytes)
! Total temporary filespace (Kbytes)
! Total "cherished" filespace (Kbytes) (currently
! reported equal to total filespace)
! Maximum permanent filespace which the user is allowed
! to own (on-line)
! Maximum single filesize allowed for <user>.
!>
!
!
!<SSNOF
! Operation: The program prompts for <user> and <fsys>.
! Effect: The following data are printed from <user>'s file index:
! Number of files
! Number of temporary files
! Number of cherished files
! Number of file descriptors currently extant (this may
! exceed number of files, as some descriptors may be
! marked "dead", awaiting a garbage collect).
! Maximum and currently free numbers of list cells in up
! to 4 list-cell pools
!>
!
!
!<SSPERMISSIONS
! Operation: Prompts for <user>, <fsys>, <file>
! Effect: Gives OWNP and EEP for <file> and whole index permissions.
! If <file> is specified as .ALL then whole index permissions
! only are given.
!>
!
!
!<SSPERMIT
! Operation: The program prompts for <user>, <fsys> and <filename>.
! Effect: The specified file is given general access permission,
! i.e. execute, write and read.
!>
!
!
!<SS REMOVE PRM
! Operation: Prompts for <user>, <fsys>, <file> and <to user>.
! Effect: Removes individual permissions to a file or index.
! Reverses the effects of SSIPERMIT.
!>
!
!
!<SSRENAME
! Operation: The program prompts for <user>, <fsys>, <filename> and
! <newname>.
! Effect: The specified file is renamed to <newname>.
!>
!
!
!<SSTRANSFER
! Operation: The program prompts for <user>, <fsys>, <filename>,
! <newuser>, <newfsys> and <newname>.
! Effect: <filename> belonging to <user> on <fsys> is transferred to
! ownership of <newuser> in <newfsys> and with name
! <newname>.
!>
!
!
!<TEST BAD PAGES
! Operation: Prompts for <fsys> (or -1)
! Effect: Attempts to write to each page flagged as a bad page on
! <fsys> by using the Bulk Mover to write successively
! a page of X'FFFFFFFF' ,a page of X'08CEF731' (the most
! difficult for the hardware) and finally the empty page
! pattern. If all of these are successful then the user is
! informed, the page removed from the bad page list and
! returned to the system.
! See BADPAGES.
!>
!
!
!<USERNAMES
! Operation: Prompts for <FSYS>, <SORT TYPE>, <USERNAMES> - if all
! FSYS option selected - and <FILE/DEV>.
! Effect: A list of usernames accredited on <fsys> (if specified -
! otherwise all on-line file systems), together with leading
! file index attributes (file limits, process concurrency
! limits, file space etc.) is placed in <file or device>.
! If the single FSYS option is selected then the
! sorting can be by index no or by username. If on the other hand
! all on line file systems are selected the sorting may be alphabetic
! by username or surname or both. Optionally in this case a file
! called USERNAMES may be created or updated in the calling
! process. This file contains a directory of usernames sorted by
! surname.
! Command LISTNNT is a synonym for command USERNAMES.
!>
!
!
!<WHATFILE
! Operation: The program prompts for <disc address> and <fsys>.
! Effect: File system <fsys> is searched for the file(s), if any, to
! which epage number <disc address> belongs. If <fsys> is
! specified as -1 then all file systems are searched. The
! filenames, if any, are reported.
!>
!
!
!<WHATFSYS
! Operation: The program prompts for <username>.
! Effect: Each on-line file system is searched for a file index
! belonging to <username> . The <fsys>'s discovered
! containing <username> are reported.
!>
!>
!
!===================================================================
!* *
!******************** RECORD FORMATS *******************************
!* *
!===================================================================
!
RECORDFORMAT COMF(INTEGER OCPTYPE, IPLDEV, SBLKS, SEPGS, NDISCS, DLVNADDR,
GPCTABSIZE, GPCA, SFCTABSIZE, SFCA, SFCK, DIRSITE, DCODEDA, SUPLVN,
WASKLOKCORRECT, DATE0, DATE1, DATE2, TIME0, TIME1, TIME2, EPAGESIZE,
USERS, CATTAD, DQADDR, SACPORT, OCPPORT, ITINT, CONTYPEA, GPCCONFA,
FPCCONFA, SFCCONFA, BLKADDR, DPTADDR, SMACS, TRANS, LONGINTEGER KMON,
INTEGER DITADDR, SMACPOS, SUPVSN, PSTVA, SECSFRMN, SECSTOCD, SYNC1DEST,
SYNC2DEST, ASYNCDEST, MAXPROCS, INSPERSEC, ELAPHEAD, COMMSRECA, STOREAAD,
PROCAAD, SFCCTAD, DRUMTAD, SP0, SP1, SP2, SP3, SP4, SP5, SP6, SP7, SP8,
SP9, LSTL, LSTB, PSTL, PSTB, HKEYS, HOOT, SIM, CLKX, CLKY, CLKZ, HBIT,
SLAVEOFF, INHSSR, SDR1, SDR2, SDR3, SDR4, SESR, HOFFBIT, S2, S3, S4, END)
!
RECORDFORMAT DAF(INTEGER SECTSI, NSECTS, LASTSECT, SP,
INTEGERARRAY DA(0:255))
!
RECORDFORMAT DATAF(INTEGER START, BITSIZE, BADSTART, NNTSTART,
NNTSIZE, NNTTOP, NNTHASH, INDEXSTART, FILESTART, END)
!
RECORDFORMAT DDTFORM(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)
!
RECORDFORMAT DFINFRECF(INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG,
CCT, CODES, CODES2, SSBYTE, STRING (6) OFFER)
!
RECORDFORMAT PROPFORM(INTEGER TRACKS, CYLS, PPERTRK, BLKSIZE, TOTPAGES,
RQBLKSIZE, LBLKSIZE, ALISTSIZE, KEYLEN, SECTINDX)
!
RECORDFORMAT FHDRF(INTEGER NEXTFREEBYTE, TXTRELST, MAXBYTES, ZERO, SPARE,
DATE, NEXTCYCLIC, READ TO)
!
RECORDFORMAT NNF(STRING (6) NAME, BYTEINTEGER KB, TAG, MARKER,
HALFINTEGER INDNO)
!
RECORDFORMAT OINFF(STRING (11) NAME, INTEGER SP12, NKB, BYTEINTEGER ARCH,
CODES, CCT, OWNP, EEP, USE, CODES2, SSBYTE, FLAGS, SP29, SP30, SP31)
!
RECORDFORMAT SCTF(INTEGER HORIZ VECTOR BOUND, SCT RELST, IDENS ARRAY RELST,
DT STAMP, STRING (15) FIXUP DATE, INTEGER ENDF)
!
RECORDFORMAT UINF(STRING (6) USER, STRING (31) JOBDOCFILE, INTEGER MARK,
FSYS, PROCNO, ISUFF, REASON, BATCHID, SESSICLIM, SCIDENSAD, SCIDENS,
STARTCNSL, AIOSTAT, SCT DATE, SYNC1 DEST, SYNC2 DEST, ASYNC DEST,
AACCT REC, AIC REVS, STRING (15) JOBNAME, STRING (31) BASEFILE,
INTEGER PREVIC, INTEGER ITADDRO, ITADDR1, ITADDR2, ITADDR3, ITADDR4,
STREAM ID, DIDENT, SCARCITY, PREEMPTAT, STRING (11) SPOOLRFILE,
INTEGER RESUNITS, SESSLEN, UEND)
!
RECORDFORMAT TF(STRING (8) LASTUSED, STRING (6) USER, INTEGER FSYS,
STRING (31) SURNAME, DELIV, INTEGER LASTLOGON)
!
RECORDFORMAT LOSTF(STRING (8) DATE, TIME, STRING (6) USER,
STRING (11) FILE, BYTEINTEGER CODES2, CODES, CHERISHED)
!
CONSTINTEGER TOPSFI=44
RECORDFORMAT TABLEF(INTEGER IORS, HOWMANY, TOSPTEXT)
OWNRECORD (TABLEF) ARRAYFORMAT TABLEAF(0:TOPSFI)
!
RECORDFORMAT H F(INTEGER NEXT FREE BYTE, TXT REL ST, MAXBYTES, X, SEMA,
DATE, NEXT CYCLIC, READ TO)
!
RECORDFORMAT INDIVF(STRING (6) USER, BYTEINTEGER UPRM)
RECORDFORMAT RETF(INTEGER BYTES, OWNP, EEP, SPARE,
RECORD (INDIVF) ARRAY INDIV(0:15))
!
RECORDFORMAT NNEF(RECORD (NNF) NN, INTEGER FSYS, STRING (7) INITS,
STRING (19) SURNAME, STRING (31) DELIV, INTEGER ACR, MAXFILE, MAXKB,
TOTKB, IMAX, BMAX, TMAX, AFILES)
!
RECORDFORMAT USINFF(STRING (6) NAME, BYTEINTEGER KB, INTEGER INDNO)
!===================================================================
!* *
!******************** EXTERNAL ROUTINE/ FN SPECS *******************
!* *
!===================================================================
!
DYNAMICINTEGERFNSPEC DERROR(STRINGNAME TXT)
DYNAMICINTEGERFNSPEC DNEW ARCH INDEX(STRING (6) USER, INTEGER FSYS, KBYTES)
EXTERNALSTRINGFNSPEC DERRS(INTEGER I)
EXTERNALINTEGERFNSPEC DSYSAD(INTEGER TYPE, ADR, FSYS)
EXTERNALINTEGERFNSPEC FBASE(INTEGERNAME LO, HI, INTEGER FSYS)
SYSTEMROUTINESPEC PHEX(INTEGER I)
DYNAMICINTEGERFNSPEC DSFI(STRING (6) USER, INTEGER FSYS, TYPE, SET, ADR)
DYNAMICROUTINESPEC PROMPT(STRING (255) S)
DYNAMICINTEGERFNSPEC DCONNECT(STRING (6) USER, STRING (15) FILE,
INTEGER FSYS, MODE, APF, INTEGERNAME SEG, GAP)
DYNAMICINTEGERFNSPEC DDISCONNECT(STRING (6) USER, STRING (15) FILE,
INTEGER FSYS, DSTRY)
DYNAMICROUTINESPEC GET AV FSYS(INTEGERNAME N, INTEGERARRAYNAME A)
DYNAMICINTEGERFNSPEC DCREATE(STRING (6) USER, STRING (11) FILE,
INTEGER FSYS, NKB, TYPE)
DYNAMICROUTINESPEC DPRINTSTRING(STRING (255) S)
DYNAMICINTEGERFNSPEC DTRANSFER(STRING (6) USER1, USER2, STRING (15) FILE,
NEWNAME, INTEGER FSYS1, FSYS2, TYPE)
DYNAMICINTEGERFNSPEC DFSYS(STRING (6) USER, INTEGERNAME FSYS)
DYNAMICINTEGERFNSPEC OUTPOS
DYNAMICINTEGERFNSPEC DFSTATUS(STRING (6) USER, STRING (11) FILE,
INTEGER FSYS, ACT, VALUE)
DYNAMICINTEGERFNSPEC DFINFO(STRING (6) USER, STRING (15) FILE,
INTEGER FSYS, ADR)
DYNAMICINTEGERFNSPEC DRENAME(STRING (6) USER, STRING (15) OLDNAME,
NEWNAME, INTEGER FSYS)
DYNAMICROUTINESPEC DEFINE(STRING (255) S)
DYNAMICROUTINESPEC CLEAR(STRING (255) S)
DYNAMICINTEGERFNSPEC DFILENAMES(STRING (6) USER,
RECORD (OINFF) ARRAYNAME INF, INTEGERNAME FILENO, MAXREC, NFILES,
INTEGER FSYS, TYPE)
DYNAMICINTEGERFNSPEC DDESTROY(STRING (6) USER, STRING (15) FILE,
STRING (8) DATE, INTEGER FSYS, TYPE)
DYNAMICINTEGERFNSPEC DPERMISSION(STRING (6) OWNER, USER, STRING (8) DATE,
STRING (15) FILE, INTEGER FSYS, TYPE, ADRPRM)
EXTERNALSTRINGFNSPEC UINFS(INTEGER I)
EXTERNALROUTINESPEC RENAME(STRING (255) S)
EXTERNALINTEGERFNSPEC EXIST(STRING (255) S)
EXTERNALROUTINESPEC NEWGEN(STRING (255) S)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH, FROM, TO)
SYSTEMSTRINGFNSPEC ITOS(INTEGER VALUE)
EXTERNALINTEGERFNSPEC GET USNAMES2(RECORD (NNF) ARRAYNAME UNN,
INTEGERNAME N, INTEGER FSYS)
DYNAMICSTRINGFNSPEC INTERRUPT
DYNAMICINTEGERFNSPEC DGETDA(STRING (6) USER, STRING (15) FILE,
INTEGER FSYS, ADR)
DYNAMICINTEGERFNSPEC GET USNAMES(INTEGERNAME N, INTEGER ADR, FSYS)
DYNAMICINTEGERFNSPEC ACREATE2(STRING (6) USER, TAPE, STRING (8) FDATE,
STRING (15) FILE, INTEGER FSYS, NKB, CHAPTER, TYPE)
DYNAMICINTEGERFNSPEC DNEWUSER(STRING (6) USER, INTEGER FSYS, NKB)
DYNAMICINTEGERFNSPEC DDELUSER(STRING (6) USER, INTEGER FSYS)
DYNAMICINTEGERFNSPEC DRENAME INDEX(STRING (6) OLDNAME, NEWNAME,
INTEGER FSYS)
DYNAMICINTEGERFNSPEC DOFFER(STRING (6) USER, OFFERTO, STRING (15) FILE,
INTEGER FSYS)
SYSTEMROUTINESPEC FILL(INTEGER LEN, FROM, FILLER)
SYSTEMSTRING (8) FNSPEC UNPACKDATE(INTEGER I)
SYSTEMSTRING (8) FNSPEC UNPACKTIME(INTEGER I)
SYSTEMROUTINESPEC UCTRANSLATE(INTEGER AD, LEN)
SYSTEMSTRINGFNSPEC FAILURE MESSAGE(INTEGER I)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
SYSTEMROUTINESPEC OUTFILE(STRING (31) S, INTEGER LENGTH, MAXBYTES, PROT,
INTEGERNAME CONAD, FLAG)
!
!
!====================================================
!
!***************** CONSTANTS ************************
!
!====================================================
!
!----------- CODES ----------- CODES2 ----------
CONSTINTEGER UNAVA=1, WRCONN=1
CONSTINTEGER OFFER=2, NEWGE=2
CONSTINTEGER TEMPFI=4, OLDGE=4
CONSTINTEGER VTEMPF=8, WSALLOW=8
CONSTINTEGER TEMPFS=12
CONSTINTEGER CHERSH=16
CONSTINTEGER PRIVAT=32, DISCFI=32
CONSTINTEGER VIOLAT=64
CONSTINTEGER NOARCH=128
!----------------------------------------------------------
!
CONSTSTRINGNAME DATE=X'80C0003F', TIME=X'80C0004B'
CONSTINTEGER SWR=11; ! Shared, R+W
CONSTINTEGER LOSTFLEN=48; ! bytes, nominal, generous
!
CONSTINTEGER MAXUSERS=4000
CONSTINTEGER NNEFLEN=108
!
CONSTINTEGER TRUE=1
CONSTINTEGER FALSE=0
!
CONSTINTEGER TOPSI=32
CONSTINTEGER TRANSFER=1, COPY=3, RENAMEOLD=1, NORENAME=0
CONSTINTEGER MAXFILES=400
CONSTINTEGER SETOWNP=0,SETEEP=1,ADDTOFLIST=2,ADDTOILIST=6
CONSTINTEGER GETFLIST=4,GETILIST=8
CONSTINTEGER SFI=0, FSTAT=1, PERM=2, TRAN=3, FILEN=4, OFFE=5
CONSTINTEGER TOPNNT = 1364; ! for 0 to N
CONSTSTRING (17)EXECUTIVES = "VOLUMSPOOLRMAILER"
!
!------------------------------------------------------------------
!
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 INSTRG(STRINGNAME S)
INTEGER I
S = ""
CYCLE
READSYMBOL(I)
EXITIF I = NL
S = S.TOSTRING(I)
REPEAT
UCTRANSLATE(ADDR(S) + 1, LENGTH(S)) UNLESS S = ""
END ; ! INSTRG
!
!----------------------------------------------------------------------
ROUTINE RSTRG(STRINGNAME S)
INSTRG(S) UNTIL S # ""
END ; ! RSTRG
ROUTINE UCTRAN(STRINGNAME S)
UCTRANSLATE(ADDR(S) + 1, LENGTH(S))
END {UCTRAN}
ROUTINE UCSTRG(STRINGNAME S)
RSTRG(S)
UCTRAN(S)
END {UCSRTG}
!
!-----------------------------------------------------------------------
!
ROUTINE WRS(STRING (255) S1)
PRINTSTRING(S1)
NEWLINE
END
!
!
!
ROUTINE WRSS(STRING (255) S1, S2)
PRINTSTRING(S1)
PRINTSTRING(S2)
NEWLINE
END
!
!
!
ROUTINE WRSSS(STRING (255) S1, S2, S3)
PRINTSTRING(S1)
PRINTSTRING(S2)
PRINTSTRING(S3)
NEWLINE
END
!
!
!
ROUTINE WRSN(STRING (255) S1, INTEGER N)
PRINTSTRING(S1)
WRITE(N, 1)
NEWLINE
END
!
!
!
ROUTINE WRSNS(STRING (255) S1, INTEGER N, STRING (255) S2)
PRINTSTRING(S1)
WRITE(N, 1)
PRINTSTRING(S2)
NEWLINE
END
!
!
!
ROUTINE WRSSN(STRING (255) S1, S2, INTEGER N)
PRINTSTRING(S1)
PRINTSTRING(S2)
WRITE(N, 1)
NEWLINE
END
!
!
!
ROUTINE WRSSNSS(STRING (255) S1, S2, INTEGER N, STRING (255) S3, S4)
PRINTSTRING(S1)
PRINTSTRING(S2)
WRITE(N, 1)
PRINTSTRING(S3)
PRINTSTRING(S4)
NEWLINE
END
!
!-----------------------------------------------------------------------
!
INTEGERFN HXSTOBIN(STRING (29) S)
! RESULT IS VALUE REPRESENTED BY UP TO 8 HEX DIGITS IN THE PARAM.
! ERROR RESULT IS X80308030
INTEGER I, Q, L, AS, CH
AS = ADDR(S)
L = LENGTH(S)
RESULT = X'80308030' IF L > 8 OR L = 0
I = 0
CYCLE Q = 1, 1, L
CH = BYTEINTEGER(AS + Q)
RESULT = X'80308030' UNLESS '0' <= CH <= '9' OR 'A' <= CH <= 'F'
IF CH > '9' THEN CH = CH - 55 ELSE CH = CH - 48
I = I << 4 ! CH
REPEAT
RESULT = I
END ; ! HXSTOBIN
!
!-----------------------------------------------------------------------
!
STRINGFN FROMSTR(STRING (255) S, INTEGER I, J)
INTEGER A
RESULT = "" UNLESS 0 < I <= J AND J <= LENGTH(S)
A = ADDR(S)
I = I - 1
BYTEINTEGER(A + I) = J - I
RESULT = STRING(A + I)
END ; ! FROMSTR
!
!-----------------------------------------------------------------------
!
INTEGERFN NWFILEAD(STRING (15) S, INTEGER PGS)
INTEGER I, FLAG, CURR
FLAG = 1
IF 0 < LENGTH(S) <= 15 THEN OUTFILE(S, PGS << 12, X'40000', 0, I, FLAG)
IF FLAG # 0 START
CURR = COMREG(23)
SELECT OUTPUT(0)
WRSSNSS("", "OUTFILE FLAG =", FLAG, " ", FAILURE MESSAGE(FLAG))
I = 0
SELECT OUTPUT(CURR)
FINISH
RESULT = I
END ; ! NWFILEAD
!
!
!
INTEGERFN BIN(STRING (255) S)
! RESULT IS VALUE REPRESENTED BY THE STRING PARAM
! ERROR RESULT IS X80308030 (BAD CHAR IN STRING OR BAD
! LENGTH)
INTEGER I, Q, L, AS, CH, SIGN
STRING (255) REST
SIGN = 1
WHILE S - > REST.(" ").S AND REST = "" CYCLE ; REPEAT
IF S - > REST.("-").S AND REST = "" THEN SIGN = - 1
WHILE S - > REST.(" ").S AND REST = "" CYCLE ; REPEAT
IF S - > REST.("X").S AND REST = "" START
I = HXSTOBIN(S)
IF I # X'80308030' THEN I = I * SIGN
RESULT = I
FINISH
AS = ADDR(S)
L = LENGTH(S)
RESULT = X'80308030' IF L = 0
I = 0
CYCLE Q = 1, 1, L
CH = BYTEINTEGER(AS + Q)
RESULT = X'80308030' UNLESS '0' <= CH <= '9'
I = 10 * I + CH - 48
REPEAT
RESULT = I * SIGN
END ; ! BIN
!
!-----------------------------------------------------------------------
!
ROUTINE GET INT(INTEGERNAME I)
! READS NEXT UNSIGNED DEC NO. OR HEX NO. (NOT X80308030).
OWNSTRING (15) ARRAY NS(1:10)=""(10)
STRING (1) T
STRING (63) REST, S
OWNINTEGER NP=0,NL=0
IF NP >= NL START
RESET:
UCSTRG(S)
NP = 0; NL = 0
WHILE S - > REST.(" ").S AND REST = "" CYCLE ; REPEAT
WHILE S - > NS(NL + 1).(" ").S CYCLE
WHILE S - > REST.(" ").S AND REST = "" CYCLE
REPEAT
IF NS(NL + 1) = "X" OR NS(NL + 1) = "-" START
T = NS(NL + 1)
WHILE S - > REST.(" ").S AND REST = "" CYCLE
REPEAT
UNLESS S - > REST.(" ").S THEN REST = S AND S = ""
NS(NL + 1) = T.REST
FINISH
NL = NL + 1
REPEAT
IF S # "" START
NL = NL + 1
NS(NL) = S
FINISH
FINISH
!
NP = NP + 1
S = NS(NP)
I = BIN(S)
IF I = X'80308030' START
WRS("INVALID HEX OR DEC NO.")
IF NP > 1 START
NP = NP - 1
WRSS("LAST TAKEN WAS ", NS(NP))
FINISH
->RESET
FINISH
END ; ! GET INT
!
!
!
ROUTINE RDSTRG(STRING (255) TXT, STRINGNAME VAR)
PROMPT(TXT)
UCSTRG(VAR)
END
!
!
!
ROUTINE RDINT(STRING (255) TXT, INTEGERNAME VAR)
PROMPT(TXT)
GET INT(VAR)
END
!
!
!
ROUTINE RDFSYS(STRING (255) TXT, INTEGERNAME FSYS)
PROMPT(TXT)
GET INT(FSYS) UNTIL - 1 <= FSYS < 100
END
!
!
!
INTEGERFN YES OR NO(STRING (255) TXT)
STRING (63) S
PROMPT(TXT)
CYCLE
UCSTRG(S)
RESULT = 0 IF S = "N" OR S = "NO"
RESULT = 1 IF S = "Y" OR S = "YES"
REPEAT
END
!
!
!
!===================================================================
!* *
ROUTINE ERROR(STRING (255)TXT)
INTEGER J
STRING (255)MSG
J = DERROR(MSG)
WRSS(TXT, MSG)
END ; ! ERROR
!
!-----------------------------------------------------------------------
!
INTEGERFN BIT TO CYL TK PG(INTEGERNAME CYL, TK, PG, INTEGER FSYS, BITNO)
! Result is the BITNO corresponding to 1st page of TRK on CYL on FSYS.
! Zero if fsys not found.
INTEGER BASE, J, FS
INTEGER LCYL, LTRKS, PPERTRK, TKSPERCYL
RECORD (DDTFORM) NAME DDT
RECORD (PROPFORM) NAME PROP
RECORD (COMF) NAME COM
INTEGERARRAYNAME DIT
INTEGERARRAYFORMAT DITF(0:99)
BYTEINTEGERARRAYNAME DLVNA
BYTEINTEGERARRAYFORMAT DLVNAF(0:99)
COM == RECORD(X'80000000' + 48 << 18)
DLVNA == ARRAY(COM_DLVNADDR, DLVNAF)
DIT == ARRAY(COM_DITADDR, DITF)
J = DLVNA(FSYS)
IF J <= 250 START
DDT == RECORD(DIT(J))
FS = DDT_DLVN << 2 >> 2
BASE = DDT_BASE
IF 4 <= DDT_STATE <= 7 AND (BASE = X'40' OR BASE = X'800') AND C
FSYS = FS START
PROP == RECORD(DDT_PROPADDR)
PPERTRK = PROP_PPERTRK
TKSPERCYL = PROP_TRACKS
LTRKS = BITNO // PPERTRK
PG = BITNO - LTRKS * PPERTRK
LCYL = LTRKS // TKSPERCYL
TK = LTRKS - LCYL * TKSPERCYL
CYL = LCYL
RESULT = 0
FINISH
FINISH
RESULT = 1; ! FAIL
END ; ! BIT TO CYL TK PG
!
!-----------------------------------------------------------------------
!
INTEGERFN FBASE2(INTEGER FSYS, ADR)
!
! This returns the characteristics of an on-line disc in a record
! of format DATAF at address ADR
INTEGER J, LOB, HIB, TYPE, K
RECORD (DATAF) NAME DATA
CONSTINTEGER TOPTYPE= 5
CONSTINTEGERARRAY BITSIZE(1:TOP TYPE)= X'1000'(2), X'2000'(2), X'5000'
CONSTINTEGERARRAY NNTSTART(1:TOP TYPE)= X'7000'(4), X'A000'
CONSTINTEGERARRAY NNTSIZE(1:TOP TYPE)= X'4000'(4), X'1FF8'
CONSTINTEGERARRAY NNTTOP(1:TOP TYPE)= 1364(4), 681
CONSTINTEGERARRAY NNTHASH(1:TOP TYPE)= 1361(4), 667
CONSTBYTEARRAY INDEXSTART(1:TOP TYPE)= 12(5)
CONSTINTEGERARRAY FILESTART(1:TOP TYPE)= 256(5)
CONSTINTEGERARRAY HI(1:TOP TYPE)= X'3F1F', X'59F3', X'8F6F',
X'B3E7', X'24797'
J = FBASE(LOB, HIB, FSYS)
RESULT = J UNLESS J = 0
!
TYPE = - 1
CYCLE K = 1, 1, TOP TYPE
TYPE = K ANDEXITIF HIB = HI(K)
REPEAT
RESULT = 8 IF TYPE < 0
!
DATA == RECORD(ADR)
!
DATA_START = LOB
DATA_BITSIZE = BITSIZE(TYPE)
DATA_BADSTART = X'5000'
DATA_NNTSTART = NNTSTART(TYPE)
DATA_NNTSIZE = NNTSIZE(TYPE)
DATA_NNTTOP = NNTTOP(TYPE)
DATA_NNTHASH = NNTHASH(TYPE)
DATA_INDEXSTART = INDEX START(TYPE)
DATA_FILESTART = FILE START(TYPE)
DATA_END = HIB
RESULT = 0
END ; ! FBASE2
!
!-----------------------------------------------------------------------
!
ROUTINE UDERRS(INTEGER N)
WRSS("FLAG =", DERRS(N))
END ; ! UDERRS
!
!
!
ROUTINE WRSU(STRING (255) S, INTEGER N)
PRINTSTRING(S)
WRSS(" FLAG =", DERRS(N))
END
!
!-----------------------------------------------------------------------
!
ROUTINE GUAF(STRINGNAME USER, INTEGERNAME FSYS)
! GET USER AND FSYS
RDSTRG("User: ", USER)
RDFSYS("Fsys: ", FSYS)
END ; ! GUAF
!
!-----------------------------------------------------------------------
!
ROUTINE GUAFAF(STRINGNAME USER, INTEGERNAME FSYS, STRINGNAME FILE)
RDSTRG("User: ", USER)
RDFSYS("Fsys: ", FSYS)
RDSTRG("File: ", FILE)
END ; ! GUAFAF
!
!-----------------------------------------------------------------------
!
ROUTINE GET FSYSS(INTEGERARRAYNAME A, INTEGERNAME N)
INTEGER FSYS, NSYS, P, J, W
RDFSYS("Fsys: ", FSYS)
!
IF FSYS < 0 THEN GET AV FSYS(NSYS, A) ELSE A(0) = FSYS AND NSYS = 1
!
N = NSYS
P = 1
UNTIL P = 1 CYCLE
P = 1
IF NSYS > 1 START
CYCLE J = 0, 1, NSYS - 2
IF A(J) > A(J + 1) START
P = 0
W = A(J)
A(J) = A(J + 1)
A(J + 1) = W
FINISH
REPEAT
FINISH
REPEAT
END ; ! GET FSYSS
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE BAD PAGES(STRING (255) S)
ROUTINE PRINT(INTEGER FSYS, BITNO)
INTEGER I, CYL, TK, PG
WRITE(BITNO, 5)
SPACES(2)
PHEX(BITNO)
SPACES(2)
I = BIT TO CYL TK PG(CYL, TK, PG, FSYS, BITNO)
IF I # 0 START
PRINTSTRING("ERROR FOR BITNO ")
PHEX(BITNO)
NEWLINE
RETURN
FINISH
WRITE(CYL, 5)
SPACES(2)
PHEX(CYL)
SPACES(2)
WRITE(TK, 5)
SPACES(2)
PHEX(TK)
WRITE(PG, 8)
NEWLINE
END ; ! PRINT
!
ROUTINE ONE BAD PAGE(INTEGER FSYS)
INTEGER I, J, LISTAD, N, HDR, TOP
INTEGERARRAY LIST(0:5119)
RECORD (DATAF)DATA
LISTAD = ADDR(LIST(0))
J = DSYSAD(6, LISTAD, FSYS); ! COPY BAD-PAGES-BIT MAP
-> OUT UNLESS J = 0
!
J = FBASE2(FSYS, ADDR(DATA))
-> OUT UNLESS J = 0
!
TOP = (DATA_BITSIZE >> 2) - 1
HDR = 0; ! header not (yet) written
!
CYCLE I = 0, 1, TOP
N = LIST(I)
CYCLE J = 0, 1, 31
EXITIF N = 0
IF N < 0 START
IF HDR = 0 START
HDR = 1
WRSN("Summary of bad pages on FSYS ", FSYS)
WRS(" Bitno Cyl Track Page")
WRS(" dec hex dec hex dec hex")
FINISH
PRINT(FSYS, 32 * I + J)
FINISH
N = N << 1
REPEAT
REPEAT
!
WRSN("No bad pages on fsys ", FSYS) IF HDR = 0
RETURN
OUT:
ERROR("Fsys " . ITOS(FSYS) . " ")
END ; ! ONE BAD PAGE
!
INTEGER NSYS, F
INTEGERARRAY A(0:99)
GET FSYSS(A, NSYS)
!
CYCLE F = 0, 1, NSYS - 1
ONE BAD PAGE(A(F))
REPEAT
END ; ! BAD PAGES
!
!
!------------------------------------------------------------------
!
ROUTINE UNWIND(INTEGER A, B)
INTEGERNAME BP, BM
RECORD (FHDRF) NAME AH, BH
!
ROUTINE PIECE(INTEGER ADR, L)
IF BP < BM START ; ! output file not yet full
L = L - ADR
L = BM - BP IF BP + L > BM
MOVE(L, A + ADR, B + BP)
BP = BP + L
FINISH
END
!
AH == RECORD(A)
BH == RECORD(B)
BP == BH_NEXTFREEBYTE
BM == BH_MAXBYTES
!
IF AH_NEXTCYCLIC = AH_NEXTFREEBYTE START ; ! not wrapped round
PIECE(AH_TXTRELST, AH_NEXTFREEBYTE)
FINISHELSESTART
PIECE(AH_NEXTCYCLIC, AH_NEXTFREEBYTE)
IF AH_NEXTCYCLIC > AH_TXTRELST START
PIECE(AH_TXTRELST, AH_NEXTCYCLIC)
FINISH
FINISH
!
BH_ZERO = 3; ! character file
END ; ! UNWIND
!
!----------------------------------------------------------
!
EXTERNALROUTINE LOGOUT(STRING (255) S)
INTEGER FA2, J, LP, FSYS, SEG, GAP
STRING (63) USER, LOGFILE
LP = 0
GUAF(USER, FSYS)
J = DSFI(USER, FSYS, 19, 0, ADDR(LOGFILE))
->ERR UNLESS J = 0
WRS("NO LOG FILE") ANDRETURNIF LENGTH(LOGFILE) = 0
FA2 = NWFILEAD("T#OUT", 16); ! 16 EPAGES
RETURNIF FA2 = 0
SEG = 0
GAP = 0
J = DCONNECT(USER, LOGFILE, FSYS, SWR, 0, SEG, GAP)
->ERR UNLESS (J = 0) OR (J = 34)
UNWIND(SEG << 18, FA2)
WRS("T#OUT written")
IF J = 34 THEN J = 0 ELSE J = DDISCONNECT(USER, LOGFILE, FSYS, 0)
ERR:
ERROR("LOGOUT") UNLESS J = 0
END ; ! LOGOUT
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE CCKOUT(STRING (255) S)
INTEGER J, TO, SEG, GAP, FSYS
RDFSYS("Fsys: ", FSYS) UNTIL FSYS >= 0
TO = NWFILEAD("T#OUT", 64); ! 64 EPAGES
UNLESS TO = 0 START
SEG = 0
GAP = 0
J = DCONNECT("VOLUMS", "CCKMESS", FSYS, 11, 0, SEG, GAP)
UNLESS 0 # J # 34 START
UNWIND(SEG << 18, TO)
J = DDISCONNECT("VOLUMS", "CCKMESS", FSYS, 0) IF J = 0
J = 0 IF J = 34
FINISH
FINISH
!
IF J = 0 THEN WRS("T#OUT WRITTEN") ELSE WRSS("FLAG =", DERRS(J))
END ; ! CCKOUT
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE LOST FILES(STRING (255) S)
INTEGER FAD, J
RECORD (LOSTF) NAME L
RECORD (FHDRF) NAME F
INTEGER FSYS, SEG, GAP
RDFSYS("Fsys: ", FSYS)
SEG = 0
GAP = 0
J = DCONNECT("VOLUMS", "LOSTFILES", FSYS, 9, 0, SEG, GAP)
IF 34 # J # 0 START
WRSU("VOLUMS.LOSTFILES", J)
FINISHELSESTART
FAD = SEG << 18
F == RECORD(FAD)
J = FAD + F_NEXTFREEBYTE - LOSTFLEN
WHILE J > FAD CYCLE
L == RECORD(J)
PRINTSTRING(L_DATE)
SPACE
PRINTSTRING(L_TIME)
SPACE
WRSSS(L_USER, ".", L_FILE)
J = J - LOSTFLEN
REPEAT
J = DDISCONNECT("VOLUMS", "LOSTFILES", FSYS, 0)
WRSU("DDISCONN VOLUMS.LOSTFILES", J) UNLESS J = 0
FINISH
END ; ! LOST FILES
!
!------------------------------------------------------------
!
EXTERNALROUTINE DIRLOG(STRING (255) S)
INTEGER TO, J, SEG, GAP
J = 99
TO = NWFILEAD("T#OUT", 32)
UNLESS TO = 0 START
SEG = 0
GAP = 0
J = DCONNECT("VOLUMS", "#DIRLOG", - 1, 11, 0, SEG, GAP)
IF J = 0 OR J = 34 START
UNWIND(SEG << 18, TO)
J = DDISCONNECT("VOLUMS", "#DIRLOG", - 1, 0) IF J = 0
J = 0 IF J = 34
FINISH
FINISH
!
IF J = 0 THEN WRS("T#OUT WRITTEN") ELSE WRSS("FLAG =", DERRS(J))
END ; ! DIRLOG
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SETDIR(STRING (255) S)
INTEGER I
RECORD (UINF) NAME UIN
UIN == RECORD(9 << 18)
IF LENGTH(S) = 1 START
I = BYTEINTEGER(ADDR(S) + 1) - '0'
IF 0 <= I <= 3 START
WRSN("FLAG =", DSFI(UIN_USER, UIN_FSYS, 8, 1, ADDR(I)))
RETURN
FINISH
FINISH
!
WRS("Param must be <n>, 0<=n<=3")
END
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE MYLOG(STRING (255) S)
INTEGER J, SEG, GAP, TO
STRING (31) LOGFILE
RECORD (UINF) NAME UIN
UIN == RECORD(9 << 18)
J = DSFI(UIN_USER, UIN_FSYS, 19, 0, ADDR(LOGFILE))
J = 32 IF J = 0 = LENGTH(LOGFILE)
IF J = 0 START
J = 99
TO = NWFILEAD("T#OUT", 16)
UNLESS TO = 0 START
SEG = 0
GAP = 0
J = DCONNECT(UIN_USER, LOGFILE, UIN_FSYS, 11, 0, SEG, GAP)
IF J = 0 OR J = 34 START
UNWIND(SEG << 18, TO)
J = DDISCONNECT(UIN_USER, LOGFILE, UIN_FSYS, 0) IF J = 0
J = 0 IF J = 34
FINISH
FINISH
FINISH
!
IF J = 0 THEN WRS("T#OUT WRITTEN") ELSE WRSS("FLAG =", DERRS(J))
END
!
!-----------------------------------------------------------------------
!
ROUTINE PNSTRG(STRING (255) S)
IF S = "" THEN S = "<null>"
WRS(S)
END ; ! PNSTRG
!
!-----------------------------------------------------------------------
!
!******************* GET/SET ROUTINES *******************
!
! NB THE '39' BELOW COULD BECOME 'TOPSFI' AGAIN
!
CONSTSTRING (15) ARRAY TYPES(0:TOPSFI)= C
"BASEFILE",
"DELIVERY",
"CONTROLFILE",
"ADDRTELE",
"INDEXUSE",
"",
"LASTLOGON",
"ACR",
"DIRVSN",
"ARCHINDUSE",
"STKKB",
"MAXKB",
"MAXFILE",
"CURRPROCS",
"MAXPROCS",
"CODES",
"DIRMON",
"SIGMON",
"SURNAME",
"LOGFILE",
"CUMINSTRS",
"SESSINSTRS",
"DINSTRS",
"CUMPTRNS",
"SESSPTRNS",
"NKBOUT",
"NKBIN",
"CUMMSECS",
"SESSMSECS",
"CONNECTT",
"FILES",
"AFILES",
"ISESSM",
"FUNDS",
"GPFSYS",
"SPECIALSS",
"BATCHSS",
"GPHOLDR",
"PRIVILEGES",
"DEFAULTLP",
"",
"",
"",
"MAILCOUNT",
"SUPERVISOR"
OWNINTEGERARRAY ELEMENTS(0:119)= C
'S', 1, 0,
'S', 1, 0,
'S', 1, 0,
'S', 1, 0,
'I', 12, 1,
'0', 0, 0,
'0', 0, 38,
'I', 1, 0,
'I', 1, 0,
'I', 12, 13,
'I', 1, 0,
'I', 1, 0,
'I', 1, 0,
'I', 2, 25,
'I', 3, 25,
'I', 1, 0,
'I', 1, 0,
'I', 2, 28,
'S', 1, 0,
'S', 1, 0,
'I', 2, 25,
'I', 1, 0,
'I', 1, 0,
'I', 2, 25,
'I', 1, 0,
'I', 1, 0,
'I', 1, 0,
'I', 2, 25,
'I', 1, 0,
'I', 1, 0,
'I', 6, 30,
'I', 2, 36,
'I', 1, 0,
'I', 1, 0,
'I', 1, 0,
'S', 1, 0,
'S', 1, 0,
'S', 1, 0,
'0', 0, 0,
'S', 1, 0
CONSTSTRING (13) ARRAY SPTEXT(1:39)= C
"FILES: ",
"USEDFDS: ",
"FREEBYTES: ",
"INDEX SIZE: ",
"POOL 0 USED: ",
" FREE: ",
"POOL 1 USED: ",
" FREE: ",
"POOL 2 USED: ",
" FREE: ",
"POOL 3 USED: ",
" FREE: ",
"AFILES: ",
"USEDAFDS: ",
"",
"AINDEX SIZE: ",
"",
"",
"",
"",
"",
"",
"",
"",
"INTERACTIVE: ",
"BATCH: ",
"TOTAL: ",
"SIGMON: ",
"MONITORING: ",
"FILES: ",
"TOTKB: ",
"CHERFILES: ",
"CHERKB: ",
"",
"TEMPKB: ",
"AFILES: ",
"AKB: ",
"I LASTLOGON: ",
"B LASTLOGON: "
CONSTSTRING (6) ARRAY PRIV(0:31)= C
"PRIV00",
"PRIV01",
"PRIV02",
"PRIV03",
"PRIV04",
"PRIV05",
"PRIV06",
"PRIV07",
"PRIV08",
"PRIV09",
"PRIV10",
"PRIV11",
"PRIV12",
"PRIV13",
"PRIV14",
"PRIV15",
"PRIV16",
"PRIV17",
"PRIV18",
"PRIV19",
"PRIV20",
"PRIV21",
"PRIV22",
"PRIV23",
"PRIV24",
"PRIV25",
"PRIV26",
"PRIV27",
"PRIV28",
"PRIV29",
"PRIV30",
"PRIV31"
OWNRECORD (TABLEF) ARRAYNAME TABLE
!
!-----------------------------------------------------------------------
!
ROUTINE PURGE(STRINGNAME S, STRING (1) T)
STRING (255) L, R
! PURGE THE STRING S OF ALL
! OCCURANCES OF T.
S = L.R WHILE S - > L.(T).R
END ; ! RTN. PURGE
!
!------------------------------------------------------------------
!
INTEGERFN LOOK UP(STRING (31) WHAT, STRINGARRAYNAME KEYS, INTEGER LIM)
INTEGER I
!
CYCLE I = 0, 1, LIM
IF KEYS(I) = WHAT THENRESULT = I
REPEAT
RESULT = - 1
END ; ! LOOK UP
!
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE GET(STRING (255) S)
INTEGER TYPE, FSYS, J, I, LIM, SPTEXTPOINTER
STRING (31) WHAT, USER
INTEGERARRAY FIELD(0:31)
TABLE == ARRAY(ADDR(ELEMENTS(0)), TABLEAF)
RDSTRG("What: ", WHAT)
TYPE = LOOK UP(WHAT, TYPES, TOPSFI)
!
IF TYPE < 0 THEN PRINTSTRING("NOT KNOWN") ANDRETURN
GUAF(USER, FSYS)
J = DSFI(USER, FSYS, TYPE, 0, ADDR(FIELD(0)))
ERROR("GET") ANDRETURNUNLESS J = 0
PNSTRG(STRING(ADDR(FIELD(0)))) ANDRETURNIF TABLE(TYPE)_IORS = 'S'
WRITE(FIELD(0), 1) ANDRETURNIF TABLE(TYPE)_HOWMANY = 1
NEWLINE
LIM = TABLE(TYPE)_HOWMANY - 1
UNLESS LIM < 0 START
SPTEXTPOINTER = TABLE(TYPE)_TOSPTEXT
CYCLE I = 0, 1, LIM
IF SPTEXT(I + SPTEXTPOINTER) # "" START
WRSN(SPTEXT(I + SPTEXTPOINTER), FIELD(I))
FINISH
REPEAT
FINISH
IF TYPE = 6 START ; ! LAST LOGON
CYCLE I = 0, 1, 1
PRINTSTRING(SPTEXT(38 + I))
PHEX(FIELD(I))
PRINTSTRING(" => ".UNPACKDATE(FIELD(I))." ".UNPACKTIME(FIELD C
(I)))
NEWLINE
REPEAT
FINISH
IF TYPE = 38 START ; ! PRIVILEGES
NEWLINE
PRINTSTRING("*NONE*") ANDRETURNIF FIELD(0) = 0
CYCLE I = 0, 1, 31
IF FIELD(0) & 1 = 1 THEN WRS(PRIV(I))
FIELD(0) = FIELD(0) >> 1
EXITIF FIELD(0) = 0
REPEAT
FINISH
END ; ! GET
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SET(STRING (255) S)
INTEGER TYPE, FSYS, J, I, BITNO, LIM, SPTEXTPOINTER, PATTERN
STRING (31) WHAT, USER, REPLY, GIVEORREMOVE
INTEGERARRAY FIELD(0:31)
CONSTINTEGERARRAY INVALID(1:10)= 4,6,9,21,22,24,28,30,31,34
TABLE == ARRAY(ADDR(ELEMENTS(0)), TABLEAF)
RDSTRG("What: ", WHAT)
TYPE = LOOK UP(WHAT, TYPES, TOPSFI)
WRS("NOT KNOWN") ANDRETURNIF TYPE < 0
!
J = - 1
CYCLE I = 1, 1, 10
J = I ANDEXITIF TYPE = INVALID(I)
REPEAT
UNLESS J = - 1 START
WRS("NOT ALLOWED")
RETURN
FINISH
!
GUAF(USER, FSYS)
IF TABLE(TYPE)_HOWMANY = 1 START
IF TABLE(TYPE)_IORS = 'I' THEN C
RDINT("New value: ", FIELD(0)) ELSE C
PROMPT("NEW VALUE: ") AND INSTRG(STRING(ADDR(FIELD(0))))
FINISHELSESTART
LIM = TABLE(TYPE)_HOWMANY - 1
SPTEXTPOINTER = TABLE(TYPE)_TOSPTEXT
UNLESS LIM < 0 START
CYCLE I = 0, 1, LIM
RDINT(SPTEXT(I + SPTEXTPOINTER), FIELD(I))
REPEAT
FINISH
FINISH
!
IF TYPE = 38 START
! GET CURRENT VALUE
J = DSFI(USER, FSYS, 38, 0, ADDR(FIELD(0)))
ERROR("GET PRIV") ANDRETURNUNLESS J = 0
!
WRS("CURRENT PRIVILEGES ARE:")
J = FIELD(0)
IF J = 0 THEN WRS("*NONE*") ELSESTART
CYCLE I = 0, 1, 31
WRS(PRIV(I)) IF J & 1 = 1
J = J >> 1
EXITIF J = 0
REPEAT
FINISH
WRS("1. TERMINATE 'PRIV: ' PROMPT WITH .END")
WRS("2. 'G/R: ' PROMPT MEANS GIVE OR REMOVE PRIVILEGE.")
WRS("REPLY 'G' OR 'R'")
CYCLE
RDSTRG("Priv: ", REPLY)
PURGE(REPLY, " ")
EXITIF REPLY = ".END"
BITNO = LOOK UP(REPLY, PRIV, 31)
IF BITNO < 0 THEN WRS(" NOT KNOWN") ELSESTART
RDSTRG("G/R: ", GIVEORREMOVE) UNTIL C
GIVEORREMOVE = "G" OR GIVEORREMOVE = "R"
PATTERN = 1 << BITNO
IF GIVEORREMOVE = "G" THEN C
FIELD(0) = FIELD(0) ! PATTERN ELSE C
FIELD(0) = FIELD(0) & ( ¬ PATTERN)
FINISH
REPEAT
FINISH
J = DSFI(USER, FSYS, TYPE, 1, ADDR(FIELD(0)))
UNLESS J = 0 THEN ERROR("SET") ANDRETURN
IF TYPE = 38 START
WRS("PRIVILEGES ARE NOW:")
J = FIELD(0)
IF J = 0 THEN WRS("*NONE*") ELSESTART
CYCLE I = 0, 1, 31
WRS(PRIV(I)) IF J & 1 = 1
J = J >> 1
EXITIF J = 0
REPEAT
FINISH
FINISH
WRS("Finished O.K.")
END ; ! SET
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE CREATE LOG FILE(STRING (255) S)
RECORD (H F) NAME H
STRING (255) USER, FILE
INTEGER J, FSYS, AD
INTEGER SEG, GAP
RECORD (UINF) NAME UIN
UIN == RECORD(9 << 18)
SEG = 0
GAP = 0
GUAF(USER, FSYS)
RDSTRG("Logfile: ", FILE)
!
J = DCREATE(USER, FILE, FSYS, 256, 8)
->ERR UNLESS J = 0
!
J = DPERMISSION(USER, UIN_USER, "", FILE, FSYS, 2, 7)
->ERR UNLESS J = 0
!
J = DCONNECT(USER, FILE, FSYS, 3, 0, SEG, GAP)
->ERR UNLESS J = 0
!
AD = SEG << 18
H == RECORD(AD)
H_NEXT FREE BYTE = 32
H_TXT REL ST = 32
H_MAXBYTES = 256 << 10
H_READ TO = 32
H_NEXT CYCLIC = 32
!
J = DSFI(USER, FSYS, 19, 1, ADDR(FILE))
RETURNIF J = 0
ERR:
ERROR("CREATE LOG FILE")
END ; ! CREATE LOG FILE
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSFSTATUS(STRING (255) S)
STRING (63) USER, FILE
INTEGER FSYS, ACT, VALUE, J
GUAFAF(USER, FSYS, FILE)
RDINT("Act: ", ACT)
RDINT("Value: ", VALUE)
!
LOOP:
J = DFSTATUS(USER, FILE, FSYS, ACT, VALUE)
UDERRS(J)
!
RDSTRG("File/.END: ", FILE)
->LOOP UNLESS FILE = ".END" OR FILE = ".E"
END ; ! SSFSTATUS
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSRENAME(STRING (255) S)
STRING (31) USER, FILE, NEWNAME
INTEGER FSYS, J
GUAF(USER, FSYS)
RDSTRG("File: ", FILE)
RDSTRG("Newname: ", NEWNAME)
J = DRENAME(USER, FILE, NEWNAME, FSYS)
UDERRS(J)
END ; ! SSRENAME
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSDESTROY(STRING (255) S)
STRING (31) USER, FILE
INTEGER FSYS, J
GUAFAF(USER, FSYS, FILE)
UNTIL FILE = ".END" OR FILE = ".E" CYCLE
J = DDESTROY(USER, FILE, "", FSYS, 0)
UDERRS(J)
RDSTRG("File/.END: ", FILE)
REPEAT
END ; ! SSDESTROY
!
!-----------------------------------------------------------------------
!
ROUTINE ASORTFILES(RECORD (OINFF) ARRAYNAME P, INTEGERARRAYNAME X,
INTEGER N)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
!NOTIMP80 %RECORDSPEC P(OINFF)
INTEGER I, J, K, M, W
RETURNUNLESS N > 0
!
CYCLE I = 1, 1, N
X(I) = I
REPEAT
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXITIF M = 0
CYCLE I = 1, 1, N - M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXITIF P(X(K))_NAME <= P(X(J))_NAME
W = X(J)
X(J) = X(K)
X(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END ; ! ASORT FILES
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSFILES(STRING (255) S)
CONSTINTEGER MAX= 512
STRING (31) USER
INTEGERARRAY I(0:15)
INTEGER J, FSYS, N, FROMREC, NGIVEN, TOT
RECORD (OINFF) ARRAY FLIS(0:MAX)
INTEGERARRAY X(1:MAX)
GUAF(USER, FSYS)
FROMREC = 0
NGIVEN = MAX; ! SET TO MAX PREPARED TO RECIEVE
J = DFILENAMES(USER, FLIS, FROMREC, NGIVEN, N, FSYS, 0)
WRSN("FLAG =", J) ANDRETURNIF J # 0
WRSN("NO OF RECORDS RETURNED =", NGIVEN)
WRSN("NO OF FILES: ", N)
IF NGIVEN > 15 START
DEFINE("77,T#OUT")
SELECT OUTPUT(77)
FINISH
!
FLIS(NGIVEN) = FLIS(0); ! for the sort routine
IF NGIVEN > 0 THEN ASORT FILES(FLIS, X, NGIVEN)
!
TOT = 0
J = 0
WHILE J < NGIVEN CYCLE
J = J + 1
WRS(FLIS(X(J))_NAME)
TOT = TOT + FLIS(X(J))_NKB
REPEAT
WRSN("CALCULATED KB =", TOT)
J = DSFI(USER, FSYS, 30, 0, ADDR(I(0)))
IF J = 0 THEN WRSN("KBYTES IN INDEX =", I(1)) ELSE WRSU("DSFI 30 ", J)
IF NGIVEN > 15 START
SELECT OUTPUT(0)
CLOSE STREAM(77)
CLEAR("77")
WRS("T#OUT written")
FINISH
END ; ! SSFILES
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSFFILES(STRING (255) S)
CONSTINTEGER MAX= 512
STRING (31) USER
INTEGERARRAY I(0:15)
INTEGER J, FSYS, N, FROMREC, NGIVEN, TOT
RECORD (OINFF) ARRAY FLIS(0:MAX)
INTEGERARRAY X(1:MAX)
ROUTINESPEC FQINFO(RECORD (OINFF) NAME X)
GUAF(USER, FSYS)
FROMREC = 0
NGIVEN = MAX; ! SET TO MAX PREPARED TO RECIEVE
J = DFILENAMES(USER, FLIS, FROMREC, NGIVEN, N, FSYS, 0)
WRSN("FLAG =", J) ANDRETURNIF J # 0
WRSN("NO OF RECORDS RETURNED =", NGIVEN)
WRSN("NO OF FILES: ", N)
IF NGIVEN > 15 START
DEFINE("77,T#OUT")
SELECT OUTPUT(77)
FINISH
!
WRS(" Epages Ownp Eep Use SSbyte Pool")
FLIS(NGIVEN) = FLIS(0); ! for the sort routine
IF NGIVEN > 0 THEN ASORT FILES(FLIS, X, NGIVEN)
!
TOT = 0
J = 0
WHILE J < NGIVEN CYCLE
J = J + 1
FQINFO(FLIS(X(J)))
TOT = TOT + FLIS(X(J))_NKB
REPEAT
NEWLINE
WRSN("CALCULATED KB =", TOT)
J = DSFI(USER, FSYS, 30, 0, ADDR(I(0)))
IF J = 0 THEN WRSN("TOT KBYTES", I(1)) ELSE WRSU("DSFI 30 ", J)
IF NGIVEN > 15 START
SELECT OUTPUT(0)
CLOSE STREAM(77)
CLEAR("77")
WRS("T#OUT written")
FINISH
!
ROUTINE FQINFO(RECORD (OINFF) NAME X)
!NOTIMP80 %RECORDSPEC X(OINFF)
IF X_CODES & CHERSH # 0 THEN PRINTSYMBOL('*') ELSE SPACE
SPACE
PRINTSTRING(X_NAME)
SPACES(14 - OUTPOS)
IF X_NKB >> 2 > 15 THEN PRINTSYMBOL('X') ELSE SPACE
PRINTSTRING(HTOS(X_NKB >> 2, 3))
WRITE(X_OWNP, 4)
WRITE(X_EEP & 15, 4)
WRITE(X_USE, 4)
WRITE(X_SSBYTE, 4)
WRITE(X_SP29, 4)
IF X_CODES & UNAVA # 0 THEN PRINTSTRING("; UNAVA")
IF X_CODES & PRIVAT # 0 THEN PRINTSTRING("; PRIVAT")
IF X_CODES & VIOLAT # 0 THEN PRINTSTRING("; VIOL")
IF X_CODES & TEMPFS # 0 THEN PRINTSTRING("; ")
IF X_CODES & VTEMPF # 0 THEN PRINTSTRING("V")
IF X_CODES & TEMPFS # 0 THEN PRINTSTRING("TEMPFI")
IF X_CODES & NOARCH # 0 THEN PRINTSTRING("; NOARCH")
IF X_CODES2 & (NEWGE ! OLDGE) # 0 THEN PRINTSTRING("; GENRS")
IF X_CODES2 & WRCONN # 0 THEN PRINTSTRING("; WRCONN")
IF X_CODES2 & DISCFI # 0 THEN PRINTSTRING("; DISCFI")
NEWLINE
END ; ! FQINFO
!
!-----------------------------------------------------------------------
!
END ; ! SSFFILES
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSPERMISSIONS(STRING (255) S)
RECORD (RETF) P
STRING (31) FILE, USER
INTEGER I, J, TYPE, FSYS
ROUTINESPEC OUT(INTEGER A)
GUAFAF(USER, FSYS, FILE)
IF FILE # ".ALL" START
J = DPERMISSION(USER, "", "", FILE, FSYS, 4, ADDR(P))
! GIVE LIST FOR FILE
TYPE = 4
IF J # 0 THEN ->MONPRM
PRINTSTRING("OWNP: "); OUT(P_OWNP)
PRINTSTRING("; EEP: "); OUT(P_EEP); NEWLINE
I = 0
J = 16
WHILE J < P_BYTES CYCLE
SPACE; PRINTSTRING(P_INDIV(I)_USER)
OUT(P_INDIV(I)_UPRM); NEWLINE
J = J + 8
I = I + 1
REPEAT
FINISH ; ! S NOT ""
J = DPERMISSION(USER, "", "", FILE, FSYS, 8, ADDR(P))
! GIVE LIST FOR INDEX
TYPE = 8
IF J # 0 THEN ->MONPRM
PRINTSTRING("Whole-index permissions:")
NEWLINE
I = 0
J = 16
WHILE J < P_BYTES CYCLE
SPACE
PRINTSTRING(P_INDIV(I)_USER)
OUT(P_INDIV(I)_UPRM); NEWLINE
J = J + 8
I = I + 1
REPEAT
RETURN
MONPRM:
PRINTSTRING("DPERM"); WRITE(TYPE, 1)
PRINTSTRING(" FLAG ="); WRITE(J, 1); NEWLINE
RETURN
ROUTINE OUT(INTEGER A)
SPACE
IF A & 4 # 0 THEN PRINTSTRING("X")
IF A & 2 # 0 THEN PRINTSTRING("W")
IF A & 1 # 0 THEN PRINTSTRING("R")
END ; ! OUT
!
!-----------------------------------------------------------------------
!
END ; ! SSPERMISSIONS
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSTRANSFER(STRING (255) S)
STRING (31) USER1, USER2, FILE1, FILE2
INTEGER FSYS1, FSYS2, J
WRS("FROM :-")
GUAFAF(USER1, FSYS1, FILE1)
WRS("TO :-")
GUAFAF(USER2, FSYS2, FILE2)
J = DTRANSFER(USER1, USER2, FILE1, FILE2, FSYS1, FSYS2, 1)
WRSN("FLAG =", J)
END ; ! SSTRANSFER
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SSFINFO(STRING (255) S)
RECORD (DFINFRECF) X
STRING (63) USER, FILE
INTEGER J, FSYS
!
GUAFAF(USER, FSYS, FILE)
X = 0
J = DFINFO(USER, FILE, FSYS, ADDR(X))
IF J # 0 THEN UDERRS(J) ANDRETURN
IF X_CODES & CHERSH # 0 THEN PRINTSYMBOL('*') AND SPACE
PRINTSTRING(FILE.":")
PRINTSTRING(" CONN ")
IF X_CONSEG > 15 THEN PRINTSYMBOL('X')
PRINTSTRING(HTOS(X_CONSEG, 2))
PRINTSTRING("; PGS ")
IF X_NKB >> 2 > 15 THEN PRINTSYMBOL('X')
PRINTSTRING(HTOS(X_NKB >> 2, 3))
PRINTSTRING("; OWP"); WRITE(X_RUP, 1)
PRINTSTRING("; EEP"); WRITE(X_EEP & 15, 1)
PRINTSTRING("; APF "); PRINTSTRING(HTOS(X_APF, 3))
PRINTSTRING("; USERS"); WRITE(X_USE, 1)
PRINTSTRING("; POOL"); WRITE(X_SSBYTE, 1)
IF LENGTH(X_OFFER) = 6 THEN PRINTSTRING("; OFF: ".X_OFFER)
IF X_CODES & VIOLAT # 0 THEN PRINTSTRING("; VIOL")
IF X_CODES & TEMPFS # 0 THEN PRINTSTRING("; ")
IF X_CODES & VTEMPF # 0 THEN PRINTSTRING("V")
IF X_CODES & TEMPFS # 0 THEN PRINTSTRING("TEMPFI")
IF X_CODES & NOARCH # 0 THEN PRINTSTRING("; NOARCH")
IF X_CODES2 & (NEWGE ! OLDGE) # 0 THEN PRINTSTRING("; GENRS")
NEWLINE
WRSN("SSBYTE =", X_SSBYTE) IF X_SSBYTE # 0
END ; ! SSFINFO
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE SET SSBYTE(STRING (255) S)
STRING (31) USER, FILE
INTEGER FSYS, J, VALUE
GUAFAF(USER, FSYS, FILE)
RDINT("SSBYTE VALUE: ", VALUE)
J = DFSTATUS(USER, FILE, FSYS, 18, VALUE)
UDERRS(J)
END ; ! SET SSBYTE
!
!-----------------------------------------------------------------------
!
ROUTINE DOARCHBIT(INTEGER OP)
STRING (31) USER, FILE
INTEGER FSYS, J
GUAFAF(USER, FSYS, FILE)
J = DFSTATUS(USER, FILE, FSYS, OP, 0)
UDERRS(J)
END ; ! DOARCHBIT
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE ARCHOFF(STRING (255) S)
DOARCHBIT(17)
END ; ! ARCHOFF
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE ARCHON(STRING (255) S)
DOARCHBIT(16)
END ; ! ARCHON
!
!-----------------------------------------------------------------------
!
ROUTINE NAMESORT(RECORD (NNEF) ARRAYNAME P, INTEGERARRAYNAME X, INTEGER N)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
!NOTIMP80 %RECORDSPEC P(NNEF)
INTEGER I, J, K, M, W
RETURNUNLESS N > 0
!
CYCLE I = 1, 1, N
X(I) = I
REPEAT
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXITIF M = 0
CYCLE I = 1, 1, N - M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXITIF P(X(K))_SURNAME <= P(X(J))_SURNAME
W = X(J)
X(J) = X(K)
X(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END ; ! NAMESORT
!
!-----------------------------------------------------------------------
!
ROUTINE ASORT(RECORD (NNEF) ARRAYNAME P, INTEGERARRAYNAME X, INTEGER N)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
!NOTIMP80 %RECORDSPEC P(NNEF)
INTEGER I, J, K, M, W
RETURNUNLESS N > 0
!
CYCLE I = 1, 1, N
X(I) = I
REPEAT
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXITIF M = 0
CYCLE I = 1, 1, N - M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXITIF P(X(K))_NN_NAME <= P(X(J))_NN_NAME
W = X(J)
X(J) = X(K)
X(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END ; ! ASORT
!
!-----------------------------------------------------------------------
!
ROUTINE NSORT(RECORD (NNEF) ARRAYNAME P, INTEGERARRAYNAME X, INTEGER N)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
!NOTIMP80 %RECORDSPEC P(NNEF)
INTEGER I, J, K, M, W
RETURNUNLESS N > 0
!
CYCLE I = 1, 1, N
X(I) = I
REPEAT
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXITIF M = 0
CYCLE I = 1, 1, N - M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXITIF P(X(K))_NN_INDNO <= P(X(J))_NN_INDNO
W = X(J)
X(J) = X(K)
X(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END ; ! NSORT
!
!-----------------------------------------------------------------------
!
INTEGERFN ALPHA(INTEGER CH)
RESULT = 1 IF 'A' <= CH <= 'Z' OR 'a' <= CH <= 'z'
RESULT = 0
END ; ! ALPHA
!
!-----------------------------------------------------------------------
!
ROUTINE UPSUR(STRINGNAME SURNAME)
INTEGER J
J = 0
WHILE J < LENGTH(SURNAME) CYCLE
J = J + 1
CHARNO(SURNAME, J) = CHARNO(SURNAME, J) & ( ¬ X'20')
REPEAT
END ; ! UPSUR
!
!-----------------------------------------------------------------------
!
ROUTINE SEPSUR(STRING (255) S, STRINGNAME INITS, SURNAME)
INTEGER L, J, SURPT, LETT FOUND, CH
STRING (63) REST, WK, A, B, REST2
SURPT = 1
LETT FOUND = 0
L = LENGTH(S)
L = 19 IF L > 19
J = L
WHILE J > 0 CYCLE
CH = CHARNO(S, J)
IF ALPHA(CH) # 0 THEN LETT FOUND = 1
! We are looking for the R-most '.' having chars to the right of it
IF CH = '.' THEN SURPT = J + 1 ANDEXIT
J = J - 1
REPEAT
WK = FROMSTR(S, SURPT, L)
WK = A.B WHILE WK - > A.(" ").B
INITS = FROMSTR(S, 1, SURPT - 1)
INITS = A.B WHILE INITS - > A.(" ").B
IF INITS - > REST.("DR").B AND REST = "" THEN INITS = "Dr".B
IF INITS - > REST.("MR").B AND REST = "" THEN INITS = "Mr".B
IF INITS - > REST.("MRS").B AND REST = "" THEN INITS = "Mrs".B
IF INITS - > REST.("MS").B AND REST = "" THEN INITS = "Ms".B
IF INITS - > REST.("ST").B AND REST = "" THEN INITS = "St".B
! Put the name except first char into lower case
J = 1
WHILE J < LENGTH(WK) CYCLE
J = J + 1
CH = CHARNO(WK, J)
IF ALPHA(CH) # 0 AND CH < 'a' THEN CHARNO(WK, J) = CH ! X'20'
REPEAT
IF WK - > REST2.("Mc").REST AND REST2 = "" THEN C
CHARNO(WK, 3) = CHARNO(WK, 3) & ( ¬ X'20')
IF WK - > REST2.("Mac").REST AND REST2 = "" THEN C
CHARNO(WK, 4) = CHARNO(WK, 4) & ( ¬ X'20')
SURNAME = WK
END ; ! SEPSUR
!
!-----------------------------------------------------------------------
!
ROUTINE UPDATE DIRECTORY(RECORD (NNEF) ARRAYNAME NN,
INTEGERARRAYNAME ALPH, INTEGER N)
!NOTIMP80 %RECORDSPEC NN(NNEF)
INTEGER J, FSYS
STRING (63) INITS, SUR
STRING (6) USER
DEFINE("62,SS#KK,1023")
SELECT OUTPUT(62)
PRINTSTRING("Directory of Usernames")
SPACES(10)
PRINTSTRING("Updated at ")
WRSSS(TIME, " on ", DATE)
J = 0
WHILE J < N CYCLE
J = J + 1
USER = NN(ALPH(J))_NN_NAME
FSYS = NN(ALPH(J))_FSYS
INITS = NN(ALPH(J))_INITS
SUR = NN(ALPH(J))_SURNAME
IF INITS # "" AND SUR # "" START
PRINTSTRING(INITS)
SPACES(6 - LENGTH(INITS))
PRINTSTRING(SUR)
SPACES(14 - LENGTH(SUR))
PRINTSTRING(USER)
PRINTSTRING(" Fsys")
WRITE(FSYS, 2)
SPACES(5)
UPSUR(SUR)
WRS(SUR)
FINISH
REPEAT
SELECT OUTPUT(0)
CLOSE STREAM(62)
CLEAR("62")
IF EXIST("USERNAMES") = 0 THEN RENAME("SS#KK,USERNAMES") ELSE C
NEWGEN("SS#KK,USERNAMES")
END ; ! UPDATE DIRECTORY
!
!-----------------------------------------------------------------------
!
ROUTINE FILLNNE(RECORD (NNEF) NAME NN)
!NOTIMP80 %RECORDSPEC NN(NNEF)
INTEGER K, FSYS, AD
INTEGERARRAY SCRATCH(1:12)
STRING (31) INITS, SUR
STRING (6) USER
STRING (31) NAME SSCRATCH
AD = ADDR(SCRATCH(1))
SSCRATCH == STRING(AD)
USER = NN_NN_NAME
FSYS = NN_FSYS
! ACR
K = DSFI(USER, FSYS, 7, 0, ADDR(NN_ACR))
IF K # 0 THENMONITOR
! MAXFILE
K = DSFI(USER, FSYS, 12, 0, ADDR(NN_MAXFILE))
IF K # 0 THENMONITOR
! MAXKB
K = DSFI(USER, FSYS, 11, 0, ADDR(NN_MAXKB))
IF K # 0 THENMONITOR
! CONCURR
K = DSFI(USER, FSYS, 14, 0, AD)
IF K # 0 THENMONITOR
NN_IMAX = SCRATCH(1)
NN_BMAX = SCRATCH(2)
NN_TMAX = SCRATCH(3)
! KBYTES OF FILE SPACE
K = DSFI(USER, FSYS, 30, 0, AD)
IF K # 0 THENMONITOR
NN_TOTKB = SCRATCH(2)
! ARCHIVE INDEX DATA
K = DSFI(USER, FSYS, 31, 0, AD)
IF K # 0 THENMONITOR
NN_AFILES = SCRATCH(1)
! NAME AND INITIALS
K = DSFI(USER, FSYS, 18, 0, AD)
IF K # 0 THENMONITOR
SEPSUR(SSCRATCH, INITS, SUR)
NN_INITS <- INITS
NN_SURNAME = SUR
! DELIVERY
K = DSFI(USER, FSYS, 1, 0, AD)
IF K # 0 THENMONITOR
NN_DELIV = SSCRATCH
END ; ! FILLNNE
!
!
!
ROUTINE PNNT(RECORD (NNEF) ARRAYNAME NN, INTEGERARRAYNAME ALPH, INTEGER N)
!NOTIMP80 %RECORDSPEC NN(NNEF)
INTEGER J, ENT, FSYS, L
STRING (6) USER
PRINTSTRING("Dated ")
PRINTSTRING(DATE)
SPACES(31)
WRS("---Archive Index----")
WRS(" Max Max Con- Total Files Kb Used Size")
PRINTSTRING("FSYS Name Kb No. ACR File Tot curr Kbytes")
SPACES(22)
WRS("Name Delivery")
WRS(" Kb Kb I.B.T Mb FDS Kb")
ENT = 0
WHILE ENT < N CYCLE
ENT = ENT + 1
L = ALPH(ENT)
USER = NN(L)_NN_NAME
FSYS = NN(L)_FSYS
WRITE(FSYS, 2)
SPACE
PRINTSTRING(USER)
WRITE(NN(L)_NN_KB, 1)
SPACE
J = NN(L)_NN_INDNO
PRINTSTRING(HTOS(J << 10 ! J, 5))
! ACR
IF NN(L)_ACR = 0 THEN SPACES(3) ELSE WRITE(NN(L)_ACR, 2)
! MAXFILE
WRITE(NN(L)_MAXFILE, 5)
! MAXKB
WRITE(NN(L)_MAXKB, 5)
! CONCURR
SPACES(2)
PRINTSTRING(ITOS(NN(L)_IMAX).".".ITOS(NN(L)_BMAX).".".ITOS(NN(L) C
_TMAX))
! KBYTES OF FILE SPACE
WRITE(NN(L)_TOTKB, 5)
! ARCHIVE INDEX DATA
SPACES(2)
WRITE(NN(L)_AFILES, 4)
SPACES(15)
PRINTSTRING(NN(L)_INITS)
SPACES(6 - LENGTH(NN(L)_INITS))
PRINTSTRING(NN(L)_SURNAME)
SPACES(14 - LENGTH(NN(L)_SURNAME))
! DELIVERY
SPACES(2)
WRS(NN(L)_DELIV)
REPEAT
END ; ! PNNT
!
!-----------------------------------------------------------------------
!
ROUTINE DUPLICATES(RECORD (NNEF) ARRAYNAME TT, INTEGER N,
INTEGERNAME SORTBYUSE, INTEGERARRAYNAME ALPH)
!NOTIMP80 %RECORDSPEC TT(NNEF)
INTEGER J, K, PFSYS
STRING (6) PNAM
STRING (255) DUPL
ROUTINESPEC PNAME
DUPL = "
The following names occur on more discs than one, as shown:
Name occurs on FSYS
"
IF SORTBYUSE = 0 THEN ASORT(TT, ALPH, N)
!
! NOW CYCLE UP WRITING OUT DUPLICATES AND CLEARING OUT NAME WHEN
! NOTED ONCE.
J = 0
WHILE J < N CYCLE
J = J + 1
IF LENGTH(TT(ALPH(J))_NN_NAME) = 6 START
PNAM = TT(ALPH(J))_NN_NAME
PFSYS = TT(ALPH(J))_FSYS
K = J
WHILE K < N CYCLE
K = K + 1
IF TT(ALPH(J))_NN_NAME = TT(ALPH(K))_NN_NAME START
PNAME
WRITE(TT(ALPH(K))_FSYS, 3); ! (THEN DULICATE)
TT(ALPH(K))_NN_NAME = ""
FINISHELSESTART
J = K - 1
EXIT
FINISH
REPEAT
FINISH
REPEAT
NEWLINE
RETURN
ROUTINE PNAME
RETURNIF PNAM = ""
IF DUPL # "" THEN PRINTSTRING(DUPL) AND DUPL = ""
NEWLINE
PRINTSTRING(PNAM)
WRITE(PFSYS, 3)
PNAM = ""
END ; ! PNAME
!
!-----------------------------------------------------------------------
!
END ; ! DUPLICATES
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE LIST NNT(STRING (255) S)
!
INTEGERARRAY ALPH, ALPHSUR(1:MAXUSERS)
INTEGERARRAY A(0:99)
RECORD (NNEF) ARRAYNAME TT
RECORD (NNF) ARRAY NN(0:TOPNNT)
RECORD (NNEF) ARRAY NNE(0:MAXUSERS - 1)
RECORD (NNEF) ARRAYFORMAT FF(0:MAXUSERS - 1)
INTEGER J, NSYS, FSYS, COMPLETE, TEMP, FAD, F, TOT, N
INTEGER SORTBYIND, SORTBYSUR, SORTBYUSE, WANTNAMES
STRING (31) FILE, REPLY
WRS(VSN)
FAD = NWFILEAD("T#K", 128)
RETURNIF FAD = 0
SORTBYIND = FALSE
SORTBYSUR = FALSE
SORTBYUSE = FALSE
WRS(" '-1' for all FSYS")
RDINT("Fsys: ", FSYS) UNTIL - 1 <= FSYS <= 99
IF FSYS < 0 THEN GETAVFSYS(NSYS, A) ELSE A(0) = FSYS AND NSYS = 1
IF NSYS = 1 START
WRS("Sort by username or by index no? Reply 'USE' or 'IND'")
PROMPT("Sort type? ")
UCSTRG(REPLY) UNTIL REPLY = "USE" OR REPLY = "IND"
IF REPLY = "IND" THEN SORTBYIND = TRUE
FINISHELSESTART
SORTBYIND = FALSE
WRS("Sort by username or by surname or both?
Reply 'USE' or 'SUR' or 'BOTH'")
PROMPT("Sort type? ")
UCSTRG(REPLY) UNTIL C
REPLY = "USE" OR REPLY = "SUR" OR REPLY = "BOTH"
IF REPLY = "USE" OR REPLY = "BOTH" THEN SORTBYUSE = TRUE
IF REPLY = "SUR" OR REPLY = "BOTH" THEN SORTBYSUR = TRUE
WRS("Do you wish the file USERNAMES to be created or
updated in your process? Reply 'YES','Y','NO' or 'N'")
PROMPT("Usernames? ")
UCSTRG(REPLY) UNTIL C
REPLY = "YES" OR REPLY = "Y" OR REPLY = "NO" OR REPLY = "N"
IF REPLY = "YES" OR REPLY = "Y" THEN WANTNAMES = TRUE ELSE C
WANTNAMES = FALSE
FINISH
PROMPT("To file/dev: ")
UCSTRG(FILE)
DEFINE("61,".FILE.",1023")
SELECT OUTPUT(61)
!
! SORT FILE SYSTEMS INTO ASCENDING ORDER
UNTIL COMPLETE # 0 CYCLE
COMPLETE = 1
J = 0
WHILE J < NSYS - 1 CYCLE
IF A(J) > A(J + 1) START
COMPLETE = 0
TEMP = A(J)
A(J) = A(J + 1)
A(J + 1) = TEMP
FINISH
J = J + 1
REPEAT
REPEAT
!
! Get usernames, create array for sorting each FSYS, and also add
! the names to the global array TOT.
J = 0
TT == ARRAY(FAD, FF)
TOT = 0
F = 0
WHILE F < NSYS CYCLE
FSYS = A(F)
J = GET USNAMES2(NN, N, FSYS)
IF J # 0 START
PRINTSTRING("GETUSNAMES FOR FSYS ")
WRITE(FSYS, 1)
WRSN(" FAILS ", J)
RETURN
FINISH
!
J = N
WHILE J > 0 CYCLE
NNE(J)_NN = NN(J-1)
NNE(J)_FSYS = FSYS
J = J - 1
REPEAT
!
NSORT(NNE, ALPH, N)
CYCLE J = 1, 1, N
FILLNNE(NNE(ALPH(J)))
REPEAT
! %IF SORTBYIND=FALSE %THEN ASORT(NNE,ALPH,N) %ELSE NSORT(NNE,ALPH,N)
IF SORTBYIND = FALSE THEN ASORT(NNE, ALPH, N)
PNNT(NNE, ALPH, N) IF NSYS = 1
! MOVE THIS FSYS'S NAMES INTO THE BIG ARRAY
! CAN IT BE DONE?
IF TOT + N >= MAXUSERS START
! NO
SELECT OUTPUT(0)
CLOSE STREAM(61)
CLEAR("61")
PRINTSTRING("Too many usernames(")
WRITE(MAXUSERS, 1)
PRINTSTRING("). Program terminated.")
NEWLINE
PRINTSTRING("Amend and re-compile.")
NEWLINE
RETURN
FINISH
MOVE(N * NNEFLEN, ADDR(NNE(1)), ADDR(TT(TOT + 1)))
TOT = TOT + N
F = F + 1
REPEAT
IF NSYS > 1 START
IF SORTBYSUR = TRUE START
PRINTSTRING("
Alphabetic by surname
")
NAMESORT(TT, ALPHSUR, TOT)
PNNT(TT, ALPHSUR, TOT)
FINISH
IF SORTBYUSE = TRUE AND SORTBYSUR = TRUE THEN NEWPAGE
IF SORTBYUSE = TRUE START
PRINTSTRING("
Alphabetic by username
")
ASORT(TT, ALPH, TOT)
PNNT(TT, ALPH, TOT)
FINISH
FINISH
DUPLICATES(TT, TOT, SORTBYUSE, ALPH)
SELECT OUTPUT(0)
CLOSE STREAM(61)
CLEAR("61")
IF NSYS > 1 AND WANTNAMES = TRUE START
NAMESORT(TT, ALPHSUR, TOT) IF SORTBYSUR = FALSE
UPDATE DIRECTORY(TT, ALPHSUR, TOT)
FINISH
NEWLINE
PRINTSTRING("LISTNNT ends normally")
END ; ! LIST NNT
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE USERNAMES(STRING (255) S)
LISTNNT(S)
END ; ! USERNAMES
!
!-----------------------------------------------------------------------
!
!************************** END OF LISTNNT ROUTINES ****************
!
!===================================================================
!* *
!
!-----------------------------------------------------------------------
!
INTEGERFN IHOLESHIST(INTEGER FSYS, INTEGERARRAYNAME A)
INTEGERARRAY BITMAP(0:5119)
INTEGER I, J, LO, HI, W, N, S
FILL((TOPSI + 1) << 2, ADDR(A(0)), X'00'); ! ZERO ARRAY A
J = DSYSAD(0, ADDR(BITMAP(0)), FSYS)
UDERRS(J) ANDRESULT = - J UNLESS J = 0
J = FBASE(LO, HI, FSYS)
! USER FILES RUN FROM BIT LO+X'100' TO HI
! WORD ALIGN
LO = (LO + X'100') >> 5
HI = HI >> 5
CYCLE I = LO, 1, HI
W = BITMAP(I)
!
N = 0; ! number of consecutive zero bits
S = 32; ! number of bits remaining to be examined
WHILE S > 0 CYCLE
IF W = 0 START
A(S) = A(S) + 1
EXIT
FINISH
IF W < 0 START
IF N > 0 START
A(N) = A(N) + 1
N = 0
FINISH
FINISHELSE N = N + 1
W = W << 1
S = S - 1
REPEAT
!
REPEAT
RESULT = 0
END ; ! IHOLESHIST
!
!-----------------------------------------------------------
!
ROUTINE ISECTHIST(INTEGER FSYS, INTEGERARRAYNAME A)
RECORD (NNF) ARRAY USERS(0:TOPNNT)
RECORD (DAF) DA
INTEGER I, J, NUSERS, FROMREC, NGIVEN, NFILES, K
RECORD (OINFF) ARRAY FLIS(0:255)
STRING (31) FILE
FILL((TOPSI + 1) << 2, ADDR(A(0)), X'00')
J = GETUSNAMES2(USERS, NUSERS, FSYS)
UDERRS(J) ANDRETURNUNLESS J = 0
NUSERS = NUSERS - 1
CYCLE I = 0, 1, NUSERS
NGIVEN = 256
FROMREC = 0
J = DFILENAMES(USERS(I)_NAME, FLIS, FROMREC, NGIVEN, NFILES, FSYS, 0)
UDERRS(J) ANDRETURNUNLESS J = 0
NFILES = NFILES - 1
UNLESS NFILES < 0 START
CYCLE K = 0, 1, NFILES
FILE = FLIS(K)_NAME
J = DGETDA(USERS(I)_NAME, FILE, FSYS, ADDR(DA))
UDERRS(J) ANDRETURNUNLESS J = 0
A(DA_SECTSI) = A(DA_SECTSI) + DA_NSECTS - 1
A(DA_LASTSECT) = A(DA_LASTSECT) + 1
REPEAT
FINISH
REPEAT
RETURN
END ; ! ISECTHIST
!
!----------------------------------------------------
!
ROUTINE OUTHISTO(INTEGER FSYS, INTEGERARRAYNAME A)
INTEGER I, J, L, D
INTEGERARRAY P(0:TOPSI)
FILL((TOPSI + 1) << 2, ADDR(P(0)), X'00')
WRSN("FSYS", FSYS)
!
D = 10000
CYCLE L = 0, 1, 4
CYCLE J = 1, 1, TOPSI
I = A(J) // D
IF I > 0 OR P(J) = 1 OR L = 4 THEN C
WRITE(I, 1) AND P(J) = 1 ELSE SPACES(2)
A(J) = A(J) - D * I
REPEAT
NEWLINE
D = D // 10
REPEAT
NEWLINE
CYCLE J = 1, 1, TOPSI
PRINTSTRING("--")
REPEAT
NEWLINE
I = 1
CYCLE J = 1, 1, TOPSI
WRITE(I, 1)
IF I = 9 THEN I = 0 ELSE I = I + 1
REPEAT
NEWLINE
END ; ! OUTHISTO
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE HOLES HIST(STRING (255) S)
INTEGERARRAY A(0:99)
INTEGERARRAY HISTO(0:TOPSI)
INTEGER NSYS, I, FLAG
GET FSYSS(A, NSYS)
CYCLE I = 0, 1, NSYS - 1
! HOLES
PRINTSTRING("Holes on ")
FLAG = IHOLESHIST(A(I), HISTO); ! VALUE NOT IMPORTANT HERE
OUTHISTO(A(I), HISTO)
! SECTIONS
PRINTSTRING("Sections on ")
ISECTHIST(A(I), HISTO)
OUTHISTO(A(I), HISTO)
REPEAT
END ; ! HOLES HIST
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE FSYSSTART(STRING (255) S)
! Give the start bitno of the user files on chosen FSYS.
INTEGER LOWD, HIWD, FSYS, J
RDFSYS("Fsys: ", FSYS)
J = FBASE(LOWD, HIWD, FSYS)
PHEX(LOWD + X'100')
SPACES(2)
PHEX(HIWD)
END ; ! FSYSSTART
!
!--------------------------------------------------------
!
INTEGERFN PERCENT(INTEGER FSYS)
INTEGERARRAY BITMAP(0:5119)
INTEGER SET, I, J, W, LO, HI
J = DSYSAD(0, ADDR(BITMAP(0)), FSYS)
UDERRS(J) ANDRESULT = J UNLESS J = 0
J = FBASE(LO, HI, FSYS)
LO = (LO + X'100') >> 5; ! INTEGER START OF USER FILES
HI = HI >> 5; ! END OF USER FILES
SET = 0
CYCLE I = LO, 1, HI
W = BITMAP(I)
WHILE W # 0 CYCLE
SET = SET + 1
*LSS_W
*ST_ TOS
*USB_1
*AND_ TOS
*ST_W
REPEAT
REPEAT
PRINTSTRING("FSYS")
WRITE(FSYS, 1)
WRSNS(" is", (SET * 100) // (HI - LO + 1) << 5, "% FULL")
RESULT = 0
END ; ! PERCENT
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE HOW FULL(STRING (255) S)
INTEGER J, NSYS, FLAG
INTEGERARRAY A(0:99)
GET FSYSS(A, NSYS)
J = 0
WHILE J < NSYS CYCLE
FLAG = PERCENT(A(J))
J = J + 1
REPEAT
END ; ! HOW FULL
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE HOW FRAG(STRING (255) S)
INTEGER J, NSYS, LO, HI, I, FRAGS, FLAG
INTEGERARRAY A(0:99), HISTO(0:TOPSI)
GETFSYSS(A, NSYS)
I = 0
WHILE I < NSYS CYCLE
FLAG = IHOLESHIST(A(I), HISTO); ! VALUE UNIMPORTANT HERE
J = FBASE(LO, HI, A(I))
FRAGS = 0
CYCLE J = TOPSI - 1, - 1, 1
FRAGS = FRAGS + HISTO(J) * J; ! PAGES IN FRAGMENTS
REPEAT
PRINTSTRING("Fsys")
WRITE(A(I), 2)
PRINT(FRAGS * 100 / (HI - LO - X'100'), 10, 1)
PRINTSTRING("% Fragmented
")
I = I + 1
REPEAT
RETURN
END ; ! HOWFRAG
!
!-----------------------------------------------------------------
!
!
!
!
INTEGERFN ITRANSFER(STRING (31)I1, I2, F1, F2, INTEGER FSYS1, FSYS2, TYPE)
INTEGER J, ADR, I, PT
RECORD (DFINFRECF)REC
RECORD (RETF)PERM
RECORD (INDIVF)NAME P
ADR = ADDR(REC)
J = DFINFO(I1, F1, FSYS1, ADR)
-> OUT UNLESS J = 0
!
UNLESS REC_CODES & OFFER = 0 START
J = DOFFER(I1, "", F1, FSYS1); ! discard 'offers'
-> OUT UNLESS J = 0
FINISH
!
PERM = 0
J = DPERMISSION(I1, "", "", F1, FSYS1, 4, ADDR(PERM)); ! get file list
-> OUT UNLESS J = 0
!
J = DTRANSFER(I1, I2, F1, F2, FSYS1, FSYS2, TYPE)
-> OUT UNLESS J = 0
!
J = DFSTATUS(I2, F2, FSYS2, 1, 0) UNLESS REC_CODES & CHERSH = 0
-> OUT UNLESS J = 0
J = DFSTATUS(I2, F2, FSYS2, 8, 0) UNLESS REC_CODES & PRIVAT = 0
-> OUT UNLESS J = 0
J = DFSTATUS(I2, F2, FSYS2, 17, 0) UNLESS REC_CODES & NOARCH = 0
-> OUT UNLESS J = 0
J = DFSTATUS(I2, F2, FSYS2, 18, REC_SSBYTE)
-> OUT UNLESS J = 0
J = DFSTATUS(I2, F2, FSYS2, 13, REC_ARCH)
-> OUT UNLESS J = 0
!
I = 0
PT = 16
WHILE PT < PERM_BYTES CYCLE
P == PERM_INDIV(I)
J = DPERMISSION(I2, P_USER, "", F2, FSYS2, 2, P_UPRM)
-> OUT UNLESS J = 0
I = I + 1
PT = PT + 8
REPEAT
!
J = DPERMISSION(I2, "", "", F2, FSYS2, 0, PERM_OWNP)
-> OUT UNLESS J = 0
J = DPERMISSION(I2, "", "", F2, FSYS2, 1, PERM_EEP)
-> OUT UNLESS J = 0
OUT:
RESULT = J
END ; ! ITRANSFER
!
!
!
INTEGERFN PHYSICAL SIZE KB(STRING (11) USER, FILE, INTEGER FSYS)
! Result is physical size of FILE in Kbytes, or zero if cannot obtain for
! any reason.
INTEGER J
RECORD (DFINFRECF) X
J = DFINFO(USER, FILE, FSYS, ADDR(X))
RESULT = X_NKB IF J = 0
WRSU("DFINFO ", J)
RESULT = 0
END ; ! PHYSICAL SIZE KB
!
!-------------------------------------------------------------------------------
!
INTEGERFN FILE EEP(STRING (11) USER, FILE, INTEGER FSYS)
INTEGER J
RECORD (DFINFRECF) X
J = DFINFO(USER, FILE, FSYS, ADDR(X))
RESULT = X_EEP IF J = 0
WRSU("DFINFO ", J)
RESULT = - 1
END ; ! FILE EEP
!
!-------------------------------------------------------------------------------
!
INTEGERFN INDEX SIZE(STRING (6) USER, INTEGER FSYS, INTEGERNAME KB, MARK)
INTEGER J
INTEGERARRAY N(0:63)
J = DSFI(USER, FSYS, 4, 0, ADDR(N(0)))
IF J = 0 START
KB = N(3)
MARK = KB & 1
KB = KB + MARK
FINISH
RESULT = J
END
!
!-----------------------------------------------------------------------
!
INTEGERFN IMOVEI(STRING (6) OLDUSER, NEWUSER, INTEGER MODE, OLDFSYS,
NEWFSYS, DO IRENAME)
! Transfers (for MODE = TRANSFER) or copies (for MODE = COPY) all
! files belonging to OLDUSER to NEWUSER.
!
! The parameter DO IRENAME is set to RENAMEOLD when doing MOVE INDEX or
! REFRESH INDEX, but to NORENAME n the case of COPY INDEX
!
! If any file cannot be moved because it's in use a prompt appears
! "Continue? ". If reply "NO" is given the index is not moved, and
! no side effects have occurred.
!
! NEWUSER must already have been created, but all SFI data (BASEFILE,
! Delivery, etc., etc.) is transferred.
!
! Result is 0 if move is successfully completed (even if some files
! cannot actually be moved).
! 1 if move is not attempted due to whole-index-type failure
! or because No option is given to Continue?
CONSTBYTEINTEGERARRAY XFER(0:TOPSFI)= C
1,1,1,1,0,0,0,1,0,0,
1,1,1,0,1,1,0,0,1,1,
0,0,0,0,0,0,0,0,0,0,
0,0,1,1,0,1,1,1,1,1,
0,1,0,1,1
!
RECORD (RETF) P
!
!
RECORD (OINFF) ARRAY FLIS(0:MAXFILES - 1)
!
INTEGERARRAY INF(0:63)
!
INTEGER I, J, CODES, CODES2, N, X, TYPE, FROMREC, NGIVEN
INTEGER GOOD, BAD, PT, USE, CONDITION, SAVE MAXKB, SAVE MAXFILE
STRING (31) S, FILE, ERRFILE
!
STRING (6) USER
!
CONSTSTRING (31) ARRAY DF(0:8)= C
"DSFI", "DFSTATUS", "DPERMISSION", "DTRANSFER", "DFILENAMES",
"DOFFER", "DRENAME INDEX", "DNEWUSER", "DDELUSER"
!
CONSTSTRING (19) ARRAY NOGO(1:4)= C
"UNAVA/VIOLAT set", "has use count =",
"has WRCONN set", "has generations"
!
ROUTINE VDERRS(INTEGER DIRFN, TYPE, FLAG)
STRING (31) S
RETURNIF FLAG = 0
IF ERRFILE # "" START
PRINTSTRING("FILE: ")
PRINTSTRING(ERRFILE)
SPACES(12 - LENGTH(ERRFILE))
ERRFILE = ""
FINISHELSE SPACES(18)
WRSSNSS(DF(DIRFN), " TYPE =", TYPE, " FLAG =", DERRS(FLAG))
END ; ! VDERRS
!
INTEGERFN DPERM(STRING (6) TO USER, INTEGER ACT, ADR OR PERM)
STRING (6) OWNER
INTEGER FSYS, J
IF ACT = GETILIST OR ACT = GETFLIST START
OWNER = USER
FSYS = OLDFSYS
FINISHELSESTART
OWNER = NEWUSER
FSYS = NEWFSYS
FINISH
J = DPERMISSION(OWNER, TO USER, "", FILE, FSYS, ACT, ADR OR PERM)
VDERRS(PERM, ACT, J) UNLESS J = 0
RESULT = J
END ; ! DPERM
!
!
!
ERRFILE = ""
FROMREC = 0
NGIVEN = MAXFILES; ! SET THIS PARAM TO MAX ACCEPTABLE
SAVE MAXFILE = - 1; ! to hold user's MAXFILE until after the transfer
! Clear recordarray to zero. For a screwed index, we may get back
! fewer records than specified by NGIVEN. This would lead to UNASSIGNED
! VARIABLE, but this way we will smply get a null filename.
CYCLE J = 0, 1, MAXFILES - 1
FLIS(J) = 0
REPEAT
! GET LIST OF FILENAMES AND SEE HOW MANY WE CAN'T ACTUALLY TRANSFER
J = DFILENAMES(OLD USER, FLIS, FROMREC, NGIVEN, N, OLDFSYS, 0)
IF J # 0 START
VDERRS(FILEN, 0, J)
->ABANDON
FINISH
!
WRSN("Number of files given =", NGIVEN)
WRSN("Total number of files =", N)
->ABANDON UNLESS N = NGIVEN
!
BAD = 0
X = 0
WHILE X < N CYCLE
FILE = FLIS(X)_NAME
CODES = FLIS(X)_CODES
CODES2 = FLIS(X)_CODES2
USE = FLIS(X)_USE
CONDITION = 0
IF CODES & UNAVA # 0 OR CODES & VIOLAT # 0 THEN CONDITION = 1
IF MODE = TRANSFER AND USE # 0 THEN CONDITION = 2
IF CODES2 & WRCONN # 0 AND (MODE = TRANSFER OR (MODE = COPY AND C
CODES & WSALLOW = 0)) THEN CONDITION = 3
IF MODE = TRANSFER AND CODES2 & (OLDGE ! NEWGE) # 0 THEN C
CONDITION = 4
IF CONDITION # 0 START
PRINTSTRING(FILE)
SPACES(12 - LENGTH(FILE))
PRINTSTRING(NOGO(CONDITION))
IF CONDITION = 2 THEN WRITE(USE, 1)
NEWLINE
BAD = BAD + 1
FINISH
X = X + 1
REPEAT
!
IF BAD = 0 THEN WRS("Files OK") ELSESTART
PRINTSTRING("Cannot transfer")
WRITE(BAD, 1)
S = "files"
IF BAD = 1 THEN LENGTH(S) = 4
WRS(S)
J = YES OR NO("Continue?")
->ABANDON IF J = 0; ! not-completed result
FINISH
IF DO IRENAME = RENAMEOLD START
USER = ITOS(OLDFSYS)
USER = "0".USER IF OLDFSYS < 10
USER = "OLDZ".USER
J = D RENAME INDEX(OLD USER, USER, OLD FSYS)
UNLESS J = 0 START
WRSU("RENAME INDEX ".OLD USER." TO ".USER, J)
->ABANDON
FINISH
FINISHELSE USER = OLDUSER
WRSSS(OLDUSER, " index renamed ", USER)
CYCLE TYPE = 0, 1, TOPSFI; ! move SFI information
IF XFER(TYPE) # 0 START
J = DSFI(USER, OLDFSYS, TYPE, 0, ADDR(INF(0)))
IF J = 0 START
! Temporarily save user's MAXFILE and set the field "very large"
! in case there are files about exceeding his current MAXFILE.
! Similarly with MAXKB
IF TYPE = 11 START
SAVE MAXKB = INF(0)
INF(0) = 200 * 1024
FINISH
!
IF TYPE = 12 START
SAVE MAXFILE = INF(0)
INF(0) = 200 * 1024
FINISH
!
J = DSFI(NEWUSER, NEWFSYS, TYPE, 1, ADDR(INF(0)))
FINISH
ERROR(NEWUSER) UNLESS J = 0
FINISH
REPEAT
WRS("SFI information moved OK")
!
FILE = ""; ! Move whole-index permissions
J = DPERM("", GETILIST, ADDR(P))
IF J = 0 START
I = 0
PT = 16
WHILE PT < P_BYTES CYCLE
J = DPERM(P_INDIV(I)_USER, ADDTOILIST, P_INDIV(I)_UPRM)
I = I + 1
PT = PT + 8
REPEAT
FINISH
WRS("Whole index permissions moved")
!
GOOD = 0; ! Now transfer the files
BAD = 0
X = 0
WHILE X < NGIVEN CYCLE ; ! ALL THE FILES
FILE = FLIS(X)_NAME
ERRFILE = FILE
J = ITRANSFER(USER, NEWUSER, FILE, FILE, OLDFSYS, NEWFSYS, MODE)
IF J = 0 START
GOOD = GOOD + 1
WRITE(NGIVEN-X, 3)
SPACE
WRS(FILE)
FINISH ELSE START
BAD = BAD + 1
ERROR("IMOVEI" . FILE)
FINISH
X = X + 1
REPEAT ; ! ALL THE FILES
!
WRSN("Files transferred: ", GOOD)
WRSN("Files failed to transfer: ", BAD) IF BAD > 0
!
INF(0) = SAVE MAXKB
J = DSFI(NEWUSER, NEWFSYS, 11, 1, ADDR(INF(0)))
-> ERROR UNLESS J = 0
!
INF(0) = SAVE MAXFILE
J = DSFI(NEWUSER, NEWFSYS, 12, 1, ADDR(INF(0)))
-> ERROR UNLESS J = 0
!
WRS("Finished IMOVEI")
RESULT = 0; ! completed OK result
ERROR:
ERROR("")
ABANDON:
WRS("IMOVEI abandoned")
RESULT = 1
END ; ! IMOVEI
!
!-------------------------------------------------------------------------------
!
ROUTINE IIMOVE(STRING (6)USER, INTEGER OLDFSYS, NEWFSYS, NEWIKB, MARK)
! This routine is an interface routine between MOVE INDEX/REFRESH
! INDEX/REFRESH INDEXES routines and the IMOVEI routine, which does
! the move of all files and SFI data.
! It sets up the XXXZZZ index, calls IMOVEI and does the index
! rename and delete afterwards.
INTEGER J, IMOVEIFLAG, MODE
STRING (6)OLD, NEW
MODE = COPY; ! this bit for MOVE INDEX only
MODE = TRANSFER IF OLDFSYS = NEWFSYS
NEWFSYS = NEWFSYS & X'7FFFFFFF'
!
OLD = ITOS(OLDFSYS)
OLD = "0".OLD IF OLDFSYS < 10
OLD = "OLDZ".OLD
!
NEW = ITOS(NEWFSYS)
NEW = "0".NEW IF NEWFSYS < 10
NEW = "NEWZ".NEW
!
NEWIKB = - NEWIKB IF MARK = 1
J = DNEWUSER(NEW, NEWFSYS, NEWIKB)
!
UNLESS J = 0 START
WRSU("DNEWUSER ".NEW, J)
->ABANDON
FINISH
WRSS("Created new user ", NEW)
!
IF MODE = COPY START
J = IMOVEI(USER, NEW, COPY, OLDFSYS, NEWFSYS, RENAMEOLD)
!
! Before proceeding to delete any indexes offer one last chance
! to abandon the move in case anything odd happened during IMOVEI.
J = 1 - YES OR NO("Proceed? ") IF J = 0
UNLESS J = 0 START
! IMOVEI FAILED.
! USER MAY HAVE BEEN RENAMED TO OLDZZZ.
! TIDY DEBRIS BY RENAMING INDEX IF REQUIRED
! RESTORE WHOLE INDEX PERMISSION IF NECESSARY
IMOVEIFLAG = J
J = DRENAMEINDEX(OLD, USER, OLDFSYS)
UNLESS J = 0 OR J = 37 START
! 37 == USER NOT KNOWN I.E. NOT RENAMED
UDERRS(J)
FINISHELSE WRSSS(OLD, " has been renamed ", USER)
J = IMOVEIFLAG
FINISH
FINISHELSESTART
J = IMOVEI(USER, NEW, TRANSFER, OLDFSYS, NEWFSYS, RENAMEOLD)
FINISH
!
!------------------------------------------------------------
IF J = 0 START ; ! IMOVEI worked
WRS("File transfer complete")
!
J = DDELUSER(OLD, OLDFSYS)
IF J = 0 THEN WRSS(OLD, " deleted") ELSE WRSU("DDELUSER ".OLD, J)
!
J = DRENAMEINDEX(NEW, USER, NEWFSYS)
!
IF J = 0 THEN WRSSS(NEW, " has been renamed ", USER) ELSE C
WRSU("DRENAMEINDEX ".NEW, J)
!
DPRINTSTRING("MoveIndex".USER."from".ITOS(OLDFSYS)."to".ITOS(NEWFSYS)."")
RETURN
FINISH
!
J = DDELUSER(NEW, NEWFSYS)
IF J = 0 THEN WRSS(NEW, " deleted") ELSE WRSU("DDELUSER ".NEW, J)
ABANDON:
WRS("IIMOVE abandoned")
END ; ! IIMOVE
!
!-------------------------------------------------------------------------------
!
EXTERNALROUTINE MOVE INDEX(STRING (255) S)
! Used to re-site an index:
! * on the same file system, or
! * on a different file system, or
! * to change its size, or
! * to eliminate possible corruption,
! or a combination of these.
! Care should be taken if moving to a smaller size index, that the new
! index can accommodate all the files, otherwise files which can't be got
! in will be lost.
!
! If any file cannot be moved because it's in use a prompt appears
! "Continue? ". If reply "NO" is given the index is not moved, and
! no side effects have occurred.
!
STRING (31) USER, REPLY
INTEGER OLDFSYS, NEWFSYS, NEWIKB, J, OLDIKB, MARK
!
!
!
INTEGERFN QUERYCOPY(STRING (6) USER, INTEGER FSYS)
! This routine attempts a worst case analysis for a MOVEINDEX
! within the same FSYS. The idea is to simulate making a copy
! of the files belonging to the user to be moved to see whether
! they can be fitted into the space remaining on the disc.
! The method is as follows:
! 1. Get HOLESHIST for the appropriate fsys.
! 2. For each file of the user to be moved
! a Subtract full sections from the 32 page holes.
! (HOLES(32)<0 means COPY cant be done)
! b Sections in the range 8<=sect<=31 should pick the
! largest available hole. If there isnt one then
! COPY cant be done
! c Sections in the range 1<=sect<=7 try first to
! get an exact hole. Failing that they pick the largest
! hole <=7 and failing that the largest available hole.
! If none of these are successful then COPY is not possible
RECORD (DAF) DA
INTEGERARRAY HOLES(0:32)
INTEGER I, J, FROMREC, NGIVEN, NFILES, K, LASTSECT, FLAG, AFLAG
RECORD (OINFF) ARRAY FLIS(0:MAXFILES - 1)
STRING (31) FILE
FLAG = IHOLESHIST(FSYS, HOLES)
RESULT = - FLAG UNLESS FLAG = 0
!
NGIVEN = MAXFILES
FROMREC = 0
J = DFILENAMES(USER, FLIS, FROMREC, NGIVEN, NFILES, FSYS, 0)
UDERRS(J) ANDRESULT = - J UNLESS J = 0
!
NGIVEN = NGIVEN - 1
RESULT = 0 IF NGIVEN < 0; ! NO FILES SO CAN ALWAYS COPY
CYCLE K = 0, 1, NGIVEN
FILE = FLIS(K)_NAME
J = DGETDA(USER, FILE, FSYS, ADDR(DA))
UDERRS(J) ANDRESULT = - J UNLESS J = 0
! SUBTRACT 32 PAGE HOLES FIRST
HOLES(32) = HOLES(32) - DA_NSECTS + 1
RESULT = 1 IF HOLES(32) < 0; ! NO FULL SECTIONS LEFT
LASTSECT = DA_LASTSECT
! SMALL HOLES FIRST
IF LASTSECT < 8 START
! TRY EXACT
IF HOLES(LASTSECT) > 0 THEN C
HOLES(LASTSECT) = HOLES(LASTSECT) - 1 ANDCONTINUE
! IF HERE THEN NO EXACT -> TRY LASTSECT+1 TO 7
I = 7
AFLAG = 1
WHILE I > LASTSECT CYCLE
IF HOLES(I) > 0 START
HOLES(I) = HOLES(I) - 1
AFLAG = 0
HOLES(I - LASTSECT) = HOLES(I - LASTSECT) + 1
EXIT
FINISH
I = I - 1
REPEAT
CONTINUEIF AFLAG = 0
FINISH
! IF LASTSECT<8 THEN FOUND NOTHING SO FAR ANY TRY ANYTHING
! LASTSECT>=8 START HERE
I = 32
AFLAG = 1
WHILE I >= LASTSECT AND I > 7 CYCLE
IF HOLES(I) > 0 START
HOLES(I) = HOLES(I) - 1
AFLAG = 0
HOLES(I - LASTSECT) = HOLES(I - LASTSECT) + 1
EXIT
FINISH
I = I - 1
REPEAT
CONTINUEIF AFLAG = 0
RESULT = 1; ! CANT GUARANTEE IT IF REACH HERE
REPEAT
RESULT = 0
END ; ! QUERYCOPY
!
!
!
WRS(VSN)
GUAF(USER, OLDFSYS)
->OUT UNLESS 0 <= OLDFSYS < 100
!
J = DFSYS(USER, OLDFSYS)
UDERRS(J) ANDRETURNUNLESS J = 0
!
RDINT("New fsys: ", NEWFSYS)
->OUT UNLESS 0 <= NEWFSYS < 100
!
J = DFSYS("SPOOLR", NEWFSYS)
UNLESS J = 0 START
WRS("Fsys not available")
RETURN
FINISH
!
J = INDEX SIZE(USER, OLDFSYS, OLDIKB, MARK); ! report old index size
IF J # 0 START
WRSU("DSFI FAILS ", J)
WRS("MOVE INDEX abandoned")
RETURN
FINISH
WRSNS("CURRENT INDEX SIZE IS", OLDIKB, " KBYTES")
!
RDINT("New index size Kb: ", NEWIKB)
UNLESS NEWIKB = 2 OR (4 <= NEWIKB <= 32 AND NEWIKB & 3 = 0) START
WRS("Index size must be 2 or 4-32")
RETURN
FINISH
!
IF OLDFSYS = NEWFSYS START
J = QUERYCOPY(USER, OLDFSYS)
IF J = 0 START
! COPY IS POSSIBLE
WRS("Move can proceed via COPY or TRANSFER mode")
WRS("Which? (COPY is slower but safer)")
PROMPT("C/T? ")
UCSTRG(REPLY) UNTIL REPLY = "C" OR REPLY = "T"
IF REPLY = "C" THEN NEWFSYS = NEWFSYS ! X'80000000'
! SET TOP BIT
FINISH
FINISH
!
PRINTSTRING("MOVE INDEX mode is ")
IF OLDFSYS = NEWFSYS THEN WRS("TRANSFER") ELSE WRS("COPY")
!
IIMOVE(USER, OLDFSYS, NEWFSYS, NEWIKB, MARK)
WRS("MOVE INDEX complete")
RETURN
OUT:
WRS("Fsys must be in range 0-99")
END ; ! MOVE INDEX
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE COPY INDEX(STRING (255) S)
! This routine makes a copy of all files and SFI information in an
! index in a new or existing index.
! The main purpose is to be able to keep a copy of MANAGR files on a
! second disc, so that all MANAGR utilities are still available even
! if the MANAGR disc or index become(s) badly corrupted. Thus if a
! copy of MANAGR index into say a MANAG1 index is made from time to time,
! one can sort out a file system equally from MANAG1 if necessary.
STRING (31) USER, NEWUSER
INTEGER OLDFSYS, NEWFSYS, NEWIKB, J, KB, MARK
WRS(VSN)
GUAF(USER, OLDFSYS)
J = DFSYS(USER, OLDFSYS)
-> OUT UNLESS J = 0
J = INDEX SIZE(USER, OLDFSYS, KB, MARK)
-> OUT UNLESS J = 0
WRSNS("Index size is", KB, " KBYTES")
RDSTRG("New user: ", NEWUSER)
RDINT("New fsys: ", NEWFSYS)
! Next check on new index
J = INDEX SIZE(NEWUSER, NEWFSYS, NEWIKB, J)
IF J = 37 START
RDINT("New index size Kb: ", NEWIKB)
J = DNEWUSER(NEWUSER, NEWFSYS, NEWIKB)
-> OUT UNLESS J = 0
WRSS(NEWUSER, " has been created")
FINISHELSESTART
-> OUT UNLESS J = 0
WRSNS("Index size is", NEWIKB, " Kbytes")
FINISH
!
J = IMOVEI(USER, NEWUSER, COPY, OLDFSYS, NEWFSYS, NORENAME)
!
WRS("COPY INDEX complete")
RETURN
OUT:
ERROR("")
WRS("COPY INDEX abandoned")
END ; ! COPY INDEX
!
!-----------------------------------------------------------------------
!
ROUTINE ICONSIST(STRING (6) USER, INTEGER FSYS)
! Was used to bring archive indexes up to date.
INTEGER J
J = DNEW ARCH INDEX(USER, FSYS, 0)
ERROR(USER)
END ; ! ICONSIST
!
!-------------------------------------------------------------------------------
ROUTINE HISTO(INTEGER KIC INTER, KICBATCH, MSECS INTER, MSECS BATCH)
! Was used to extract Kinstrs and OCP times from all indexes and make a
! histogram of ratios, and to get an average ratio.
INTEGER J, SLOT
REAL RATIO
OWNINTEGER N 500 TO 750, NOUT=0
OWNREAL TOTKIC, TOTMSECS=0
OWNINTEGERARRAY H(100:150)
OWNINTEGER REJECTS=0
IF KIC INTER = - 1 START
PRINTSTRING("Histogram of kinstructions/second values
")
CYCLE J = 100, 1, 150
WRITE(J * 5, 4); SPACES(H(J)); PRINTSYMBOL('*')
NEWLINE
REPEAT
PRINTSTRING("Average kinstructions per second: ")
PRINT(((TOTKIC * 1000) / TOTMSECS), 5, 1)
NEWLINE
PRINTSTRING("No in range 500 to 750: ")
WRITE(N 500 TO 750, 3); NEWLINE
PRINTSTRING("No outside that range: ")
WRITE(NOUT, 2); NEWLINE
PRINTSTRING("REJECTS:"); WRITE(REJECTS, 2); NEWLINE
RETURN
FINISH
! %IF HD=0 %START
! HD=1
! PRINTSTRING("KIC KIC MSECS MSECS
!INTER BATCH INTER BATCH KINSTRS PER SECOND
!")
! %FINISH
! WRITE(KIC INTER,7)
! WRITE(KIC BATCH,7)
! WRITE(MSECS INTER,7)
! WRITE(MSECS BATCH,7)
IF MSECS INTER > 0 AND KIC INTER > 0 START
RATIO = (KIC INTER * 1000.) / MSECS INTER
UNLESS 400 <= RATIO <= 800 THEN REJECTS = REJECTS + 1 ANDRETURN
TOTKIC = TOTKIC + KIC INTER
TOTMSECS = TOTMSECS + MSECS INTER
IF 500 <= RATIO <= 750 START
SLOT = INT((RATIO * 20 + 5) / 100)
H(SLOT) = H(SLOT) + 1
N 500 TO 750 = N 500 TO 750 + 1
FINISHELSE NOUT = NOUT + 1
FINISH
NEWLINE
END ; ! HISTO
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE DO ALL INDEXES(STRING (255) S)
RECORD (NNF) ARRAY U(0:TOPNNT)
INTEGER NU, NUSERS
INTEGERARRAY WORD0(0:63)
INTEGER J, N, FX, FSYS, SEG, GAP
INTEGERARRAY A(0:99)
STRING (63) USER
INTEGER KIC INTER, KIC BATCH, MSECS INTER, MSECS BATCH
CYCLE J = 0, 1, 63
WORD0(J) = 0
REPEAT
!
FSYS = BIN(S)
FSYS = - 1 UNLESS - 1 <= FSYS <= 99
IF FSYS < 0 C
THEN GET AV FSYS(N, A) C
ELSE A(0) = FSYS AND N = 1
FX = 0
WHILE FX < N CYCLE
SEG = 0
GAP = 0
FSYS = A(FX)
J = GET USNAMES2(U, NUSERS, FSYS)
WRSN("FSYS", FSYS)
WRSN("GET USNAMES FLAG", J)
WRSN("NO OF USERS", NUSERS)
NU = 0
WHILE NU < NUSERS CYCLE
USER <- U(NU)_NAME
IF LENGTH(USER) = 6 START
!*********...here you insert the code you want to execute...****************
! ...for each index.
!ICONSIST(USER,FSYS) %IF USER#"SPOOLR"
KIC INTER = 0; KIC BATCH = 0; MSECS INTER = 0
MSECS BATCH = 0
J = DSFI(USER, FSYS, 20, 0, ADDR(KIC INTER))
IF J # 0 START
PRINTSTRING("FLAG"); WRITE(J, 1)
PRINTSTRING(" FOR USER "); PRINTSTRING(USER)
NEWLINE
FINISH
J = DSFI(USER, FSYS, 27, 0, ADDR(MSECS INTER))
IF J # 0 START
PRINTSTRING("FLAG"); WRITE(J, 1)
PRINTSTRING(" FOR USER "); PRINTSTRING(USER)
NEWLINE
FINISH
HISTO(KIC INTER, KIC BATCH, MSECS INTER, MSECS BATCH)
!*************************************************************************************
FINISH
NU = NU + 1
REPEAT
FX = FX + 1
REPEAT
! HISTO(-1,0,0,0)
END ; ! DO ALL INDEXES
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE REFRESH INDEXES(STRING (255) S)
! Goes up a whole file system re-siting every index, with the same
! attributes (size in particular).
!
! If any file cannot be moved because it's in use a prompt appears
! "Continue? ". If reply "NO" is given the index is not moved, and
! no side effects have occurred.
!
! However, the intention is that it should be used on a newly-CCK-ed
! file system with no users active.
!
! Don't try to move the file system that you're running it from!
RECORD (NNF) ARRAY U(0:TOPNNT)
INTEGER NU, NUSERS, KB, MARK
INTEGER J, FSYS
STRING (63) USER
RDFSYS("Fsys: ", FSYS)
WRS(VSN)
WRS("If it's necessary to interrupt this program, type Int:STOP")
J = GET USNAMES2(U, NUSERS, FSYS)
WRSN("GET USNAMES flag =", J) ANDRETURNUNLESS J = 0
WRSN(" NO OF USERS =", NUSERS)
NU = 0
WHILE NU < NUSERS CYCLE
USER <- U(NU)_NAME
IF LENGTH(USER) = 6 START
WRSS("User ", USER)
J = INDEX SIZE(USER, FSYS, KB, MARK)
IIMOVE(USER, FSYS, FSYS, KB, MARK)
FINISH
NU = NU + 1
IF INTERRUPT = "STOP" START
WRSS("INT:STOP received. Last index moved was ", USER)
RETURN
FINISH
REPEAT
END ; ! REFRESH INDEXES
!
!-------------------------------------------------------------------------------
!
EXTERNALROUTINE MOVE INDEXES(STRING (255) S)
INTEGER J, NU, NUSERS, FLAG, FROM FSYS, TO FSYS, KB, MARK
RECORD (NNF) ARRAY U(0:TOPNNT)
STRING (6) USER
STRING (15)W
WRS(VSN)
WRS("If its necessary to interrupt this program, type INT:STOP")
!
RDINT("From fsys: ", FROM FSYS) UNTIL FROM FSYS >= 0
FLAG = PERCENT(FROM FSYS)
RETURNUNLESS FLAG = 0
!
RDINT("To fsys: ", TO FSYS) UNTIL TO FSYS >= 0
!
IF FROM FSYS = TO FSYS START
WRS("MUST SPECIFY DIFFERENT FSYS'S")
RETURN
FINISH
FLAG = PERCENT(TO FSYS)
RETURNUNLESS FLAG = 0
!
J = GET USNAMES2(U, NUSERS, FROM FSYS)
WRSN("GET USERNAMES flag =", J) UNLESS J = 0
WRSN(" No of users =", NUSERS)
!
RETURNIF NUSERS < 1
!
NUSERS = NUSERS - 1; ! ARRAY ELEMENTS RUN FROM ZERO
CYCLE NU = 0, 1, NUSERS
USER <- U(NU)_NAME
IF LENGTH(USER) = 6 START
->SKIP IF EXECUTIVES -> W . (USER) . W
WRSS("User ", USER)
J = INDEX SIZE(USER, FROM FSYS, KB, MARK)
IIMOVE(USER, FROM FSYS, TO FSYS, KB, MARK)
FINISH
SKIP:
IF INTERRUPT = "STOP" START
WRS("INT:STOP received")
WRSS("Last index moved was for ", USER)
RETURN
FINISH
REPEAT
!
FLAG = PERCENT(TO FSYS)
END ; ! MOVE INDEXES
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE REFRESH INDEX(STRING (255) S)
! Equivalent to MOVE INDEX where the same new index-size and new FSYS are
! required. Re-sites an index on the same FSYS and with the same
! attributes. Purpose: to eliminate possible corruption in the index or
! to bring an index up to date (e.g. for later versions of Director with
! newer facilities).
!
! If any file cannot be moved because it's in use a prompt appears
! "Continue? ". If reply "NO" is given the index is not moved, and
! no side effects have occurred.
!
INTEGER J, FSYS
INTEGER KB, MARK
STRING (63) USER
WRS(VSN)
GUAF(USER, FSYS)
!
J = INDEX SIZE(USER, FSYS, KB, MARK)
WRSU("DSFI fails", J) ANDRETURNUNLESS J = 0
IIMOVE(USER, FSYS, FSYS, KB, MARK)
WRSS(USER, " refreshed")
END ; ! REFRESH INDEX
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE GETDA(STRING (255) S)
RECORD (DAF) P
INTEGER J, FSYS
STRING (31) FILE, USER
GUAFAF(USER, FSYS, FILE)
J = DGETDA(USER, FILE, FSYS, ADDR(P))
UDERRS(J)
NEWLINE
J = 0
WHILE J < P_NSECTS CYCLE
PHEX(P_DA(J))
NEWLINE
J = J + 1
REPEAT
END ; ! GETDA
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE WHAT FILE(STRING (255) S)
! Program to discover the file(s) to which a given page number belongs.
! You can specify that one FSYS or all FSYSes are to be searched.
INTEGER FROMREC, NGIVEN
INTEGER FSYS, J, I, N, UX, SX, DA, PGNO, LEN, NFILES, FX, USERS
STRING (31) FILE, USER
INTEGERARRAY A(0:99)
STRING (6) ARRAY U(0:TOPNNT)
RECORD (OINFF) ARRAY FLIS(0:255)
!
RECORD (DAF) DAAREA
!
RDINT("Fsys or -1: ", FSYS)
RDINT("Page no: ", PGNO)
GET AV FSYS(N, A)
IF FSYS >= 0 START
CYCLE J = 0, 1, N - 1
IF A(J) = FSYS START
A(0) = FSYS
N = 1
->OK
FINISH
REPEAT
WRS("FSYS N/A")
RETURN
FINISH
OK:
CYCLE J = 0, 1, N - 1
FSYS = A(J)
WRSN("FSYS", FSYS)
PGNO = PGNO << 8 >> 8 ! FSYS << 24
I = GET USNAMES(USERS, ADDR(U(0)), FSYS)
MONITORIF I # 0
UX = 0
WHILE UX < USERS CYCLE
USER = U(UX)
FROMREC = 0
NGIVEN = 256; ! SET TO MAX PREPARED TO RECEIVE
I = DFILENAMES(USER, FLIS, FROMREC, NGIVEN, NFILES, FSYS, 0)
MONITORIF I # 0
FX = 0
WHILE FX < NFILES CYCLE
FILE = FLIS(FX)_NAME
I = DGETDA(USER, FILE, FSYS, ADDR(DA AREA))
MONITORIF I # 0
SX = 0
WHILE SX < DA AREA_NSECTS CYCLE
DA = DA AREA_DA(SX)
SX = SX + 1
LEN = DA AREA_SECTSI
IF SX = DA AREA_NSECTS THEN LEN = DA AREA_LASTSECT
IF DA <= PGNO < DA + LEN START
SPACES(4)
WRSSS(USER, ".", FILE)
FINISH
REPEAT ; ! UP THE SECTIONS OF THE FILE
FX = FX + 1
REPEAT ; ! UP THE FILES OF THE USER
UX = UX + 1
REPEAT ; ! UP THE USERS OF THE FSYS
REPEAT ; ! UP THE FSYS'S
END ; ! WHAT FILE
!
!-------------------------------------------------------------------------------
!
INTEGERFN SETNOARCH(STRING (31) USER, FILE, INTEGER FSYS)
! Sets NOARCH bit in file descriptor for FILE, but FILE must be
! #ARCH.
INTEGER J
RESULT = 0 IF FILE # "#ARCH"
J = DFSTATUS(USER, FILE, FSYS, 17, 0)
RESULT = 0 IF J = 0
PRINTSTRING("SET NOARCH flag ")
UDERRS(J)
END ; ! SETNOARCH
!
!-------------------------------------------------------------------------------
ROUTINE IREFRESH FILE(STRING (31)USER, FILE, INTEGER FSYS)
INTEGER J
J = DRENAME(USER, FILE, "##", FSYS)
-> OUT UNLESS J = 0
!
J = ITRANSFER(USER, USER, "##", FILE, FSYS, FSYS, 2)
IF J = 0 START
WRSS(USER . "." . FILE, " refreshed")
RETURN
FINISH
!
ERROR(USER.".".FILE)
!
J = DRENAME(USER, "##", FILE, FSYS)
-> OUT UNLESS J = 0
!
WRS(USER.".".FILE." renamed to original name")
RETURN
OUT:
ERROR(USER.".".FILE)
END ; ! IREFRESH FILE
!
!-------------------------------------------------------------------------------
ROUTINE TO SET MSG EEP(STRING (31) USER, FILE, INTEGER FSYS)
INTEGER EEP, J
RETURNIF FILE # "#MSG" AND FILE # "#ARCH"
EEP = 11
J = DPERMISSION(USER, USER, "", FILE, FSYS, 1, EEP)
IF J # 0 THEN PRINTSTRING("DPERMISSN FLAG ") AND UDERRS(J)
END ; ! TO SET MSG EEP
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE REFRESH FILE(STRING (255) S)
STRING (31) USER, FILE
INTEGER FSYS
GUAFAF(USER, FSYS, FILE)
IREFRESH FILE(USER, FILE, FSYS)
END ; ! REFRESH FILE
!
!-------------------------------------------------------------------------------
ROUTINE TO DO ALL FILES(ROUTINE H(STRING (31)USER, FILE, INTEGER FSYS))
!
INTEGER FSX, NGIVEN, FROMREC
INTEGER FSYS, I, N, UX, NFILES, FX, USERS
STRING (31) FILE, USER, TXT
INTEGERARRAY A(0:99)
STRING (6) ARRAY U(0:TOPNNT)
RECORD (OINFF) ARRAY FLIS(0:255)
!
RDINT("Fsys or -1: ", FSYS)
A(0) = FSYS
N = 1
GET AV FSYS(N, A) IF FSYS < 0
!
CYCLE FSX = 0, 1, N - 1
FSYS = A(FSX)
TXT = "Fsys " . ITOS(FSYS)
WRS(TXT)
I = GET USNAMES(USERS, ADDR(U(0)), FSYS)
-> OUT UNLESS I = 0
UX = 0
WHILE UX < USERS CYCLE
USER = U(UX)
FROMREC = 0
L:
NGIVEN = (1<<31) ! 256; ! SET TO MAX PREPARED TO RECIEVE
TXT = USER
I = DFILENAMES(USER, FLIS, FROMREC, NGIVEN, NFILES, FSYS, 0)
-> OUT UNLESS I = 0
!
FX = 0
WHILE FX < NGIVEN CYCLE
FILE = FLIS(FX)_NAME
H(USER, FILE, FSYS)
FX = FX + 1
REPEAT ; ! UP THE FILES OF THE USER
!
FROMREC = FROMREC + NGIVEN
-> L IF FROMREC < NFILES
!
UX = UX + 1
REPEAT ; ! UP THE USERS OF THE FSYS
REPEAT ; ! UP THE FSYS'S
H("", "", 0)
RETURN
OUT:
ERROR(TXT)
END ; ! TO DO ALL FILES
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE SET MSG EEP(STRING (255) S)
TO DO ALL FILES(TO SET MSG EEP)
END ; ! SET MSG EEP
OWNINTEGER LOW PAGENO
!
!-------------------------------------------------------------------------------
ROUTINE TO CHECK DAS(STRING (31) USER, FILE, INTEGER FSYS)
INTEGER I, SX, DA, LEN, LOW PAGE NO
RECORD (DATAF)DATA
RECORD (DAF)DA AREA
RETURNIF USER = ""
!
I = DGETDA(USER, FILE, FSYS, ADDR(DA AREA))
-> OUT UNLESS I = 0
!
I = FBASE2(FSYS, ADDR(DATA))
-> OUT UNLESS I = 0
LOW PAGE NO = DATA_START + DATA_FILESTART + X'300'
!
SX = 0
WHILE SX < DA AREA_NSECTS CYCLE
DA = DA AREA_DA(SX)
SX = SX + 1
LEN = DA AREA_SECTSI
IF SX = DA AREA_NSECTS THEN LEN = DA AREA_LASTSECT
IF DA < FSYS << 24 ! LOW PAGENO START
SPACES(4)
WRSSS(USER, ".", FILE)
RETURN
FINISH
REPEAT ; ! UP THE SECTIONS OF THE FILE
RETURN
OUT:
ERROR(USER.".".FILE)
END ; ! TO CHECK DAS
!
!-------------------------------------------------------------------------------
ROUTINE TO SET HNOARCH(STRING (31) USER, FILE, INTEGER FSYS)
INTEGER J
RETURNIF FILE # "#ARCH"
J = SETNOARCH(USER, FILE, FSYS)
END ; ! TO SET HNOARCH
!
!-------------------------------------------------------------------------------
ROUTINE TO REFRESH(STRING (31) USER, FILE, INTEGER FSYS)
INTEGER I, SX, DA, LEN, LOW PAGENO
RECORD (DATAF)DATA
!
RECORD (DAF)DAAREA
!
RETURN IF USER = ""
!
I = DGETDA(USER, FILE, FSYS, ADDR(DA AREA))
-> OUT UNLESS I = 0
!
I = FBASE2(FSYS, ADDR(DATA))
-> OUT UNLESS I = 0
LOW PAGE NO = DATA_START + DATA_FILESTART + X'300'
!
SX = 0
WHILE SX < DA AREA_NSECTS CYCLE
DA = DA AREA_DA(SX)
SX = SX + 1
LEN = DA AREA_SECTSI
IF SX = DA AREA_NSECTS THEN LEN = DA AREA_LASTSECT
IF DA < FSYS << 24 ! LOW PAGENO START
IREFRESH FILE(USER, FILE, FSYS)
RETURN
FINISH
REPEAT ; ! UP THE SECTIONS OF THE FILE
RETURN
OUT:
ERROR(USER.".".FILE)
END ; ! TO REFRESH
OWNINTEGER SSI
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE CHECK DAS(STRING (255) S)
TO DO ALL FILES(TO CHECKDAS)
END ; ! CHECK DAS
!
!-----------------------------------------------------------
!
EXTERNALROUTINE SETHNOARCH(STRING (255) S)
TO DO ALL FILES(TO SETHNOARCH)
END ; ! SETHNOARCH
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE REFRESH FILES(STRING (255) S)
TO DO ALL FILES(TO REFRESH)
END ; ! REFRESH FILES
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE WHATFSYS(STRING (255) S)
! WILL CHECK FOR MULTIPLE OCCURRENCES OF USERNAMES
INTEGER J, NFSYS, I, FOUNDUSER
INTEGERARRAY A(0:99)
STRING (63) USER
RDSTRG("User: ", USER)
FOUNDUSER = 0
GETAVFSYS(NFSYS, A)
NFSYS = NFSYS - 1
CYCLE I = 0, 1, NFSYS
J = DFSYS(USER, A(I))
UNLESS J = 37 OR J = 0 THEN UDERRS(J) ANDRETURN
IF J = 0 START
! FOUND USER
FOUNDUSER = 1 IF FOUNDUSER = 0
WRSN("FSYS", A(I))
FINISH
REPEAT
UDERRS(37) IF FOUNDUSER = 0
END ; ! WHATFSYS
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE RENAME INDEX(STRING (255) S)
STRING (31) OLD, NEW
INTEGER FSYS, J
GUAF(OLD, FSYS)
PROMPT("NEW NAME: ")
UCSTRG(NEW)
J = DRENAME INDEX(OLD, NEW, FSYS)
UDERRS(J) UNLESS J = 0
END ; ! RENAME INDEX
!
!-------------------------------------------------------------------------------
!
INTEGERFN GOODUSER(STRING (255) USER)
! result = 1 if USER is length 6, alphanumeric & has decimal digits
! as last 2 characters
! Else result 0
INTEGER J, OK, CH
OK = 1
IF LENGTH(USER) = 6 START
CYCLE J = 1, 1, 6
CH = CHARNO(USER, J)
UNLESS ('A' <= CH <= 'Z' AND J < 5) OR '0' <= CH <= '9' THEN C
OK = 0
REPEAT
FINISHELSE OK = 0
IF OK = 0 START
WRS("Give 6 alphanumeric characters, the last two being numeric")
FINISH
RESULT = OK; ! or not as the case may be
END ; ! GOODUSER
!
!-------------------------------------------------------------------------------
!
INTEGERFN INCU(STRINGNAME USER)
! reject without message unless last 2 chars are decimal digits
UNLESS '0' <= CHARNO(USER, 5) <= '9' AND C
'0' <= CHARNO(USER, 6) <= '9' THENRESULT = 0
! "bad"
CHARNO(USER, 6) = CHARNO(USER, 6) + 1
IF CHARNO(USER, 6) > '9' START
CHARNO(USER, 6) = '0'
CHARNO(USER, 5) = CHARNO(USER, 5) + 1
FINISH
IF CHARNO(USER, 5) > '9' START
WRS("Username out of range !!!!!!!!!!!!!!!!!!!")
RESULT = 0; ! bad
FINISH
RESULT = 1; ! good
END ; ! INCU
!
!-------------------------------------------------------------------------------
!
INTEGERFN GOODRANGE(STRING (6) USER, INTEGER N)
! result = 1 if range OK, 0 otherwise.
INTEGER J, OK
RESULT = 1 IF N = 1
J = 0
OK = 0
WHILE J < N - 1 CYCLE
OK = INCU(USER)
EXITIF OK = 0
J = J + 1
REPEAT
WRS("User range invalid") IF OK = 0
RESULT = OK; ! or not as the case may be
END ; ! GOODRANGE
!
!-------------------------------------------------------------------------------
!
INTEGERFN DO NEWUSERS(STRING (255) USER, INTEGER NUMBER)
STRING (255) SURNAME, PASS, DELIV
INTEGER FSYS, NKB, J, IPASS0, IPASS1, MAXKB, MAXFILE, MAXPROI, MAXPROB,
MAXPROT
INTEGER N, DEFAULTFUNDS, D
CONSTINTEGER TOP = 7
CONSTBYTEARRAY TYPE(1:TOP)=18, 1, 5, 12, 11, 14, 33
INTEGERARRAY A(1:TOP)
DEFAULTFUNDS = 50000
RDINT("Fsys: ", FSYS)
RDINT("Index Kbytes: ", NKB)
! Do this immediately for the first one in case it's going to fail and
! waste all the prompted input.
J = DNEWUSER(USER, FSYS, NKB)
ERROR(USER) UNLESS J = 0
IF J # 0 THENRESULT = J
PROMPT("INITLS+SURNAME:")
UCSTRG(SURNAME)
WRS("Give 4 character passwords")
PROMPT("F Password: ")
UCSTRG(PASS) UNTIL LENGTH(PASS) = 4
MOVE(4, ADDR(PASS) + 1, ADDR(IPASS0))
PROMPT("B Password: ")
UCSTRG(PASS) UNTIL LENGTH(PASS) = 4
MOVE(4, ADDR(PASS) + 1, ADDR(IPASS1))
PROMPT("Delivery info: ")
INSTRG(DELIV)
RDINT("Maxfile Kb: ", MAXFILE)
RDINT("Max Kbytes: ", MAXKB)
RDINT("Max I.Procs: ", MAXPROI)
RDINT("Max B.Procs: ", MAXPROB)
RDINT("Max T.Procs: ", MAXPROT)
!
A(1) = ADDR(SURNAME)
A(2) = ADDR(DELIV)
A(3) = ADDR(IPASS0)
A(4) = ADDR(MAXFILE)
A(5) = ADDR(MAXKB)
A(6) = ADDR(MAXPROI)
A(7) = ADDR(DEFAULTFUNDS)
!
N = 1
WHILE N <= NUMBER CYCLE
PRINTSTRING("User: ".USER)
SPACES(2)
IF N > 1 START ; ! first has already been done above
J = DNEWUSER(USER, FSYS, NKB)
ERROR(USER) AND RESULT = J UNLESS J = 0
FINISH
!
CYCLE D = 1, 1, TOP
J = DSFI(USER, FSYS, TYPE(D), 1, A(D))
ERROR(USER) UNLESS J = 0
REPEAT
WRS(" Completed")
N = N + 1
J = INCU(USER) UNLESS NUMBER = 1
REPEAT
RESULT = 0
END ; ! DO NEWUSERS
!
!-------------------------------------------------------------------------------
!
EXTERNALROUTINE NEWUSER(STRING (255) S)
STRING (255) USER
INTEGER J
PROMPT("User: ")
UCSTRG(USER)
J = DO NEWUSERS(USER, 1)
END ; ! NEWUSER
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE REGISTER CLASS(STRING (255) S)
STRING (255) USER
INTEGER N, J
! This routine prompts for a "base" username and a number N of users.
! Username is assumed to be of the form AAAAnn (nn numeric)
! and nn and N-1 further usernames are accreditted.
!
PROMPT("Base username: ")
UCSTRG(USER) UNTIL GOODUSER(USER) # 0
RDINT("How many? ", N)
IF GOODRANGE(USER, N) = 0 THENRETURN
J = DO NEWUSERS(USER, N)
UDERRS(J)
END ; ! REGISTER CLASS
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE DE REGISTER CLASS(STRING (255) S)
! This routine prompts for a "base" username and a number N of users.
! Username is assumed to be of the form AAAAnn (nn numeric)
! and nn and N-1 further usernames are accreditted.
!
STRING (31) USER
INTEGER N, NUM, K, FSYS, J
PROMPT("Base username: ")
UCSTRG(USER) UNTIL GOODUSER(USER) # 0
RDINT("How many? ", N)
IF GOODRANGE(USER, N) = 0 THENRETURN
RDFSYS("Fsys: ", FSYS)
! Disconnect currently_connected #ARCH (if any connected).
! Otherwise NEWUSER followed by DELUSER followed by NEWUSER all for the
! same user causes AINDA in Director file ARCHnn to fail 37 (user not
! known). A slightly pathological case, but still.
J = ACREATE2("", "", "", "", 0, 0, 0, 0); ! disconnect #ARCH
NUM = 1
WHILE NUM <= N CYCLE
K = DDELUSER(USER, FSYS)
EXITIF K # 0
NUM = NUM + 1
J = INCU(USER)
REPEAT
ERROR(USER) UNLESS K = 0
END ; ! DE REGISTER CLASS
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE DELUSER(STRING (255) S)
! THIS VERSION ASKS FOR CONFIRMATION BEFORE DELETING AND
! WILL ALSO CHECK FOR MULTIPLE OCCURRENCES OF THE USERNAME
STRING (31) USER, REPLY
INTEGER FSYS, J
TRY AGAIN:
GUAF(USER, FSYS)
WRS("Confirm user ".USER." to be deleted")
PROMPT("Y/N? ")
UCSTRG(REPLY) UNTIL REPLY = "Y" OR REPLY = "N"
->TRY AGAIN IF REPLY = "N"
! Disconnect currently_connected #ARCH (if any connected).
! Otherwise NEWUSER followed by DELUSER followed by NEWUSER all for the
! same user causes AINDA in Director file ARCHnn to fail 37 (user not
! known). A slightly pathological case, but still.
ANOTHER:
J = ACREATE2("", "", "", "", 0, 0, 0, 0); ! disconnect #ARCH
J = DDELUSER(USER, FSYS)
IF J = 0 START
WRSNS(USER." on fsys", FSYS, " successfully deleted")
FINISHELSE UDERRS(J) ANDRETURN
! CHECK MULTIPLE OCCURRENCE
FSYS = - 1
J = DFSYS(USER, FSYS)
IF J = 0 START
WRSNS("** WARNING - User ".USER." also occurs on FSYS", FSYS, "
Delete this as well?")
PROMPT("Y/N? ")
UCSTRG(REPLY) UNTIL REPLY = "Y" OR REPLY = "N"
->ANOTHER IF REPLY = "Y"
FINISH
END ; ! DELUSER
!
!-------------------------------------------------------------------------------
EXTERNALROUTINE ENV(STRING (255) S)
INTEGER N, J
INTEGERARRAY A(0:99)
!
RECORD (COMF) NAME COM
RECORD (SCTF) NAME SCT
RECORD (UINF) NAME UIN
!
COM == RECORD(X'80000000' + 48 << 18)
SCT == RECORD(8 << 18)
UIN == RECORD(9 << 18)
!
PRINTSTRING(UINFS(10)); ! ocp type
PRINTSTRING(" Sup: ")
PRINTSTRING(STRING(ADDR(COM_SUPVSN)))
!
PRINTSTRING(" Dir: ")
PRINTSTRING(SCT_FIXUPDATE)
!
WRSN(" Proc: ", UIN_PROCNO)
!
PRINTSTRING("Discs: ")
GETAVFSYS(N, A); ! FIRST DISC IS SLOAD DISC
!
CYCLE J = 0, 1, N - 1
WRITE(A(J), 1)
REPEAT
NEWLINE
END ; ! ENV
!
!---------------------------------------------------------------------
!
!******************* INACTIVE USERS ROUTINES *****************
!
!----------------------------------------------------------------
!
ROUTINE XXNSORT(RECORD (TF) ARRAYNAME P, INTEGERARRAYNAME X, INTEGER N)
! DECLARE INTEGER ARRAY X, BOUNDS 1:NUM, IN CALLING ROUTINE
!NOTIMP80 %RECORDSPEC P(TF)
INTEGER I, J, K, M, W
RETURNUNLESS N > 0
!
CYCLE I = 1, 1, N
X(I) = I
REPEAT
!
M = 1
M = M << 1 WHILE M <= N
M = M - 1
!
CYCLE
M = M >> 1
EXITIF M = 0
CYCLE I = 1, 1, N - M
K = I
WHILE K > 0 CYCLE
J = K + M
!
EXITIF P(X(K))_LASTLOGON <= P(X(J))_LASTLOGON
W = X(J)
X(J) = X(K)
X(K) = W
!
K = K - M
REPEAT
REPEAT
REPEAT
END ; ! XXNSORT
!
!----------------------------------------------------------------
!
INTEGERFN STINT(STRING (15) S)
INTEGER I, J
J = 0
CYCLE I = 1, 1, LENGTH(S)
UNLESS '0' <= CHARNO(S, I) <= '9' THENRESULT = - 1
J = J * 10 + CHARNO(S, I) - 48
REPEAT
RESULT = J
END ; ! STINT
!
!-----------------------------------------------------------------
!
EXTERNALROUTINE INACTIVEUSERS(STRING (255) S)
RECORD (TF) ARRAYFORMAT XTF(1:400)
RECORD (USINFF) ARRAY USINF(0:TOPNNT)
RECORD (TF) ARRAY TABLE(0:399)
RECORD (TF) ARRAYNAME TAB
INTEGERARRAY ALLFSYS(0:15), ALPH(1:400)
INTEGERARRAY LL(1:2)
INTEGER I, J, FLAG, NACTIVE, NUSERS, AD, LASTLOGON, NEXT, TRIGGER
STRING (3) DD, MM, YY
STRING (255) FAIL, TRIG, OPDEV, W
ROUTINE SCLOSE
SELECTOUTPUT(0)
CLOSESTREAM(53)
CLEAR("53")
END ; ! SCLOSE
!
!
!
TAB == ARRAY(ADDR(TABLE(0)), XTF)
AD = ADDR(LL(1))
WRS("Date in format DD/MM/YY")
PROMPT("TRIGGER DATE: ")
UCSTRG(TRIG) UNTIL TRIG - > DD.("/").MM.("/").YY
PROMPT("Op file/dev: ")
UCSTRG(OPDEV) UNTIL OPDEV # ""
TRIGGER = (STINT(YY) - 70) << 9 ! STINT(MM) << 5 ! STINT(DD)
GETAVFSYS(NACTIVE, ALLFSYS)
NACTIVE = NACTIVE - 1
NEXT = 0
CYCLE I = 0, 1, NACTIVE
NUSERS = 512
FLAG = GETUSNAMES2(USINF, NUSERS, ALLFSYS(I))
IF FLAG # 0 THEN FAIL = "GETUSNAMES " AND ->ERROR
NUSERS = NUSERS - 1
UNLESS NUSERS < 0 START
CYCLE J = 0, 1, NUSERS
UNLESS EXECUTIVES -> W . (USINF(J)_NAME) . W START
FLAG = DSFI(USINF(J)_NAME, ALLFSYS(I), 6, 0, AD)
MONITORAND ->NEXT IF FLAG # 0
LASTLOGON = LL(1) >> 17
IF LASTLOGON < TRIGGER START
IF NEXT = 400 START
WRS("Too many entries. Recompile. Dumping.")
->OUTPUTSEG
FINISH
TABLE(NEXT)_USER = USINF(J)_NAME
TABLE(NEXT)_FSYS = ALLFSYS(I)
FLAG = DSFI(USINF(J)_NAME, ALLFSYS(I), 18, 0,
ADDR(TABLE(NEXT)_SURNAME))
MONITORAND ->NEXT IF FLAG # 0
FLAG = DSFI(USINF(J)_NAME, ALLFSYS(I), 1, 0,
ADDR(TABLE(NEXT)_DELIV))
MONITORAND ->NEXT IF FLAG # 0
TABLE(NEXT)_LASTLOGON = LASTLOGON
MM = ITOS((LASTLOGON >> 5) & X'F')
MM = "0".MM IF LENGTH(MM) = 1
DD = ITOS(LASTLOGON & X'1F')
DD = "0".DD IF LENGTH(DD) = 1
TABLE(NEXT)_LASTUSED = DD."/".MM."/".ITOS C
(LASTLOGON >> 9 + 70)
NEXT = NEXT + 1
FINISH
FINISH
NEXT:
REPEAT
FINISH
REPEAT
! OUTPUT SEGMENT
OUTPUTSEG:
DEFINE("53,".OPDEV.",500")
SELECTOUTPUT(53)
WRS("Processes not used since ".TRIG)
WRS(" ** NONE **") AND SCLOSE AND RETURN IF NEXT = 0
XXNSORT(TAB, ALPH, NEXT)
WRS("LASTUSED USER FSYS")
CYCLE I = 1, 1, NEXT
J = ALPH(I)
PRINTSTRING(TAB(J)_LASTUSED); SPACES(2)
PRINTSTRING(TAB(J)_USER); SPACES(2)
WRITE(TAB(J)_FSYS, 2); SPACES(2)
PRINTSTRING(TAB(J)_SURNAME); SPACES(33 - LENGTH(TAB(J)_SURNAME))
WRS(TAB(J)_DELIV)
REPEAT
NEWLINE
WRITE(NEXT, 5)
PRINTSTRING(" Users")
SCLOSE
WRITE(NEXT, 5)
PRINTSTRING(" Users")
RETURN
ERROR:
WRSN(FAIL, FLAG)
END ; ! INACTIVEUSERS
!
!------------------------------------------------------------------
!
!**************** END OF INACTIVE USERS ROUTINES **************
ENDOFFILE