conststring (1) snl = "
"
constinteger amdahl = 369, xa = 371
INCLUDE "TARGET"
if TARGET = 2900 start { machine specific constants }
constinteger MAX LINE = 132
conststringname DATE = X'80C0003F'
conststringname TIME = X'80C0004B'
constinteger SEG SHIFT = 18
finish { 2900 }
!
if TARGET = 370 start
constinteger SEG SHIFT = 16
finish
!
if TARGET = XA or TARGET = AMDAHL start
constinteger SEG SHIFT = 20
finish
!
unless TARGET = 2900 start
constinteger com seg = 31
conststringname DATE = COM SEG << SEG SHIFT + X'3B'
conststringname TIME = COM SEG << SEG SHIFT + X'47'
constinteger MAX LINE = 80 { for convenience on terminals }
finish
!* COMMUNICATIONS RECORD FORMAT - EXTANT FROM CHOPSUPE 20A ONWARDS *
!
! This is the Supervisor Communications Record Format, defined in EMAS
! 2900 Supervisor Note 15.
if TARGET = 2900 start
recordformat c
COMF(integer OCPTYPE, IPLDEV, SBLKS, SEPGS,
NDISCS, DLVNADDR, GPCTABSIZE, GPCA,
SFCTABSIZE, SFCA, SFCK, DIRSITE,
DCODEDA, SUPLVN, TOJDAY, DATE0,
DATE1, DATE2, TIME0, TIME1,
TIME2, EPAGESIZE, USERS, CATTAD,
SERVAAD, byteinteger NSACS, RESV1, SACPORT1, SACPORT0,
NOCPS, RESV2, OCPPORT1, OCPPORT0,
integer ITINT,
CONTYPEA, GPCCONFA, FPCCONFA, SFCCONFA,
BLKADDR, RATION, SMACS, TRANS,
longinteger KMON, integer DITADDR, SMACPOS,
SUPVSN, PSTVA, SECSFRMN, SECSTOCD,
SYNC1DEST, SYNC2DEST, ASYNCDEST, MAXPROCS,
KINSTRS, ELAPHEAD, COMMSRECA, STOREAAD,
PROCAAD, SFCCTAD, DRUMTAD, TSLICE,
FEPS, MAXCBT, PERFORMAD,
INTEGER SP0,SP1,SP2,SP3,SP4,SP5,
integer LSTL, LSTB, PSTL,
PSTB, HKEYS, HOOT, SIM,
CLKX, CLKY, CLKZ, HBIT,
SLAVEOFF, INHSSR, SDR1, SDR2,
SDR3, SDR4, SESR, HOFFBIT,
BLOCKZBIT, BLKSHIFT, BLKSIZE, END)
finish else start
recordformat C
COMF(integer OCPTYPE, SLIPL, TOPS, SEPGS,
NDISCS, NSLDEVS, DLVNADDR, DITADDR,
SLDEVTABAD, STEER INT, DIRSITE, DCODEDA,
exSUPLVN, TOJDAY, DATE0, DATE1,
DATE2, TIME0, TIME1, TIME2,
PAGESIZE, USERS, CATTAD, SERVAAD,
NOCPS, ITINT, RATION, TRANS,
longinteger KMON, integer SUPVSN, SECSFRMN,
SECSTOCD, SYNC1DEST, SYNC2DEST, ASYNCDEST,
MAXPROCS, KINSTRS, ELAPHEAD, COMMSRECA,
STOREAAD, PROCAAD, TSLICE, FEPS,
MAXCBT, PERFORMAD, END)
finish
!*
!
if TARGET = 2900 start
recordformat file inff(string (11)NAME,
integer SD,halfinteger PGS, H0,
byteinteger CODES, CODES2, DAYNO, USE,
OWNP, EEP, PHEAD, ARCH,
byteinteger CCT, SSBYTE, halfinteger PREFIX)
finish else start
recordformat file inff(string (11)NAME, integer SD,
shortinteger PGS, H0,
byteinteger CODES, CODES2, DAYNO, USE,
OWNP, EEP, PHEAD, ARCH,
CCT, SSBYTE, shortinteger PREFIX)
finish
recordformat pe(integer dest,srce,p1,p2,p3,p4,p5,p6)
if TARGET # 2900 start
RECORDFORMAT FINFF((INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG,
CCT, CODES, DAYNO, CODES2,
SSBYTE or INTEGERARRAY i(0:12)),STRING (6)OFFER)
finish else start
RECORDFORMAT FINFF(INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG,
CCT, CODES, BYTEINTEGER SP1, DAYNO, SP2, CODES2,
INTEGER SSBYTE,STRING (6)OFFER)
finish
!*
recordformat daf((integer blksi, nblks, last blk, spare,
integerarray da(1 : 512) or integer sparex, integerarray i(0:514)))
!
if TARGET = 2900 start
externalstringfnspec derrs(integer flag)
externalintegerfnspec ddap(integerfn a(integer a,b,c), integer act, addr)
externalintegerfnspec dsfi(string (6) user,
integer fsys, integer type, set, address)
externalroutinespec dstop(integer reason)
!%externalintegerfnspec change context
externalintegerfnspec d check bpass(string (6) user,
string (63) bpass, integer fsys)
externalintegerfnspec dpon3(string (6) user,
record (pe)name p, integer invoc, msgtype, outno)
externalroutinespec dpoff(record (pe)name p)
externalroutinespec dtoff(record (pe)name p)
externalintegerfnspec dgetda(string (6) user,
string (11) file, integer fsys, address)
externalintegerfnspec dchsize(string (6) user,
string (11) file, integer fsys, newsize)
externalroutinespec get av fsys(integername n,
integerarrayname a)
externalintegerfnspec dfsys(string (6) user, integername fsys)
externalintegerfnspec dpermission( c
string (6) owner, user, string (8) date,
string (11) file, integer fsys, type, adrprm)
externalintegerfnspec ddestroy(string (6) user,
string (11) file, string (8) date, integer fsys, type)
externalintegerfnspec ddisconnect(string (6) user, string (11) file c
integer fsys, destroy)
externalintegerfnspec drename(string (6) user,
string (11) oldname, newname, integer fsys)
externalintegerfnspec dfstatus(string (6) user,
string (11) file, integer fsys, act, value)
externalintegerfnspec dfilenames(string (6) user,
record (file inff)arrayname inf,
integername filenum, maxrec, nfiles, integer fsys, type)
externalintegerfnspec dfinfo(string (6) user,
string (11) file, integer fsys, address)
externalintegerfnspec dcreate(string (6) user,
string (11) file, integer fsys, nkb, type)
externalintegerfnspec dconnect(string (6) user,
string (11) file, integer fsys, mode, apf,
integername seg, gap)
externalintegerfnspec dmessage(string (6) user,
integername l, integer act, fsys, adr)
externalintegerfnspec dtransfer( c
string (6) user1, user2,
string (11) file, newname, integer fsys1, fsys2, type)
externalintegerfnspec dnewgen(string (6) user, string (11) file, c
newgen of file, integer fsys)
finish else start
EXTERNALINTEGERFNSPEC DCHECKBPASS(STRINGNAME USER, BPASS, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DCHSIZE(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, NKB)
! The physical size of file FILE belonging to file index FILE INDEX on
! disc-pack FSYS (or -1) is altered (if necessary) so that its new size
! is NEWKB Kbytes. The size may not be reduced to zero. The file may
! be connected in the caller's virtual memory (only). If the caller is
! not the file owner, he must either have W access to the file index or
! be privileged.
!%EXTERNALINTEGERFNSPEC CHANGE CONTEXT
EXTERNALINTEGERFNSPEC DCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, MODE, SEG, GAP)
EXTERNALINTEGERFNSPEC DCREATE(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, NKB, TYPE, DA)
! A file of name FILE is created, in file index FILE INDEX on disc-pack
! FSYS, of E Epages, where E is the smallest number of Epages containing
! NKB Kbytes. The maximum size of file allowed is 16 Mbytes. Subsystems
! requiring larger files should arrange that they be made up of subfiles
! comprising files created by this procedure.
!
! Bits in TYPE may be set:
!
! 2**0 For a temporary file (destroyed when the creating process
! stops if the file was connected, or at System start-up).
!
! 2**1 For a very temporary file (destroyed when the file is
! disconnected).
!
! 2**2 For a file which is to be zeroed when created.
!
! 2**3 To set "CHERISHed" status for the file.
!
!
! Temporary files are made into ordinary files (that is, the "temporary"
! attribute is removed) on being RENAMEd, OFFERed, TRANSFERred or
! PERMITted, and also explicitly by an appropriate call on procedure
! DFSTATUS.
!
! The disc address of the first section of the file is returned in DA.
EXTERNALINTEGERFNSPEC DDESTROY(STRINGNAME FILE INDEX, FILE, DATE, INTEGERNAME FSYS, TYPE)
! File FILE belonging to file index FILE INDEX on disc-pack FSYS, is
! destroyed. TYPE should be set to 1 to destroy a file from archive
! storage, otherwise it should be set to zero. When TYPE=1, DATE should
! be set to the archive date. DATE is ignored if TYPE=0.
!
! The procedure fails if 'OWNP' for the file is either zero (no access)
! or 8 (do not destroy).
EXTERNALINTEGERFNSPEC DDISCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, DSTRY)
! The file of name FILE belonging to file index FILE INDEX on disc-pack
! FSYS is disconnected from the caller's virtual memory. Parameter
! DESTROY should be set either to 0 or 1. If set to 1 the file will be
! destroyed, provided that it belongs to the process owner (not necessary
! if the process is privileged) and the "use-count" for the file is zero
! after disconnection. Otherwise the parameter is ignored.
EXTERNALINTEGERFNSPEC DFILENAMES(STRINGNAME GROUP, INTEGERNAME FILENO, MAXREC, C
NFILES, FSYS, TYPE, RECORD (file inff)ARRAYNAME INF)
! This procedure delivers, in the record array INFS (which should be
! declared (0:n)), a sequence of records describing the on-line files
! (for TYPE=0), archived files (for TYPE=1) or backed-up files (for
! TYPE=2) belonging to group GROUP on fsys FSYS (or -1 if not known).
!
! The procedure works differently for on-line files (TYPE=0) and
! off-line files (TYPE>0).
!
! For on-line files, the records returned give the names of files and
! groups belonging to GROUP but not the contents of any of these groups.
! DFILENAMES must be called again with GROUP set to the name of the
! subgroup to determine these. Thus
!
! FLAG = DFILENAMES(ERCC99,...
!
! returns the names of files and groups in ERCC99's main file index. If
! there is a group called PROJ:, the contents of it can be found with
!
! FLAG = DFILENAMES(ERCC99.PROJ:,...
!
! The group separator, :, may be omitted if desired.
!
! Note that the usage of . and : (USEP and GSEP) is reversed in EMAS3.
! The UINF fields USEP, USEPCH etc allow utilities to be written which
! will work for both EMAS2 and EMAS3.
!
! MAXREC is set by the caller to specify the maximum number of records he
! is prepared to accept in the array INFS, and is set by Director to be
! the number of records returned.
!
! NFILES is set by Director to be the number of files actually held on
! on-line storage or on archive storage, depending on the value of TYPE.
!
! FILENO is not normally used. [ If the top bit of MAXREC is set, FILENO
! is used in the same way as for off-line files, described below ]
!
! The format of the records returned in INFS is
!
! %string(11)NAME, %integer SPARE1, KBYTES,
! %byteinteger ARCH, CODES, CCT, OWNP,
! EEP, USE, CODES2, SSBYTE, SPARE2, PHEAD, DAYNO, GROUP
!
! ( 32 bytes )
! PHEAD is non-zero if the file or group has been permitted itself to a
! user or user group.
! GROUP is non-zero if NAME is the name of a group.
!
! For off-line files, TYPE = 1 or 2, GROUP will normally be be the name
! of a file index eg ERCC99 or ERCC99{UTILS} when all the names in the
! index will be returned. If an actual group name is given eg
!
! ERCC99.PROJ:
!
! then only names of the form
!
! ERCC99.PROJ:name
!
! are returned. MAXREC and NFILES are used in the same way as above.
!
! Filenames are stored in chronological order of archive (or backup) date,
! youngest first. FILENO is set by the caller to specify the "file-number"
! from which names are to be returned, zero representing the most recently
! archived file. Thus the caller can conveniently receive subsets of names
! of a very large number of files.
!
! The format of the records returned in INFS is
!
! %string(11)NAME, %integer KBYTES,
! %string(8)DATE, %string(6)TAPE,
! %halfinteger PREFIX, CHAPTER,
! %byteinteger EEP, PHEAD, SPARE, COUNT
!
! ( 40 bytes )
! To allow the full filenames to be reconstructed, the array INFS, in
! general, contains some records which hold group names. Records refering
! to filenames can be distinguished by the fact that KBYTES > 0. If PREFIX
! is > 0, the name is a member of a group whose name is given in the
! record INFS(PREFIX). The chain can be followed back until a record
! with a zero PREFIX field is found.
!
! Note. MAXREC does not give the number of filenames returned but the
! number of records in INFS.
!
! TAPE and CHAPTER are returned null to unprivileged callers.
EXTERNALINTEGERFNSPEC DFINFO(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, C
STRINGNAME S, INTEGERARRAYNAME I)
! This procedure returns detailed information about the attributes of
! file or group FILE belonging to file index FILE INDEX on disc-pack
! FSYS, in a record written to address ADR.
!
! A caller of the procedure having no permitted access to the file
! receives an error result of 32, as though the file did not exist.
!
! The format of the record returned is:
!
recordformat DFINFOF((integer NKB, RUP, EEP, APF,
USE, ARCH, FSYS, CONSEG, CCT, CODES,
byteinteger SP1, DAYNO, SP2, CODES2,
integer SSBYTE or INTEGERARRAY i(1:12)), string (6)OFFER)
!
! where
! NKB the number of Kbytes (physical file size)
! zero indicates a group name
! RUP the caller's permitted access modes
! EEP the general access permission
! APF 1-4-4 bits, right-justified, giving respectively the Execute,
! Write and Read fields of APF, if the file is connected in
! this VM
! USE the current number of users of the file
! ARCH the value of the archive byte for the file (see procedure
! DFSTATUS)
! FSYS disc-pack number on which the file resides
! CONSEG the segment number at which the file is connected in the
! caller's VM, zero if not connected
! CCT the number of times the file has been connected since this
! field was last zeroed (see procedure DFSTATUS)
! CODES information for privileged processes
! SP1 spare
! DAYNO Day number when file last connected
! SP2 spare
! CODES2 information for internal use
! SSBYTE information for the subsystem's exclusive use
! OFFER the username to which the file has been offered, otherwise
! null
EXTERNALINTEGERFNSPEC DFLAG(INTEGERNAME FLAG, STRINGNAME TXT)
EXTERNALINTEGERFNSPEC DFSTATUS(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, ACT, VALUE)
! This procedure is supplied to enable the attributes of file FILE
! belonging to file index FILE INDEX on disc-pack FSYS to be modified,
! as follows.
!
! Parameter VALUE is for use by the archive/backup program (ACT=13),
! and by the subsystem (ACT=18), otherwise it should be set to zero.
!
! ACT ACTION
!
! 0 HAZARD Remove CHERISHed attribute
!
! 1 CHERISH Make subject to automatic System back-up procedures
! Note: If the file is one of
! SS#DIR, SS#OPT or SS#PROFILE
! then the 'archive-inhibit' bit is also set.
! Similarly, the 'archive-inhibit' bit is
! cleared by HAZARD for these files.
!
! 2 UNARCHIVE Remove the "to-be-archived" attribute
!
! 3 ARCHIVE Mark the file for removal from on-line to archive
! storage.
!
! 4 NOT TEMP Remove the "temporary" attribute.
!
! 5 TEMPFI Mark the file as "temporary", that is, to be
! destroyed when the process belonging to the file
! owner stops (if the file is connected at that
! time), or at system start-up.
!
! 6 VTEMPFI Mark the file as "very temporary", that is, to be
! destroyed when it is disconnected from the owner's
! VM.
!
! 7 NOT PRIVATE May now be written to magnetic tape either for
! back-up or archive. May be called only by
! privileged programs.
!
! 8 PRIVATE Not to be written to magnetic tape either for
! back-up or archive. May be called only by
! privileged programs.
!
! 9 SET CCT Set the connect count for the file to VALUE.
!
! 11 ARCH Operation 1 (PRIVILEGED).
! Set currently-being-backed-up bit (bit 2**1 in
! ARCH byte), unless the file is currently connected
! in write mode, when error result 52 is given.
!
! 12 ARCH Operation 2 (PRIVILEGED).
! Clear currently-being-backed-up bit (2**1) and
! has-been-connected-in-write-mode bit (2**0).
!
! 14 ARCH Operation 4 (PRIVILEGED).
! Clear the UNAVAilable and privacy VIOLATed bits in
! CODES. Used by the back-up and archive programs
! when the file has been read in from magnetic tape.
!
! 15 CLR USE Clear file use-count and WRITE-CONNECTED status
! (PRIVILEGED).
!
! 16 CLR NOARCH Clear archive-inhibit bit in CODES. PRIVILEGED -
! for System
!
! 17 SET NOARCH Set archive-inhibit bit in CODES. Library use
!
! 18 SSBYTE Set SSBYTE to be the bottom 8 bits of VALUE (byte
! for a subsystem's exclusive use).
!
! 19 ARCH Operation 5 (PRIVILEGED).
! Set the WRCONN bit in CODES2. Used to prevent any
! user connecting the file in write mode during
! back-up or archive.
!
! 20 ARCH Operation 6 (PRIVILEGED).
! Clear the WRCONN bit in CODES2. Used when back-up
! is complete.
!
! 21 DAYNO Set DAYNO to bottom 8 bits of VALUE
EXTERNALINTEGERFNSPEC DFSYS(STRINGNAME FILE INDEX, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DFSYSDATA(INTEGERNAME FSYS, INTEGERARRAYNAME DATA)
EXTERNALINTEGERFNSPEC DGETDA(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, INTEGERARRAYNAME I)
! This procedure provides the disc addresses of the sections of file FILE
! belonging to file index FILE INDEX on disc-pack FSYS. Data is written
! from address ADR in the format
!
! (%integer SECTSI, NSECTS, LASTSECT, %integerarray DA(0:255))
!
! where SECTSI is the size (in epages) of the sections (except
! possibly the final section)
!
! NSECTS is the number of sections, and hence the number
! of entries returned in array DA
!
! LASTSECT is the size (in epages) of the final section
!
! In each entry in the DA array, the top byte contains the FSYS number.
EXTERNALINTEGERFNSPEC DMESSAGE(STRINGNAME USER, INTEGERNAME LEN, ACT, INVOC, FSYS, ADR)
EXTERNALINTEGERFNSPEC DNEWGEN(STRINGNAME FILE INDEX, FILE, NEWGEN, INTEGERNAME FSYS)
! This procedure provides a means of introducing an updated version
! (i.e. a new generation) of file FILE belonging to file index FILE INDEX
! even though it may be connected in other users' virtual memories.
!
! If FILE is not connected in any virtual memory, a call on DNEWGEN is
! equivalent to destroying FILE and then renaming NEWGEN to FILE,
! except that the new version of FILE retains the former FILE's access
! permissions.
!
! If FILE is connected in some virtual memory, then the filename
! NEWGEN "disappears", and any subsequent connection of FILE into
! a virtual memory yields the contents of the new generation formerly
! held in NEWGEN.
!
! When the number of users of a former copy of FILE becomes zero
! (i.e. when it is not connected in any virtual memory), that copy is
! destroyed.
EXTERNALINTEGERFNSPEC DPERMISSION(STRINGNAME FILE INDEX, C
USER, DATE, FILE, INTEGERNAME FSYS, TYPE, ADR)
! This procedure allows the caller to set access permissions, or specific
! preventions, for file connection to individual users, groups of users
! or to all users to file FILE belonging to file index FILE INDEX. It
! also allows a caller to determine the modes (if any) in which he may
! access the file.
!
! TYPE determines the service required of the procedure:
!
! TYPE Action
!
! 0 set OWNP (not for files on archive storage)
! 1 set EEP
! 2 put USER into the file list (see "Use of file
! access permissions", below)
! 3 remove USER from file list
! 4 return the file list
! 5 destroy the file list
! 6 put USER into the index list (see "Use of file
! access permissions", below)
! 7 remove USER from the index list
! 8 return the index list
! 9 destroy the index list
! 10 give modes of access available to USER for FILE
! 11 set EEP for the file index as a whole
!
! TYPEs 0 to 9 and 11 are available only to the file owner and to
! privileged processes. For TYPE 10, ADRPRM (see below) should be the
! address of an integer into which the access permission of USER to the
! file is returned. If USER has no access to the file, error result 32
! will be returned from the function, as though the file did not exist.
! If the file is on archive storage, TYPE should be set to 16 plus the
! above values to obtain the equivalent effects.
!
! ADRPRM is either the permission being attached to the file, bit
! values interpreted as follows:
!
! all bits zero prevent access
! 2**0 allow READ access
! 2**1 allow WRITE access not allowed for files
! 2**2 allow EXECUTE access on archive storage
! 2**3 If TYPE = 0, prevent the file from being
! destroyed by e.g. DDESTROY, DDISCONNECT (and
! destroy).
! or, except for type 10, it is the address of an area into which access
! permission information is to be written
!
! %recordformat(%integer BYTES RETURNED, OWNP, EEP, SPARE,
! %record(EF)%array INDIV PRMS(0:15))
!
! and EF is
! %recordformat EF(%string(6)USER, %byteinteger PERMISSION)
!
! where:
!
! BYTES indicates the amount of data returned.
! RETURNED
!
! OWNP is the file owner's own permission to the file, or the
! requesting user's "net" permission if the caller of the
! procedure is not the file owner (see "Use of file access
! permissions", below).
!
! EEP is the general (all users) access permission to the file
! ("everyone else's permission").
!
! UPRM The PERMISSION values in the sub-records are those
! for the corresponding users or groups of users denoted by
! USER. Up to 16 such permissions may be attached to a
! file.
!
! Use of file access permissions
!
! The general scheme for permissions is as follows. With each file
! there are associated:
!
! OWNP the permission of the owner of the file to access it
!
! EEP everyone else's permission to access it (other than users
! whose names are explicitly or implicitly attached to the
! file)
!
! INDIV PRMS a list of up to 16 items describing permissions for
! individual users, e.g. ERCC00, or groups of users, e.g.
! ERCC?? (specifying all usernames of which the first four
! characters are "ERCC")
!
! In addition, a user may attach a similar list of up to 16 items to
! his file index as a whole and an EEP for the file index. These
! permissions apply to any file described in the index along with those
! attached to that particular file.
! In determining the mode or modes in which a particular user may access
! a file, the following rules apply:
!
! 1. If the user is the file owner then OWNP applies.
!
! 2. Otherwise, if the user's name appears explicitly in the list for
! the file, the corresponding permission applies.
!
! 3. Otherwise, if the user's name is a member of a group of users
! represented by a list item for the file, the corresponding
! permission applies.
!
! 4. Otherwise EEP applies if greater than zero.
!
! 5. Otherwise, if the user's name appears explicitly in the list for
! the index, the corresponding permission applies.
!
! 6. Otherwise, if the user's name is a member of a group of users
! represented by a list item for the index, the corresponding
! permission applies.
!
! 7. Otherwise, everybody else's permission to the file index applies.
!
! In the event of a user's name appearing more than once (implicitly)
! within groups specified in a single list, the actual list item to be
! selected to give the permission should be regarded as indeterminate.
EXTERNALINTEGERFNSPEC DPOFF(RECORD (pe)NAME P)
EXTERNALINTEGERFNSPEC DPON3(STRINGNAME USER, RECORD (pe)NAME P, C
INTEGERNAME INVOC, MSGTYPE, OUTNO)
EXTERNALINTEGERFNSPEC DRENAME(STRINGNAME FILE INDEX, OLDNAME, NEWNAME, INTEGERNAME FSYS)
! File OLDNAME belonging to file index FILE INDEX on disc-pack FSYS is
! renamed NEWNAME.
!
! A file may not be renamed while it is connected in any virtual memory.
EXTERNALINTEGERFNSPEC DSTOP(INTEGERNAME REASON)
EXTERNALINTEGERFNSPEC DSFI(STRINGNAME FILE INDEX, INTEGERNAME FSYS, TYPE, C
SET, STRINGNAME S, INTEGERARRAYNAME I)
! This procedure is used to set or read information in file index FILE
! INDEX (or user record in some cases) on disc-pack FSYS. TYPE specifies
! which data item is to be referenced (see list below). SET must be 1
! to write the data item into the index, or 0 to read the item from the
! index. ADR is the address of an area, which must be available in write
! or read mode, to or from which the data item is to be transferred.
!
! TYPE Data item Data type & size
!
! 0 BASEFILE name (the file to be connected
! and entered at process start-up) string(18)
!
! 1 DELIVERY information (to identify string(31)
! slow-device output requested by the
! index owner)
!
! 2 CONTROLFILE name (a file for use by the
! subsystem for retaining control information) string(18)
!
! 3 ADDRTELE address and telephone number of user string(63)
!
! 4 INDEX USE (may not be reset)
! Gives (in successive integers from ADR):
! a) number of files
! b) number of file descriptors currently in use
! c) number of free file descriptors
! d) index size (Kbytes)
! e) Number of section descriptors (SDs)
! f) Number of free section descriptors
! g) Number of permission descriptors (PDs)
! h) Number of free permission descriptors integer(x8)
!
! 5 Foreground and background passwords
! (reading is a privileged operation), a zero
! value means "do not change" integer(x2)
!
! 6 Date last logged-in: (Y-70)<<9 ! (M<<5) ! D and
! date last started (non-interactive) (same)
! (may not be reset) integer(x2)
!
! 7 ACR level at which the process owning this
! index is to run (may be set only by privileged
! processes) integer
!
! 8 Director Version (may be set only by privileged
! processes) integer(x2)
!
! 9 ARCHIVE INDEX USE (may not be reset)
! Gives (in successive integers from ADR):
! a) number of archived files
! b) number of archived Kbytes
! c) number of backed-up files
! d) number of backed-up Kbytes
! e) index size (Kbytes)
! f) number of file descriptors
! g) number of free file descriptors
! h) number of permission descriptors
! i) number of free permission descriptors integer(x9)
!
! 10 Stack size (Kbytes) integer
!
! 11 Limit for total size of all files in disc
! storage (Kbytes) (may be set only by privileged
! processes integer
!
! 12 Maximum file size (Kbytes) (may be set only by
! privileged processes) integer
!
! 13 Current numbers of interactive and batch
! processes, respectively, for the user (may
! not be reset) integer(x2)
!
! 14 Process concurrency limits (may be set only
! by privileged processes). The three words
! denote respectively the maximum number of
! interactive, batch and total processes which
! may be concurrently running for the user.
! (Setting the fields to -1 implies using
! the default values, currently 1, 1 and 1.) integer(x3)
!
! 15 When bit 2**0 is set, TELL messages to the
! index owner are rejected with flag 48. integer
!
! 16 Set Director monitor level (may be set only
! by privileged processes) integer(x2)
!
! 17 Set SIGNAL monitor level (may be set only
! by privileged processes) integer
!
! 18 Initials and surnames of user (may
! be set only by privileged processes) string(31)
!
! 19 Director monitor file string(11)
!
! 20 Thousands of instructions executed, interactive
! and batch modes (may be reset only by
! privileged processes) integer(x2)
!
! 21 Thousands of instructions executed (current
! session only) integer
!
! 22 Thousands of instructions executed in Director
! procedures (current process session only)
! (may not be reset) integer
!
! 23 Page-turns, interactive and batch modes
! (may be reset only by privileged processes) integer(x2)
!
! 24 Page-turns (current process session only) integer
!
! 25 Thousands of bytes output to slow-devices
! (local or remote) (may be reset only by
! privileged processes) integer
!
! 26 Thousands of bytes input from slow-devices
! (local or remote) (may be reset only by
! privileged processes) integer
!
! 27 Milliseconds of OCP time used, interactive
! and batch modes (may be reset only by
! privileged processes) integer(x2)
!
! 28 Milliseconds of OCP time used (current
! session only) integer
!
! 29 Seconds of interactive terminal connect time
! (may be reset only by privileged processes) integer
!
! 30 No. of disc files, total disc Kbytes, no. of
! cherished files, total cherished Kbytes, no.
! of temporary files, total temporary Kbytes
! (cannot be reset) integer(x6)
!
! 31 No. of archive files, total archive Kbytes integer(x2)
!
! 32 Interactive session length in minutes integer
! 0 or 5 <= x <= 240
!
! 33 Funds integer
!
! 34 The FSYS of the Group Holder of the index integer
! owners funds, if he has a GH
!
! 35 Test BASEFILE name string(18)
!
! 36 Batch BASEFILE name string(18)
!
! 37 Group Holder of funds for scarce resources string(6)
!
! 38 Privileges integer
!
! 39 Default LP string(15)
!
! 40 Dates passwords last changed integer(x2)
! (may not be reset)
!
! 41 Password data integer(x8)
!
! 42 Get accounting data integer(x17)
!
! 43 Mail count integer
! (may be reset only by privileged processes)
!
! 44 Supervisor string(6)
!
! 45 Secure record about 512 bytes
!
! 46 Gateway access id string(15)
!
! 47 File index attributes byte
!
! 48 User type byte
EXTERNALINTEGERFNSPEC DTOFF(RECORD (pe)NAME P)
EXTERNALINTEGERFNSPEC DTRANSFER(STRINGNAME FILE INDEX1, FILE INDEX2, FILE1, C
FILE2, INTEGERNAME FSYS1, FSYS2, TYPE)
! This procedure transfers FILE1 belonging to file index FILE INDEX1 on
! FSYS1 to the ownership of file index FILE INDEX2 on FSYS2 under name
! FILE2.
!
! TYPE = 0 'accepts' a file which has been 'offered'. This call
! is non-privileged.
! 1 a privileged call to transfer a file.
! 2 like 1, but, in addition, forces a re-allocation of the
! disc space.
! 3 a privileged call to copy the file.
! 4 as 3 but works even when file connected W (for test purposes)
EXTERNALINTEGERFNSPEC DVALIDATE(INTEGERNAME ADR, LEN, RW)
finish
constinteger not assigned = x'80808080'
constinteger yes = 1
constinteger file header size = 32
constinteger already exists = 16; !DIRECTOR FLAG
constinteger r = b'00000001'; !READ PERMISSION
constinteger w = b'00000010'; !WRITE PERMISSION
constinteger shared = b'00001000'; !ALLOW OTHERS ACCESS
constinteger link list entries = 1000
constinteger link list entry size = 28
constinteger max fep = 7; !MAXIMUM FEPS CURRENTLY ALLOWED.
constinteger max queues = 255; !MAX QUEUES ALLOWED IN CONFIGURATION
constinteger max remotes = 128; !MAX REMOTES ALLOWED IN CONFIGURATION
constinteger max streams = 255; !MAX STREAMS ALLOWED IN CONFIGURATION
constinteger queue entry size = 148; !NUMBER OF BYTES IN A QUEUE DESCRIPTOR
constinteger remote entry size = 172; !NUMBER OF BYTES IN A REMOTE DESCRIPTOR
!NOTE THIS INCLUDES SPACE FOR UP TO 8 FEPS, ADJUST FOR FURTHER IN GROUPS OF 4.
constinteger stream entry size = 200; !NUMBER OF BYTES IN A STREAM DESCRIPTOR
constinteger name entry size = 24
constinteger qdescriptors = 15
constinteger rdescriptors = 5
constinteger sdescriptors = 13
conststring (11) temp outfile = "TEMPCFILE"
conststring (11) link list name = "SPOOLLINK"
conststring (15) array qd(1 : q descriptors) = c
"QUEUE=",
"USER=",
"DELIVERY=",
"START=",
"PRIORITY=",
"TIME=",
"OUTPUTLIMIT=",
"FORMS=",
"MODE=",
"COPIES=",
"RERUN=",
"MAXLENGTH=",
"MAXACR=",
"QBY=",
"RESOURCELIMIT="
constbyteintegerarray qdt(1 : q descriptors) = c
15,6,31,0,5,0,0,0,3,0,3,0,0,15,0; !A 0 SPECIFIES PARAMETER IS AN INTEGER ELSE LENGTH OF STRING
conststring (15) array rd(1 : rdescriptors)= c
"REMOTE=",
"STATUS=",
"FEP=",
"NETADDRESS=",
"PASSWORD="
constbyteintegerarray rdt(1 : rdescriptors) = c
15,12,0,255,7; !A 0 SPECIFIES PARAMETER IS AN INTEGER ELSE LENGTH OF STRING
conststring (15) array sd(1 : sdescriptors) = c
"STREAM=",
"REMOTE=",
"STATUS=",
"DEVICETYPE=",
"DEVICENO=",
"LIMIT=",
"FORMS=",
"LOWESTPRIORITY=",
"TYPE=",
"QUEUE=",
"HEADER=",
"UNITSIZE=",
"UNITNAME="
constbyteintegerarray sdt(1 : sdescriptors) = c
15,15,11,2,0,0,0,5,6,255,15,0,7; !A 0 SPECIFIES PARAMETER IS AN INTEGER ELSE LENGTH OF STRING
conststring (13) array stream types(0 : 5) = c
"OUTDEV",
"$OUTDEV",
"INDEV",
"JOB",
"PROC",
"$PROC"
conststring (3) array modes(0 : 2) = c
"ISO",
"EBC",
"BIN"
conststring (15) array remote status(0 : 3) = c
"CLOSED",
"OPEN",
"PRELOGON",
"PRELOGONTIED"
conststring (15) array stream status(0 : 1) = c
"UNALLOCATED",
"ALLOCATED"
conststring (15) array header types(1 : 3) = c
"LINEPRINTER",
"TAPEPUNCH",
"CARDPUNCH"
conststring (2) array device type(0 : 15) = c
"NA","PP","PR","CP","CR","MT","LP","GP","OP","MP","DO",
"NA","CT","SU","FE","NA"
conststring (5) array priorities(1 : 5) = c
"VLOW",
"LOW",
"STD",
"HIGH",
"VHIGH"
ownbyteintegerarray temp qs name(0 : 2*name entry size -1) = c
0(2*name entry size); !AREA FOR DEFAULT CONFIGURATION OF 2 QUEUES
ownbyteintegerarray temp rmts name(0 : name entry size -1) = c
0(name entry size); !DITTO FOR ONE REMOTE
ownbyteintegerarray temp strms name(0 : name entry size-1) = c
0(name entry size); !DITTO FOR ONE STREAM
ownbyteintegerarray temp qs(0 : 2*queue entry size -1) = c
0(2*queue entry size); !AREA FOR DEFAULT CONFIGURATION OF 2 QUEUES
ownbyteintegerarray temp rmts(0 : remote entry size -1) = c
0(remote entry size); !DITTO FOR ONE REMOTE
ownbyteintegerarray temp strms(0 : stream entry size-1) = c
0(stream entry size); !DITTO FOR ONE STREAM
recordformat pointers f(integer queues, queue entry size, queue displ,
queue name displ, streams, stream entry size, stream displ,
stream name displ, remotes, remote entry size, remote displ,
remote name displ, ftp stations, station entry size,
ftp station displ)
if TARGET = 2900 start
recordformat queuef(string (15) name,
halfintegerarray streams(0 : 15),
string (7) default user,
string (31) default delivery,
integer default start, default priority, default time,
default output limit, default forms, default mode, default copies,
default rerun, length, head, max length, maxacr,
halfinteger q by, general access, integer resource limit,
amount)
finish else start
recordformat queuef(string (15) name,
(shortintegerarray streams(0 : 15) or shortintegerarray lines(0 : 15)),
string (7) default user,
string (31) default delivery,
integer default start, default priority, default time,
default output limit, default forms, default mode, default copies,
default rerun, length, head, max length, maxacr,
shortinteger q by, general access, integer resource limit,
amount)
finish
recordformat remotef(string (15) name,
integer status, lowest stream, highest stream, fep, old fep,
prelog fep, prelog, timeout, polling, command lock,
byteinteger unused1, unused2, n add type,
(byteinteger n add len, byteintegerarray network address(0 : 63) c
or string (64) TS address),
byteintegerarray fep route value(0 : max fep),string (31) description,
string (7) password)
if TARGET = 2900 start
recordformat stream f(string (15) name, string (7) unit name,
integer q no, halfintegerarray queues(0 : 15),
integer status, bytes sent, bytes to go, block, part block,
document, spare1, spare2, spare3,
byteinteger service, user abort, unit size, fep,
integer remote, abort retry count, offset,
(integer in comms stream or integer comms stream),
integer out comms stream,
(integer in stream ident or integer ident),
integer out stream ident,
(integer limit, account,
byteinteger device type, device no, forms, lowest priority,
header type, header number, batch enable, invoc,
string (55) unused or integer transfer status, tcc subtype,
in block addr, out block addr,
byteinteger activity, station type, station ptr, suspend,
in stream status, out stream status,
timer, output buffer status, output transfer pending, sp1,
halfinteger kbmoved,
integer xspare1, xspare2, xspare3,
record (pe) output transfer record))
finish else start
recordformat stream f(string (15) name, string (7) unit name,
integer q no, shortintegerarray queues(0 : 15),
integer status, bytes sent, bytes to go, block, part blocks,
document, string (6) barred user, (byteinteger reallocate or byteinteger logical dap),
integer bin offset, byteinteger service, user abort, unit size, fep,
integer remote, byteinteger abort retry count, connect fail expected,
TS call accept,spb, integer offset,
(integer in comms stream or integer comms stream),
integer out comms stream,
(integer in stream ident or integer ident),
integer out stream ident,
(integer limit, account,
byteinteger device type, device no, forms, lowest priority,
header type, header number, batch enable, invoc,
string (55) unused or integer transfer status, tcc subtype,
in block addr, out block addr,
byteinteger activity, station type, station ptr, suspend,
in stream status, out stream status,
timer, output buffer status, output transfer pending,
new ftp data record,sp2,sp3,
integer aux document, pre abort status, bytes transferred,
record (pe) output transfer record))
finish
recordformat fhf(integer end, start, size, type, remotes,
datetime, queues, streams)
ownstring (255) ns1, ns2
externalintegerfnspec pack date and time(string (8) date, time)
externalstringfnspec itos(integer i)
externalintegerfnspec stoi(stringname s)
externalroutine read spool config( c
string (6) infile owner, outfile owner,
integer in fsys, out fsys,
string (11) infile, outfile,
integername queues, qconad, remotes, rconad, streams,
sconad, qnconad,snconad,rnconad, link list conad)
!***********************************************************************
!* *
!* PURPOSE OF THIS ROUTINE IS TO READ IN A SPOOLER CONFIGURATION FILE *
!* WHICH IS IN TEXT FORMAT AND CREATE A FILE FOR PASSING ON TO THE *
!* SPOOLER PROCESS AS A DATA BASE. *
!* *
!***********************************************************************
stringfnspec errs(integer flag)
record (fhf)name file header
record (queuef)name queue entry
record (remotef)name remote entry
record (streamf)name stream entry
recordformat nf(string (15) name, string (7) user)
record (nf)arrayformat qaf(1:max queues)
record (nf)arrayformat saf(1:max streams)
record (nf)arrayformat raf(1:max remotes)
record (nf)arrayname queue name entries
record (nf)arrayname stream name entries
record (nf)arrayname remote name entries
record (pointers f)name pointers
string (255) line, temps, temp1, temp2
integer text pointer, text end, seg, gap, flag, i, j, k, l,
value, conad, config size, headers, ptr conad
switch qswt(1 : q descriptors), rswt(1 : rdescriptors),
sswt(1 : sdescriptors)
stringfn errs(integer flag)
integer i; string (63) error
if TARGET = 2900 then result = derrs(flag) else START
i = dflag(flag,error)
result = error
FINISH
end
routine read line(stringname line)
!***********************************************************************
!* *
!* READS A LINE OF TEXT TERMINATED BY A NEWLINE. SKIPPING LEADING *
!* NEWLINES AND SPACES. IGNORES SPACES IN LINE *
!* WHEN TEXT POINTER = TEXT END (END OF FILE). RETURNS A NULL LINE IF *
!* END OF FILE. *
!* *
!***********************************************************************
integer sym, comment
comment = 0
line = ""
text pointer = text pointer+1 c
while text pointer < text end c
and (byteinteger(text pointer) = ' ' c
or byteinteger(text pointer) = nl)
return if text pointer = text end
sym = byteinteger(text pointer); !READ A SYMBOL
text pointer = text pointer+1
while sym # nl and text pointer < text end cycle
line = line.to string(sym) unless (sym = ' ' and comment = 0);!NOT SPACES EXCEPT WITHIN COMMENT
comment = 1 if sym = '!'
sym = byteinteger(text pointer)
text pointer = text pointer+1
repeat
end ; !OF ROUTINE READ LINE
routine create and connect(string (6) name,
string (11) outfile, integer fsys, size, mode,
integername conad)
!***********************************************************************
!* *
!* DESTROYS A FILE IF IT EXISTS. THEN CREATES A NEW FILE AND THEN *
!* CONNECTS IT. CONAD = 0 IF UNSUCCESSFUL SIZE IS GIVEN IN BYTES. *
!* *
!***********************************************************************
integer flag, seg, gap, ada
string (31) filename
conad = 0; !INITIALLY ZERO
filename = name.".".outfile
flag = ddestroy(name,outfile,"",fsys,0); !INCASE IT ALREADY EXISTED
if TARGET # 2900 then flag = dcreate(name,outfile,fsys,(size+1023)>>10,4,ada) c
else flag = dcreate(name,outfile,fsys,(size+1023)>>10,4)
!CREATE FILE AND ZERO.
if flag = 0 start
seg = 0; gap = 0
if TARGET # 2900 then flag = dconnect(name,outfile,fsys,mode,seg,gap) c
else flag = dconnect(name,outfile,fsys,mode,0,seg,gap)
if flag = 0 then conad = seg<<seg shift c
else print string("CONNECT ".filename." FAILS ". c
errs(flag).snl)
finish else print string("CREATE ".filename." FAILS ". c
errs(flag).snl)
end ; !OF ROUTINE CREATE AND CONNECT
!THE FOLLOWING VALUES ARE PASSED BACK TO THE CALLING ROUTINE
queues = 0; !THE NUMBER OF QUEUES IN THE CONFIGURATION
qconad = 0; !THE CONNECT ADDRESS OF THE QUEUE TABLE
remotes = 0; !THE NUMBER OF REMOTES IN THE CONFIGURATION
rconad = 0; !THE CONNECT ADDRESS OF THE REMOTES TABLE
streams = 0; !THE NUMBER OF STREAMS IN THE CONFIGURATION
sconad = 0; !THE CONNECT ADDRESS OF THE STREAM TABLE
qnconad = 0;snconad = 0;rnconad = 0; !the 'name' areas for queue/stream/remote tables
headers = 0; !THE NUMBER OF STREAMS REQUIRING HEADERS
if infile owner # "" and infile # "" start
seg = 0; gap = 0; !ANY SEGMENT ANY GAP
if TARGET # 2900 then flag = dconnect(infile owner,infile,in fsys,r,seg,gap) c
else flag = dconnect(infile owner,infile,in fsys,r,0,seg,gap)
!CONNECT INPUT FILE TO READ
if flag = 0 start
conad = seg<<seg shift; !TURN SEGMENT INTO A VIRTUAL ADDRESS
file header == record(conad); !MAP FILE HEADER
text pointer = conad+file header_start; !ADDR OF FIRST BYTE (USED BY READ LINE)
text end = conad+file header_end; !ADDR OF LAST BYTE + 1 (USED BY READ LINE)
config size = max queues*queue entry size+max remotes c
*remote entry size+max streams*stream entry size+file header size + c
(max streams+max queues+max remotes)*name entry size
create and connect(outfile owner,temp outfile,
out fsys,config size,r!w,conad)
create and connect(outfile owner, outfile."PTRS", out fsys, c
1024,r!w!shared, ptr conad)
!This file contains the pointers to the main spooler database.
if conad # 0 and ptr conad # 0 start ; !SUCCESSFULLY CREATED CONFIG FILE
!* QUEUE INPUT SECTION
conad = conad+file header size
!now initialise the pointer file.
pointers == record(ptr conad + file header size)
file header == record(ptr conad)
file header_start = file header size
file header_size = x'1000'
read line(line); !READ FIRST LINE IN FILE
if line -> ns1.("QUEUES=").ns2 and ns1="" start ; !NUMBER OF QUEUES
temps = ns2; temps = temp1 if temps -> temp1.("!").temp2
!REMOVE ANY COMMENTS
queues = s to i(temps)
if 1 <= queues <= max queues start
!VALID NUMBER OF QUEUES
qnconad = conad+queues*queue entry size
queue name entries == array(qnconad,qaf)
pointers_queues = queues
pointers_queue displ = file header size
pointers_queue name displ = pointers_queue displ + queues*queue entry size
pointers_queue entry size = queue entry size
cycle i = 1,1,queues;!ROUND EACH QUEUE DESCRIPTOR
queue entry == record(conad+(i-1)* c
queue entry size)
!MAP QUEUE ENTRY
cycle j = 1,1,q descriptors;!READ EACH Q DESCRIPTOR
read line(line)
exit if line = ""; !A NULL LINE SIGNIFIES THE END OF FILE
if line -> ns1.(qd(j)).ns2 and ns1="" start
!CORRECT FORMAT?
temps=ns2
temps = temp1 if temps -> temp1.( c
"!").temp2
!REMOVE COMMENTS
-> nextq if temps = "NA" c
or temps = "NOTAPPLICABLE"
if qdt(j) = 0 start ; !NUMERIC PARAMETER
value = stoi(temps)
-> failq if value = c
not assigned or value < 0
finish else start ; !STRING PARAMETER
-> failq unless 1 <= length( c
temps) <= qdt(j)
finish
-> qswt(j); !INTERPRET TEMPS
qswt(1):
!NAME OF QUEUE
queue entry_name = temps
queue name entries(i)_name = temps
-> nextq
qswt(2):
!DEFAULT USERNAME
queue entry_default user = temps
-> nextq
qswt(3):
!DEFAULT DELIVERY
queue entry_default delivery = temps
-> nextq
qswt(4):
!START BYTE IN FILE
queue entry_default start = value
-> next q
qswt(5):
!DEFAULT PRIORITY
cycle k = 1,1,5
if temps = priorities(k) start
queue entry_default priority = k
-> nextq
finish
repeat
-> failq
qswt(6):
!DEFAULT CPU TIME
if value > 0 start
queue entry_default time = value
-> nextq
finish else -> failq
qswt(7):
!DEFAULT OUTPUT LIMIT
if value > 0 start
queue entry_default output limit = c
value
-> nextq
finish else -> failq
qswt(8):
!DEFAULT FORMS TYPE
if value <= 255 start
queue entry_default forms = value
-> nextq
finish else -> failq
qswt(9):
!DEFAULT MODE
cycle k = 0,1,2
if temps = modes(k) start
queue entry_default mode = k
-> nextq
finish
repeat
-> failq
qswt(10):
!DEFAULT COPIES
if 0 < value <= 255 start
queue entry_default copies = value
-> nextq
finish else -> failq
qswt(11):
!DEFAULT RERUN
if temps = "YES" or temps = "NO" c
start
queue entry_default rerun = yes c
if temps = "YES"
-> next q
finish else -> failq
qswt(12):
!MAXIMUM LENGTH OF QUEUE
queue entry_max length = value
-> nextq
qswt(13):
!MAX ACR WITH ACCESS TO THIS QUEUE
if 0 < value <= 15 start
queue entry_max acr = value
-> nextq
finish else -> failq
qswt(14):
!QUEUE BY ALGORITHM
queue entry_q by = 0
-> nextq
qswt(15):
!SET RESOURCE LIMIT FOR PRIORITY CALCULATION
if value > 0 start
queue entry_resource limit = value
->nextq
finishelse -> failq
finish
failq: print string("QUEUE ".i to s(i)." ". c
queue entry_name." ENTRY ".qd(j). c
" WRONG ".line.snl)
nextq:
repeat ; !EACH QUEUE DESCRIPTOR
exit if line = ""; !END OF FILE?
repeat ; !EACH QUEUE
!* REMOTE INPUT SECTION
read line(line); !GET NUMBER OF REMOTES
if line -> ns1.("REMOTES=").ns2 and ns1="" start
!IS IT NUMBER OF REMOTES?
temps=ns2; temps = temp1 if temps -> temp1.("!").temp2
!REMOVE COMMENTS
remotes = s to i(temps)
if 1 <= remotes <= max remotes start
!VALID NUMBER OF REMOTES?
rnconad = conad+queues*queue entry size+ c
queues*name entry size +remotes*remote entry size
remote name entries == array(rnconad,raf)
pointers_remotes = remotes
pointers_remote displ = pointers_queue displ + c
queues*(queue entry size+name entry size)
pointers_remote name displ = pointers_remote displ + c
remotes*remote entry size
pointers_remote entry size = remote entry size
cycle i = 1,1,remotes; !ROUND EACH REMOTE
remote entry == record(conad+queues* c
queue entry size+(i-1)* c
remote entry size+queues*name entry size)
!MAP REMOTE ENTRY
cycle j = 1,1,r descriptors
read line(line)
exit if line = "";!END OF FILE?
if line -> ns1.(rd(j)).ns2 and ns1="" start
!CORRECT FORMAT?
temps=ns2; temp2 = ""
temps = temp1 if temps -> c
temp1.("!").temp2
!IGNORE COMMENTS
-> nextr if temps = "NA" c
or temps = "NOTAPPLICABLE"
if rdt(j) = 0 start
!NUMERIC
value = stoi(temps)
-> failr if value = c
not assigned or value < 0
finish else start
!STRING
-> failr unless 1 <= c
length(temps) <= rdt(j)
finish
-> rswt(j)
rswt(1):
!NAME OF REMOTE
remote entry_name = temps
remote name entries(i)_name = temps
if length(temp2)>0 and charno(temp2,1)='*' c
start
temp2->("*").temp2
if length(temp2)>31 then length(temp2)=31
remote entry_description = temp2
finish else remote entry_description = ""
if temps = "LOCAL" then remote entry_status = 3
!IE IF IT IS THE 'LOCAL' REMOTE THE INITS STATE MUST BE LOGGED ON.
-> nextr
rswt(2):
!DEFAULT REMOTE STATUS
cycle k = 0,1,3
if temps = remote status( c
k) start
if k<2 then remote entry_status = k c
else start
remote entry_status = 1; !IE OPEN
if k=2 then remote entry_prelog c
=1 else remote entry_prelog=2
finish
-> nextr
finish
repeat
-> failr
rswt(3):
!DEFAULT FEP
if value <= 9 start
remote entry_prelog fep = value
-> nextr
finish else -> failr
rswt(4):
!DEFAULT NETWORK ADDRESS
k = 0
while temps # "" cycle
temp1 = "" unless temps -> c
temps.("_").temp1
if temp1 = "" and k = 0 start
!Then it is a 'text' logon address.
remote entry_n add type = 2 {TS}
cycle k = 1,1,length(temps)
remote entry_network address(k-1) = c
byteinteger(addr(temps)+k)
repeat
k = length(temps)
exit
finish
-> failr if k = 32
remote entry_n add type = 1 {NSI}
l = stoi(temps)
if 0 <= l <= 255 start
remote entry_ c
network address(k) = l
k = k+1
finish else -> failr
temps = temp1
repeat
remote entry_n add len = k
-> nextr
rswt(5):
!THE REMOTE PASSWORD.
remote entry_password = temps
-> nextr
finish
failr: print string("REMOTE ".i to s(i c
)." ".remote entry_name. c
" ENTRY ".rd(j)." WRONG ". c
line.snl)
nextr:
repeat ; !EACH REMOTE DESCRIPTOR
exit if line = ""; !END OF FILE
repeat ; !EACH REMOTE
!* STREAM INPUT SECTION
read line(line);!GET NUMBER OF STREAMS
if line -> ns1.("STREAMS=").ns2 and ns1="" start
!IS IT NUMBER OF STREAMS?
temps=ns2
temps = temp1 if temps -> temp1.( c
"!").temp2
!REMOVE COMMENTS
streams = s to i(temps)
if 1 <= streams <= max streams start
!VALID NUMBER OF STREAMS?
snconad = queues*queue entry size c
+queues*name entry size +remotes*remote entry size + remotes*name entry size c
+conad + streams*stream entry size
stream name entries == array(snconad,saf)
pointers_streams = streams
pointers_stream displ = pointers_remote displ + c
remotes*(remote entry size+name entry size)
pointers_stream name displ = pointers_stream displ + c
streams*stream entry size
pointers_stream entry size = stream entry size
cycle i = 1,1,streams
!ROUND EACH STREAM
stream entry == record( c
queues*queue entry size+ c
remotes*remote entry size c
+(queues+remotes)*name entry size+conad+(i-1)* c
stream entry size)
!MAP STREAM ENTRY
cycle j = 1,1,s descriptors
!ROUND EACH STREAM DESCRIPTOR
read line(line)
exit if line = ""
!END OF FILE?
if line -> ns1.(sd(j)).ns2 and ns1="" start
!CORRECT FORMAT?
temps=ns2
temps = temp1 if temps -> c
temp1.("!").temp2
!IGNORE COMMENTS
-> nexts if temps = c
"NA" or temps = c
"NOTAPPLICABLE"
if sdt(j) = 0 start
!NUMERIC
value = stoi(temps)
-> fails if value = c
not assigned or c
value < 0
finish else start
!STRING
-> fails unless 1 c
<= length(temps) c
<= sdt(j)
finish
-> sswt(j)
sswt(1):
!NAME OF STREAM
stream entry_name = temps
stream name entries(i)_name = temps
-> nexts
sswt(2):
!REMOTE FOR STREAM
cycle k = 1,1,remotes
remote entry == c
record(conad+ c
queues* c
queue entry size+( c
k-1)* c
remote entry size+queues*name entry size)
if remote entry_ c
name = temps start
stream entry_remote = k
remote entry_ c
lowest stream = c
i if c
remote entry_ c
lowest stream = 0
-> fails unless c
remote entry_ c
highest stream = c
0 or c
remote entry_ c
highest stream = c
i-1
remote entry_ c
highest stream = i
-> nexts
finish
repeat
-> fails
sswt(3):
!DEFAULT STREAM STATUS
cycle k = 0,1,1
if temps = c
stream status(k) c
start
stream entry_status = k
-> nexts
finish
repeat
-> fails
sswt(4):
!DEVICE TYPE
cycle k = 0,1,15
if device type(k) = c
temps start
stream entry_ c
device type = k
-> fails if c
stream entry_ c
remote = 0
remote entry == c
record(conad+ c
queues* c
queue entry size+( c
stream entry_ c
remote-1)* c
remote entry size+queues*name entry size)
if remote entry_ c
name = "LOCAL" c
then start
stream entry_ c
ident = k<<24
if TARGET # 2900 and k = 4 then printstring("LOCAL CR not (yet) handled".snl) c
and -> fails
finish else c
stream entry_ c
ident = 14<<24
!FEP
-> nexts
finish
repeat
-> fails
sswt(5):
!DEVICE NO
if value <= 9 start
stream entry_ c
device no = value
-> fails if c
stream entry_ c
remote = 0
remote entry == c
record(conad+ c
queues* c
queue entry size+( c
stream entry_ c
remote-1)* c
remote entry size+queues*name entry size)
if remote entry_ c
name = "LOCAL" c
then c
stream entry_ c
ident = c
stream entry_ c
ident!value<<16 c
else c
stream entry_ c
ident = c
stream entry_ c
ident! c
remote entry_fep<<16
-> nexts
finish else -> fails
sswt(6):
!DEFAULT LIMIT
stream entry_limit = value
-> nexts
sswt(7):
!DEFAULT FORMS
if value <= 255 start
stream entry_forms = c
value
-> nexts
finish else -> fails
sswt(8):
!LOWEST PRIORITY
cycle k = 1,1,5
if temps = c
priorities(k) start
stream entry_ c
lowest priority = k
-> nexts
finish
repeat
-> fails
sswt(9):
!STREAM TYPE
cycle k = 0,1,5
if temps = c
stream types(k) start
stream entry_ c
service = k
-> nexts
finish
repeat
-> fails
sswt(10):
!QUEUES ATTACHED TO
remote entry==record(conad+ c
queues*queue entry size+( c
stream entry_remote-1)* c
remote entry size+queues*name entry size)
while temps # "" cycle
temp1 = "" unless c
temps -> temps.( c
"&").temp1
cycle k = 1,1,queues
queue entry == c
record(conad+(k-1 c
)* c
queue entry size)
if queue entry_ c
name = temps start
cycle l = 0,1,15
if stream entry_ c
queues(l) = 0 start
stream entry_queues c
(l) = k
if remote entry_name = "LOCAL" and c
stream entry_service = 0 then c
queue entry_general access = 1
!IE OFFER ALL LOCAL OUTPUT QUEUES.
-> out1
finish
repeat
-> fails
out1:
if stream entry_ c
service # 2 start
!NOT INPUT STREAMS
cycle l = 0,1,15
if queue entry_ c
streams(l) = 0 start
queue entry_streams c
(l) = i
-> out2
finish
repeat
-> fails
finish else -> out2
finish
repeat
-> fails
out2: temps = temp1
repeat
-> nexts
sswt(11):
!HEADER TYPE
cycle k = 1,1,3
if temps = c
header types(k) start
stream entry_ c
header type = k
headers = headers+1
stream entry_ c
header number = c
headers
-> nexts
finish
repeat
-> fails
sswt(12):
! UNIT SIZE
if value <= 255 start
stream entry_unitsize = value
-> nexts
finish else -> fails
sswt(13):
! UNIT NAME
stream entry_unitname = temps
-> nexts
finish
fails: print string("STREAM ". c
i to s(i)." ". c
stream entry_name. c
" ENTRY ".sd(j). c
" WRONG ".line.snl)
nexts:
repeat ; !EACH STREAM DESCRIPTOR
exit if line = ""
!END OF FILE
repeat ; !EACH STREAM
finish else print string( c
"INVALID NUMBER OF STREAMS ". c
line.snl)
finish else print string( c
"NUMBER OF STREAMS MUST BE NEXT IN CONFIG FILE NOT " c
.line.snl)
finish else print string( c
"INVALID NUMBER OF REMOTES ".line.snl)
finish else print string( c
"NUMBER OF REMOTES MUST BE NEXT IN CONFIG FILE NOT ". c
line.snl)
finish else print string( c
"INVALID NUMBER OF QUEUES ".line.snl)
finish else print string( c
"NUMBER OF QUEUES MUST BE FIRST IN CONFIG FILE NOT ". c
line.snl)
!* AT THIS POINT A CONFIG FILE IS CREATED AND CONNECTED
flag = ddisconnect(outfile owner,temp outfile,
out fsys,0)
if flag = 0 start ; !CONFIG FILE DISCONNECTED TO CHANGE ITS SIZE
conad = 0
if queues > 0 and remotes > 0 c
and streams > 0 start
!MAKE SURE THERE IS SOMETHING IN IT
config size = (queues*queue entry size+ c
remotes*remote entry size+streams* c
stream entry size+ c
(queues+streams+remotes)*name entry size + c
file header size+1023)>>10
flag = dchsize(outfile owner,temp outfile,
out fsys,config size)
if flag = 0 start ; !SUCCESSFULL TRIMMED
flag = drename(outfile owner,temp outfile,
outfile,out fsys)
flag = dnewgen(outfile owner,outfile,
temp outfile,out fsys) c
if flag = already exists
if flag = 0 start
flag = dpermission(outfile owner,"",
"",outfile,out fsys,1,r)
print string("SET EEP ON ". c
outfile owner.".".outfile. c
" ON FSYS ".i to s(out fsys). c
" FAILS ".errs(flag).snl) c
if flag # 0
seg = 0; gap = 0
if TARGET # 2900 then flag = dconnect(out file owner, outfile,
out fsys,r!w!shared,seg,gap) else c
flag = dconnect(out file owner,outfile,
out fsys,r!w!shared,0,seg,gap)
if flag = 0 start
conad = seg<<seg shift
file header == record(conad)
file header_end = queues* c
queue entry size+remotes* c
remote entry size+streams* c
stream entry size+c
file header size+ (queues+streams+remotes)*name entry size
file header_start = file header size
file header_size = config size
file header_type = 0
file header_datetime = c
pack date and time(date,time)
file header_queues = queues
file header_remotes = remotes
file header_streams = streams
qconad = file header size+conad
rconad = file header size+conad+ c
queues*queue entry size+queues*name entry size
sconad = file header size+conad+ c
queues*queue entry size+remotes c
*remote entry size+(queues+remotes)*name entry size
finish else print string("CONNECT ". c
outfile owner.".".outfile." FAILS " c
.errs(flag).snl)
flag = dpermission(outfile owner,"","", outfile."PTRS", c
out fsys, 1, r)
if flag # 0 then printstring("Permission on POINTER file fails ".errs(flag).snl)
finish else print string( c
"RENAME/NEWGEN ".outfile owner.".". c
outfile." FAILS ".errs(flag).snl)
finish else print string("CHSIZE ". c
outfile owner.".".temp outfile." FAILS ". c
errs(flag).snl)
finish else print string( c
"NO QUEUES, REMOTES OR STREAMS IN CONFIGURATION FILE". c
snl)
if conad = 0 start
flag = ddestroy(outfile owner,temp outfile,
"",out fsys,0)
print string("DESTROY ".outfile owner.".". c
temp outfile." FAILS ".errs(flag).snl) c
if flag # 0
finish
finish else print string("DISCONNECT ". c
outfile owner.".".temp outfile." FAILS ".errs( c
flag).snl)
finish ; !CREATE AND CONNECT FAILURE
flag = ddisconnect(infile owner,infile,in fsys,0)
print string("DISCONNECT ".infile owner.".".infile. c
" FAILS ".errs(flag).snl) if flag # 0
finish else print string("CONNECT ".infile owner.".". c
infile." FAILS ".errs(flag).snl)
finish
!Now create the LINK LIST file.
create and connect(outfile owner, link list name, out fsys, link list entries* c
link list entry size, r!w!shared, link list conad)
if link list conad = 0 then printstring("DISASTER Link list create fails".snl) and stop
flag = dpermission(outfile owner,"","",link list name,out fsys,1,r)
if flag # 0 then printstring("Permission on link list file fails ".errs(flag).snl)
!* THIS NEXT SECTION IS ONLY ENTERED IF THE CONFIGURATION FILE WAS
!* NOT SUCCESSFULLY READ OR THE SPOOLER DATA BASE FILE NOT SUCCESSFULLY
!* CREATED.
if qconad = 0 or rconad = 0 or sconad = 0 start
!FAILED TO CREATE CONFIG FILE
print string("DEFAULT CONFIG IN USE".snl)
qconad = addr(tempqs(0)); !ADDRESS OF DEFAULT QUEUES
queues = 2
rconad = addr(temp rmts(0))
remotes = 1
sconad = addr(tempstrms(0)); !ADDRESS OF DEFAULT STREAMS
streams = 1
queue entry == record(qconad)
queue entry = 0
queue entry_name = "LP"; !DEFAULT LINE PRINTER QUEUE
queue entry_streams(0) = 1; !THE LP0 STREAM
queue entry_default user = "SPOOLR"
queue entry_default delivery = "Spooled Output"
queue entry_default start = 32
queue entry_default priority = 3; !STD
queue entry_default copies = 1
queue entry_default rerun = yes
queue entry_max length = 100
queue entry_max acr = 15; !ACCESS BY ANY ONE
queue entry_resource limit = 1000
queue entry == record(qconad+queue entry size)
queue entry = 0
queue entry_name = "JOURNAL"; !DEFAULT JOURNAL QUEUE
queue entry_default start = 32
queue entry_default priority = 3; !STD
queue entry_default copies = 1
queue entry_default rerun = yes
queue entry_max length = 100
queue entry_max acr = 9; !PRIVILEGED ACCESS ONLY
queue entry_resource limit = 1000
qnconad = ADDR(TEMP QS NAME(0))
queue name entries == array(qnconad,qaf)
queue name entries(1)_name = "LP"
queue name entries(2)_name = "JOURNAL"
remote entry == record(rconad)
remote entry = 0
remote entry_name = "LOCAL"
remote entry_status = 3; !LOGGED ON
remote entry_lowest stream = 1
remote entry_highest stream = 1
rnconad = ADDR(TEMP RMTS NAME(0))
remote name entries == array(rnconad,raf)
remote name entries(1)_name = "LOCAL"
stream entry == record(sconad)
stream entry = 0
stream entry_name = "LP0"
stream entry_remote = 1
stream entry_status = 1; !ALLOCATED
stream entry_ident = x'06000000'; !LP ADAPTOR DEVICE 0
stream entry_limit = 512
stream entry_queues(0) = 1; !THE LP QUEUE
stream entry_device type = 6; !LP
stream entry_device no = 0
stream entry_lowest priority = 1
stream entry_header type = 1; !LINE PRINTER
stream entry_header number = 1
stream entry_service = 0; !OUTPUT DEVICE
snconad = ADDR(TEMP STRMS NAME(0))
stream name entries == array(snconad,saf)
stream name entries(1)_name = "LP0"
finish else print string("CONFIG ".in file owner.".". c
infile.snl)
! printstring("CONFIG returns".snl. %c
! "QCONAD ".itos(qconad).snl."SCONAD ".itos(sconad). %c
! "RCONAD ".itos(rconad).snl."QS ".itos(queues).snl)
! printstring("STRMS ".itos(streams).snl."RMTS ")
! queue entry == record(qconad)
! printstring(itos(remotes).snl.queue entry_name.snl)
! queue entry == record(qconad+queue entry size)
! printstring(queue entry_name.snl)
! remote entry == record(rconad); stream entry == record(sconad)
! printstring(remote entry_name.snl.stream entry_name.snl."END LIST".snl)
end ; !OF ROUTINE READ SPOOL CAT
endoffile