!TITLE Subsystem maintenance utilities
!
!
! This package is a collection of utility commands which are primarily
! intended for supporting and maintaining the Edinburgh Subsystem.
!
!
! Subjects covered are:
!
! 1 Updating members of pdfiles
! 2 Messages of the day
! 3 Altering the ALERT time
! 4 Subsystem basefiles
! 5 Subsystem option files
! 6 Handling of user suggestions
! 7 Checking partitioned files
!
!
!
!STOP
!
!
!***********************************************************************
!*
!* Subsystem maintenance utilities
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXI
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTINTEGER NO = 0, YES = 1
CONSTINTEGER INCHAN = 1, OUTCHAN = 2
CONSTINTEGER BACKGROUND = 0, FOREGROUND = 1, BOTH = 2
CONSTINTEGER SSOBJFILETYPE = 1
CONSTINTEGER SSCHARFILETYPE = 3
CONSTINTEGER SSDATAFILETYPE = 4
CONSTINTEGER SSOPTFILETYPE = 9
CONSTINTEGER ALERTSIZE = 27; ! Size of 'alert' part of message of the day
CONSTINTEGER SEGSIZE = X'00040000'
CONSTINTEGER ABASEFILE = X'00800000'; ! Address of basefile when loaded
CONSTSTRING (1) SNL = "
"
CONSTSTRING (6) OWNER = "SUBSYS"
CONSTSTRING (11) DEFAULTPD = "SYSTEM"; ! For UPDATEPD command
CONSTSTRING (11) DEFAULTACTIVEDIR = "SS#DIR"
CONSTSTRING (10) TEMPDIR = "T#TEMPDIR"
CONSTSTRING (17) SSBLKBRD = "SUBSYS.SUGGESTION"
CONSTSTRING (11)ARRAY MESSAGEFILE(BACKGROUND:BOTH) = C
"BMESSAGE","FMESSAGE","FMESSAGE"
CONSTSTRING (8)ARRAY OPNAME(BACKGROUND:BOTH) = C
"SETBMESS","SETFMESS","SETBOTH"
CONSTSTRING (8) SANAME = "SETALERT"
!
CONSTSTRING (10)ARRAY BKEYS(1:2) = "BRACKETS","NOBRACKETS"
CONSTBYTEINTEGERARRAY BVALUES(1:2) = 1,2
CONSTSTRING (8)ARRAY EKEYS(1:3) = "NOECHO","PARTECHO","FULLECHO"
CONSTBYTEINTEGERARRAY EVALUES(1:3) = 0,1,2
CONSTSTRING (10)ARRAY JKEYS(1:3) = "NORECALL","TEMPRECALL","PERMRECALL"
CONSTBYTEINTEGERARRAY JVALUES(1:3) = 0,1,2
CONSTSTRING (12)ARRAY LKEYS(1:2) = "BLANKLINES","NOBLANKLINES"
CONSTBYTEINTEGERARRAY LVALUES(1:2) = 0,1
!
CONSTBYTEINTEGERARRAY HEX(0:15) = C
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
SYSTEMROUTINESPEC CHANGEACCESS(STRING (31) FILE,INTEGER MODE,C
INTEGERNAME FLAG)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE,INTEGER MODE,HOLE,C
PROT,RECORDNAME R,INTEGERNAME FLAG)
EXTERNALSTRINGFNSPEC DATE
SYSTEMROUTINESPEC DEFINE(INTEGER CHAN,STRING (31) IDEN,C
INTEGERNAME AFD,FLAG)
EXTERNALROUTINESPEC DEFINFO(INTEGER CHAN,STRINGNAME FILENAME,C
INTEGERNAME STATUS)
SYSTEMROUTINESPEC DESTROY(STRING (31) FILE,INTEGERNAME FLAG)
SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE,INTEGERNAME FLAG)
SYSTEMSTRINGFNSPEC FAILUREMESSAGE(INTEGER MESS)
SYSTEMROUTINESPEC FILL(INTEGER LENGTH,FROM,FILLER)
SYSTEMSTRINGFNSPEC ITOS(INTEGER N)
SYSTEMROUTINESPEC MODDIRFILE(INTEGER EP,STRING (31) DIRFILE,ENTRY,C
FILENAME,INTEGER TYPE,DR0,DR1,C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC MODPDFILE(INTEGER EP,STRING (31) PDFILE,C
STRING (11) MEMBER,STRING (31) INFILE,C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO)
SYSTEMROUTINESPEC NEWGEN(STRING (31) FILE,NEWFILE,INTEGERNAME FLAG)
SYSTEMSTRINGFNSPEC NEXTTEMP
SYSTEMROUTINESPEC OUTFILE(STRING (31) FILE,INTEGER SIZE,HOLE,C
PROT,INTEGERNAME CONAD,FLAG)
EXTERNALINTEGERFNSPEC OUTPOS
SYSTEMINTEGERFNSPEC PARMAP
SYSTEMROUTINESPEC PERMIT(STRING (31) FILE,STRING (6) USER,C
INTEGER MODE,INTEGERNAME FLAG)
EXTERNALROUTINESPEC PROMPT(STRING (255) S)
SYSTEMINTEGERFNSPEC PSTOI(STRING (63) S)
SYSTEMROUTINESPEC SETFNAME(STRING (63) S)
SYSTEMROUTINESPEC SETPAR(STRING (255) S)
EXTERNALROUTINESPEC SET RETURN CODE(INTEGER I)
SYSTEMSTRINGFNSPEC SPAR(INTEGER N)
EXTERNALSTRINGFNSPEC TIME
SYSTEMROUTINESPEC UCTRANSLATE(INTEGER AD,LEN)
EXTERNALINTEGERFNSPEC UINFI(INTEGER ENTRY)
EXTERNALSTRINGFNSPEC UINFS(INTEGER N)
!
EXTERNALROUTINESPEC CHERISH(STRING (255) S)
EXTERNALROUTINESPEC CLEAR(STRING (255) S)
EXTERNALROUTINESPEC PARM(STRING (255) S)
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
RECORDFORMAT CONTF(INTEGER DATAEND,DATASTART,PSIZE,FILETYPE,C
SUM,DATETIME,SP0,SP1,MARK,NULL1,UGLA,ASTK,USTK,C
NULL2,ITWIDTH,LDELIM,RDELIM,JOURNAL,C
SEARCHDIRCOUNT,ARRAYDIAG,INITWORKSIZE,SPARE,C
ITINSIZE,ITOUTSIZE,NOBL,ISTK,C
LONGINTEGER INITPARMS,INTEGER DATAECHO,C
TERMINAL,I23,I24,I25,I26,I27,I28,I29,I30,I31,I32,C
STRING (31) FSTARTFILE,BSTARTFILE,PRELOADFILE,C
MODDIR,CFAULTS,S6,S7,S8,S9,S10,S11,S12,S13,S14,C
S15,S16,S17,S18,S19,S20,S21,S22,S23,S24,S25,S26,C
S27,S28,S29,S30,S31,S32,C
STRING (31)ARRAY SEARCHDIR(1:16))
RECORDFORMAT DIRINFF(STRING (6) USER,STRING (31) BATCHFILE,C
INTEGER MARK,FSYS,PROCNO,ISUFF,REASON,BATCHID,C
SESSICLIM,SCIDENSAD,SCIDENS,OPERNO,AIOSTAT,C
SCDATE,SYNC1DEST,SYNC2DEST,ASYNCDEST,AACCTREC,C
AICREVS,STRING (15) BATCHIDEN,C
STRING (31) BASEFILE,INTEGER PREVIC,ITADDR0,C
ITADDR1,ITADDR2,ITADDR3,ITADDR4,STREAMID,DIDENT,C
SCARCITY,PREEMPTAT,STRING (11) SPOOLRFILE,C
INTEGER RESUNITS,SESSLEN,PRIORITY,DECKS,DRIVES,C
UEND)
RECORDFORMAT EP4F(INTEGER LINK,DISP,L,A,STRING (31) IDEN)
RECORDFORMAT HF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,C
SUM,DATETIME,FORMAT,RECORDS)
RECORDFORMAT OFMF(INTEGER START,LEN,PROPS)
RECORDFORMAT OHF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,SUM,C
DATETIME,LDA,OFM)
RECORDFORMAT PDF(INTEGER START,STRING (11) NAME,C
INTEGER HOLE,S5,S6,S7)
RECORDFORMAT PDHF(INTEGER DATAEND,DATASTART,SIZE,FILETYPE,SUM,C
DATETIME,ADIR,COUNT)
RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND)
!
OWNINTEGERARRAYFORMAT LDATAF(0:14)
OWNBYTEINTEGERARRAYFORMAT BIF(1:10000)
OWNRECORDARRAYFORMAT OFMAF(1:7)(OFMF)
OWNRECORDARRAYFORMAT PDAF(1:4095)(PDF)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
STRING (255)FN SPECMESSAGE(INTEGER FLAG)
SWITCH SW(1000:1002)
!
-> SW(FLAG)
!
SW(1000): RESULT = "Catastrophic failure"
SW(1001): RESULT = "May be used only by ".OWNER
SW(1002): RESULT = "Entry SSDATELINKED not found"
END ; ! of SPECMESSAGE
!
!
ROUTINE FAIL(STRING (15) OP,INTEGER FLAG)
SELECTOUTPUT(0)
PRINTSTRING(SNL.OP." fails -")
IF FLAG < 1000 THEN START
PRINTSTRING(FAILUREMESSAGE(FLAG))
FINISH ELSE START
PRINTSTRING(" ".SPECMESSAGE(FLAG).SNL)
FINISH
SET RETURN CODE(FLAG)
STOP
END ; ! of FAIL
!
!
ROUTINE CHECKUSER(STRING (15) OP)
IF UINFS(1) # OWNER THEN START
PRINTSTRING(OP." may be used only by ".OWNER.SNL)
SET RETURN CODE(1000)
STOP
FINISH
END ; ! of CHECKUSER
!
!
ROUTINE READLINE(STRINGNAME S)
INTEGER C
!
S = ""
CYCLE
READSYMBOL(C)
EXIT IF C = NL
S <- S.TOSTRING(C)
REPEAT
!
WHILE LENGTH(S) > 0 CYCLE
IF CHARNO(S,LENGTH(S)) # ' ' THEN EXIT
LENGTH(S) = LENGTH(S) - 1
REPEAT
END ; ! of READLINE
!
!
STRING (8)FN HTOS(INTEGER VALUE,PLACES)
INTEGER I
STRING (8) S
!
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
!
!
INTEGERFN GETVAL(STRING (255) PR,INTEGER MIN,MAX,DEFAULT,MULT)
INTEGER I
STRING (255) S
!
PROMPT(PR.": ")
CYCLE
READLINE(S)
IF S = "" THEN START
PRINTSTRING("[".ITOS(DEFAULT//MULT)."]".SNL)
RESULT = DEFAULT
FINISH
I = PSTOI(S)
IF I < 0 THEN START
PRINTSTRING("Invalid number".SNL)
CONTINUE
FINISH
I = I*MULT
IF MIN <= I <= MAX THEN RESULT = I
PRINTSTRING("Number outside permitted range".SNL)
REPEAT
END ; ! of GETVAL
!
!
INTEGERFN GET SETTING(STRING (255) PR,INTEGER NSETTINGS,C
STRINGARRAYNAME KEYS,C
BYTEINTEGERARRAYNAME VALUES,STRING (31) DEFAULT)
INTEGER I
STRING (255) S
!
PROMPT(PR.": ")
CYCLE
READLINE(S)
UCTRANSLATE(ADDR(S)+1,LENGTH(S))
IF S = "" THEN START
PRINTSTRING("[".DEFAULT."]".SNL)
S = DEFAULT
FINISH
CYCLE I = 1,1,NSETTINGS
IF S = KEYS(I) THEN RESULT = VALUES(I)
REPEAT
PRINTSTRING("Invalid setting".SNL)
REPEAT
END ; ! of GET SETTING
!
!
STRING (255)FN GETSTR(STRING (255) PR,INTEGER MAXLEN,C
STRING (255) DEFAULT)
STRING (255) S
!
CYCLE
PROMPT(PR.": ")
READLINE(S)
UCTRANSLATE(ADDR(S)+1,LENGTH(S))
IF S = "." THEN RESULT = ""
IF S = "" THEN START
PRINTSTRING("[".DEFAULT."]".SNL)
RESULT = DEFAULT
FINISH
IF LENGTH(S) <= MAXLEN THEN RESULT = S
PRINTSTRING("Reply must not exceed ".ITOS(MAXLEN)." characters".SNL)
REPEAT
END ; ! of GETSTR
!
!
INTEGERFN ROUNDUP(INTEGER N,R)
R = R - 1
RESULT = (N+R) & (¬R)
END ; ! of ROUNDUP
!
!
ROUTINE CONNECT OR CREATE(STRING (11) FILE,RECORDNAME RR,C
STRING (15) OP)
RECORDSPEC RR(RF)
INTEGER FLAG,CONAD
RECORDNAME R(HF)
!
CONNECT(FILE,1,0,0,RR,FLAG)
IF FLAG = 218 THEN START ; ! File does not exist - create it
PRINTSTRING("There is no ".FILE." file".SNL)
PRINTSTRING("It is being created".SNL.SNL)
OUTFILE(FILE,4096,0,0,CONAD,FLAG)
IF FLAG = 0 THEN START
R == RECORD(CONAD)
R_FILETYPE = SSCHARFILETYPE
PERMIT(FILE,"",1,FLAG); ! Set EEP = R
CHERISH(FILE)
FILL(ALERTSIZE-1,CONAD+R_DATASTART,' ')
BYTEINTEGER(CONAD+R_DATASTART+ALERTSIZE-1) = NL
R_DATAEND = R_DATASTART + ALERTSIZE
FINISH
CONNECT(FILE,1,0,0,RR,FLAG)
FINISH
IF FLAG # 0 THEN FAIL(OP,FLAG)
END ; ! of CONNECT OR CREATE
!
!
ROUTINE PRINTMESSAGE(INTEGER CONAD,STRING (7) TYPE)
INTEGER I,J
RECORDNAME R(HF)
!
R == RECORD(CONAD)
J = R_DATASTART + ALERTSIZE
IF J >= R_DATAEND THEN START
PRINTSTRING("The ".TYPE." message is null".SNL)
FINISH ELSE START
PRINTSTRING("The ".TYPE." message is:-".SNL.SNL)
CYCLE I = CONAD+J,1,CONAD+R_DATAEND-1
PRINTSYMBOL(BYTEINTEGER(I))
REPEAT
FINISH
NEWLINE
END ; ! of PRINT MESSAGE
!
!
ROUTINE SETMESSAGE(STRINGNAME PARMS,INTEGER TYPE,MODE)
INTEGER FLAG,CONAD,COUNT,J
STRING (11) FILE,TEMPFILE
STRING (15) OP
STRING (255) LINE
RECORD RR(RF)
RECORDNAME R(HF)
!
SET RETURN CODE(1000)
FILE = MESSAGEFILE(TYPE)
OP = OPNAME(MODE)
CHECKUSER(OP)
!
SETPAR(PARMS)
IF PARMAP # 0 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
!
CONNECT OR CREATE(FILE,RR,OP)
PRINTMESSAGE(RR_CONAD,"current")
!
TEMPFILE = "T#".NEXTTEMP
CYCLE
PRINTSTRING("Type new message - terminated by :".SNL)
!
LOOP:
PROMPT("Message: ")
OUTFILE(TEMPFILE,4096,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
R == RECORD(CONAD)
R_FILETYPE = SSCHARFILETYPE
MOVE(ALERTSIZE,RR_CONAD+RR_DATASTART,CONAD+R_DATASTART)
COUNT = R_DATASTART + ALERTSIZE
CYCLE
READLINE(LINE)
EXIT IF LINE = ":"
IF LENGTH(LINE) = 255 THEN LENGTH(LINE) = 254
LINE = LINE.SNL
J = LENGTH(LINE)
IF COUNT + J >= R_FILESIZE THEN START
PRINTSTRING("Message too long - try again".SNL)
-> LOOP
FINISH
MOVE(J,ADDR(LINE)+1,CONAD+COUNT)
COUNT = COUNT + J
REPEAT
R_DATAEND = COUNT
PRINTMESSAGE(CONAD,"new")
PROMPT("OK? ")
READLINE(LINE) UNTIL LINE # ""
UCTRANSLATE(ADDR(LINE)+1,1)
EXIT IF CHARNO(LINE,1) = 'Y'
REPEAT
!
NEWGEN(TEMPFILE,FILE,FLAG)
-> ERR IF FLAG # 0
PRINTSTRING("New ".FILE." in use".SNL)
SET RETURN CODE(0)
RETURN
!
ERR:
FAIL(OP,FLAG)
END ; ! of SETMESSAGE
!
!
!***********************************************************************
!*
!* U P D A T E P D
!*
!***********************************************************************
!
!<Updating members of pdfiles
!
! The command UPDATEPD is used to add a new member to, update an
! existing member in, or delete a member from, a pdfile which may be in
! use by other processes.
!
! The command takes the form:
!
! UPDATEPD(pdfile_member,option)
!
! where:-
!
! pdfile_member - specifies the member to be operated on
! option - if null, the member must already exist
! - if N, the member must not already
! exist
! - if D, the old member is simply deleted.
!
!
!
!
!
! It is assumed that any file which is to be a replacement for a member
! has the same name as the member itself, and resides in the same
! process.
!
! Since the most common use of this utility is to update members of
! SUBSYS.SYSTEM, the pdfile part of the parameter defaults to SYSTEM.
!>
!
EXTERNALROUTINE UPDATEPD(STRING (255) PARMS)
INTEGER FLAG,CONAD,SAVEDT,OPTION
STRING (11) MEMBER,TEMPFILE
STRING (31) FILE,S
RECORD RR(RF)
RECORDNAME IR,OR(HF)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF 1 # PARMAP # 3 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
IF PARMAP & 2 # 0 THEN START
S <- SPAR(2)
IF "D" # S # "N" THEN START
SETFNAME(S)
FLAG = 202; ! Invalid parameter
-> ERR
FINISH
OPTION = CHARNO(S,1)
FINISH ELSE OPTION = 'Z'; ! Dummy value
S <- SPAR(1)
UNLESS S -> FILE.("_").MEMBER THEN START
SETFNAME(PARMS)
FLAG = 202; ! Invalid parameter
-> ERR
FINISH
!
IF FILE = "" THEN FILE = DEFAULTPD
!
UNLESS OPTION = 'D' THEN START
CONNECT(MEMBER,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
FINISH
CONNECT(FILE."_".MEMBER,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0 AND OPTION # 'N'
IF FLAG = 0 AND OPTION = 'N' THEN START
FLAG = 287; ! Member already exists
-> ERR
FINISH
CONNECT(FILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
IR == RECORD(RR_CONAD)
!
! Make temporary copy of pdfile
!
TEMPFILE = "T#".NEXTTEMP
OUTFILE(TEMPFILE,IR_FILESIZE,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
OR == RECORD(CONAD)
SAVEDT = OR_DATETIME; ! Save creation date over copy
MOVE(IR_FILESIZE,RR_CONAD,CONAD); ! Take the copy
OR_DATETIME = SAVEDT; ! Restore date
!
! Delete any existing copy of member. Ignore failures, except in the
! case of the 'D' option.
!
MODPDFILE(2,TEMPFILE,MEMBER,"",FLAG)
IF FLAG # 0 AND OPTION = 'D' THEN -> ERR
!
! Insert new copy of member if appropriate
!
MODPDFILE(1,TEMPFILE,MEMBER,MEMBER,FLAG) UNLESS OPTION = 'D'
-> ERR IF FLAG # 0
!
! Put new copy of pdfile into service
!
NEWGEN(TEMPFILE,FILE,FLAG)
-> ERR IF FLAG # 0
PRINTSTRING("Member ".FILE."_".MEMBER)
IF OPTION = 'D' THEN S = "destroyed"
IF OPTION = 'N' THEN S = "inserted"
IF OPTION = 'Z' THEN S = "replaced"
PRINTSTRING(" ".S.SNL)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("UPDATEPD",FLAG)
END ; ! of UPDATEPD
!
!
!***********************************************************************
!*
!* S E T F M E S S
!*
!***********************************************************************
!
!<Messages of the day
!
!
! Three commands are provided to alter the 'messages of the day' which
! are displayed at process start-up. These are described in the
! following Sections:
!
!
!<Changing the foreground message
!
!
!
! The command SETFMESS is used to change the 'message of the day'
! displayed to foreground users when they log on. This special command
! is necessary to avoid problems if the file is currently in use, and
! to avoid disturbing the first line of the message, which always
! carries the date and time of the most recent ALERT text.
!
! SETFMESS takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!
EXTERNALROUTINE SETFMESS(STRING (255) PARMS)
SETMESSAGE(PARMS,FOREGROUND,FOREGROUND)
END ; ! of SETFMESS
!
!
!***********************************************************************
!*
!* S E T B M E S S
!*
!***********************************************************************
!
!<Changing the background message
!
!
!
! The command SETBMESS is used to change the 'message of the day'
! displayed to background users when their job starts. This special
! command is necessary to avoid problems if the file is currently in
! use, and to avoid disturbing the first line of the message, which
! always carries the date and time of the most recent ALERT text.
!
! SETBMESS takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!
EXTERNALROUTINE SETBMESS(STRING (255) PARMS)
SETMESSAGE(PARMS,BACKGROUND,BACKGROUND)
END ; ! of SETBMESS
!
!
!***********************************************************************
!*
!* S E T B O T H
!*
!***********************************************************************
!
!<Changing both messages
!
!
!
! The command SETBOTH is used to change both 'messages of the day'
! displayed to users on process start-up. This special command is
! necessary to avoid problems if the file is currently in use, and
! to avoid disturbing the first line of the message, which always
! carries the date and time of the most recent ALERT text.
!
! SETBOTH takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!>
!
EXTERNALROUTINE SETBOTH(STRING (255) PARMS)
INTEGER FLAG,CONAD
STRING (11) TEMPFILE
RECORD RR(RF)
!
SETMESSAGE(PARMS,FOREGROUND,BOTH)
!
TEMPFILE = "T#".NEXTTEMP
CONNECT(MESSAGEFILE(FOREGROUND),1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
OUTFILE(TEMPFILE,4096,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
MOVE(4096,RR_CONAD,CONAD)
!
NEWGEN(TEMPFILE,MESSAGEFILE(BACKGROUND),FLAG)
-> ERR IF FLAG # 0
!
PRINTSTRING("New ".MESSAGEFILE(BACKGROUND)." in use".SNL)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL(OPNAME(BOTH),FLAG)
END ; ! of SETBOTH
!
!
!***********************************************************************
!*
!* S E T A L E R T
!*
!***********************************************************************
!
!<Altering the ALERT time
!
!
!
! The command SETALERT is used to alter the date and time given in the
! 'Latest ALERT' message which forms a permanent part of the message
! of the day, for both foreground and background users.
!
! SETALERT takes up to two parameters:-
!
! 1) The time to be used in the message. Exactly four characters are
! expected, i.e.: hhmm. If this parameter is omitted, a prompt
! is issued for it.
!
! 2) The date to be used in the message. Standard EMAS date format is
! assumed, i.e.: dd/mm/yy. If this parameter is omitted, the
! current date is assumed.
!>
!
EXTERNALROUTINE SETALERT(STRING (255) PARMS)
INTEGER CONAD,I,SAVEDT,FLAG
STRING (11) FILE,TEMPFILE
STRING (255) ASTRING,D,T
RECORD RR(RF)
RECORDNAME OR(HF)
!
SET RETURN CODE(1000)
CHECKUSER(SANAME)
SETPAR(PARMS)
IF PARMAP > 3 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
T = SPAR(1)
D = SPAR(2)
IF D = "" THEN D = DATE
IF LENGTH(D) # 8 THEN START
SETFNAME(D)
FLAG = 202; ! Invalid parameter
-> ERR
FINISH
CYCLE
IF T = "" THEN START
PROMPT("Time: ")
READLINE(T) UNTIL T # ""
FINISH
IF LENGTH(T) = 4 THEN EXIT
PRINTSTRING("Invalid time".SNL)
T = ""
REPEAT
ASTRING = "Latest ALERT=".D." ".T.SNL
!
CYCLE I = BACKGROUND,1,FOREGROUND
FILE = MESSAGEFILE(I)
CONNECT OR CREATE(FILE,RR,SANAME)
TEMPFILE = "T#".NEXTTEMP
OUTFILE(TEMPFILE,4096,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
OR == RECORD(CONAD)
SAVEDT = OR_DATETIME; ! Save creation date over copy
MOVE(4096,RR_CONAD,CONAD); ! Take the copy
OR_DATETIME = SAVEDT; ! Restore date
MOVE(ALERTSIZE,ADDR(ASTRING)+1,CONAD+OR_DATASTART)
NEWGEN(TEMPFILE,FILE,FLAG)
-> ERR IF FLAG # 0
REPEAT
PRINTSTRING(ASTRING.SNL)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL(SANAME,FLAG)
END ; ! of SETALERT
!
!
!***********************************************************************
!*
!* M A K E B A S E F I L E
!*
!***********************************************************************
!
!<Subsystem basefiles
!
!
!
! The Edinburgh Subsystem resides in a file which is commonly called
! the 'basefile'.
!
! This Section describes the structure of the basefile, and how to
! create a new one.
!
!
!
!<Basefile structure
!
!
! The basefile for the Edinburgh Subsystem is a partitioned file which
! contains three members:
!
! a) The subsystem object file, with the code fixed up (using the FIX
! utility) to start at segment 32, and the GLA fixed up to start at
! the next free segment after the code.
!
! b) A default 'option' file, connected and used in the absence of the
! user's own option file. When the user sets a non-default option,
! a copy of the default file is made (as SS#OPT), and the modified
! option included in the copy.
!
! c) A directory file, containing the entry points found in the
! subsystem object file. This is the first directory searched by the
! loader.
!>
!<The MAKEBASEFILE command
!
!
! This command takes up to three parameters. These are:
!
!
! 1) The name of the subsystem object file to be used for input.
!
! 2) The name of the default option file to be included in the
! completed basefile.
!
! 3) The destination of the completed basefile.
!
!
! If any of these parameters is omitted, a prompt is issued for it.
!>
!>
!
EXTERNALROUTINE MAKEBASEFILE(STRING (255) PARMS)
INTEGER FLAG,OBJCONAD,DIRLENGTH,LINK,GLASTART
STRING (31) BASEOBJECT,OPTIONFILE,BASEFILE
RECORD RR(RF)
INTEGERARRAYNAME LDATA
RECORDNAME DIRINF(DIRINFF)
RECORDNAME EP4(EP4F)
RECORDNAME H(OHF)
RECORDNAME R(HF)
RECORDARRAYNAME OFM(OFMF)
INTEGERARRAY BASE(0:7)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF PARMAP > 7 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
!
BASEOBJECT = SPAR(1)
OPTIONFILE = SPAR(2)
BASEFILE = SPAR(3)
!
PROMPT("Object file: ")
READLINE(BASEOBJECT) WHILE BASEOBJECT = ""
PROMPT("Option file: ")
READLINE(OPTIONFILE) WHILE OPTIONFILE = ""
PROMPT("Basefile: ")
READLINE(BASEFILE) WHILE BASEFILE = ""
!
DESTROY(BASEFILE,FLAG); ! Ignore flag
MODPDFILE(4,BASEFILE,"","",FLAG); ! Create pdfile
-> ERR IF FLAG # 0
!
CONNECT(BASEOBJECT,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
IF RR_FILETYPE # SSOBJFILETYPE THEN START
SETFNAME(BASEOBJECT)
FLAG = 267; ! Invalid filetype
-> ERR
FINISH
MODPDFILE(1,BASEFILE,"BASEOBJECT",BASEOBJECT,FLAG)
! Insert member - order is critical
-> ERR IF FLAG # 0
!
CONNECT(OPTIONFILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
IF RR_FILETYPE # SSOPTFILETYPE THEN START
SETFNAME(OPTIONFILE)
FLAG = 267; ! Invalid filetype
-> ERR
FINISH
MODPDFILE(1,BASEFILE,"OPTIONFILE",OPTIONFILE,FLAG)
! Insert member
-> ERR IF FLAG # 0
!
DESTROY(TEMPDIR,FLAG); ! Ignore flag
MODDIRFILE(10,TEMPDIR,"","",0,759,1164,FLAG)
! Create directory
-> ERR IF FLAG # 0
CONNECT(TEMPDIR,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
R == RECORD(RR_CONAD)
DIRLENGTH = R_FILESIZE
!
CONNECT(BASEFILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
!
! Set BASE(2) to the address of the base GLA, forming a pseudo
! object file map
!
BASE(2) = ROUNDUP(ABASEFILE+RR_DATAEND+DIRLENGTH,SEGSIZE)
MODDIRFILE(4,TEMPDIR,"",BASEFILE."_BASEOBJECT",0,ADDR(BASE(1)),0,FLAG)
! Insert data and proc entries
-> ERR IF FLAG # 0
!
! Copy directory into basefile
!
MODPDFILE(1,BASEFILE,"BASEDIR",TEMPDIR,FLAG)
-> ERR IF FLAG # 0
DESTROY(TEMPDIR,FLAG); ! Ignore flag
!
! Now locate the external integer SSDATELINKED, and fill in the date
! of the current system call table in Director
!
DIRINF == RECORD(UINFI(10))
CONNECT(BASEFILE."_BASEOBJECT",1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
CHANGEACCESS(BASEFILE,3,FLAG); ! To write to member
-> ERR IF FLAG # 0
OBJCONAD = RR_CONAD
H == RECORD(OBJCONAD)
OFM == ARRAY(OBJCONAD+H_OFM+4,OFMAF); ! Object file map
GLASTART = OFM(2)_START
LDATA == ARRAY(OBJCONAD+H_LDA,LDATAF)
LINK = LDATA(4)
WHILE LINK # 0 CYCLE ; ! Search data entry list
EP4 == RECORD(OBJCONAD+LINK)
IF EP4_IDEN = "SSDATELINKED" THEN START
INTEGER(OBJCONAD+GLASTART+EP4_DISP) = DIRINF_SCDATE
INTEGER(OBJCONAD) = X'1B800010'; ! Jump over header of BASEOBJECT
-> FOUND
FINISH
LINK = EP4_LINK
REPEAT
FLAG = 1002
-> ERR
!
FOUND:
DISCONNECT(BASEFILE,FLAG)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("MAKEBASEFILE",FLAG)
END ; ! of MAKEBASEFILE
!
!
!***********************************************************************
!*
!* M A K E O P T I O N F I L E
!*
!***********************************************************************
!
!<Subsystem option files
!
!
! The Edinburgh Subsystem makes use of a file containing 'options' set
! by the user to tailor his process to his own needs. This Section
! describes how the initial option file used by the Subsystem is
! created, and explains the entries in it.
!
!
!<Making the file
!
!
! The command MAKEOPTIONFILE takes a single parameter, which is the name
! of the option file to be generated. If this parameter is omitted, a
! prompt is issued for it.
!
! A series of prompts is then issued. A value for the appropriate option
! may then be given, or the default setting invoked by simply typing
! 'return'. In the latter case, the actual value used is displayed,
! for information.
!
! The only exception to all this is the initial PARM setting - see
! Section 5.2.1.
!>
!<Description of options
!
!
!
!
!
! Some of the values stored in the option file are integers, and others
! are strings. Generally, they describe items such as the size of
! a particular workfile, terminal characteristics, directory search
! lists, etc.
!
!
! The rest of this Section describes each option in detail.
!
!PAGE
!
!<Initial PARM setting
!
! The value of this option is made the current PARM setting at log-on.
! MAKEOPTIONFILE uses the value actually in force when the option file
! is being created, as this saves it from having to decode large numbers
! of PARM keywords.
!>
!<Auxiliary stack size
!
! The auxiliary stack is a separate file which is used to store large
! data areas in user programs, due to the limitations on the size of the
! run-time stack in the ICL 2900 series.
!
! Keyword: AUXSTACKSIZE
!
! Default value: 128 Kbytes
!>
!<User stack size
!
! The user stack contains all local variables needed by a normal user
! program.
!
! Keyword: USERSTACKSIZE
!
! Default value: 252 Kbytes
!>
!<Initialised stack size
!
! The initialised stack is a pre-allocated part of the user stack. It
! must be at least 32 Kbytes smaller than the user stack as a whole.
! It is used as a data area by FORTRAN programs, but need only be
! pre-allocated if it is intended to load FORTRAN programs from other
! programs.
!
! Keyword: INITSTACKSIZE
!
! Default value: 100 Kbytes
!>
!<Interactive terminal width
!
! Subsystem commands such as ANALYSE and FILES assume the terminal
! width given by this option when planning their output.
!
! Keyword: ITWIDTH
!
! Default value: 72
!>
!<Array diagnostic level
!
! When a diagnostic traceback is given for a program, the number of
! elements of each array which are actually printed is given by this
! option.
!
! Keyword: ARRAYDIAG
!
! Default value: 10
!>
!<The session workfile
!
! Many subsystem commands (particularly the compilers) make use of a
! common workfile. The size of the workfile is determined by this
! option setting.
!
! Keyword: INITWORKSIZE
!
! Default value: 256 Kbytes
!>
!<Interactive terminal buffers
!
! The subsystem requires two buffers for interactive terminal I/O.
! One is used solely for input, and the other solely for output.
! Two options are provided in order that the sizes of these buffers
! may be altered.
!
! Keyword (input): ITINSIZE
!
! Default value (input) : 1 Kbyte
!
!
! Keyword (output): ITOUTSIZE
!
! Default value (output): 3 Kbytes
!
!>
!<Terminal type
!
! The terminal/screen control package (used by screen editors, etc.)
! uses this option to determine how an interactive terminal is to be
! driven.
!
! In general, this option will not be set by means of the OPTION
! command, although the keyword TERMINAL is provided. It is expected
! that users will select the appropriate terminal type (which is an
! integer) by means of a special command.
!
! The default value supplied is zero, which should correspond to
! 'unspecified terminal'. This means that a user dialogue will be
! entered when the screen control package is first used.
!
!>
!<Brackets/Nobrackets
!
! There are two different command formats which are accepted by the
! subsystem:
!
! a) Spaces in commands are not significant, and any parameters must
! be enclosed in brackets.
!
! b) Spaces in commands are not allowed, since one or more spaces are
! used to separate the command from its parameters, which should
! not be enclosed in brackets.
!
! The actual format accepted depends on this option.
!
! Keywords: BRACKETS and NOBRACKETS
!
! Default value: BRACKETS
!
!>
!<Recall of terminal I/O
!
! The subsystem provides facilities for storing and retrieving
! transactions on an interactive terminal. The three possible values
! for this option are:
!
! NORECALL - nothing is stored
! TEMPRECALL - the current session is stored
! PERMRECALL - the last few sessions are stored
!
! Default value: TEMPRECALL
!>
!<Suppression of blank lines
!
! This option is provided to enable all blank lines output to the
! terminal to be suppressed.
!
! Keywords: BLANKLINES and NOBLANKLINES
!
! Default value: BLANKLINES
!>
!<Echoing of OBEY files
!
! When an OBEY file is being processed, the subsystem may or may not
! 'echo' the resulting transactions on the user's terminal. This option
! controls the amount echoed. The possible settings are:
!
! NOECHO - nothing at all is echoed
! PARTECHO - only 'Command:' lines are echoed
! FULLECHO - all input is echoed, including program input
!
! Batch jobs are treated by the subsystem as if they are effectively
! OBEY files for the purposes of this option.
!>
!<Foreground start-up file
!
! This option allows the user to nominate a file of commands which are
! to be OBEYed on foreground process start-up.
!
! Keywords: NOFSTARTFILE and FSTARTFILE
!
! Default value: NOFSTARTFILE
!>
!<Background start-up file
!
! This option allows the user to nominate a file of commands which are
! to be OBEYed on background process start-up.
!
! Keywords: NOBSTARTFILE and BSTARTFILE
!
! Default value: NOBSTARTFILE
!>
!<Pre-loading file
!
! This option allows the user to nominate object files which are to
! be 'pre-loaded' on process start-up. It is not currently implemented.
!>
!<Active directory
!
! This option selects the file which is to be used as the 'active
! directory' for the INSERT and REMOVE commands, and associated actions.
! This is the first user directory searched by the loader, immediately
! after searching the session directory (see Section 4.1).
!
! Keyword: ACTIVEDIR
!
! Default value: SS#DIR
!>
!<Compiler fault file
!
! This option allows the user to select another file, in addition to the
! compiler listing file, to which compilation fault messages may be
! sent.
!
! Keyword: CFAULTS
!
! Default value: .OUT
!>
!<Search directories
!
! Up to 16 additional directories may be added to the search list for
! a process. They are searched immediately after the active directory.
!
! Keywords: SEARCHDIR and REMOVEDIR
!
! Default value: No search directories
!>
!>
!>
!
EXTERNALROUTINE MAKEOPTIONFILE(STRING (255) PARMS)
INTEGER FLAG,CONAD,I
STRING (31) FILE
STRING (255) S
RECORDNAME C(CONTF)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF PARMAP > 1 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
FILE <- SPAR(1)
IF FILE = "" THEN START
PROMPT("Option file: ")
READLINE(FILE)
FINISH
!
OUTFILE(FILE,4096,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
C == RECORD(CONAD)
C_DATAEND = 4096
C_FILETYPE = SSOPTFILETYPE
!
FILL(C_DATAEND-C_DATASTART,CONAD+C_DATASTART,X'FF')
! Fill whole file with -1
FILL(5*32,CONAD+C_DATASTART+128,0); ! Clear used strings
FILL(16*32,ADDR(C_SEARCHDIR(1)),0); ! Set all search directories to null
C_MARK = 4; ! Mark four option file format
!
! Fill in the installation-dependent values
!
C_INITPARMS = LONGINTEGER(ADDR(COMREG(27)))
PRINTSTRING("Init "); PARM("?")
C_ASTK = GETVAL("Aux stack",64<<10,1024<<10,128<<10,1024)
C_USTK = GETVAL("User stack",64<<10,252<<10,252<<10,1024)
C_ISTK = GETVAL("Init stack",0,C_USTK-(32<<10),100<<10,1024)
C_ITWIDTH = GETVAL("IT width",20,132,80,1)
C_ARRAYDIAG = GETVAL("Arraydiag",0,1000,10,1)
C_INITWORKSIZE = GETVAL("Initworksize",256<<10,1024<<10,256<<10,1024)
C_ITINSIZE = GETVAL("IT insize",1<<10,16<<10,1<<10,1024)
C_ITOUTSIZE = GETVAL("IT outsize",1<<10,16<<10,3<<10,1024)
C_TERMINAL = GETVAL("Terminal",-1,100,4,1)
!
FLAG = GET SETTING("(No)Brackets",2,BKEYS,BVALUES,"BRACKETS")
IF FLAG = 1 THEN START
C_LDELIM = '('
C_RDELIM = ')'
FINISH ELSE START
C_LDELIM = ' '
C_RDELIM = NL
FINISH
C_JOURNAL = GET SETTING("Recall",3,JKEYS,JVALUES,"TEMPRECALL")
C_NOBL = GET SETTING("(No)Blanks",2,LKEYS,LVALUES,"BLANKLINES")
C_DATAECHO = GET SETTING("Echo",3,EKEYS,EVALUES,"PARTECHO")
!
C_FSTARTFILE = GETSTR("Fstartfile",31,"")
C_BSTARTFILE = GETSTR("Bstartfile",31,"")
C_PRELOADFILE = GETSTR("Preloadfile",31,"")
C_MODDIR = GETSTR("Activedir",31,DEFAULTACTIVEDIR)
C_CFAULTS = GETSTR("Cfaults",31,".OUT")
!
CYCLE I = 1,1,16
PROMPT("Searchdir ".ITOS(I).": ")
ASK:
READLINE(S)
UCTRANSLATE(ADDR(S)+1,LENGTH(S))
IF S = "" OR S = ".END" THEN START
C_SEARCHDIRCOUNT = I - 1
EXIT
FINISH
IF LENGTH(S) > 31 THEN START
PRINTSTRING("Reply must not exceed 31 characters".SNL)
-> ASK
FINISH
C_SEARCHDIR(I) = S
REPEAT
!
DISCONNECT(FILE,FLAG)
PRINTSTRING("Finished".SNL)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("MAKEOPTIONFILE",FLAG)
END ; ! of MAKEOPTIONFILE
!
!
!***********************************************************************
!*
!* M A K E S U G G E S T I O N F I L E
!*
!***********************************************************************
!
!<The suggestion file
!
!
! The Edinburgh Subsystem supports the SUGGESTION command, which
! provides a simple way for users to make comments for improvements to
! the system. Two utility commands are used in the administration of
! this file.
!
!
!<Making a suggestion file
!
!
! The command MAKESUGGESTIONFILE takes up to one parameter, this being
! the name of the empty suggestion file to be created. If this parameter
! is omitted, the name SUBSYS.SUGGESTION is assumed.
!>
!
EXTERNALROUTINE MAKESUGGESTIONFILE(STRING (255) PARMS)
INTEGER CONAD,FLAG
STRING (31) FILE
RECORDNAME R(HF)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF PARMAP > 1 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
FILE <- SPAR(1)
IF FILE = "" THEN FILE = SSBLKBRD
!
OUTFILE(FILE,64<<10,0,0,CONAD,FLAG)
-> ERR IF FLAG # 0
CHERISH(FILE)
PERMIT(FILE,"",3,FLAG); ! Set EEP = RW
-> ERR IF FLAG # 0
R == RECORD(CONAD)
R_DATAEND = R_FILESIZE
R_FILETYPE = SSDATAFILETYPE
R_FORMAT = 3; ! Un-structured
INTEGER(CONAD+R_DATASTART) = 35; ! Set current 'top' of file
DISCONNECT(FILE,FLAG)
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("MAKESUGGESTIONFILE",FLAG)
END ; ! of MAKESUGGESTIONFILE
!
!
!***********************************************************************
!*
!* L I S T S U G G E S T I O N F I L E
!*
!***********************************************************************
!
!<Listing the suggestion file
!
!
! The command LISTSUGGESTIONFILE takes up to one parameter, this being
! the file or device to which the suggestion listing is to be written.
! If this parameter is omitted, a prompt is issued for it.
!
!<Additional facilities
!
! If there are no suggestions in the file, the subsystem return code is
! set to -1, otherwise it is set to zero (or some error code). This
! allows suggestions to be checked and listed, if present, by suitable
! Job Control statements.
!>
!>
!>
!
EXTERNALROUTINE LISTSUGGESTIONFILE(STRING (255) PARMS)
INTEGER CONAD,FLAG,AFD,CURTOP,START,I,INDEFINED
STRING (31) OUT
STRING (255) S
RECORD RR(RF)
BYTEINTEGERARRAYNAME TEXT
RECORDNAME R(HF)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF PARMAP > 1 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
OUT <- SPAR(1)
IF OUT = "" THEN START
PROMPT("Output: ")
READLINE(OUT) UNTIL OUT # ""
FINISH
CONNECT(SSBLKBRD,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
CONAD = RR_CONAD
R == RECORD(CONAD)
IF INTEGER(CONAD+R_DATASTART) = 35 THEN START
! File is empty
PRINTSTRING("Suggestion file empty".SNL)
SET RETURN CODE(-1)
STOP
FINISH
DEFINE(OUTCHAN,OUT,AFD,FLAG)
-> ERR IF FLAG # 0
SELECTOUTPUT(OUTCHAN)
PRINTSTRING("Contents of ".SSBLKBRD." on ".DATE." at ".TIME.SNL.SNL)
CURTOP = CONAD + INTEGER(CONAD+R_DATASTART)
START = CONAD + R_DATASTART + 4
WHILE START < CURTOP CYCLE
TEXT == ARRAY(START,BIF)
IF TEXT(1) # 1 THEN START
SETFNAME(SSBLKBRD)
FLAG = 311; ! Corrupt file
-> ERR
FINISH
CYCLE I = 2,1,5000
EXIT IF TEXT(I) = 0
PRINTSYMBOL(TEXT(I))
REPEAT
NEWLINES(4)
START = ADDR(TEXT(I)) + 1
REPEAT
IF FROMSTRING(SSBLKBRD,1,6) = UINFS(1) THEN START
! User is owner of file
INDEFINED = NO
DEFINFO(INCHAN,S,FLAG)
IF FLAG = 0 THEN START
DEFINE(INCHAN,".IN",AFD,FLAG)
-> ERR IF FLAG # 0
INDEFINED = YES
FINISH
SELECTINPUT(INCHAN)
PROMPT("Reset? ")
READLINE(S) UNTIL S # ""
UCTRANSLATE(ADDR(S)+1,LENGTH(S))
IF CHARNO(S,1) = 'Y' THEN START
CHANGEACCESS(SSBLKBRD,3,FLAG)
IF FLAG # 0 THEN PRINTSTRING(FAILUREMESSAGE(FLAG)) ELSE START
INTEGER(CONAD+R_DATASTART) = 35
FINISH
FINISH
FINISH
DISCONNECT(SSBLKBRD,FLAG)
SELECTINPUT(0)
SELECTOUTPUT(0)
CLOSESTREAM(INCHAN)
CLOSESTREAM(OUTCHAN)
CLEAR(ITOS(OUTCHAN))
IF INDEFINED = YES THEN CLEAR(ITOS(INCHAN))
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("LISTSUGGESTIONFILE",FLAG)
END ; ! of LISTSUGGESTIONFILE
!
!
!***********************************************************************
!*
!* C H E C K P D
!*
!***********************************************************************
!
!<Checking partitioned files
!
! Partitioned files greater than 256 Kbytes in size present special
! problems if they contain members which are object files. An object
! file that crosses a 256 Kbyte boundary may not execute correctly,
! so the action of the subsystem loader is to make a copy of such a
! member, and execute that. This is clearly inefficient.
! The CHECKPD command provides facilities for identifying such problem
! members. It also flags other conditions which cause the loader to make
! a copy of an object file.
! The command takes exactly one parameter, the meaning of which is
! given in the following subsections.
!
!<Finding the offsets of members
!
! If CHECKPD is given the name of a partitioned file, it simply lists
! the relative offset (in hexadecimal) of each member of that file.
!>
!<Checking for possible problems
!
! If CHECKPD is given the name of a single member of a partitioned file,
! it determines whether either of two conditions would force the
! subsystem to copy the file when attempting to load it. These
! conditions are:
!
! a) The code of the member crosses a 256 Kbyte boundary
!
! b) The code of the member is not shareable (possible for converted
! ICL object files)
!>
!>
!
EXTERNALROUTINE CHECKPD(STRING (255) PARMS)
INTEGER FLAG,CONAD,I
STRING (11) MEMBER
STRING (31) PDFILE,FILE
RECORD RR(RF)
RECORDNAME OR(OHF)
RECORDNAME PD(PDF)
RECORDNAME PR(PDHF)
RECORDARRAYNAME OFM(OFMF)
RECORDARRAYNAME PDA(PDF)
!
SET RETURN CODE(1000)
SETPAR(PARMS)
IF PARMAP # 1 THEN START
FLAG = 263; ! Wrong number of parameters
-> ERR
FINISH
FILE <- SPAR(1)
!
CONNECT(FILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
!
IF FILE -> PDFILE.("_").MEMBER THEN START
CONNECT(FILE,1,0,0,RR,FLAG)
-> ERR IF FLAG # 0
CONAD = RR_CONAD
OR == RECORD(CONAD)
IF OR_FILETYPE # SSOBJFILETYPE THEN START
PRINTSTRING("Member ".MEMBER." is not an object file".SNL)
-> OK
FINISH
OFM == ARRAY(CONAD+OR_OFM+4,OFMAF); ! Object file map
IF (CONAD+OFM(1)_START) >> 18 # C
(CONAD+OFM(1)_START+OFM(1)_LEN) >> 18 THEN START
PRINTSTRING("Code of member ".MEMBER.C
" crosses a 256 Kbyte boundary".SNL)
-> OK
FINISH
IF OFM(1)_PROPS & 1 # 0 THEN START
PRINTSTRING("Code of member ".MEMBER." is not shareable".SNL)
-> OK
FINISH
PRINTSTRING("No problems with member ".MEMBER.SNL)
-> OK
FINISH ELSE START
CONAD = RR_CONAD
PR == RECORD(CONAD)
PDA == ARRAY(CONAD+PR_ADIR,PDAF)
I = 1
WHILE I <= PR_COUNT CYCLE
PD == PDA(I)
PRINTSTRING(PD_NAME)
SPACES(15-OUTPOS)
PRINTSTRING("X".HTOS(PD_START,6).SNL)
I = I + 1
REPEAT
FINISH
!
OK:
SET RETURN CODE(0)
STOP
!
ERR:
FAIL("CHECKPD",FLAG)
END ; ! of CHECKPD
ENDOFFILE