!TITLE Director Error Messages
! When a Director procedure is called, a record is kept of the procedure
! called and the value of the result returned. Subsequently, a process
! may use the procedures described here to interpret the result value and
! generate a meaningful error message.
!STOP
!<Error Message Texts
CONSTINTEGER TOPMESSAGE = 115
CONSTSTRING (39)ARRAY MESSAGE(0:TOPMESSAGE) = C
{..0} "Successful",
{..1} "File too big or bad site",
{..2} "Sconnect - bad parameters",
{..3} "Alloc Dseg - no free segments",
{..4} "Denable Terminal Stream fails",
{..5} "File not available",
{..6} "Use count on fsys negative",
{..7} "No space for index",
{..8} "Bad parameter",
{..9} "Must allow 15 mins",
{.10} "File system full",
{.11} "Bad USER name",
{.12} "Nkb must be 2 or 4 <= Nkb <= 32",
{.13} "Name-number table (NNT) full",
{.14} "User already has index on fsys",
{.15} "No free file descriptors",
{.16} "File already exists",
{.17} "No free permission descriptors",
{.18} "Invalid filename &",
{.19} "Password truncated to 11 characters",
{.20} "File & on offer",
{.21} "File being executed",
{.22} "Bits already clear for some pages",
{.23} "Fsys not available",
{.24} "error 24",
{.25} "Disk transfer failed",
{.26} "error 26",
{.27} "File too big",
{.28} "CBT freelist empty",
{.29} "No free CONLIST entries",
{.30} "error 30",
{.31} "Ambiguous",
{.32} "File & does not exist or no access",
{.33} "Conflicting use of file & in another VM",
{.34} "File is already connected",
{.35} "Segment in use or GAP too small",
{.36} "(De-)Nominate fails",
{.37} "User & not known",
{.38} "Already claimed",
{.39} "File & is not connected",
{.40} "File is connected",
{.41} "Single file limit exceeded",
{.42} "File is connected in another VM",
{.43} "No free section descriptors",
{.44} "DAP timed out",
{.45} "User's parameters not accessible",
{.46} "Bad permission",
{.47} "Not enough stack",
{.48} "TELL message rejected",
{.49} "Permission list full (max 16)",
{.50} "User(group) not in list",
{.51} "OWNP is zero or no-destroy set",
{.52} "File is connected in write mode",
{.53} "No interrupt data",
{.54} "No outward call set up",
{.55} "System Call Table full",
{.56} "Area crosses segment boundary",
{.57} "End of session",
{.58} "Bad parameter or RCB not accessible",
{.59} "Archive index checksum failure",
{.60} "Donate - user has no funds",
{.61} "Process not available",
{.62} "Max in DAP Claim Queue",
{.63} "DAP not claimed at start",
{.64} "DAP claim de-queued",
{.65} "Bad Date/Time",
{.66} "Close sequence cancelled",
{.67} "Not claimed",
{.68} "Failed to lock-down area",
{.69} "CCK already done",
{.70} "List is full",
{.71} "No time left",
{.72} "DAP not started",
{.73} "DAP not available",
{.74} "Not enough contiguous DAP blocks",
{.75} "DAP closing",
{.76} "User already has DAP",
{.77} "Failed to claim archive semaphore",
{.78} "Disconnect - cannot find file",
{.79} "Area not locked",
{.80} "Not in list",
{.81} "LP is already MAIN",
{.82} "Maximum areas already locked",
{.83} "Total file space limit exceeded",
{.84} "Restricted connect",
{.85} "Fsys closing",
{.86} "Failed to create and connect #msg",
{.87} "Index corrupt",
{.88} "Re-map fails",
{.89} "Invalid file",
{.90} "Maximum already allocated",
{.91} "Block still active",
{.92} "Interactive use not allowed",
{.93} "User does not have privilege",
{.94} "Failed to claim semaphore",
{.95} "Cannot allocate main LP",
{.96} "Password failure",
{.97} "Bad page reported in NINDA",
{.98} "Resources Scarce",
{.99} "Obsolete index format encountered",
{100} "Logged on",
{101} "System Full",
{102} "Logon Fails",
{103} "Invalid Pass",
{104} "Process Running",
{105} "Invalid Name",
{106} "Workfile Fail",
{107} "No User Service",
{108} "No Batch File",
{109} "No Funds",
{110} "User not found",
{111} "FE closing",
{112} "Node closing",
{113} "TCP closing",
{114} "Connected",
{115} "???"
!>
OWNSTRING (6) PASSU,PASSW
CONSTINTEGER YES = 1
CONSTINTEGER ABORT = 5
CONSTINTEGER AFTER = 2
CONSTINTEGER ASYNC TYPE = 3
CONSTINTEGER BATCH = 2; ! reason for STARTP
CONSTINTEGER CLODACT = 8
CONSTINTEGER CONNECT STREAM = X'370001'
CONSTINTEGER DATKEY = 4; ! SYSAD
CONSTINTEGER DEFAULT BMAX = 1
CONSTINTEGER DEFAULT IMAX = 1
CONSTINTEGER DEFAULT TMAX = 1
CONSTINTEGER DIRDACT = 5; ! special director async messages
CONSTINTEGER DISABLE STREAM = X'370004'
CONSTINTEGER DISCONNECT STREAM = X'370005'
CONSTINTEGER DT = 1; ! DATE and TIME required in PRINTSTRING
CONSTINTEGER EEP8 = X'B000055'; ! EEP = 11, SET EEP, ZERO AND TEMPFI
CONSTINTEGER ENABLE STREAM = X'370002';!START TRANSFER ON COMMUNICATIONS STREAM
CONSTINTEGER ENDLIST = 255
CONSTINTEGER EPAGE SIZE = 4
CONSTINTEGER EVERY = 1
CONSTINTEGER X29 ACTIVITY ADDON = 12
CONSTINTEGER FEP INPUT CONNECT = 52
CONSTINTEGER FEP INPUT CONNECT REPLY = 53
CONSTINTEGER FEP INPUT DISABLE = 57
CONSTINTEGER FEP INPUT DISABLE REPLY = 58
CONSTINTEGER FEP INPUT DISCONNECT REPLY = 60
CONSTINTEGER FEP INPUT ENABLE REPLY = 55
CONSTINTEGER FEP INPUT MESS = 50
CONSTINTEGER FEP OUTPUT CONNECT REPLY = 54
CONSTINTEGER FEP OUTPUT DISABLE REPLY = 59
CONSTINTEGER FEP OUTPUT DISCONNECT REPLY = 61
CONSTINTEGER FEP OUTPUT ENABLE REPLY = 56
CONSTINTEGER FEP OUTPUT REPLY MESS = 51
CONSTINTEGER FORK = 5
CONSTINTEGER INTDACT = 1; ! INT: messages from supervisor
CONSTINTEGER INTER = 0; ! reason for STARTP
CONSTINTEGER LEAVE = 8
CONSTINTEGER LOG = 2; ! route PRINTSTRING to MAINLOG
CONSTINTEGER NEWSTART = 4
CONSTINTEGER NO = 0
CONSTINTEGER OK = 0; !GENERAL SUCCESSFUL REPLY FLAG
CONSTINTEGER OPERC = 1; ! reason for STARTP
CONSTINTEGER OPTYPE = X'8000000'
CONSTINTEGER PON AND CONTINUE = 6
CONSTINTEGER REC SEP = 30
CONSTINTEGER SYNC1 TYPE = 1
CONSTINTEGER TOPEXEC = 3
CONSTINTEGER TXTDACT = 3; ! text messages in file, P1 = start/finish
CONSTINTEGER WRTOF = 4; ! route PRINTSTRING to private log file
CONSTINTEGERARRAY WARN AT(0:3) = 16, 6, 3, 2; ! MINS TO GO
CONSTSTRING (1) SNL="
"
CONSTSTRING (6)ARRAY EXEC(0:TOPEXEC) = "VOLUMS","SPOOLR","MAILER","FTRANS"
! see below owns %CONSTRECORD(COMF)%NAME COM = X'80000000' + 48 << 18
CONSTSTRINGNAME TIME = X'80C0004B'
! COMMANDS TO DIRECT
CONSTINTEGER TOPM = 93
! In the table below,
! the first two digits give the number of the command in XOPER
! the next three digits describe the (first) three parameters
! 0 none
! 1 string(6)
! 2 numeric
! 3 string(6.11)
! 4 string(4)
! 5 string(1)
! 6 string(6) or numeric
! 7 string 0 < length < 32
! 8 no checking done
! the sixth digit
! 0 must have the specified number of parameters
! 1 may have fewer
!-------------------------------------------------!
! The following ACTivities are currently SPARE: !
! !
!-------------------------------------------------!
CONSTSTRING (25)ARRAY M(1:TOPM) = C
"30-1220-ACR",
"40-2001-AUTOFILE",
"79-7000-AUTOSLOAD",
"13-2220-BADFSYSCYLTRK",
"43-2200-BADFSYSPAGE",
"18-1201-BASEF",
"50-2001-BROADCAST",
"07-2000-CCK",
"14-2000-CCKDONE",
"92-2000-CHECKFSYS",
"42-2000-CLEARBADPAGESLIST",
"10-2000-CLEARFSYS",
"26-2001-CLOSE",
"12-0000-CLOSEDOWN",
"70-2201-CLOSEFE",
"70-2201-CLOSEFEP",
"61-2201-CLOSEFSYS",
"80-2201-CLOSENODE",
"90-7201-CLOSEPAD",
"82-7201-CLOSETCP",
"91-2001-CLOSETIME",
"76-1000-CLOSETO",
"45-2001-CLOSEUSERS",
"72-0000-CLOSE?",
"60-2000-CONNECTFE",
"15-0000-CREATE",
"71-8801-DAP",
"89-0000-DAY",
"11-2200-DDUMP",
"55-8001-DELIVER",
"02-1200-DELUSER",
"28-0000-DESTS",
"39-1220-DIRMON",
"67-2001-DIRPRINT",
"57-2000-DISCONNECTFE",
"74-0000-EMPTYDVM",
"03-2221-ERTE",
"63-0000-FAIL",
"77-1000-FE",
"73-2001-FEUSECOUNT",
"06-1201-FSYS",
"69-2200-FSYSBITNO",
"68-2220-FSYSCYLTRK",
"44-2200-GOODFSYSPAGE",
"48-1500-INT:",
"29-1201-KILL",
"87-1220-LS",
"54-0000-LOGSPACE",
"32-0000-MAINLP",
"47-1201-MSG",
"16-1221-NEWSTART",
"01-1220-NEWUSER",
"51-1201-NNT",
"05-0000-OBEYFILE",
"78-2000-OPENFE",
"78-2000-OPENFEP",
"46-2000-OPENFSYS",
"81-2000-OPENNODE",
"93-7000-OPENPAD",
"83-7000-OPENTCP",
"52-1000-OPENTO",
"46-2001-OPENUSERS",
"38-1400-PASS",
"17-0000-PASSOFF",
"65-2001-PREEMPTAT",
"22-0000-PRG",
"25-2001-PRINT",
"04-3201-PRM",
"59-0000-PROMPTOFF",
"58-0000-PROMPTON",
"21-1121-RENI",
"35-2200-REP",
"20-3201-S",
"64-2001-SCARCITY",
"33-1201-SENDMSG",
"66-2001-SESSIONLENGTH",
"37-1201-SETBASEF",
"49-0000-SETMSG",
"75-1220-SIGMON",
"34-1200-SINT:",
"88-0000-SITE",
"08-0000-SNOS",
"31-1221-START",
"27-0000-STOP",
"41-1221-TESTSTART",
"36-2000-TEXT",
"24-0000-TRANSFER",
"62-2001-USECOUNT",
"23-0000-UNPRG",
"09-2000-USERNAMES",
"56-6201-USERS",
"19-0000-VSN",
"53-1201-XNNT"
!
!-----------------------------------------------------------------------
!
EXTERNALSTRINGFNSPEC ITOS(INTEGER I)
!
!-----------------------------------------------------------------------
!
EXTERNALSTRINGFN DERRS(INTEGER N)
STRING (63) W, M, A, B, C
W = ITOS(N)
N = TOPMESSAGE UNLESS 0 <= N < TOPMESSAGE
M = MESSAGE(N); ! remove curlies
M = A . C WHILE M -> A . ("{") . B . ("}") . C
RESULT = " " . W . " " . M
END ; ! DERRS
!
!-----------------------------------------------------------------------
!
!<DFLAG
externalintegerfn DFLAG(integer FLAG, stringname TXT)
!
! This procedure returns the text string associated with FLAG as
! described in the list above. The text returned is of the form:
! sp flag sp error-message
!>
TXT = ITOS(FLAG)
FLAG = TOPMESSAGE UNLESS 0 <= FLAG < TOPMESSAGE
TXT = " " . TXT . " " . MESSAGE(FLAG)
RESULT = 0
END ; ! DFLAG
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINESPEC C
WRSNT(STRING (255)S, INTEGER N, T)
EXTERNALROUTINESPEC C
WRS(STRING (255)S)
EXTRINSICINTEGER DIRFLAG
EXTRINSICINTEGER DIRFN
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE DREPORT(STRING (63)TEMPLATE)
INTEGER LNBHERE, BASE, J, T, W, W1, TO, GLA, LNB
STRING (255)S
RETURN IF TEMPLATE = "NIL"; ! for procs like DSFI
!
TO = ADDR(S)
*STLN_LNBHERE
LNB = INTEGER(INTEGER(LNBHERE))
BASE = LNB + 16
GLA = INTEGER(LNB + 16)
T = INTEGER(LNB + 12) << 8 >> 8 + INTEGER(GLA + 12) + 12
!
PRINTSTRING(STRING(T)); ! procedure name
!
J = 0
WHILE J < LENGTH(TEMPLATE) CYCLE
BASE = BASE + 4
W = INTEGER(BASE)
IF J = 0 THEN SPACE ELSE PRINTSTRING(",")
J = J + 1
T = CHARNO(TEMPLATE, J)
!
IF T = 'I' START
WRITE(W, 1)
FINISH
!
IF T = 'X' START
WRSNT("", W, 6); ! hex
FINISH
!
IF T = 'S' START
BASE = BASE + 4
W1 = INTEGER(BASE)
*LDTB_W
*LDA_W1
*CYD_0
*LDA_TO
*MV_L =DR
PRINTSTRING(S)
FINISH
!
IF T = 'J' START ; ! integername
BASE = BASE + 4
W = INTEGER(INTEGER(BASE))
WRITE(W, 1)
FINISH
REPEAT
!
IF DIRFLAG = 0 C
THEN WRS(" OK") C
ELSE WRS(DERRS(DIRFLAG))
END ; ! DREPORT
!
!-----------------------------------------------------------------------
!
OWNINTEGER INITIAL DELAY
EXTRINSICINTEGER MONITORAD
EXTRINSICINTEGER BLKSI
EXTRINSICINTEGER DDVSN; ! FORMAT IS FSYS<<18 ! DIRVSN
EXTRINSICINTEGER DIRLOGAD
EXTRINSICINTEGER DIROUTP0
EXTRINSICINTEGER FILE1AD
EXTRINSICINTEGER LOG ACTION
EXTRINSICINTEGER PROC1 LNB
EXTRINSICINTEGER PROCESS
EXTRINSICINTEGER SUPLVN S START
EXTRINSICINTEGER WORKBASE
EXTRINSICSTRING (6)PROCUSER
EXTRINSICSTRING (15)VSN
EXTRINSICBYTEINTEGERARRAY FSYS USE COUNT(0:99)
RECORDFORMAT C
FHDRF(INTEGER NEXTFREEBYTE,TXTRELST,MAXBYTES,THREE, C
SEMA,DATE,NEXTCYCLIC,READ TO)
RECORDFORMAT C
FINFOF(INTEGER NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG,
CCT, CODES, BYTEINTEGER SP1, DAYNO, SP2, CODES2, INTEGER SSBYTE,
STRING (6)OFFER)
RECORDFORMAT C
PROPF(INTEGER TRACKS, CYLS, PPERTRK, BLKSIZE C
, TOTPAGES, RQBLKSIZE, LBLKSIZE, ALISTSIZE, KEYLEN, C
SECTINDX)
INCLUDE "PD22S_C03FORMATS"
CONSTBYTEINTEGERARRAY IN CONTROL STREAM(ITP:X29) = 2, 8
CONSTBYTEINTEGERARRAY OUT CONTROL STREAM(ITP:X29)= 3, 9
EXTERNALROUTINESPEC C
ADJUST DLVN BIT(INTEGER FSYS, SET)
EXTERNALINTEGERFNSPEC C
ASYNC MSG(STRING (6) USER,INTEGER INVOC,DACT,P1,P3)
EXTERNALINTEGERFNSPEC C
AUTO COMM(STRING (255) S,INTEGER ACT)
EXTERNALINTEGERFNSPEC C
AV(INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC C
BAD PAGE(INTEGER TYPE, FSYS, BITNO)
EXTERNALINTEGERFNSPEC C
CCK(INTEGER FSYS, CHECK, INTEGERNAME PERCENT)
EXTERNALROUTINESPEC C
CLEAR FSYS(INTEGER FSYS)
EXTERNALROUTINESPEC C
COPY TO FILE(INTEGER FA1,FA2)
EXTERNALINTEGERFNSPEC C
CREATE AND CONNECT(STRING (31)FULL,
INTEGER FSYS, NKB, ALLOC, MODE, APF, C
INTEGERNAME SEG, GAP)
EXTERNALROUTINESPEC C
CYCINIT(INTEGER FAD, MAXBYTES)
EXTERNALROUTINESPEC C
DCHAIN(INTEGER SEG, DESTROY)
EXTERNALINTEGERFNSPEC C
DCONNECTI(STRING (31)FULL, INTEGER FSYS, MODE, APF,
INTEGERNAME SEG,GAP)
EXTERNALINTEGERFNSPEC C
DCREATEF(STRING (31)FULL, INTEGER FSYS, NKB, ALLOC, LEAVE,
INTEGERNAME DA)
EXTERNALINTEGERFNSPEC C
DDAYNUMBER
EXTERNALINTEGERFNSPEC C
DDELUSER(STRING (6)USER, INTEGER FSYS)
EXTERNALINTEGERFNSPEC C
DDESTROYF(STRING (31)FULL, INTEGER FSYS, DEALLOC)
EXTERNALINTEGERFNSPEC C
DDISCONNECTI(STRING (31)FULL, INTEGER FSYS, LO)
EXTERNALINTEGERFNSPEC C
DDTENTRY(INTEGERNAME ENTAD, INTEGER FSYS)
EXTERNALINTEGERFNSPEC C
DDUMPINDNO(INTEGER FSYS,INDNO)
EXTERNALROUTINESPEC C
DERR2(STRING (31) S,INTEGER FN, ERR)
EXTERNALINTEGERFNSPEC C
DFINFO(STRING (31)FILE INDEX, FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC C
DGETDA(STRING (31)USER, FILE, INTEGER FSYS, ADR)
EXTERNALINTEGERFNSPEC C
DISCSEGCONNECT(INTEGER FSYS, SITE, SEG, APF, PGS, FLAGS)
EXTERNALINTEGERFNSPEC C
DISC USE COUNT(INTEGER FSYS,INCREMENT)
EXTERNALINTEGERFNSPEC C
DNEWUSER(STRING (6)USER, INTEGER FSYS, NKB)
EXTERNALROUTINESPEC C
DOPERR(STRING (15)TXT,INTEGER FN,RES)
EXTERNALROUTINESPEC C
DOPER2(STRING (255)S)
EXTERNALROUTINESPEC C
DOUTI(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC C
DOUT11I(RECORD (PARMF)NAME P)
EXTERNALINTEGERFNSPEC C
DPERMISSIONI(STRING (18)OWNER, USER, STRING (8)DATE, STRING (11)FILE,
INTEGER FSYS, TYPE, ADRPRM)
EXTERNALROUTINESPEC C
DPOFFI(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC C
DPONI(RECORD (PARMF)NAME P)
EXTERNALINTEGERFNSPEC C
DPON3I(STRING (6) USER,RECORD (PARMF)NAME P, C
INTEGER INVOC,MSGTYPE,OUTNO)
EXTERNALINTEGERFNSPEC C
DPRG(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, C
STRING (6)LABEL, INTEGER SITE)
EXTERNALINTEGERFNSPEC C
DRENAME INDEX(STRING (18)OLDNAME, NEWNAME, INTEGER FSYS)
EXTERNALINTEGERFNSPEC C
DSFI(STRING (31)INDEX, INTEGER FSYS, TYPE, SET, ADR)
EXTERNALROUTINESPEC C
DSTOP(INTEGER REASON)
EXTERNALINTEGERFNSPEC C
DTRANSFER(STRING (31)USER1, USER2, FILE1, FILE2,
INTEGER FSYS1, FSYS2, TYPE)
EXTERNALINTEGERFNSPEC C
DUNPRG(STRING (31)USER, FILE, INTEGER FSYS,
STRING (6)LABEL, INTEGER SITE)
EXTERNALROUTINESPEC C
EMPTY DVM
EXTERNALINTEGERFNSPEC C
ENCRYPT(INTEGER MODE, STRING (63)PASS, LONGINTEGERNAME E,
INTEGERNAME K, DT)
EXTERNALINTEGERFNSPEC C
FBASE2(INTEGER FSYS, ADR)
EXTERNALROUTINESPEC C
FILE FOR HOTTOP(INTEGER INVOC)
EXTERNALINTEGERFNSPEC C
FIND NNT ENTRY(STRING (31)INDEX, INTEGERNAME FSYS, NNAD,INTEGER TYPE)
EXTERNALSTRINGFNSPEC C
FROMSTRING(STRING (255)S, INTEGER I, J)
EXTERNALINTEGERFNSPEC C
FUNDS(INTEGERNAME GPINDAD, INTEGER INDAD)
EXTERNALROUTINESPEC C
GET AV FSYS2(INTEGER TYPE, INTEGERNAME N, INTEGERARRAYNAME A)
EXTERNALINTEGERFNSPEC C
GET USNAMES(INTEGERNAME N, INTEGER ADDR, FSYS)
EXTERNALINTEGERFNSPEC C
HINDA(STRING (6)UNAME, INTEGERNAME FSYS, INDAD, INTEGER TYPE)
EXTERNALSTRINGFNSPEC C
HTOS(INTEGER I, PL)
EXTERNALINTEGERFNSPEC C
LISTMOD(STRING (6) S1,INTEGER N1,N2)
EXTERNALINTEGERFNSPEC C
LOGLINK(RECORD (PARMF)NAME P,INTEGER ACT)
EXTERNALROUTINESPEC C
MOVE(INTEGER LENGTH, FROM, TO)
EXTERNALINTEGERFNSPEC C
NEWPAGE CHAR(RECORD (PARMF)NAME P)
EXTERNALROUTINESPEC C
OUTPUT MESSAGE TO FEP(RECORD (FEPF)ARRAYNAME FEPS,
INTEGER FE, TYPE, ADR, LEN, STREAM, PROTOCOL)
EXTERNALINTEGERFNSPEC C
PACKDT
EXTERNALROUTINESPEC C
PLACE(STRING (39)TEXT, INTEGER SCREEN,LINE,COL,ACTION)
EXTERNALROUTINESPEC C
PREC(STRING (255)S, RECORD (PARMF)NAME P, INTEGER N)
EXTERNALROUTINESPEC C
PRHEX(INTEGER I)
EXTERNALINTEGERFNSPEC C
SET CLOSING BIT(INTEGER FSYS)
EXTERNALINTEGERFNSPEC C
STRING TO FILE(INTEGER LEN,ADR,FAD)
EXTERNALROUTINESPEC C
SYMBOLS(INTEGER N, SYMBOL)
EXTERNALINTEGERFNSPEC C
SYSAD(INTEGER KEY, FSYS)
EXTERNALINTEGERFNSPEC C
TXTMESS(STRING (6) USER,RECORD (PARMF)NAME RP, C
INTEGER SYNC,INVOC,TXTLEN,TXTAD,FSYS,SACT)
EXTERNALROUTINESPEC C
UCTRANSLATE(INTEGER ADR, LEN)
EXTERNALINTEGERFNSPEC C
VAL(INTEGER ADR, LEN, RW, PSR)
EXTERNALROUTINESPEC C
WRSS(STRING (255)S1, S2)
EXTERNALROUTINESPEC C
WRSN(STRING (255)S, INTEGER N)
EXTERNALROUTINESPEC C
WRS3N(STRING (255)S1, S2, S3, INTEGER N)
OWNRECORD (LOGF HDF)NAME LOGH
OWNRECORD (FEPF)ARRAYNAME FEPS
OWNINTEGER BATCH STREAMS = 0
OWNINTEGER BATCH PROCESSES = 0
OWNRECORD (PROCDATF)ARRAYFORMAT PROCLF(0:255)
OWNRECORD (PROCDATF)ARRAYNAME PROCLIST
OWNBYTEINTEGER FREEHDI=0,LIVEHDI=ENDLIST,BACKHDI=ENDLIST
OWNBYTEINTEGERNAME FREEHD,LIVEHD,BACKHD
OWNINTEGER FCHECK PROCS=0
!-----------------------------------------------------------------------------
! The group of declarations which follow was introduced for
! D/CLOSE FE, D/CLOSE FSYS etc.
OWNINTEGER CLO FES=0, CLO FSYS=0, CLO NODES=0
OWNINTEGER PENDG CLO FES=0, PENDG CLO FSYS=0, PENDG CLO NODES=0
OWNINTEGER FES CLOSED=0, NODES CLOSED=0
{ The CLO FES etc variables are set by the D/CLOSE FE etc commands. }
{ The contents are moved to the CLO FES ETC variables at 7 mins before the }
{ stated partial close time. In addition, at 2 mins to partial close time, }
{ CLO FES, CLO NODES, CLO TCPS are moved to FES CLOSED, NODES CLOSED, TCPS CLOSED,these being }
{ inspected by the CHECKSTART function to determine whether logons should }
{ be rejected. }
OWNINTEGER NEW CLOSE TIME=-1,SUPPRESS EXEC STOP=0
OWNINTEGERARRAY PENDG FCLOSING(0:3)=0(4)
OWNINTEGERARRAY FCLOSING(0:3)=0(4)
OWNBYTEINTEGERARRAY FE USECTI(0:TOP FE NO)
OWNBYTEINTEGERARRAYNAME FE USECOUNT
CONSTINTEGER OPENG=1, CLOSG=2, TCPPENDG=4, TCPINITG=8, TCPCLOSED=16
!-----------------------------------------------------------------------------
OWNINTEGER FES FOUNDI=0
OWNINTEGERNAME FES FOUND
OWNINTEGER DEFAULT SESSLEN=0
OWNINTEGER STOP LOGFILE=0
OWNINTEGERARRAY PR SRCE(0:10)
OWNINTEGERARRAY OPSTAT(0:3)=0(3),X'08000000'
! 100 bits here for FSYS 0 -99
! 0 = closed
! 1 = open
! 101st bit initially set, and cleared by a D/CLOSE USERS (used to prevent
! service being opened automatically if D/CLOSE USERS given in time.
!-----------------------------------------------------------------------
!<DERROR
externalintegerfn DERROR(stringname TXT)
!
! This procedure returns a string which describes the most recent call
! on a Director procedure. The text has the form:
! sp procedure-name sp flag sp error-message
! It is envisaged that sections of code could be written in the form:
! FLAG = DCONNECT(...
! -> FAIL %unless FLAG = 0 %or FLAG = 34
! ...
!
!
! FAIL:
! J = DERROR(TXT)
! PRINTSTRING(TXT)
! NEWLINE
! %end
!>
TXT = " " . STRING(DIRFN) . DERRS(DIRFLAG)
RESULT = 0
END ; ! DERROR
!
!-----------------------------------------------------------------------
!
INTEGERFN DIRECT SYNC1 DEST
RESULT =(COM_SYNC1 DEST + PROCESS)<<16
END ; ! DIRECT SYNC1 DEST
!-----------------------------------------------------------------------
EXTERNALINTEGERFN STOI2(STRING (255) S, INTEGERNAME I2)
STRING (63) P
INTEGER TOTAL, SIGN, AD, I, J, HEX
!MON MON(1) = MON(1) + 1
HEX = 0; TOTAL = 0; SIGN = 1
AD = ADDR(P)
A: IF S -> P.(" ").S AND P="" THEN -> A; !CHOP LEADING SPACES
IF S -> P.("-").S AND P="" THEN SIGN = -1
IF S -> P.("X").S AND P="" THEN HEX = 1 AND -> A
P = S
UNLESS S -> P.(" ").S THEN S = ""
I = 1
WHILE I <= BYTEINTEGER(AD) CYCLE
J = BYTE INTEGER(I+AD)
-> FAULT UNLESS '0' <= J <= '9' OR (HEX # 0 C
AND 'A' <= J <= 'F')
IF HEX = 0 THEN TOTAL = 10*TOTAL C
ELSE TOTAL = TOTAL<<4+9*J>>6
TOTAL = TOTAL+J&15; I = I+1
REPEAT
IF HEX # 0 AND I > 9 THEN -> FAULT
IF I > 1 THEN I2 = SIGN*TOTAL AND RESULT = 0
FAULT:
I2 = 0
RESULT = 1
END ; ! STOI2
!-----------------------------------------------------------------------
EXTERNALINTEGERFN STOI(STRING (255)S)
INTEGER J, I2
J = STOI2(S, I2)
RESULT = I2 IF J = 0
RESULT = X'80308030'
END ; ! STOI
!-----------------------------------------------------------------------
ROUTINE OPER(INTEGER SRCE,STRING (255)S)
RECORD (PARMF) P
INTEGER L
WRSS("OPER: ", S)
RETURN IF SRCE = 0
P = 0
P_DEST = SRCE
CYCLE
P_S <- S
DPONI(P)
L = LENGTH(S) - 23
RETURN UNLESS L > 0
LENGTH(S) = L
MOVE(L, ADDR(S)+24, ADDR(S)+1)
REPEAT
END ; ! THIS LOCAL VERSION OF OPER WHICH SENDS REPLIES BACK TO CALLER
!-------------------------------------------------------------------------------
INTEGERFN CYL TRK CONVERT(INTEGERNAME PPERTRACK, C
CYL,TRK,PG,INTEGER WHICH,FSYS)
! Converts an FSYS-CYL-TRK to a bitnumber (PG), for WHICH=0, or
! an FSYS-BITNO (PG) to a CYL-TRK-PG (WHICH=1).
! Result zero if OK, 23 if disc not found in disc table
INTEGER LCYL,LTRKS,TKSPERCYL, ENTAD
INTEGER J
RECORD (DDTF)NAME DDT
RECORD (PROPF)NAME PROP
J = DDT ENTRY(ENTAD, FSYS)
RESULT = 23 UNLESS J = 0
DDT == RECORD(ENTAD)
PROP==RECORD(DDT_PROPADDR)
PPERTRACK=PROP_PPERTRK
IF WHICH=0 START
PG=((CYL*PROP_TRACKS) + TRK) *PROP_PPERTRK
FINISH ELSE START
TKSPERCYL=PROP_TRACKS
LTRKS=PG//PPERTRACK
PG=PG - LTRKS*PPERTRACK
LCYL=LTRKS//TKSPERCYL
TRK=LTRKS - LCYL*TKSPERCYL
CYL=LCYL
FINISH
RESULT =0
END ; ! CYL TRK CONVERT
!-----------------------------------------------------------------------
INTEGERFN EQUSER(STRING (MAXTCPNAME) USER,PASSU)
! RESULT 1 IF USER IS IN THE CLASS "PASSU", ELSE RESULT 0
INTEGER J,CHP,CHU
CYCLE J=0,1,LENGTH(USER) {test length byte first}
CHU=BYTEINTEGER(ADDR(USER)+J)
CHP=BYTEINTEGER(ADDR(PASSU)+J)
UNLESS CHU=CHP OR CHP='?' THEN RESULT =NO
REPEAT
RESULT =YES
END ; ! EQUSER
!-----------------------------------------------------------------------
INTEGERFN OPEN TO(STRING (MAXTCPNAME)USER, INTEGER MASK, ACT, CNSL)
!
! This function is used to store usergroups for the "open to","close to"
! commands and to store TCP-names which are to be closed (partial system close).
!
! ACT is:
!
! 0 Set user into next free entry RES=0 OK, 70 list full
! 1
! user not null
! Is user in one of the entries? RES=0 OK, as OPEN TO
! -1 OK, as CLOSED TO
! user null
! 80 NO. (-1 if USER null).
! 2 Clear all the (relevant) entries Result not relevant
! 3 Clear the entry RES=0 OK, 80 not found
! 4 Move pendg bits to inited bits for TCPs
! 5 Move inited bits to closed bits for TCPs
! 6 Give array contents on OPER
! the bits in MASK are:
!
! 2**0 an "open to" entry (D/OPENTO user)
! 2**1 a "closed to" entry (D/CLOSETO user)
! 2**2 TCP pending (D/CLOSETCP identifier time If time is given its a
! potential close, else see 2**4)
! 2**3 TCP init Get to here from '2**2', about 7 mins before time
! 2**4 TCP closed (D/CLOSETCP identifier also happens in final stage
! of partial close involving a TCP)
!
CONSTINTEGER TOP = 30
RECORDFORMAT RF(STRING (MAXTCPNAME)NAME, INTEGER DATA)
OWNRECORD (RF)ARRAY RS(0 : TOP)
RECORD (RF)NAME R
SWITCH A(0 : 6)
INTEGER J, K
STRING (31) S
K = -1
CYCLE J = 0, 1, TOP
R == RS(J)
-> A(ACT)
A(0): ! insert
K = J IF K < 0 AND R_NAME = ""; ! remember first free
IF R_NAME = USER START ; ! found
R_DATA = R_DATA ! MASK
RESULT = 0
FINISH
CONTINUE
A(1): ! query
IF USER = "" START
RESULT = 0 IF R_DATA & MASK > 0
FINISH ELSE START
IF EQUSER(USER , R_NAME) = YES START
IF R_DATA & MASK > 0 START
IF R_DATA = CLOSG C
THEN RESULT = -1 C
ELSE RESULT = OK
FINISH
FINISH
FINISH
CONTINUE
A(2): ! clear all
IF R_DATA & MASK > 0 START
R_DATA = R_DATA & (¬MASK)
R_NAME = "" IF R_DATA = 0
FINISH
CONTINUE
A(3): ! clear the entry
IF EQUSER(USER, R_NAME) = YES AND R_DATA & MASK > 0 START
R_DATA = R_DATA & (¬MASK)
R_NAME = "" IF R_DATA = 0
RESULT =0
FINISH
CONTINUE
A(4): ! initialise closing sequence
R_DATA = R_DATA ! TCPINITG IF R_DATA & TCPPENDG > 0
CONTINUE
A(5): ! TCP closed
R_DATA = R_DATA ! TCPCLOSED IF R_DATA & TCPINITG > 0
CONTINUE
A(6): ! list to oper
S = ""
S = "Open to " IF R_DATA = OPENG
S = "Closed to " IF R_DATA = CLOSG
S = "Closure of TCP: " IF R_DATA & TCPPENDG > 0
OPER(CNSL, S . R_NAME) AND S = "" UNLESS S = ""
S = "TCP closed: " IF R_DATA & TCPCLOSED > 0
OPER(CNSL, S . R_NAME) UNLESS S = ""
REPEAT
!
IF ACT = 0 START
RESULT = 70 IF K < 0; ! no free entry
RS(K)_NAME = USER
RS(K)_DATA = MASK
RESULT = 0
FINISH
!
RESULT = -1 IF ACT = 1 AND USER = ""; ! no special TCP settings
!
RESULT = 80; ! not in list, or totally irrelevant result!
END ; ! OPEN TO
!-----------------------------------------------------------------------
INTEGERFN BIT STATUS(INTEGERARRAYNAME OPSTAT,
INTEGER OPEN,FSYS)
! OPEN = -1 test status for FSYS
! result 1 OPEN (or any FSYS open if FSYS = -1)
! result 0 CLOSED (or all file systems closed if FSYS = -1)
! 0 set status CLOSED
! 1 set status OPEN
! FSYS = -1 for all file systems
! 0-99 for thst file system
CONSTINTEGERARRAY MOP(0:3) = -1(3), X'F8000000'
INTEGER J,A,VAR,M
VAR=0
A=ADDR(OPSTAT(0))
IF OPEN>=0 START
! OPEN = 0 close
! 1 open
IF FSYS<0 START
! All file systems
CYCLE J=0,1,3
IF OPEN=0 THEN OPSTAT(J)=OPSTAT(J)&(¬MOP(J)) C
ELSE OPSTAT(J)=OPSTAT(J) ! MOP(J)
REPEAT
FINISH ELSE START
! file system FSYS
*LDTB_101
*LDA_A
*LB_FSYS
*LSS_OPEN
*ST_(DR +B )
FINISH
FINISH ELSE START
! OPEN < 0: return the OPEN status
IF FSYS<0 START
! if all file systems closed return 0 (closed)
! if any file system open< return 1 (open)
CYCLE J=0,1,3
M=MOP(J)
IF J=3 THEN M=M>>28<<28; ! drop bit 101
IF OPSTAT(J)&M#0 THEN VAR=1
REPEAT
FINISH ELSE START
*LDTB_101
*LDA_A
*LB_FSYS
*LSS_(DR +B )
*ST_VAR
FINISH
FINISH
RESULT =VAR
END ; ! BIT STATUS
!-----------------------------------------------------------------------
ROUTINE DISPLAY VSNS
INTEGER FE NO,NUM,PENDG CLO TCPS
STRING (40) W,TEXT
!
! 1 2 3 3
!0....5....0....5....0....5....0....5...9
!FEs: 0,1,2,3 Closed CLOSEUSERS 17.00
!
NUM = 0
W = ""
CYCLE FE NO = 0, 1, TOP FE NO
UNLESS FES FOUND & (1<<FE NO) = 0 START
W = W . "," UNLESS W = ""
W = W . TOSTRING(FE NO + '0')
NUM = NUM + 1
FINISH
REPEAT
!
TEXT = "No FEs" IF NUM = 0
TEXT = "FE: " IF NUM = 1
TEXT = "FEs: " IF NUM > 1
TEXT = TEXT . W
TEXT = TEXT . " " WHILE LENGTH(TEXT) < 17
LENGTH(TEXT) = 17 IF LENGTH(TEXT) > 17
!
W = "Closed "; ! if 'closed' set for all file systems, else blank
W = " " UNLESS BIT STATUS(OPSTAT, -1, -1) = 0
TEXT = TEXT . W
!
IF COM_SECSTOCD > 1 START { ACTUAL CLOSE }
W = "Part close "
PENDG CLO TCPS = (¬(OPEN TO("", TCPPENDG, 1, 0)))
IF PENDG CLO FES ! PENDG CLO FSYS ! PENDG CLO NODES ! PENDG CLO TCPS=0 START
IF SUPPRESS EXEC STOP = 0 C
THEN W = "Full close " C
ELSE W = "Closeusers "
FINISH
FINISH ELSE START
IF NEW CLOSE TIME > 0 C
THEN W = "Close time " C
ELSE W = " "
FINISH
!
TEXT = TEXT . W
PLACE(TEXT, 0, 1, 0, 0)
END ; ! DISPLAY VSNS
!-----------------------------------------------------------------------
EXTERNALINTEGERFN SHOW USE COUNT(INTEGER FSYS, SOURCE, CNSL)
! The parameter source indicates whether the information is to come from the
! disc table (SOURCE = 0) or from the process' use count array (SOURCE = 1)
INTEGER ENTAD,K,N1,N2,COUNT, J
INTEGERARRAY A(0:99)
RECORD (DDTF)NAME DDT
IF FSYS < 0 START
GET AV FSYS2(1, K, A)
OPER(CNSL, "No of discs: " . ITOS(K))
FINISH ELSE START
IF AV(FSYS, 1) = 0 START
OPER(CNSL, "Disc not available")
RESULT = 23; ! FSYS NOT ONLINE
FINISH
A(0) = FSYS
K = 1
FINISH
J = 0
CYCLE N1 = 0, 1, K-1
N2 = A(N1)
IF 0 <= N2 <= 99 START
IF SOURCE = 0 START
J = DDT ENTRY(ENTAD, N2)
EXIT UNLESS J = 0
DDT == RECORD(ENTAD)
COUNT = DDT_CONCOUNT
FINISH ELSE COUNT = FSYS USE COUNT(N2)
OPER(CNSL, "Fsys ".ITOS(N2)." Count=".ITOS(COUNT))
FINISH ELSE OPER(CNSL, "N2: " . ITOS(N2))
REPEAT
RESULT = J
END ; ! SHOW USE COUNT
!-----------------------------------------------------------------------
ROUTINE KILLI(INTEGER PROCNO)
RECORD (PARMF) P
P=0
P_DEST=(COM_ASYNCDEST+PROCNO)<<16 ! X'FFFF'
DPONI(P)
END ; ! KILLI
!-------------------------------------------------------------------------------
ROUTINE KILL(STRING (6) USER,INTEGER PROCNO,CNSL)
! USER = "" kill all processes
! otherwise
! kill USER, but no action if more than one invocation
INTEGER J,N
BYTEINTEGERARRAY PROCS(0:255)
RECORD (PROCDATF) NAME PROCE
N=0
J=LIVEHD
WHILE J#ENDLIST CYCLE
PROCE==PROCLIST(J)
IF USER="" OR C
(USER=PROCE_USER#"" AND PROCNO=PROCE_PROCESS) C
THEN KILLI(PROCE_PROCESS) C
ELSE IF PROCE_USER=USER AND PROCNO<0 C
THEN PROCS(N)=PROCE_PROCESS AND N=N+1
J=PROCLIST(J)_LINK
REPEAT
RETURN IF USER=""
IF N=0 THEN OPER(CNSL,USER." not found") ELSE C
IF N=1 THEN KILLI(PROCS(0)) ELSE START
J=0
WHILE J<N CYCLE
OPER(CNSL,USER." proc ".ITOS(PROCS(J)))
J=J+1
REPEAT
OPER(CNSL,USER." not killed")
FINISH
END ; ! KILL
!-------------------------------------------------------------------------------
INTEGERFN MAP XOP OWNS(INTEGER DACT)
! Result 0 if OK, else non-zero.
INTEGER J
RECORD (PARMF)P
J = LOGLINK(P, DACT)
RESULT = J UNLESS J = 0
!
LOGH == RECORD(P_DEST)
PROCLIST == LOGH_PROCLIST
FREEHD == LOGH_FREEHD
LIVEHD == LOGH_LIVEHD
BACKHD == LOGH_BACKHD
FES FOUND == LOGH_FES FOUND
FE USECOUNT == LOGH_FE USECOUNT
FEPS == LOGH_FEPS
RESULT = 0
END ; ! MAP XOP OWNS
!-------------------------------------------------------------------------------
ROUTINE OPEN FEP(RECORD (PARMF)NAME P)
INTEGER DACT, WHICH FE, FLAG, PROTOCOL, ACT ADDON
OWNINTEGER INIT=-1
RECORD (FEP DETAILF) NAME FEP
SWITCH ACT(FEP INPUT CONNECT : FEP OUTPUT DISCONNECT REPLY)
INIT = MAP XOP OWNS(8) UNLESS INIT = 0
RETURN UNLESS INIT = 0
!
DACT = P_DEST&255
WHICH FE = (P_DEST>>8)&255
IF DACT > FEP OUTPUT DISCONNECT REPLY START
PROTOCOL = X29
DACT = DACT - X29 ACTIVITY ADDON
ACT ADDON = X29 ACTIVITY ADDON
FINISH ELSE START
PROTOCOL = ITP
ACT ADDON = 0
FINISH
FEP == FEPS(WHICH FE)_FEP DETAILS(PROTOCOL)
-> ACT(DACT)
!*
ACT(FEP INPUT CONNECT):
P = 0
P_DEST = CONNECT STREAM
P_SRCE = WHICH FE<<8!FEP INPUT CONNECT REPLY
P_P1 = FEPS(WHICH FE)_FEP DETAILS(ITP)_INPUT STREAM
P_P2 = DIRECT SYNC1 DEST!WHICH FE<<8!FEP INPUT MESS
!INPUT HIGH LEVEL CONTROL MESSAGES TO THIS ACTIVITY
P_P3 = 14<<24!WHICH FE<<16! IN CONTROL STREAM(ITP)
FLAG = DPON3I("",P,0,0,6)
P = 0
P_DEST = CONNECT STREAM
P_SRCE = WHICH FE<<8!FEP INPUT CONNECT REPLY+X29 ACTIVITY ADDON
P_P1 = FEPS(WHICH FE)_FEP DETAILS(X29)_INPUT STREAM
P_P2 = DIRECT SYNC1 DEST!WHICH FE<<8!FEP INPUT MESS+X29 ACTIVITY ADDON
!INPUT HIGH LEVEL CONTROL MESSAGES TO THIS ACTIVITY
P_P3 = 14<<24!WHICH FE<<16! IN CONTROL STREAM(X29)
FLAG = DPON3I("",P,0,0,6)
RETURN
!*
!*
ACT(FEP INPUT CONNECT REPLY): !INPUT STREAM CONNECT REPLY
IF P_P2 = 0 START
FES FOUND = FES FOUND ! (1<<WHICH FE)
FEP_INPUT STREAM = P_P1; !STORE COMMS STREAM ALLOCATED
P = 0
P_DEST = CONNECT STREAM
P_SRCE = WHICH FE<<8!FEP OUTPUT CONNECT REPLY+ACT ADDON
P_P1 = FEP_OUTPUT STREAM
P_P2 = DIRECT SYNC1 DEST!WHICH FE<<8!FEP OUTPUT REPLY MESS
!OUTPUT HIGH LEVEL CONTROL MESSAGES TO THIS ACTIVITY
P_P3 = 14<<24!WHICH FE<<16!OUT CONTROL STREAM(PROTOCOL)
FLAG = DPON3I("",P,0,0,6)
FINISH
RETURN
!*
!*
ACT(FEP OUTPUT CONNECT REPLY): !OUTPUT STREAM CONNECT REPLY
IF P_P2 = 0 START
FEP_OUTPUT STREAM = P_P1
FEP_INPUT CURSOR = 0
P_DEST = ENABLE STREAM
P_SRCE = WHICH FE<<8!FEP INPUT ENABLE REPLY+ACT ADDON
P_P1 = FEP_INPUT STREAM
P_P2 = FEP_IN BUFF DISC ADDR
P_P3 = FEP_IN BUFF DISC BLK LIM
P_P4 = 2<<4!1; !BINARY CIRCULAR
P_P5 = FEP_IN BUFF OFFSET
P_P6 = FEP_IN BUFF LENGTH
FLAG = DPON3I("",P,0,0,6)
FINISH ELSE START
WRSNT("CONNECT OUT STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!*
!*
ACT(FEP INPUT ENABLE REPLY): !ENABLE INPUT STREAM REPLY
IF P_P2 = 0 START
FEP_OUTPUT CURSOR = 0
P_DEST = ENABLE STREAM
P_SRCE = WHICH FE<<8!FEP OUTPUT ENABLE REPLY+ACT ADDON
P_P1 = FEP_OUTPUT STREAM
P_P2 = FEP_OUT BUFF DISC ADDR
P_P3 = FEP_OUT BUFF DISC BLK LIM
P_P4 = 2<<4!1; !BINARY CIRCULAR
P_P5 = FEP_OUT BUFF OFFSET
P_P6 = FEP_OUT BUFF LENGTH
FLAG = DPON3I("",P,0,0,6)
FINISH ELSE START
WRSNT("ENABLE IN STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!*
!*
ACT(FEP OUTPUT ENABLE REPLY): !ENABLE OUTPUT STREAM REPLY
IF P_P2 = 0 START
FEPS(WHICH FE)_AVAILABLE = YES
WRSN("CONNECTED FE", WHICH FE)
FINISH ELSE START
WRSNT("ENABLE OUT STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!--------------------- Entry for Disconnect Stream follows ---------------------
!*
ACT(FEP INPUT DISABLE):
P = 0
P_DEST = DISABLE STREAM
P_SRCE = WHICH FE<<8!FEP INPUT DISABLE REPLY
P_P1 = FEPS(WHICH FE)_FEP DETAILS(ITP)_INPUT STREAM
P_P2 = 4; ! suspend
FLAG = DPON3I("",P,0,0,6)
P = 0
P_DEST = DISABLE STREAM
P_SRCE = WHICH FE<<8!FEP INPUT DISABLE REPLY+X29 ACTIVITY ADDON
P_P1 = FEPS(WHICH FE)_FEP DETAILS(X29)_INPUT STREAM
P_P2 = 4; ! suspend
FLAG = DPON3I("",P,0,0,6)
RETURN
!*
!*
ACT(FEP INPUT DISABLE REPLY):
IF P_P2 = 0 START
P = 0
P_DEST = DISABLE STREAM
P_SRCE = WHICH FE<<8!FEP OUTPUT DISABLE REPLY+ACT ADDON
P_P1 = FEP_OUTPUT STREAM
P_P2 = 4; ! suspend
FLAG = DPON3I("",P,0,0,6)
FINISH ELSE START
WRSNT("DISABLE IN STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!*
!*
ACT(FEP OUTPUT DISABLE REPLY):
IF P_P2 = 0 START
P_DEST = DISCONNECT STREAM
P_SRCE = WHICH FE<<8!FEP OUTPUT DISCONNECT REPLY+ACT ADDON
P_P1 = FEP_OUTPUT STREAM
FLAG = DPON3I("",P,0,0,6)
FINISH ELSE START
WRSNT("DISABLE OUT STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!*
!*
ACT(FEP OUTPUT DISCONNECT REPLY):
IF P_P2 = 0 START
P_DEST = DISCONNECT STREAM
P_SRCE = WHICH FE<<8!FEP INPUT DISCONNECT REPLY+ACT ADDON
P_P1 = FEP_INPUT STREAM
FLAG = DPON3I("",P,0,0,6)
FINISH ELSE START
WRSNT("DISCONNECT OUT STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
RETURN
!*
!*
ACT(FEP INPUT DISCONNECT REPLY):
IF P_P2 = 0 START
FES FOUND = FES FOUND & (¬(1<<WHICH FE))
FES CLOSED= FES CLOSED& (¬(1<<WHICH FE))
DISPLAY VSNS
FEPS(WHICH FE)_AVAILABLE = NO
FEP_INPUT STREAM = 0; ! reset for re-use
FEP_OUTPUT STREAM = 1; ! reset for re-use
WRSN("DISCONNECTED FE", WHICH FE)
FINISH ELSE START
WRSNT("DISCONNECT OUT STRM FE", WHICH FE, 5)
WRSN(" FAILS ", P_P2)
FINISH
END ; ! OPEN FEP
!-------------------------------------------------------------------------------
ROUTINE CONNECT FE(INTEGER STRM)
INTEGER FE NO,LO,HI
RECORD (PARMF)P
! messages to FE have "destination" specified by a "stream id"
! messages to process1 have "destination" specified by a "stream no"
! (chosen by comms controller).
LO=0
HI=TOP FE NO
IF STRM>=0 THEN LO=STRM AND HI=STRM
CYCLE FE NO=LO,1,HI
P=0
P_DEST=FE NO<<8 ! FEP INPUT CONNECT
OPEN FEP(P)
REPEAT
END ; ! CONNECT FE
!-----------------------------------------------------------------------
ROUTINE DISCONNECT FE(INTEGER STRM)
RECORD (PARMF)P
INTEGER FE NO,LO,HI
!MON MON(3) = MON(3) + 1
LO=0
HI=TOP FE NO
IF STRM>=0 THEN LO=STRM AND HI=STRM
CYCLE FE NO=LO,1,HI
P=0
P_DEST=FE NO<<8 ! FEP INPUT DISABLE
IF FES FOUND&(1<<FE NO)#0 START
OPEN FEP(P)
FINISH ELSE START
IF STRM>=0 THEN DOPER2("No such FE")
! (here, we should call OPER(CNSL,..., not DOPER)
FINISH
REPEAT
END ; ! DISCONNECT FE
!-------------------------------------------------------------------------------
INTEGERFN AUTOPRG(STRING (31)FILE, INTEGER SITE)
INTEGER J, SEG, GAP
RECORD (FINFOF)FINFO
CONSTINTEGER SITESEG = 12
J = DFINFO("", FILE, -1, ADDR(FINFO))
-> OUT UNLESS J = 0
!
J = 27
-> OUT IF FINFO_NKB > 512 OR FINFO_NKB < 128
!
SEG = 0
GAP = 0
J = DCONNECTI(FILE, FINFO_FSYS, 5, 0, SEG, GAP)
-> OUT UNLESS J = 0 OR J = 34
!
DCHAIN(SITESEG, 1)
DCHAIN(SITESEG + 1, 1)
!
SITE = SITE + SUPLVN S START
J = DISC SEG CONNECT(COM_SUPLVN, SITE, SITESEG, X'22'{apf}, 64{pgs}, 0)
-> OUT UNLESS J = 0
!
J = DISC SEG CONNECT(COM_SUPLVN, SITE+X'40', SITESEG+1, X'22', 64, 0)
-> OUT UNLESS J = 0
!
MOVE(FINFO_NKB<<10, SEG<<18, SITESEG<<18)
!
J = DDISCONNECTI(FILE, FINFO_FSYS, 0)
DCHAIN(SITESEG, 0)
DCHAIN(SITESEG+1, 0)
J = 0
OUT:
RESULT = J
END ; ! AUTOPRG
!
!-----------------------------------------------------------------------
!
ROUTINE DESTROY TEMPS(STRING (6)USER, STRING (3)SUFFIX, C
INTEGER FSYS)
CONSTINTEGER TOPTN = 5
CONSTSTRING (8)ARRAY TNAMES(0:TOPTN) = C
".#STK", ".#LCSTK", ".#SIGSTK", ".T#LOAD", ".T#IT", ".#UINFI"
INTEGER J, I, P3
STRING (18)FILE
! reverse order of destroying because we create #STK first and we
! want all the others to be gone before we create a new #STK with the
! same suffix
P3 = 0
CYCLE J=TOPTN,-1,0
FILE = USER . TNAMES(J) . SUFFIX
I = DDESTROYF(FILE, FSYS, 5)
WRS3N("Destroy", USER, TNAMES(J), I) IF I # 0 AND J < 3
REPEAT
END ; ! DESTROY TEMPS
!-----------------------------------------------------------------------
ROUTINE PROCESS STOPS(STRING (6)USER, INTEGER INVOC, STOPREASON, KINSTRS, PTRNS)
! post-stopping tidying-up done here:
! . destroying known tempfiles
! . disconnecting console streams
! . freeing mag tapes
! . etc7
RECORD (HF)NAME NH
INTEGER IX,J,INDAD,FSYS, CUR, FE NO, CPU, RES
BYTEINTEGERNAME PREV
RECORD (PROCDATF)PIX
RECORD (PARMF)P
STRING (3)INVOCS
BYTEINTEGERNAME USE
RECORD (DIRCOMF)NAME DIRCOM
INTEGER SITE, SITEA, COUNT
STRINGNAME SITEF
CONSTSTRING (7)ARRAY SITEN(1:2) = "SUBSYS", "STUDENT"
!
-> OUT UNLESS 0 <= INVOC < 255
INVOCS = ITOS(INVOC)
!
PRINTSTRING(" STOPS: ")
PRINTSTRING(USER)
PRINTSTRING(" INVOC ")
PRINTSTRING(INVOCS)
!
IX = -1; ! if not found
PREV == LIVEHD
CUR = LIVEHD
WHILE CUR # ENDLIST CYCLE
IF PROCLIST(CUR)_USER = USER ANDC
PROCLIST(CUR)_INVOC = INVOC C
THEN IX = CUR AND EXIT
PREV == PROCLIST(CUR)_LINK
CUR = PROCLIST(CUR)_LINK
REPEAT
!
IF IX<0 START
OUT:
DOPERR("CANT FIND ".USER, 0, INVOC)
RETURN
FINISH
!
PIX = PROCLIST(IX)
WRSNT(" PROC", PIX_PROCESS, 5)
WRSNT(" REAS", STOPREASON<<8>>8, 5)
CPU = KINSTRS//COM_KINSTRS
WRSNT(" CPU", CPU, 5)
WRSNT(" PTRNS", PTRNS, 5)
WRSNT(" PROCS", COM_USERS, 5)
WRSNT(" PRIORITY", STOPREASON >> 24, 5) IF PIX_REASON = BATCH
NEWLINE
!
IF CPU > 30 AND PTRNS > (CPU << 13) C
THEN DOPER2(USER . " excessive PTRNS")
!
IF 0 < PIX_SITE < 3 START ; ! ie 1 or 2
SITE = PIX_SITE
DIRCOM == RECORD(SYSAD(DIRCOMKEY, -1))
SITEA = ADDR(DIRCOM_SUBSYS SITE COUNT)
SITEA = SITEA + 24 IF SITE = 2
*LXN_SITEA
*TDEC_(XNB +0)
*ST_COUNT; ! original value
!
SITEF == STRING(SITEA + 4)
UNLESS SITEF = "" START
!
IF COUNT = 1 START ; ! now zero
DOPER2(SITEN(SITE) . " site free")
DOPER2("AUTOPRG " . SITEF)
J = AUTOPRG(SITEF, X'300' + SITE << 7)
DOPER2("Flag=" . ITOS(J))
SITEF = "" IF J = 0
FINISH
!
IF COUNT < 1 OR 1 < COUNT < 9 START
DOPER2(SITEN(SITE) . " site count " . ITOS(COUNT-1))
FINISH
!
FINISH
FINISH
!
PREV=PIX_LINK; ! REMOVE FROM CHAIN
IF BACKHD=IX C
THEN BACKHD=PIX_BLNK C
ELSE PROCLIST(PREV)_BLNK=PIX_BLNK
PROCLIST(IX)_LINK=FREEHD
FREEHD=IX
FSYS=PIX_FSYS
RES = HINDA(USER, FSYS, INDAD, 2)
DOPERR("PROC STOPS",12,RES) AND RETURN UNLESS RES=0; ! failed to find username (PROCESS STOPS)
IF PIX_REASON=BATCH START
BATCH PROCESSES=BATCH PROCESSES - 1
P = 0; ! advise spoolr
P_DEST = X'FFFF0035'
P_P1 = PIX_ID
J = BATCH STREAMS - BATCH PROCESSES
P_P3 = J IF J > 0
P_P4 = STOPREASON<<8>>8
P_P5 = KINSTRS
P_P6 = PTRNS
J = DPON3I("SPOOLR", P, 0, SYNC1TYPE, PONANDCONTINUE)
FINISH ELSE START
IF PIX_REASON=INTER START
COM_RATION = COM_RATION-1
!
! Decrement use-count of FE
!
FE NO=(PIX_ID>>16)&255
FE USE COUNT(FE NO)=FE USE COUNT(FE NO) - 1
IF CLO FES&(1<<FE NO)#0 AND FE USE COUNT(FE NO)=0 START
DOPER2("FE no. ".ITOS(FE NO)." disconnecting")
DISCONNECT FE(FE NO)
FINISH
FINISH
! Decrement usergroup counts in restrictions lists
J=LISTMOD(USER,0,-1); ! ignore flag. ",0,-1" indicates "decrement".
FINISH
NH == RECORD(INDAD)
IF PIX_REASON = BATCH C
THEN USE == NH_BUSE C
ELSE USE == NH_IUSE
USE = USE - 1 IF USE > 0
DESTROY TEMPS(USER, INVOCS, FSYS)
J = DISC USE COUNT(FSYS,-1); ! covers normal stack file + other workfiles
!
! Get index seg out of VM if this users's FSYS is closing
IF BIT STATUS(FCLOSING,-1,FSYS)#0 THEN EMPTY DVM
END ; ! PROCESS STOPS
!-----------------------------------------------------------------------
ROUTINE SET ITADDR(STRING (63)ITADDR, INTEGERNAME NODENO, CONSOLE,
STRINGNAME TCPNAME)
!
! This routine is subject to change, with the changing comms formats for the
! ITaddr. Currently there are three flavours:
!
! Old ITP TCPs byte 0 no of bytes which follow (as "string length")
! at Glasgow: byte 1 node no ("binary")
! byte 2 network terminal no of TCP
! byte 3 console no (port no of interactive terminal on
! its TCP
! bytes 4-end TCP-name in (printable) text (no built-in counts or anything)
! followed by one space, followed by console no as above.
! Thus:
! <TCPname> <space char> <console no(bin)>
! Example: TCPD (X28)
! The TCP-name is therefore the text from byte 4 up to and not including
! the (first) space. This name is up to constinteger MAXTCPNAME in length
!
!-------------------------------------------------------------------------------
! Ring TCPs: byte 0 no of bytes which follow (as "string length")
! byte 1 node no ("binary")
! byte 2 network terminal no of TCP
! byte 3 console no (port no of interactive terminal on
! its TCP
! bytes 4-end TCP-name in (printable) text (no built-in counts or anything)
! followed by a plus char, followed by console no in prinable chars.
! Thus:
! <TCPname> <plus char> <console no. in prinable chars>
! Example: TCPD+X28
! The TCP-name is therefore the text from byte 4 up to and not including
! the (first) space. This name is up to constinteger MAXTCPNAME in length
!
!-------------------------------------------------------------------------------
! New Edinburgh: byte 0 no of bytes which follow, like string length
!
! bytes 1 to end TCP name (printable) followed by a '+' followed
! by two printable hex digits being the console
! number.
! OR, in the case of TripleX:
! All numeric PAD address.
!
!-------------------------------------------------------------------------------
! Kent: byte 0 no of bytes which follow (as"string length").
! bytes 1-end (printable) text, with sub-fields delimited by
! colons, as follows:
! <TCPname> : <line-speed> : <some number> : EMAS
! Example: GATEX : 9600 : 1 : EMAS
! The TCP-name is therefore the text from byte 1 up to and not including
! the first colon. This name may be up to 15 chars. See the constinteger
! MAXTCPNAME.
INTEGER J, CH, ALL TEXT, COLONS, FIRSTCOLON, FIRSTSPACE, ALL NUMERIC, L
ALL TEXT=1
CONSOLE = 0
COLONS=0
FIRSTCOLON=0
FIRSTSPACE=0
ALL NUMERIC=1
! First look to see if all chars are printable, and count the colons. Note
! position of first colon if any.
J=0
L = LENGTH(ITADDR)
WHILE J<L CYCLE
J=J+1
CH=CHARNO(ITADDR, J)
UNLESS '0'<=CH<='9' THEN ALL NUMERIC=0
UNLESS 32<=CH<=126 THEN ALL TEXT=0
IF CH=' ' AND FIRSTSPACE=0 AND J>4 THEN FIRSTSPACE=J
IF CH=':' START
IF COLONS=0 THEN FIRST COLON=J
COLONS=COLONS+1
FINISH
REPEAT
NODENO=0
TCPNAME <- ITADDR
IF ALL TEXT = 0 START ; ! old Edinburgh
IF CHARNO(ITADDR, L-2) = '+' C
THEN TCPNAME = FROMSTRING(ITADDR, 4, L-3) AND C
CONSOLE = (CHARNO(ITADDR, L-1)<<8) ! CHARNO(ITADDR, L) ELSE C
IF FIRSTSPACE > 0 THEN TCPNAME = FROMSTRING(ITADDR, 4, FIRSTSPACE - 1)
NODE NO = CHARNO(ITADDR, 1)
FINISH ELSE START
IF COLONS > 1 AND FIRST COLON <= MAX TCP NAME START ; ! Kent
TCPNAME = FROMSTRING(ITADDR, 1, FIRSTCOLON - 1)
UCTRANSLATE(ADDR(TCPNAME)+1, LENGTH(TCPNAME))
CONSOLE = CHARNO(ITADDR,FIRSTCOLON+2) - '0'
IF CHARNO(ITADDR,FIRSTCOLON+3) # ':' THEN START
CONSOLE = CONSOLE*10 + (CHARNO(ITADDR,FIRSTCOLON+3) - '0')
FINISH
FINISH ELSE START ; ! New Edinburgh
IF ALL NUMERIC = 0 START
IF CHARNO(ITADDR, L-2) = '+' C
THEN TCPNAME = FROMSTRING(ITADDR, 1, L-3)
FINISH
CONSOLE = (CHARNO(ITADDR, L-1)<<8) ! CHARNO(ITADDR, L)
FINISH
FINISH
! %IF ALL TEXT#0 %AND COLONS>=2 %AND FIRST COLON<=MAXTCPNAME %START
! TCPNAME <- FROMSTRING(ITADDR, 1, FIRSTCOLON-1)
! %FINISH %ELSE %START
! TCPNAME <- FROMSTRING(ITADDR, 4, FIRSTSPACE-1)
! NODENO=CHARNO(ITADDR, 1)
! %FINISH
TCPNAME="null" IF TCPNAME="" {which would be inconvenient}
END ; ! SET ITADDR
!-----------------------------------------------------------------------
ROUTINE LOGON REPLY(STRING (63)S, USER, INTEGER J,
STREAM ID, PROTOCOL, STRING (63)ITADDR)
INTEGER ITA0, ITA1, KK
STRING (63)W, TEMP, AA, BB
W = S
UNLESS J = 0 START
J = TOPMESSAGE UNLESS 0 < J < TOPMESSAGE
W = MESSAGE(J)
FINISH
! For new FE software, all these messages require CR-LF.
KK = J
KK = 0 IF KK = 114
TEMP = TOSTRING(KK) . TOSTRING(LENGTH(W)+2) . W . TOSTRING(13) . SNL
OUTPUT MESSAGE TO FEP(FEPS, C
(STREAM ID>>16)&255,1,ADDR(TEMP)+1, C
LENGTH(TEMP), STREAM ID, PROTOCOL)
! INFO attempts to log on very frequently
! dont log these attempts
UNLESS J=0 OR USER->AA.("INFO").BB START
PRINTSTRING(USER)
PRINTSTRING(": LOGON FAILS ")
IF J = 103 AND LENGTH(ITADDR) > 0 START
LENGTH(ITADDR) = 7 IF LENGTH(ITADDR) > 7
STRING(ADDR(ITA0)) = ITADDR
PRHEX(ITA0); SPACE
PRHEX(ITA1); SPACE
FINISH
WRSN(W, J)
FINISH
END ; ! LOGON REPLY
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN STARTP(STRING (6)USER, STRINGNAME FILE,
STRING (63)ITADDR, INTEGERNAME INVOC,
INTEGER FSYS, STARTCNSL, REASON, STREAM ID, DIRVSN, PROTOCOL)
!
!
! FILE parameter is:
! - on input, for a batch job, SPOOLR's file
! - on output, an error msg
!
! DIRVSN parmeter: if in range 0-3, use that dirvsn
! if -1, use default dirvsn
! if -2, use (and reset to default) INDEX DIRVSN
! and the DIRVSN parameter is set as follows:
! start from oper: -1, = default, unless explicitly given
! start from login: -2, = from index (and reset to default)
! reasons for starting:
! 0 interactive log-on
! 1 started at oper console
! 2 batch job started by SPOOLr
CONSTINTEGER TOPREASON = 6
CONSTSTRING (4)ARRAY REAS(0:TOPREASON) = C
"I", "D/", "B", "TEST", "NEW", "FORK", "???"
!
RECORDFORMAT MF(INTEGERARRAY START(0:TOPREASON), INTEGER COUNT,
STRING (6)ARRAY USER(0:999))
RECORD (MF)NAME M
!
RECORD (PARMF)P
INTEGER DIRSITE,INDAD,STKKB,GPINDAD,ISESSM,DEFAULT STKKB
INTEGER CUR,IMAX,BMAX,TMAX,IUSE,BUSE,DACT IN SCHEDULE
INTEGER J,LSTACKDA,DSTACKDA,DGLA DA,PROCNO,STARTRESULT,SEG,GAP
INTEGER PREEMPT AT,FE NO
INTEGER FUNDSI, LCSTKKB, UINFAD, PENDG CLO TCPS
INTEGER DA, CONSOLE
STRING (7) SUFFIX,REST
STRING (31)SPOOLRFILE
INTEGER FN, MINS, LINVOC
INTEGERNAME ITADR
INTEGER AITADR
! for start-process message to supervisor:
! P1-P2 to string(6) USER ID
! P3 to be DA of local controller stack
! P4 to be DA of director code (or default director, if zero)
! P5 to be DA of local stack (first section. cbt entries will be
! set up for 255kbytes)
! P6 to be DA for DIRECTOR GLA
! create local stack file
RECORD (HF)NAME NH
RECORD (UINFF)NAME UINF
BYTEINTEGERNAME USEFIELD
SPOOLRFILE = FILE
FILE = ""
!
REASON = TOPREASON UNLESS 0 <= REASON <= TOPREASON
LOG ACTION = LOG ACTION ! DT
PRE EMPT AT=(COM_RATION>>16)&255
IF FCHECKPROCS#0 THEN RESULT = 102; ! cannot start process
IF FREEHD=ENDLIST START
DOPERR("STRTP NO PRCLST CELLS", 0, -1); ! should not occur (no proclist cells)
RESULT = 102; ! cannot start
FINISH
! find out local stacksize to set from index hdr
J = HINDA(USER, FSYS, INDAD, 0)
RESULT = 110 UNLESS J = 0; ! User not found
! Interactive users >= scarcity
FUNDSI = FUNDS(GPINDAD, INDAD)
IF REASON=INTER AND COM_RATION&255>=COM_RATION>>24 START
IF FUNDSI<=0 THEN RESULT = 109
IF COM_RATION&255>=PRE EMPT AT START
CUR = BACKHD
MINS = COM_SECSFRMN //60
WHILE CUR # ENDLIST CYCLE
IF PROCLIST(CUR)_PRE EMPT # 0 START
PROCLIST(CUR)_PRE EMPT = 0
PROCLIST(CUR)_SESSEND = MINS + 8
PRINTSTRING("PRE EMPTED: ")
WRSN(PROCLIST(CUR)_USER, PROCLIST(CUR)_INVOC)
EXIT
FINISH
CUR = PROCLIST(CUR)_BLNK
REPEAT
FINISH
FINISH
J = HINDA(USER, FSYS, INDAD, 0)
RESULT = 110 UNLESS J = 0
!
NH == RECORD(INDAD)
STKKB = NH_STKKB
TMAX = NH_TMAX
BMAX = NH_BMAX
IMAX = NH_IMAX
IUSE = NH_IUSE
BUSE = NH_BUSE
ISESSM = NH_ISESSM
!
IF REASON = BATCH C
THEN USEFIELD == NH_BUSE C
ELSE USEFIELD == NH_IUSE
!
IF DIRVSN = -2 AND NH_DIRVSN < 8 START
DIRVSN = NH_DIRVSN & 3
NH_DIRVSN = 255 IF NH_DIRVSN < 4
FINISH
DEFAULT STKKB=BLKSI*EPAGE SIZE
STKKB=DEFAULT STKKB IF STKKB<DEFAULT STKKB; ! 1 block minimum, which is what the LC connects
! see whether user is allowed to have more processes running
TMAX=DEFAULT TMAX IF TMAX=255
BMAX=DEFAULT BMAX IF BMAX=255
IMAX=DEFAULT IMAX IF IMAX=255
IF IUSE+BUSE>=TMAX OR C
(REASON=BATCH AND BUSE>=BMAX) OR C
(REASON=INTER AND IUSE>=IMAX) THEN RESULT = 104; ! user already has max processes
USEFIELD=USEFIELD + 1
IF ISESSM=0 THEN ISESSM=DEFAULT SESSLEN
! But not applicable if not an interactive session or if session
! close time is sooner.
IF REASON#INTER OR 0<COM_SECSTOCD//60<ISESSM+5 C
THEN ISESSM=0
! create local stack file
FN = 1
CYCLE LINVOC = 0, 1, 254
FILE = USER . ".#STK" . ITOS(LINVOC)
J = DCREATEF(FILE, FSYS, STKKB, 5, 1, DSTACKDA); ! tempfile and allocate
EXIT UNLESS J = 16; ! already exists
REPEAT
DERR2("UNIQUE ".FILE, 1, J) UNLESS J = 0
SUFFIX = ITOS(LINVOC)
INVOC = LINVOC
-> WORK FAIL UNLESS J = 0
! create local controller stack file. Get size from bound of seg 0 in local segment table.
LCSTKKB = (((INTEGER(0)&X'0003F000') ! X'FFF' + 1) >> 10) + 16 { first 4 pages for DGLA }
FILE = USER . ".#LCSTK".SUFFIX
J = DCREATEF(FILE, FSYS, LCSTKKB, 16+4+1, 2, D GLA DA); ! zero, temp & allocate
-> WORK FAIL IF 16#J#0
! create T#LOAD file
FILE = USER . ".T#LOAD".SUFFIX
J = DCREATEF(FILE, FSYS, 12, 16+4+1, 3, DA); ! zero, temp and allocate
-> WORK FAIL IF 16#J#0
! Create T#IT
IF REASON = INTER OR REASON = NEWSTART OR REASON = FORK START
FILE = USER . ".T#IT" . SUFFIX
J = DCREATEF(FILE, FSYS, 4, 4+1, 4, DA); ! 1 page, temp
-> WORK FAIL IF 0 # J # 16
FINISH
! Create #UINF file
FILE = USER . ".#UINFI" . SUFFIX
J = DCREATEF(FILE, FSYS, 4, (11<<24)+64+16+4+1, 5, DA)
-> WORK FAIL IF 0#J#16
SEG = 0
GAP = 0
FN = 2
J = DCONNECTI(FILE, FSYS, 8+2+1, 0, SEG, GAP)
-> WORK FAIL UNLESS J = 0
UINFAD = SEG << 18
UINF==RECORD(UINFAD)
UINF = 0; ! CLEAR IT OUT
UINF_PROTOCOL = PROTOCOL
UINF_USER=USER
UINF_FSYS=FSYS
UINF_ISUFF=INVOC; ! +'0' Subsys can cope with >=0 (ie not >= '0')
UINF_REASON=REASON
!
UINF_REASON=INTER IF UINF_REASON=NEWSTART; ! Subsys can't cope at Sep 81
!
UINF_BATCH ID=STREAM ID
UINF_STARTCNSL=STARTCNSL
UINF_SPOOLRFILE=SPOOLRFILE
UINF_STREAM ID=STREAM ID
UINF_DIDENT=-2; {and not required at all after Subsys has stopped looking at this field}
UINF_SCARCITY=COM_RATION>>24
UINF_PRE EMPT AT=PREEMPT AT
UINF_SESSLEN=ISESSM
UINF_DIRVSN = DIRVSN
UINF_ITADDR <- ITADDR
LENGTH(ITADDR)=19 IF LENGTH(ITADDR)>19; ! that's all the room we've
! got in that part of the record
! format at present
STRING(ADDR(UINF_ITADDR0))=ITADDR
!
! Place known information about any pending partial close into UINF
MOVE(16,ADDR(PENDG FCLOSING(0)),ADDR(UINF_FCLOSING(0)))
UINF_CLO FES=PENDG CLO FES
! If part close in progress, set PART CLOSE word -1 to indicate to subsystem
! and to executive processes that COM_SECSTOCD relates to a partial close
! only (the subsystem will not want to put out its "Warning - close in nn
! minutes" message at process start-up, for example).
PENDG CLO TCPS=(¬(OPEN TO("", TCPPENDG, 1, 0)))
UINF_PART CLOSE=-1 IF PENDG CLO FES ! PENDG CLO NODES ! PENDG CLO FSYS ! PENDG CLO TCPS#0
! (Always get DIRECTOR from "SLOAD" disc).
DIRSITE = 0
IF 0<=DIRVSN<=3 AND REASON # BATCH START
DIRSITE=X'200'+X'40'*DIRVSN+COM_SUPLVN<<24+SUPLVNSSTART
FINISH
!
UNLESS MONITORAD = 0 START
M == RECORD(MONITORAD)
M_START(REASON) = M_START(REASON) + 1
!
IF REASON = INTER START
UNLESS NH_LASTLOGON >> 17 = PACKDT >> 17 START ; ! first one today
IF M_COUNT < 999 START
M_USER(M_COUNT) = USER
M_COUNT = M_COUNT + 1
FINISH
FINISH
FINISH
FINISH
!
! Here is the gen about the new FE arrangements.
! The logon reply must always arrive before the user process' connect comms
! stream request. We used to get the user process to send the reply if the
! case of successful startup, but with the new FE communication method, the
! process is unable to do this (it could have access to the enabled output
! file, but it cannot get at the cursor pointers to synchronise itself).
! So we are going to send a "successful" message here, before actually
! starting the new process. If the process eventually fails to start success-
! fully, a subsequent failure message, destined for the terminal, but routed
! via the enabled output file held by DIRECT, is acceptable to the FEP software,
! provided that the process has not yet done it's "connect comms stream(s)".
! The mechanism for outputting this message is via DACT 18 in routine PROCESS1.
IF REASON=INTER THEN LOGON REPLY("Logged on",USER,0,STREAM ID, PROTOCOL, ITADDR)
! only for interactive terminal sessions
! start-process message to supervisor
DACT IN SCHEDULE=1; ! start interactive process
IF REASON=BATCH OR (USER->("JOBR").REST AND C
REASON#NEWSTART AND C
REASON#INTER) THEN DACT IN SCHEDULE=16; ! start batch process
P=0
P_DEST=X'00030000' ! DACT IN SCHEDULE
! STRING(ADDR(P_P1))=USER, RH byte of P2 = 'invocation no'
P_P2=INVOC
MOVE(7, ADDR(USER), ADDR(P_P1))
P_P3 = D GLA DA + 4 {LSTACKDA}
P_P4=DIRSITE
P_P5=DSTACKDA
P_P6=DGLA DA
DOUT11I(P)
! replies from supervisor are:
! 0 OK
! 1 SYSTEM FULL
! 2 CANNOT START PROCESS
STARTRESULT=P_P1
PROCNO=P_P5
IF STARTRESULT=0 START
J = DISC USE COUNT(FSYS,+1)
IF REASON=INTER START
COM_RATION=COM_RATION+1
!
! Increment use count for this FE
FE NO=(STREAM ID>>16)&255
FE USE COUNT(FE NO)=FE USE COUNT(FE NO) + 1
FINISH
!
PRINTSTRING(REAS(REASON))
PRINTSTRING("START: ")
PRINTSTRING(USER)
PRINTSTRING(" INVOC ")
PRINTSTRING(SUFFIX)
PRINTSTRING(" PROC")
WRITE(PROCNO,2)
!
IF REASON=INTER START
AITADR = ADDR(UINF_ITADDR0)
CYCLE J = 0, 4, 16
ITADR == INTEGER(AITADR + J)
EXIT IF ITADR = 0
SPACE
PRHEX(ITADR)
REPEAT
PRINTSTRING(" FE"); WRITE(FE NO, 1)
FINISH
!
NEWLINE
!
IF REASON = BATCH C
THEN BATCH PROCESSES = BATCH PROCESSES + 1 C
ELSE J = LISTMOD(USER, 0, 1)
!
CUR = FREEHD
FREEHD = PROCLIST(CUR)_LINK
PROCLIST(CUR)_LINK = LIVEHD
BACKHD = CUR IF BACKHD = ENDLIST
PROCLIST(CUR)_BLNK = ENDLIST
PROCLIST(LIVEHD)_BLNK = CUR
LIVEHD = CUR
PROCLIST(CUR)_USER = USER
SET ITADDR(ITADDR, J, CONSOLE, PROCLIST(CUR)_TCPNAME)
PROCLIST(CUR)_NODENO = J
PROCLIST(CUR)_CONSOLE1 = CONSOLE >> 8
PROCLIST(CUR)_CONSOLE2 = CONSOLE & 255
PROCLIST(CUR)_FSYS = FSYS
PROCLIST(CUR)_INVOC = INVOC
PROCLIST(CUR)_PROTOCOL = PROTOCOL
PROCLIST(CUR)_REASON = REASON
PROCLIST(CUR)_ID = STREAM ID; ! or batch id for batch
PROCLIST(CUR)_PROCESS = PROCNO
PROCLIST(CUR)_PREV WARN = 0
PROCLIST(CUR)_LOGKEY = 0
UINF_PSLOT = CUR
IF ISESSM > 0 START
J = COM_SECSFRMN // 60 + ISESSM
J = ISESSM IF J > 23*60+54
ISESSM = J
FINISH
PROCLIST(CUR)_SESSEND=ISESSM; ! mins from midnight
J = 0
J = 1 IF REASON=INTER AND FUNDSI<=0; ! liable to pre-emption
PROCLIST(CUR)_PRE EMPT=J
!
J = DDISCONNECTI(FILE, FSYS, 0)
RESULT = 0
FINISH
J=DDISCONNECTI(FILE,FSYS,0)
J = STARTRESULT + 100
FILE = ""
FN = 8
WORK FAIL:
DERR2(FILE, FN, J)
USEFIELD=USEFIELD - 1
DESTROY TEMPS(USER,SUFFIX,FSYS)
RESULT = J; ! WORK FILE FAILURE
END ; ! STARTP
!-----------------------------------------------------------------------
ROUTINE ATTOP(STRINGNAME S)
STRING (255) T
T="**OPER ".TOSTRING(7).TIME
LENGTH(T)=LENGTH(T)-3
S<-T.": ".S
END ; ! ATTOP
!-----------------------------------------------------------------------
ROUTINE PROMPT(INTEGER CNSL,STRING (23) TXT)
RECORD (PARMF)P
WRSS("Prompt ", TXT) AND RETURN IF CNSL = 0
P_DEST= (CNSL & (-256)) ! 8
P_SRCE=DIRECT SYNC1 DEST ! 19
P_S<-TXT
DPONI(P)
END ; ! PROMPT
!-----------------------------------------------------------------------
INTEGERFN BROADMSG(STRING (255) S)
! This routine creates and connects the broadcast file, returning the
! startbyte and byte after last byte offsets of the text after placing in
! in the file. Result zero is an error.
! (LH 16 bits=start, RH 16= end)>
INTEGER FSYS,SEG,GAP,DIR ACR,J
*LSS_(1); ! PSR
*ST_J
DIR ACR=(J>>20)&15
! Edinburgh Subsystem would like a NL in the broadcast file
IF LENGTH(S)<255 THEN S=S."
"
SEG=0; GAP=0
FSYS=-1
J = CREATE AND CONNECT("VOLUMS.BROADCAST", FSYS, 4, C
EEP8, 11, DIRACR << 4 ! 15, SEG, GAP)
-> NOBR UNLESS J = 0
RESULT =STRING TO FILE(LENGTH(S),ADDR(S)+1,SEG<<18)
NOBR:
DOPER2("BROADCAST FAIL")
RESULT =0
END ; ! BROADMSG
!-----------------------------------------------------------------------
ROUTINE SLASH83(STRING (255) S,T,INTEGER FOR FSYS,SHUTDOWN)
! SENDS AN ASYNC TXT MSG TO ALL PROCESSES
! (EXCEPT EXECUTIVE PROCESSES), BUT IF S IS "ST",
! IT GIVES THE SPECIAL DIR MSG "ST".
! Parameter SHUTDOWN is zero for a broadcast message (called from XOPER,
! D/BROADCAST), and 1 for (all partial-type messages and special director
! messages relating to same) except for the 15-minute warning, before the
! PENDG words have been moved to the "initiated" words, when it has value 2 (call
! from routine WARN).
! "Part close" broadcast messages are the warning and shutdown messages
! required to close down one or more FEs or FSYSes. The SHUTDOWN parameter
! is non-zero when this routine is called from the shutdown warning sequence.
! The second parameter, T, is relevant only when a partial shutdown is
! required, and is the same as string S except that the word "Partial"
! preceeds the essential text.
INTEGER DEST, DACT, ORD DACT, PROC, PTRS, J, FSYS, FE NO, NODE NO
INTEGER ORD PTRS, PARTIAL PTRS, PARTIAL SHUTDOWN, CLO TCPS, OMIT
RECORD (PROCDATF)NAME PROCE
RECORD (PARMF) P
STRING (MAXTCPNAME) TCPNAME
WRSS("SLASH83/ ", S)
RETURN IF S = ""
P = 0
ORD PTRS=0
PARTIAL SHUTDOWN = 0
CLO TCPS=(¬(OPEN TO("", TCPINITG, 1, 0)))
IF SHUTDOWN # 0 # (CLO FES ! CLO NODES ! CLO TCPS ! CLO FSYS) C
THEN PARTIAL SHUTDOWN = 1
IF S = "ST" START
ORD DACT = DIRDACT
P_P1 = M'ST ' ! (2<<24)
FINISH ELSE START
ORD DACT = TXTDACT
ORD PTRS = BROADMSG(S)
RETURN IF ORD PTRS = 0
IF PARTIAL SHUTDOWN # 0 START
PARTIAL PTRS = BROADMSG(T)
RETURN IF PARTIAL PTRS = 0
FINISH
FINISH
P_SRCE = 31; ! Any replies to DIRLOG
J = LIVEHD
WHILE J # ENDLIST CYCLE
PTRS = ORD PTRS
DACT = ORD DACT
OMIT = 0
PROCE == PROCLIST(J)
PROC = PROCE_PROCESS
FE NO = (PROCE_ID >> 16) & 255
NODE NO = PROCE_NODENO
TCPNAME <- PROCE_TCPNAME
FSYS = PROCE_FSYS
IF PROC > TOPEXEC+2 AND PROCE_REASON # BATCH AND C
(FOR FSYS < 0 OR FSYS = FOR FSYS) START
! In a partial shutdown:
! If the process is not on an FE or node which is closing and its
! index is not on a disc which is closing, then it receives
! the "Partial ..." message instead of the "(Normal) Close..."
! message.
! In addition, for the 15-minute warning, when the close is not
! "initiated", SHUTDOWN is set 2 in the call from rt WARN and we
! suppress the "Reconfiguration" message if it is not going to
! concern the user. In this case we have to test the PENDG variables.
IF SHUTDOWN=2 AND C
PENDG CLO FES & (1 << FE NO) = 0 AND C
PENDG CLO NODES & (1 << NODE NO) = 0 AND C
OPEN TO(TCPNAME, TCPPENDG, 1, 0) # 0 {i.e. TCP not closing} AND C
BIT STATUS(PENDG FCLOSING,-1,FSYS) = 0 THEN OMIT=1
! (Note PARTIAL SHUTDOWN should be ZERO if SHUTDOWN=2, because
! the PENDG variables are moved to the initiated variables
! only after the 15-minute warning. I guarantee that I won't
! understand ANY of this the next time I read it).
IF PARTIAL SHUTDOWN#0 ANDC
CLO FES & (1 << FE NO) = 0 ANDC
CLO NODES & (1 << NODE NO) = 0 ANDC
OPEN TO(TCPNAME, TCPINITG, 1, 0) # 0 ANDC
BIT STATUS(FCLOSING, -1, FSYS) = 0 C
START
PTRS = PARTIAL PTRS
DACT = CLODACT
FINISH
PRINTSTRING("broadcast ")
WRSNT(PROCE_USER, FSYS, 5)
IF PTRS = ORD PTRS C
THEN PRINTSTRING(" Ordinary ") C
ELSE PRINTSTRING(" Partial ")
DEST = (COM_ASYNCDEST + PROC)<<16 + DACT
PRHEX(DEST)
IF PROCE_REASON=INTER START
WRSNT(" FE no", FE NO, 5)
WRSNT(" Node no", NODE NO, 5)
FINISH
IF OMIT#0 START
WRS(" omitted")
FINISH ELSE START
NEWLINE
P_DEST = X'3F0000' ! (PROC & 7); ! Service 3F sends message
! to P_P6 after DACT secs delay
! In this case 0-7 secs
P_P3 = PTRS
P_P6 = DEST
DPONI(P)
FINISH
FINISH
J = PROCE_LINK
REPEAT
END ; ! SLASH83
!-----------------------------------------------------------------------
ROUTINE KICK AT(INTEGER SECONDS,DACT,EVERY OR AFTER,INFO)
! Param EVERY OR AFTER should be 1 for every SECONDS seconds, or CANCEL
! or 2 for after SECONDS second.
! If SECONDS is -1, then it's a "cancel" request.
RECORD (PARMF)P
P = 0
P_DEST = X'A0000' ! EVERY OR AFTER
P_SRCE = 26; ! dummy dact in process1
P_P1 = DIRECT SYNC1 DEST ! DACT
P_P2 = SECONDS
P_P3 = INFO {returned in P_P1}
DPONI(P)
END ; ! KICK AT
!-----------------------------------------------------------------------
ROUTINE WARN(STRING (6) USER,INTEGER INVOC,FSYS,MINS TO GO)
RECORD (PARMF)P
STRING (63) S,T, IN X MINS
INTEGER J,K,M,PENDG CLOTCPS,SHUTPARAM
PENDG CLOTCPS{set non-zero if any closing} = (¬(OPEN TO ("", TCPPENDG, 1, 0)))
SHUTPARAM=1
CYCLE J=0,1,3
M=WARN AT(J)
IF MINS TO GO=M START
IN X MINS = " in " . ITOS(M-1) . " minutes"
S = "Close"
IN X MINS = " imminent" AND S = "Shutdown" IF J = 3
IF USER = "" START
IF J = 0 # (PENDG CLOFSYS ! PENDG CLONODES ! PENDG CLOTCPS ! PENDG CLOFES) C
THEN S = "Closing" AND SHUTPARAM=2
! SHUTPARAM is going to be used inSLASH83 to suppress this message
! if it doesn't concern the user.
S = S . IN X MINS
ATTOP(S)
! Prepare a second message preceeded by "Partial", in case
! it should be required for a partial closedown.
T = "Partial close (Fsys "
CYCLE K = 0, 1, 99
IF BIT STATUS(PENDG FCLOSING, -1, K) # 0 C
THEN T = T . ITOS(K) . ","
REPEAT
CHARNO(T, LENGTH(T)) = ')'
T = T . IN X MINS
ATTOP(T)
SLASH83(S, T, -1, SHUTPARAM)
FINISH ELSE START
S = "End-of-session" . IN X MINS
ATTOP(S)
P_DEST = X'FFFF0016'
K = TXTMESS(USER, P, 0, INVOC, LENGTH(S), ADDR(S)+1, FSYS, 0)
FINISH
FINISH
REPEAT
END ; ! WARN
!-----------------------------------------------------------------------
ROUTINE CHECKWARN(RECORD (PROCDATF)NAME P,INTEGER NOW MINS 0000, C
SYS MINS TO GO)
! The point of this routine is as follows
! 1. To make sure that the 15, 5, 2 and 1-minute warnings are always
! given (even though thie rt is being called only v. approx. at one
! minute intervals.
! 2. To prevent proc-close warnings being given while system-close
! warnings are in force (last 10 mins of sequence).
! 3. To enable a process to continue for at least 5 more mins if a system
! close-time is withdrawn.
INTEGER MINS, J, W
INTEGERNAME LAST WARN
LAST WARN == P_PREV WARN
IF P_SESSEND<NOW MINS 0000 C
THEN P_SESSEND = NOW MINS 0000 + 10 AND LAST WARN=0; ! minutes
IF P_SESSEND>=23*60+55 C
THEN P_SESSEND=0010 AND LAST WARN=0; ! 0010 hrs
MINS=P_SESSEND - NOW MINS 0000
! Cancel if we've got to last 10 mins of session
IF MINS>SYS MINS TO GO - 10 THEN P_SESSEND=0 AND RETURN
CYCLE J = 0, 1, 3
W = WARN AT(J)
MINS = W IF MINS < W < LAST WARN
REPEAT
IF LAST WARN=0 OR LAST WARN>MINS START
WARN(P_USER,P_INVOC,P_FSYS,MINS)
LAST WARN=MINS
FINISH
IF MINS=0 START
J = ASYNC MSG(P_USER, P_INVOC, DIRDACT, M'VST' ! (3<<24), 0)
P_SESSEND=0
FINISH
END ; ! CHECKWARN
!-----------------------------------------------------------------------
ROUTINE CLEAR ALL PARTIAL { Nodes and TCPs remain closed by virtue }
{ of the variables NODES CLOSED, TCPS CLOSED.}
{ the latter represented by result from OPENTO}
{ These must }
INTEGER J { be cleared manually, i.e. by D/OPEN NODE }
CLO FES=0; CLO FSYS=0 { after the event. }
CLO NODES=0
PENDG CLO FES=0; PENDG CLO FSYS=0
PENDG CLO NODES=0
J=OPEN TO("", TCPINITG!TCPPENDG, 2, 0) {clear pendg & initd entries}
J=BIT STATUS(FCLOSING,0,-1)
J=BIT STATUS(PENDG FCLOSING,0,-1)
DISPLAY VSNS
END ; ! CLEAR ALL PARTIAL
!-----------------------------------------------------------------------
ROUTINE ADVISE EXEC(INTEGER FSYS)
CONSTBYTEINTEGERARRAY EXECDACTS(0:TOPEXEC)=26,58,27,58
INTEGER I,J
RECORD (PARMF)P
CYCLE I=TOPEXEC,-1,0
P=0
P_DEST=X'FFFF0000' ! EXECDACTS(I)
P_P1=FSYS
IF EXEC(I)="SPOOLR" START
P_P1=1; ! meaning 'FSYS'
P_P2=1; ! closing now
P_P3=FSYS
FINISH
J=DPON3I(EXEC(I),P,0,SYNC1 TYPE,PON AND CONTINUE)
!
! also an async message to set the Director variable FSYS WARN
P=0
P_DEST=X'FFFF0000' ! CLODACT
P_P1=0
J=DPON3I(EXEC(I),P,0,ASYNC TYPE,PON AND CONTINUE)
REPEAT
END ; ! ADVISE EXEC
!-----------------------------------------------------------------------
ROUTINE STOP FSYS BATCH
!
! Sends the special Director CLOSE MSG to non-interactive jobs. Effect
! at the recipient process is to EMPTY DVM if the process has a non-zero
! usecount for any closing fsys, THEN (to stop the process if the counts
! have not all come to zero) ELSE ( to take no further action if all
! counts have come to zero)
INTEGER DEST, PROC, J
RECORD (PROCDATF)NAME PROCE
RECORD (PARMF)P
P = 0
P_P1 = M'ST ' ! (2<<24)
J = LIVEHD
WHILE J # ENDLIST CYCLE
PROCE == PROCLIST(J)
PROC = PROCE_PROCESS
IF PROC >= 5 AND PROCE_REASON # INTER START
WRS3N("Fclosing: batch job ", PROCE_USER, " stopped", 0)
DEST = (COM_ASYNCDEST + PROC)<<16 + CLODACT
P_DEST = X'3F0000' ! (PROC & 7); ! Service 3F sends message
! to P_P6 after DACT secs delay
! In this case 0-7 secs
P_P6 = DEST
DPONI(P)
FINISH
J = PROCE_LINK
REPEAT
END ; ! STOP FSYS BATCH
!-----------------------------------------------------------------------
OWNINTEGER AUTO STATE=0
ROUTINE AUTO CLOSE(INTEGER TIM, DACT)
! Parameter TIM is the decimal number representing the close time
! e.g. 1500 to represent 15.00 hrs.
! Values of AUTO STATE have the following meanings
! 0 no auto-close currently set
! 1 close time set and at least 6 mins away
! 2 close time <6 mins away
! 3 final sequence. Leaves this state after "Shutdown imminent" warning
! 4 final sequence. Now give 83/ST
! 5 fianl sequence. Give 83/ST again
! 6 final sequence. Now check 3 processes left. Revert to state 0 if partial close.
! > 7 final sequence. Now stop processes 1,2 and 3.
OWNINTEGER TIMES CHECKED=0,PREVMINS TO GO=100000
INTEGER RES, H, M, FSYS, CSAV, CUR, ENTAD, CLO TCPS, DAP
INTEGER NOW MINS 0000,CLOSE MINS 0000,NEXT KICK,J,MINS TO GO
INTEGERARRAY STATE(1 : 2)
RECORD (PARMF) PP
RECORD (PARMF)NAME P
RECORD (PROCDATF)NAME PROCE
RECORD (DDTF)NAME DDT
STRING (3) HH,MM,SS
STRING (5)HHMM
SWITCH FINAL SEQ(0:10)
SWITCH AUTO(25:32)
!
!
OWNSTRING (15)LAST DAP STATE = ""
STRING (15)DAP STATE
!
CONSTSTRING (5)ARRAY DAPTXT(0:3, 1:2) = C
"OFF ",
"ON ",
"STORE",
"RUN ",
" OFF",
" ON",
"STORE",
" RUN"
!
!
RETURN UNLESS 0<=TIM<=2400
NEXT KICK=0
TIME -> HH . (".") . MM . (".") . SS
NOW MINS 0000 = STOI(HH)*60 + STOI(MM)
-> AUTO(DACT)
AUTO(26): ! As 27, but executive processes not to be stopped.
! D/CLOSEUSERS hhmm
! SUPPRESS EXEC STOP=1
AUTO(27): ! D/CLOSE n
! SUPPRESS EXEC STOP=0
SUPPRESS EXEC STOP=27-DACT
IF TIM=0 START
SUPPRESS EXEC STOP=0
COM_SECSTOCD=0
AUTO STATE=0
PREV MINS TO GO=100000
NEW CLOSE TIME=-1
PLACE(" ", 0, 1, 24, 0)
RETURN
FINISH
AUTO(28): ! SET Close time
AUTO STATE=1
H = TIM // 100
M = TIM - 100*H
HHMM = ITOS(M)
HHMM = "0" . HHMM IF M < 10
HHMM = ITOS(H) . "." . HHMM
HHMM = "0" . HHMM IF H < 10
PLACE(HHMM, 0, 1, 35, 0)
NEW CLOSE TIME=TIM
CLOSE MINS 0000=H*60 + M
MINS TO GO=CLOSE MINS 0000 - NOW MINS 0000
IF MINS TO GO<-1 THEN MINS TO GO=MINS TO GO + 24*60
COM_SECSTOCD=MINS TO GO*60 - 45
-> KICK OUT
AUTO(29): ! COMES BACK HERE EACH MINUTE
NOW MINS 0000 = NOW MINS 0000 + 1
MINS TO GO = COM_SECSTOCD // 60
MINS TO GO = 24*60 IF MINS TO GO = 0
!
!
IF 5 <= COM_OCPTYPE <= 6 START
CYCLE DAP = 1, 1, 2
STATE(DAP) = COM_CDR(DAP)_DAP STATE
STATE(DAP) = 1 IF STATE(DAP) = 2; ! 'alloc' mapped to 'on'
STATE(DAP) = 2 IF STATE(DAP) > 3; ! 'store'
REPEAT
!
DAP STATE = DAPTXT(STATE(1), 1) . " DAP " . DAPTXT(STATE(2), 2)
!
UNLESS DAP STATE = LAST DAP STATE START
LAST DAP STATE = DAP STATE
PLACE(DAPSTATE, 0, 4, 25, 0)
FINISH
FINISH
!
! the cycle which follows is to deal with individual process closing (funds
! scheme).
J = LIVEHD
WHILE J # ENDLIST CYCLE
IF PROCLIST(J)_SESSEND # 0 C
THEN CHECKWARN(PROCLIST(J), NOW MINS 0000, MINS TO GO)
J = PROCLIST(J)_LINK
REPEAT
IF AUTO STATE#1 THEN RETURN
MINS TO GO=COM_SECSTOCD//60 + 1
IF MINS TO GO<=16 AND PREV MINS TO GO>16 THEN WARN("",0,0,16)
PREV MINS TO GO=MINS TO GO
IF MINS TO GO<=7 START
NEXT KICK=10; ! seconds
AUTO STATE=2
! Initiate the partial close sequence if required
CLO FES=PENDG CLO FES
CLO FSYS=PENDG CLO FSYS
CLO NODES=PENDG CLO NODES
J=OPEN TO("", 0, 4, 0) {move state from pend->init}
CYCLE FSYS=99,-1,0
IF BIT STATUS(PENDG FCLOSING,-1,FSYS)#0 START
J=SET CLOSING BIT(FSYS); ! set bit in disc table
J=BIT STATUS(FCLOSING,1,FSYS); ! set bit in final array
! And we must tell the executive processes:
! VOLUMS: DACT=26, P_P1=FSYS
! SPOOLR: DACT=58, P_P1=FSYS
! MAILER:
ADVISE EXEC(FSYS)
FINISH
REPEAT
DISPLAY VSNS
FINISH
-> KICK OUT
AUTO(30): ! shorter kicks in final sequence
-> FINAL SEQ(AUTO STATE)
FINAL SEQ(2):
NEXT KICK=10
MINS TO GO=COM_SECSTOCD//60+1
IF MINS TO GO=PREV MINS TO GO THEN -> KICK OUT
PREV MINS TO GO=MINS TO GO
IF MINS TO GO<=2 START
FES CLOSED=FES CLOSED ! CLO FES
NODES CLOSED=NODES CLOSED ! CLO NODES
CLO TCPS=(¬(OPEN TO("", TCPINITG, 1, 0))) {ie set if any initiated}
J=OPEN TO("", 0, 5, 0) {Set all TCPs closed which are to be closed}
J=BIT STATUS(OPSTAT,0,-1) IF C
PENDG CLO FSYS ! PENDG CLO NODES ! CLO TCPS ! PENDG CLO FES = 0; ! ie only for Full Close
STOP FSYS BATCH IF CLOFSYS # 0; ! special close message to
! non-interactive jobs if partial
! close/fsys closing
FINISH
WARN("",0,0,MINS TO GO)
DISPLAY VSNS
IF MINS TO GO<=1 THEN AUTO STATE=3
-> KICK OUT
FINAL SEQ(3):
NEXT KICK=15; ! seconds
AUTO STATE=4
-> KICK OUT
AUTO(25): ! D/CLOSEDOWN
SUPPRESS EXEC STOP=0
J=BIT STATUS(OPSTAT,0,-1)
DISPLAY VSNS
PLACE(" ", 0, 1, 35, 0); ! clear hh.mm time field on display
CLEAR ALL PARTIAL
FINAL SEQ(4):
SLASH83("ST","",-1,1)
IF COM_USERS<=TOPEXEC+2 THEN -> SKIPSL
NEXT KICK=15
AUTO STATE=5
-> KICK OUT
FINAL SEQ(5):
IF COM_USERS<=TOPEXEC+2 THEN -> SKIPSL
SLASH83("ST","",-1,1); ! repeat this for those who refuse to go because
! they are awaiting a DISABLE reply.
AUTO STATE=6
NEXT KICK=15; ! 5 secs wasn't enough to let a process stop prop-
! erly before CLO FES is cleared.
-> KICK OUT
FINAL SEQ(6):
SKIPSL:
TIMES CHECKED=0
CLO TCPS=(¬(OPEN TO("", TCPINITG, 1, 0)))
CSAV=CLO FES ! CLO FSYS ! CLO NODES ! CLO TCPS
IF CSAV#0 START ; ! Partial close in progress
! See whether Closing FSYSes have in fact closed. If not, pon off delayed
! messages containing the DDT LVN entry, and when received back we just
! set the DDT fields (LVN and CONCOUNT) to "off-line"
FOR FSYS=99, -1, 0 CYCLE
IF BIT STATUS(FCLOSING, -1, FSYS)#0 START
J=DDT ENTRY(ENTAD, FSYS)
CONTINUE IF J#0
DDT==RECORD(ENTAD)
! Top bit in DLVN means "Not available (not Fchecked)" when set.
! Nex bit means "FSYS closing" when set.
IF DDT_CONCOUNT#0 OR DDT_DLVN>=0 {i.e. not yet "not available"} C
THEN KICK AT(90, 13 {DACT in rt PROCESS1}, AFTER, DDT_DLVN)
FINISH
REPEAT
FINISH
CLEAR ALL PARTIAL
IF CSAV#0 START
AUTO CLOSE(0,27)
NEXT KICK=0
EMPTY DVM; ! just in case there are no processes stopping to get it
! done in rt PROCESS STOPS.
-> KICK OUT
FINISH
NEXT KICK=1; ! seconds
AUTO STATE=7
IF COM_USERS>TOPEXEC+2 THEN -> KICK OUT
! else press on
FINAL SEQ(7): ! Check that all user processes have stopped
NEXT KICK=1
IF COM_USERS>TOPEXEC+2 AND TIMES CHECKED<15 START
TIMES CHECKED=TIMES CHECKED + 1
-> KICK OUT
FINISH
IF SUPPRESS EXEC STOP#0 THEN -> SUPMON
TIMES CHECKED = 0
AUTO STATE = 8
DISCONNECT FE(-1)
FINAL SEQ(8): ! Check that FEPs have been disconnected
NEXT KICK=1
IF FES FOUND#0 AND TIMES CHECKED<15 START
TIMES CHECKED=TIMES CHECKED + 1
-> KICK OUT
FINISH
SUPMON:
P == RECORD(DIROUTP0)
P = 0; ! discs
P_DEST = X'200006'
P_P1 = -1
*OUT_11
IF COM_SFCK > 0 START ; ! drums, if there are any
P = 0
P_DEST = X'280004'
DPONI(P)
FINISH
P = 0; ! sup monitoring
P_DEST = X'90001'
*OUT_6
P = 0
P_DEST = X'390000'
*OUT_6
AUTO STATE=9
IF SUPPRESS EXEC STOP#0 THEN AUTO CLOSE(0,27)
-> KICK OUT
FINAL SEQ(9): ! STOP THE EXECUTIVE PROCESSES
CYCLE J = 0, 1, TOPEXEC
CUR=LIVEHD
WHILE CUR#ENDLIST CYCLE
PROCE==PROCLIST(CUR)
IF PROCE_USER=EXEC(J) AND PROCE_REASON=OPERC START
PP = 0
PP_DEST = X'FFFF0014'
STRING(ADDR(PP_P1)) = "STOP"
RES = DPON3I(EXEC(J), PP, PROCE_INVOC, SYNC1TYPE, C
PON AND CONTINUE)
IF RES # 0 THEN DOPER2("STOP ".EXEC(J)." FLAG ". C
ITOS(RES))
FINISH
CUR=PROCE_LINK
REPEAT
REPEAT
NEXT KICK=1; ! seconds
TIMES CHECKED=0
AUTO STATE=10
FINAL SEQ(10): ! Check that all processes have stopped
NEXT KICK=1
IF COM_USERS>1 AND TIMES CHECKED<15 START
TIMES CHECKED=TIMES CHECKED + 1
-> KICK OUT
FINISH
KILL("",0,0)
PP = 0
J = NEWPAGE CHAR(PP)
RETURN
FINAL SEQ(0):
FINAL SEQ(1):
KICK OUT:
IF NEXT KICK#0 THEN KICK AT(NEXT KICK,30,AFTER,0)
END ; ! AUTO CLOSE
!-------------------------------------------------------------------------------
ROUTINE POKE SPOOLR(INTEGER ACT,NUM,SET)
! In case it isn't obvious, this routine is used only for advising to SPOOLR
! the changes to the pending partial closure statuses. After the partial
! closure becomes "initiated", the final situation is delivered to SPOOLR
! via the SPOOLR FES routine, called from AUTO CLOSE.
! ACT = 26 D/CLOSE
! 61 D/CLOSE FSYS
! 70 D/CLOSE FE(P)
! 80 D/CLOSE NODE
! SET = 0 unset partial close for FSYS/FE/NODE
! 1 set partial close for FSYS/FE/NODE
! Here is the spec for ACT 58 messages to SPOOLR:
! p1 = 0 FE
! 1 FSYS
! P2 = 0 close in COM_SECSTOCD seconds. This message is sent
! (only) when operator does D/CLOSE hhmm, D/CLOSE FE hhmm ,
! D/CLOSE FSYS hhmm or D/CLOSE NODE hhmm.
! 1 close now. This message is sent when the partial close
! becomes irrevocable (7 mins before stated time). One
! message for each FSYS and for each FE, and one only if
! ANY node is closing.
! 2 withdraw close. As for P2=0, this message is sent only
! when operators withdraw a close (total or partial).
! P3 = the FE or FSYS number (-1 for D/CLOSE).
! Not relevant for Node closure.
! Here are some notes about partial close of a Node.
! We treat a Node closure as a closure of all FEs that we know about.
! As is the case for DIRECT itself, SPOOLR will require to be opened up
! "manually" when the node is put on-line again.
! In this routine, we want to tell SPOOLR what's changed, and in the case of
! changing the close-status of FEs or Nodes, the following constraints apply:
! 1. Do not withdraw a CLOSE FE for a CLOSE NODE if a CLOSE FE is still
! pending for that FE.
! 2. Do not withdraw a CLOSE FE for a CLOSE FE if a CLOSE NODE is still
! pending.
! 3. Do not advise a CLOSE FE if a CLOSE NODE is pending.
! 4. Do not advise a CLOSE FE for a CLOSE NODE if a CLOSE FE is pending for
! that FE.
! But in practice, forget 3 & 4. It's not important if SPOOLR gets one twice.
INTEGER J
RECORD (PARMF)P
RETURN UNLESS ACT=26 OR ACT=61 OR ACT=70 OR ACT=80
NUM=-1 IF ACT=26
IF SET=0 { withdrawing } START
RETURN IF (ACT=80 AND PENDG CLO FES#0 { constraint 1 above }) ORC
(ACT=70 AND PENDG CLO NODES#0 { 2 above })
! As a consequence of this "out", the operators may have to tell
! SPOOLR explicitly that the relevant FE(s) are up, later on.
FINISH
{ We do not worry about giving extra "closing" msgs to SPOOLR for
{ FEs which may already have been notified as closing.
IF ACT=80 START
FOR J=TOP FENO, -1, 0 CYCLE
IF FES FOUND&(1<<J)#0 THEN POKE SPOOLR(70, J, SET)
REPEAT
RETURN
FINISH
P=0
P_DEST=X'FFFF0000' ! 58
IF ACT=61 OR ACT=26 THEN P_P1=1 { FSYS. Treat full close }
{ (ACT 26) as full FSYS close.}
IF SET=0 THEN P_P2=2; ! Withdraw close
P_P3=NUM
J=DPON3I("SPOOLR",P,0,SYNC1 TYPE,PON AND CONTINUE)
END ; ! POKE SPOOLR
!-------------------------------------------------------------------------------
routine ertecheck(integer cnsl, dfctrunksac, fsys1, fsys2)
! Checks that the discs are on the specified dfcs ('dfc' values:
! 0 = A, 1 = B etc, 'trunk' is the appropriate trunk number).
! Also checks that the dfc is on the specified sac.
!
! Prints oper messages otherwise.
record (ddtf) name ddt
integer i, flag, pt, ddtad, la, fsys
integer dfc, trunk, sac
string (7) s
dfc = dfctrunksac >> 8
trunk = (dfctrunksac >> 4) & 15
sac = dfctrunksac & 15
!
la = log action; ! save it
log action = la!log; ! include MAINLOG
flag = 0
fsys = fsys1
for i = 1, 1, 2 cycle
s = "fsys ".itos(fsys)
if 0#ddtentry(ddtad, fsys) then c
flag = 1 and oper(cnsl, s." missing!!") else start
ddt == record(ddtad)
pt = (ddt_pts>>4)&255
if pt&15#trunk then c
oper(cnsl, "Put ".s." on DFC ".tostring(dfc+'A')) and flag = 1
if pt>>4#sac then c
oper(cnsl, "Put DFC ".tostring(dfc+'A')." on SAC " c
. tostring(sac+'0')) and flag = 1
finish
fsys = fsys2
exit if fsys<0
repeat
if flag=0 then oper(cnsl, "DFC ok") else c
oper(cnsl, "Reconfig required!!!")
log action = la; ! revert to original setting
end ; ! ertecheck
!
!-----------------------------------------------------------------------
!
ROUTINE XOPER(INTEGER CNSL, STRING (41)IS)
INTEGER P,NPS,DEFAULTS,BITS2,SPACES THROWN,PENDG CLO TCPS,CLO TCPS
INTEGER PARS FOUND
OWNINTEGER TYPE
INTEGER N1,N2,N3,N4
INTEGERARRAY N(0:4)
STRING (41) S0,S1,S2,S3,S4,USER,FILE, W41
STRING (2)W2
STRING (8)W8
STRING (41)ARRAY S(0:4)
!----------------------------------------------------------------------
SWITCH OP(1:TOPM)
!--------- OWNS AND SWITCH FOR CARRYING OVER DATA WHERE TWO ------------
!--------- OR MORE ENTRIES ARE REQUIRED FOR THE COMMAND ----------------
CONSTINTEGER TOPCONT = 13
SWITCH CONTMSG(1:TOPCONT)
CONSTBYTEINTEGERARRAY CONTP(1:TOPCONT) = 2,2,1,0,2,0,0,3,2,2,2,0,3
! 0 no check (but only first param checked anyway)
! 1 length = 6
! 2 string 6.11
! 3 null or string 6.11
OWNINTEGER FSYS1
OWNSTRING (41) USER1,FILE1
!-----------------------------------------------------------------------
OWNSTRING (255) BCASTM
OWNINTEGER MSTATE=0,CONUSE=-1,ACT
INTEGER I,J,K,L,MM,LEN
STRING (255) NISS
STRING (41) NIS
INTEGER YY
RECORD (PARMF)QQ
INTEGER NNAD
RECORD (HF)NAME NH
RECORD (NNF)NAME NN
RECORD (DIRCOMF)NAME DIRCOM
!
SWITCH SW71(0 : 9)
CONSTSTRING (8)ARRAY DAPCOM(0 : 9) = C
"?", "LIMIT", "INTER", "LOBATCH0", "HIBATCH0", "LOBATCH1", "HIBATCH1",
"BUSER0", "BUSER1", "IUSER"
!
CONSTINTEGERARRAY DAP DEFAULT(1 : 6) = C
1, 600, 0, 3600, 0, 3600
!
CONSTSTRING (7)ARRAY MNEMO(0:7) = "VOLUMS", "MAILER", "SUBSYS",
"", "STUDENT", "", "SPOOLR", "FTRANS"
!
CONSTSTRING (6)ARRAY DAY(1:7) = C
"Sun", "Mon", "Tues", "Wednes", "Thurs", "Fri", "Satur"
!
!-----------------------------------------------------------------------
!
ROUTINE SHOW FES(STRING (6) USER, INTEGER CNSL)
INTEGER J
STRING (7) S
J=LIVEHD
WHILE J#ENDLIST CYCLE
IF PROCLIST(J)_USER=USER START
IF PROCLIST(J)_REASON=INTER THEN S="FE ". C
ITOS((PROCLIST(J)_ ID>>16)&255) ELSE S="None"
OPER(CNSL,USER." proc ".ITOS(PROCLIST(J)_PROCESS)." ".S)
FINISH
J=PROCLIST(J)_LINK
REPEAT
END ; ! SHOW FES
!------------------------------------------------------------------------------
ROUTINE DISPLAY OP STAT(INTEGER CNSL)
INTEGER OPEN,CLOSED,J,FSYS,BIT,A,L,X
STRING (255) S,SS,SOTHER,SOPEN,SCLOSED
OPEN=0; CLOSED=0
SOPEN=""; SCLOSED=""
A=ADDR(OPSTAT(0))
CYCLE FSYS=0,1,99
SS = ITOS(FSYS)
SS = " " . SS WHILE LENGTH(SS) < 3
*LDTB_101
*LDA_A
*LB_FSYS
*LSS_(DR +B )
*ST_BIT
IF BIT=0 START
CLOSED=CLOSED+1
SCLOSED<-SCLOSED.SS
LENGTH(SCLOSED)=250 IF LENGTH(SCLOSED)>250
FINISH ELSE START
OPEN=OPEN+1
SOPEN<-SOPEN.SS
LENGTH(SOPEN)=250 IF LENGTH(SOPEN)>250
FINISH
REPEAT
RETURN IF OPEN=0 OR CLOSED=0
IF OPEN<CLOSED START
S="Open"
SS=SOPEN
SOTHER="closed"
FINISH ELSE START
S="Closed"
SS=SCLOSED
SOTHER="open"
FINISH
OPER(CNSL,S." to file systems: ")
L=LENGTH(SS)
J=1
WHILE J<LENGTH(SS) CYCLE
X=J+20
IF X>L THEN X=L
OPER(CNSL,FROMSTRING(SS,J,X))
J=J+21
REPEAT
OPER(CNSL,"All others ".SOTHER)
END ; ! DISPLAY OP STAT
!-----------------------------------------------------------------------
INTEGERFN GIVE SECTS(STRING (31)USER, FILE, INTEGER FSYS, CNSL)
STRING (255) S
INTEGER J,DD,N
RECORDFORMAT AF(INTEGER SECTSI,NSECTS,LASTSECT,SP, C
INTEGERARRAY DA(0:255))
RECORD (AF)A
S=""
J=DGETDA(USER,FILE,FSYS,ADDR(A))
IF J#0 THEN RESULT =J
N=A_NSECTS
J=0
WHILE J<N CYCLE
DD=A_DA(J)
S=S." ".HTOS(DD,4)
J=J+1
REPEAT
OPER(CNSL,S)
RESULT =0
END ; ! GIVE SECTS
!-----------------------------------------------------------------------
ROUTINE SPCAN(STRINGNAME S)
INTEGER CH, PREVIOUS, L, J
! remove leading, trailing and multiple spaces
! remove '10' from end
! remove D/ from start
RETURN IF S = ""
PREVIOUS = ' '
L = 0
CYCLE J = 1, 1, LENGTH(S)
CH = CHARNO(S, J)
L = L + 1 AND CHARNO(S, L) = CH UNLESS CH = ' ' = PREVIOUS
PREVIOUS = CH
REPEAT
L = L - 1 IF CH = ' '
L = L - 1 IF CHARNO(S, L) = 10
L = 0 IF L < 0
LENGTH(S) = L
IF S->("D/").S START ; FINISH
END ; ! SPCAN
!-----------------------------------------------------------------------
INTEGERFN FF(STRING (39) S)
IF S->USER.(".").FILE START
IF LENGTH(USER)=6 AND 0<LENGTH(FILE)<=11 THEN RESULT =1
FINISH
RESULT =0
END ; ! FF
!-----------------------------------------------------------------------
WRSS("D/", IS)
IF MSTATE#0 AND CNSL#CONUSE START
! REJECT MESSAGES FROM THER THAN CURRENTLY BUSY CNSL IF THE LATTER
! REQUIRES MORE MSGS TO COMPLETE COMMAD, INDICATED BY SETTING CONUSE
! EQUAL TO THE CONSOLE NUMBER
OPER(CNSL,"PROCESS1 IS BUSY")
-> REPROM
FINISH
SPCAN(IS)
NIS=IS
! ANALYSE COMMAND, HAVING 3 SHOTS AT THROWING AWAY SPACES IF UNSUCCESSFUL
SPACES THROWN=0
WHILE SPACES THROWN<=3 CYCLE
CYCLE J=1,1,4; S(J)="-1"; REPEAT ; ! SET FOR DEFAULT NUMERICS
! SEPARATE AND COUNT PARAMS
J=0
S(0)=IS
J=J+1 WHILE J<4 AND S(J)->S(J).(" ").S(J+1)
PARS FOUND=J
CONUSE=CNSL
S0=S(0)
! SET THE NUMERICS
CYCLE J=1,1,4
N(J)=STOI(S(J))
REPEAT
N1=N(1); N2=N(2); N3=N(3); N4=N(4)
S1=S(1); S2=S(2); S3=S(3); S4=S(4)
IF MSTATE > 0 START ; ! check param(s) just read
BITS2 = CONTP(MSTATE)
IF BITS2 > 0 START ; ! checking required
IF BITS2=1 AND LENGTH(S0)#6 THEN -> QQQ
IF BITS2=2 AND FF(S0)=NO THEN -> QQQ
IF BITS2=3 AND LENGTH(S0)#0 AND FF(S0)=NO THEN ->QQQ
FINISH
-> CONTMSG(MSTATE)
FINISH
! NOW LOOK FOR THE COMMAND
CYCLE YY=1,1,TOPM
W41 = M(YY)
W8 <- W41; ! first 8 characters ie 'FN-DDDD-'
W41 -> (W8) . W41
IF W41 = S0 START ; ! apparently matches
W2 <- W8; ! command number
W8 -> (W2 . "-") . W8; ! parameter descriptor, format dddd-
ACT = STOI(W2)
NPS = 0; ! counts how many params allowed
CYCLE J = 1, 1, 3
BITS2 = CHARNO(W8, J) - '0'
EXIT IF BITS2 = 0; ! no more params allowed
NPS = NPS + 1
LEN = LENGTH(S(J))
-> QQQ1 IF BITS2=1 AND LEN#6
-> QQQ1 IF BITS2=2 AND N(J)=X'80308030'
-> QQQ1 IF BITS2=3 AND FF(S(J))=0
-> QQQ1 IF BITS2=4 AND LEN#4
-> QQQ1 IF BITS2=5 AND LEN#1
-> QQQ1 IF BITS2=6 AND LEN#6 AND N(J)=X'80308030'
-> QQQ1 IF BITS2 = 7 AND (LEN = 0 OR LEN > 31)
REPEAT
!
DEFAULTS = 0
IF PARS FOUND < NPS START ; ! not enough params
-> QQQ1 IF CHARNO(W8, 4) = '0'; ! defaults not allowed
DEFAULTS = 1
FINISH
!
IF PARS FOUND = NPS OR DEFAULTS = 1 START
IF FCHECKPROCS > 0 START ; ! still doing FCHECKs
-> WAIT UNLESS ACT = 12 OR ACT = 32 OR ACT = 45
FINISH
-> OP(ACT)
FINISH
! TOO MANY PARAMS APPARENTLY. MAYBE WE GOT THE WRONG
! COMMAND SOMEHOW BY HAVING A SPACE SOMEWHERE. IT"S
! PROBABLY INVALID, BUT WE GO RUND AGAIN ANYHOS1.
FINISH ; ! FOUND
REPEAT
QQQ1:
! COMMAND NOT FOUND. MAYBE IT HAD A SPACE IN IT.
IF IS->IS.(" ").S4 THEN IS=IS.S4
SPACES THROWN=SPACES THROWN + 1
REPEAT
!-----------------------------------------------------------------------
OP(*):
QQQ:
OPER(CNSL,NIS." ??")
-> OUT
WAIT:
OPER(CNSL, "Wait 'til FCHECKS done")
-> OUT
PRERR:
OPER(CNSL,DERRS(J))
-> OUT
DONE:
OPER(CNSL,"DONE")
OUT:
CONUSE=-1
MSTATE=0
REPROM:
J = PR SRCE(0)
IF J > 0 START
CYCLE I = 1, 1, J
PROMPT(CNSL, "Direct:") AND EXIT IF CNSL = PR SRCE(I)
REPEAT
FINISH
DISPLAY VSNS
POUT:
MSTATE = 0 IF CNSL = 0
RETURN
OP(1): ! NEWUSER
J=DNEWUSER(S1,N2,N3)
-> PRERR
OP(2): ! DELUSER
J=DDELUSER(S1,N2)
-> PRERR
OP(3): ! ERTECHECK
ERTECHECK(CNSL, N1, N2, N3)
-> OUT
OP(4): ! PRM_FILE (IE. PERMIT)
J=DPERMISSIONI(USER,USER,"",FILE,N2,1,7); ! 1=set EEP, PRM=7=X+W+R
-> PRERR
OP(5): ! OBEY
PROMPT(CNSL, "Give OBEYFILE name:")
MSTATE = 11
-> POUT
CONTMSG(11):
J = AUTOCOMM(S0, 5)
-> PRERR
OP(6): ! FSYS_USER(_FSYS)
! TO FIND OUT WHAT FSYS A USER IS ON
J = HINDA(S1,N2,N3, 0); ! N3 IRRELEVANT
IF J=0 START
OPER(CNSL,"FSYS ".ITOS(N2))
J = LIVEHD
WHILE J # ENDLIST CYCLE
IF PROCLIST(J)_USER = S1 C
THEN OPER(CNSL, S1." proc ".ITOS(PROCLIST(J)_PROCESS))
J = PROCLIST(J)_LINK
REPEAT
J = 0
FINISH
-> PRERR
OP(7): ! CONSISTENCY CHECK
-> QQQ UNLESS 0 <= N1 <= 99
J = CCK(N1, 0, P)
DOPER2("Fsys " . ITOS(N1) . " " . ITOS(P) . "% full")
I = MAP XOP OWNS(8) IF N1 = COM_SUPLVN
-> PRERR
OP(8): ! SNOS
OPER(CNSL,"SLOADED ".ITOS(COM_SUPLVN)." DIRVSN IS ". C
ITOS(((COM_DIRSITE<<8>>8)-X'200')>>6))
OPER(CNSL,"SNOS ".HTOS(COM_SYNC1 DEST,3)." ". C
HTOS(COM_SYNC2 DEST,3). C
" ".HTOS(COM_ASYNC DEST,3))
-> OUT
OP(9): ! PRINT USERNAMES
IF AV(N1, 0)=0 THEN -> QQQ
J=GET USNAMES(I,-1,N1)
-> PRERR
OP(10): ! CLEAR FSYS
-> QQQ IF N1<0
CLEAR FSYS(N1)
J = DNEWUSER("VOLUMS",N1,8)
J = DNEWUSER("SPOOLR",N1,8)
J = DNEWUSER("MAILER",N1,8)
J = DNEWUSER("FTRANS", N1, 8)
OPER(CNSL,"EXEC PROCS CREATED")
-> PRERR
OP(11): ! DDUMP
J=DDUMPINDNO(N1,N2)
-> PRERR
OP(12): ! CLOSEDOWN
AUTO CLOSE(0,25)
-> OUT
OP(13): ! BAD FSYS CYL TRK_FSYS_CYL_TRK
-> QQQ IF AV(N1, 0)=0
J=CYL TRK CONVERT(I,N2,N3,K,0,N1); ! sets I to pgs per trk
-> PRERR IF J#0
IF ACT=68 START
OPER(CNSL,"Bitno=".ITOS(K)." (dec)")
FINISH ELSE START
CYCLE N4=0,1,I-1
J=BAD PAGE(1,N1,K+N4)
REPEAT
FINISH
-> OUT
OP(14): ! CCK DONE_FSYS
IF N1<0 THEN -> QQQ
ADJUST DLVN BIT(N1, 0)
I = LOGLINK(QQ, 8) IF N1 = COM_SUPLVN
-> DONE
OP(15): ! CREATE_USER_NKB
PROMPT(CNSL,"FILENAME FSYS NKB")
MSTATE=1
-> POUT
CONTMSG(1):
-> QQQ IF N1 < -1
-> QQQ IF N2 < 1
J=DCREATEF(USER . "." . FILE,N1,N2,1,LEAVE,N3)
-> PRERR
OP(16): ! NEWSTART_user(_fsys_dirvsn)
! Request stream id from OPER adaptor
IF CNSL >> 16 # X'32' THEN -> QQQ
P = (CNSL >> 8) & 255
QQ=0
QQ_DEST=X'00320001' ! (P<<8)
DOUT11I(QQ)
J = 102
-> PRERR IF QQ_P1 = 0
J=STARTP(S1,FILE,"",I,N2,P,NEWSTART,OP TYPE ! (P<<16) ! QQ_P1, N3, 0)
-> PRERR
OP(17): ! PASSOFF
PASSU=""
-> DONE
OP(18): ! BASEF
J=DSFI(S1,N2,0,0,ADDR(S2))
OPER(CNSL,S2)
-> PRERR
OP(19): ! VSN
OPER(CNSL,"VSN ".VSN)
-> OUT
OP(20): ! S_FILENAME - GIVE SECTION ADDRESSES
J=GIVE SECTS(USER,FILE,N2,CNSL)
-> PRERR
OP(21): ! RENI
J=DRENAME INDEX(S1,S2,N3)
-> PRERR
OP(22): ! PRG
OP(23): ! UNPRG
PROMPT(CNSL,"FILE FSYS")
MSTATE=2
-> POUT
CONTMSG(2):
-> QQQ IF N1 < -1
USER1=USER; FILE1=FILE; FSYS1=N1
PROMPT(CNSL,"LABEL SITE")
MSTATE=3
RETURN
CONTMSG(3):
CYCLE J = 0, 1, 7; ! replace mnemonic for site by address
N1 = X'300' + (J << 6) AND EXIT IF S1 = MNEMO(J)
REPEAT
!
-> QQQ UNLESS 0 < N1 <= X'4C0'
!
IF ACT=22 C
THEN J=DPRG(USER1,FILE1,FSYS1,S0,N1) C
ELSE J=DUNPRG(USER1,FILE1,FSYS1,S0,N1)
-> PRERR
OP(24): ! TRANSFER
PROMPT(CNSL,"FILE1 FSYS1")
MSTATE=9
-> POUT
CONTMSG(9):
-> QQQ UNLESS N1>-1
USER1=USER; FILE1=FILE; FSYS1=N1
PROMPT(CNSL,"FILE2 FSYS2")
MSTATE=10
RETURN
CONTMSG(10):
-> QQQ UNLESS N1>-1
J=DTRANSFER(USER1,USER,FILE1,FILE,FSYS1,N1,1)
-> PRERR
OP(25): ! PRINT
QQ_DEST=N1
J=LOGLINK(QQ, 3)
-> DONE
OP(26): ! CLOSE
N1 = NEW CLOSE TIME IF N1 = -1
-> QQQ IF N1 < 0
N2=N1
-> SEVERAL CLOS
OP(27): ! STOP
-> QQQ UNLESS IS = ""; ! so that D/STOP LP0 is not catastrophic!
KICK AT(-1,29,1,0); ! cancel regular tick on DACT 29
! DISCONNECT CTL STREAMS(-1) - now done in routine DSTOP
DSTOP(100)
-> QQQ
OP(28): ! DESTS
OPER(CNSL,"Sync1 Sync2 Async")
OPER(CNSL,HTOS(COM_SYNC1DEST,4)." ". C
HTOS(COM_SYNC2DEST,4)." ". C
HTOS(COM_ASYNCDEST,4))
-> OUT
OP(29): ! KILL_<user> [_procno]
KILL(S1,N2,CNSL)
-> OUT
OP(75): ! SIGMON_user_fsys_sigmon
OP(39): ! DIRMON_user_fsys_dirmon
OP(30): ! ACR_user_fsys_acr
J = HINDA(S1,N2,I,0)
IF J = 0 START
NH == RECORD(I)
IF ACT = 30 THEN NH_ACR <- N3
IF ACT = 75 THEN NH_SIGMON <- N3
IF ACT = 39 THEN NH_DIRMON = N3
FINISH
-> PRERR
OP(31): ! START_USER(_FSYS_DIVSN)
! %IF CNSL >> 16 # X'32' %THEN -> QQQ
P = (CNSL >> 8) & 255
J=STARTP(S1,FILE,"",I,N2,P,OPERC,0,N3,0); ! REASON = FROM OPER CONSOLE
-> PRERR
OP(32): ! MAIN LP
J=LOGLINK(QQ,5); ! AND SPOOL THE PREVIOUS
! This own used to prevent a logfile from being started even for
! DIRVSN=0 (if D/MAIN LP typed early enough).
! Just to suppress BAD PARAM msg when done before CCK complete!):
J=0 IF STOP LOGFILE=0 AND J=8
STOP LOGFILE=1
-> PRERR
OP(33): ! SENDMSG_USER(_FSYS)
-> QQQ IF BCASTM = ""
NISS = BCASTM
ATTOP(NISS)
QQ_DEST = X'FFFF0016'
J = TXTMESS(S1, QQ, 0, 0, LENGTH(NISS), ADDR(NISS)+1, N2, 0)
-> PRERR
OP(34): ! SINT:
-> QQQ UNLESS 0<=N2<=X'FFFF'
J=ASYNC MSG(S1,0,INTDACT,0,(1<<24) ! N2)
-> PRERR
OP(35): ! REP_address_value
IF N1&3#0 OR VAL(N1, 4, 1, 0)=0 START
OPER(CNSL,"INVALID ADDRESS")
-> OUT
FINISH
J=INTEGER(N1)
OPER(CNSL,HTOS(N2,8)." REPS ".HTOS(J,8))
INTEGER(N1)=N2
-> DONE
OP(36): ! TEXT n
OPER(CNSL, DERRS(N1))
-> OUT
OP(37): ! SET BASEF_USER_FSYS
USER1=S1; FSYS1=N2
IF HINDA(USER1,FSYS1,J,0)#0 THEN -> PRERR
PROMPT(CNSL,"GIVE BASEFILE ID")
MSTATE=8
-> POUT
CONTMSG(8):
J=DSFI(USER1,FSYS1,0,1,ADDR(S0))
-> PRERR
OP(38): ! PASS_ERCC99_AAAA
PASSU=S1
PASSW=S2
-> DONE
! OP(39): look near label OP(30) ! DIRMON <N>
OP(40): ! AUTOFILE(_0)
IF N1>0 THEN -> QQQ
IF N1=0 START
J=AUTOCOMM("",2); ! disconnect the file
-> PRERR
FINISH
PROMPT(CNSL,"Give Autofile name:")
MSTATE=5
-> POUT
CONTMSG(5):
J=AUTOCOMM(S0,1); ! disconnect and connect this file
-> PRERR
OP(41): ! TESTSTART_USER(_FSYS_DIRVSN)
J = STARTP(S1, FILE, "", I, N2, 0, 3, 0, N3, 0); ! REASON 3 = TEST
-> PRERR
OP(42): ! CLEAR BAD PAGES LIST
OP(43): ! BAD FSYS PAGE_FSYS_BITNO
OP(44): ! GOOD FSYS PAGE_FSYS_BITNO
J=BAD PAGE(ACT-42,N1,N2); ! PARAMS ARE TYPE, FSYS, BITNO
-> PRERR
OP(45): ! CLOSE USERS
IF 0<=N1<=2400 AND LENGTH(S1)>2 START
! e.g. D/CLOSE USERS 1700
! D/CLOSE USERS 940
!
! not allowed to do CLOSE USERS if CLOSE FE or CLOSE FSYS has
! been done.
!
IF PENDG CLO FES#0 OR PENDG CLO FSYS#0 THEN -> QQQ
AUTO CLOSE(N1,26)
-> DONE
FINISH
! but D/CLOSE USERS <0 - 99> means close users for that fsys.
OP(46): ! OPEN USERS
OP46: ! from OP(61) via OTHER CLOSES
-> QQQ UNLESS -1<=N1<=99
INITIAL DELAY = 0
J=BIT STATUS(OPSTAT,ACT-45,N1)
DISPLAY OP STAT(CNSL)
J=OPEN TO("", OPENG!CLOSG, 2, 0); ! CANCEL "OPEN TO" LIST
-> DONE
OP(47): ! MSG_USER(_FSYS)
USER1=S1; FSYS1=N2
PROMPT(CNSL,"TYPE MESSAGE:")
MSTATE=6
-> POUT
CONTMSG(6):
NISS = IS
ATTOP(NISS)
QQ_DEST = X'FFFF0016'
J = TXTMESS(USER1, QQ, 0, 0, LENGTH(NISS), ADDR(NISS)+1, FSYS1, 0)
-> PRERR
OP(48): ! INT:_USER_ONE-CHAR
J=ASYNC MSG(S1,0,INTDACT,0,(1<<24)!(BYTEINTEGER(ADDR(S2)+1)<<16))
-> PRERR
OP(49): ! SETMSG
BCASTM=""
MSTATE=7
CYCLE
PROMPT(CNSL,"("":"" TERMINATES)")
-> POUT
CONTMSG(7):
IF IS=":" OR LENGTH(BCASTM)=255 THEN EXIT
BCASTM<-BCASTM." ".IS
REPEAT
SPCAN(BCASTM)
OPER(CNSL,BCASTM)
-> OUT
OP(50): ! BROADCAST
-> QQQ IF BCASTM=""
NISS=BCASTM
ATTOP(NISS)
SLASH83(NISS,"",N1,0)
-> DONE
OP(51): ! NNT
J = FIND NNT ENTRY(S1, N2, NNAD, 0)
-> PRERR UNLESS J = 0
NN == RECORD(NNAD)
IF LENGTH(NN_NAME) < 7 C
THEN OPER(CNSL, "Name: ".NN_NAME) C
ELSE OPER(CNSL, "Name: length".ITOS(LENGTH(NN_NAME)))
OPER(CNSL, "KB: ".ITOS(NN_KB))
OPER(CNSL, "INDNO: ".ITOS(NN_INDNO))
-> OUT
OP(52): ! OPEN TO_<usergroup>
J=OPEN TO(S1, OPENG, 0, 0); ! PUT "S1" INTO THE LIST
-> PRERR
OP(53): ! XNNT
J = FIND NNT ENTRY(S1, N2, NNAD, 0)
-> PRERR UNLESS J = 0
NN == RECORD(NNAD)
NN_NAME = ".NULL"
-> DONE
OP(54): ! LOGSPACE
J=LOGLINK(QQ,6)
-> PRERR
OP(55): ! DELIVER
IF "-1" # S1 # "" START
-> QQQ UNLESS LENGTH(S1) = 6
N1 = -1
J = HINDA(S1, N1, I, 0)
-> PRERR UNLESS J = 0
NH == RECORD(I)
IS = NH_DELIVERY
FINISH ELSE START
PROMPT(CNSL,"Delivery:")
MSTATE=4
-> POUT
FINISH
CONTMSG(4):
LENGTH(IS)=31 IF LENGTH(IS)>31
STRING(ADDR(QQ))=IS
J=LOGLINK(QQ,7)
-> DONE
OP(56): ! USERS(_<usergroup>(_<N>)) or USERS(_<N>)
J=LISTMOD(S1,N1,N2)
-> OUT
OP(57): ! DISCONNECTFE
IF N1<0 THEN -> QQQ
DISCONNECT FE(N1)
-> DONE
OP(58): ! PROMPT ON
J = PR SRCE(0)
-> QQQ IF J > 9
PR SRCE(J + 1) = CNSL
PR SRCE(0) = J + 1
-> OUT
OP(59): ! PROMPT OFF
J = PR SRCE(0)
-> QQQ IF J = 0
CYCLE P = 1, 1, J
IF PR SRCE(P) = CNSL START
PR SRCE(P) = PR SRCE(J); ! CLOSE THE RANKS!
PR SRCE(0) = J - 1
-> DONE
FINISH
REPEAT
-> QQQ
OP(60): ! CONNECTFE
IF N1<0 THEN -> QQQ
CONNECT FE(N1)
-> DONE
OP(61): ! CLOSE FSYS_n (_time)
IF AV(N1,0)=0 THEN -> QQQ
-> SEVERAL CLOS
OP(62): ! USECOUNT FSYS_n
J = SHOW USE COUNT(N1,0, CNSL)
-> OUT
OP(63): ! FAIL
J=1//0
-> PRERR
OP(64): ! SCARCITY
OP(65): ! PRE EMPT AT
J=COM_RATION>>24; ! scarcity
K=(COM_RATION>>16)&255; ! pre empt at
IF N1>=0 START
IF ACT=64 THEN J=N1 ELSE K=N1
FINISH
-> QQQ IF J>255 OR K>255
COM_RATION=(COM_RATION<<16>>16) ! (J<<24) ! (K<<16)
OPER(CNSL,"Interactive Users =".ITOS(COM_RATION&255))
OPER(CNSL,"Scarcity at Users>=".ITOS(J))
OPER(CNSL,"Pre-empt at Users>=".ITOS(K))
-> OUT
OP(66): ! SESSION LENGTH
UNLESS -1<=N1<=0 OR 5<=N1<=4*60 THEN -> QQQ
IF N1>=0 THEN DEFAULT SESSLEN=N1
OPER(CNSL,"Default sess mins=".ITOS(DEFAULT SESSLEN))
-> OUT
OP(67): ! DIRPRINT n
QQ_DEST = N1
J = LOGLINK(QQ, 12)
-> DONE
OP(68): ! FSYS CYL TRK_FSYS_CYL_TRK
-> OP(13)
OP(69): ! FSYS BITNO_FSYS_BITNO
J=CYL TRK CONVERT(K,L,MM,N2,1,N1)
-> PRERR IF J#0
OPER(CNSL,"Cyl/Tk/Pg=".ITOS(L)."/".ITOS(MM)."/".ITOS(N2)." (dec)")
-> OUT
OP(70): ! CLOSE FE(P)
UNLESS 0<=N1<=TOP FE NO AND FES FOUND & (1<<N1)#0 THEN -> QQQ
-> SEVERAL CLOS
OP(71): ! DAP
DIRCOM == RECORD(SYSAD(DIRCOMKEY, -1))
S2 = "" IF S2 = "-1"
CYCLE J = 0, 1, 9
-> SW71(J) IF S1 = DAPCOM(J)
REPEAT
SW71(0): ! ?
OPER(CNSL, "BUSER0:".DIRCOM_DAP USER(0))
OPER(CNSL, "BUSER1:".DIRCOM_DAP USER(1))
OPER(CNSL, "IUSER: ".DIRCOM_DAP USER(2))
OPER(CNSL, "BATCHUSER0: ".DIRCOM_DAP BATCH USER(0))
OPER(CNSL, "BATCHUSER1: ".DIRCOM_DAP BATCH USER(1))
OPER(CNSL, " INTER ".ITOS(DIRCOM_DAP INTEGER(2)))
OPER(CNSL, "LO BATCH 0 ".ITOS(DIRCOM_DAP INTEGER(3)))
OPER(CNSL, "HI BATCH 0 ".ITOS(DIRCOM_DAP INTEGER(4)))
OPER(CNSL, "LO BATCH 1 ".ITOS(DIRCOM_DAP INTEGER(5)))
OPER(CNSL, "HI BATCH 1 ".ITOS(DIRCOM_DAP INTEGER(6)))
QQ = 0
QQ_DEST = (31<<16) ! 10 {enquire for queued users}
DOUT11I(QQ)
J = QQ_P1
J = 0 UNLESS 0 <= J <= 20
OPER(CNSL, "(CLAIMQ) ".ITOS(J)." LIMIT ".ITOS(DIRCOM_DAP INTEGER(1)))
-> OUT
!
SW71(7): ! USER
SW71(8):
SW71(9):
DIRCOM_DAP USER(J - 7) = S2 IF S2 = "" OR LENGTH(S2) = 6
-> OUT
SW71(*): ! Some integer
I = DAP DEFAULT(J)
DIRCOM_DAP INTEGER(J) = I IF S2 = "" OR STOI2(S2, I) = 0
-> OUT
OP(72): ! CLOSE ?
PENDG CLO TCPS=(¬(OPEN TO("", TCPPENDG, 1, 0)))
IF PENDG CLO FES ! PENDG CLO NODES ! PENDG CLO FSYS ! PENDG CLO TCPS#0 START
S3="Pending:"; S4="Partial close at "
CLO TCPS=(¬(OPEN TO("", TCPINITG, 1, 0)))
IF CLO FES ! CLO NODES ! CLO FSYS ! CLO TCPS#0 THEN S3="Initiated:"
OPER(CNSL,S3)
FINISH ELSE S4="Full close at "
{FSYSes}
CYCLE J=99,-1,0
IF BIT STATUS(PENDG FCLOSING,-1,J)#0 THEN C
OPER(CNSL,"Closure of Fsys: ".ITOS(J))
IF BIT STATUS(OPSTAT, -1, -1)#0 {i.e. if ANY Fsys is open} C
AND BIT STATUS(OPSTAT, -1, J)=0 {and fsys J is closed} C
THEN OPER(CNSL, "FSYS closed: ".ITOS(J))
REPEAT
{FEs}
CYCLE J=TOP FE NO,-1,0
IF PENDG CLO FES & (1<<J)#0 THEN OPER(CNSL, C
"Closure of FE no. ".ITOS(J))
IF FES CLOSED & (1<<J)#0 THEN OPER(CNSL, C
"FE no. ".ITOS(J)." closed")
REPEAT
{Nodes}
CYCLE J=31,-1,0
IF PENDG CLO NODES & (1<<J)#0 THEN OPER(CNSL, C
"Closure of NODE no. ".ITOS(J))
IF NODES CLOSED& (1<<J)#0 THEN OPER(CNSL, C
"NODE no. ".ITOS(J)." closed")
REPEAT
{TCPs}
J=OPEN TO("", 0, 6, CNSL); ! TCP closures
IF NEW CLOSE TIME < 0 C
THEN OPER(CNSL,"No close time set") C
ELSE OPER(CNSL,S4.ITOS(NEW CLOSE TIME))
-> OUT
OP(73): ! FE USECOUNT (_feno)
IF N1>=0 START
N2=N1; N3=N1
FINISH ELSE START
N2=0; N3=TOP FENO
FINISH
CYCLE J=N3,-1,N2
IF FES FOUND & (1<<J) # 0 THEN OPER(CNSL,"FE no. ". C
ITOS(J).", count=".ITOS(FE USE COUNT(J))) C
ELSE START
IF N1>=0 THEN -> QQQ
FINISH
REPEAT
-> OUT
OP(74):
EMPTY DVM
-> DONE
! OP(75): look near OP(30)
OP(76): !CLOSE TO <USERGROUP>
J = OPEN TO(S1, CLOSG, 0, 0)
-> PRERR
OP(77): ! FE_<username>
SHOW FES(S1,CNSL)
-> OUT
OP(78): ! OPEN FE(P)_feno
FES CLOSED=FES CLOSED & (¬(1<<N1))
-> DONE
OP(79): ! AUTOSLOAD ON/OFF
IF S1 = "ON" C
THEN COM_IPLDEV = (1<<31) ! COM_IPLDEV C
ELSE IF S1 = "OFF" C
THEN COM_IPLDEV = COM_IPLDEV << 1 >> 1 C
ELSE IF S1 = "?" START
S1 = "OFF"
S1 = "ON" IF COM_IPLDEV < 0
OPER(CNSL, S1)
FINISH ELSE -> QQQ
-> DONE
OP(80): ! CLOSE NODE
UNLESS 0<N1<=31 THEN -> QQQ {Node 0 is special, and we cannot close it
-> SEVERAL CLOS
OP(81): ! OPEN NODE
NODES CLOSED=NODES CLOSED & (¬(1<<N1))
-> DONE
OP(82): ! CLOSE TCP
IF LENGTH(S1) < 2 THEN -> QQQ
SEVERAL CLOS:
!
! We get to this label from:
!
! N1 N2
!
! OP(26) D/CLOSE 0
! D/CLOSE time
!
! OP(61) D/CLOSE FSYS f 0
! D/CLOSE FSYS f time
! D/CLOSE FSYS f -1
!
! OP(70) D/CLOSE FE(P) n 0
! D/CLOSE FE(P) n time
! D/CLOSE FE(P) n -1
!
! OP(80) D/CLOSE NODE n 0
! D/CLOSE NODE n time
! D/CLOSE NODE n -1
!
! OP(82) D/CLOSE TCP tcpname 0
! D/CLOSE TCP tcpname time
! D/CLOSE TCP tcpname -1
!
! If close time not given, then we just close the FSYS/FE/Node/ TCP
! to new logons (not a partial close).
N2 = NEW CLOSE TIME IF N2 = -1
-> QQQ UNLESS -1 <= N2 <= 2400
!
IF N2<0 START
IF ACT=26 THEN -> QQQ
IF ACT=61 THEN ACT=45 AND -> OP46 {same as D/CLOSE USERS fsys}
IF ACT=70 THEN FES CLOSED=FES CLOSED ! (1<<N1)
IF ACT=80 THEN NODES CLOSED=NODES CLOSED ! (1<<N1)
IF ACT=82 THEN J=OPEN TO(S1, TCPCLOSED, 0, 0) AND -> PRERR
-> DONE
FINISH
CLO TCPS=(¬(OPEN TO("", TCPINITG, 1, 0)))
IF CLO FES ! CLO FSYS ! CLO NODES ! CLO TCPS#0 OR 2<=AUTO STATE<=6 THEN -> QQQ
{can't allow any alterations after state goes from}
{"Pending" to "Initiated". }
N3=1; ! N3 is used as a set/unset marker for the actions on the
! bit arrays for FSYSes/FEs. (It is possible to withdraw a
! CLOSE FSYS/FE by saying
! D/CLOSEFE fe-no 0 or
! D/CLOSEFSYS fsys 0 or
! D/CLOSENODE node-no 0 or
! D/CLOSETCP tcpname 0
!
! Similarly D/CLOSE 0 withdraws all CLOSE FE/FSYS settings.
! But note that all this can be done only before the "pending"
! status changes to "definite", about 16 mins before the
! appointed time).
! Note also that Nodes(TCPs) are opened by saying D/OPEN NODE(TCP), and these
! commands are subject to fewer checks than the others. This is
! because they are intended to be used AFTER the partial close is
! complete and the node(TCP) becomes available again. It is not primar-
! ily intended for withdrawing a partial close.
IF N2>=0 START ; ! N2 is the time, hhmm, from the command.
IF N2=0 THEN N3=0 {withdrawing}
IF ACT=26 {D/CLOSE} OR ACT=45 {D/CLOSEUSERS} START
! D/CLOSE 0 or D/CLOSEUSERS 0: clear all settings
! D/CLOSE time, D/CLOSEUSERS time: also clear all settings
CLEAR ALL PARTIAL
FINISH ELSE IF N3#0 START
BEGIN {Also test that time begin set for partial close is at least 15 mins away}
STRING (3) HH,MM,SS
INTEGER H, M, NOW MINS 0000, MINS TO GO, CLOSE MINS 0000
TIME -> HH . (".") . MM . (".") . SS
NOW MINS 0000 = STOI(HH)*60 + STOI(MM)
H = N2 // 100
M = N2 - 100*H
CLOSE MINS 0000=H*60 + M
MINS TO GO=CLOSE MINS 0000 - NOW MINS 0000
IF MINS TO GO<-1 THEN MINS TO GO=MINS TO GO + 24*60
IF MINS TO GO < 15 THEN J=9 {Must give 15 mins} ELSE J=0
END {begin block}
IF J#0 THEN -> PRERR
FINISH
FINISH
IF ACT=61 THEN J=BIT STATUS(PENDG FCLOSING,N3,N1) AND PENDG CLO FSYS=N3
IF ACT=70 {D/CLOSE FE} START
IF N3=0 C
THEN PENDG CLO FES=PENDG CLO FES & (¬(1<<N1)) C
AND FES CLOSED=FES CLOSED & (¬(1<<N1)) {Note 1} C
ELSE PENDG CLO FES=PENDG CLO FES ! (1<<N1)
! Note 1 immediately above: This line is placed here to provide an
! emergency way of clearing bits in FES CLOSED. Normally this should
! get done at comms controller reply to Disconnect FE, but just in
! case this doesn't get done for any reason, the route for clearing
! a bit would be:
!
! D/CLOSEFE fe time followed by
! D/CLOSEFE fe 0
FINISH
IF ACT=80 {D/CLOSE NODE} START
IF N3=0 C
THEN PENDG CLO NODES=PENDG CLO NODES & (¬(1<<N1)) C
ELSE PENDG CLO NODES=PENDG CLO NODES ! (1<<N1)
FINISH
IF ACT=82 {D/CLOSE TCP} START
LENGTH(S1)=MAXTCPNAME IF LENGTH(S1)>MAXTCPNAME
J = 0; ! set
J = 3 IF N3 = 0; ! clear
J = OPEN TO(S1, TCPPENDG, J, 0)
FINISH
PENDG CLO TCPS=(¬(OPEN TO("", TCPPENDG, 1, 0)))
AUTO CLOSE(N2,27) IF N2>0 OR (N2 ! PENDG CLO FSYS ! PENDG CLO FES ! C
PENDG CLO NODES ! PENDG CLO TCPS)=0
POKE SPOOLR(ACT,N1,N3)
-> DONE
OP(83): ! OPEN TCP
-> QQQ IF LENGTH(S1) < 2
J=OPEN TO(S1, TCPCLOSED, 3, 0)
-> PRERR
OP(87): ! LS user key sno
! Special actions (perhaps a temporary D/ command, but a permanent
! mechanism will be required) to set an entry in the process list to
! tell DIRECT to pass a message to an existing process at LOGON.
!
N4 = N2 >> 4
N2 = N2 & 15
-> QQQ UNLESS 0<=N2<=2 AND N3>X'FFFF' AND N4 < 256
!
BEGIN
INTEGER C
RECORD (PROCDATF)NAME PROCE
J=37 {user not found}
C = LIVEHD
WHILE C # ENDLIST CYCLE
PROCE == PROCLIST(C)
IF PROCE_USER=S1 AND PROCE_INVOC = N4 START
PROCE_LOGKEY=N2
PROCE_LOGSNO=N3
J=0
EXIT
FINISH
C = PROCE_LINK
REPEAT
END {begin block}
-> PRERR
OP(88): ! Site
TYPE = -1
MSTATE = 12
PROMPT(CNSL, "Type: ")
-> POUT
CONTMSG(12):
TYPE = 0 IF S0 = "SUBSYS"
TYPE = 1 IF S0 = "STUDENT"
-> OP88A IF TYPE < 0
!
MSTATE = 13
PROMPT(CNSL, "File: ")
-> POUT
CONTMSG(13):
TYPE = -1 UNLESS S0 = "" OR FF(S0) = 1
OP88A:
DIRCOM == RECORD(SYSAD(DIRCOM KEY, -1))
DIRCOM_DEFAULT SUBSYS = S0 IF TYPE = 0
DIRCOM_DEFAULT STUDENT = S0 IF TYPE = 1
OPER(CNSL, " SUBSYS: " . DIRCOM_DEFAULT SUBSYS)
OPER(CNSL, " count: " . ITOS(DIRCOM_SUBSYS SITE COUNT))
OPER(CNSL, "STUDENT: " . DIRCOM_DEFAULT STUDENT)
OPER(CNSL, " count: " . ITOS(DIRCOM_STUDENT SITE COUNT))
-> OUT
OP(89): ! DAY
J = 1 + DDAYNUMBER
J = 1 + J - 7*(J//7)
OPER(CNSL, DAY(J) . "day")
-> OUT
OP(90): ! CLOSE PAD
ACT=82
-> op(82)
-> QQQ UNLESS LENGTH(S1) = 8
S1 = "0000" . S1 . "??"
ACT = 82 { pretend to be CLOSE TCP }
-> SEVERAL CLOS
OP(91): ! CLOSE TIME
-> QQQ UNLESS -1 <= N1 <= 2400
NEW CLOSE TIME = N1
-> DONE
OP(92): ! CHECK FSYS
-> QQQ UNLESS 0 <= N1 <= 99
J = CCK(N1, 1, P)
DOPER2("Fsys " . S1 . " " . ITOS(P) . "% full")
-> PRERR
OP(93): ! OPEN PAD
ACT=83
-> op(83)
-> QQQ UNLESS LENGTH(S1) = 8
S1 = "0000" . S1 . "??"
J = OPEN TO(S1, TCPCLOSED, 3, 0)
-> PRERR
END ; ! XOPER
!
!-----------------------------------------------------------------------
!
STRINGFN SPECIAL CONCAT(STRING (255) A, B)
RESULT = A . TOSTRING(LENGTH(B)) . B {and let's hope it's not too long: shouldn't be}
END ; ! SPECIAL CONCAT
!
!-----------------------------------------------------------------------
!
ROUTINE SANITARISE(STRINGNAME S)
INTEGER I
FOR I = 1, 1, LENGTH(S) CYCLE
CHARNO(S, I) = REC SEP ! 128 IF CHARNO(S, I) = REC SEP
REPEAT
END ; ! SANITARISE
!
!-----------------------------------------------------------------------
!
INTEGERFN CHECKSTART(STRING (255)USER, STRINGNAME PASS, STRING (63) ITADDR,
INTEGER IDENT, PROTOCOL)
!
! PASS is used to return an error message
!
INTEGER FSYSOPEN, FLAG, INDAD, SPECIALLYOPEN, FSYS, INVOC, FE NO, J
INTEGER SUPFSYS, SUPINDAD
BYTEINTEGERNAME PASSFAILS
INTEGER BASEFILE, NODE NO, CONSOLE, K, DT
LONGINTEGER LE
RECORD (HF)NAME NH, SUPH
STRING (MAXTCPNAME) TCPNAME
STRING (255)PASSWORD, FULL USER
CONSTINTEGER LIM = 100
PASSWORD = PASS
PASS = ""
!
FE NO = (IDENT>>16) & 255
{FEs}
IF FES CLOSED & (1<<FE NO) # 0 THEN RESULT = 111
SET ITADDR(ITADDR, NODE NO, CONSOLE, TCPNAME)
{Nodes}
IF NODES CLOSED & (1<<NODE NO)#0 THEN RESULT =112; ! Remember, if we want to introduce
! a new message, there is INFO to think of, as well as
! the user documentation.
{TCPs}
RESULT =113 IF OPEN TO(TCPNAME, TCPCLOSED, 1, 0)=0 {TCP closing}
FSYSOPEN = BIT STATUS(OPSTAT,-1, -1); ! YES if any open, else NO
FSYS = -1
FLAG = 105; ! Invalid user
FULL USER = USER
IF LENGTH(USER) > 6 THEN LENGTH(USER) = 6
IF LENGTH(USER) = 6 START
FLAG = 110; ! User not found
UCTRANSLATE(ADDR(USER)+1, 6)
J = HINDA(USER, FSYS, INDAD, 0)
IF J = 0 START
BASEFILE = 0
NH == RECORD(INDAD)
PASSFAILS == NH_PASSFAILS
LE = NH_DWSP
K = NH_DWSPK
BASEFILE = 1 UNLESS NH_BASEFILE = ""
SPECIALLYOPEN = NO
J = OPEN TO(USER, OPENG!CLOSG, 1, 0)
! result < 0 if specially CLOSED TO user
! = 0 (OK) if specially OPEN TO user
IF J < 0 THEN RESULT = 110 ELSE C
IF J = OK THEN SPECIALLYOPEN = YES
FSYSOPEN = BIT STATUS(OPSTAT,-1, FSYS)
IF FSYSOPEN = YES OR SPECIALLYOPEN = YES START
-> TRYSTART IF EQUSER(USER,PASSU)=YES AND PASSWORD=PASSW
RESULT = 103 IF PASSFAILS > LIM
!
IF NH_SURNAME = "#VIEWER" START
-> PASS FAIL IF BASEFILE = 1
-> PASS OK IF USER = "VIEWER"
-> PASS OK IF USER = "LIBRAR"
-> PASS OK IF USER = "HORTIH"
-> PASS OK IF USER = "IMPORT"
-> PASS OK IF USER = "DATALI"
-> PASS OK IF USER = "CROPHE"
-> PASS OK IF USER = "MINIUC"
-> PASS OK IF USER = "CROPHE"
-> PASS OK IF USER = "CROPHE"
-> PASS OK IF USER = "CROPHE"
FINISH
-> TRY START IF USER = "REMOTE"
-> TRY START IF USER = "PRINTE"
!
-> PASS OK IF ENCRYPT(0, PASSWORD, LE, K, DT) = 0
-> PASS FAIL IF BASEFILE = 0; ! default basefile
-> PASS FAIL UNLESS CHARNO(USER, 4) = 'U'; ! not a student
-> PASS FAIL IF NH_SUPERVISOR = ""; ! no supervisor
SUPFSYS = -1
FLAG = HINDA(NH_SUPERVISOR, SUPFSYS, SUPINDAD, 0)
IF FLAG = 0 START
SUPH == RECORD(SUPINDAD)
LE = SUPH_DWSP
K = SUPH_DWSPK
FLAG = ENCRYPT(0, PASSWORD, LE, K, DT)
FINISH
!
IF NH_OWNER # USER START
J = HINDA(USER, FSYS, INDAD, 0)
RESULT = 1000 + J UNLESS J = 0
NH == RECORD(INDAD)
PASSFAILS == NH_PASSFAILS
FINISH
!
-> PASS FAIL UNLESS FLAG = 0
PASS OK:
-> TRYSTART IF SPECIALLYOPEN = YES
FLAG = LISTMOD(USER, 0, 0)
-> TRYSTARTIF FLAG=0
RESULT =FLAG
PASS FAIL:
PASSFAILS = PASSFAILS+1 IF PASSFAILS <= LIM
DOPER2(USER." PASSWORD FAILURE") IF PASSFAILS&7=0
FINISH
FLAG = 103; ! INVALID PASSWORD
FINISH
FINISH
FLAG = 107 IF FSYSOPEN = NO; ! NO USER SERVICE
!
IF FLAG = 105 AND FULL USER -> ("INFO") START
FLAG = 98 {Resources Scarce} IF COM_RATION&255 > COM_RATION>>24
FINISH
!
RESULT = FLAG
TRYSTART:
FLAG = 0
! If exactly one interactive process aleady exists for USER, look to see if its
! PROCLIST entry specifies that a message is simply to be given to the
! existing process.
IF NH_IUSE=1 START
BEGIN
INTEGER C, J
RECORD (PARMF) P
RECORD (PROCDATF)NAME PROCE
STRING (255) TEMP
C = LIVEHD
WHILE C # ENDLIST CYCLE
PROCE == PROCLIST(C)
IF PROCE_USER=USER {%AND PROCE_REASON = INTER} AND PROCE_LOGKEY#0 AND PROCE_LOGSNO#0 START
! If reason for process wanting logon message is that it has lost its
! console due to a comms break (LOGKEY=1), then set the key zero so that no
! further logon gets the same treatment. If reason is that process
! has designated itself as a multi-console process (LOGKEY=2) then
! let the proess list entry stand, for further logons.
PROCE_LOGKEY=0 IF PROCE_LOGKEY=1
TEMP=SPECIAL CONCAT("", HTOS(COM_SECSFRMN, 8))
TEMP=SPECIAL CONCAT(TEMP, HTOS(IDENT, 8))
TEMP=SPECIAL CONCAT(TEMP, FULL USER)
TEMP=SPECIAL CONCAT(TEMP, PASSWORD)
TEMP=SPECIAL CONCAT(TEMP, ITADDR)
TEMP=SPECIAL CONCAT(TEMP, HTOS(PROTOCOL, 8))
SANITARISE(TEMP)
P_DEST=PROCE_LOGSNO
J=TXTMESS(PROCE_USER, P, 1 {sync}, PROCE_INVOC, LENGTH(TEMP)+1, ADDR(TEMP), PROCE_FSYS, 1 {sact=>PON AND CONTINUE})
IF J=0 THEN FLAG=114 {"Connected"} ELSE FLAG=107 {"No User Service"}
EXIT
FINISH
C = PROCE_LINK
REPEAT
END {begin block}
FINISH
RESULT = FLAG UNLESS FLAG = 0
! Else continue with a normal start-up
RESULT = STARTP(USER, PASS, ITADDR, INVOC, FSYS, 0, INTER, IDENT, -2, PROTOCOL)
END ; ! CHECKSTART
!
!-------------------------------------------------------------------------------
!
EXTERNALINTEGERFN COUNT PROCS IN(STRING (6) USERGROUP,
INTEGERNAME IPROCS)
INTEGER N,CUR,LI
RECORD (PROCDATF)NAME E
LI=0; ! COUNT OF INTERACTIVE PROCESSES
N=0
CUR=LIVEHD
WHILE CUR#ENDLIST CYCLE
E==PROCLIST(CUR)
IF E_REASON#BATCH AND E_PROCESS>TOPEXEC+2 START
IF EQUSER(E_USER,USERGROUP)#0 THEN N=N+1
LI=LI+1
FINISH
CUR=E_LINK
REPEAT
IPROCS=LI
RESULT =N
END ; ! COUNT PROCS IN
ROUTINESPEC INPUT MESSAGE FROM FEP(RECORD (PARMF)NAME P)
!-----------------------------------------------------------------------
EXTERNALROUTINE PROCESS1(INTEGER XA, XB)
! Params XA, XB are not used
! Process 1 Activities
! 19 Message from OPER in reply to prompt
! 20 Message from OPER
! 21 LOGLINK(1)
! 22 Log-on message from FEP
! 23 Process stopping
! 24 Start Batch job
! 25 FCHECK receives request for consistency check
! 26 Dummy (NO-OP)
! 27 For JOURNL, causes current logfile to be spooled
! 28 Reply from SPOOLR
! 29 Regular 57 sec kick, see AUTOCOMM("",0)
! 30 Autoclose
! 31 Print message in log, equiv to act 7, err msgs from PARSE COM
! 32 Used in DIRECTs closedown sequence
! 33 Reply to FE connect
! 34 Display VSNs
! 35 DIRECT receives FSYS CCK complete from FCHECK
! 36 NEWPAGE CHAR
! 37 FCHECK
! 38 LOGLINK(9)
! 39 10
! 40 11
! 41 spare, was used for IUPDATE and pre-emption
! 50-61, 62-73 for FEP this that and the other!
RECORDFORMAT BRQF(INTEGER DEST,SRCE,IDENT,BYTEINTEGER FSYS, C
STRING (11) SPOOLRFILE,STRING (6) SPARE)
RECORD (BRQF)NAME BATCHRQ
RECORDFORMAT SPOOF(INTEGER VSN,FSYS,STRING (6) USER,SPARE1, C
INTEGER IDENT,KINSTRS,STRING (31)JOBDOCFILE, STRING (15)JOBNAME, C
INTEGER PRIORITY, DECKS, DRIVES, OUTPUTLIMIT)
RECORD (SPOOF)NAME SPOOH
! PRIORITY IS A NUMBER IN THE RANGE 1 - 5
! 1 = VLOW
! 2 = LOW
! 3 = DEFAULT
! 4 = HIGH
! 5 = VHIGH
RECORD (PROCDATF)ARRAY PROCL(0:255); ! 64 bytes*256 procs = 14 kbytes.
INTEGER MAXPROCS, NSYS, BASE, CTODAY, CTIM, AD, PERCENT, K
INTEGER IDENT, REPLY DEST, INVOC
INTEGER DACT, I, J, FSYS, SEG, GAP, CCKFLAG
INTEGERNAME TIME ON DISC, DATE ON DISC
INTEGERARRAY A(0:99)
STRING (6)USER
STRING (11)SPOOLRFILE
STRING (42)S
RECORD (FHDRF)NAME FILEH
RECORD (DDTF)NAME DDT
RECORD (PARMF)P
SWITCH PR(0:73)
OWNSTRING (42) PROM=""
OWNINTEGER TIMES ENTERED = 0; ! count to avoid infinite loops
STRINGNAME SN
RECORD (DISCDATAF)DATA
! DO CONSISTENCY CHECK ONLY IF DIRVSN IS ZERO. THIS WAY WE CAN RESTART
! WITH A DIFFERENT DIRVSN, NOT DOING CONSISTENCY CHECK, IF THE
! CONSISTENCY CHECK SHOULD FAIL.
*MPSR_X'F840'; ! clear bits 5-7 in PSR which are left as ones
! by SIGNAL in case of restart-after-contingency
TIMES ENTERED = TIMES ENTERED + 1
IF TIMES ENTERED = 1 START
*STLN_I
PROC1 LNB = I; ! save for SIGNAL
FINISH ELSE START
DOPER2("DIRECT restarted")
DSTOP(98) IF TIMES ENTERED > 2
-> IN
FINISH
!
PERCENT = -1
CCKFLAG = 0
*LSS_(3)
*ST_J
J = J ! X'00000800'
*LSS_J
*ST_(3); ! IC INTS MASKED IN SSR
!
PROCLIST == ARRAY(ADDR(PROCL(0)), PROCLF)
IF PROCUSER = "FCHECK" START
! Use the record array as a temporary text "file" for the fcheck.
FILE1AD = ADDR(PROCL(0))
CYCINIT(FILE1AD, 64*255)
LOG ACTION = DT ! WRTOF
FINISH ELSE START
! Not FCHECK. Link up a mini process list.
CYCLE J = 0, 1, 7
PROCL(J) = 0
PROCL(J)_LINK = J + 1
REPEAT
PROCL(7)_LINK = ENDLIST
FREEHD == FREEHDI
LIVEHD == LIVEHDI
BACKHD == BACKHDI
FES FOUND == FES FOUNDI
FE USECOUNT == FE USECTI
!
FILE1AD = ADDR(PROCL(8))
CYCINIT(FILE1AD, 64*247)
LOG ACTION = DT ! LOG ! WRTOF
FINISH
!
GET AV FSYS2(1, NSYS, A)
!
IF PROCESS = 1 START
DOPER2(VSN)
DOPER2("Workbase X" . HTOS(WORKBASE, 3))
J = AUTOCOMM("", 4); ! say 'no autofile'
! formerly.. CONNECT CONTROL STREAMS(-1)
J = COM_MAXPROCS
J = 254 IF J > 254
COM_RATION = J << 24 ! J << 16; ! Set "scarcity" and "pre-empt-at" values to "maxusers"
IF COM_USERS = 1 AND DDVSN&3 = 0 START
J = FBASE2(COM_SUPLVN, ADDR(DATA))
AD = SYSAD(DATKEY, COM_SUPLVN)
TIME ON DISC == INTEGER(AD)
DATE ON DISC == INTEGER(AD+4)
! ALLOW 6 DAYS SINCE LAST CCK!
CTODAY = PACKDT
CTIM = CTODAY << 15 >> 15
CTODAY = CTODAY >> 17
J = 0
J = 65 UNLESS DATE ON DISC <= CTODAY <= DATE ON DISC+6
J = 65 IF DATE ON DISC = CTODAY AND CTIM < TIME ON DISC
DOPER2("DT SETTING ?") AND -> IN UNLESS J = 0
! Work out how many processes we can afford to start, at X'40' per process
! in the space between WORKBASE and the start of the file system (FBASE).
! Each process has 5 work files:
! local controller stack 4 pages
! director stack 51
! uinf 1
! director gla 4
! signal stack 4
! --
! 64
MAXPROCS=(DATA_START - WORKBASE)//64
BASE = WORKBASE ! (COM_SUPLVN<<24);! PUT FSYS NO IN
MAXPROCS = NSYS IF NSYS < MAXPROCS
!
! START MAXPROCS PROCESSES
I = X'200' ! DDVSN << 6 + SUPLVN S START
J = 0
WHILE J < MAXPROCS CYCLE
P = 0
P_DEST = X'30010'; ! start 'batch' process
STRING(ADDR(P_P1)) = "FCHECK"
P_P3 = BASE; ! LSTACK, 4 pages
P_P4 = I; ! same director
P_P5 = BASE + 4; ! DSTACK 52 pages
P_P6 = BASE + 56; ! DGLA 4 pages
DOUTI(P)
-> IN UNLESS P_P1 = 0
P_DEST = (COM_SYNC1DEST + P_P5) << 16 ! 37
DPONI(P)
J=J+1
BASE=BASE + 64
REPEAT
FCHECKPROCS=MAXPROCS
FINISH ELSE START ; ! finish fresh IPL and dirvsn 0
J = MAP XOP OWNS(8); ! get LOGMAP address and do mappings
IF J=0 THEN DOPER2("DIRECT restarted OK")
FINISH
KICK AT(-1,29,1,0); ! cancel any previous
KICK AT(57,29,EVERY,0); ! every 57 seconds on DACT 29
! finish process 1 else kick to keep DIRECK awake
! (cancel this in rt STOP FEPS)
FINISH ELSE KICK AT(57,26,EVERY,0)
!--------------------------------------------------------------------------
IN:
! ****************************WAIT HERE FOR THINGS TO HAPPEN**************
DPOFFI(P); ! SYNC1-TYPE
DACT=P_DEST&127
!TEMP - till SPOOLR leaves LP at head-of-form.
! GPC replies for NEWPAGE CHAR at closedown
IF DACT=3 OR DACT=5 OR DACT=2 THEN DACT=36; ! NEWPAGE CHAR
DACT=31 IF DACT=7
-> PR(DACT)
PR(*):
PREC("FUNNY MSG TO PROC 1 ", P, 0)
-> IN
PR(13): ! Check that closing discs have
! gone, else gone them. P_P1 has
! DDT_DLVN. Message was PONned from
! rt AUTO CLOSE.
FSYS=P_P1&255
J=DDT ENTRY(I, FSYS)
IF J=0 START
DDT==RECORD(I)
IF DDT_CONCOUNT#0 OR DDT_DLVN>=0 START
DDT_CONCOUNT=0
DDT_DLVN=(DDT_DLVN<<2>>2) ! (1<<31)
DOPER2("Disc ".ITOS(FSYS)." forced free")
FINISH
FINISH
-> IN
PR(18): ! Process start-up failure message - to be printed at terminal
! Activity is invoked from routine FAIL in DIRECTOR
LOGON REPLY(STRING(ADDR(P_P3)), PROCLIST((P_DEST>>8)&255)_USER,
P_P6, P_P2, PROCLIST((P_DEST>>8)&255)_PROTOCOL, "")
-> IN
PR(19): ! MESSAGE FROM OPER IN REPLY TO PROMPT
! SAVE UNTIL THERE'S A NEWLINE ON THE END.
SN == STRING(ADDR(P_P1))
PROM <- PROM . SN
-> IN UNLESS CHARNO(SN, LENGTH(SN)) = NL
S=PROM
LENGTH(S)=LENGTH(S)-1
PROM=""
XOPER(P_SRCE,S)
-> IN
PR(20): ! MESSAGE FROM OPER
S<-STRING(ADDR(P_P1))
XOPER(P_SRCE,S)
-> IN
PR(21): ! LOGFILE
J=LOGLINK(P,1)
-> IN
!----------------- Process stopping message to DIRECT --------------------------
PR(23): ! PROCESS STOPPING
USER<-STRING(ADDR(P_P3))
! P_P1 is Kinstructions used in session
! P_P2 is ISUFF
! P_P5 is REASON
! P_P6 is Pageturns used in session
IF USER#"FCHECK" THEN PROCESS STOPS(USER,P_P2,P_P5,P_P1,P_P6)
-> IN
PR(24): ! START-BATCH-JOB FROM SPOOLR
BATCHRQ==P
IDENT=BATCHRQ_IDENT
FSYS=BATCHRQ_FSYS
SPOOLRFILE <- BATCHRQ_SPOOLRFILE
S = "SPOOLR." . SPOOLRFILE
INVOC=0
SEG=0; GAP=0
J=DCONNECTI(S,FSYS,1,0,SEG,GAP)
IF J#0 START
DOPERR("SPLR BATCHFILE", 2, J); ! connect SPOOLR's batchfile fails
J=8
-> BREPLY
FINISH
SPOOH==RECORD(SEG<<18)
USER<-SPOOH_USER
J=DDISCONNECTI(S,FSYS,1)
WRSN("STARTB-DIS", J) UNLESS J = 0
J=STARTP(USER,SPOOLRFILE,"",INVOC,FSYS,0,BATCH,IDENT,-2,0)
UNLESS J = 0 START
WRS("STARTB " . USER . " " . S . " " . DERRS(J))
IF J > 100 THEN J = J - 100 ELSE J = 6
FINISH
BREPLY:
P_DEST=P_SRCE
P_P1=IDENT
P_P2=J; ! NB SPOOLR expects error flag to be in range 1-10
P_P3=INVOC
DPONI(P)
-> IN
!----------------- FCHECK receives request for CONSISTENCY CHECK ---------------
PR(25): ! CCK ON FSYS P_P1
REPLY DEST=P_SRCE
FSYS=P_P1
DSTOP(100) IF FSYS<0
SYMBOLS(57, '-')
NEWLINE
CCKFLAG = CCK(FSYS, 0, PERCENT); ! DO THE CCK
WRS("Fsys is " . ITOS(PERCENT) . "% full"); ! to get it into CCKMESS
S = "VOLUMS.CCKMESS"
J=DCREATEF(S,FSYS,256,32+17, LEAVE, SEG); ! ZERO THE FILE and cherish
IF J=0 OR J=16 START
IF J=0 START
J=DPERMISSIONI("VOLUMS","DIRECT","","CCKMESS",FSYS,1,7)
IF J#0 THEN DOPERR(S,3,J); ! CCKMESS permission fail
FINISH
SEG=0
GAP=0
J=DCONNECTI(S,FSYS,11,X'05F',SEG,GAP)
IF J=0 START
AD = SEG << 18
FILEH==RECORD(AD)
CYCINIT(AD, X'40000') UNLESS FILEH_TXTRELST=32 AND FILEH_MAXBYTES=X'40000'
COPY TO FILE(FILE1AD, AD)
FILEH_DATE = PACKDT
J = DDISCONNECTI(S, FSYS, 1)
FINISH ELSE DOPERR(S,2,J); ! connect VOLUMS.CCKMESS fails
FINISH ELSE DOPERR(S,1,J); ! create VOLUMS.CCKMESS fails
!
IF COM_IPLDEV < 0 START ; ! we are in 'auto' mode
IF CCKFLAG # 0 AND FSYS # COM_SUPLVN START
ADJUST DLVN BIT(FSYS, 1); ! make fsys unavailable again
CCKFLAG = 0
FINISH
FINISH
!
-> PR37
PR(26): ! DUMMY, FOR CONTROL STREAM CONNECTED REPLY, ELAPSED INT REPLY
! and SET UP DEST routine.
-> IN
PR(27): ! for JOURNL to cause current logfile to be spooled.
J=LOGLINK(P,4)
-> IN
PR(28): ! REPLIES FROM SPOOLR
DOPERR("XOP28 SPOOLR REPLY", 0, P_P1); ! TEMP - WE THINK SHOULD NOT OCCUR
-> IN
PR(29):
IF INITIAL DELAY > 0 START
INITIAL DELAY = INITIAL DELAY - 1
IF INITIAL DELAY = 0 START
J = BIT STATUS(OPSTAT, 1, -1) { open all fsys's }
J = AUTO COMM("", 3); ! connect the file if poss
WRSS("Auto-command file flag=", DERRS(J)) UNLESS J = 0
J = BIT STATUS(OPSTAT, 0, 100) { close imaginary fsys 100}
FINISH
FINISH
!
J=AUTO COMM("",0)
PR(30): ! RESERVED FOR AUTO-CLOSE
AUTO CLOSE(0,DACT)
-> IN
PR(31):
S <- STRING(ADDR(P_P1))
WRS(S)
-> IN
PR(32):
! TO CLOSEDOWN DIRECT,SEE PR(36)
KICKAT(-1, 29, 1, 0); !cancel regular kick on act29
DSTOP(100)
PR(33): ! formerly REPLY TO FE CONNECT. Now spare (Aug 81)
-> IN
PR(34):
DISPL:
DISPLAY VSNS
-> IN
!---------- DIRECT receives FSYS consistency check complete message from an FCHECK process ---------
PR(35): ! FSYS complete message from an FCHECK process
! This message requests another FSYS message for the FCHECK process
IF P_P1 >= 0 START ; ! this is the fsys, first time its -1
CCK FLAG = CCK FLAG ! P_P2
S = "Fsys "
S = S . " " IF P_P1 < 10
S = S . ITOS(P_P1) . " "
S = S . " " IF P_P3 < 10
S = S . ITOS(P_P3) . "% full"
DOPER2(S)
FINISH
!
IF NSYS > 0 START
NSYS = NSYS - 1
FSYS = A(NSYS)
FINISH ELSE START
FSYS = -1; ! Stop process message
FCHECKPROCS = FCHECKPROCS - 1
FINISH
!
REPLY DEST = P_SRCE ! 25; ! RH half of this word is already zero
P = 0
P_DEST = REPLY DEST
P_P1 = FSYS
DPONI(P)
!
-> IN UNLESS FCHECKPROCS = 0 = CCKFLAG; !------------------- CCK COMPLETE
!
! Chose DACT 2 or 8 in LOGLINK according to whether we want to
! go to a main logfile. If the call succeeds, we get an address
! to map the process list aray onto, so that it can be accessed
! by a subsequent invocation of DIRECT, should this one die for
! any reason.
!
WRS("CCK COMPLETE")
!
J = 8
J = 2 IF STOP LOGFILE = 0
!
J = MAP XOP OWNS(J)
CONNECT FE(-1) IF J=0
COPY TO FILE(FILE1AD, DIRLOGAD) UNLESS DIRLOGAD = 0
!
FILE FOR HOTTOP(0)
J = BROADMSG(""); ! To create VOLUMS.BROADCAST
!
WRSS("Director Version ", VSN)
CYCLE K = 0, 1, TOPEXEC
J=STARTP(EXEC(K),S,"",I,COM_SUPLVN,0,OPERC,0,-1,0)
DOPERR("START " . EXEC(K), 0, J) UNLESS J = 0; ! start fails
REPEAT
! XOPER(X'00320007', "NEWSTART REMOTE")
! XOPER(X'00320007', "NEWSTART PRINTE")
!
INITIAL DELAY = 2 IF BIT STATUS(OPSTAT, -1, 100) = 1 { fsys 100 open }
-> DISPL
PR(36):
-> IN IF NEWPAGE CHAR(P) = 0; ! keep NEWPAGECHAR going until it returns # result
DSTOP(100)
PR(37): ! Kick to request FSYSes
FSYS = -1; ! No FSYS result
PR37:
P = 0
P_DEST = (COM_SYNC1 DEST + 1)<<16 ! 35; ! get another FSYS from process 1
P_P1 = FSYS
P_P2 = CCKFLAG
P_P3 = PERCENT
DPONI(P)
-> IN
!
PR(38):
PR(39):
PR(40):
J = LOGLINK(P, DACT-29); ! TO DACTs 9, 10, 11 in LOGLINK
PR(41):
-> IN
!
! Note: DACTs 50 - 61 reserved for FE software (ITP)
! ditto + X29 ACTIVITY ADDON reserved for FE software (X29)
PR(FEP INPUT MESS):
PR(FEP INPUT MESS + X29 ACTIVITY ADDON):
INPUT MESSAGE FROM FEP(P)
-> IN
PR(FEP OUTPUT REPLY MESS):
PR(FEP OUTPUT REPLY MESS + X29 ACTIVITY ADDON):
WRS("Output message reply from FEP")
-> IN
PR(FEP INPUT CONNECT REPLY):
PR(FEP OUTPUT ENABLE REPLY):
PR(FEP INPUT CONNECT):
PR(FEP OUTPUT CONNECT REPLY):
PR(FEP INPUT ENABLE REPLY):
PR(FEP INPUT DISABLE):
PR(FEP INPUT DISABLE REPLY):
PR(FEP OUTPUT DISABLE REPLY):
PR(FEP INPUT DISCONNECT REPLY):
PR(FEP OUTPUT DISCONNECT REPLY):
PR(FEP INPUT CONNECT REPLY + X29 ACTIVITY ADDON):
PR(FEP OUTPUT ENABLE REPLY + X29 ACTIVITY ADDON):
PR(FEP INPUT CONNECT + X29 ACTIVITY ADDON):
PR(FEP OUTPUT CONNECT REPLY + X29 ACTIVITY ADDON):
PR(FEP INPUT ENABLE REPLY + X29 ACTIVITY ADDON):
PR(FEP INPUT DISABLE + X29 ACTIVITY ADDON):
PR(FEP INPUT DISABLE REPLY + X29 ACTIVITY ADDON):
PR(FEP OUTPUT DISABLE REPLY + X29 ACTIVITY ADDON):
PR(FEP INPUT DISCONNECT REPLY + X29 ACTIVITY ADDON):
PR(FEP OUTPUT DISCONNECT REPLY + X29 ACTIVITY ADDON):
OPEN FEP(P)
DISPLAY VSNS IF DACT = FEP INPUT CONNECT REPLY OR C
DACT = FEP INPUT DISCONNECT REPLY
-> IN
END ; ! PROCESS1
!-----------------------------------------------------------------------
ROUTINE FEP DOWN(INTEGER FE)
INTEGER I, PROTOCOL
RECORD (PARMF)P
FES FOUND = FES FOUND & (¬(1<<FE))
FEPS(FE)_AVAILABLE = NO
CYCLE PROTOCOL = ITP, 1, X29
P_DEST = DISABLE STREAM
P_SRCE = FE<<8!FEP OUTPUT REPLY MESS
P_P1 = FEPS(FE)_FEP DETAILS(PROTOCOL)_INPUT STREAM
P_P2 = ABORT
I = DPON3I("",P,0,0,PON AND CONTINUE)
P_DEST = DISABLE STREAM
P_SRCE = FE<<8!FEP OUTPUT REPLY MESS
P_P1 = FEPS(FE)_FEP DETAILS(PROTOCOL)_OUTPUT STREAM
P_P2 = ABORT
I = DPON3I("",P,0,0,PON AND CONTINUE)
P_DEST = DISCONNECT STREAM
P_SRCE = FE<<8!FEP OUTPUT REPLY MESS
P_P1 = FEPS(FE)_FEP DETAILS(PROTOCOL)_INPUT STREAM
I = DPON3I("",P,0,0,PON AND CONTINUE)
P_DEST = DISCONNECT STREAM
P_SRCE = FE<<8!FEP OUTPUT REPLY MESS
P_P1 = FEPS(FE)_FEP DETAILS(PROTOCOL)_OUTPUT STREAM
I = DPON3I("",P,0,0,PON AND CONTINUE)
REPEAT
DISPLAY VSNS
END ; ! FEP DOWN
!-----------------------------------------------------------------------
EXTERNALROUTINE STOP FEPS
INTEGER J
FOR J=0,1,TOP FE NO CYCLE
FEP DOWN(J) IF FES FOUND&(1<<J)#0
REPEAT
KICK AT(-1,26,1,0)
END ; ! STOP FEPS
!-----------------------------------------------------------------------
ROUTINE MODE DATA(STRING (255) DATA, INTEGER ID)
! This routine is called by rt INPUT MESSAGE FROM FEP when mode data
!arrives from a TCP. The user's UINF file is connected and the data
!moved to the UINF record.
INTEGER CUR,SEG,GAP,FSYS,J, PROTOCOL
STRING (18)FILE
RECORD (UINFF)NAME UINF
RECORD (PARMF) P
RECORD (PROCDATF)NAME PROCE
! We have to find the user for whom the data is destined from the
! process list.
CUR=LIVEHD
WHILE CUR#ENDLIST CYCLE
PROCE==PROCLIST(CUR)
!
! Check that the process has a GETMODE request outstanding.
IF ID=PROCE_ID START
IF PROCE_GETMODE=0 START
DOPER2("Unwanted mode data")
RETURN
FINISH ELSE PROCE_GETMODE=0
!
! Connect the UINF file, insert the data and disconnect.
FSYS=PROCE_FSYS
FILE=PROCE_USER . ".#UINFI".ITOS(PROCE_INVOC)
SEG=0; GAP=0
J=DCONNECTI(FILE,FSYS,8+2+1,0,SEG,GAP)
IF J#0 START
DOPER2("UINF connect fail ".ITOS(J))
FINISH ELSE START
UINF==RECORD(SEG<<18)
! Check data length against size of destination record.
PROTOCOL = UINF_PROTOCOL
J = 32 - PROTOCOL; ! SIZEOF(TESTR)
IF LENGTH(DATA)>J START
DOPER2("Mode data too long")
LENGTH(DATA)=J
FINISH
MOVE(LENGTH(DATA)+PROTOCOL,ADDR(DATA)+1-PROTOCOL,ADDR(UINF_TMODES))
J=DDISCONNECTI(FILE,FSYS,0)
IF J#0 THEN DOPER2("UINF discon fail ".ITOS(J))
FINISH
! Send message to user to allow him to run
P=0
P_DEST=(COM_SYNC2DEST+PROCE_PROCESS)<<16
DPONI(P)
RETURN
FINISH
CUR=PROCE_LINK
REPEAT
DOPER2("Spurious mode data")
END ; ! MODE DATA
!-----------------------------------------------------------------------
ROUTINE INPUT MESSAGE FROM FEP(RECORD (PARMF)NAME P)
INTEGER FE, CURSOR, NEWCURSOR, COUNT, ADD, BUFF LEN, I
INTEGER STRM ID, CODE, PROTOCOL, J
BYTEINTEGER TOTAL LENGTH, TYPE
STRING (255) NAME, PASS, ITADDR, REPLY, TEMP
RECORD (PROCDATF)NAME PJ
!
CONSTINTEGER TOPIMF = 6
SWITCH IMF(0 : TOPIMF)
!
!Messages between DIRECT and the FEP
!
!
!A. IN to DIRECT
! "fn"
! +-----+-----+-----+-----+-----+--- - - +---- - - -+--- - - -+
! 1. Logon | LEN | 1 | Stream no | ct) | ITADDR | ct) NAME | ct) PASS|
! +-----+-----+-----+-----+-----+--- - - +---- - - -+--- - - -+
!
! +-----+-----+-----+-----+-----+------------- - - -----------+
! 2. Mode data | LEN | 2 | Stream no | ct) | MODE DATA |
! +-----+-----+-----+-----+-----+------------- - - -----------+
!
! +-----+-----+-----+-----+-----+-----+------- - - - ---------+
! 3. Rejected | LEN | 3 | Stream no | FEP | ct) | rest of rejected msg |
! message | | | | flag| | |
! | | | | =fn | | |
! +-----+-----+-----+-----+-----+-----+------- - - - ---------+
!
! +-----+-----+-----+-----+-----+------------- - - - ---------+
! 4. Monitor | LEN | 4 | Spare | ct) | text (for MAINLOG) |
! message +-----+-----+-----+-----+-----+------------- - - - ---------+
!
! +-----+-----+-----+-----+-----+------------- - - - ---------+
! 5. Monitor | LEN | 5 | Spare | ct) | text (for OPER) |
! message +-----+-----+-----+-----+-----+------------- - - - ---------+
!
! +-----+-----+-----+-----+-----+------------- - - - ---------+
! 6. Kent use | LEN | 6 | Stream no | ct) | Kent-defined |
! +-----+-----+-----+-----+-----+------------- - - - ---------+
!
!
! B. Out from DIRECT
!
! +-----+-----+-----+-----+-----+-----+-----+----- - - - -----+
! 1. Logon | LEN | 1 | Stream no |0=FEP|reply| ct) | text |
! reply | | | |flag |code | | |
! +-----+-----+-----+-----+-----+-----+-----+----- - - - -----+
!
! +-----+-----+-----+-----+-----+-----+----------- - - - -----+
! 2 Setmode | LEN | 2 | Stream no |0=FEP| ct) | TCP commands |
! | | | |flag | | |
! +-----+-----+-----+-----+-----+-----+----------- - - - -----+
!
!Notes: LEN is the message length in total (i.e. including the LEN byte).
!
! ct) is the length of the text of bytes which follow(s) in the
! field, like in an IMP string.
!
! FEP flag: must be set zero on output from DIRECT. When received by
! Direct in "rejected message" message, the FEP flag field is
! the "fn" (function) field of the rejected message, to enable
! re-transmission.
!
!-------------------------------------------------------------------------------
!
!
ROUTINE CLEAN(STRINGNAME S)
INTEGER L, J, K, CH
L = LENGTH(S)
IF L > 0 START
K = 0 { count good characters }
CYCLE J = 1, 1, L
CH = CHARNO(S, J) & 127 { remove any top bit }
IF 32 <= CH <= 126 START
K = K + 1
CHARNO(S, K) = CH
FINISH
REPEAT
LENGTH(S) = K
FINISH
END ; ! CLEAN
!
ROUTINE GET(INTEGER ADR, LEN)
INTEGER L
L = BUFF LEN - CURSOR
IF LEN > L START ; ! have to do it in 2 bits
MOVE(L, ADD + CURSOR, ADR)
MOVE(LEN - L, ADD, ADR + L)
CURSOR = LEN - L
FINISH ELSE START
MOVE(LEN, ADD + CURSOR, ADR)
CURSOR = CURSOR + LEN
CURSOR = 0 IF CURSOR >= BUFF LEN
FINISH
COUNT = COUNT + LEN
END ; ! GET
FE = (P_DEST>>8)&255; !GET FEP
IF FEPS(FE)_AVAILABLE = YES START
IF P_P3 = X'01590000' START ; !FEP DOWN!
FEP DOWN(FE)
RETURN
FINISH
IF P_DEST&255 > FEP OUTPUT DISCONNECT REPLY THEN PROTOCOL = X29 ELSE PROTOCOL = ITP
ADD = FEPS(FE)_FEP DETAILS(PROTOCOL)_IN BUFF CON ADDR
CURSOR = FEPS(FE)_FEP DETAILS(PROTOCOL)_INPUT CURSOR
BUFF LEN = FEPS(FE)_FEP DETAILS(PROTOCOL)_IN BUFF LENGTH
NEW CURSOR = P_P2
WHILE CURSOR # NEW CURSOR CYCLE ;!UNTIL END OF MESSAGES
COUNT = 0; !CHECK ON LENGTH OF EACH MESSAGE
STRM ID = 0
GET(ADDR(TOTAL LENGTH),1); ! first byte
GET(ADDR(TYPE),1); ! second byte
GET(ADDR(STRM ID)+2,2); ! bytes 3 and 4
STRM ID = (14<<24) ! (FE<<16) ! STRM ID
TYPE = 0 UNLESS 0 < TYPE <= TOPIMF
-> IMF(TYPE)
IMF(0):
DOPER2("Invalid FEP input")
-> CHECK
IMF(1): ! interactive logon
GET(ADDR(ITADDR),1)
GET(ADDR(ITADDR)+1,LENGTH(ITADDR))
CLEAN(ITADDR)
GET(ADDR(NAME),1)
GET(ADDR(NAME)+1,LENGTH(NAME))
CLEAN(NAME)
UCTRANSLATE(ADDR(NAME)+1, LENGTH(NAME)) UNLESS NAME = ""
GET(ADDR(PASS),1)
GET(ADDR(PASS)+1,LENGTH(PASS))
CLEAN(PASS)
CODE=CHECKSTART(NAME, PASS, ITADDR, STRM ID, PROTOCOL)
LOGON REPLY(PASS, NAME, CODE, STRM ID, PROTOCOL, ITADDR) IF CODE # 0
-> CHECK
IMF(2): ! terminal characteristics (GETMODE)
! move data to user's area and give user a reply
GET(ADDR(TEMP),1)
GET(ADDR(TEMP)+1,LENGTH(TEMP))
MODE DATA(TEMP,STRM ID)
-> CHECK
IMF(3): ! rejected message from FEP
DOPER2("Rejected msg from FE")
! send it again - straight away
GET(ADDR(REPLY)+1,TOTAL LENGTH - 3)
LENGTH(REPLY)=TOTAL LENGTH - 3
TYPE=CHARNO(REPLY,1); ! get original request function for re-issue
REPLY=FROMSTRING(REPLY,2,LENGTH(REPLY))
OUTPUT MESSAGE TO FEP( FEPS, C
FE,1,ADDR(REPLY),LENGTH(REPLY)+1,STRM ID,PROTOCOL)
-> CHECK
IMF(4): ! message for main log
IMF(5): ! message for OPER
GET(ADDR(TEMP),1)
GET(ADDR(TEMP)+1,LENGTH(TEMP))
IF TYPE=4 START
I = LOG ACTION
LOG ACTION = LOG
WRS(TEMP)
LOG ACTION = I
FINISH ELSE DOPER2(TEMP)
-> CHECK
IMF(6): ! KENT special
GET(ADDR(NAME), 1)
GET(ADDR(NAME)+1, LENGTH(NAME))
!
J = LIVEHD
WHILE J # ENDLIST CYCLE
PJ == PROCLIST(J)
IF PJ_ID=STRMID AND PJ_REASON=INTER AND PJ_USER=NAME START
PJ_PREEMPT = 0
PJ_SESSEND = COM_SECSFRMN // 60 + 4
WRSS("Winding up session for ", NAME)
{exit ?}
FINISH
J = PJ_LINK
REPEAT
-> CHECK
CHECK:
WRS("INTERNAL LENGTH ?") AND EXIT C
UNLESS COUNT = TOTAL LENGTH + 1; ! first byte is count of bytes
! which follow
REPEAT
FEPS(FE)_FEP DETAILS(PROTOCOL)_INPUT CURSOR = NEW CURSOR
FINISH ELSE WRSN("MESSAGE FROM FE", FE)
END ; ! INPUT MESSAGE FROM FEP
ENDOFFILE