Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50512/spl.b36
There are no other files named spl.b36 in the archive.
MODULE SPL=
!Top-level routine to process requests from QUASAR
!ENVIRONMENT: TOPS-10	6.03 or later,	GALAXY,	requires NETSPL interrupt system
!ABSTRACT:	Go online to QUASAR, create a process running LOCJOB for each
!		request we get from QUASAR
BEGIN
!
! Table of Contents
!
FORWARD ROUTINE
SPL,
SPLHANDLE,
SPLQST;	!Called by others to tell SPL to do status change

!
! Conditional Compilation
!

COMPILETIME FTDEBUG=1;

!
! Libraries
!

REQUIRE 'INTR.REQ';

!
! Version
!
THIS_IS [SPL]		VERSION [1]	EDIT [11]	DATE [18,DEC,79]
![11] No QUASAR ACKS ever!
![10] Handle unsolicited TEXT messages

!
! Externals
!
EXTERNAL ROUTINE
USRLOG,			!Write log file for user
NDBINI,			!Set up an NDB
IPCINI,			!Set up interrupts for IPCF packets
DONEXTJOB,		!Process NEXTJOB message from QUASAR
DOABORT,		!Process ABORT message from QUASAR
HELLO,			!On-line/Off-line/Change status to QUASAR
REQJOB,			!Reque a job
RELJOB,			!Release a job
QSRACK,			!Send ACK to QUASAR (what else??)
RCVACK,			!Get ACK from QUASAR
NODNDB,			!Fill in NDB from NODTBL
TELLJOB,		!Tell the OPR about a request
FREEFB,			!Give back an NDB or File block & everything connected
REQIT,			!Decide if we should re-queue
REMINF,			!Bury a dead inferior process
FALMJC,			!Tell FAL about a change in # of transfers
SAYONQ,			!Say we're online to QUASAR
FREE,			!Free up some memory
LOGS,			!Write a string to the log file
QUIT;			!Give up the ghost

EXTERNAL	HIMSG: QSR$HI,	!The HELLO message
		IPCFINT: INT_BLOCK;	!Interrupt block for IPCF
EXTERNAL	NXFERS,	!# of transfers in progress
		RXFERS,	!# of remotely-requested transfers in progress
		MJOBS;	!# of transfers (total) allowed
EXTERNAL	RUN: REF PROCESS_BLOCK;	!Our process block
EXTERNAL	QSRPID;			!QUASAR's PID

!
! Global data
!
GLOBAL QSRSTINT: INT_BLOCK;
%IF FTDEBUG %THEN GLOBAL QDEBUG: BITVECTOR[32] %FI;

!
! Macros
!

UNDECLARE %QUOTE PREFIX;
MACRO PREFIX='SPL' %;

!
! Literals
!

!
! Routines
!

GLOBAL ROUTINE SPL=
!Process file transfer requests from QUASAR
BEGIN
LOCAL NB: REF NDB;
LOCAL MESSAGE: REF QSR_EQ;
LOCAL IB: REF INT_BLOCK;
LOCAL FB: REF FILE_BLOCK;

ESTABLISH(SPLHANDLE);
TYPE('[',PPREFIX,'SSU  SPL started up]',CRLF);

IPCINI();	!Set up interrupts & get PID for QUASAR (wait if no QUASAR)
HIMSG[QSR$MS_ACK]=0;	![11] ACK facility does not work (for us anyway)!!
IF HELLO() EQL SS$_ERROR THEN (ERROR(FRKEND);QUIT(QSRERR));
			!Send a HELLO message (wait for ACK)
			!Go away if QUASAR doesn't like us
			!Error message will already have been printed

RUN[P$DISPLAY]=SAYONQ;	!So WHAT cmd will say we're on-line

DO	BEGIN
	EXTERNAL ROUTINE QUEWAT,DONEXTJOB,INTINI,FBINI,ALLOC,QMRECV;
	LOCAL HDR: IPCF_HEADER;
	LABEL	PROCESS_MESSAGE;

	QUEWAT(HDR);
	MESSAGE=QMRECV(HDR);
	IF .MESSAGE[QSR$MS_ACK] THEN QSRACK(); !Give him an ACK if he wants one
	PROCESS_MESSAGE:
		BEGIN
		SELECT .MESSAGE[QSR$MS_TYP] OF SET
		[QSR$MS_NEXTJOB]:
			BEGIN	!Create a new job
			EXTERNAL ROUTINE LOCJOB;
			LOCAL NN;
			LOCAL PB: REF PROCESS_BLOCK;

			%IF FTDEBUG %THEN
			IF .QDEBUG[QSR$MS_NEXTJOB]
			THEN CINFO(DEBUG,'Received NEXTJOB from QUASAR');
			%FI
			NB=ALLOC(NDB_LEN);	!Make a node data block
			NDBINI(.NB);		!Initialize it
			IF .MESSAGE[QSR$EQ_FUNC] NEQ RMC$F_DEL
				THEN	BEGIN	!Build a local file block
					NB[NDB$FB]=(FB=ALLOC(FB_LEN));
					FBINI(.FB);	!Initialize it
					END;
				!Currently the alias will not be believed
				!unless the GODLY bit is on.  If this breaks
				!in some future release, this may be why
			NB[FILE$IB]=(IB=ALLOC(INT_LEN));
			INTINI(.IB);

			DONEXTJOB(.NB,.MESSAGE); !Fill in FB & NDB from message
			CINFO(DEBUG,'Job received from QUASAR');

			NN=NODNDB(.NB);	!Fill in stuff from NODTBL
			IF .NXFERS GEQ .MJOBS THEN NN=0;	!Too many jobs
			IF .NN THEN
				BEGIN
				NOINTS(( NXFERS=.NXFERS+1 )); !1 more going
				PB=FORK(LOCJOB,.NB);
				PB[P$NDB]=.NB;	!This is his NDB now
				RUN[P$NDB]=0;	!Not ours
				END

			ELSE	BEGIN
				RUN[P$NDB]=0;		!Clear NDB owner
				SELECT .NN<STSCODE> OF SET !See why job can't run
				[NODUNN]:	![6] Tell user & sys about it
					BEGIN		!We never heard of this node
					UNDECLARE %QUOTE PREFIX;
					MACRO PREFIX='UNN' %;
					(ERR('Unknown remote NODE in request'));
					USRLOG(.NB,NODUNN); !Do log file
					RELJOB(.NB);	!Throw job away
					END;
				[OTHERWISE]:	REQJOB(.NB,.NB[NDB$REQUE]); !Try later
				TES;
				FREEFB(.NB);		!Throw away the NDB
				END;
			LEAVE PROCESS_MESSAGE;	!So we don't free it
			END;
		[QSR$MS_ABORT]:
			BEGIN
			MAP MESSAGE: REF QSR$ABO;
			EXTERNAL RUN:REF PROCESS_BLOCK;
			LOCAL	P: REF PROCESS_BLOCK,
				NB: REF NDB,
				MS: REF QSR_EQ;
			LOCAL ABORT_INT: INT_BLOCK;

			CLEARV(ABORT_INT);
			ABORT_INT[INT$SIGNAL_ARGS]=1;	!Just the code itself
			ABORT_INT[INT$SEVERITY]=SS$_ERROR; !Process should croak
			ABORT_INT[INT$STSCODE]=
			 (IF .MESSAGE[QSR$ABO_REASON] THEN USRABO ELSE OPRABO);
			 !1 if by user, 2 if by operator
			P=.RUN[P$INFERIORS];
			WHILE .P NEQ 0 DO !Look thru inferiors for job to kill
				BEGIN
				NB=.P[P$NDB];	!Find his NDB
				MS=.NB[NDB$EQ];	!QUASAR message that caused it
				IF .MS[QSR$EQ_TASK] EQL .MESSAGE[QSR$ABO_ITN]
					THEN (FSIGNL(.P,ABORT_INT);EXITLOOP);
				P=.P[P$LINK]
				END;
			END;
		[QSR$MS_TEXT]:	BEGIN
				MAP MESSAGE: REF QSR$MSG_TEXT;
				UNDECLARE NB;
				UNDECLARE %QUOTE PREFIX; MACRO PREFIX='MFQ' %;
				IF .MESSAGE[QSR$TEXT_NOMESS] EQL 0 THEN
					BEGIN
					IF .MESSAGE[QSR$TEXT_FATAL]
					THEN ERR_NCRLF('')
					ELSE IF .MESSAGE[QSR$TEXT_WARN]
					THEN WRN_NCRLF('')
					ELSE INFO_NCRLF('');

					!Now for the text of the message
					TSTR(MESSAGE[QSR$TEXT_MSG]);

					IF .MESSAGE[QSR$TEXT_FATAL]
					OR .MESSAGE[QSR$TEXT_WARN] EQL 0
					THEN TYPE(']');
					TYPE(CRLF);
					END;

				IF .MESSAGE[QSR$TEXT_FATAL]
				THEN (ERROR(FRKEND);QUIT(QSRERR))
				!If QUASAR tells us to shove off, do so.
				END;
		[ALWAYS]:	FREE(MESSAGE[0,0,0,0],.HDR[IPCF$MSG_LEN]);
				!Free up the storage & ignore it
		TES;
		END
	END WHILE 1;
END;	!SPL
ROUTINE SPLHANDLE(SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS)=
!Condition handler for SPL
!Arguments: the standard ones for condition handlers
!		ENABLE_ARGS is currently ignored
BEGIN
MAP SIGNAL_ARGS: REF BLOCK FIELD(SA_FIELDS),
    MECH_ARGS: REF VECTOR,
    ENABLE_ARGS: REF VECTOR;
    !These are all argument lists of the form:
    !length,arg1,arg2,arg3,arg4,... (words)
    !length does not include the length word itself

EXTERNAL ROUTINE
FSIGNL,	!Force a signal to another process
ERTEXT;	!Get text of error message

EXTERNAL RUN: REF PROCESS_BLOCK;
LOCAL
	C,	!Code
	S;	!Severity

S=.SIGNAL_ARGS[SA$SEVERITY];
SELECT (C=.SIGNAL_ARGS[SA$STSCODE]) OF SET
	!Fill in conditions here
	[SS$_UNWIND,FRKEND]:
		BEGIN
		EXTERNAL ROUTINE INTFRE;
		EXTERNAL IPCFINT: INT_BLOCK;
		EXTERNAL ROUTINE HELLO,RCVACK;
		EXTERNAL HIMSG: QSR$HI;
		WHILE .RUN[P$INFERIORS] NEQ 0 DO
			WAIT(0);	!Wait for all inferiors to die
		IF .QSRPID NEQ 0 THEN	!Tell QUASAR if he's there
			BEGIN
			HIMSG[QSR$HI_BYE]=1;	!Say good-bye to QUASAR
			HIMSG[QSR$MS_ACK]=0;	![11] No ACKs
			HIMSG[QSR$HI_STC]=1;
			HELLO();
			END;
		INTFRE(IPCFINT);	!No more interrupts from IPCF
		QUIT(.SIGNAL_ARGS[SA$STATUS]);
		END;

	[QSRSTC]:	!Someone wants us to send a status change
		BEGIN
		HIMSG[QSR$HI_MJOB]=(.MJOBS-.RXFERS);
			!# of jobs we will process = 
			!# of jobs we want - # of remote jobs active
		HIMSG[QSR$HI_STC]=1;
		HIMSG[QSR$MS_ACK]=0;	![11] No ACKs
		HELLO();
		RETURN SS$_CONTINUE;
		END;
	[QSRNRN]: QSRPID=0;	!Make sure we don't try to talk to QUASAR
	[OPRABO]:
		BEGIN
		TYPE('[',PPREFIX,'SSD  SPL shut down by operator]',CRLF);
		SIGNALW(FRKEND,OPRABO);
		END;
	[INFQIT]:
		BEGIN
		EXTERNAL ROUTINE REQJOB,RELJOB;
		LOCAL R;
		BIND NB=.BLOCK[.SIGNAL_ARGS[SA$STATUS],P$NDB]: NDB;
			!NDB of dead process
		BIND FB=.NB[NDB$FB]: FILE_BLOCK;	!his file block
		R=.SIGNAL_ARGS[SA$QUIT_STSCODE];
		SELECTONE .R OF SET
		[WIN]:	RELJOB(NB);	!Successful
		[OTHERWISE]:
			BEGIN
			UNDECLARE %QUOTE PREFIX;
			MACRO PREFIX='LCT'%;	!For termination message
			IF REQIT(.SIGNAL_ARGS[SA$QUIT_STSCODE])
			THEN	BEGIN		!Job will be re-queued
				FB[FILE$FUNCTION]=OPRDEF; 
						!TELLJOB will say "Reque"
				TELLJOB(NB);	!Tell OPR if he cares
				REQJOB(NB,.NB[NDB$REQUE]);
				END
			ELSE	BEGIN
				FB[FILE$FUNCTION]=OPRABO; !We got aborted
				TELLJOB(NB);	!Tell OPR if he cares
				RELJOB(NB);	!Done all we ever can
				END;
			IF .NB[NDB$CONNECTED] THEN
			CWRN(LCD,'Local system terminated connection');
			END;
		TES;

		REMINF(.SIGNAL_ARGS[SA$STATUS]);
		NOINTS(( NXFERS=.NXFERS-1 ));	!1 less transfer in progress
		FALMJC();			!Let FAL know about it
		RETURN SS$_CONTINUE	!Keep going
		END;
	[ALWAYS]:
		BEGIN
		SELECT .S OF SET	!Check severity
			[SS$_WARN]:	BEGIN
					MSG('%','');TSTR(ERTEXT(.C));TYPE(CRLF);
					RETURN SS$_CONTINUE
					END;
			[SS$_SEVEREERROR]:	BEGIN
						MSG('?','');TSTR(ERTEXT(.C));
						CRASH(CRLF);
						END;
			[SS$_ERROR]:	BEGIN
					LOCAL CC;
					EXTERNAL ERRUEC,RMTUEC;
					TYPE('%%',PPREFIX,
					 'SAE  SPL Aborted due to error (');
					CC=ERTEXT(.C);
					TSTR(.CC);
					IF (.CC EQL ERRUEC) OR (.CC EQL RMTUEC)
					 THEN	TNUM(.C,8);
						!# for undefined error code
					TYPE(')',CRLF);
					SIGNALW(FRKEND,.C);
!!!!!					QUIT(.C);	!Go away
					END;
			TES
		END;
	TES
END; !SPLHANDLE
GLOBAL ROUTINE SPLQST=
!Called by any fork to tell SPL (if it is running) to do a status change
!to QUASAR.  Does nothing if SPL is not running
!Returns: nothing
BEGIN
LOCAL SPLPB: REF PROCESS_BLOCK;
EXTERNAL ROUTINE FINDP;

IF (SPLPB=FINDP(%SIXBIT'SPL')) NEQ 0 THEN  !this sequence #'ed job is next
	BEGIN
	FSIGNL(.SPLPB,QSRSTINT);
	END;	!Request a status change
END; !SPLQST
END ELUDOM