Google
 

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