Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-08 - 43,50512/nodtbl.b36
There are no other files named nodtbl.b36 in the archive.
MODULE NODTBL	(Ident='2 24-Jul-80',MAIN=INITIA)=
BEGIN

!	PROGRAM TO MANIPULATE NODTBL.EXE, THE NODE SPECIFIC
!	DATABASE FOR NETSPL.
!

!			  COPYRIGHT (c) 1978, 1978 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	FTS NODTBL
!
! ABSTRACT:
!
!
!	PROGRAM TO MANIPULATE NODTBL.EXE, THE NODE SPECIFIC
!	DATABASE FOR NETSPL.
!
!
! ENVIRONMENT:	TOPS-10 6.03,6.03A,7.01...
!
! AUTHOR:	Marty Palmieri, CREATION DATE: 24-Jul-80
!
! MODIFIED BY:	Andy Nourse
!
! 	, : VERSION
! 01	- 
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
	INITIA:NOVALUE,		!TOP LEVEL COMMAND PROCESSOR
	ADDNOD,			!INSERT A NODE INTO THE TABLE
	UPDATE,			!UPDATE AN EXISTING ENTRY
	TYPNOD,			!TYPE A NODE OR THE ENTIRE TABLE
	LIST,			!LIST ALL NODES IN TABLE
	EXITPG,			!EXIT THE PROGRAM
	WRITES,			!SAVE CHANGES ON DISK AND EXIT
	HELP,			!GIVE SOME TOP LEVEL HELP
	DELNOD,			!REMOVE AN ENTRY FROM THE TABLE
	CORGET,			!INCREASE HI-SEG WHEN NEEDED
	GET_TYPE,		!GET TYPE OF NODE (NET,D78,DIAL,DIRECT)
	GET_NODE$NAME,		!GET THE NAME OF THE NODE
	FIND_NODE,		!SEE IF NODE IS ALREADY IN TABLE
	STORE_DISPATCH,		!DECIDE WHAT TO STORE
	STOR_SIXBIT,		!STORE A SIXBIT ENTRY IN THE TABLE
	COLON,			!PROCESS COLON IN TIME ARGUMENTS
!THE FOLLOWING ROUTINES WRITE THEIR ENTRIES INTO THE DATABASE
	NODEID,
	QUE_DEV,
	QUE_DV2,
	PHON1_NUM,
	PHON2_NUM,
	TIME_UP,
	TIME_DOWN,
	CON_TIMEOUT,
	REPLY_TIMEOUT,
	INACTIVE_TO,
	REQUE_TIME,
	SIGNON,
	SIGNOFF,
	PASSWORD,,
	LOCATION,
	SYSTEM_TYPE,
	CONTACT,
	TIME_TO_HOLD,
	FLAGS,
	LAST_CONNECT,
	MAX_FILESIZE,
	SCRATCH,
! END ROUTINES TO SAVE ENTRIES
	GET_ARG,
	TYPE_BLOCK,
	TYPE_SIX,
	TYPDEC,
	TYPOCT,
!!!!!!	FRUCK_SAVE,!Obsolete
	GIVE_HELP,
	OS_TYPE,		!DETERMINE THE TYPE OF OPERATING SYSTEM
	TYPE_OS,		!TYPE OUT THE OPERATING SYSTEM TYPE
	CURFLAG,		!TYPE OUT THE SETTINGS OF FLAG ENTRY
	WED_HISEG;		!WRITE ENABLE OR LOCK THE HISEG

!
! Libraries
!

LIBRARY 'TBL';
LIBRARY 'NODTBL';
LIBRARY 'NETCOM';
LIBRARY 'UUOSYM';


LITERAL
	SREG=%O'17',
	FREG=%O'15';

LINKAGE	JSIM=PUSHJ(REGISTER=1,REGISTER=2,REGISTER=3,REGISTER=4):
	     LINKAGE_REGS(SREG,FREG,1);
	     !Linkage for JSYS simulation routines
EXTERNAL ROUTINE
	RESETF: NOVALUE,!Flush file
	RDSIXA,		!CONVERT ASCIZ STRING TO SIXBIT
	RDNUMA,		!CONVERT ASCIZ STRING TO OCTAL
	WRNUMA,		!CONVERT OCTAL NUMBER TO ASCIZ
	WRNUM,		!CONVERT OCTAL NUMBER TO ASCIZ
	WRSIXA,		!CONVERT SIXBIT STRING TO ASCIZ
	FBINI,		!INITIALIZE A FILOP. BLOCK
	FILOP,		!EXECUTE A FILOP.
	FPARSE,		!PARSE A FILESPEC
	COPY,		!BLT FROM ONE PLACE IN CORE TO ANOTHER
	ZERO,		!ZERO A BLOCK OF CORE
	STOP,		!STOP THE JOB
	DOCMDS,		!PROCESS A COMMAND OR SERIES OF COMMANDS
	MOVEAZ,
	TIMJIF,		!CONVERT 24 HR TIME TO JIFFIES SINCE 0000
	JIFTIM,		!CONVERT JIFFEIES SINCE 0000 TO 24HR TIME
	TIMQUE,		!CONVERT FROM WHAT USER TYPED TO QUEUE TIME
	QUETIM,		!CONVERT FROM QUEUE TIME TO 24 HOUR TYPE TIME
	TTYIN,		!GET A LINE OF TYPE IN
	SSAVE: JSIM;	!Routine to Save a core image (shareable)
	UNDECLARE OCT;

LITERAL
    ASC = %O'0700',		!ENTRY IS AN ASCII STRING
    SIX = %O'0600',		!ENTRY IS A SIXBIT STRING
    OCT = %O'1000',		!ENTRY IS A OCTAL NUMBER
    NET = %O'10000',		!ENTRY REQUIRED ONLY FOR FTS NODES
    D78 = %O'20000',		!ENTRY REQUIRED ONLY FOR 2780 TYPE NODES
    HARD = %O'40000',		!ENTRY REQUIRED FOR DIRECT WIRED NODES
    DIAL = %O'100000',		!ENTRY REQUIRED FOR DIALUP NODES ONLY
    ALL = %O'170000',		!ENTRY REQUIRED FOR ALL NODES
    NONE = %O'00000',		!ENTRY IS NOT REQUIRED FOR ANY NODE
    JBHRL = %O'115',		!WORD IN VESTIGIAL JOB DATA AREA SHOWING CURRENT CORE ALLOCATION
    HISEG_ORIGIN = %O'400000',	!WHERE THE HISEG BEGINS
    NDB$NUMITEM = 25,		!NUMBER OF ENTRIES IN NODTAB
    UDX = 0,			!PLACE TO SAVE THE UDX FOR MY TTY
    SYSPPN = %O'1000004',	!THE SYSTEM AREA PPN
    MAXLEN = 80;		!SIZE OF TTY INPUT BUFFER
EXTERNAL
    DIRECT,	!ADDR OF DEFAULT HARDWIRED NODE
    DIALUP,	!ADDR OF DEFAULT DIALUP NODE
    SNODE,	!SCRATCH AREA IN LOSEG, USED TO BUILD A NODE BEFORE
		!COPYING TO HISEG.  SINCE THE HISEG IS WRITE ENABLED
		!THIS PREVENTS SOMEONE FOR INSERTING AN INCOMPLETE
		!ENTRY INTO THE SHARABLE HISEG
    PRVTAB,	!TABLE OF PRIVILEDGED TOP LEVEL COMMANDS
    NPRVTB,	!TABLE OF READ ONLY COMMANDS
    TBLTAB,	!TABLE OF NODE TABLE ENTRIES
    FLGTAB:VECTOR[14];	!TABLE OF FLAGS
!    NOD_ZERO;	!END OF HISEG DATA

OWN
    C,		!ALWAYS CONTAINS A CHARACTER
    COMTAB,	!POINTER TO THE TOP LEVEL COMTAB WE ARE USING
    ALLSW,	!/ALL switch
    PNODE,	!REMEMBERS NODE BLOCK IN HISEG WHILE BUILDING SNODE
    DEFNOD,	!THE NODE TYPE TO GET DEFAULTS FROM
    LHW,	!=1 SAYS WE TYPE THE <RH>
    TBUF_PTR,    !CHARACTER POINTER FOR THE TTY INPUT BUFFER
    TTBUF:VECTOR[CH$ALLOCATION(80)],
    TTOBUF:VECTOR[CH$ALLOCATION(120)],	!TTY OUTPUT BUFFER
    NODE,		!ADDRESS OF NODE IN TABLE
    NODE$NAME,     	!NAME OF CURRENT NODE
    HI$ADDR,		!TOP OF HISEG
    FB: FILE_BLOCK,		!FILOP BLOCK TO COPY HISEG TO DISK
    NODE$FLAG:BITVECTOR [36];	!FLAGWORD

LITERAL
    NF$NET = 0,			!NODE IS ANF-10
    NF$RJ = 1,			!NODE IS RJ2780/DAS78
    NF$DIRECT = 2,		!LINK TO NODE IS HARDWIRED
    NF$DIAL = 3,		!LINK TONODE IS DIALUP
    NF$WILD = 4,		!USER TYPED AN ASTERISK
    NF$FILESPEC = 5;		!FILE SPECIFICATION PARSED

    UNDECLARE
	%QUOTE RT11,
	%QUOTE RSTS,
	%QUOTE RSX11S,
	%QUOTE RSX11M,
	%QUOTE RSX11D,
	%QUOTE IAS,
	%QUOTE VAX,
	%QUOTE TOPS20,
	%QUOTE TOPS10;
    BIND
	OTHER = UPLIT(%ASCIZ'OTHER'),
	RT11 = UPLIT(%ASCIZ'RT11'),
	RSTS = UPLIT(%ASCIZ'RSTS'),
	RSX11S = UPLIT(%ASCIZ'RSX11S'),
	RSX11D = UPLIT(%ASCIZ'RSX11D'),
	RSX11M = UPLIT(%ASCIZ'RSX11M'),
	IAS = UPLIT(%ASCIZ'IAS'),
	VAX = UPLIT(%ASCIZ'VAX'),
	TOPS20 = UPLIT(%ASCIZ'TOPS20'),
	TOPS10 = UPLIT(%ASCIZ'TOPS10');

FIELD ACTION_FLAGS = SET

    ENTRY_LEN = [0,0,6,0],		!NUMBER OF WORDS IN TABLE ENTRY
    ENTRY_FORMAT = [0,6,6,0],		!SIXBIT OR ASCII OR OCTAL
    NODE_CHAR = [0,12,4,0],			!TYPE OF NODE
    PROMPT_STR = [1,0,18,0]			!ADDRESS OF ASCIZ PROMPT

TES;


!
! Macros
!
MACRO	FILENAME_CHARS=%C'A' TO %C'Z', %C'0' TO %C'9', %C'A'+32 TO %C'Z'+32 %,
	WILD_1=%C'%',%C'?'%,
	WILD_N=%C'*'%,
	LOWER_CASE=%C'A'+%O'40' TO %C'Z'+%O'40'%;

MACRO NODE_TABLE(STRING,CODE) = CODE,UPLIT (%ASCIZ %STRING(STRING))%;

	BIND NODTAB = UPLIT(
			NODE_TABLE('NodeId',ALL+SIX+2),
			NODE_TABLE('Que',D78+SIX+2),
			NODE_TABLE('AltQue',NONE+SIX+2),
			NODE_TABLE('Phone',DIAL+ASC+8),
			NODE_TABLE('AltPhone',NONE+ASC+8),
			NODE_TABLE('TimeUp',DIAL+OCT+2),
			NODE_TABLE('TimeDown',DIAL+OCT+2),
			NODE_TABLE('ConTimeout',NONE+OCT+1),
			NODE_TABLE('Replyto',NONE+OCT+1),
			NODE_TABLE('Inactive',D78+OCT+1),
			NODE_TABLE('Reque',ALL+OCT+1),
			NODE_TABLE('Signon',D78+SIX+2),
			NODE_TABLE('Signoff',D78+SIX+2),
			NODE_TABLE('Password',D78+ASC+8),
			NODE_TABLE('Reconnect',NONE+OCT+2),
			NODE_TABLE('Location',ALL+ASC+8),
			NODE_TABLE('SystemType',ALL+SIX+2),		!16
			NODE_TABLE('Contact',ALL+ASC+16),		!17
			NODE_TABLE('TimeToHold',NONE+OCT+2),		!18
			NODE_TABLE('Flags',ALL+OCT+2),			!19
			NODE_TABLE('*TFlags',NONE+OCT+2),		!20
			NODE_TABLE('MaxFilesize',ALL+OCT+2),		!21
			NODE_TABLE('Route-through-node',NET+SIX+2),	!22
			NODE_TABLE('Objecttype',NONE+OCT+1),		!23
			NODE_TABLE('Programmer#',NONE+OCT+1),		!24
			NODE_TABLE('Taskname',NONE+SIX+2),		!25
			NODE_TABLE('*TLimit',NONE+OCT+2))
		:BLOCKVECTOR[23,2] FIELD (ACTION_FLAGS);

GLOBAL ROUTINE INITIA: NOVALUE=	!Top Level of NODTBL
!++
! FUNCTIONAL DESCRIPTION:
!
!	TOP LEVEL ROUTINE - IDENTIFY THE USER, CHECK HIS PRIVILEDGES, AND
!	SEE WHAT HE WANTS TO DO
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
    BEGIN
	LOCAL
	    N,
	    PTR;

	REGISTER F;
!
!TO PREVENT UNAUTHORIZED TAMPERING WITH THE NODTBL DATABASE SEE
!IF THE USER IS 1,2(OPERATOR).  IF SO, ALLOW HIM TO WRITE IN THE
!HISEGEMENT.  IF NOT ONLY ALLOW HIM TO READ HIGH SEGMENT
!
	CALLI (F,%O'24');		!GETPPN CALLI
	    IF .F EQL %O'1000002' THEN		!Check for operator
		BEGIN
		WED_HISEG(0);		!HE IS 1,2
		COMTAB = PRVTAB;	!SO USE THE PRIVILEDGED COMMAND TABLE
		END
	    ELSE
		COMTAB = NPRVTB;	!NOT 1,2 - CANNOT WRITE ANYTHING

	HI$ADDR = .JBHRL<RH>;		!GET TOP OF HISEG

	WHILE 1 DO
	    BEGIN
	    NODE$FLAG = 0;
	    TBUF_PTR = CH$PTR(TTBUF);
	    TYPE ('*');
	    TTYIN(.TBUF_PTR,MAXLEN);
	    TBUF_PTR = CH$PTR(TTBUF);
	    N = DOCMDS(.COMTAB,TBUF_PTR,%O'177',TBUF_PTR);	!See what to do
		IF .N GTR 1^16 THEN
		    BEGIN
		    IF .N THEN
			TYPE ('Ambigious command',CRLF)
		    ELSE
			TYPE ('Unknown command',CRLF);
		    END
		else
		    BEGIN
		    If ch$rchar(.tbuf_ptr) neq %o'0' then
			BEGIN
			TYPE ('Junk in input string: ');
			N = .TBUF_PTR<RH>;
!			TSTR (N);
			TYPE	(CRLF);
			END
		    END
	END
    END;
GLOBAL ROUTINE ADDNOD =	!MAIN ROUTINE TO ADD A NODE TO THE HISEG DATABASE
!++
! FUNCTIONAL DESCRIPTION:
!
!	MAIN ROUTINE TO ADD A NODE TO THE HISEG DATABASE
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	NONE
!
!--
    BEGIN
    LOCAL
	IDX,		!POINTS INTO NODTAB
	ENTRY_PTR,	!POINTS TO ASCIZ STRING IN NODTAB
	PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    LABEL
	LOOPA,
	LOOPB;

    IF GET_NODE$NAME(.TBUF_PTR) NEQ 0 THEN
	BEGIN
	IF FIND_NODE() NEQ 0 THEN
	    BEGIN
	    TYPE ('Node already exists',crlf);
	    TTBUF = 0;
	    RETURN;
	    END;

	LOOPA:
	    BEGIN

	    INCR NDB$PTR FROM NODTBL$BASE TO .HI$ADDR BY .NTBL$EL DO
		BEGIN
		NODE = .NDB$PTR;
		IF (.NODE[NOD$ID] EQL -1 OR .NODE[NOD$ID] EQL 0)
		 THEN IF (.NODE + .NTBL$EL) LSS .HI$ADDR
		  THEN LEAVE LOOPA
		  ELSE IF CORGET() EQL 0
		   THEN RETURN 2;
		END;
	    !
	    !		NO FREE SPACE IN HISEG
	    !
	    IF CORGET() EQL 0 THEN RETURN 2;
	    END;		!END OF LOOPA

	GET_TYPE();		!GET THE TYPE OF NODE WE WILL BE DEALING WITH
	PNODE = .NODE;	!BUILD NEW NODE IN SCRATCH TABLE SPACE
	NODE = SNODE;
	COPY(.DEFNOD,.NODE,.NTBL$EL);	!SET UP DEFAULTS
	NODE[NOD$ID] = .NODE$NAME;		!GIVE IT A NAME

	!
	!NOW FOR ALL OF THE ENTRIES REQUIRED FOR THIS TYPE OF NODE
	!
	INCR IDX FROM 1 TO NDB$NUMITEM DO
	LOOPB:
	    BEGIN
	    IF (.NODTAB[.IDX,NODE_CHAR] AND .NODE$FLAG) NEQ 0 THEN
		BEGIN
		WHILE 1 DO
		    BEGIN
		    TSTR (.NODTAB[.IDX,PROMPT_STR]);	!PROMPT THE USER
		    TYPE (': ');
		    TBUF_PTR = CH$PTR(TTBUF);
		    C = TTYIN(.TBUF_PTR,MAXLEN);
		    TBUF_PTR = CH$PTR(TTBUF);
		    IF CH$RCHAR(.TBUF_PTR) EQL %O'0' THEN
			BEGIN
			IF .C EQL %O'12'
			THEN	!IF HE TYPES ONLY A LINE FEED HE WANTS HELP
			 GIVE_HELP(.IDX)
			ELSE LEAVE LOOPB;	!MUST WANT DEFAULT
			END
		    ELSE
			BEGIN
			TBUF_PTR = CH$PTR(TTBUF);
			ENTRY_PTR = CH$PTR(.NODTAB[.IDX,PROMPT_STR]);
			IF (DOCMDS(TBLTAB,ENTRY_PTR,%O'177',TBUF_PTR)) LSS 1^16
			 THEN EXITLOOP;
			END;
		    END;
		END;
	    END;
	END;
    IF .NODE$FLAG[NF$NET] THEN
	BEGIN
	NODE[NOD$F_TYPE] = 1; !Mark as Netspl
	IF .NODE[NOD$ROUTE] NEQ 0 THEN	!We're going to use the NETWORK NODE!!
	    BEGIN	!Set up necessary hacks
	    IF .NODE[NOD$CNAME] EQL 0 THEN NODE[NOD$CNAME]=.NODE$NAME;
	    IF .NODE[NOD$CPPN] EQL 0 AND .NODE[NOD$SYSTEM] NEQ OS_TOPS10
	    THEN NODE[NOD$OBJTYPE]=FTSFAL_OBJECT_TYPE;
	    END;
	END;

    COPY (.NODE,.PNODE,.NTBL$EL); !COPY NODE FROM SCRATCH TO PLACE IN HISEG

    RETURN 2
    END;
ROUTINE CORGET=
!
!NO SPACE FOUND IN HI-SEGMENT TO INSERT NEW NODE
!WILL ATTEMPT TO ENLARGE HI-SEG WITH A CORE UUO
!
BEGIN
    REGISTER F;

    F = 0;
    F<LH>=HI$ADDR=.HI$ADDR+512;	!GET ANOTHER 512 WORDS
	IF CALLI (F,%O'11') EQL 0 THEN
	    BEGIN
	    TYPE ('?Attempt to expand program high segement failed',crlf,
		  'Node cannot be inserted',crlf);
	    HI$ADDR = .HI$ADDR-512;
	    RETURN 0
	    END
	ELSE
	    BEGIN
	    ZERO(.HI$ADDR-512,.HI$ADDR);
	    RETURN 2
	    END
END;
ROUTINE GET_TYPE=
    BEGIN
	LOCAL
	    PUT$STR,
	    N;

	N = 0;
	WHILE 1 DO
	    BEGIN
	    TYPE ('Que device(NET/D78):');
	    TBUF_PTR = CH$PTR(TTBUF);
	    TTYIN(.TBUF_PTR,MAXLEN);
	    TBUF_PTR = CH$PTR(TTBUF);
	    if (n = ch$rchar_a(tbuf_ptr)) geq %o'141' then n = .n - 32;
	    IF .N EQL %O'0' THEN N = %C'N';
	    SELECTONEU .N OF SET
		[%c'D']:
		    BEGIN
		    NODE$FLAG[NF$RJ] = 1;
		    DEFNOD = DIRECT;
		    EXITLOOP;
		    END;
		[%c'N']:
		    BEGIN
		    NODE$FLAG[NF$NET] = 1;
		    DEFNOD = DIRECT;
		    EXITLOOP;
		    END;
		[OTHERWISE]:
		    TYPE ('Unknown que device - please type D78 or NET',CRLF);
	    TES;
	    END;
	IF .NODE$FLAG[NF$NET] THEN RETURN;
	N = 0;
	WHILE 1 DO
	    BEGIN
	    TYPE ('Link type-Direct or dialup: ');
	    TBUF_PTR = CH$PTR(TTBUF);
	    TTYIN(.TBUF_PTR,MAXLEN);
	    TBUF_PTR = CH$PTR(TTBUF);
	    PUT$STR = CH$PTR(N);
	    CH$MOVE (3,.TBUF_PTR,.PUT$STR);
	    SELECTONEU .N OF SET
	        [%ASCII'DIR']:
		    BEGIN
		    NODE$FLAG[NF$DIRECT] = 1;
		    EXITLOOP;
		    END;
	        [%ASCII'DIA']:
		    BEGIN
		    NODE$FLAG[NF$DIAL] = 1;
		    DEFNOD = DIALUP;
		    EXITLOOP;
		    END;
	        [OTHERWISE]:
		    BEGIN
		    TYPE ('?Unknown link type, Please type DIRECT or DIALUP',CRLF);
		    END;
	    TES;
	    END;
END;
ROUTINE GET_NODE$NAME =
BEGIN
LOCAL	TMP_PTR;

ALLSW=0;				!/ALL not specified
WHILE (C = CH$RCHAR(.TBUF_PTR)) EQL %O'40'
DO CH$RCHAR_A(TBUF_PTR);	!EAT SPACES

IF .C EQL 0 THEN		!Used up command, prompt for more
	BEGIN
	TYPE ('Nodename:');
	TBUF_PTR = CH$PTR(TTBUF);
	TTYIN(.TBUF_PTR,MAXLEN);
	TBUF_PTR = CH$PTR(TTBUF);
	IF (C = CH$RCHAR(.TBUF_PTR)) EQL %O'0' THEN
	RETURN (NODE$NAME = 0)
	END;

IF CH$RCHAR(.TBUF_PTR) EQL %C'*' THEN
	BEGIN
	NODE$FLAG[NF$WILD] = 1;
	NODE$NAME = -1;
	CH$RCHAR_A(TBUF_PTR); !Eat the character
	END

ELSE	BEGIN
	TMP_PTR = TBUF_PTR;
	TMP_PTR<35,1> = 1;	!Flag to allow %,?,*
	NODE$NAME = RDSIXA(.TMP_PTR)
	END;

IF CH$RCHAR(.TBUF_PTR) EQL %C'/'	!A switch?
THEN	BEGIN
	CH$RCHAR_A(TBUF_PTR);	!Eat the "/"
	SELECT RDSIXA(TBUF_PTR) OF SET
	[%SIXBIT 'ALL',%SIXBIT 'AL', %SIXBIT 'A']: ALLSW=1;
	[OTHERWISE]: TYPE (CRLF,'%Illegal switch -- ignored',CRLF);
	TES;
	END;
.NODE$NAME	!Return value
END;	!GET_NODE$NAME
GLOBAL ROUTINE UPDATE =
    BEGIN
	LOCAL
	    N,
	    PUT$STR;

	LABEL UPD_LOOP;

    UPD_LOOP:BEGIN

    if get_node$name() eql 0 then
	return
    else
    WHILE 1 DO
	BEGIN
	IF FIND_NODE() EQL 0 THEN	!RETURNS NODE POINTING TO HI-SEG
	    BEGIN
	    TYPE ('No such node in table',CRLF);
	    TBUF_PTR = CH$PTR(TTBUF);
	    TTBUF = 0;		!BE SURE IT LOOKS EMPTY
	    IF GET_NODE$NAME(TBUF_PTR) EQL 0 THEN
		RETURN;
	    END
	ELSE
	    EXITLOOP;
	END;	!END WHILE 1


	WHILE 1 DO
	BEGIN
	TYPE ('Change:');
	TBUF_PTR = CH$PTR(TTBUF);
	C = TTYIN(.TBUF_PTR,MAXLEN);
	TBUF_PTR = CH$PTR(TTBUF);
	IF CH$RCHAR(.TBUF_PTR) EQL 0 THEN
	    BEGIN
	    IF .C EQL %O'12' THEN
		GIVE_HELP(-1)
	    ELSE
		LEAVE UPD_LOOP;
	    END
	ELSE
	    BEGIN
	    N = DOCMDS(TBLTAB,TBUF_PTR,%O'177',0);
	    IF .N GTR 1^16 THEN
		BEGIN
		IF .N THEN
		    TYPE ('Ambigious command',CRLF)
		ELSE
		    TYPE ('Unknown command',CRLF);
		END
	    END
	END
    END;
    TTBUF = 0;
    TBUF_PTR = CH$PTR(TTBUF);
    RETURN 2
END;
GLOBAL ROUTINE NODEID =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

	BEGIN
	    IF (.NODE EQL DIRECT OR .NODE EQL DIALUP) THEN
		BEGIN
		TYPE ('You may not change the name of this node',CRLF);
		RETURN 2
		END;
	    IF GET_ARG(0) EQL 0 THEN
		BEGIN
		TYPE ('Null argument illegal',CRLF,'If you wish to remove this node from the table use the DELETE command',crlf);
		TTBUF = 0;
		RETURN 2
		END;
	    N = .NODTAB[0,ENTRY_FORMAT];
	    NN = .NODTAB[0,ENTRY_LEN];
	    PUT$STR = CH$PTR(NODE[NOD$ID],0,.N);
	    STORE_DISPATCH(N,NN,PUT$STR);
	    .TBUF_PTR<RH> = 0;
	    RETURN  2
	END;
END;
GLOBAL ROUTINE QUE_DEV =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(1) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[1,ENTRY_FORMAT];
    NN = .NODTAB[1,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$QDEV],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
END;
GLOBAL ROUTINE QUE_DV2 =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(2) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[2,ENTRY_FORMAT];
    NN = .NODTAB[2,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$DEV2],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
END;
GLOBAL ROUTINE PHON1_NUM =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(3) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[3,ENTRY_FORMAT];
    NN = .NODTAB[3,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$PHN],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE PHON2_NUM =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

     IF GET_ARG(4) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[4,ENTRY_FORMAT];
    NN = .NODTAB[4,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$PHN2],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE TIME_UP =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(5) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$TIMUP] = TIMJIF(RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE TIME_DOWN =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(6) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$TIMDN] =TIMJIF( RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE CON_TIMEOUT =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

     IF GET_ARG(7) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$CONTO] = TIMJIF( RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE REPLY_TIMEOUT =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(8) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$REPTO] = TIMJIF(RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE INACTIVE_TO =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(9) EQL 0 THEN
	RETURN;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$INACTO] = TIMJIF(RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE REQUE_TIME =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(10) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$REQUE] = TIMQUE(RDNUMA(TMP_PTR,10));
    RETURN  2
    END;
GLOBAL ROUTINE SIGNON =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(11) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[11,ENTRY_FORMAT];
    NN = .NODTAB[11,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$SON],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE SIGNOFF =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(12) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[12,ENTRY_FORMAT];
    NN = .NODTAB[12,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$SOF],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE PASSWORD =
    BEGIN
	LOCAL N,NN,PUT$STR;

	MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(13) EQL 0 THEN
	    RETURN 2;
        N = .NODTAB[13,ENTRY_FORMAT];
        NN = .NODTAB[13,ENTRY_LEN];
        PUT$STR = CH$PTR(NODE[NOD$PWD],0,.N);
        STORE_DISPATCH(N,NN,PUT$STR);
        RETURN  2
	END;
GLOBAL ROUTINE RECONNECT =
    BEGIN
	LOCAL N,TMP_PTR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(14) EQL 0 THEN
	RETURN 2;
    N = COLON();
    TMP_PTR = CH$PTR(N);
    NODE[NOD$CONN] = RDNUMA(TMP_PTR,10);
    RETURN  2
    END;
GLOBAL ROUTINE LOCATION =
    BEGIN
	LOCAL N,NN,PUT$STR;

	MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(15) EQL 0 THEN
	    RETURN 2;
        N = .NODTAB[15,ENTRY_FORMAT];
        NN = .NODTAB[15,ENTRY_LEN];
        PUT$STR = CH$PTR(NODE[NOD$WHERE],0,.N);
        STORE_DISPATCH(N,NN,PUT$STR);
        RETURN  2
	END;
GLOBAL ROUTINE SYSTEM_TYPE =
    BEGIN
	LOCAL N;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(16) EQL 0 THEN
	RETURN 2;
    WHILE 1 DO
	BEGIN
	N = RDSIXA(TBUF_PTR);
	IF (NODE[NOD$SYSTEM] = OS_TYPE(N)) EQL -1 THEN
	    BEGIN
		WHILE 1 DO
		BEGIN
		TYPE ('System type: ');
		TBUF_PTR = CH$PTR(TTBUF);
		C = TTYIN(.TBUF_PTR,MAXLEN);
		TBUF_PTR = CH$PTR(TTBUF);
		IF .C EQL %O'12' THEN
		    GIVE_HELP(16)
		ELSE
		    BEGIN
		    IF CH$RCHAR(.TBUF_PTR) EQL 0 THEN
			BEGIN
			NODE[NOD$SYSTEM] = 0;
			RETURN 2
			END
		    ELSE
			EXITLOOP;
		    END;
		END
	    END
	ELSE
	    BEGIN
	    TBUF_PTR = CH$PTR(TTBUF);
	    TTBUF = 0;
	    RETURN 2
	    END
	END
    END;
GLOBAL ROUTINE CONTACT =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(17) EQL 0 THEN
	    RETURN 2;
	N = .NODTAB[17,ENTRY_FORMAT];
	NN = .NODTAB[17,ENTRY_LEN];
	PUT$STR = CH$PTR(NODE[NOD$HELP],0,.N);
	STORE_DISPATCH(N,NN,PUT$STR);
	RETURN  2
    END;
GLOBAL ROUTINE TIME_TO_HOLD =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(18) EQL 0 THEN
	    RETURN 2;
	NODE[NOD$HOLD] = RDNUMA(TBUF_PTR,10);
	RETURN 2
    END;
GLOBAL ROUTINE FLAGS =
    BEGIN
	LOCAL N;

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(19) EQL 0 THEN
	    RETURN 2;
!	NODE[NOD$FLG] = 63^28;		!TURN ON ALL FLAGS WE CARE ABOUT
!CHECK FOR <LF> AND GIVE HELP
	WHILE 1 DO
	BEGIN
	N = DOCMDS(FLGTAB,TBUF_PTR,%C'/',0);
	IF .N GTR 1^16 THEN 
	    BEGIN
		IF .N THEN
		    TYPE ('Ambiguous argument',CRLF)
		ELSE
		    TYPE ('Not a valid flag',CRLF);
		TYPE ('Flags: ');
		TBUF_PTR = CH$PTR(TTBUF);
		C = TTYIN(.TBUF_PTR,MAXLEN);
		TBUF_PTR = CH$PTR(TTBUF);
	    END
	ELSE
	    EXITLOOP;
	END;
	NODE[NOD$FLG] = (.NODE[NOD$FLG] OR (.N<8,8>^28))
	    AND NOT (.N<0,8>^28);
	RETURN  2
    END;
GLOBAL ROUTINE LAST_CONNECT =
	BEGIN
	TYPE ('Cannot be changed at this time',crlf);
	RETURN 2
	END;
GLOBAL ROUTINE MAX_FILESIZE =
    BEGIN

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(21) EQL 0 THEN
	    RETURN 2;
	NODE[NOD$LIMIT] = RDNUMA(TBUF_PTR,10);
	RETURN	2
    END;
GLOBAL ROUTINE ROUTE =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(22) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[22,ENTRY_FORMAT];
    NN = .NODTAB[22,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$ROUTE],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE OBJTYP =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(23) EQL 0 THEN
	    RETURN 2;
	NODE[NOD$OBJTYPE] = RDNUMA(TBUF_PTR,8);
	RETURN 2
    END;
GLOBAL ROUTINE PROGNO =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

	IF GET_ARG(24) EQL 0 THEN
	    RETURN 2;
	NODE[NOD$PROGNO] = RDNUMA(TBUF_PTR,8);
	RETURN 2
    END;
GLOBAL ROUTINE TASKNAME =
    BEGIN
	LOCAL N,NN,PUT$STR;

    MAP NODE: REF NODTBL_ENTRY;

    IF GET_ARG(25) EQL 0 THEN
	RETURN 2;
    N = .NODTAB[25,ENTRY_FORMAT];
    NN = .NODTAB[25,ENTRY_LEN];
    PUT$STR = CH$PTR(NODE[NOD$SOF],0,.N);
    STORE_DISPATCH(N,NN,PUT$STR);
    RETURN  2
    END;
GLOBAL ROUTINE SCRATCH =
    BEGIN

    MAP NODE: REF NODTBL_ENTRY;

	TYPE ('Cannot modify NETSPL scratch space',crlf);
	RETURN 2
    END;
ROUTINE GET_ARG(HELP) =
    BEGIN

    IF (C = CH$RCHAR(.TBUF_PTR)) EQL %C' 'THEN
	CH$RCHAR_A(TBUF_PTR);
    IF .C EQL 0 THEN
	WHILE 1 DO
	    BEGIN
	    TYPE ('Arg: ');
	    TBUF_PTR = CH$PTR(TTBUF);
	    C = TTYIN(.TBUF_PTR,MAXLEN);
	    IF .C EQL %O'12' THEN
		GIVE_HELP(.HELP)
	    ELSE
		BEGIN
		IF (CH$RCHAR(.TBUF_PTR)) EQL %O'0' THEN
		    RETURN 0;
		TBUF_PTR = CH$PTR(TTBUF);
		RETURN 2
		END
	    END;
	RETURN 2
    END;
GLOBAL ROUTINE DELNOD =

!
!THIS ROUTINE REMOVES A NODE FROM THE DATABASE
!A NODE IS DELETED BY SETTING ITS NODENAME TO -1
!THIS ALSO TELLS NETSPL THAT THE BLOCK IS UNUSED
!
    BEGIN
	IF GET_NODE$NAME(.TBUF_PTR) NEQ 0 THEN
	    BEGIN
	    IF  .NODE$FLAG[NF$WILD] NEQ 0 THEN
		BEGIN
		TYPE ('May not use wildcard DELETE',CRLF);
		RETURN	2
		END;
	    IF FIND_NODE() EQL 0 THEN
		TYPE ('No such node in table',CRLF)
	    ELSE
		IF (.NODE EQL DIRECT OR .NODE EQL DIALUP) THEN
		    BEGIN
		    TYPE ('Cannot delete Node ');
		    type_six(2,.NODE);
		    TYPE (CRLF);
		    end
		ELSE
		    BEGIN
		    TYPE ('Node ');
		    TYPE_SIX(2,.NODE);
		    TYPE (' deleted',crlf);
		    .NODE = -1;
		    END;
	    END;
	TTBUF = 0;
	TBUF_PTR = CH$PTR(TTBUF);
	RETURN 2
    END;
ROUTINE FIND_NODE=
    BEGIN

	MAP NODE: REF NODTBL_ENTRY;

	INCR NDB$PTR FROM NODTBL$BASE TO .HI$ADDR BY .NTBL$EL DO
	    BEGIN
		IF (..NDB$PTR EQL .NODE$NAME) THEN
		BEGIN
		    NODE = .NDB$PTR;
		    NODE$FLAG = 0;		!CLEAR ALL FLAGS
!
!CHECK FLAG WORD OF ENTRY TO SEE IF NETSPL OR DAS78
!
		    IF .NODE[NOD$F_TYPE] THEN
			NODE$FLAG[NF$NET] = 1
		    ELSE
			NODE$FLAG[NF$RJ] = 1;
!
!SEE IF A PHONE NUMBER TO AUTO DIAL-IF SO THEN ASSUME DIALUP NODE
!
		    IF .NODE[NOD$PHN] NEQ 0 THEN
			NODE$FLAG[NF$DIAL] = 1
		    ELSE
			NODE$FLAG[NF$DIRECT] = 1;
!
!RETURN WITH NODE CONTAINING ADDRESS OF ENTRY IN HI-SEG
!
		    RETURN .NODE
		END
	    END;
    RETURN 0	!NO SUCH NODE IN TABLE
    END;
ROUTINE STORE_DISPATCH(N,NN,PUT$STR)=
! Routine to read data from command string and store it

!
! Formal Parameters
!

!N:	ADDRESS OF Datatype code: 6-Sixbit 7-Ascii 8-Octal
!NN:	ADDRESS OF # of halfwords allocated to storage of datum
!PUT$STR: ADDRESS OF Byte pointer to store data

!
! Implicit Parameters
!

! TBUF_PTR: Byte pointer into command string (returned updated)

    BEGIN

	SELECTONEU ..N OF SET

	    [%O'7'] :
		BEGIN
		LOCAL XX;

		XX = (..NN * 5)/2 - 1;	!Max # of chars

		DECR NNN FROM .XX-1 TO 0
		DO IF (LOCAL C;
		       CH$WCHAR_A(C=CH$RCHAR_A(TBUF_PTR),.PUT$STR);
		       .C) EQL 0
		THEN RETURN 2;
		TYPE ('Entry exceeds maximum size of ');
		TNUM (.XX,10);
		type (' chars,...Truncating',crlf);
		END;
	    [%O'6'] :
		STOR_SIXBIT(..NN,.PUT$STR);
	    [OTHERWISE]:
		BEGIN
		TYPE ('?Program logic error(1), Please notify the FTS maintainer',crlf);
		RETURN 0
		END;
	TES;
    END;
ROUTINE STOR_SIXBIT(NN,PUT$STR)=
!Routine to read & store SIXBIT data from command string

!
! Formal Parameters
!

!NN:		# of halfwords allocated to storage of datum
!PUT$STR:	ADDRESS OF Byte pointer to store data

!
! Implicit Parameters
!

! TBUF_PTR: Byte pointer into command string (returned updated)

BEGIN
LOCAL	C;

DECR X FROM .NN*3-1 TO 0
DO	BEGIN
	SELECT (C=CH$RCHAR_A(TBUF_PTR)) OF SET
	[LOWER_CASE]:		C=.C-32;	!Convert to upper case
	[FILENAME_CHARS]:	CH$WCHAR_A(.C-32,.PUT$STR);
	[OTHERWISE]:		BEGIN
				DECR Y FROM .X TO 0
				DO CH$WCHAR_A(0,.PUT$STR); !Pad with nulls
				RETURN;
				END;
	TES;
	END;

!	IF CH$RCHAR(.TBUF_PTR) NEQ %O'0' THEN
!	    TYPE ('Excess arguments in response',crlf);
    END;
ROUTINE COLON =
    BEGIN
	LOCAL
	    N,
	    NCHR,		!# OF CHARACTERS SINCE LAST COLON
	    CLN,
	    PUT$STR;

	PUT$STR = CH$PTR(N);
	CLN = NCHR = N = 0;
	WHILE 1 DO
	    BEGIN
	    IF .NCHR GTR 4 THEN EXITLOOP;
	    IF (C=CH$RCHAR_A(TBUF_PTR)) NEQ %C':' THEN
		IF .C EQL 0 THEN
		    BEGIN
		    IF .CLN EQL 0 THEN EXITLOOP;
		    IF (.CLN EQL 1 AND .NCHR GEQ 2) THEN
			EXITLOOP
		    ELSE
			BEGIN
			UNTIL .NCHR GEQ 2 DO
			    BEGIN
			    CH$WCHAR_A(%C'0',PUT$STR);
			    NCHR = .NCHR + 1;
			    END;
			EXITLOOP;
			END
		    END
		ELSE
		    BEGIN
		    CH$WCHAR_A(.C,PUT$STR);
		    NCHR = .NCHR + 1
		    END
	    ELSE
		IF .CLN EQL 0 THEN
		    BEGIN
		    CLN = 1;
		    NCHR = 0
		    END
		ELSE
		    BEGIN
		    TYPE ('Please type time as HHMM or HH:MM',CRLF);
		    RETURN 0
		    END
	    END;
	RETURN	.N;
    END;
ROUTINE WED_HISEG(LOCKIT)=		!ROUTINE TO EITHER WRITE-ENABLE
					!OR WRITE-LOCK HISEG
BEGIN
REGISTER F;		!

F=0;			!CLEAR THE AC
IF .LOCKIT EQL 0 THEN	!IF (LOCKIT)=0 HISEG IS TO WRITE ENABLED
    BEGIN
    IF CALLI (F,%O'036') THEN		!SETUWP UUO
	-1		!UUO SUCCESSFUL
	ELSE
	BEGIN		!ERROR RETURN TAKEN

	TYPE ('?Unable to WRITE-ENABLE Hi-Seg',CRLF);
	.F;
	END;
    END
ELSE
    BEGIN
    F=1;		!SET USER WRITE PROTECT
    IF CALLI(F,%O'036')
	THEN
	-1		!UUO SUCCESSFUL

	ELSE		!ERROR RETURN TAKEN

	BEGIN
	TYPE ('?Unable to WRITE-PROTECT Hi-Seg',crlf);
	.F
	END;
    END;
END;
GLOBAL ROUTINE WRITES=
    BEGIN

    FBINI(FB);
    FB[FILE$MODE]=$IODMP;
    FB[FILE$CHANNEL] = 0;
    FB[FILE$DEVICE] = %SIXBIT'SYS';
    FB[FILE$FUNCTION] = $FOSAU;
    FB[FILE$GODLY]=1;
    FB[FILE$NAME] = %SIXBIT'NODTBL';
    FB[FILE$EXTENSION] = %SIXBIT'   EXE';
    IF FILOP(FB) THEN ()
    !!!!!!!    FRUCK_SAVE(SAVE$SYS)
    ELSE
	BEGIN
	TYPE ('Unable to save NODTBL on SYS: - trying DSK:',CRLF);
	FB[FILE$LPPN] = 0;
	FB[FILE$DEVICE] = %SIXBIT'DSK';
	IF FILOP(FB) THEN ()
	!!!!!!	FRUCK_SAVE(SAVE$DSK)
	ELSE
	    BEGIN
	    TYPE ('Unable to save NODTBL on DSK:',crlf);
	    RETURN 0;
	    END;
	END;
    SSAVE(0,UPLIT(XWD(-%O'400',%O'720000'),
		  XWD(-%O'300',%O'320000'+NODTBL$HSO^-9),
		  0
		 ),0);
    RESETF(FB);	!Don't supercede hiseg
    END;
%(This is obsolete
ROUTINE FRUCK_SAVE(N)=
    BEGIN
	REGISTER F;

	WED_HISEG(1);		!WRITE LOCK THE HI-SEG
	F = -1;
	IF CALLI (F,%O'115')  THEN
	    BEGIN
	    .N+1 = .F;
	    F<LH> = 3;
	    F<RH> = .N;
	    IF CALLI (F,%O'116')  THEN
		STOP()
	    ELSE
		RETURN 0;
	    END
	ELSE
	    RETURN 0;
END;
)%
GLOBAL ROUTINE HELP=
    BEGIN
	IF .COMTAB EQL PRVTAB THEN
	    TYPE ('Valid commands are: Add,Delete,Exit,Help,List,Type,Update,Write',crlf)
	ELSE
	    TYPE ('Valid commands are: List,Type,Exit',CRLF);
	RETURN 2;
    end;
GLOBAL ROUTINE EXITPG=
    BEGIN
	WED_HISEG(1);		!WRITE LOCK THE HISEG
	STOP();			!AND EXIT
    END;
GLOBAL ROUTINE LIST=
    BEGIN
	INCR N FROM NODTBL$BASE TO .HI$ADDR BY .NTBL$EL DO
	BEGIN
	    IF ..N EQL 0 THEN
		 RETURN 2
	    ELSE
		BEGIN
		IF ..N NEQ -1 THEN
		    BEGIN
		    TYPE_SIX(2,.N);
		    TYPE (CRLF);
		    END;
		END;
	END;
    END;
GLOBAL ROUTINE TYPNOD =

!
!Routine to type out the entries for a node or for all nodes
!
    BEGIN
	LOCAL
	    TMP$PTR;

    UNTIL CH$RCHAR(.TBUF_PTR) NEQ %O'40' DO
	CH$RCHAR_A(TBUF_PTR);		!EAT SPACES

    TMP$PTR = .TBUF_PTR;
    WHILE 1 DO
	IF (C=CH$RCHAR_A(TMP$PTR)) EQL 0 THEN
	    EXITLOOP
	ELSE
	    IF .C EQL %C'=' THEN 
		BEGIN
		FBINI(FB);			!INITIALIZE A FILE BLOCK
		FPARSE(FB,TBUF_PTR);
		NODE$FLAG[NF$FILESPEC] = 1;
		END;

    IF GET_NODE$NAME(.TBUF_PTR) eql 0 THEN
	RETURN 2
    ELSE
    IF .NODE$FLAG[NF$WILD] THEN
	BEGIN
	INCR N FROM NODTBL$BASE TO .HI$ADDR BY .NTBL$EL DO
	    BEGIN
	    IF (..N NEQ -1 AND ..N NEQ 0) THEN
		BEGIN
		NODE = .N;
		TYPE_BLOCK();
		END;
	    END
	END
    ELSE
	BEGIN
	IF FIND_NODE() EQL 0 THEN
	    BEGIN
	    TYPE ('No such NODE in table',crlf);
	    END
	ELSE
	    TYPE_BLOCK();
	END;
	TYPE (CRLF);
	TTBUF = 0;
	TBUF_PTR = CH$PTR(TTBUF);
    RETURN 2
    END;
ROUTINE TYPE_BLOCK=
    BEGIN

	LOCAL
	    N,
	    NPTR,	!ABS ADDR INTO HI-SEG FOR EACH ENTRY
	    NN;

	MAP NODE: REF NODTBL_ENTRY;

	NPTR = .NODE;
!
!IF NETSPL NODE FLAG THAT
!
	IF .NODE[NOD$F_TYPE] THEN
	    NODE$FLAG[NF$NET] = 1
	ELSE
	    NODE$FLAG[NF$RJ] = 1;
!
!IF THERE IS A PHONE NUMBER ASSUME A DIALUP
!
	IF .NODE[NOD$PHN] NEQ 0 THEN
	    NODE$FLAG[NF$DIAL]=1
	ELSE
	    NODE$FLAG[NF$DIRECT] = 1;

	TYPE (CRLF);

!
!SCAN ALL ENTRIES IN THE BLOCK TO SEE IF WE SHOULD PRINT THEM
!PRINT THOSE WHOSE FLAGS MATCH THE NODTAB TYPE FIELD
!
	INCR NDB$PTR FROM 0 TO NDB$NUMITEM DO
	    BEGIN
	    NN = .NODTAB[.NDB$PTR,ENTRY_LEN];
	    IF ((.NODTAB[.NDB$PTR,NODE_CHAR] AND .NODE$FLAG) OR .ALLSW) EQL 0
	    THEN
		NPTR = .NPTR + .NN/2	!Doesn't he want to hear about this?
	    ELSE
		BEGIN
		TSTR (.NODTAB[.NDB$PTR,PROMPT_STR]);
		TYPE (': ');
		CASE .NDB$PTR FROM 0 TO NDB$NUMITEM OF
		SET
		[0,1,2,11,12]:		!SIXBIT ENTRIES
		    BEGIN
		    IF ..NPTR NEQ 0 THEN
			TYPE_SIX(.NN,.NPTR);
		    NPTR = .NPTR + .NN/2;
		    END;
		[16]:			!OPERATING SYSTEM TYPE
		    BEGIN
		    TYPE_OS(.NPTR);
		    NPTR = .NPTR + .NN/2;
		    END;
		[3,4,13,15,17]:			!ASCII ENTRIES
		    BEGIN
		    IF ..NPTR NEQ 0 THEN
			TSTR(.NPTR);
		    NPTR = .NPTR + .NN/2;
		    END;
		[5,6]:			!ONE WORD DECIMTAL ENTRIES IN JIFFIES
		    BEGIN
		    N = (JIFTIM(..NPTR));
		    TYPDEC(N);
		    NPTR= .NPTR +1;
		    END;
		[14,18,20,21]:	!ONE-WORD DECIMAL ENTRIES
		    BEGIN
		    IF ..NPTR NEQ 0 THEN
			TYPDEC(.NPTR);
		    NPTR = .NPTR + 1;
		    END;
		[7,9]:				!<LH> DECIMAL
		    BEGIN
		    N = ..NPTR;
		    N = .N<LH>;
		    IF .N NEQ 0 THEN
			BEGIN
			N = JIFTIM(.N);	!CONVERT FROM JIFFIES
			TYPDEC(N);
			END;
		    END;
		[8]:				!<RH> OCTAL
		    BEGIN
		    N = ..NPTR;
		    N = .N<RH>;
		    IF .N NEQ 0 THEN
			N = JIFTIM(.N);	!CONVERT TO HHMM
			TYPDEC(N);
		    NPTR = .NPTR + 1;
		    END;
		[10]:
		    BEGIN
			N = ..NPTR;
			N = QUETIM(.N<RH>);
			TYPDEC (N);
			NPTR = .NPTR + 1;
		    END;
		[19]:
		    BEGIN
		    CURFLAG();
		    NPTR = .NPTR + 1;
		    END;
		[22]:	!Route-through node
		    TYPE_SIX(.NN,NODE[NOD$ROUTE]);
		[23]:	!Object type
		    TYPOCT(%REF(.NODE[NOD$OBJTYPE]));
		[24]:	!Programmer #
		    TYPOCT(%REF(.NODE[NOD$PROGNO]));
		[25]:	!Taskname
		    TYPE_SIX(.NN,NODE[NOD$CNAME]);
		TES;
	    TYPE (CRLF);
		END;
	    END;
    END;
ROUTINE TYPE_SIX(NN,NPTR)=

!
!ROUTINE TO TYPE OUT A SIXBIT ENTRY
!NPTR CONTAINS Address of THE SIXBIT ENTRY
!NN CONTAINS LENGTH IN HALF WORDS OF THE ENTRY
!
    BEGIN

	LOCAL PUT$STR;

	PUT$STR = CH$PTR(TTOBUF);
	INCR N FROM 2 TO .NN BY 2 DO
	BEGIN
	    WRSIXA(..NPTR,PUT$STR);
	    CH$WCHAR_A(0,PUT$STR);
	    TSTR(TTOBUF);
	END;
    END;
ROUTINE TYPDEC(N)=
    BEGIN

	LOCAL
	   PUT$STR;

    PUT$STR = CH$PTR(TTOBUF);
    WRNUMA (..N,10,PUT$STR);
    TSTR(TTOBUF);
    END;
ROUTINE TYPOCT(N)=
    BEGIN

	LOCAL
	   PUT$STR;

    PUT$STR = CH$PTR(TTOBUF);
    WRNUMA (..N,8,PUT$STR);
    TSTR(TTOBUF);
    END;
ROUTINE OS_TYPE(N)=
    BEGIN
	SELECTONEU ..N OF SET
	    [%SIXBIT'OTHER']:
		RETURN 0;
	    [%SIXBIT'RT11']:
		RETURN 1;
	    [%SIXBIT'RSTS']:
		RETURN 2;
	    [%SIXBIT'RSX11S']:
		RETURN 3;
	    [%SIXBIT'RSX11M']:
		RETURN 4;
	    [%SIXBIT'RSX11D']:
		RETURN 5;
	    [%SIXBIT'IAS']:
		RETURN 6;
	    [%SIXBIT'VAX']:
		RETURN 7;
	    [%SIXBIT'TOPS20']:
		RETURN 8;
	    [%SIXBIT'TOPS10']:
		RETURN 9;
	    [OTHERWISE]:
		BEGIN
		TYPE ('Unknown operating system type',CRLF);
		RETURN -1
		END;
	   TES;
    END;
ROUTINE TYPE_OS(N)=
    BEGIN
    CASE ..N FROM 0 TO 9 OF
	SET
	[0]:
	    TSTR(OTHER);
	[1]:
	    TSTR(RT11);
	[2]:
	    TSTR (RSTS);
	[3]:
	    TSTR (RSX11S);
	[4]:
	    TSTR (RSX11M);
	[5]:
	    TSTR (RSX11D);
	[6]:
	    TSTR (IAS);
	[7]:
	    TSTR (VAX);
	[8]:
	    TSTR (TOPS20);
	[9]:
	    TSTR (TOPS10);
	[OUTRANGE]:
	    TYPE ('Program logic error(2) - notify FTS maintainer',crlf);
	TES;
    END;
ROUTINE CURFLAG=
!Print out the status of a node
BEGIN
LOCAL
	PTR;
MAP NODE: REF NODTBL_ENTRY;

PTR=CH$PTR(TTOBUF);

!Now type out the bits in turn

IF .NODE[NOD$F_TYPE] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NETSPL'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /DAS78'))),PTR);

IF .NODE[NOD$F_RSND] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /RTRANSMIT'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NORTRANSMIT'))),PTR);

IF .NODE[NOD$F_RRTV] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /RRECEIVE'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NORRECEIVE'))),PTR);

IF .NODE[NOD$F_LSND] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /LTRANSMIT'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NOLTRANSMIT'))),PTR);

IF .NODE[NOD$F_LRTV] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /LRECEIVE'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NOLRECEIVE'))),PTR);

IF .NODE[NOD$F_QSND] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /QTRANSMIT'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NOQTRANSMIT'))),PTR);

IF .NODE[NOD$F_QRTV] THEN
	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /QRECEIVE'))),PTR)
ELSE	MOVEAZ(%REF(CH$PTR(UPLIT(%ASCIZ' /NOQRECEIVE'))),PTR);

CH$WCHAR_A(0,PTR);	!ASCIZ
TSTR(TTOBUF);					!Type it all out
END;	!CURFLAG
ROUTINE GIVE_HELP(N)=
    BEGIN
	LOCAL NN;
	CASE .N FROM 0 TO 30 OF
	    SET
	    [0]:
		type ('Node name of up to 6 characters',crlf);
	    [1]:
		type ('The device to which the request will be queued',crlf);
	    [2]:
		type ('Alternate queue device - used when primary is not available',crlf);
	    [3]:
		TYPE ('Phone number to be used by the automatic dialer',CRLF,'	to connect this node',crlf);
	    [4]:
		TYPE ('Secondary phone number for automatic dialer',crlf);
	    [5]:
		type ('Time that the node comes online - 24 hour time',CRLF);
	    [6]:
		type ('Time that the node goes offline - 24 hour time',CRLF);
	    [7]:
		TYPE ('Time in minutes to wait for successful connect',CRLF);
	    [8]:
		;
	    [9]:
		;
	    [10]:
		TYPE ('After switch time if request must be requeued',CRLF);
	    [11]:
		TYPE ('Sign on file name',CRLF);
	    [12]:
		TYPE ('Sign off file name',CRLF);
	    [13]:
		TYPE ('Password to be used to validate process we are connecting to',CRLF);
	    [14]:
		;
	    [15]:
		TYPE ('Geographical location of the system',CRLF);
	    [16]:
		TYPE ('Type of operating system running on this node',CRLF);
	    [17]:
		TYPE ('Person to contact at this node - up to 39 characters',CRLF);
	    [18]:
		;
	    [19]:
		BEGIN
		TYPE ('Flags controlling transfers from/to this node',CRLF);
		TYPE ('Valid flags are: ');
		INCR N FROM 1 TO 14 DO
		    BEGIN
		    C = FLGTAB[.N];
		    C = ..C;
		    C = .C<LH>;
		    TSTR(.C);
		    TYPE (',');
		    END;
		TYPE (CRLF);
		END;
	    [20]:
		;
	    [21]:
		TYPE ('Largest file that may be transfered to this node',CRLF,
		      'Size is specified in blocks',CRLF);
	    [22]:
		TYPE ('Name of NETWORK NODE or other routing node.',CRLF,
		      'Leave blank if the node is on the same network.',CRLF);
	    [23]:
		TYPE ('DECNET object type of remote server.',CRLF,
		      '0 if the remote system is a TOPS-10 system.',CRLF);
	    [24]:
		;
	    [25]: TYPE ('Process Name to connect to.',CRLF,
			'For nodes reached through NETWORK NODE:',CRLF,
			'	Should be node-id of node on its own network',
		CRLF,	'For all other nodes: should be 0',CRLF);

	    [INRANGE]:;
	    [OUTRANGE]:
		BEGIN
		TYPE ('The following entries may be changed:',CRLF);
		INCR N FROM 1 TO NDB$NUMITEM DO
		    BEGIN
		    IF (.NODTAB[.N,NODE_CHAR]AND .NODE$FLAG) NEQ 0 THEN
			BEGIN
			TSTR (.NODTAB[.N,PROMPT_STR]);
			TYPE (CRLF);
			END
		    END
		END;
	TES;
	END;
END ELUDOM