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