Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50512/cmd.b36
There are no other files named cmd.b36 in the archive.
MODULE CMD=
!Command processing routines for NETSPL
BEGIN
!
! Table of Contents
!
FORWARD ROUTINE
AUTO, !AUTO (file) command
NEXTCMD, !NEXT command
MJOBCMD, !The MJOB command
DATA_REQUESTS, !Set # of data requests
TDATA_REQUESTS, !Type # of data requests
TNEXT, !Tell what's next
TMJOB, !Type current value of MJOB
EATSPACES, !Read past spaces in a string
START,
TRANSFER,
GETRFS, !Get a remote filespec
GETARG, !See if we have an argument
HELP, !HELP command
WHAT, !The WHAT command
ABORT, !ABORT command
REQUE, !REQUE command
TELL, !TELL command
RESET, !RESET command
STOPN, !Stop a process by name
STOPP, !ABORT and RESET commands call this to do the dirty work
REQUEP, !REQUE calls this to signal an abort/reque to a process
FINDP, !Find a process (immediate inferior) by name
OFFLINE,!OFFLINE command (fast shutdown)
SHUTDOWN,!EXIT command
MESSAGE, !MESSAGE command
TMESSAGE, !type out current settings of above
FIND_REQUEST, !Find a process for KILL & REQUE commands
INIT_NODTBL; !Initialize NODTBL
!
! REQUIRE & LIBRARY files
!
REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';
LIBRARY 'NODTBL';
!
! Version
!
THIS_IS [CMD] VERSION [1] EDIT [15] DATE [8,OCT,79]
!
! Revision History
!
%(
[15] Fix TRANSFER command to set FILE$GODLY always
Make KILL & REQUE commands understand jobnames & seq #s
[14] Fix TRANSFER command for supercede,rename,delete
[13] Fix REQUE with no args not to multiply by 60.
Change printout of (TTY) message classes
[12] Make MJOB command work even if SPL isn't running
)%
!
! Macros
!
MACRO DUMPIN(FILBLK,ADDRESS,LEN)= !Input in dump mode
BEGIN
EXTERNAL ROUTINE INPUT;
LOCAL IOLIST: VECTOR[2]; !I/O list will be here
CLEARV(IOLIST);
IOLIST<LH>=-(LEN); !Length in left half
IOLIST<RH>=(ADDRESS)-1; !Address-1 in right half
FILBLK[FILE$I_IOLIST]=IOLIST;
INPUT(FILBLK)
END%;
MACRO TTIRDY(FOO)=MACHSKIP(%O'51',%O'14') %; !SKPINL
MACRO PREFIX='CMD'%; !For MSG macro
!
! Externals
!
EXTERNAL ROUTINE
CPROC,NEXTP,SIX12C,FPARSE,RDSIX,TTYIN,FBINI,NDBINI,ALLOC,FREE,GETCFG,
SAYRES,RELEASE,ERTEXT,RDSIXA,LKNODE,DOCMDS,HELLO,RCVACK,RDNUMA,WRNUMA,
XINPUT,XOUTPUT,XBIN,XBOUT,XMIT,RECV,DOAA,SNDCTL,SNDATT,SNDACC,
FALMJC,TABLEL,WRNUM,NETCMD,MOVEAZ,SPLQST,COPY,DOSWITCHES;
EXTERNAL
STFAL,
STSPL,
HIMSG: QSR$HI,
XFERTAB,
MLEVEL: BITVECTOR[8],
PTAB: VECTOR,
PTAB_LEN,
RXFERS,
INNETB,
MAXDRQ,
MSGTBL;
EXTERNAL RUN: REF PROCESS_BLOCK;
BUILTIN MACHOP,MACHSKIP;
!
! Literals
!
LITERAL
CR=13,
LF=10;
%IF %SWITCHES(DEBUG) %THEN
UNDECLARE %QUOTE F;
GLOBAL LITERAL P=SREG, F=FREG;
%FI
!
! Global Data
!
GLOBAL MJOBS; !# of jobs we are permitted to process at this time
GLOBAL ROUTINE AUTO(PTR,ARGS)=
!The AUTO command (take commands from a file)
!PTR: Address of byte pointer to command string
!ARGS: additional arguments from caller (not used)
BEGIN
LOCAL
BUFF, !Address of buffer to read in auto file
LEN, !Length of auto file in words
AUTOBLOCK: FILE_BLOCK;
FBINI(AUTOBLOCK); !Initialize AUTOfile block
AUTOBLOCK[FILE$GODLY]=1; !Get as much access as possible
AUTOBLOCK[FILE$I_NBUFF]=AUTOBLOCK[FILE$O_NBUFF]=0; !Dump mode,no buffers
AUTOBLOCK[FILE$DEVICE]=%SIXBIT'DSK'; !Set defaults
AUTOBLOCK[FILE$NAME]=%SIXBIT'NETSPL';
AUTOBLOCK[FILE$EXTENSION]=(%SIXBIT'ATO')^-18;
IF GETARG(.PTR) EQL 1 THEN FPARSE(AUTOBLOCK,.PTR); !Parse filespec if any
AUTOBLOCK[FILE$MODE]=_IODMP; !Read in dump mode
OPEN_R(AUTOBLOCK);
LEN=.AUTOBLOCK[FILE$SIZE];
BUFF=ALLOC(.LEN+1); !The extra word insures an ASCIZ string
DUMPIN(AUTOBLOCK,.BUFF,.LEN); !We will read it all in at once
RELEASE(AUTOBLOCK); !Do this now so nested autofiles work
NETCMD(CH$PTR(.BUFF)); !Execute it all
FREE(.BUFF,.LEN+1); !Give back the storage
END; !AUTO
GLOBAL ROUTINE NEXTCMD(PTR,ARGS)=
!The NEXT command
!PTR: Address of b.p. to command string
!ARGS: additional args from caller (ignored)
BEGIN
LOCAL SPLPB: REF PROCESS_BLOCK;
LOCAL NUM;
IF GETARG(.PTR) NEQ 1 THEN !He just wants to know what's next
BEGIN
IF .HIMSG[QSR$HI_NEXT] NEQ 0
THEN TNEXT() !So tell him
ELSE TYPE('No NEXT job has been specified',CRLF);
RETURN WIN
END;
NUM=RDNUMA(.PTR,10); !Get sequence #
IF .NUM GTR 9999 THEN WARNING(ARGCMD);
HIMSG[QSR$HI_NEXT]=.NUM;
SPLQST();
END; !NEXT
GLOBAL ROUTINE MJOBCMD(PTR,ARGS)=
!The MJOB command
!PTR: Address of b.p. to command string
!ARGS: additional args from caller (ignored)
BEGIN
LOCAL SPLPB: REF PROCESS_BLOCK;
LOCAL NUM;
IF GETARG(.PTR) NEQ 1 THEN !He just wants to know what MJOB is now
BEGIN
TMJOB(); !So tell him
RETURN WIN
END;
NUM=RDNUMA(.PTR,10); !Get sequence #
IF .NUM GTR MAX_NXFERS THEN WARNING(ARGCMD); !Too big
MJOBS=.NUM;
HIMSG[QSR$HI_MJOB]=.MJOBS-.RXFERS;
SPLQST(); !Tell SPL
FALMJC(); !Tell FAL also
END; !MJOBCMD
GLOBAL ROUTINE DATA_REQUESTS(PTR,ARGS)=
!The NEXT command
!PTR: Address of b.p. to command string
!ARGS: additional args from caller (ignored)
BEGIN
LOCAL NUM;
IF GETARG(.PTR) NEQ 1 THEN !He just wants to know what's next
BEGIN
TDATA_REQUESTS(); !So tell him
RETURN WIN
END;
NUM=RDNUMA(.PTR,10); !Get sequence #
IF (.NUM GTR .MAXDRQ) OR (.NUM EQL 0) THEN WARNING(ARGCMD);
INNETB=.NUM !Set # of input buffers & thus, # of data requests
END; !DATA_REQUESTS
GLOBAL ROUTINE TDATA_REQUESTS=
!Type out a message telling how many data requests get sent
BEGIN
EXTERNAL ROUTINE MOVEAZ,WRNUMA;
LOCAL PTR, STR:VECTOR[CH$ALLOCATION(80)];
PTR=CH$PTR(STR);
MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ'Number of data requests is '))),PTR);
WRNUMA(.INNETB,10,PTR);
CH$WCHAR_A(CR,PTR) ; CH$WCHAR_A(LF,PTR);CH$WCHAR_A(0,PTR); !add a CRLF
TSTR(STR)
END; !TNEXT
GLOBAL ROUTINE TNEXT=
!Type out a message telling what the next job is, if any
!Otherwise do nothing
BEGIN
EXTERNAL ROUTINE MOVEAZ,WRNUMA;
IF .HIMSG[QSR$HI_NEXT] NEQ 0 THEN
BEGIN
LOCAL PTR, STR:VECTOR[CH$ALLOCATION(80)];
PTR=CH$PTR(STR);
MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ'Next job is (sequence #) '))),PTR);
WRNUMA(.HIMSG[QSR$HI_NEXT],10,PTR);
CH$WCHAR_A(CR,PTR) ; CH$WCHAR_A(LF,PTR);CH$WCHAR_A(0,PTR); !add a CRLF
TSTR(STR)
END;
END; !TNEXT
GLOBAL ROUTINE TMJOB=
!Type out the # of jobs we will attempt simultaneously
BEGIN
LOCAL PTR, STR: VECTOR[CH$ALLOCATION(80)];
PTR=CH$PTR(STR);
MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ'MJOB = '))),PTR);
WRNUMA(.MJOBS,10,PTR);
CH$WCHAR_A(CR,PTR);CH$WCHAR_A(LF,PTR);CH$WCHAR_A(0,PTR); !CRLF , ASCIZ
TSTR(STR);
END; !TMJOB
GLOBAL ROUTINE EATSPACES(PTR)=
!Routine to eat spaces and tabs
!PTR: ADDRESS of byte pointer, returned pointing to first non-space
!RETURNS: first non-space character
BEGIN
REGISTER V;
DO BEGIN
V=CH$RCHAR(..PTR);
SELECTONE .V OF SET
[%O'40',%O'11']: CH$RCHAR_A(.PTR);
[OTHERWISE]: RETURN .V
TES
END WHILE 1
END; !EATSPACES
GLOBAL ROUTINE START(PTR,CMD)=
!START command
!PTR: address of byte pointer
!CMD: entry in command table
BEGIN
LOCAL V: BITVECTOR[16];
EXTERNAL FAL,STFAL;
EXTERNAL SPL,STSPL;
IF GETARG(.PTR) THEN
BEGIN
EXTERNAL ROUTINE DOCMDS;
EXTERNAL STTAB;
V=DOCMDS(STTAB,.PTR,%C',',%REF(0));
IF .V GTR 1^16 THEN WARNING(.V);
END
ELSE BEGIN
V=-1; !Start everything
END;
IF .V[STFAL] THEN
BEGIN
IF FINDP(PNAME(FAL)) EQL 0
THEN FORK(FAL) !Start FAL
ELSE TYPE('[NTLCMD FAL is already START''ed]',CRLF)
END;
IF .V[STSPL] THEN
BEGIN
IF FINDP(PNAME(SPL)) EQL 0
THEN FORK(SPL) !Start SPL
ELSE TYPE('[NTLCMD SPL is already START''ed]',CRLF)
END;
END; !START
GLOBAL ROUTINE TRANSFER(PTR,CMD)=
!Transfer command.
!PTR: ADDRESS of byte pointer
!CMD: Command table entry for this command
BEGIN
LOCAL NB: REF NDB,
FB: REF FILE_BLOCK,
IB: REF INT_BLOCK;
EXTERNAL ROUTINE LOCJOB,ALLOC;
BIND ACCOMP_CMD=PLIT(CHAR8(DAP_ACM,0,ACM_CMD));
BIND ACCOMP_CMD_LEN=3;
LOCAL FILSPC: VECTOR[CH$ALLOCATION(133)];
LOCAL FILREN: VECTOR[CH$ALLOCATION(133)];
LOCAL COMMAND: VECTOR[CH$ALLOCATION(133)];
LOCAL RPTR;
LOCAL COM: BITVECTOR[16],
CTLFUN;
LABEL CMDBLOCK;
EXTD(CPROC,NEXTP,FBINI,INTINI,NDBINI,FILOP,LINK,SNDATT,XMTMSG,TABLEL,XOUTPUT);
EXTERNAL CFGMSG,CFGLEN;
NB=ALLOC(NDB_LEN); !Allocate an NDB
FB=ALLOC(FB_LEN); !and a file block
NDBINI(.NB);
NB[NDB$MASTER]=1;
FBINI(.FB); FB[FILE$GODLY]=1; !Always use our privs
FB[FILE$MODE]=_IOIMG; !!ONLY IMAGE MODE FOR NOW
FB[FILE$ALIAS]=XWD(1,2); !OPR did it
NB[NDB$REQUESTOR]='[1,2]'; !This only works because it's 5 chars
NB[NDB$FB]=.FB;
RPTR=CH$PTR(NB[NDB$REMOTEFILE]);
COM=0;
IF GETARG(.PTR) EQL 1 THEN
BEGIN
LOCAL TPTR;
UNDECLARE %QUOTE N;
LOCAL N;
!Try RENAME case first, since the parse is more general
N=0;
TPTR=..PTR;
N=RDSIXA(TPTR); !Look for nodeid
IF CH$RCHAR_A(TPTR) EQL %C':'
AND CH$RCHAR_A(TPTR) EQL %C':'
THEN NB[NDB$NODEID]=.N
ELSE (TPTR=..PTR;N=0); !Guessed wrong
COM=(GETRFS(CH$PTR(NB[NDB$REMRENAME]),TPTR));
IF CH$RCHAR_A(TPTR) EQL %C'=' THEN
BEGIN !Another filespec coming....
LOCAL TTPTR;
LOCAL NN;
TTPTR=.TPTR;
NN=RDSIXA(TTPTR); !May be nodeid::
IF CH$RCHAR_A(TTPTR) EQL %C':'
AND CH$RCHAR_A(TTPTR) EQL %C':'
THEN BEGIN !It was a nodeid::
TPTR=.TTPTR; !Remote filespec starts after this
IF .N EQL 0 !Any nodeid so far?
THEN NB[NDB$NODEID]=.NN !This is the only one, use it
ELSE BEGIN !Nodeids on both filespecs
IF .N NEQ .NN THEN WARNING(ARGCMD);
!Rename: 2 different systems
END;
END;
IF .NB[NDB$NODEID] EQL 0 THEN WARNING(ARGCMD);
!We Must have a nodeid from somewhere!!
COM=(.COM OR GETRFS(CH$PTR(NB[NDB$REMOTEFILE]),TPTR));
.PTR=.TPTR;
IF .COM[ACC$RENAME] EQL 0 THEN !It wasn't RENAME
BEGIN
EX[NB[NDB$FOP],FB$SUP]=1; !Always try to supercede
IF .N NEQ 0
THEN BEGIN !Remote came first
FPARSE(.FB,%REF(CH$PTR(NB[NDB$REMOTEFILE])));!Get local filespec
COPY(NB[NDB$REMRENAME],NB[NDB$REMOTEFILE],
CH$ALLOCATION(129)); !put the real remote filespec in place
IF .COM EQL 0 THEN COM[ACC$CREATE]=1; !Assume SEND
END
ELSE BEGIN
FPARSE(.FB,%REF(CH$PTR(NB[NDB$REMRENAME]))); !Get local filespec
IF .COM EQL 0 THEN COM[ACC$OPEN]=1; !Assume RETREIVE
END;
END
END
ELSE COPY(NB[NDB$REMRENAME],NB[NDB$REMOTEFILE],CH$ALLOCATION(129));
!Probably DELETE, so get file name into correct field
INCR I FROM ACC$OPEN TO ACC$EXE DO
BEGIN
IF .COM EQL 1^(.I) THEN
BEGIN
NB[NDB$ACCFUNC]=.I;
EXITLOOP;
END
END;
IF .NB[NDB$ACCFUNC] EQL 0 THEN WARNING(ARGCMD);
RUN[P$NDB]=0; !We just gave our NDB away
FORK(LOCJOB,.NB); !Create a new process to do it
END;
END;
GLOBAL ROUTINE GETRFS(RPTR,PTR)=
!Get a remote filespec from a command line, processing switches along the way
!RPTR: byte pointer to store remote filespec
!PTR: address of byte pointer to command
!Returns: value of switches, if any
BEGIN
EXTERNAL ROUTINE DOSWITCHES;
EXTERNAL XFERTAB;
REGISTER
C;
DO BEGIN
IF (C=CH$RCHAR(..PTR)) EQL %C'/'
THEN RETURN DOSWITCHES(XFERTAB,.PTR,0)
ELSE IF (.C EQL 0) OR (.C EQL %C'=') THEN RETURN; !Done
CH$RCHAR_A(.PTR); !bump pointer
CH$WCHAR_A(.C,RPTR); !Copy remote fsp
END WHILE 1;
END; !GETRFS
GLOBAL ROUTINE GETARG(PTR)=
!Check for the presence of an argument to a command
!PTR: Address of byte pointer, returned pointing to argument if any
!RETURNS: 1 if alphanumeric begins argument, 0 if no argument
! 3 if argument is a switch, 2 otherwise
BEGIN
SELECT EATSPACES(.PTR) OF SET
[%C';',%O'12',%O'15',%O'33',0]: RETURN 0; !End of this command
[%C'/']: RETURN 3; !A switch
[%C'A' TO %C'Z',%C'A'+32 TO %C'Z'+32,%C'0' TO %C'9']: RETURN 1;
[OTHERWISE]: RETURN 2; !Something wierd
TES
END; !GETARG
GLOBAL ROUTINE HELP(PTR,ARGS)=
!The HELP command
!PTR: Address of byte pointer to command string
!ARGS: additional args (ignored)
BEGIN
GLOBAL BIND HELPTXT=UPLIT(%ASCIZ %STRING(
'NETSPL commands are: AUTO, CURRENT, EXIT, HELP, KILL, LOG, MJOB',CRLF,
'MESSAGE, NEXT, OFFLINE, RESET, REQUE, SET, START, TELL',CRLF
));
IF GETARG(.PTR) THEN
DO BEGIN
LOCAL NODEID;
LOCAL NODE: REF NODTBL_ENTRY;
NODEID=RDSIXA(.PTR);
IF CH$RCHAR(..PTR) EQL %C':' THEN
BEGIN
IF CH$A_RCHAR(.PTR) EQL %C':' THEN CH$RCHAR_A(.PTR);
END;
IF (NODE=LKNODE(.NODEID)) EQL 0 THEN (WARNING(FILUNN);RETURN FILUNN);
TSTR(NODE[NOD$HELP]);TYPE(CRLF)
END WHILE EATSPACES(.PTR) EQL %C','
ELSE TSTR(HELPTXT);
END; !HELP
GLOBAL ROUTINE WHAT(PTR,CMD)=
!The "WHAT" Command
!PTR: Address of Byte Pointer to command string
!CMD: Pointer to entry in command table that matched (ignored)
BEGIN
EXTERNAL ROUTINE
TPROC, !Display a process
TXFER, !Display a file transfer
RDSIXA; !Read a SIXBIT word
IF GETARG(.PTR) THEN
BEGIN
LOCAL ARG;
ARG=RDSIXA(.PTR);
IF CH$RCHAR(..PTR) EQL %C':' THEN
BEGIN !We are looking for an NDB to print out
IF CH$A_RCHAR(.PTR) EQL %C':' THEN CH$RCHAR_A(.PTR);
!Eat second colon if it was there
INCR I FROM 0 TO 15 DO
BEGIN
EXTERNAL FBTBL: VECTOR;
IF .FBTBL[.I] NEQ 0 THEN
BEGIN
BIND TFB=.FBTBL[.I]: NDB;
IF .TFB[FILE$PF_NODE_A] THEN
BEGIN
IF .TFB[NDB$NODEID] EQL .ARG THEN
TXFER(TFB)
END
END
END
END
ELSE BEGIN !We are looking for a process
LOCAL T: REF PROCESS_BLOCK;
EXTERNAL RUN: REF PROCESS_BLOCK;
IF .RUN[P$NAME] EQL .ARG THEN TPROC(.RUN,0);
!Do us if we match
T=.RUN[P$INFERIORS]; !Point to list of inferior processes
WHILE .T NEQ 0 DO
BEGIN
IF .T[P$NAME] EQL .ARG THEN TPROC(.T,0);
!Display if if it matches
T=.T[P$LINK] !Walk down the linked list
END
END
END
ELSE BEGIN
EXTERNAL CMDPBLOCK: PROCESS_BLOCK;
TPROC(CMDPBLOCK,0)
END
END; !WHAT
GLOBAL ROUTINE ABORT(PTR,ARGS)=
!ABORT command comes here
!PTR: Address of b.p. to command string
!ARGS: additional args (ignored)
BEGIN
ROUTINE ABORT_JOB(PB,PTR)=STOPP(.PB); !Just kill whatever we find
IF FIND_REQUEST(.PTR,ABORT_JOB) EQL 0 THEN WRN('No jobs cancelled');
END; !ABORT
GLOBAL ROUTINE REQUE(PTR,ARGS)=
!REQUE command comes here
!PTR: Address of b.p. to command string
!ARGS: additional args (ignored)
BEGIN
ROUTINE REQUE_AFTER(PB,PTR)=
BEGIN
MAP PB: REF PROCESS_BLOCK;
BIND NB=.PB[P$NDB]: NDB;
IF GETARG(.PTR) EQL 1
THEN BEGIN
NB[NDB$REQUE]=RDNUMA(.PTR,10);
!# of minutes for /AFTER
IF CH$RCHAR_A(.PTR) EQL %C':' !hh:mm
THEN NB[NDB$REQUE]=(.NB[NDB$REQUE]*60) + RDNUMA(.PTR,10);
END;
REQUEP(.PB);
END;
IF FIND_REQUEST(.PTR,REQUE_AFTER) EQL 0 THEN WRN('No jobs requeued');
END; !REQUE
GLOBAL ROUTINE TELL(PTR,ARGS)=
!TELL command. (does nothing but eat characters until ";" or end of string
!PTR: addr of b.p to cmd string
!ARGS: ignored
BEGIN
EXTERNAL LOGBLK: FILE_BLOCK;
IF .LOGBLK[FILE$NAME] EQL 0
THEN WRN('No log file is open');
WHILE 1 DO
SELECT CH$RCHAR(..PTR) OF SET
[0,%C';']: RETURN WIN;
[OTHERWISE]: CH$RCHAR_A(.PTR); !Eat character
TES
END; !TELL
GLOBAL ROUTINE RESET(PTR,ARGS)=
!RESET command comes here
!PTR: Address of b.p to command string
!ARGS: additional args (ignored)
BEGIN
LOCAL V: BITVECTOR[16];
EXTERNAL STTAB; !Table of processes that can be STARTed or RESET
IF (GETARG(.PTR)) EQL 1 THEN
BEGIN
V=DOCMDS(STTAB,.PTR,%C',',%REF(0)); !Reset whatever we have to
IF .V GTR 1^16 THEN WARNING(.V);
END
ELSE V=-1; !Reset everything
IF .V[STFAL] THEN
BEGIN
IF STOPN(%SIXBIT'FAL') EQL 0 THEN
WRN('FAL is not running');
END;
IF .V[STSPL] THEN
BEGIN
IF STOPN(%SIXBIT'SPL') EQL 0 THEN
WRN('SPL is not running')
END;
END; !RESET
GLOBAL ROUTINE STOPN(FORKNAME)=
!Stop a process whose name is FORKNAME (must be an immediate inferior)
BEGIN
LOCAL T: REF PROCESS_BLOCK;
IF (T=FINDP(.FORKNAME)) NEQ 0 THEN
BEGIN
(T[P$NAME])<12,6>=%C'*'-%C' '; !Change "FAL" to "FAL*", etc.
T[P$DISPLAY]=SAYRES; !Say "pending reset" on WHAT cmd
STOPP(.T);
!Kill it if we found it
RETURN WIN !We are successful
END;
RETURN 0; !Couldn't find it
END; !STOPN
GLOBAL ROUTINE FINDP(FORKNAME)=
!Find a process whose name is FORKNAME (must be an immediate inferior)
BEGIN
EXTERNAL RUN: REF PROCESS_BLOCK;
LOCAL T: REF PROCESS_BLOCK;
T=.RUN[P$INFERIORS]; !Start of linked list
WHILE .T NEQ 0 DO
BEGIN
IF .T[P$NAME] EQL .FORKNAME THEN
BEGIN
RETURN .T !Found it
END;
T=.T[P$LINK]; !Try again
END;
END; !FINDP
GLOBAL ROUTINE STOPP(AFORK)=
!Stop the process whose process block is at AFORK
!AFORK: process block of process to stop
BEGIN
OWN OPRABO_BLOCK:INT_BLOCK INITIAL(REP 5 OF (0),1,OPRABO^3+SS$_ERROR);
!Interrupt block
!This is not as un-re-entrant as it looks. If the block is active when
!the routine gets invoked, it will be copied into free storage, which will
!be freed when the destination process gets it
NOINTS(( FSIGNL(.AFORK,OPRABO_BLOCK) ))
END; !STOPP
GLOBAL ROUTINE REQUEP(AFORK)=
!Stop the process whose process block is at AFORK
!causing it to REQUE whatever it was doing
!AFORK: process block of process to stop
BEGIN
OWN OPRDEF_BLOCK:INT_BLOCK INITIAL(REP 5 OF (0),1,OPRDEF^3+SS$_ERROR);
!Interrupt block
!This is not as un-re-entrant as it looks. If the block is active when
!the routine gets invoked, it will be copied into free storage, which will
!be freed when the destination process gets it
NOINTS(( FSIGNL(.AFORK,OPRDEF_BLOCK) ))
END; !STOPP
GLOBAL ROUTINE OFFLINE(PTR,ARGS)=
!OFFLINE command. Shut down everything NOW
!PTR: Address of b.p to command string
!ARGS: Additional arguments (ignored)
BEGIN
EXTERNAL FBTBL: VECTOR;
INCR I FROM 1 TO 15 DO
BEGIN
BIND NB=.FBTBL[.I]: NDB;
IF .N[PF_NODE_A] THEN BEGIN
BIND PB=.BLOCK[.N[IB],INT$PROCESS]: PROCESS_BLOCK;
!Find the owner of the NDB
NB[NDB$EQ]=0; !Don't reque at all
IF .PB[P$NAME] NEQ %SIXBIT'FAL'
THEN REQUEP(PB); !Kill it
END
END;
SHUTDOWN(.PTR,.ARGS) !Now go away
END; !OFFLINE
GLOBAL ROUTINE SHUTDOWN(PTR,ARGS)=
!Shut down NETSPL
!PTR: Address of b.p to command string
!ARGS: additional args (ignored)
BEGIN
EXTERNAL ROUTINE
TTYIN,
NETCMD,
STOP,
WAIT;
EXTERNAL RUN: REF PROCESS_BLOCK;
STOPN(%SIXBIT'FAL');
STOPN(%SIXBIT'SPL');
WHILE .RUN[P$INFERIORS] NEQ 0
DO BEGIN !Wait for them to go away
LOCAL TTIBUF: VECTOR[CH$ALLOCATION(133)],
TTIPTR;
CLEARV(TTIBUF); !Zero the buffer to start
TTIPTR=CH$PTR(TTIBUF); !Init pointer
IF TTIRDY()
THEN BEGIN
TTYIN(.TTIPTR,132);!Get a command or something
NETCMD(.TTIPTR); !Process the commands
END
ELSE WAIT(0); !Wait for whatever happens
END;
STOP() !HALTF,MONRT., or what-have-you
END;
%(
GLOBAL ROUTINE MSGLVL(PTR,ARGS)=
!Set message level
!PTR: Address of byte pointer to command string
!ARGS: Additional arguments (ignored)
BEGIN
EXTERNAL ROUTINE RDNUMA,RDATOM;
EXTERNAL MLEVEL;
LOCAL VAL;
LOCAL MPTR,
TTPTR,
TPTR;
CASE GETARG(.PTR) FROM 0 TO 1 OF SET
[0]: (TYPE('Message level is: ');TSTR(MLEVEL);TYPE(CRLF);RETURN);
[1]: ;
[OUTRANGE]: WARNING(ARGCMD);
TES;
MPTR=CH$PTR(MLEVEL);
TTPTR=(TPTR=..PTR); !Copy our pointer
!Leading zeroes may or may not be present so eat them if they are
WHILE CH$RCHAR(.TPTR) EQL %C'0' DO CH$RCHAR_A(TPTR);
!check the range
SELECT RDNUMA(TTPTR,10) OF SET
[0 TO 999]:;
[0 TO 99]: CH$WCHAR_A(%C'0',MPTR);
[0 TO 9]: CH$WCHAR_A(%C'0',MPTR);
[0]: CH$WCHAR_A(%C'0',MPTR);
[OTHERWISE]: WARNING(RNGCMD);
TES;
INCR I FROM 1 TO 7 DO !Only write at most 7 characters
BEGIN
LOCAL C;
CH$WCHAR_A((C=CH$RCHAR_A(.PTR)),MPTR);
IF .C EQL 0 THEN EXITLOOP;
END;
END; !MSGLVL
)%
GLOBAL ROUTINE MESSAGE(PTR,ARGS)=
!The "MESSAGE" command (set what kinds of messages get typed)
!PTR: addr of b.p. to command string
!ARGS: additional args (ignored, must be present)
BEGIN
EXTERNAL MLEVEL: BLOCK[1] FIELD(MLEVEL_FIELDS);
SELECT GETARG(.PTR) OF SET
[0]: TMESSAGE(); !Say what it is
[1]: BEGIN
LOCAL V: BLOCK[1] FIELD(MLEVEL_FIELDS);
V=DOCMDS(MSGTBL,.PTR,%C' ',0);
IF .V GTR 1^16 THEN WARNING(.V); !Bad keyword?
IF .V THEN MLEVEL[MLEVEL$ALL]=-1; !ALL
IF (.V AND %O'400') NEQ 0 THEN MLEVEL=0; !NONE
MLEVEL=(.MLEVEL OR .V) AND (NOT .V^-8) AND %O'377';
!Turn on all the YES bits and turn off all the NO bits
END;
[OTHERWISE]: WARNING(ARGCMD);
TES;
END; !MESSAGE
GLOBAL ROUTINE TMESSAGE=
!Type out the current message flag settings
BEGIN
TYPE('MESSAGE: ');
IFMSG(LCD,(TYPE('CONNECT ')));
IFMSG(LJOB,(TYPE('SPL ')));
IFMSG(RJOB,(TYPE('FAL ')));
IFMSG(WARN,(TYPE('WARN ')));
IFMSG(LJERR,(TYPE('ERROR ')));
IFMSG(DEBUG,(TYPE('DEBUG')));
IFNOTMSG(ANY,(TYPE('NONE')));
TYPE(CRLF);
END; !TMESSAGE
GLOBAL ROUTINE FIND_REQUEST(PTR,DO_TO_IT)=
!Routine to process NODEID::JOBNAME/SEQ:nnn in KILL & REQUE cmds
!
!Formal Parameters
!
!PTR: Addr of char pointer to rest of cmd line
!DO_TO_IT: Routine to call for each request found
! called: foo(Process_block_addr,Cmd_char_ptr_addr)
!
!Returns
!
!1 if any requests matched, 0 if not.
!
BEGIN
IF GETARG(.PTR) THEN
BEGIN
LOCAL NODEID,
JOBNAME,
SEQ,
FOUNDONE; !Remember if we found anything
CLEARV(FOUNDONE,JOBNAME,SEQ,NODEID);
JOBNAME=RDSIXA(.PTR); !Get the job to zap
IF CH$RCHAR(..PTR) EQL %C':'
THEN BEGIN !should be a nodeid
IF CH$A_RCHAR(.PTR) NEQ %C':' THEN WARNING(ARGCMD);
NODEID=.JOBNAME; !This is a node id
JOBNAME=RDSIXA(.PTR); !a job name now, maybe?
END;
IF CH$RCHAR(..PTR) EQL %C'/'
THEN BEGIN
SELECT CH$A_RCHAR(.PTR) OF SET
[ALWAYS]: RDSIXA(.PTR); !Eat the rest, always
[%C 'S']:
BEGIN
IF CH$RCHAR_A(.PTR) NEQ %C':'
THEN WARNING(ARGCMD);
SEQ=RDNUMA(.PTR,10);
END;
[OTHERWISE]: WARNING(ARGCMD);
TES;
END;
IF (.JOBNAME OR .SEQ OR .NODEID) EQL 0 THEN WARNING(ARGCMD);
INCR I FROM 0 TO PTAB_LEN-1 DO
BEGIN
EXTERNAL PTAB: VECTOR;
BIND P=.PTAB[.I]: PROCESS_BLOCK,
NB=(IF P NEQ 0 THEN .P[P$NDB] ELSE 0): NDB,
EQ=(IF NB NEQ 0 THEN .NB[NDB$EQ] ELSE 0): QSR_EQ,
PSEQ=(IF EQ NEQ 0 THEN .EQ[QSR$EQ_SEQ] ELSE 0),
PNODE=(IF NB NEQ 0 THEN .NB[NDB$NODEID] ELSE 0);
IF P NEQ 0 !Is there anything here?
THEN
IF ((.NODEID EQL 0) OR (PNODE EQL .NODEID))
AND ((.JOBNAME EQL 0) OR (.P[P$NAME] EQL .JOBNAME))
AND ((.SEQ EQL 0) OR (.SEQ EQL PSEQ))
THEN BEGIN
FOUNDONE=1;
(.DO_TO_IT)(P,.PTR);
END;
END;
RETURN .FOUNDONE;
END
ELSE (WARNING(ILLCMD);RETURN 0);
END; !FIND_REQUEST
GLOBAL ROUTINE INIT_NODTBL=
BEGIN
!Now initialize all the operator-settable node attributes
INCR I FROM NODTBL$BASE BY .NODTBL$ENTLEN DO
BEGIN
MAP I: REF NODTBL_ENTRY;
IF .I[NOD$ID] EQL 0 THEN EXITLOOP; !Reached the end
IF .I[NOD$ID] NEQ -1 THEN
BEGIN
I[NOD$TLIMIT]=.I[NOD$LIMIT];
I[NOD$TFLG]=.I[NOD$FLG];!Reset temp flags
I[NOD$TF_OVERRIDE]=0; !Reset Time-of-day override
END
END;
END; !INIT_NODTBL
END ELUDOM