Google
 

Trailing-Edge - PDP-10 Archives - AP-D471B-SB_1978 - util.bli
There are 13 other files named util.bli in the archive. Click here to see a list.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
MODULE UTIL(RESERVE(#11,#12,#13,#14),SREG=#17,FREG=#16,DREGS=4,
	    VREG=#15,MLIST,TIMER=EXTERNAL(SIX12),FSAVE)=
BEGIN
!
! LAST MODIFIED BY CDO  ON  29 MAR 77
!

REQUIRE  DATA.BLI;			!EVERYONE WANTS ONE OF THESE

	EXTERNAL	GPURGE,
			ROLGH,
			KILGROUP,
			ROLMSG;
COMMENT;


! SUBROUTINE MOVE
! ========== ====

! THIS SUBROUTINE MOVES THISMANY NUMBER OF WORDS 

GLOBAL ROUTINE MOVE(FROMPTR,TOPTR,THISMANY) =
    BEGIN
	REGISTER P;
	MACHOP BLT = #251;

	IF .THISMANY EQL 0 THEN RETURN FALSE;	! IF NOTHING TO DO RETURN FALSE

	IF .FROMPTR EQL 0 THEN		! IF MOVE FROM ZERO THEN TREAT AS A ZERO STORAGE COMMAND
	    BEGIN
		P<LH> _ .TOPTR;		! SET UP FOR A ZERO TYPE BLT
		P<RH> _ .TOPTR + 1;
		(.TOPTR)<0,36> _ 0	! ZERO FIRST WORD
	    END
	    ELSE
	    BEGIN
		P<LH> _ .FROMPTR;	! SET UP FOR A MOVE TYPE BLT
		P<RH> _ .TOPTR;
	    END;
	BLT(P,.TOPTR+.THISMANY-1);	! BLT
	TRUE				! RETURN TRUE
    END;
COMMENT;

! SUBROUTINE COMPARE
! ==================
! THIS SUBROUTINE COMPARES TWO VECTORS, EACH OF THISMANY NUMBER OF WORDS LONG
! ON ENTRY:
! A = POINTER TO VECTOR 1
! B = POINTER TO VECTOR 2
! THISMANY = LENGTH OF THE VECTORS

GLOBAL ROUTINE COMPARE(A,B,THISMANY) =
     BEGIN
	INCR I FROM 0 TO .THISMANY-1 DO
	     IF @(.A+.I) NEQ @(.B+.I) THEN RETURN FALSE;
	TRUE
     END;
COMMENT;


! SUBROUTINE LINK
! ===============
! THIS ROUTINE LINKS BLOCKS THAT THE FIRST WORD OF EACH BLOCK CONTAINS
! INFORMATION OF THE PREVIOUS AND NEXT BLOCKS IN THE LINK CHAIN. 
! THE FIRST AND THE LAST BLOCKS IN THE CHAIN IS REFLECTED IN THE LINKKEY
! IN THE CONTROL HEADER. E.G. G0MHS IN A GH IS THE LINKKEY TO ALL THE MH'S
! THAT BELONG TO THIS GH.

GLOBAL ROUTINE LINK(KEY,WHAT) =
    BEGIN
	REGISTER
		WHERE,
		WORK;
	IF @.KEY NEQ 0 THEN
	    BEGIN
		WHERE _ .(.KEY)<AFT>;
		WORK _ .(.WHERE)<RH>;
		(.WHERE)<RH> _.WHAT;
		(.WHAT)<AFT> _ .WHERE;
		IF .WORK NEQ 0 THEN INFORM( PAZ 'FPROBLEM IN LINK@',0,0,0,0,0);
		(.KEY)<AFT> _ .WHAT
	    END
	    ELSE (.KEY)<FORE> _ (.KEY)<AFT> _ .WHAT;

	WHERE _ .(.WHAT)<FORE>;
	UNTIL .WHERE EQL 0 DO
	    BEGIN
		(.KEY)<AFT> _ .WHERE;
		WHERE _ .(.WHERE)<FORE>
	    END
    END;
COMMENT;

! SUBROUTINE UNLINK
! =================

GLOBAL ROUTINE UNLINK(KEY,WHAT) =
    BEGIN
	REGISTER
		PREV,
		NEXT;
	PREV _ .(.WHAT)<AFT>;
	NEXT _ .(.WHAT)<FORE>;
	IF .PREV NEQ 0 THEN (.PREV)<FORE> _ .NEXT 
	    ELSE IF .KEY NEQ 0 THEN  (.KEY)<FORE> _ .NEXT;
	IF .NEXT NEQ 0 THEN (.NEXT)<AFT> _ .PREV 
	    ELSE IF .KEY NEQ 0 THEN  (.KEY)<AFT> _ .PREV;
    END;
COMMENT;


! LAST MODIFIED 10 FEB 74

! SUBROUTINE BUILD
! =================
! .POINTER POINTS TO THE LINKKEY IN HEADER

GLOBAL ROUTINE BUILD(POINTER,SIZE) =
    BEGIN
	REGISTER	LOCATION;

	LOCATION _ GETMEM(.SIZE);	!GET .SIZE OF WORDS OF MEMORY FROM KERNEL

	ZERO( .LOCATION, .LOCATION + .SIZE - 1);
					! ZERO THE BLOCK OF CORE JUST OBTAINED
	IF .POINTER NEQ 0 THEN LINK(.POINTER,.LOCATION);
					!IF THE LAST ONE IN CHAIN IS NOT NULL, THEN LINK
					!THE JUST OBTAINED BLOCK TO THE LAST ONE IN CHAIN
	 .LOCATION			!RETURN THE LOCATION OF THE JUST OBTAINED BLOCK
    END;
COMMENT;

! SUBROUTINE DCHNKS
! ========== ======
! THIS ROUTINE DELETES ALL CHUNKS BELONGING TO THE SPECIFIED
! MESSAGE BY CALLING DELCHNK REPEATEDLY

GLOBAL ROUTINE DCHNKS(MHPTR) =
    BEGIN
	REGISTER CHUNKPTR, NEXT;
	MAP  FORMAT MHPTR;
	MAP  FORMAT CHUNKPTR;

	IF (CHUNKPTR _ .MHPTR[M0INCHNK]) NEQ 0 THEN	! IF THERE ARE ANY CHUNKS IN THIS MESSAGE THEN
	    BEGIN
		IF .CHUNKPTR NEQ .MHPTR[ M0OUTCHNK ] THEN CHUNKPTR _ .MHPTR[ M0OUTCHNK ];
		WHILE .CHUNKPTR NEQ 0 DO			! FOR EACH CHUNK
		    BEGIN
			NEXT _.CHUNKPTR[C0LINK];
			DELCHNK(.CHUNKPTR);				! ZAP IT
			CHUNKPTR _ .NEXT
		    END
	    END;
	MHPTR[M0CHNKS] _ 0				! REMOVE THE CHUNKS FROM THE MH
    END;
COMMENT;

! SUBROUTINE DELMH
! ========== =====

! THIS ROUTINE DELETES A MESSAGE HEADER AND CHUNKS BELONGING TO THE
! MESSAGE HEADER.

GLOBAL ROUTINE DELMH(LINKKEY,MHPTR) =
    BEGIN

	DCHNKS(.MHPTR);					! DELETE THE CHUNKS OF THIS MESSAGE
	DELETE(.LINKKEY,.MHPTR,M0SIZE,0);		! IN EITHER CASE ZAP THE MESSAGE HEADER

    END;
COMMENT;

! SUBROUTINE DMHS
! ========== ====

! THIS ROUTINE DELETES ALL THE MESSAGES BELONGING TO THE
! GROUP HEADER SPECIFIED.

GLOBAL ROUTINE DMHS(GHPTR) =
    BEGIN
	REGISTER
		MHPTR,
		NEXT;

	MAP  FORMAT GHPTR;
	MAP  FORMAT MHPTR;

	IF (MHPTR _ .GHPTR[G0FMHPTR]) NEQ 0 THEN	! IF THERE ARE ANY MESSAGES IN THIS GROUP THEN
		WHILE .MHPTR NEQ 0 DO				! FOR EACH MESSAGE HEADER
		    BEGIN
			NEXT _.MHPTR[M0FORE];
			DELMH(GHPTR[G0MHS],.MHPTR);			! ZAP THE MESSAGE
			MHPTR _ .NEXT
		    END;
	GHPTR[G0MHS] _ 0				! REMOVE THE MESSAGES FROM THE GH
    END;
COMMENT;

! SUBROUTINE DELGH
! ========== =====

! THIS ROUTINE DELETES A GROUP HEADER AND MESSAGES BELONGING TO THE
! GROUP HEADER

GLOBAL ROUTINE DELGH(LINKKEY,GHPTR) =
    BEGIN

	DMHS(.GHPTR);					! DELETE THE MESSAGES BELONGING TO THIS GROUP
	DELETE(.LINKKEY,.GHPTR,G0SIZE,0);		! THEN ZAP THE GROUP HEADER

    END;
COMMENT;

! ROUTINE FIXTERM
! ======= =======
!   THIS ROUTINE RESETS A TERMINALS FLAGS AND LEAFSTATUS TABLE
!    TO THEIR ORIGINAL SETTING FROM THE GENERATION DIALOG
!    AND ALSO CLEARS THE TSN,GHPTR AND PURGE BIT OF THE SOURCE.

GLOBAL ROUTINE FIXTERM(SRCPTR) =
    BEGIN
	MAP FORMAT SRCPTR;

	SRCPTR[S0TSN] _ SRCPTR[S0GHPTR] _ SRCPTR[S0PURGE] _ 0; !CLEAR STATUS BITS
	SRCPTR[S0ED] _ .SRCPTR[S0EDINI];			!RESTORE ED
	SRCPTR[S0DIT] _ .SRCPTR[S0DITINI];			!AND DIT
	MOVE (%FROM%  .SRCPTR[S0LSTINI],			!AND LEAF
	        %TO%  SRCPTR[S0LFSTTAB],			!STATUS
		%LN%  .SRCPTR[S0LSTINI]-SRCPTR[S0LFSTTAB]<0,0>); !TABLE
    END;
COMMENT;

! SUBROUTINE RESETTERMINAL
! ========== =============
! 
! THIS ROUTINE IS CALLED WHENEVER A TERMINAL DISCONNECTS FROM THE
! SYSTEM. THIS COULD BE CAUSED BY LINE OR NETWORK FAILURE.
! THE FUNCTIONS ARE:
!	1)DELETE CHUNKS OF ESI OR LESS LEVEL
!	2)SEND "G0LOSTTERM" TO RECEIVING LEAF IF ANY GROUPS EXIST
!	3)IF THIS IS A TEMPORARY SIGN ON, SIGN OFF THE TERMINAL
!	4)RESTORE ED,DIT AND LEAF STATUS TABLE TO ORIGINAL VALUES


GLOBAL ROUTINE RESETTERMINAL (SRCPTR) =
    BEGIN
	EXTERNAL FINDPORT;
	EXTERNAL RECV;
	REGISTER GHPTR,
	         PORTADDR,
		 CHUNKPTR,
		 NEXT;
	LOCAL	JSN;
	LOCAL	PAGEPTR;
	MAP FORMAT SRCPTR;
	MAP FORMAT PORTADDR;
	MAP FORMAT GHPTR;
	MAP FORMAT CHUNKPTR;

	IF .SRCPTR EQL 0 THEN RETURN;	!IF CALLED FOR NOTHING

! FIRST, DELETE ANY CHUNKS NOT ASSIGNED TO A GROUP YET
	NEXT _ .SRCPTR[S0FCHNK];	!START HERE
	WHILE (CHUNKPTR _ .NEXT) NEQ 0 DO
	  BEGIN
	    NEXT _ .CHUNKPTR[C0LINK];	!GET LINK FIRST
	    DELCHNK(.CHUNKPTR)		!AND DELETE THE CHUNK
	  END;
	SRCPTR[S0CHUNKS] _ 0;		!CLEAR THE POINTER

! SECONDLY, DON'T KEEP ANY MPPS WAITING. ALSO CLEANS UP GROUPS & MESSAGES
	IF (GHPTR _ .SRCPTR[S0GHPTR]) NEQ 0 THEN
	  BEGIN
	    GHPTR[G0LOSTTERM] _ GHPTR[G0ENDI] _ TRUE;
	    IF .GHPTR[G0EMPTY] THEN	!IF THE GROUP HAS BEEN EMPTIED
	      BEGIN
		GHPTR[G0EMPTY] _ FALSE;	!CLEAR IT
		IF .GHPTR[G0OUTMH] NEQ 0 THEN !IF NON-ZERO,SOMEONE AWAITS US
		  BEGIN
		    PAGEPTR _ .GHPTR[G0PADDR] ^ 9;	!SET PAGE NR.
		    JSN _ .GHPTR[G0JSN];		!AND JSN NR.
		    RECV(.JSN,.PAGEPTR);		!DO A SEND
		    OUTIPC(.PAGEPTR,.JSN);		!AND GIVE PAGE BACK
		    KILGROUP(.GHPTR,.JSN);		!KILL THE GROUP OFF
		  END;
	      END
	  END;

! NOW, SIGN OFF THE TERMINAL, IF THERE WAS A TEMPORARY CONNECTION
	PORTADDR _ FINDPORT(.SRCPTR[S0PORTPTR]); !FIND PORT ADDRESS
	IF .PORTADDR[PT0TMPSRCPTR] NEQ 0 THEN	!IF IT IS A TEMP ASSIGNMENT
	   SRCPTR[S0PORTPTR] _ PORTADDR[PT0SRCPTR] _ 0; !CLEAR IT

! LASTLY, RESET TERMINAL STATUS TO ITS ORIGINAL STATE, A LA GENERATION DIALOG
	FIXTERM(.SRCPTR)

    END;
COMMENT;

! ROUTINE QPSTS
! ======= =====
!	QUERY PORT STATUS
!    THIS ROUTINE IS CALLED WHEN SOME INTERRUPT TELLS US THAT A
!    CHANGE IN PORT-DEVICE STATUS HAS OCCURED. WE LOOP THRU THE
!    PORT TABLE QUERYING THE STATUS OF EACH DEVICE CONNECTED
!    TO A PORT. IF WE FIND THAT THE LINE CARRIER HAS BEEN DROPPED,
!    OR THE DEVICE HAS GONE AWAY, WE TAKE REMEDIAL ACTION INCLUDING
!    CLEANING UP THE TERMINAL ASSOCIATED(IF ANY) AND DOING APPROPRIATE
!    DISCONNECTS AND CLEARS.


GLOBAL ROUTINE QPSTS =
    BEGIN
	REGISTER STATUS;
	REGISTER PORTPTR;
	MAP FORMAT PORTPTR;
	EXTERNAL	PSTATUS,
			MONCPS,
			CUDX,
			PDISCONNECT;

	PORTPTR _ .PORTTAB<RH>;		!LOAD INITIAL POINTER

	WHILE @@PORTPTR NEQ 0 DO
	  BEGIN
	  IF .PORTPTR[PT0UDX] NEQ 0 THEN
	   BEGIN
	    IF (STATUS _ PSTATUS(.PORTPTR[PT0UDX])) NEQ 0 THEN
	      BEGIN
		IF (.STATUS AND LOSTCARRIER) NEQ 0 THEN
		   BEGIN
		     IF .MONCPS AND .PORTPTR[PT0CARRIER] THEN
			INFORM(PAZ '[MCSLCP LOST CARRIER FOR PORT %0S%  UDX=%1O%]@',
				.PORTPTR[PT0NAMEW],.PORTPTR[PT0UDX],0,0,0);
		     RESETTERMINAL(.PORTPTR[PT0SRCPTR]);
		     PORTPTR[PT0CARRIER] _ FALSE
		   END;
		IF (.STATUS AND LOSTDEVICE) NEQ 0 THEN
		  BEGIN
		    IF .MONCPS THEN
			INFORM(PAZ '[MCSLDP LOST DEVICE FOR PORT %0S%  UDX=%1O%]@',
				.PORTPTR[PT0NAMEW],.PORTPTR[PT0UDX],0,0,0);
		    PDISCONNECT(.PORTPTR[PT0UDX]);	!DO MONITOR DISCONNECT
		    CUDX(.PORTPTR[PT0UDX]);		!CLEAR UDX FROM SOURCE
		    PORTPTR[PT0UDX] _ 0;		!CLEAR UDX OUT
		  END
		END;
	     END;
	    PORTPTR _ .PORTPTR + PT0SIZE
	  END
    END;
COMMENT;


! LAST MODIFIED:	17 FEB 74    BY		AG

! SUBROUTINE QHASH
! ========== =====
! THIS SUBROUTINE LOOKS AT THE PAGE, SEARCHES FOR THE NODE IN THE TREE,
! THAT MATCHES THE QUEUE NAME SPECIFIED IN THE PAGE,RETURNS THE NODEPTR
! IF ONE IF FOUND, OTHERWISE 0 IS RETURNED.

GLOBAL ROUTINE QHASH(NAMEADDR) =
    BEGIN
	REGISTER
		NODE,
		FORMAT NODEPTR;

	LABEL	LOOP;

	NODE _ NODEPTR _ (TREE+2)<0,0>;		! SET STARTING POINT OF SEARCH TO
						! THE ROOT OF THE TREE

	INCR I FROM 0 TO (MAXLEVEL - 1) * LEAFNAMLEN BY LEAFNAMLEN DO
						! LOOK AT THE QUEUENAMES ONE AT A TIME

	   LOOP:BEGIN
		IF .(.NAMEADDR)[ .I ] EQL 0 THEN
						! IF THE QUEUE NAME IS NULL THEN
		    BEGIN
			IF .I EQL 0 THEN RETURN 0
						! IF THE PQ WASN'T SPECIFIED RETURN 0
			    ELSE RETURN .NODEPTR;
						! ELSE RETURN A NODEPTR
		    END;

		WHILE .NODE NEQ 0 DO		! IF NOT NULL THEN SEARCH THE TREE FOR THE NAME

		    BEGIN
			NODEPTR _ .NODE;

			IF COMPARE(.NODEPTR,(.NAMEADDR)[ .I ],LEAFNAMLEN) THEN
								! SEE IF THE NAME OF THIS NODE IS THE ONE WE WANT
			! NOTE: WE IGNORE THE UNUSED WORDS IF N0LEN =1 OR 2
			    BEGIN
				NODE _ .NODEPTR[N0NXTND];	! GOT ONE ON THIS LEVEL
								! SO TRY NEXT NAME & LEVEL

				LEAVE LOOP
			    END
			    ELSE NODE _ .NODEPTR[N0SAMND];	! NOT IT SO TRY NEXT
								! ON THIS LEVEL

		    END;

		RETURN 0				! NO MATCH SO ERROR OUT
	    END;

	.NODEPTR					! ALL MATCHED !

    END;
	EXTERNAL	RECV;

COMMENT;

GLOBAL WAITLIST;			!POINTERS TO FIRST AND LAST ENTRIES IN
				!THE WAITLIST

! ROUTINE WAITSET
! ======= =======
! THIS ROUTINE SETS UP A WAIT LIST ENTRY FOR THE JOB SLOT SPECIFIED
! CALLED WITH THE CURRENT VALUE OF JSN, PAGEADDR, AND NODEPTR
! ALWAYS RETURNS FALSE
! ALGORITHM:
! .B 2	!RUNOFF COMMAND

GLOBAL ROUTINE WAITSET(JSN,PAGEADDR,NODEPTR)=
    BEGIN

	REGISTER WLPTR;

	MAP FORMAT WLPTR;

	! GET CORE FOR A WAIT LIST ENTRY
	WLPTR _ GETMEM(W0SIZE);

	! FILL IN THE WAIT LIST ENTRY
	WLPTR[W0LINK] _ 0;
	WLPTR[W0JSN] _ .JSN;
	WLPTR[W0PAGE] _ .PAGEADDR;
	WLPTR[W0NODE] _ .NODEPTR;

	! LINK IT TO THE WAIT LIST
	LINK(WAITLIST,.WLPTR);

	! IF EPI ON SET IDLE
	IF ( GETMPPSTATUS( .JSN ) AND EPIBIT ) NEQ 0
	    THEN SETMPPSTATUS( .JSN, IDLEBIT );

	! RETURN FALSE
	FALSE

    END;

! .B 5	!RUNOFF COMMAND
COMMENT;
! ROUTINE WAITCANCEL
! ======= ==========
! DELETES THE WAITLIST ENTRY (IF ANY) FOR THE JSN SPECIFIED
! RETURNS TRUE IF FOUND AND DELETED ELSE FALSE
! ALGORITHM:
! .B 2	!RUNOFF COMMAND

GLOBAL ROUTINE WAITCANCEL(JSN)=
    BEGIN

	REGISTER WLPTR;

	MAP FORMAT WLPTR;

	! GET FIRST WAITLIST ENTRY
	WLPTR _ .WAITLIST<FORE>;

	! WHILE THERE ARE ENTRIES IN THE WAITLIST
	WHILE .WLPTR NEQ 0 DO
	    BEGIN
		! SEE IF THIS IS THE ONE WE WANT
		IF .WLPTR[W0JSN] EQL .JSN THEN
		    ! IF IT IS THEN FREE UP THE PAGE IT HOLDS, GET RID OF
		    ! THE WAITLIST ENTRY, AND RETURN WITH TRUE
		    BEGIN
			UNLINK(WAITLIST,.WLPTR);
			DPAGE(.WLPTR[W0PAGE]);
			RETMEM(.WLPTR,W0SIZE);
			RETURN TRUE
		    END;
		! IF WASN'T THE ONE THEN TRY ANOTHER
		WLPTR _ .WLPTR[W0FORE]
	    END;
	! IF DIDN'T FIND A MATCH THEN RETURN WITH FALSE
	FALSE
    END;


! .B 5	!RUNOFF COMMAND
COMMENT;
! ROUTINE WAITTEST
! ======= ========
! GIVEN A LEAFPTR, SEE IF ANY JOB IS WAITING FOR A GROUP FROM IT
!   IF SO DELETE IT FROM THE WAIT LIST AND DO A RECV
!   RETURN THE COUNT OF THE NUMBER OF JOBS FOUND,STARTED, AND DELETED ELSE FALSE
! ALGORITHM:
! .B 2	!RUNOFF COMMAND

GLOBAL ROUTINE WAITTEST(LEAFPTR)=
    BEGIN

	REGISTER
		NODEPTR,
		COUNT,
		WLPTR,
		PAGEPTR;

	MACRO	TEMP = PAGEPTR$;		! NEED ANOTHER REGISTER NAME BUT NOT NECESSARY ANOTHER REGISTER
						! BE WARNED IF THE USE OF PAGEADDR OR TEMP IS CHANGED

	MAP FORMAT LEAFPTR;
	MAP FORMAT NODEPTR;
	MAP FORMAT WLPTR;

	! GET FIRST WAITLIST ENTRY
	WLPTR _ .WAITLIST<FORE>;

	! START THE COUNT OF MPP'S CONTINUED AT 0
	COUNT _ 0;

	! SEARCH WAITLIST FOR A NON-ZERO GROUP COUNT FOR ANY OF THE ENTRIES
	WHILE .WLPTR NEQ 0 DO
	    BEGIN
		NODEPTR _ .WLPTR[W0NODE];
		IF .NODEPTR[N0TSCNT] GTR 0 THEN
    		    BEGIN
			! IF A NON-ZERO ENTRY IS FOUND FOR
			! THE NODEPTR SAVED IN THE WAITLIST ENTRY
			! THEN DO A RECV
			!	CLEAR THE JOB SLOT'S EPI BIT
			!	SEND THE RESULT
			!	REMOVE THE WAITLIST ENTRY AND
			!	TRY SOME MORE NODES
			CLRMPPSTATUS(.WLPTR[W0JSN],EPIBIT+IDLEBIT);	!CLEAR THE JOBSLOT'S EPI BIT & IDLE BIT
			RECV(.WLPTR[W0JSN],(PAGEPTR _ .WLPTR[W0PAGE]));
			OUTIPC(.PAGEPTR,.WLPTR[W0JSN]);
			TEMP _ .WLPTR[W0FORE];	! SAVE POINTER TO NEXT BECAUSE UNLINK MAKES IT GO AWAY
			UNLINK(WAITLIST,.WLPTR);
			RETMEM(.WLPTR,W0SIZE);
			WLPTR _ .TEMP;		! TRY THE NEXT ENTRY
			COUNT _ .COUNT + 1
		    END
		    ELSE WLPTR _ .WLPTR[W0FORE]	! ELSE TRY THE NEXT WAIT LIST ENTRY
	    END;
	! WHEN OUT OF WAIT LIST ENTRIES RETURN WITH .COUNT
	.COUNT

    END;
COMMENT;
! LAST MODIFIED:	31-JAN-74    BY AG

! SUBROUTINE CHKSRCTAB
! ====================
! THIS ROUTINE CHECKS FOR THE LEGALITY OF THE SOURCE IN SRCTAB

GLOBAL ROUTINE CHKSRCTAB(DEST) =
    BEGIN
	REGISTER	FORMAT SRCPTR;

	SRCPTR _ .SRCTAB + 1;		!SET SRCPTR TO THE FIRST ENTRY IN SRCTAB
	WHILE .SRCPTR[S0IDW] NEQ 0 DO	! RUN BAREFOOT THRU THE SOURCES
	    BEGIN
		IF COMPARE(.SRCPTR,.DEST,SRCNAMLEN) THEN RETURN .SRCPTR
					!IF NAMES MATCH, RETURN .SRCPTR.
		ELSE SRCPTR _ .SRCPTR + .S0SIZE;
					!IF DOES NOT MATCH, STEPS TO THE NEXT ENTRY.
	    END;
	0				!IF NO MATCH IN SRCTAB,RETURN 0
    END;



COMMENT;
!SUBROUTINE CHKLFTAB
!===================
!THIS ROUTINE CHECKS FOR THE LEGALITY OF DESTINATION IN LFTAB
!THE ALGORITHM USED HERE IS SIMILAR TO THAT IN CHKSRCTAB.
!STEP THROUGH LFTAB, LOOKS FOR ENTRY WHICH MATCHES THE NAME CONTAINED
!IN THE DEST.
!IF A MATCH IS FOUND, THE ENTRY PTR IS RETURNED.
!IF NO MATCH IS FOUND, 0 IS RETURNED.

GLOBAL ROUTINE CHKLFTAB(DEST) =
    BEGIN
	REGISTER I;
	MAP FORMAT LFTAB;

	I _ 1;						! START WITH 1
	WHILE .LFTAB[L0DSTW(.I)] NEQ 0 DO		! UNTIL WE RUN OUT OF LFTAB ENTRIES
	    BEGIN
		IF COMPARE(LFTAB[L0DST(.I)],.DEST,3)	! SEE IF WE MATCH
		    THEN RETURN .I			! IF WE DO RETURN
		    ELSE I _ .I + L0SIZE		! OTHERWISE TRY ANOTHER
	    END;
	0						! NO MATCH THEN RETURN 0
    END;
COMMENT;

! ROUTINES: INCREMENT AND DECREMENT
!	    =========     =========
! ADDS A VALUE OR SUBTRACTS ONE FROM THE TRANSACTION COUNTS OF ALL THE NODES
!	FROM THE GIVEN NODE (LEAF) TO A PRIMARY QUEUE
! NOTE: THESE ROUTINES DEPEND ON THE FACT THAT THE PARENT OF A PRIMARY
!	QUEUE IS 0
! LAST MODIFIED:	30 JUN 76  BY  CDO

!ROUTINE DECREMENT
!	 =========
GLOBAL ROUTINE DECREMENT(LEAFPTR,FLAG)=
    BEGIN

	MAP FORMAT LEAFPTR;

	IF .FLAG THEN LEAFPTR[N0TSCORE] _ .LEAFPTR[N0TSCORE] - 1; ! DECREMENT IN CORE COUNT IF NEEDED

	DO LEAFPTR[N0TSCNT] _ .LEAFPTR[N0TSCNT] - 1 WHILE ( LEAFPTR _ .LEAFPTR[N0PARENT] ) NEQ 0;

    END;
COMMENT;
!ROUTINE INCREMENT
!	 =========
GLOBAL ROUTINE INCREMENT(LEAFPTR,VALUE)=
    BEGIN
	REGISTER
		MPPPTR,
		HOWMANY,
		NEWTSCNT,
		POSSIBLEMPP;

	LABEL	LOOP;

	MAP FORMAT LEAFPTR;

	LEAFPTR[N0TSCORE] _ .LEAFPTR[N0TSCORE] + .VALUE;	! INCREMENT IN CORE COUNT

	MPPPTR _ HOWMANY _ 0;

LOOP:	REPEAT
	    BEGIN

		! ADD THE CONTENTS OF VALUE TO THE CURRENT NODE'S TRANSACTION COUNT
		NEWTSCNT _ LEAFPTR[N0TSCNT] _ .LEAFPTR[N0TSCNT] + .VALUE;

		! IF THERE IS AN MPP THAT MIGHT BE STARTED FOR THIS NODE THEN
		IF (POSSIBLEMPP _ .LEAFPTR[N0MPP]) NEQ #777777 AND .MPPPTR EQL 0 THEN 
		    ! IF THE NEWTSCNT - THE NUMBER TO START >= THIS NODE'S THRESHOLD THEN
		    IF ( HOWMANY _ .NEWTSCNT  - .LEAFPTR[N0THRESH] + 1 ) GTR 0 THEN MPPPTR _ .POSSIBLEMPP;

		IF ( LEAFPTR _ .LEAFPTR[N0PARENT] ) EQL 0 THEN LEAVE LOOP
	    END;

	IF .HOWMANY GTR 0 THEN				! IF THERE ARE MPP'S TO START
	    BEGIN
			MPPPTR<LH> _ .HOWMANY;		! RETURN XWD HOWMANY, MPPPTR
			.MPPPTR
	    END
	    ELSE 0					! OTHERWISE RETURN 0

    END;
COMMENT;

! SUBROUTINE CHKRUN
! ========== ======
! LAST MODIFIED:	17 DEC 76  BY  CDO

GLOBAL ROUTINE CHKRUN(LEAFPTR,NUMBER,GHPTR) =
    BEGIN
	REGISTER
		MPPINDEX,
		OVER,
		MHPTR;

	MAP	FORMAT LEAFPTR;
	MAP	FORMAT GHPTR;
	MAP	FORMAT MHPTR;

	LOCAL	COUNT;

	EXTERNAL ?Q$FULL,	! QUE FILE IS FULL FLAG IN KERNEL
		 ?C$FULL,	! CORE IF FULL FLAG IN KERNEL
		 RUNROL;	! THE ROLLING PROCESS FLAG

	MPPINDEX _ INCREMENT(.LEAFPTR,.NUMBER);		! INCREMENT THE TRANSACTION COUNTS IN THE TREE

	GHPTR _ .LEAFPTR[N0LGH];			!GET LAST GH IN QUEUE

	IF .ROLLING THEN OVER _ .LEAFPTR[N0TSCORE] - .LEAFPTR[N0QUOTA] ELSE OVER _ 0;

	IF .?C$FULL NEQ 0 THEN OVER _ .LEAFPTR[N0TSCORE];

! **** NOTE: WE NEED TO ROLL OUT ONLY 1 MESSAGE HERE AND POST THE ROLLER TO COME BACK LATER

	WHILE .OVER GTR 0 AND .GHPTR NEQ 0 DO		! AND ROLL OUT THOSE THAT ARE
	    BEGIN
		IF .GHPTR[G0CHKPNT] THEN		! IF CHECKPOINTING
		    BEGIN
			IF NOT .GHPTR[G0ONDSK] THEN	! IF NOT ALREADY ON DISK THEN
			    BEGIN
				MHPTR _ .GHPTR[G0FMHPTR]; ! GET THE FIRST MESSAGE OF THE GROUP
				GHPTR[G0ONDSK] _ TRUE;	! MARK THE GROUP AS ROLLED OUT

				UNTIL .MHPTR EQL 0 DO	! FOR EACH MESSAGE OF THE GROUP
				    BEGIN
					DCHNKS( .MHPTR); ! DELETE THE IN CORE IMAGE
					MHPTR[M0CHNKS] _ 0;
					MHPTR _ .MHPTR[M0FORE] ! AND DO THE NEXT
				    END;

				LEAFPTR[N0TSCORE] _ .LEAFPTR[N0TSCORE] - 1; ! DECREMENT THE IN CORE COUNT
				OVER _ .OVER -1			! DECREMENT AMOUNT OVER QUOTA
			    END

		    END
		    ELSE
		    BEGIN
			IF .?Q$FULL NEQ 0 THEN OVER _ -1 ELSE IF NOT .GHPTR[G0ONDSK] THEN
			    BEGIN
				MHPTR _ .GHPTR[G0FMHPTR];		! GET THE FIRST MESSAGE HEADER
				GHPTR[G0ONDSK] _ TRUE;			! MARK THE GROUP AS ROLLED OUT
				GHPTR[G0DSKGHADDR] _ ROLGH(.LEAFPTR[ N0LLFNO ],
							.GHPTR[ G0TSN ],
							.GHPTR[ G0SENDER ],
							.MHPTR);
				MHPTR[M0CHNKS] _ 0;			! AND SHOW THE CHUNKS ARE OUT
				MHPTR _ .MHPTR[M0FORE];			! GET THE NEST MESSAGE HEADER

				UNTIL .MHPTR EQL 0 DO			! UNTIL WE'VE ROLLED THEM ALL
				    BEGIN
					MHPTR[M0DSKADDR] _ ROLMSG( .GHPTR[ G0DSKGHADDR ],
								.MHPTR[ M0INCHNK ],
								.MHPTR[ M0SOT ] );
					MHPTR[M0CHNKS] _ 0;		! AND MARK THEM ON DSK
					MHPTR _ .MHPTR[M0FORE]		! AND TRY ANOTHER MH
				    END;
				LEAFPTR[N0TSCORE] _ .LEAFPTR[N0TSCORE] - 1; ! DECREMENT THE IN CORE COUNT
				OVER _ .OVER -1;		! DECREMENT AMOUNT OVER QUOTA
				IF .?C$FULL EQL 0 AND .OVER GTR 0 THEN OVER _ RUNROL _ -1 ! RET LATER

			    END
		    END;
		GHPTR _ .GHPTR[G0AFT]				! GET THE NEXT GH
	    END;

	! **** NOTE **** IF NOT ROLLING OR CHECKPOINTING THEN WE GO 'TIL WE'RE OUT OF CORE

	WAITTEST(.LEAFPTR);		!START ANY WAITING MPPS

	COUNT _ .MPPINDEX<LH>;		! SPLIT UP THE VALUES RETURNED FROM INCREMENT

	MPPINDEX _ .MPPINDEX<RH>;

	IF .MPPINDEX NEQ #777777 AND .COUNT GTR 0 AND .LEAFPTR[N0TSCNT] NEQ 0
		THEN MPPRUN(.MPPINDEX, .LEAFPTR, .COUNT);

    END ;
COMMENT;

!THE ROLLER
!=== ======

! LAST MODIFIED:	17 DEC 76  BY  CDO

!THE ROLLER TAKES CORRECTIVE ACTION WHEN CORE BECOMED FULL AND IS ITS
!	PRIMARY FUNCTION.  HOWEVER, A FEW BENIFICIAL SIDE EFFECTS ARE
!	SEEN.
!		1) CHANGING NODE PARAMETERS (THRESHOLD OR QUOTA) WILL
!			KICK THE ROLLER AND WILL EITHER START A NEW MPP
!			OR BEGIN REDUCING CORE TO THE NEW QUOTA
!		2) SETTING NEW MPP PARAMETERS (MAX OR MPP TO RUN) WILL
!			TAKE THE APPROPRIATE ACTION
!		3) KILLING OFF ANY MPP WILL POSSIBLY START ONE THAT WAS
!			NOT BEFORE SINCE A JOB SLOT IS AVAILABLE
!		4) TURNING ON ROLLING WILL REDUCE CORE TO THE QUOTA

GLOBAL ROUTINE ROLCORE=
  BEGIN
	REGISTER LEAFPOINTER;

	MAP FORMAT LEAFPOINTER;

	INCR I FROM 0 TO 262143 DO
	  BEGIN
		LEAFPOINTER _ .LFPTRTAB[.I];	!GET LEAF POINTER
		IF .LEAFPOINTER<RH> GEQ ERLEAF<0,0> THEN RETURN; !STOP AT THE TOP
		CHKRUN(.LEAFPOINTER,0,0)	!TRY TO ROLL OR START MPP
	  END;
  END;
	EXTERNAL	RECV;

COMMENT;

! ROUTINE INSERT
! ======= ======

! LAST MODIFIED:	30 JUN 76  BY  CDO

!PURPOSE TO LINK MH TO GH
!	AND DO A RECV IF A JOB IS WAITING FOR THIS MESSAGE

GLOBAL ROUTINE INSERT(MHPTR,GHPTR)=
    BEGIN
	MAP FORMAT MHPTR;
	MAP FORMAT GHPTR;
	REGISTER
	    PAGEPTR,
	    JSN;

	LINK(GHPTR[G0MHS],.MHPTR);		! LINK MESSAGE TO THE GROUP

	IF .GHPTR[G0EMPTY] THEN			! IF GROUP HAS BEEN EMPTIED THEN
	    BEGIN
		GHPTR[G0EMPTY] _ FALSE;		! TURN OFF EMPTY FLAG
		IF .GHPTR[G0OUTMH] NEQ 0 THEN	! G0OUTMH NEQ 0 IF SOMEONE WAITING
		    BEGIN
			PAGEPTR _ .GHPTR[G0PADDR] ^ 9;	! GET PAGE ADDRESS
			JSN _ .GHPTR[G0JSN];		! AND THE JSN
			GHPTR[G0OUTMH] _ .MHPTR;	! FIX OUTPUT POINTER
			RECV(.JSN,.PAGEPTR);		! SEND TO WHOEVER'S WAITING
			OUTIPC(.PAGEPTR,.JSN);		! AND GIVE IT BACK
		    END
		    ELSE
		    BEGIN
		        GHPTR[G0OUTMH] _ .MHPTR	! FIX FOR NEXT RECV
		    END
	    END;
	0
    END;
COMMENT;
! ROUTINE FINDPORT
! ======= ========
! THIS ROUTINE SEARCHES THE PORT TABLE (PORTTAB) FOR A MATCH TO THE
! UDX IT IS GIVEN
! CALLED WITH:	A UDX
! RETURNS:	A POINTER TO THE PORT TABLE OF THE PORT WITH THE
!		    MATCHING UDX

GLOBAL ROUTINE FINDPORT(UDX) =
    BEGIN
	REGISTER
		PORTADDR,
		UDXREG;
	MAP	FORMAT PORTADDR;

	IF (UDXREG _ .UDX) EQL 0 THEN RETURN 0;
	PORTADDR _ .PORTTAB;

	WHILE .PORTADDR[PT0UDX] NEQ .UDXREG DO		! UNTIL WE FIND THE PORT WE WANT
	    BEGIN
		PORTADDR _ .PORTADDR + PT0SIZE;		! STEP TO THE NEXT PORT
		IF .PORTADDR[PT0NAMEW] EQL 0 THEN RETURN 0
	    END;
	.PORTADDR					! ELSE RETURN WHAT WAS WANTED
    END;
COMMENT;

! ROUTINE UNDEFER
! ======= =======
! THIS ROUTINE UNDEFERS THE SPECIFIED NUMBER OF MESSAGES FROM THE
! DEFERRED MESSAGE QUEUE OF THE SPECIFIED DESTINATION.

GLOBAL ROUTINE UNDEFER( SRCPTR, COUNT) =
    BEGIN
	REGISTER GHPTR;
	EXTERNAL RUNMSW,MSGCHN;
	MAP	FORMAT SRCPTR;
	MAP     FORMAT GHPTR;

	SRCPTR[ S0DEFSENDING ] _ TRUE;		! DON'T SEND ANY DEFERRED MESSAGES AFTER THESE ( PIGGYBACK )

	WHILE (COUNT _ .COUNT - 1) GEQ 0 AND (GHPTR _ .SRCPTR[S0FDGHPTR]) NEQ 0 DO
	    BEGIN
		UNLINK( SRCPTR[S0DGHS], .GHPTR);	! UNLINK IT FROM THE DEFERRED MESSAGES
		GHPTR[ G0LINK ]_0;
		LINK( SRCPTR[S0IGHS], .GHPTR);		! AND LINK TO IMMEDIATE MESSAGES
		MSGCHN(.SRCPTR);			! INSERT INTO THE OUTPUT CHAIN
		RUNMSW _ -1;				! START THE OUTPUT PROCESS
		SRCPTR[S0DFGCNT] _ .SRCPTR[S0DFGCNT] - 1
	    END;
	.COUNT + 1					! RETURN THE NUMBER NOT UNDEFERRED
    END;
COMMENT;

! ROUTINE MAKEMSG
! ======= =======

!THIS ROUTINE GENERATES THE CHUNKS (CHAINED) FOR THE ARGUMENT STRING
!	GIVEN.  SEE USE IN  SON,SOFF,DCR,DMR.

GLOBAL ROUTINE MAKEMSG( MSG, ARG0, ARG1, ARG2, ARG3, ARG4 ) =
    BEGIN

	OWN
		OUTBP,
		CHAR,
		ARGS[5],
		WHICHARG,
		WHICHTYPE,
		COUNT,
		FIRSTCHUNK,
		LASTCHUNK,
		CHUNK,
		INBP,
		BCOUNT,
		DATE,
		TIME;
	MAP	FORMAT CHUNK;
	MAP	FORMAT FIRSTCHUNK;
	MAP	FORMAT LASTCHUNK;

	LABEL	LOOP;

	BIND	MAXCOUNT = ( C0SIZE - C0HEADSIZE ) * 5;

	MACRO	NEXTCHAR = SCANI( INBP )$;

	BIND	MONTAB = PLIT(	ASCIZ 'Jan',
				ASCIZ 'Feb',
				ASCIZ 'Mar',
				ASCIZ 'Apr',
				ASCIZ 'May',
				ASCIZ 'Jun',
				ASCIZ 'Jul',
				ASCIZ 'Aug',
				ASCIZ 'Sep',
				ASCIZ 'Oct',
				ASCIZ 'Nov',
				ASCIZ 'Dec' );

	%LOCAL% ROUTINE STORE( CHAR ) =
	    BEGIN
		IF (BCOUNT _ .BCOUNT + 1) GTR MAXCOUNT THEN
		    BEGIN
			CHUNK[C0LINK] _ 0;
			CHUNK[C0BPOS] _ 36;
			CHUNK[C0BSIZ] _ 7;
			CHUNK[C0ENDI] _ ESI;
			CHUNK[C0BCNT] _ MAXCOUNT;
			CHUNK[C0WORDS] _ C0SIZE - C0HEADSIZE;
			IF .LASTCHUNK NEQ 0 THEN LASTCHUNK[C0LINK] _ .CHUNK;
			LASTCHUNK _ .CHUNK;
			CHUNK _ GETMEM( C0SIZE );
			OUTBP _ ( .CHUNK + C0HEADSIZE )<36,7>;
			BCOUNT _ 1
		    END;
		REPLACEI( OUTBP, .CHAR )
	    END;

	%LOCAL% ROUTINE XASCIZ( ARG, COUNT ) =
	    BEGIN
		REGISTER BP;
		BP _ .ARG;
		CHAR _ SCANI( BP );
		WHILE .CHAR NEQ 0 AND ( COUNT _ .COUNT - 1 ) GEQ 0 DO
		    BEGIN
			STORE( .CHAR );
			CHAR _ SCANI ( BP )
		    END
	    END;

	%LOCAL% ROUTINE XSIXBIT( ARG, COUNT ) =
	    BEGIN
		REGISTER BP;
		BP _ .ARG;
		WHILE ( COUNT _ .COUNT - 1 ) GEQ 0 DO
			STORE( SCANI( BP ) + #40 )
	    END;

	%LOCAL% ROUTINE OUTN(NUM,BASE,REQD)=
	    BEGIN
		OWN N,B,RD,T;
	
		%LOCAL% ROUTINE OUTM( CHAR, COUNT) =
		    BEGIN
			DECR I FROM .COUNT - 1 TO 0 DO
				STORE( .CHAR )
		    END;
	
		%LOCAL% ROUTINE XN=
		    BEGIN
			LOCAL R;
	
			IF .N EQL 0 THEN RETURN OUTM("0",.RD-.T);
			R_.N MOD .B; N_.N/.B; T_.T+1; XN();
			STORE(.R+"0")
		    END;
	
		IF .NUM LSS 0 THEN STORE("-");
		B_.BASE; RD_.REQD; T_0; N_ABS(.NUM); XN()
	
	    END;
	
	%LOCAL% ROUTINE XDECIMAL( NUMBER, REQD ) =
	    BEGIN
		OUTN( .NUMBER, 10, .REQD )
	    END;

	%LOCAL% ROUTINE XOCTAL( NUMBER, REQD ) =
	    BEGIN
		OUTN( .NUMBER, 8, .REQD )
	    END;

	%LOCAL% ROUTINE XDATETIME =
	    BEGIN
		OWN	MONTH;
		LOCAL
			DAY,
			YEAR,
			HOURS,
			MINUTES,
			SECONDS;

		STAMP( DATE, TIME );

		DAY _ .DATE MOD 31 + 1;
		YEAR _ .DATE / 31;
		MONTH _ .YEAR MOD 12;
		YEAR _ .YEAR / 12 + 64;

		XDECIMAL ( .DAY, 1 );
		STORE( " " );
		MONTH _ ( MONTAB[ .MONTH] )< 36, 7 >;
		XASCIZ( .MONTH, 3 );
		STORE( " " );
		XDECIMAL( .YEAR, 2 );

		STORE( " " );
		STORE( " " );

		HOURS _ .TIME / 3600000;
		MINUTES _ ( .TIME / 60000 ) MOD 60;
		SECONDS _ ( .TIME / 1000 ) MOD 60;

		XDECIMAL( .HOURS, 1 );
		STORE( ":" );
		XDECIMAL( .MINUTES, 2 );
		STORE( ":" );
		XDECIMAL( .SECONDS, 2 );

	    END;


! BEGIN !

	INBP _ (.MSG)< 36, 7>;
	ARGS[0] _ .ARG0;
	ARGS[1] _ .ARG1;
	ARGS[2] _ .ARG2;
	ARGS[3] _ .ARG3;
	ARGS[4] _ .ARG4;
	FIRSTCHUNK _ CHUNK _ GETMEM( C0SIZE );
	LASTCHUNK _ BCOUNT _ 0;

	OUTBP _ ( .CHUNK + C0HEADSIZE )<36,7>;

LOOP:	REPEAT
	    BEGIN
		CHAR _ NEXTCHAR;
		SELECT .CHAR OF
		    NSET
			"%":
			    BEGIN
				CHAR _ NEXTCHAR;
				IF .CHAR EQL "%" THEN STORE( .CHAR )
				    ELSE
				    BEGIN
					IF .CHAR EQL "Z" THEN
					    BEGIN
						WHICHTYPE _ XDATETIME
					    END
					    ELSE
					    BEGIN
						WHICHARG _ .CHAR - "0";
						IF .WHICHARG GTR 4 OR .WHICHARG LSS 0 THEN
							INFORM( PAZ 'FBAD ARG IN MAKEMSG@',0,0,0,0,0);
					
						CHAR _ NEXTCHAR;
					
						SELECT .CHAR OF
						    NSET
							"S":	WHICHTYPE _ XSIXBIT;
							"A":	WHICHTYPE _ XASCIZ;
							"D":	WHICHTYPE _ XDECIMAL;
							"O":	WHICHTYPE _ XOCTAL;
							OTHERWISE: INFORM( PAZ 'FBAD TYPE IN MAKEMSG@',0,0,0,0,0);
						    TESN
					
					    END;

					CHAR _ NEXTCHAR;
					
					IF .CHAR NEQ "%" THEN
					    BEGIN
						COUNT _ 0;
					
						WHILE .CHAR LEQ "9" AND .CHAR GEQ "0" DO
						    BEGIN
							COUNT _ .COUNT * 10 + (.CHAR - "0");
							CHAR _ NEXTCHAR
						    END;
					
						IF .CHAR NEQ "%" THEN
							INFORM( PAZ 'FBAD COUNT IN MAKEMSG@',0,0,0,0,0);
					    END
					    ELSE COUNT _ IF .WHICHTYPE EQL XDECIMAL OR
							    .WHICHTYPE EQL XOCTAL THEN 1 ELSE #377777777777;
					
					(.WHICHTYPE)(.ARGS[.WHICHARG], .COUNT);
				    END
			    END;
			"@":
			    BEGIN
				CHAR _ NEXTCHAR;
				IF .CHAR EQL 0 THEN LEAVE LOOP;
				%ELSE%
				STORE( "@" );
				STORE( .CHAR )
			    END;
			OTHERWISE: STORE( .CHAR );
		TESN
	    END;

	CHUNK[C0LINK] _ 0;
	CHUNK[C0BPOS] _ 36;
	CHUNK[C0BSIZ] _ 7;
	CHUNK[C0ENDI] _ EGI;
	CHUNK[C0BCNT] _ .BCOUNT;
	CHUNK[C0WORDS] _ C0SIZE - C0HEADSIZE;
	IF .LASTCHUNK NEQ 0 THEN LASTCHUNK[C0LINK] _ .CHUNK;

	.FIRSTCHUNK

    END;
COMMENT;

!ROUTINE GETREQUEST
!======= ==========
!THIS ROUTINE DETACHES A GROUP FROM THE SPECIFIED LEAF.
!0 IS RETURNED IF NO GROUP IS AVAILABLE

!NOTE:: CALLED ONLY BY THE MPR'S FOR ERR,SON,SOFF,DCR,AND DMR

GLOBAL ROUTINE GETREQUEST(LEAFPTR)=
	BEGIN
		REGISTER	GHPTR;
		MAP  FORMAT  LEAFPTR;
		MAP  FORMAT  GHPTR;

		IF ( GHPTR_.LEAFPTR[N0FGH] ) EQL 0 THEN RETURN 0;
		!GET FIRST GH AVAILABLE IN LEAF...N0NE THEN JUST EXIT
	
		UNLINK( LEAFPTR[N0GHS],.GHPTR);	!UNLINK FROM LEAF
		GHPTR[G0LINK]_0;		!CLEAR LINKS
		DECREMENT(.LEAFPTR,TRUE);		!...
		.GHPTR				!RETURN PTR TO IT
	END;
COMMENT;

!ROUTINE NEXTINTSN
!======= =========
!THIS ROUTINE PRODUCES THE NEXT INPUT TSN TO USE
!NOTE:THIS ROUTINE NEVER RETURNS ZERO

GLOBAL ROUTINE NEXTINTSN=
    BEGIN
	IF (LHTSN _ .LHTSN+1) EQL 0 THEN LHTSN_.LHTSN+1
	    ELSE .LHTSN
    END;

END;