!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
MODULE UTL(SREG = #17, FREG = #16,  VREG = #15, MLIST,TIMER=EXTERNAL(SIX12),FSAVE)=
BEGIN

! MCSGEN UTILITIES
! ====== =========

GLOBAL BIND UTL = 1;

FORWARD	OUTN, ASKL, MOVE, LINK, UNLINK, COMPARE;

EXTERNAL
	ZAPTRCODE,
	ERROR,
	WARN;

REQUIRE MGNMAC.BLI;
REQ (MGNGBL);
REQ (MGNMC2);

COMMENT;
!SOME ROUTINES TO BE ADDED
!ROUTINE SKPBLNKS=WHILE BLANK DO ADV;
!ROUTINE CMDEND=
!BEGIN
!    IF EOL THEN RETURN TRUE;
!    IF NEWCMD THEN RETURN TRUE;
!    IF COMMENT THEN RETURN TRUE;
!END;


COMMENT;

! ROUTINE ZERO
! ======= ====
! THIS ROUTINE ZEROS LOCATIONS A THRU B INCLUSIVE

GLOBAL ROUTINE ZERO(A, %THRU% B)=
    BEGIN
	MACHOP BLT=#251;
	REGISTER AC;
	(.A)<0,36> _ 0;
	IF .A GEQ .B THEN RETURN;
	AC<LH> _ .A;
	AC<RH> _ .A+1;
	BLT(AC,.B);
    END;

COMMENT;

! ROUTINE INPUT
! ======= =====
! THIS ROUTINE READS A LINE AND STORES IT IN THE BUFFER SPECIFIED IN THE
! CALL ARGUEMENTS

GLOBAL ROUTINE INPUT(BUFF,BPTR,NC,BUFFSIZE)=
    BEGIN
	REGISTER
		X,
		PBUFF,
		Z;
	OWN	EFLAG;

	EFLAG _ FALSE;
	.BPTR _ PBUFF _ (.BUFF)[-1]<1,7>;
	.NC_0;
	Z _ .BUFFSIZE;
	DO
	    BEGIN
		X_INC;
		IF .X GEQ %LOWER CASE% "a" AND .X LEQ %LOWER CASE% "z" THEN
			X _ .X - #40;		! THEN MAKE IT UPPER CASE
		IF (Z _ .Z - 1) GTR 0 THEN REPLACEI(PBUFF,.X)
		    ELSE IF .Z EQL 0 THEN ( ERROR(0); EFLAG _ TRUE )
	    END
	WHILE .X NEQ #12;
	REPLACEI( PBUFF, 0 );
	ERRORFLG _ .EFLAG;
	ADV(.BUFF,.BPTR,.NC,Z)
    END;
COMMENT;

! ROUTINE GATHER
! ======= ======
! GATHER FORMS A WORD IN ATOM
! SIZE IS THE LENGTH OF THE STORAGE SPACE FOR THE ATOM IN CHARACTERS
! THE WORD GATHERED WILL NOT EXCEED THIS LENGTH
! FURTHER THE ATOM WILL BE CLEARED TO THE END IF NOT FILLED
! RETURNS ACTUAL LENGTH AS VALUE
! THE ATOM WILL CONSIST OF AN ARBITRARY MIXTURE OF ALPHABETIC, NUMERIC,
! AND HYPHENS

GLOBAL ROUTINE GATHER(CBUFF,CBPTR,CCOUNT,CHAR,ATOM,SIZE)=
    BEGIN
	REGISTER
		GNC,
		Z,
		PACCUM;

	SKIPBLANKS(.CBUFF,.CBPTR,.CCOUNT,.CHAR);
	GNC_0;
	PACCUM_(.ATOM)[-1]<1,7>;
	WHILE (ALPHANUMERIC(.CHAR) OR ..CHAR EQL "-") DO
	    (IF .GNC LSS .SIZE THEN REPLACEI(PACCUM,..CHAR); ADV(.CBUFF,.CBPTR,.CCOUNT,.CHAR); GNC_.GNC+1);
	IF (.GNC EQL 0) AND (..CHAR EQL "??") THEN			! PICK UP ONE CHARACTER IF NOT A <CR> AND IS A "?"
	    BEGIN
		REPLACEI(PACCUM, ..CHAR);
		ADV( .CBUFF, .CBPTR, .CCOUNT, .CHAR);
		GNC _ 1
	    END;
	Z_.GNC;
	WHILE .Z LSS .SIZE DO ( Z _ .Z+1; REPLACEI(PACCUM,0));	!FILL WITH NULLS
	.GNC
    END;
GLOBAL ROUTINE SEARCHTABLE(TABLE,ATOM,ASIZE,TSIZE,EXECUTE)=
! TSIZE NOT IMPLEMENTED FOR VALUES NEQ 1
! RETURNS TRUE IF UNIQUE MATCH OF ATOM IN TABLE
! RETURNS FALSE IF NOT
! .EXECUTE IS SET TO TABLE[ATOM+1] IF TRUE
! OR IF FALSE THEN 0 IF ATOM NOT FOUND OR 1 IF NOT UNIQUE
! POSSIBLE MOD:
! RETURN WORD:
!			BIT(0) = STATUS == GOOD/BAD
!			BIT(1) = ERROR CODE == NOT-UNIQUE/NOT-FOUND
!			BITS(18,36) = .TABLE[ATOM + 1]<RH>
    BEGIN
	REGISTER Z,ACCUM,COMMANDS,UNIQUE;
	LOCAL MASK,PARTIALMATCH;
	IF .TSIZE NEQ 1 OR .ASIZE GTR 5 OR .ASIZE LSS 0 THEN
	    BEGIN
		OUTS('?? ASIZE OR TSIZE OUT OF RANGE?M?J'); OUTS('TSIZE=');
		OUTD(.TSIZE) ;OUTS('  ASIZE='); OUTD(.ASIZE); CRLF; .EXECUTE_0;
		RETURN
	    END;

	%MAKE MASK%
	MASK_0;
	Z_MASK<36,7>;
	DECR I FROM .ASIZE-1 TO 0 DO REPLACEI(Z,-1);
	ACCUM_..ATOM;
	COMMANDS_.TABLE;
	PARTIALMATCH_-1;
	UNIQUE _ FALSE;
	.EXECUTE_INCR I FROM 0 TO @(.COMMANDS)[-1] BY .TSIZE+1 DO
	    (IF .ACCUM EQL (Z_@(.COMMANDS)[.I]) THEN EXITLOOP .I
		    ELSE IF .ACCUM EQL (Z_.Z AND .MASK) THEN
			    (UNIQUE _ IF .PARTIALMATCH LSS 0 THEN (PARTIALMATCH _ .I; TRUE) ELSE FALSE)
	);
	IF ..EXECUTE LSS 0 THEN
	    BEGIN
		IF .UNIQUE EQL TRUE THEN
		    BEGIN
			(.EXECUTE _ @(.COMMANDS)[.PARTIALMATCH+.TSIZE]; TRUE)
		    END
		    ELSE
		    BEGIN
			(.EXECUTE _ (IF .PARTIALMATCH LSS 0 THEN 0 ELSE 1); FALSE)
		    END
	    END
	    ELSE
	    (.EXECUTE _ @(.COMMANDS)[..EXECUTE+.TSIZE]; TRUE)
    END;
COMMENT;

!XTYPE ROUTINE
! ===== =======

!CALL:	XTYPE(PLIT ASCIZ 'TEXT');
! OUTPUTS TEXT DEPENDING UPON MSGLEVEL
! IF MSGLEVEL IS 0 ALL TEXT IS TYPED.
! IF MSGLEVEL IS 1 ONLY THE TEXT INSIDE AT LEAST ONE LEVEL OF SQUARE
!	BRACKETS [] IS TYPE
! IF MSGLEVEL IS 2 ONLY TEXT INSIDE AT LEAST TWO LEVELS OF SQUARE
!	BRACKETS IS TYPED
! ETC.

! PARENTHESES HAVE THE OPPOSITE EFFECT FROM SQUARE BRACKETS, I.E.
!	UNLESS THE MSGLEVEL MATCHES THE NUMBER OF PARENTHESES, THE
!	TEXT WILL NOT BE TYPED
!NOTE: A ^R (OR ?R) IN THE TEXT FORCES THE NEXT CHARACTER TO BE TYPED
! REGARDLESS OF THE CHARACTER AND FURTHER THAT CHARACTER IS IGNORED
! AS FAR AS STOPPING OR LEVEL CHANGE IS CONCERNED.
! THUS TO TYPE A NULL OR SQUARE BRACKET PUT A ?R JUST BEFORE IT.

GLOBAL ROUTINE XTYPE(A)=
    BEGIN
	MACRO	NEXT=CHAR _ SCANI(TEXTPTR)$,
		ADD1(A)=A _ .A+1$,
		SUB1(A)=A _ .A-1$;

	REGISTER TEXTPTR,CHAR,BCOUNT,PCOUNT;

	LABEL B;

	TEXTPTR _ (.A)<36,7>;
	BCOUNT _ 0;
	PCOUNT _ 0;

	WHILE 1 DO
	    SELECT (NEXT) OF NSET
		NULLCHAR: RETURN;
		CNTRLR: (NEXT; IF (.MSGLEVEL LEQ .BCOUNT) AND (.MSGLEVEL GEQ .PCOUNT) THEN OUTC(.CHAR));
		LBRACKET: ADD1(BCOUNT);
		RBRACKET: SUB1(BCOUNT);
		LPAREN: ADD1(PCOUNT);
		RPAREN: SUB1(PCOUNT);
		OTHERWISE: IF (.MSGLEVEL LEQ .BCOUNT) AND (.MSGLEVEL GEQ .PCOUNT) THEN OUTC(.CHAR);
	    TESN
    END;
GLOBAL ROUTINE OUTBUF =
    BEGIN
	IFSKIP OUT( OCHAN, 0 ) THEN
	    BEGIN
		ERROR( 80 );
		% ERRORMSG = 'OUTPUT FAILED IN PUTC' %
		XIT %???%
	    END
    END;

GLOBAL ROUTINE PUTC( CHAR ) =
    BEGIN
	IF ( OBUF[2] _ .OBUF[2] - 1 ) LEQ 0 THEN
	    BEGIN
		OUTBUF();
	    END;
	REPLACEI( OBUF[1], .CHAR )
    END;

GLOBAL ROUTINE OUTTC( CHAR ) =
    BEGIN
	IF .DCHANNEL EQL TTYCHANNEL THEN OUTC( .CHAR ) ELSE PUTC( .CHAR )
    END;

GLOBAL ROUTINE XPUT(A)=
    BEGIN
	REGISTER
		CHAR,
		BPTR;

	BPTR _ (.A)<36,7>;
	WHILE ( CHAR _ SCANI( BPTR ) ) NEQ 0 DO PUTC( .CHAR )

    END;

GLOBAL ROUTINE XOUTPUT(A)=
    BEGIN
	IF .DCHANNEL EQL TTYCHANNEL THEN OUTSA(.A) ELSE XPUT(.A)
    END;

GLOBAL ROUTINE PUTWORD( AWORD ) =
    BEGIN
	IF ( OBUF[2] _ .OBUF[2] - 1 ) LEQ 0 THEN
	    BEGIN
		IFSKIP OUT( OCHAN, 0 ) THEN
		    BEGIN
			ERROR( 81 );
			% ERRORMSG = 'OUTPUT FAILED IN PUTWORD' %
			XIT	%???%
		    END
	    END;
	OBUF[1] _ .OBUF[1] + 1;
	.OBUF[1] _ .AWORD

    END;

GLOBAL ROUTINE PUTBLK( FIRST, LAST ) =
    BEGIN
	INCR I FROM .FIRST TO .LAST DO PUTWORD( @.I );
    END;

GLOBAL ROUTINE INBUF=
    BEGIN
	IFSKIP IN(ICHAN,0) THEN
	    BEGIN
		ERROR( 82 );
		% ERRORMSG = 'INPUT ERROR OR EOF' %
		RETURN -1
	    END
    END;

GLOBAL ROUTINE INBUFFER=
    BEGIN
	IFSKIP IN(ICHAN,0) THEN RETURN -1
    END;

GLOBAL ROUTINE GETWORD(BUFFER)=
    BEGIN
	IF (IBUF[2] _ .IBUF[2]-1) LEQ 0 THEN
		IF (INBUF()) LSS 0 THEN RETURN;
	IBUF[1] _ .IBUF[1] + 1;
	@.IBUF[1]
    END;

GLOBAL ROUTINE GETBLK( FIRST, LAST ) =
    BEGIN
	INCR I FROM .FIRST TO .LAST DO (.I)<WORD> _  GETWORD();
    END;


FORWARD	OUTTSWORD;

GLOBAL ROUTINE OPENINPUTDEVICE =
    BEGIN
	IFSKIP OPEN(ICHAN,IOPENBLK)
	    THEN RETURN GOOD
	    ELSE
	    BEGIN
		ERROR( 51 );
		OUTTSWORD( .IOPENBLK[ 1 ] );
		OUTS( ': NOT AVAILABLE OR DOES NOT EXIST?M?J' )
	    END;
	BAD
    END;

GLOBAL ROUTINE OPENOUTPUTDEVICE =
    BEGIN
	IFSKIP OPEN(OCHAN,OOPENBLK)
	    THEN RETURN GOOD
	    ELSE
	    BEGIN
		ERROR( 51 );
		OUTTSWORD( .OOPENBLK[ 1 ] );
		OUTS( ': NOT AVAILABLE OR DOES NOT EXIST?M?J' )
	    END;
	BAD
    END;

GLOBAL ROUTINE GMEM(SIZE)=
    BEGIN
    ! THIS IS A VERY CRUDE COUNTERFIT OF THE GMEM ROUTINE
    ! WHICH IS TO EXIST IN THE KERNAL.
    ! IT RETURNS ONLY 1 32 WORD BLOCK PER CALL
    ! MEMORY MANAGEMENT IS VIA LINKING FREE BLOCKS TOGETHER IN A LINKED LIST
	LOCAL TEMP;

	BIND	BLOCKSIZE=32,
		NUMBERTOGET=10;

	%LOCAL% ROUTINE GCORE(SIZE)= !RETURNS POINTER AS VALUE
	    BEGIN
		REGISTER Q,QQ;
		EXTERNAL ?.JBFF,?.JBREL;
		Q_.?.JBFF;
		IF (QQ_(?.JBFF_.?.JBFF+.SIZE)) GEQ .?.JBREL THEN
		    BEGIN
			IFSKIP CORE(QQ) THEN
			    ELSE
			    BEGIN
				ERROR( 63 );
				CRLF;
				XIT
			    END
		    END;
		.Q
	    END;

	IF DEBUG THEN
	    BEGIN
		IF (.SIZE GTR BLOCKSIZE OR .SIZE LEQ 0) THEN
		    BEGIN
			OUTS('SIZE OUT OF RANGE IN GMEM. MUST BE <=32 AND >0');
			CRLF;
			OUTS('SIZE GIVEN ='); OUTD(.SIZE);CRLF
		    END;
	    END;

	IF .NEXTCORE EQL 0 THEN
	    BEGIN
		REGISTER GOTCHYA;
		NEXTCORE _ GOTCHYA _ GCORE(BLOCKSIZE*NUMBERTOGET);
		DECR I FROM NUMBERTOGET-2 TO 0 DO
		    GOTCHYA _ (.GOTCHYA)<0,36> _ .GOTCHYA + BLOCKSIZE;
		(.GOTCHYA)<0,36> _ 0; %LAST BLOCK'S POINTER = 0%
	    END;
	%IN ANY CASE%
	TEMP _ .NEXTCORE;
	NEXTCORE _ @.NEXTCORE;
	ZERO( .TEMP, %THRU% .TEMP + .SIZE );
	.TEMP
    END;

GLOBAL ROUTINE PMEM(POINTER,SIZE)=
    BEGIN
    ! THIS IS THE COMPLEMENT OF THE COUNTERFIT GMEM
	(.POINTER)<0,36> _ .NEXTCORE;
	NEXTCORE _ .POINTER
    END;
COMMENT;

! ROUTINE GETNAME
! ======= =======
! GETNAME GATHERS AN ARGUEMENT FROM THE GIVEN LINE BUFFER.
!	AND FILLS PARTS OF ARGLIST:
!		ARGTYPE
!		ARGTYPELENGTH
!		PRIM
!		SUB1
!		SUB2
!		SUB3
!		PERIODS
!	STOPS ON ANY ILLEGAL CHARACTERS
!	NOTE: ARGTYPE IS NOT ZEROED IF A TYPE ISN'T SPECIFIED
!	====		 ===
!	RETURNS TRUE IF A / WAS SEEN ELSE FALSE

GLOBAL ROUTINE GETNAME(CBUFF,CBPTR,CCOUNT,CHAR)=
    BEGIN

	REGISTER
		    I;
	BIND NAMETABLE = PLIT(PRIM,SUB1,SUB2,SUB3),	MAXLEVEL = 4;

	COMMASEEN _ SLASHSEEN _ FALSE;
	SKIPBLANKS(.CBUFF,.CBPTR,.CCOUNT,.CHAR);
	I _ GATHER(.CBUFF,.CBPTR,.CCOUNT,.CHAR,PRIM,15);

	IF ..CHAR EQL ":" THEN
	    BEGIN
		ARGTYPELENGTH _ .I;
		ADV(.CBUFF,.CBPTR,.CCOUNT,.CHAR);
		MOVE(PRIM,ARGTYPE,3);
		GATHER(.CBUFF,.CBPTR,.CCOUNT,.CHAR,PRIM,15);
		IF .PRIM EQL ASCII '/' THEN
		    BEGIN
			SLASHSEEN _ TRUE;
			PRIM _ 0
		    END;
		IF .PRIM EQL ASCII ',' THEN
		    BEGIN
			COMMASEEN _ TRUE;
			PRIM _ 0
		    END;
	    END;

	ZERO(SUB1, %THRU% SUB3+2);

	IF .SLASHSEEN OR .COMMASEEN THEN RETURN .SLASHSEEN OR .COMMASEEN;

	I _ 1;
	PERIODS _ 0;
	WHILE ..CHAR EQL "." DO
	    BEGIN
		PERIODS _ .PERIODS + 1;
		ADV(.CBUFF,.CBPTR,.CCOUNT,.CHAR);
		GATHER(.CBUFF,.CBPTR,.CCOUNT,.CHAR,.NAMETABLE[.I],15);
		IF .(.NAMETABLE[.I]) EQL ASCII '/' THEN
		    BEGIN
			SLASHSEEN _ TRUE;
			(.NAMETABLE[.I]) _ 0;
			RETURN .SLASHSEEN
		    END;
		IF .(.NAMETABLE[.I]) EQL ASCII ',' THEN
		    BEGIN
			COMMASEEN _ TRUE;
			(.NAMETABLE[.I]) _ 0;
			RETURN .COMMASEEN
		    END;
		IF (I _ .I + 1) GEQ MAXLEVEL THEN RETURN .SLASHSEEN OR .COMMASEEN
	    END;
	.SLASHSEEN OR .COMMASEEN
    END;
COMMENT;

! ROUTINE GETITEM
! ======= =======

! GETITEM GATHERS AN ARGUEMENT FROM CMDLINE
!	RETURNS VALUE TRUE IF END OF COMMAND [EOL OR COMMENT OR ;] ELSE FALSE
!	SETS INDEX IN ARGLIST=
!		0 IF NONE OF THE BELOW
!		1 IF NOT UNIQUELY ONE OF THE BELOW
!		2 IF NULL
!		3 TREE:
!		4 NODE:
!		5 LEAF:
!		6 MPP:
!		7 TERMINAL:
!		8 PORT:
!		9 NETWORK:
!		10 MISCELLANEOUS:
!		11 ALL:
!		12 CONTINUE:
!
!	FILLS ARGLIST WHICH CONSISTS OF
!		INDEX
!		ARGTYPE
!		ARGTYPELENGTH
!		PRIM
!		SUB1
!		SUB2
!		SUB3
!		PERIODS
!
!	SETS ALLSWITCH
!
!	NOTE: ARGTYPE IS NOT CLEARED BY THIS ROUTINE
!	====             ===

GLOBAL ROUTINE GETITEM =
    BEGIN
	BIND
	    TYPETABLE = PLIT(
		    0,		2,
		    ASCII 'TREES',	3,
		    ASCII 'NODES',	4,
		    ASCII 'LEAFS',	5,		%YES LEAFS IS MISSPELLED%
		    ASCII 'LEAVE',	5,
		    ASCII 'MPPS',	6,
		    ASCII 'TERMI',	7,
		    ASCII 'PORTS',	8,
		    ASCII 'NETWO',	9,
		    ASCII 'MISCE',	10,
		    ASCII 'SYS',	10,
		    ASCII 'ALL',	11,
		    ASCII 'CONTI',	12);

	GETNAME(CMDLINE,CCHAR);		!FILLS ARGTYPE THROUGH SUB3

	IF NOT SEARCHTABLE(TYPETABLE,ARGTYPE,(IF .ARGTYPELENGTH GTR 5 THEN 5 ELSE
		    .ARGTYPELENGTH),1,INDEX) THEN INDEX _ (IF .INDEX NEQ 0 THEN 1 ELSE 0);

	ALLSWITCH _ IF .CCHAR NEQ "/" AND NOT .SLASHSEEN THEN FALSE
	    ELSE
	    BEGIN
		ALLSWITCH _ 0;
		IF NOT .SLASHSEEN THEN ADV(CMDBUFF,CMDBPTR,CMDCOUNT,CCHAR);
		GATHER(CMDLINE,CCHAR,ALLSWITCH,5);
		IF .ALLSWITCH NEQ 'ALL' THEN RETURN(ERROR(2));
		TRUE
	    END;
	RETURN ( IF EOL(CCHAR) OR COMMNT(CCHAR) OR NEWCMD(CCHAR) THEN TRUE ELSE FALSE)

    END;
COMMENT;

! ROUTINE ASKS
! ======= ====
! ASKS THE QUESTION A, ACCEPTS AN ANSWER, LOOKS IT UP IN TABLE B,
!  AND EXECUTES THE ROUTINE SPECIFIED IN TABLE B WITH ARGUEMENT C
! IF A WRONG ANSWER IS GIVEN, THE USER IS NOTIFIED, GIVEN A LIST OF
! VALID ANSWERS, AND ASKED TO TRY AGAIN

GLOBAL ROUTINE ASKS(A,B,C)=
    BEGIN

	LABEL LOOP;
	OWN ATOM;
	LOOP: REPEAT						! UNTIL THE USER GETS IT RIGHT
	    BEGIN
		ASKL( .A );						! TYPE THE QUESTION TO THE USER
									! AND ACCEPT HIS ANSWER
		SIZE _ GATHER(ALINE,ACHAR,ATOM,5);			! GATHER THE FIRST ATOM OF HIS ANSWER
		SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );		! SKIP ANY TRAILING BLANKS
		IF NOT EOL( ACHAR ) THEN ERROR( 9 )			! THEN IF NOT AN END OF LINE COMPLAIN
		    ELSE IF SEARCHTABLE(.B, ATOM, IF .SIZE GTR 5 THEN 5 ELSE .SIZE, 1, EXECUTE) THEN
									! ELSE LOOK THAT ATOM UP IN THE TABLE
		    LEAVE LOOP WITH (.EXECUTE)(.C);			! IF FOUND IN THE TABLE EXECUTE AND LEAVE
		ERROR( 69 );						! OTHERWISE TELL THE USER HE BLEW IT,

		INCR K FROM 0 TO .(.B)[-1] - 2 BY 2 DO		! GIVE HIM A LIST OF VALID ANSWERS,
		    BEGIN
			IF .(.B)[.K] NEQ 0 THEN OUTSN((.B)[.K]<36,7>, 5)
			    ELSE OUTS('<crlf>');
			IF .K NEQ .(.B)[-1] - 2 THEN OUTS(', ')	! AND HAVE HIM TRY AGAIN
		    END;
		OUTPUTC( ")" );
		CRLF
	    END;
	ERRORFLG _ FALSE
    END;

COMMENT;

FORWARD ASKYN;

! ROUTINE CONFIRMED
! ======= =========
! THIS ROUTINE ASKS "ARE YOU SURE" AND RETURNS TRUE IF THE USER THINK
! HE IS SURE, OTHERWISE FALSE IS RETURNED

GLOBAL ROUTINE CONFIRMED =
    BEGIN
	ASKYESORNO( '[ARE YOU SURE]?R(NO, YES?R)[:	??]', FALSE )
    END;

COMMENT;

! ROUTINE TOOLONG
! ======= =======
! THIS ROUTINE CHECKS NAMES TO SEE IF THEY ARE TOO LONG
! CALLED WITH WHERE THE NAME IS (WHERE), WHAT IT'S MAX LENGTH SHOULD BE
! (LEN), AND THE SIZE OF THE FIELD IT IS IN (SIZE)

GLOBAL ROUTINE TOOLONG( WHERE, LEN, SIZE ) =
    BEGIN
	REGISTER BP;

	BP _ (.WHERE)<36,7>;				! MAKE A BYTE POINTER
	DECR I FROM .LEN - 1 TO 0 DO INCP( BP );	! SKIP THE GOOD CHARACTERS
	DECR I FROM .SIZE - .LEN - 1 TO 0 DO		! THEN ANYTHING NOT NULL IS BAD
		IF SCANI( BP ) NEQ 0 THEN RETURN TRUE;
	FALSE
    END;

COMMENT;

! ROUTINE TRUNCATE
! ======= =======
! THIS ROUTINE PUTS NULLS INTO THE NAME FIELD
! CALLED WITH WHERE THE NAME IS (WHERE), WHAT IT'S MAX LENGTH SHOULD BE
! (LEN), AND THE SIZE OF THE FIELD IT IS IN (SIZE)

GLOBAL ROUTINE TRUNCATE( WHERE, LEN, SIZE ) =
    BEGIN
	REGISTER BP;

	BP _ (.WHERE)<36,7>;				! MAKE A BYTE POINTER
	DECR I FROM .LEN - 1 TO 0 DO INCP( BP );	! SKIP THE GOOD CHARACTERS
	DECR I FROM .SIZE - .LEN - 1 TO 0 DO		! THEN INSERT NULLS
		REPLACEI( BP, 0 )
    END;

COMMENT;

! ROUTINE TOOMUCHINPUT
! ======= ============
! THE ROUTINE GENERATES AN ERROR IF THERE IS NOT AN EOL NOW IN
! THE ALTERNATE INPUT LINE

GLOBAL ROUTINE TOOMUCHINPUT =
    BEGIN
	SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
	IF NOT EOL( ACHAR ) THEN ERROR( 9 )
    END;

COMMENT;

! ROUTINE IGNORE
! ======= ======
! THIS ROUTINE IS JUST A DUMMY, IT MERELY RETURNS
! IT IS NEEDED FOR USE IN ASKS ( ASKSTR )

GLOBAL ROUTINE IGNORE = RETURN;

COMMENT;

! ROUTINE SUBQUEUES
! ======= =========
! THIS ROUTINE IS USED TO CHECK FOR THE PRESENCE OF SUBQUEUES

GLOBAL ROUTINE SUBQUEUES =
    BEGIN
	INCR I FROM 0 TO ( ( MAXLEVEL - 1 ) * N0NAMELEN ) - 1 DO
		IF .SUB1[.I] NEQ 0 THEN RETURN TRUE;
	FALSE
    END;

COMMENT;

! ROUTINE ASKCS
! ======= ====
! ASKS THE QUESTION, ACCEPTS AN ANSWER AND STORES THE RESPONSE
! (UP TO LEN CHARACTERS) AT ATOM

FORWARD COLLECTCHARS(2);

GLOBAL ROUTINE ASKCS(QUESTION, ATOM, LEN)=
    BEGIN

	ASKL( .QUESTION );					! TYPE THE QUESTION TO THE USER
								! AND ACCEPT HIS ANSWER
								! SKIP LEADING BLANKS
	SIZE _ COLLECTCHARS(.ATOM,.LEN);			! GATHER THE FIRST ATOM OF HIS ANSWER
	IF .SIZE EQL 0 THEN CRONLY ELSE NOT CRONLY

    END;

COMMENT;

! ROUTINE GETNUM
! ======= ======
! THIS ROUTINE GATHERS A NUMBER FROM THE LINE GIVEN USING THE BASE
! GIVEN.  THE ROUTINE STOPS ON THE FIRST NON-NUMERIC CHARACTER.

GLOBAL ROUTINE GETNUM( BASE, BUFF, BPTR, COUNT, CHAR ) =
    BEGIN
	REGISTER VALUE;

	SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR);

	VALUE _ 0;

	WHILE NUMERIC( .CHAR ) AND (..CHAR - "0" LSS .BASE) DO
	    BEGIN
		VALUE _ .VALUE * .BASE + (..CHAR - "0");
		ADV( .BUFF, .BPTR, .COUNT, .CHAR)
	    END;

	.VALUE
    END;
COMMENT;

! ROUTINE GETPPN
! ======= ======
! THIS ROUTINE GATHERS A PROJECT-PROGRAMMER PAIR FROM THE SPECIFIED
! LINE.  THIS ROUTINE STARTS AFTER THE "[" AND PROCEDES THRU THE "]".

GLOBAL ROUTINE GETPPN( BUFF, BPTR, COUNT, CHAR ) =
    BEGIN
	REGISTER VALUE;
	REGISTER MYPPN;

	ADV( .BUFF, .BPTR, .COUNT, .CHAR );		! SKIP THE "["

	VALUE<LH> _ GETNUM( BASE8, .BUFF, .BPTR, .COUNT, .CHAR);

	SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR );

	IF ..CHAR NEQ "," THEN				! BETTER HAVE A COMMA BETWEEN THE NUMBERS
	    BEGIN
		ERROR(4);
		RETURN
	    END;

	ADV( .BUFF, .BPTR, .COUNT, .CHAR);		! SKIP THE COMMA

	VALUE<RH> _ GETNUM( BASE8, .BUFF, .BPTR, .COUNT, .CHAR);

	SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR );

	IF ..CHAR NEQ "]" THEN				! BETTER END WITH A "]"
	    BEGIN
		ERROR(4);
		RETURN
	    END;

	ADV( .BUFF, .BPTR, .COUNT, .CHAR);		! SKIP THE "]"

	IF .VALUE<LH> EQL 0 OR .VALUE<RH> EQL 0 THEN %DEFAULT THE PPN% 
	  BEGIN
		CALLI(MYPPN,%GETPPN% #24);
	        IF .VALUE<LH> EQL 0 THEN VALUE<LH> _ .MYPPN<LH>;
		IF .VALUE<RH> EQL 0 THEN VALUE<RH> _ .MYPPN<RH>
	   END;
	.VALUE

    END;
COMMENT;

! ROUTINE SIXWORD
! ======= =======
! THIS ROUTINE RETURNS A SIXBIT WORD FROM THE CHARACTERS POINTED TO
! BY THE CALLING ARGUEMENT. NO ERROR CHECKING IS DONE.

GLOBAL ROUTINE SIXWORD( ASCIISTRING ) =
    BEGIN
	REGISTER
		TEMP,
		VALUE,
		BPS,
		BPA;

	BPS _ VALUE<36,6>;
	BPA _ (.ASCIISTRING)<36,7>;

	DECR I FROM 5 TO 0 DO
		REPLACEI( BPS, ( IF ( TEMP _ SCANI(BPA) ) EQL 0 THEN 0 ELSE .TEMP - #40) );

	.VALUE

    END;
COMMENT;

! ROUTINE GETFD
! ======= =====
! THIS ROUTINE GATHERS A FILE SPEC FROM THE LINE SPECIFIED

GLOBAL ROUTINE GETFD( BUFF, BPTR, COUNT, CHAR, SPECBLK ) =
    BEGIN

	OWN
		ATOM[2];

	MAP	FORMAT SPECBLK;

	ZERO( ARGLIST, ARGTYPELENGTH );

	GETNAME( .BUFF, .BPTR, .COUNT, .CHAR);

	IF .SUB2 NEQ 0 OR .SUB3 NEQ 0 THEN
	    BEGIN
		ERROR( 6 );
		RETURN
	    END;

	IF .SUB1 NEQ 0 AND .PRIM EQL 0 THEN
	    BEGIN
		ERROR( 20 );
		RETURN
	    END;

	SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR);

	SPECBLK[SB0DEVICE] _ SIXWORD( ARGTYPE );
	SPECBLK[SB0NAME] _ SIXWORD( PRIM );
	SPECBLK[SB0EXT] _ ( SIXWORD( SUB1 ); .VREG<LH> );
	SPECBLK[SB0CORE] _ 0;
	SPECBLK[SB0PPN] _ 0;

	IF EOL(.CHAR) OR ..CHAR EQL "," OR .SLASHSEEN OR .COMMASEEN THEN RETURN .SLASHSEEN OR .COMMASEEN;

	IF ..CHAR EQL "[" THEN
	    BEGIN
		SPECBLK[SB0PPN] _ GETPPN( .BUFF, .BPTR, .COUNT, .CHAR );
		SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR )
	    END;

	IF EOL( .CHAR ) OR ..CHAR EQL "," OR ..CHAR EQL "/" OR .ERRORFLG THEN RETURN;

	GATHER( .BUFF, .BPTR, .COUNT, .CHAR, ATOM, 6 );

	IF ..CHAR EQL ":" THEN
	    BEGIN
		IF .ARGTYPE NEQ 0 THEN
		    BEGIN
			ERROR( 21 );
			RETURN
		    END;
		SPECBLK[SB0DEVICE] _ SIXWORD( ATOM )
	    END
	    ELSE ERROR( 9 );

	ADV( .BUFF, .BPTR, .COUNT, .CHAR );		! SKIP THE ":"

	SKIPBLANKS( .BUFF, .BPTR, .COUNT, .CHAR );

	IF NOT ( EOL( .CHAR ) OR ..CHAR EQL "," ) THEN ERROR( 9 )

    END;
COMMENT;

! ROUTINE ASKNUM
! ======= ======
! THIS ROUTINE ASKS THE USER A QUESTION, ACCEPTS A RESPONSE, TRYS
! TO CONVERT THE RESPONSE TO A NUMBER OF THE BASE REQUESTED, AND
! CHECKS TO SEE IF THE NUMBER IS WITHIN THE RANGES SPECIFIED IN THE
! CALL.

GLOBAL ROUTINE ASKNUM( BASE, QUESTION, DEFAULTOKFLAG, DEFAULTVALUE, MINVALUE, MAXVALUE ) =
    BEGIN
	LABEL	LOOP1, LOOP2;
	OWN	VALUE;

LOOP1:	REPEAT						! UNTIL WE GET A GOOD ANSWER DO
	    BEGIN
LOOP2:		REPEAT					! UNTIL WE GET AN ANSWER IF A DEFAULT IS NOT ALLOWED DO
		    BEGIN
								! ASK THE QUESTION
								! ACCEPT AN ANSWER
			IF ASKL( .QUESTION ) THEN		! IF ONLY AN EOL THEN
				IF .DEFAULTOKFLAG THEN RETURN .DEFAULTVALUE
							! IF DEFAULT OK THEN RETURN DEFAULT
				    ELSE
				    BEGIN
					ERROR( 24 );	! OTHERWISE TELL THE USER HE DID A NO NO
					WARN( 0 )
				    END
			    ELSE LEAVE LOOP2		! IF NOT EOL THEN LEAVE THIS LOOP
		    END;

		VALUE _ GETNUM( .BASE, ALINE, ACHAR );	! CONVERT NUMBER

		SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );	! SKIP TRAILING BLANKS

		IF NOT EOL( ACHAR ) THEN		! NOW IF NOT EOL THEN ERROR( TOO MUCH INPUT )
		    BEGIN
			ERROR( 9 );
			WARN( 0 )
		    END
		    ELSE
			IF .VALUE LEQ .MAXVALUE AND	! IF EOL THEN CHECK IF IN RANGE
			   .VALUE GEQ .MINVALUE THEN RETURN .VALUE
							! IF IN RANGE THEN RETURN THE NUMBER
			    ELSE
			    BEGIN
				ERROR( 22 );		! OTHERWISE INFROM THE USER AND TRY AGAIN
				OUTS( 'MIN: ' );
				OUTN( .MINVALUE, .BASE, 1 );
				OUTS( ' , MAX: ' );
				OUTN( .MAXVALUE, .BASE, 1 );
				OUTS( ' )?M?J' );
				WARN( 0 )
			    END

	    END
    END;
FORWARD	MATCHALINE;

COMMENT;

! ROUTINE NASKNUM
! ======= ======
! THIS ROUTINE ASKS THE USER A QUESTION, ACCEPTS A RESPONSE, TRYS
! TO CONVERT THE RESPONSE TO A NUMBER OF THE BASE REQUESTED, AND
! CHECKS TO SEE IF THE NUMBER IS WITHIN THE RANGES SPECIFIED IN THE
! CALL. THIS ROUTINE DIFFERS FROM ASKNUM IN THAT A SYMBOLIC
! RESPONSE SUCH AS "<NONE>" MAY BE ACCEPTED.


GLOBAL ROUTINE NASKNUM( BASE, QUESTION, DEFAULTOKFLAG, DEFAULTVALUE, SRES, MINVALUE, MAXVALUE ) =
    BEGIN
	LABEL	LOOP1, LOOP2;
	OWN	SFLAG,
		VALUE;
	MAP	FORMAT SRES;

LOOP1:	REPEAT						! UNTIL WE GET A GOOD ANSWER DO
	    BEGIN
LOOP2:		REPEAT					! UNTIL WE GET AN ANSWER IF A DEFAULT IS NOT ALLOWED DO
		    BEGIN
								! ASK THE QUESTION
								! ACCEPT AN ANSWER
			IF ASKL( .QUESTION ) THEN		! IF ONLY AN EOL THEN
				IF .DEFAULTOKFLAG THEN RETURN .DEFAULTVALUE
							! IF DEFAULT OK THEN RETURN DEFAULT
				    ELSE
				    BEGIN
					ERROR( 24 );	! OTHERWISE TELL THE USER HE DID A NO NO
					WARN( 0 )
				    END
			    ELSE LEAVE LOOP2		! IF NOT EOL THEN LEAVE THIS LOOP
		    END;

		SFLAG _ FALSE;

		IF .SRES NEQ 0 THEN
			IF MATCHALINE( SRES[SRES0LIT] ) THEN
			    BEGIN
				VALUE _ .SRES[ SRES0VAL ];
				SFLAG _ TRUE
			    END;
		IF NOT .SFLAG THEN VALUE _ GETNUM( .BASE, ALINE, ACHAR );	! CONVERT NUMBER

		SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );	! SKIP TRAILING BLANKS

		IF NOT EOL( ACHAR ) THEN		! NOW IF NOT EOL THEN ERROR( TOO MUCH INPUT )
		    BEGIN
			ERROR( 9 );
		    END
		    ELSE
		    BEGIN
			IF .SFLAG THEN RETURN .VALUE;	! IF A SPECIAL RESPONSE THEN NO NEED TO CHECK RANGE
			IF .VALUE LEQ .MAXVALUE AND	! IF EOL THEN CHECK IF IN RANGE
			   .VALUE GEQ .MINVALUE THEN RETURN .VALUE
							! IF IN RANGE THEN RETURN THE NUMBER
			    ELSE
			    BEGIN
				ERROR( 22 );		! OTHERWISE INFROM THE USER AND TRY AGAIN
				OUTS( 'MIN: ' );
				OUTN( .MINVALUE, .BASE, 1 );
				OUTS( ' , MAX: ' );
				OUTN( .MAXVALUE, .BASE, 1 );
				OUTS( ' )?M?J' );
			    END
		    END;
		WARN( 0 )
	    END
    END;
COMMENT;

! ROUTINE ASKFD
! ======= ========
! THIS ROUTINE ASK THE QUESTION SUPPLIED, ACCEPTS AN ANSWER, AND TRYS
! TO DECODE THE ANSWER AS A FILE SPEC.

GLOBAL ROUTINE ASKFD( QUESTION, SPECBLK ) =
    BEGIN

NOTE;		WHAT HAPPENS TO THE SLASHSEEN RETURN FROM GETFD?
	DO
	    BEGIN
		IF ASKL( .QUESTION ) THEN RETURN CRONLY;

		GETFD( ALINE, ACHAR, .SPECBLK );

		IF .ERRORFLG THEN WARN( 0 )
	    END
	WHILE .ERRORFLG;

	NOT CRONLY
    END;
COMMENT;

! ROUTINE NASKFD
! ======= ========
! THIS ROUTINE ASK THE QUESTION SUPPLIED, ACCEPTS AN ANSWER, AND TRYS
! TO DECODE THE ANSWER AS A FILE SPEC.

GLOBAL ROUTINE NASKFD( QUESTION, NEWSPECBLK, SRES, OLDSPECBLK ) =
    BEGIN

	MAP	FORMAT SRES;

NOTE;		WHAT HAPPENS TO THE SLASHSEEN RETURN FROM GETFD?
	DO
	    BEGIN
		IF ASKL( .QUESTION ) THEN
		    BEGIN
			MOVE( .OLDSPECBLK, .NEWSPECBLK, SPECBLKLEN );
			RETURN CRONLY
		    END;

		IF .SRES NEQ 0 THEN
			IF MATCHALINE( SRES[SRES0LIT] ) THEN
			    BEGIN
				MOVE( .SRES[SRES0VAL], .NEWSPECBLK, SPECBLKLEN );
				RETURN NOT CRONLY
			    END;

		! ELSE !

		GETFD( ALINE, ACHAR, .NEWSPECBLK );

		IF .ERRORFLG THEN WARN( 0 )
	    END
	WHILE .ERRORFLG;

	NOT CRONLY
    END;
COMMENT;

! ROUTINE ASKBS
! ======= =======
! THIS ROUTINE ASKS THE QUESTION SPECIFIED, ACCEPTS A RESPONSE, AND
! TRYS TO FORM A BIT STRING OUT OF THE ANSWER

FORWARD COLLECTOITS(2), COLLECTCHARS(2);

GLOBAL ROUTINE ASKBS( QUESTION, ATOM, LEN ) =
    BEGIN

	OWN	SIZE;

	XTYPE( .QUESTION );

	ACHAR _ INPUT( ALINE, ALINELENGTH );

	IF EOL( ACHAR ) THEN RETURN CRONLY;

	SIZE _ COLLECTOITS( .ATOM, .LEN);
	IF .SIZE GTR .LEN THEN WARN( 7 );

	NOT CRONLY
    END;
COMMENT;

! ROUTINE COLLECTOITS
! ======= ===========
! THIS ROUTINE COLLECTS OCTAL DIGITS AS A BIT STRING

ROUTINE COLLECTOITS( ATOM, LEN ) =
    BEGIN
	REGISTER COUNT,Z,BP;

	COUNT_0;
	BP_(.ATOM)<36,7>;
	WHILE NOT EOL( ACHAR )  DO
	    BEGIN
		IF .COUNT LSS .LEN THEN
		    BEGIN
			IF .ACHAR NEQ "#" THEN
			    BEGIN
				REPLACEI(BP,.ACHAR);
				ADV(ABUFF,ABPTR,ACOUNT,ACHAR)
			    END
			    ELSE
			    BEGIN
				ADV(ABUFF,ABPTR,ACOUNT,ACHAR);
				IF .ACHAR EQL "#" THEN
				    BEGIN
					REPLACEI(BP,.ACHAR);
					ADV(ABUFF,ABPTR,ACOUNT,ACHAR)
				    END
				    ELSE
					REPLACEI(BP, GETNUM( BASE8, ABUFF, ABPTR, ACOUNT, ACHAR ))
					! NOTE IT IS POSSIBLE THE GETNUM WILL PRODUCE A NUMBER TOO LARGE
					! THIS SHOULD BE CHECKED FOR, BUT NOW IT IS IGNORED
			    END
		    END
		    ELSE ADV(ABUFF,ABPTR,ACOUNT,ACHAR);
		COUNT_.COUNT+1
	    END;
	Z_.COUNT;
	WHILE .Z LSS .LEN DO ( Z _ .Z+1; REPLACEI(BP,0));	!FILL WITH NULLS
	.COUNT

    END;
COMMENT;

! ROUTINE COLLECTCHARS
! ======= ============
! THIS ROUTINE COLLECTS CHARACTERS FOR A BIT STRING. THIS DIFFERS
! FROM GATHER IN THAT LEADING SPACES ARE NOT SUPPRESSED, AND ONLY
! AND EOL STOPS THE GATHERING

ROUTINE COLLECTCHARS( ATOM, LEN ) =
    BEGIN
	REGISTER GNC,Z,PACCUM;

	GNC_0;
	PACCUM_(.ATOM)[-1]<1,7>;
	WHILE NOT EOL( ACHAR )  DO
	    BEGIN
		IF .GNC LSS .LEN THEN REPLACEI(PACCUM,.ACHAR);
		ADV(ABUFF,ABPTR,ACOUNT,ACHAR);
		GNC_.GNC+1
	    END;
	Z_.GNC;
	WHILE .Z LSS .LEN DO ( Z _ .Z+1; REPLACEI(PACCUM,0));	!FILL WITH NULLS
	IF .Z GTR .LEN THEN WARN( 6 );	! COMPLAIN IF INPUT TOO LONG
	.GNC

    END;
COMMENT;

! ROUTINE GETSZ
! ======= =======
! THIS ROUTINE TRIES TO CONVERT THE ANSWER IN ALINE INTO A SIZE SPECIFICATION.

GLOBAL ROUTINE GETSZ =
    BEGIN

	REGISTER VALUE;

	VALUE _ GETNUM( BASE10, ALINE, ACHAR );

	SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );

	SELECT TRUE OF
	    NSET
		.ACHAR EQL "K" OR EOL( ACHAR ):
			IF .VALUE GTR 256 THEN
				ERROR( 23 )
			    ELSE
			    BEGIN
				ADV( ABUFF, ABPTR, ACOUNT, ACHAR );
				SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
				IF NOT EOL( ACHAR ) THEN ERROR( 9 )
					ELSE RETURN KFLAG + .VALUE
			    END;

		.ACHAR EQL "P":
			IF .VALUE GTR 512 THEN
				ERROR( 23 )
			    ELSE
			    BEGIN
				ADV( ABUFF, ABPTR, ACOUNT, ACHAR );
				SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
				IF NOT EOL( ACHAR ) THEN ERROR( 9 )
					ELSE RETURN .VALUE
			    END;

		OTHERWISE:
			ERROR( 9 );

	    TESN;

	-1			! RETURN BAD ANSWER INDICATOR

    END;
COMMENT;

! ROUTINE ASKSZ
! ======= =======
! THIS ROUTINE ASKS THE QUESTION SPECIFIED, ACCEPTS AN ANSWER, AND TRYS
! TO CONVERT THAT ANSWER INTO A SIZE SPECIFICATION.

GLOBAL ROUTINE ASKSZ( QUESTION ) =
    BEGIN

	REGISTER VALUE;

	REPEAT
	    BEGIN
		IF ASKL( .QUESTION ) THEN RETURN 0;

		VALUE _ GETSZ();

		IF .VALUE<LH> EQL 0 THEN RETURN .VALUE;

		! ELSE !

		WARN( 0 );

	    END

    END;
COMMENT;

! ROUTINE NASKSZ
! ======= =======
! THIS ROUTINE ASKS THE QUESTION SPECIFIED, ACCEPTS AN ANSWER, AND TRYS
! TO CONVERT THAT ANSWER INTO A SIZE SPECIFICATION.
! THIS ROUTINE DIFFERS FROM ASKSZ IN THAT A SYMBOLIC ANSWER SUCH AS
! "<AS REQ'D>" MAY BE ACCEPTED DEPENDING ON SRES

GLOBAL ROUTINE NASKSZ( QUESTION, SRES, OLDVALUE ) =
    BEGIN

	REGISTER VALUE;
	MAP	FORMAT SRES;

	REPEAT
	    BEGIN
		IF ASKL( .QUESTION ) THEN RETURN .OLDVALUE;

		IF .SRES NEQ 0 THEN
		    BEGIN
			IF MATCHALINE( SRES[SRES0LIT] ) THEN RETURN .SRES[ SRES0VAL ]
		    END;

		! ELSE !

		VALUE _ GETSZ();

		IF .VALUE<LH> EQL 0 THEN RETURN .VALUE;

		! ELSE !

		WARN( 0 );

	    END

    END;
COMMENT;

! ROUTINE OUTTSWORD
! ======= ===========
! THIS ROUTINE OUTPUTS A WORD AS SIX SIXBIT CHARACTERS

GLOBAL ROUTINE OUTTSWORD( AWORD ) =
    BEGIN
	REGISTER
		TEMP,
		BP;
	LABEL	LOOP;

	BP _ AWORD<36,6>;

LOOP:	DECR I FROM 5 TO 0 DO
		IF ( TEMP _ SCANI( BP ) ) EQL 0 THEN LEAVE LOOP ELSE OUTPUTC( .TEMP + #40 )

    END;
COMMENT;

! ROUTINE OUTTSHALFW
! ======= ============
! THIS ROUTINE OUTPUTS THREE SIXBIT CHARACTERS FROM THE RIGHT HALF OF
! THE WORD SUPPLIED

GLOBAL ROUTINE OUTTSHALFW( AWORD ) =
    BEGIN
	REGISTER
		TEMP,
		BP;
	LABEL	LOOP;

	BP _ AWORD<18,6>;

LOOP:	DECR I FROM 2 TO 0 DO
		IF ( TEMP _ SCANI( BP ) ) EQL 0 THEN LEAVE LOOP ELSE OUTPUTC( .TEMP + #40 )
    END;
COMMENT;

! ROUTINE OUTTM
! ======= =======
! THIS ROUTINE OUTPUT THE SINGLE CHARACTER SPECIFIED THE SPECIFIED
! NUMBER OF TIMES

GLOBAL ROUTINE OUTTM( CHAR, NUM ) =
    BEGIN
	DECR I FROM .NUM - 1 TO 0 DO
		OUTPUTC( .CHAR )
    END;
COMMENT;

! ROUTINE OUTTN
! ======= =======
! THIS ROUTINE OUTPUTS THE NUMBER SUPPLIED IN THE BASE SPECIFIED

GLOBAL ROUTINE OUTTN( NUM, BASE, REQD ) =
    BEGIN
	OWN
		N,
		B,
		RD,
		T;

	%LOCAL% ROUTINE XN =
	    BEGIN
		LOCAL R;
		IF .N EQL 0 THEN RETURN OUTPUTM("0", .RD - .T);
		R _ .N MOD .B;
		N _ .N / .B;
		T _ .T + 1;
		XN();
		OUTPUTC( .R + "0" )
	    END;

	IF .NUM LSS 0 THEN OUTPUTC( "-" );
	B _ .BASE;
	RD _ .REQD;
	T _ 0;
	N _ ABS( .NUM );
	XN()

    END;
COMMENT;

! ROUTINE OUTN
! ======= =======
! THIS ROUTINE OUTS THE NUMBER SUPPLIED IN THE BASE SPECIFIED

GLOBAL ROUTINE OUTN( NUM, BASE, REQD ) =
    BEGIN
	OWN
		N,
		B,
		RD,
		T;

	%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();
		OUTC( .R + "0" )
	    END;

	IF .NUM LSS 0 THEN OUTC( "-" );
	B _ .BASE;
	RD _ .REQD;
	T _ 0;
	N _ ABS( .NUM );
	XN()

    END;
COMMENT;

! ROUTINE OUTTFSPEC
! ======= ===========
! THIS ROUTINE OUTPUTS A FILE SPECIFICATION IN THE FORM:
! "DEV:NAME.EXT[PPN]"

GLOBAL ROUTINE OUTTFSPEC( SPECBLK ) =
    BEGIN
	MAP	FORMAT SPECBLK;

	IF .SPECBLK[SB0DEVICE] NEQ 0 THEN
	    BEGIN
		OUTPUTSWORD( .SPECBLK[SB0DEVICE] );
		OUTPUTC( ":" )
	    END;

	IF .SPECBLK[SB0NAME] NEQ 0 THEN
	    BEGIN
		OUTPUTSWORD( .SPECBLK[SB0NAME] );
		IF .SPECBLK[SB0EXT] NEQ 0 THEN
		    BEGIN
			OUTPUTC( "." );
			OUTPUTSHALFW( .SPECBLK[SB0EXT] )
		    END
	    END;

	IF .SPECBLK[SB0PPN] NEQ 0 THEN
	    BEGIN
		OUTPUTC( "[" );
		OUTPUTO( .SPECBLK[SB0PROJ] );
		OUTPUTC( "," );
		OUTPUTO( .SPECBLK[SB0PROG] );
		OUTPUTC( "]" )
	    END

    END;
COMMENT;

! ROUTINE ATTACH
! ======= ======
! THIS ROUTINE IS THE LINK ROUTINE WITH AN ARBITRARY LINK WORD

GLOBAL ROUTINE ATTACH( KEY, NODE, OFFSETT ) =
    BEGIN
	REGISTER LAST;

	IF .KEY EQL 0 THEN
	    BEGIN
		(.NODE)[.OFFSETT] _ 0;
		(.KEY)<FORE> _ (.KEY)<AFT> _ .NODE;
		RETURN
	    END;

	! ELSE !

	LAST _ .(.KEY)<AFT>;
	(.LAST)[.OFFSETT]<FORE> _ .NODE;
	(.NODE)[.OFFSETT]<AFT> _ .LAST;
	(.KEY)<AFT> _ .NODE

    END;
COMMENT;

! ROUTINE UNATTACH
! ======= ========
! THIS ROUTINE IS THE CONVERSE OF ATTACH

GLOBAL ROUTINE UNATTACH( KEY, NODE, OFFSETT ) =
    BEGIN

	REGISTER
		LAST,
		NEXT;

	IF .(.NODE)[.OFFSETT]<WORD> EQL 0 THEN
	    BEGIN
		(.KEY) _ 0;
		RETURN
	    END;

	! ELSE !

	IF ( LAST _ .(.NODE)[.OFFSETT]<AFT> ) NEQ 0 THEN
	    BEGIN
		(.LAST)[.OFFSETT]<FORE> _ .(.NODE)[.OFFSETT]<FORE>
	    END;

	IF ( NEXT _ .(.NODE)[.OFFSETT]<FORE> ) NEQ 0 THEN
	    BEGIN
		(.NEXT)[.OFFSETT]<AFT> _ .(.NODE)[.OFFSETT]<AFT>
	    END;

	(.NODE)[.OFFSETT] _ 0

    END;
COMMENT;

! ROUTINE ASKYN
! ======= =========
! THIS ROUTINE ASKS A QUESTION, ACCEPTS A YES OR NO RESPONSE, AND
! RETURNS TRUE IF YES OR FALSE IF NO

GLOBAL ROUTINE ASKYN( Q, DEFAULT ) =
    BEGIN
	OWN VALUE;

	%LOCAL% ROUTINE SETTRUE = VALUE _ TRUE;

	%LOCAL% ROUTINE SETFALSE = VALUE _ FALSE;

	%LOCAL% ROUTINE SETDEFAULT( DEFAULT ) = VALUE _ .DEFAULT;

	ASKS( .Q,
		PLIT(	ASCII	'NO',	SETFALSE,
			ASCII	'YES',	SETTRUE,
			0,		SETDEFAULT),
		.DEFAULT);

	.VALUE

    END;
COMMENT;

! ROUTINE ASKNM
! ======= =====
! THIS ROUTINE ASKS THE QUESTION SUPPLIED AND REQUESTS AN NAME AS
! INPUT

GLOBAL ROUTINE ASKNM( Q, LEN ) =
    BEGIN
									! TYPE THE QUESTION
	IF ASKL( .Q ) THEN RETURN ( PRIM _ 0 );				! ACCEPT AN ALTERNATE LINE ANSWER
								    	! IF THE LINE WAS EMPTY RETURN 0
	IF NOT .ERRORFLG THEN GETNAME(ALINE,ACHAR);			! IF NO ERROR ACCEPTING THE LINE THEN GATHER A NAME
	IF NOT .ERRORFLG THEN TOOMUCHINPUT();				! IF NOT END OF LINE THEN ERROR
	IF NOT .ERRORFLG THEN IF SUBQUEUES() THEN ERROR( 15 );	! IF STILL NO ERRORS, SEE IF THE USER
								    	! PUT PERIODS IN THE NAME
	IF NOT .ERRORFLG THEN
		IF TOOLONG( PRIM, .LEN, .LEN * 5 ) THEN
		    BEGIN
			WARN( 6 );
			TRUNCATE( PRIM, .LEN, .LEN * 5 )
		    END;
	IF .ERRORFLG THEN 0 ELSE 1					! IF ERROR IN ANY PART, RETURN 0 ELSE 1
    END;
FORWARD	ASKL;

COMMENT;

! ROUTINE ASK2FD
! ======= ======
! THIS ROUTINE ASKS FOR A PAIR OF FILE SPECS

GLOBAL ROUTINE ASK2FD( Q, SB1, SB2 ) =
    BEGIN
	ZERO( .SB1, .SB1 + SPECBLKLEN );
	ZERO( .SB2, .SB2 + SPECBLKLEN );
	DO
	    BEGIN
		IF ASKL( .Q ) THEN RETURN CRONLY;

		GETFD( ALINE, ACHAR, .SB1 );
		IF NOT .ERRORFLG THEN
		    BEGIN
			IF EOL( ACHAR ) THEN RETURN NOT CRONLY;
			IF .ACHAR NEQ "," AND NOT .COMMASEEN THEN ERROR( 83 );
			IF NOT .COMMASEEN THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR );		! SKIP THE COMMA
			IF NOT .ERRORFLG THEN GETFD( ALINE, ACHAR, .SB2 );
		    END;

		IF .ERRORFLG THEN WARN( 0 );
	    END
	WHILE .ERRORFLG;

	NOT CRONLY
    END;
COMMENT;

! ROUTINE NASK2FD
! ======= ======
! THIS ROUTINE ASKS FOR A PAIR OF FILE SPECS

GLOBAL ROUTINE NASK2FD( Q, SB1, SB2 ) =
    BEGIN
	DO
	    BEGIN
		IF ASKL( .Q ) THEN RETURN CRONLY;

		IF MATCHALINE( NONE ) THEN ZERO( .SB1, .SB1 + SPECBLKLEN ) ELSE GETFD( ALINE, ACHAR, .SB1 );
		IF NOT .ERRORFLG THEN
		    BEGIN
			IF EOL( ACHAR ) THEN RETURN NOT CRONLY;
			IF .ACHAR NEQ "," AND NOT .COMMASEEN THEN ERROR( 83 );
			IF NOT .COMMASEEN THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR );		! SKIP THE COMMA
			IF NOT .ERRORFLG THEN IF MATCHALINE( NONE ) THEN ZERO( .SB2, .SB2 + SPECBLKLEN ) ELSE GETFD( ALINE, ACHAR, .SB2 );
		    END;

		IF .ERRORFLG THEN WARN( 0 );
	    END
	WHILE .ERRORFLG;

	NOT CRONLY
    END;
COMMENT;

! ROUTINE OUTTBS
! ======= ======
! THIS ROUTINE OUTPUTS A BIT STRING

GLOBAL ROUTINE OUTTBS( WHERE, LEN ) =
    BEGIN
	REGISTER
		BP,
		CHAR;
	LABEL	SEL;

	BP _ (.WHERE)<36,7>;

	DECR I FROM .LEN - 1 TO 0 DO
	    BEGIN
		CHAR _ SCANI( BP );
SEL:		SELECT TRUE OF
		    NSET
			.CHAR EQL "#":	( OUTPUT( '##' ); LEAVE SEL );
			.CHAR GTR " " AND .CHAR LEQ "\":	( OUTPUTC( .CHAR ); LEAVE SEL );
			OTHERWISE:	( OUTPUTC( "#" ); OUTPUTO( .CHAR ));
		   TESN
	    END
    END;
COMMENT;

! ROUTINE GETSWITCH
! ======= =========
! THIS ROUTINE IS A GATHER THAT WILL SKIP A LEADING /

GLOBAL ROUTINE GETSWITCH( BUFF, BPTR, COUNT, CHAR, SWITCH ) =
    BEGIN
	REGISTER SIZE;
	SIZE _ .SWITCH _ 0;
	IF .SLASHSEEN OR ..CHAR EQL "/" THEN
	    BEGIN
		IF NOT .SLASHSEEN THEN ADV( .BUFF, .BPTR, .COUNT, .CHAR );
		SIZE _ GATHER( .BUFF, .BPTR, .COUNT, .CHAR, .SWITCH, 5 )
	    END;
	.SIZE
    END;
COMMENT;

! ROUTINE ASKSW
! ======= ===========
! THIS ROUTINE ASKS THE QUESTION SUPPLIED, ACCEPTS AN INPUT, AND
! GATHERS A SWITCH FROM IT

GLOBAL ROUTINE ASKSW( Q, SWITCH ) =
    BEGIN
	WHILE ASKL( .Q ) DO
	    BEGIN
		ERROR( 104 );
		WARN( 0 )
	    END;

	IF .ACHAR EQL "/" THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR );
	GATHER( ABUFF, ABPTR, ACOUNT, ACHAR, .SWITCH, 5 )	! NOTE RETURN SIZE
    END;
COMMENT;

! ROUTINE ASKSTAT
! ======= =======
! THIS ROUTINE ASKS THE QUESTION SUPPLIED AND ACCEPTS AS
! A RESPONSE "ENABLED" OR "DISABLED".
! IT RETURNS TRUE IF ENABLED OR FALSE IF DISABLED

GLOBAL ROUTINE ASKSTAT( Q, DEFAULT ) =
    BEGIN
	OWN VALUE;

	%LOCAL% ROUTINE SETENA = VALUE _ ENABLED;

	%LOCAL% ROUTINE SETDIS = VALUE _ DISABLED;

	VALUE _ .DEFAULT;

	ASKS(	.Q,
		PLIT(	ASCII 'ENABL',	SETENA,
			ASCII 'DISAB',	SETDIS,
			0,		IGNORE ),
		0 );

	.VALUE
    END;

COMMENT;

! ROUTINE OUTCOM
! ======= ======
! THIS ROUTINE OUTPUTS A COMMA

GLOBAL ROUTINE OUTCOM =
    BEGIN
	OUTPUTC( "," )
    END;

COMMENT;

! ROUTINE OUTCRLF
! ======= ======
! THIS ROUTINE OUTPUTS A CARRIAGE RETURN/LINE FEED

GLOBAL ROUTINE OUTCRLF =
    BEGIN
	OUTPUT( '?M?J' )
    END;

COMMENT;

! ROUTINE OUTTAB
! ======= ======
! THIS ROUTINE OUTPUTS A HORIZONTAL TAB

GLOBAL ROUTINE OUTTAB =
    BEGIN
	OUTPUTC( "?I" )
    END;

COMMENT;

! ROUTINE OUTBOO
! ======= ======
! THIS ROUTINE OUTPUTS "TRUE" IF THE ARG IS TRUE ELSE "FALSE"

GLOBAL ROUTINE OUTBOO( BOOL ) =
    BEGIN
	IF .BOOL THEN OUTPUT( 'TRUE' ) ELSE OUTPUT( 'FALSE' )
    END;

COMMENT;

! ROUTINE OUTTFB
! ======= ======
! THIS ROUTINE OUTPUTS A SPECBLK IN THE FORM:
!	"<TAB>SIXBIT<TAB>/" DEVICE "/<CRLF>"
!	"<TAB>SIXBIT<TAB>/" NAME "/<CRLF>"
!	"<TAB>SIXBIT<TAB>/" EXTENSION "/<CRLF>"
!	"<TAB>XWD<TAB>" PROJ "," PROG "<CRLF>"

GLOBAL ROUTINE OUTTFB( SPECBLK ) =
    BEGIN
	MAP	FORMAT SPECBLK;

	OUTPUT( '	SIXBIT	/' );
	IF .SPECBLK[SB0DEVICE] EQL 0 AND .SPECBLK[ SB0NAME ] NEQ 0 THEN OUTPUT( 'DSK' )
	     ELSE OUTPUTSWORD( .SPECBLK[SB0DEVICE] );
	OUTPUT( '/?M?J' );

	OUTPUT( '	SIXBIT	/' );
	OUTPUTSWORD( .SPECBLK[SB0NAME] );
	OUTPUT( '/?M?J' );

	OUTPUT( '	SIXBIT	/' );
	OUTPUTSHALF( .SPECBLK[SB0EXT] );
	OUTPUT( '/?M?J' );

	OUTPUT( '	XWD	' );
	OUTPUTO( .SPECBLK[SB0PROJ] );
	OUTPUTCOMMA;
	OUTPUTO( .SPECBLK[SB0PROG] );
	OUTPUTCRLF;
	OUTPUTCRLF

    END;
COMMENT;

! ROUTINE OUTTST
! ======= ======
! THIS ROUTINE OUTPUTS A BIT STRING

GLOBAL ROUTINE OUTTST( WHERE, LEN ) =
    BEGIN
	REGISTER
		BP,
		CHAR;
	LABEL	SEL;

	BP _ (.WHERE)<36,7>;

	DECR I FROM .LEN - 1 TO 0 DO
	    BEGIN
		CHAR _ SCANI( BP );
SEL:		SELECT TRUE OF
		    NSET
			.CHAR GEQ " " AND .CHAR LEQ "\":	(OUTPUTC( """" ); OUTPUTC( .CHAR ); OUTPUTC( """" ); LEAVE SEL );
			OTHERWISE:	( OUTPUT( '^O' ); OUTPUTO( .CHAR ));
		   TESN;
		IF .I NEQ 0 THEN OUTPUT( ', ' );
	    END;
    END;
FORWARD	ATCHND;

COMMENT;

! ROUTINE ASKSIBS
! ======= =======
! THIS ROUTINE ASKS FOR THE SIBLINGS OF A NODE, THEN LINKS THE
! NODE IN THE PROPER PLACE

GLOBAL ROUTINE ASKSIBS( NODEPTR, PARENT ) =
    BEGIN
	REGISTER SIB;
	EXTERNAL	DNAME, GETNODEPTR, NULLNODENAME;
	OWN	INDX;

	LABEL	LOOP;
	MAP	FORMAT PARENT;
	MAP	FORMAT NODEPTR;
	MAP	FORMAT SIB;

	SIB _ .PARENT[ N0FIRSTCHILD ];

	IF .SIB EQL 0 THEN			! IF NO SIBS THEN
	    BEGIN
		ATTACHNODE( .NODEPTR, .PARENT, 0, 0 );
		RETURN
	    END;

	OUTPUT( 'SIBS:	' );
	DO
	    BEGIN
		DNAME( .SIB );
		SIB _ .SIB[ N0RSIB ];
		IF .SIB NEQ 0 THEN OUTPUTC( "," )
	    END
	WHILE .SIB NEQ 0;

	CRLF;

LOOP:	REPEAT
	    BEGIN

		TYPE( '[WHERE DO YOU WANT ]' );
		DNAME( .NODEPTR );
		TYPE( '[ INSERTED]?R(<before first sib>, BEFORE:<sib-name>, AFTER:<sib-name>?R)[:	??]' );

		ACHAR _ INPUT( ALINE, ALINELENGTH );
		ARGTYPE _ 0;
		GETNAME( ALINE, ACHAR );
NOTE		!!!!!!! GARBAGE AFTER COMMAND???? !!!!!!!!
		IF SEARCHTABLE( PLIT (	ASCII 'BEFOR',	BEFORE,
					ASCII 'AFTER',	AFTER,
					0,		2 ),
				ARGTYPE,
				IF .ARGTYPELENGTH GTR 5 THEN 5 ELSE .ARGTYPELENGTH,
				1,
				INDX ) THEN
		    BEGIN
			SIB _ .PARENT[ N0FIRSTCHILD ];
			IF .INDX EQL 2 THEN
			    BEGIN
				INDX _ 0;
				IF NULLNODENAME( PRIM ) THEN LEAVE LOOP
			    END;
			IF NULLNODENAME( PRIM ) THEN LEAVE LOOP;
			IF .SUB1 NEQ 0 THEN
			    BEGIN
				IF ( SIB _ GETNODEPTR( PRIM ) ) NEQ 0 THEN LEAVE LOOP
			    END
			    ELSE
			    BEGIN
				WHILE .SIB NEQ 0 DO
				    BEGIN
					IF COMPARE( SIB[ N0NAME ], PRIM, N0NAMELEN ) THEN LEAVE LOOP;
					SIB _ .SIB[ N0RSIB ]
				    END
			    END;
			ERROR( 70 ) %UNKNOWN SIB%
		    END
		    ELSE ERROR( 71 )	%MODIFIER NOT BEFORE, AFTER OR NULL%;

		! ELSE !
		WARN( 0 )
	    END;

							! INSERT SIB
	ATTACHNODE( .NODEPTR, .PARENT, .INDX, .SIB )

    END;
COMMENT;

! ROUTINE MATCHALINE
! ======= =====
! THIS ROUTINE DOES A CHARACTER BY CHARACTER COMPARE OF AN ASCII STRING
! WITH THE ALTERNATE INPUT LINE AND RETURNS TRUE IF THEY ARE EQUAL ELSE FALSE

GLOBAL ROUTINE MATCHALINE( STRNG1 ) =
    BEGIN

	REGISTER
		CHAR1,
		BP1;

	BP1 _ .STRNG1;

	REPEAT
	    BEGIN
		CHAR1 _ SCANI( BP1 );

		IF .CHAR1 EQL 0
			OR
		   .ACHAR EQL 0
			OR
		   EOL( ACHAR )
			THEN RETURN TRUE;

		! ELSE !

		IF .CHAR1 NEQ .ACHAR THEN RETURN FALSE;

		ACHAR _ SCANI( ABPTR )

	    END

    END;
COMMENT;

! ROUTINE NULL
! ======= ====
! THIS ROUTINE CHECKS THE BLK ARGUEMENT TO SEE IF IT IS ALL ZEROS

GLOBAL ROUTINE NULL( BLK, SIZE ) =
    BEGIN
	DECR I FROM .SIZE - 1 TO 0 DO
	    IF .(.BLK)[.I]<WORD> NEQ 0 THEN RETURN FALSE;
	TRUE
    END;
COMMENT;

! ROUTINE DTCHND
! ======= ======
! THIS ROUTINE DETACHES A GIVEN NODE FORM ITS PARENT AND SIBS

GLOBAL ROUTINE DTCHND( NODEPTR ) =
    BEGIN
	REGISTER
		SIB,
		PARENT;
	MAP	FORMAT NODEPTR;
	MAP	FORMAT PARENT;
	MAP	FORMAT SIB;

	PARENT _ .NODEPTR[N0PARENT];
	IF ( SIB _ .NODEPTR[N0RSIB] ) EQL 0 THEN
	    BEGIN
		IF .PARENT NEQ 0 THEN PARENT[N0LASTCHILD] _ .NODEPTR[N0LSIB]
	    END
	    ELSE SIB[N0LSIB] _ .NODEPTR[N0LSIB];
	IF ( SIB _ .NODEPTR[N0LSIB] ) EQL 0 THEN
	    BEGIN
		IF .PARENT NEQ 0 THEN PARENT[N0FIRSTCHILD] _ .NODEPTR[N0RSIB]
	    END
	    ELSE SIB[N0RSIB] _ .NODEPTR[N0RSIB];

	NODEPTR[N0SIBS] _ 0

    END;
COMMENT;

! ROUTINE ATCHND
! ======= ======
! THIS ROUTINE IS USED TO ATTACH A NODE TO IT'S PARENT
! NODEPTR IS THE NODE TO BE ATTACHED
! PARENT IS TO BE THE NEW PARENT OF THE NODE
! FLAG TELLS WHERE TO PUT THE NEW NODE ( BEFORE / AFTER )
! SIB IS THE SIBLING TO BE POSITIONED ON
! IF SIB IS 0 THEN THE NEW NODE IS PLACED BEFORE THE FIRST OR AFTER
! THE LAST DEPENDING UPON FLAG

GLOBAL ROUTINE ATCHND( NODEPTR, PARENT, FLAG, SIB ) =
    BEGIN
	OWN	LSIB,
		RSIB;

	MAP	FORMAT PARENT;
	MAP	FORMAT NODEPTR;
	MAP	FORMAT SIB;
	MAP	FORMAT LSIB;
	MAP	FORMAT RSIB;

	NODEPTR[ N0LEVEL ] _ .PARENT[ N0LEVEL ] + 1;

	NODEPTR[ N0PARENT ] _ .PARENT;

	IF .PARENT[ N0CHILDREN ] EQL 0 THEN
	    BEGIN
		NODEPTR[ N0SIBS ] _ 0;
		PARENT[ N0FIRSTCHILD ] _ PARENT[ N0LASTCHILD ] _ .NODEPTR;
		ZAPTRCODE(  .PARENT[ N0TRCODE ] );
		ZERO( PARENT[ N0OPNAME ], PARENT[ N0OPNAME ] + N0NAMELEN );
		PARENT[ N0OPFLAG ] _ FALSE;
		RETURN
	    END;

	IF .SIB EQL 0 THEN
		SIB _ ( IF .FLAG NEQ AFTER THEN .PARENT[ N0FIRSTCHILD ] ELSE .PARENT[ N0LASTCHILD ] );

	IF .FLAG NEQ AFTER THEN				! DEFAULT TO BEFORE IF BAD
	    BEGIN
		IF .SIB[ N0LSIB ] EQL 0 THEN			! BEFORE ALL SIBS
		    BEGIN					! YES
			SIB[ N0LSIB ] _ PARENT[ N0FIRSTCHILD ] _ .NODEPTR;
			NODEPTR[ N0LSIB ] _ 0;
			NODEPTR[ N0RSIB ] _ .SIB
		    END
		    ELSE
		    BEGIN
			LSIB _ NODEPTR[ N0LSIB ] _ .SIB[ N0LSIB ];
			LSIB[ N0RSIB ] _ SIB[ N0LSIB ] _ .NODEPTR;
			NODEPTR[ N0RSIB ] _ .SIB
		    END
	    END
	    ELSE
	    BEGIN
		IF .SIB[ N0RSIB ] EQL 0 THEN			! AFTER ALL SIBS
		    BEGIN
			SIB[ N0RSIB ] _ PARENT[ N0LASTCHILD ] _ .NODEPTR;
			NODEPTR[ N0RSIB ] _ 0;
			NODEPTR[ N0LSIB ] _ .SIB
		    END
		    ELSE
		    BEGIN
			RSIB _ NODEPTR[ N0RSIB ] _ .SIB[ N0RSIB ];
			RSIB[ N0LSIB ] _ SIB[ N0RSIB ] _ .NODEPTR;
			NODEPTR[ N0LSIB ] _ .SIB
		    END

	    END

    END;
COMMENT;

! ROUTINE ASKL
! ======= ====
! THIS ROUTINE ASK THE QUESTION SUPPLIED, ACCEPTS AN ALTERNATE LINE,
!   SKIPS ANY LEADING BLANKS, AND RETURNS TRUE IF AFTER SKIPPING IT IS
!   THE END OF LINE, ELSE FALSE

GLOBAL ROUTINE ASKL( Q ) =
    BEGIN
	XTYPE( .Q );
	ACHAR _ INPUT( ALINE, ALINELENGTH );
	SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
	EOL( ACHAR )			NOTE <--- NOTE NO SEMICOLON
    END;
COMMENT;

! ROUTINE CMOVE
! ======= =====
! THIS ROUTINE MOVES CHARACTERS FORM THE FIRST STRING TO THE SECOND,
! THEN FILLS THE SECOND WITH NULLS
! NOTE BOTH SOURCE AND DESTINATION STRINGS ARE ASSUMED TO START ON WORD BOUNDARIES

GLOBAL ROUTINE CMOVE( WHAT, WHERE, WORDS ) =
    BEGIN
	REGISTER
		CHARACTERS,
		INBP,
		OUTBP,
		INCHAR;

	CHARACTERS _ .WORDS * 5;
	INBP _ (.WHAT)< 36, 7 >;
	INCHAR _ SCANI( INBP );
	OUTBP _ (.WHERE)< 36, 7 >;

	DECR I FROM .CHARACTERS - 1 TO 0 DO
	    BEGIN
		REPLACEI( OUTBP, .INCHAR );
		IF .INCHAR NEQ 0 THEN INCHAR _ SCANI( INBP )
	    END

    END;
COMMENT;

! ROUTINE CCPY
! ======= ====
! THIS ROUTINE MOVES CHARACTERS FROM THE FIRST STRING TO THE SECOND,
! NEITHER STRING IS EXPECTED TO START ON A WORD BOUNDARY, BUT MAY.

GLOBAL ROUTINE CCPY( STRNG1, STRNG2 ) =
    BEGIN
	REGISTER
		BP,
		CHAR;

	BP _ .STRNG2;

	WHILE ( CHAR _ SCANI( STRNG1 ) ) NEQ 0 DO
		REPLACEI( BP, .CHAR );
	.BP

    END;
COMMENT;

! ROUTINE CCPY6
! ======= ====
! THIS ROUTINE MOVES CHARACTERS FROM THE FIRST STRING TO THE SECOND,
! CONVERTING FROM SIXBIT TO ASCII
! NEITHER STRING IS EXPECTED TO START ON A WORD BOUNDARY, BUT MAY.

GLOBAL ROUTINE CCPY6( STRNG1, STRNG2 ) =
    BEGIN
	REGISTER
		BP,
		CHAR;

	BP _ .STRNG2;

	DECR I FROM 5 TO 0 DO
		IF ( CHAR _ SCANI( STRNG1 ) ) NEQ 0 THEN
			REPLACEI( BP, .CHAR + " " );
	.BP

    END;
COMMENT;

! ROUTINE HYPHENIN
! ======= ========
! THIS ROUTINE CHECKS A STRING TO SEE IF IT CONTAINS A HYPHEN

GLOBAL ROUTINE HYPHENIN( %IN% STRNG, CHARS %LONG% ) =
    BEGIN
	REGISTER BP;

	BP _ ( .STRNG )< 36, 7 >;
	DECR I FROM .CHARS - 1 TO 0 DO
		IF SCANI( BP ) EQL "-" THEN RETURN TRUE;
	FALSE
    END;
COMMENT;

! ROUTINE JOBNO
! ======= =====
! THIS ROUTINE RETURNS THE CURRENT JOB NUMBER IN SIXBIT RIGHTT JUSTIFIED

GLOBAL ROUTINE JOBNO =
    BEGIN
	REGISTER
		JOBNUM,
		AC;

	PJOB( AC );

	JOBNUM _ SIXBIT "000";
	    JOBNUM< 0, 3 > _ .AC MOD 10;
	    AC _ .AC / 10;
	    JOBNUM< 6, 3 > _ .AC MOD 10;
	    AC _ .AC / 10;
	    JOBNUM< 12, 3 > _ .AC;
	.JOBNUM

    END;
COMMENT;

! ROUTINE KILLFILE
! ======= ========
! THIS ROUTINE DELETES THE FILE GIVEN IN THE SPECBLK
! SUPPLIED, ... THE FILE MUST BE ON DISK!

GLOBAL ROUTINE KILLFILE( SPECBLK ) =
    BEGIN
	BIND	BUFFSIZE = #200 + 3,
		KBSIZE = 4;

	LOCAL	BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE], KILLBLOCK[ KBSIZE ];
	MAP	FORMAT SPECBLK;
	MAP	ROOTFORMAT ROOT;

	IOPENBLK[0] _ #10;
	IOPENBLK[1] _ .SPECBLK[SB0DEVICE];
	IOPENBLK[2]<RH> _ IBUF<0,0>;

	IF OPENINPUTDEVICE() FAILED THEN RETURN;

	MAKEBUFFERRING( IBUF, 0<0,36>, BUF1, BUF2, BUF3 );

	ILOOKUPBLK[0] _ .SPECBLK[SB0NAME];
	ILOOKUPBLK[1]<LH> _ .SPECBLK[SB0EXT];
	ILOOKUPBLK[2] _ 0;
	ILOOKUPBLK[3] _ .SPECBLK[SB0PPN];

	IFSKIP LOOKUP(ICHAN,ILOOKUPBLK)
	    THEN %CONTINUE%
	    ELSE
		BEGIN
		    ERROR( 55 );
		    RETURN
		END;

	ZERO( KILLBLOCK, KBSIZE );

	IFSKIP RENAME(ICHAN,KILLBLOCK)
	    THEN %CONTINUE%
	    ELSE
	    BEGIN
		ERROR( 53 );
		RETURN
	    END;

	CLOSE( ICHAN, 0 )

    END;
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 DEBUG THEN
			IF .WORK NEQ 0 THEN
			    BEGIN
				ERROR( 103 );		%PROBLEM IN LINK%
			    END;

		(.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 (.KEY)<FORE> _ .NEXT;
	IF .NEXT NEQ 0 THEN (.NEXT)<AFT> _ .PREV 
	    ELSE (.KEY)<AFT> _ .PREV;
    END;



END;

! END OF MGNUTL.BLI