Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
mgnnd.bli
There are no other files named mgnnd.bli in the archive.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
! *** LAST MODIFIED BY ILG ON 30-DEC-76
COMMENT;
! MGNND.BLI
! ===== ===
! THIS FILE CONTAINS THOSE ROUTINES REQUIRED TO HANDLE NODE GENERATIONS
GLOBAL BIND ND = 1;
FORWARD PRNODENAME;
COMMENT;
! ROUTINE PRINTNODENAME
! ======= =============
! OUTPUTS NODENAME TO CONTROLLING TTY
ROUTINE PRINTNODENAME( NODENAME ) =
BEGIN
TYPE( 'FOR [NODE ]');
PRNODENAME( .NODENAME );
TYPE( '[:?M?J]' )
END;
COMMENT;
! ROUTINE INNODE
! ======= ======
! THIS ROUTINE ASKS FOR AND ACCEPTS A NODE NAME FROM THE USER
ROUTINE INNODE(A)=
BEGIN
XTYPE(.A); ! TYPE THE QUESTION
IF (ACHAR _ INPUT(ALINE,ALINELENGTH)) EQL CRCHAR THEN RETURN 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 .ERRORFLG THEN 0 ELSE 1 ! IF ERROR IN ANY PART, RETURN 0 ELSE 1
END;
COMMENT;
! ROUTINE PRNODENAME
! ======= ==========
! THIS ROUTINE TYPES A NODENAME
GLOBAL ROUTINE PRNODENAME( NODENAME ) =
BEGIN
LABEL LOOP;
XOUTPUT( .NODENAME );
LOOP: INCR I FROM N0NAMELEN TO N0NAMELEN * 3 BY N0NAMELEN DO
BEGIN
IF .(.NODENAME)[.I] EQL 0 THEN LEAVE LOOP;
! ELSE !
OUTPUTC(".");
XOUTPUT( (.NODENAME)[.I] )
END
END;
COMMENT;
! ROUTINE CREATENODE
! ======= ==========
! CREATE A NEW NODE WHICH WILL BE ATTACHED TO THE TREE (BY SOMEONE
! ELSE
ROUTINE CREATENODE( NODENAME ) =
BEGIN
REGISTER
NODEPTR;
MAP FORMAT NODEPTR;
LABEL LOOP;
NODEPTR _ GMEM(N0SIZE);
ZERO( .NODEPTR, N0SIZE );
LOOP: DECR I FROM N0NAMELEN * ( MAXLEVEL - 1 ) TO 0 BY N0NAMELEN DO
IF .(.NODENAME)[.I] NEQ 0 THEN
BEGIN
MOVE( %FROM% (.NODENAME)[.I], %TO% NODEPTR[N0NAME], N0NAMELEN %WORDS%);
LEAVE LOOP
END;
NODEPTR[ N0TOBEDEFINED ] _ TRUE;
.NODEPTR
END;
COMMENT;
! ROUTINE NULLNODENAME
! ======= ============
! RETURNS TRUE IF THE PRIMARY QUEUE AND SUBQUEUES ARE NULL, ELSE FALSE
GLOBAL ROUTINE NULLNODENAME(LOC)=
BEGIN
DECR I FROM N0NAMELEN * ( MAXLEVEL - 1 ) TO 0 BY N0NAMELEN DO
IF .(.LOC)[.I] NEQ 0 THEN RETURN FALSE;
TRUE
END;
FORWARD ACCEPTNODE(1);
COMMENT;
! ROUTINE MAKENODE
! ======= ========
! GIVEN THE ADDRESS OF A NODENAME, THIS ROUTINE CAUSE THE APPROPRIATE
! QUESTIONS TO BE ASKED TO GENERATE ONE OR MORE NODES ( MORE IF
! THE NODE NAME WAS NULL)
GLOBAL ROUTINE MAKENODE(NODENAME)=
BEGIN
IF .TRCLEN LEQ 0 THEN RETURN( ERROR( 35 ) ); ! CAN'T MAKE NODE WITHOUT TRCODE SIZE
IF NULLNODENAME(.NODENAME) THEN ! IF NO NODE SPECIFIED
BEGIN ! ASK THE USER FOR NODE NAMES
REPEAT ! UNTIL HE INPUTS A <CR> BY
BEGIN ! ITSELF
IF INNODE( PAZ '[NODENAME]?R(<done>,<NAME>?R)[: ??') EQL 0 THEN
IF NOT .ERRORFLG THEN RETURN
ELSE
BEGIN
ERRORFLG _ 0; ! IF THE ANSWER WAS UNACCEPTABLE
ERROR( 88 ); ! TELL THE USER AND ASK AGAIN
WARN( 0 )
END
ELSE ACCEPTNODE(PRIM<36,7>); ! IF OK NAME EXECUTE THE FUNCTION
CRLF
END
END;
ACCEPTNODE(.NODENAME) ! IF A NODE WAS SPECIFIED, USE IT
END;
COMMENT;
! ROUTINE GETNODEPTR
! ======= ===========
! SEARCHES THE TREE FOR THE NODENAME CONTAINED AT THE CONTENTS OF NODENAME
! IF FOUND, RETURNS THE ADDRESS OF THE TREE ENTRY
! OTHERWISE RETURNS 0
GLOBAL ROUTINE GETNODEPTR(NODENAME) =
BEGIN
REGISTER
NODE,
NODEPTR;
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
LABEL LOOP;
INCR I FROM 0 TO (MAXLEVEL - 1) * N0NAMELEN BY N0NAMELEN DO
BEGIN
IF TOOLONG((.NODENAME)[.I],N0NAMESIZE, N0NAMELEN * 5) THEN
BEGIN
WARN( 1 );
TRUNCATE((.NODENAME)[.I], N0NAMESIZE, N0NAMELEN * 5)
END
END;
NODEPTR _ ROOT<0,0>;
NODE _ .ROOT[N0FIRSTCHILD]; ! SET STARTING POINT OF SEARCH TO
! THE FIRST CHILD OF THE ROOT OF THE TREE
INCR I FROM 0 TO (MAXLEVEL - 1) * N0NAMELEN BY N0NAMELEN DO
! LOOK AT THE QUEUENAMES ONE AT A TIME
LOOP: BEGIN
IF .(.NODENAME)[.I] EQL 0 THEN ! IF THE QUEUE NAME IS NULL THEN
RETURN .NODEPTR; ! ALL DONE
WHILE .NODE NEQ 0 DO ! IF NOT NULL THEN SEARCH THE TREE FOR THE NAME
BEGIN
NODEPTR _ .NODE;
IF COMPARE(NODEPTR[N0NAMEW],(.NODENAME)[.I],N0NAMELEN) THEN
! SEE IF THE NAME OF THIS NODE IS THE ONE WE WANT
BEGIN
NODE _ .NODEPTR[N0FIRSTCHILD]; ! GOT ONE ON THIS LEVEL
! SO TRY NEXT NAME & LEVEL
LEAVE LOOP
END
ELSE NODE _ .NODEPTR[N0RSIB]; ! NOT IT SO TRY NEXT
! ON THIS LEVEL
END;
RETURN 0 ! NO MATCH SO ERROR OUT
END;
.NODEPTR
END;
FORWARD MAKNODE(1), MODNODE(1), REPNODE(1);
COMMENT;
! ROUTINE ACCEPTNODE
! ======= ==========
! THIS ROUTINE CREATES A NODE TABLE ENTRY IF ONE DOES NOT EXIST
! THEN CALLS MAKNODE TO ASK THE QUESTIONS TO FILL THE ENTRY
! IF THE NODE ALREADY EXISTS, THE USER IS ASKED HOW HE WANTS TO
! HANDLE IT
ROUTINE ACCEPTNODE(NODENAME)=
BEGIN
REGISTER
PARENT,
NODEPTR;
LABEL LOOP;
MAP FORMAT NODEPTR;
PRINTNODENAME( .NODENAME );
! SEE IF ALREADY DEFINED
IF (NODEPTR _ GETNODEPTR(.NODENAME)) EQL 0 THEN
BEGIN
NODEPTR _ CREATENODE( .NODENAME ); ! MAKE A NODE TABLE ENTRY
LOOP: DECR I FROM ( MAXLEVEL - 1 ) * N0NAMELEN TO 0 BY N0NAMELEN DO ! ZAP LAST NODE NAME
IF .(.NODENAME)[ .I ] NEQ 0 THEN
BEGIN
ZERO( (.NODENAME)[ .I ], (.NODENAME)[ .I ] + N0NAMELEN );
LEAVE LOOP
END;
IF (PARENT _ GETNODEPTR( PRIM<36,7> )) EQL 0 THEN
BEGIN
ERROR( 42 ); ! BAD PARENT
PMEM( .NODEPTR, N0SIZE ); ! UNCREATE THE NODE
RETURN
END
ELSE
BEGIN
NODEPTR[N0PARENT] _ .PARENT; ! STORE THE PARENT
END
END
ELSE
BEGIN
IF NOT .NODEPTR[N0TOBEDEFINED] THEN
BEGIN
ASKSTR( 'NODE [ALREADY EXISTS]?R(IGNORE, MODIFY, REPLACE?R)[: ??]',
PLIT( ASCII 'REPLA', REPNODE,
ASCII 'MODIF', MODNODE,
0, IGNORE,
ASCII 'IGNOR', IGNORE),
.NODEPTR);
RETURN
END
END;
MAKNODE(.NODEPTR)
END;
FORWARD ASKCHILDREN, ASKCHKPNT, DFULL, KILLNODES, ASKCHILD;
COMMENT;
! ROUTINE MAKNODE
! ======= =======
! THIS ROUTINE ASKS THE QUESTIONS TO MAKE ONE (AND ONLY ONE) NODE
! AND RECORDS THE RESPONSES IN THE APPROPRIATE NODE ENTRY
ROUTINE MAKNODE( NODEPTR ) =
BEGIN
REGISTER LEAF;
MAP FORMAT NODEPTR;
ASKSIBS( .NODEPTR, .NODEPTR[ N0PARENT ] );
ASKMPP( .NODEPTR );
IF .NODEPTR[ N0LEVEL ] GEQ MAXLEVEL - 1 THEN
BEGIN
LEAF _ TRUE;
TYPE( '[THIS IS A LEAF?M?J]' )
END
ELSE LEAF _ ASKYESORNO( '[IS THIS TO BE A LEAF]?R(YES,NO?R)[: ??]', YES );
IF NOT .LEAF THEN
BEGIN
ASKCHILDREN( .NODEPTR )
END
ELSE
BEGIN
ASKQUOTA( .NODEPTR );
ASKISTAT( .NODEPTR );
ASKTRCODE( .NODEPTR );
ASKOPDST( .NODEPTR );
ASKCHKPNT( .NODEPTR )
END;
CRLF;
NODEPTR[N0TOBEDEFINED] _ FALSE
END;
COMMENT;
! ROUTINE ASKCHILDREN
! ======= ===========
! THIS ROUTINE ASKS FOR THE CHILDREN OF A NODE THEN ASKS ABOUT EACH CHILD
! NOTE: ASKCHILDREN CAN CALL ASKCHILD WHICH CAN CALL ASKCHILDREN ETC.
ROUTINE ASKCHILDREN( NODEPTR ) =
BEGIN
REGISTER
NEXTLEVEL,
SIB,
CHILD;
LABEL LOOP;
MAP FORMAT NODEPTR;
MAP FORMAT SIB;
MAP FORMAT CHILD;
TYPE( '[CHILDREN]?R(<done>,<INDIVIDUAL-NAMES>?R)[: ??]' );
NODEPTR[ N0CHILDREN ] _ 0;
FIRST _ TRUE;
NEXTLEVEL _ .NODEPTR[ N0LEVEL ] + 1;
LOOP: REPEAT
BEGIN
IF .FIRST THEN FIRST _ FALSE ELSE TYPE( '[?I?I?I??' );
ACHAR _ INPUT( ALINE, ALINELENGTH );
SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
IF EOL( ACHAR ) THEN LEAVE LOOP;
WHILE NOT EOL( ACHAR ) DO
BEGIN
GETNAME( ABUFF, ABPTR, ACOUNT, ACHAR );
IF SUBQUEUES( PRIM ) THEN
BEGIN
ACHAR _ CRCHAR; ! FAKE AN EOL
ERROR( 97 );
WARN( 0 )
END
ELSE
BEGIN
IF SIBSAMENAME( .NODEPTR, PRIM ) THEN
BEGIN
ACHAR _ CRCHAR; ! FAKE AN EOL
ERROR( 84 );
WARN( 0 )
END
ELSE
BEGIN
SKIPBLANKS( ABUFF, ABPTR, ACOUNT, ACHAR );
IF .ACHAR EQL "," OR EOL( ACHAR ) THEN
BEGIN
SIB _ .NODEPTR[ N0LASTCHILD ];
CHILD _ CREATENODE( PRIM );
IF .NODEPTR[ N0FIRSTCHILD ] EQL 0 THEN NODEPTR[ N0FIRSTCHILD ] _ .CHILD;
NODEPTR[ N0LASTCHILD ] _ SIB[ N0RSIB ] _ .CHILD;
CHILD[ N0LSIB ] _ .SIB;
CHILD[ N0PARENT ] _ .NODEPTR;
CHILD[ N0LEVEL ] _ .NEXTLEVEL;
IF .ACHAR EQL "," THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR )
END
ELSE
BEGIN
ERROR( 46 );
ACHAR _ CRCHAR ! FAKE AN EOL
END
END
END
END
END;
SIB _ .NODEPTR[N0FIRSTCHILD ];
WHILE .SIB NEQ 0 DO
BEGIN
ASKCHILD( .SIB );
SIB _ .SIB[ N0RSIB ]
END
END;
COMMENT;
! ROUTINE ASKCHILD
! ======= ========
! THIS ROUTINE ASKS FOR THE INFO ABOUT A CHILD
! SEE ASKCHILDREN ABOUT RECURSION
ROUTINE ASKCHILD( NODEPTR ) =
BEGIN
REGISTER LEAF;
MAP FORMAT NODEPTR;
TYPE( '[FOR NODE ]');
DFULL( .NODEPTR );
OUTC( ":" );
CRLF;
ASKMPP( .NODEPTR );
IF .NODEPTR[ N0LEVEL ] GEQ MAXLEVEL - 1 THEN
BEGIN
LEAF _ TRUE;
TYPE( '[THIS IS A LEAF?M?J]' )
END
ELSE LEAF _ ASKYESORNO( '[IS THIS TO BE A LEAF]?R(YES,NO?R)[: ??]', YES );
IF NOT .LEAF THEN
BEGIN
ASKCHILDREN( .NODEPTR )
END
ELSE
BEGIN
ASKQUOTA( .NODEPTR );
ASKISTAT( .NODEPTR );
ASKTRCODE( .NODEPTR );
ASKOPDST( .NODEPTR );
ASKCHKPNT( .NODEPTR )
END;
CRLF;
NODEPTR[N0TOBEDEFINED] _ FALSE
END;
COMMENT;
! ROUTINE REPNODE
! ======= =======
! THIS ROUTINE ASKS THE QUESTIONS TO REPLACE ONE NODE
! AND RECORDS THE RESPONSES IN THE APPROPRIATE NODE ENTRY
ROUTINE REPNODE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
KILLNODES( .NODEPTR ); ! FIRST DELETE THE NODE TO BE REPLACED
! AND ALL ITS CHILDREN TOO.
ACCEPTNODE( PRIM<36,7> ); !THEN RECREATE IT BY NAME
END;
FORWARD DISNODE, DALLNODES;
COMMENT;
! ROUTINE DISPNODE
! ======= ===========
! THIS ROUTINE HANDLES THE INDIVIDUAL CASES OF DISPLAY NODE:...
! CASE 1: IF AN INDIVIDUAL NODE IS REQUESTED ( BY NAME ), DISNODE IS
! CALLED WITH THE ADDRESS OF THE NODE TABLE ENTRY
! CASE 2: IF /ALL WAS SPECIFIED, DISNODE IS CALLED FOR EACH ENTRY IN
! NODE TABLE
! CASE 3: IF NO NAME OR SWITCH WAS GIVEN, THE USER IS ASKED FOR THE
! NAMES OF THE NODES TO BE DISPLAYED
GLOBAL ROUTINE DISPNODE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
IF .ROOT[ N0CHILDREN ] EQL 0 THEN RETURN ERROR( 38 );
IF NULLNODENAME(.NODENAME) AND NOT .ALLSWITCH THEN
BEGIN ! ASK THE USER FOR NODE NAMES
REPEAT ! UNTIL HE INPUTS A <CR> BY
BEGIN ! ITSELF
IF INNODE( PAZ '[NODENAME]?R(<done>,<NAME>?R)[: ??') EQL 0 THEN
IF NOT .ERRORFLG THEN RETURN
ELSE
BEGIN
ERRORFLG _ 0;
ERROR( 88 ); ! TELL THE USER AND ASK AGAIN
WARN( 0 )
END
ELSE IF (NODEPTR _ GETNODEPTR(PRIM)) EQL 0 THEN
RETURN(ERROR(33))
ELSE DISNODE(.NODEPTR);
CRLF
END
END;
IF .ALLSWITCH THEN
BEGIN
IF .ROOT[ N0CHILDREN] EQL 0 THEN RETURN ( ERROR( 68 ) );
DALLNODES( .ROOT[ N0FIRSTCHILD] );
RETURN
END;
IF (NODEPTR _ GETNODEPTR(.NODENAME)) EQL 0 THEN RETURN(ERROR(33))
ELSE DISNODE(.NODEPTR)
END;
COMMENT;
! ROUTINE DALLNODES
! ======= =========
! THIS ROUTINE DISPLAYS ALL THE NODES IN THE TREE
ROUTINE DALLNODES(ARG)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
MACRO
NAME = NODEPTR[N0NAME]$,
NEXTTHIS = NODEPTR[N0RSIB]$,
NEXTLEVEL = NODEPTR[N0FIRSTCHILD]$,
LEAF = (.NEXTLEVEL EQL 0)$;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
DISNODE(.NODEPTR);
IF NOT LEAF THEN DALLNODES(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
FORWARD DNFULLSPEC, DNNAME, DNLEVEL, DNTYPE, DNPARENT, DNSIBS,
DNCHILDREN, DNMPP, DNTHRESH, DLQUOTA, DLISTAT, DLTRCODE,
DLOSTAT,DLCHKPNT, DLONAME;
COMMENT;
! ROUTINE DISNODE
! ======= =======
! THIS ROUTINE DISPLAYS THE NODE'S NAME, AND IF THE NODE IS UNDEFINED,
! THEN "NOT YET DEFINED..." IS DISPLAYED, OTHERWISE THE NODE PARAMETERS
! ARE DISPLAYED
ROUTINE DISNODE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
DNFULLSPEC(.NODEPTR);
DNNAME(.NODEPTR);
DNLEVEL(.NODEPTR);
DNTYPE(.NODEPTR);
DNPARENT(.NODEPTR);
DNSIBS(.NODEPTR);
DNCHILDREN(.NODEPTR);
IF .NODEPTR[N0TOBEDEFINED] THEN
BEGIN
OUTPUT('NOT YET DEFINED, PLEASE MAKE OR MODIFY IT')
END
ELSE
BEGIN
DNMPP(.NODEPTR);
DNTHRESH(.NODEPTR);
IF .NODEPTR[N0CHILDREN] EQL 0 THEN ! IF LEAF THEN
BEGIN
DLQUOTA(.NODEPTR);
DLISTAT(.NODEPTR);
DLTRCODE(.NODEPTR);
DLOSTAT(.NODEPTR);
DLONAME(.NODEPTR);
DLCHKPNT(.NODEPTR)
END
END;
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNAME
! ======= =====
! THIS ROUTINE DISPLAYS THE NAME OF A NODE
GLOBAL ROUTINE DNAME( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
XOUTPUT( NODEPTR[N0NAME] )
END;
COMMENT;
! ROUTINE DFULL
! ======= =====
! THIS ROUTINE DISPLAYS THE FULL NAME OF A NODE
ROUTINE DFULL( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0PARENT] NEQ ROOT<0,0> THEN
DFULL( .NODEPTR[N0PARENT] )
ELSE
BEGIN
DNAME( .NODEPTR );
RETURN
END;
OUTPUTC( "." );
DNAME( .NODEPTR )
END;
COMMENT;
! ROUTINE DNFULLSPEC
! ======= ======
! THIS ROUTINE DISPLAYS THE FULL SPECIFICATION OF A NODE WITH SOME
! OTHER GARBAGE
ROUTINE DNFULLSPEC( NODEPTR ) =
BEGIN
OUTPUT( 'FULL SPECIFICATION: ');
DFULL( .NODEPTR );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNNAME
! ======= ======
! THIS ROUTINE DISPLAYS THE NAME OF A NODE WITH SOME OTHER GARBAGE
ROUTINE DNNAME( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
OUTPUT( 'INDIVIDUAL NAME: ');
XOUTPUT( NODEPTR[N0NAME] );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNLEVEL
! ======= =======
! THIS ROUTINE TYPES THE LEVEL OF THE NODE
ROUTINE DNLEVEL( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
OUTPUT('LEVEL: ');
XOUTPUT( CASE .NODEPTR[N0LEVEL] OF
SET
%0% PAZ 'PRIM';
%1% PAZ 'SQ1';
%2% PAZ 'SQ2';
%3% PAZ 'SQ3';
TES );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNTYPE
! ======= =========
! THIS ROUTINE DISPLAYS THE NODE'S TYPE
ROUTINE DNTYPE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
OUTPUT('TYPE: ');
XOUTPUT(IF .NODEPTR[N0CHILDREN] EQL 0 THEN PAZ 'LEAF' ELSE PAZ 'NODE');
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNPARENT
! ======= ========
! THIS ROUTINE DISPLAYS THE PARENT OF A NODE
ROUTINE DNPARENT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
OUTPUT('PARENT: ');
IF .NODEPTR[N0PARENT] EQL ROOT<0,0> THEN
OUTPUT( '<none>' )
ELSE
DFULL( .NODEPTR[N0PARENT] );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNSIBS
! ======= ======
! THIS ROUTINE TYPES THE SIBS OF A NODE
GLOBAL ROUTINE DNSIBS( NODEPTR ) =
BEGIN
REGISTER
PARENT,
SIB;
MAP FORMAT NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT SIB;
PARENT _ .NODEPTR[N0PARENT];
SIB _ .PARENT[N0FIRSTCHILD];
OUTPUT('SIBS: ');
DO
BEGIN
IF .SIB EQL .NODEPTR THEN
OUTPUT('<SELF>')
ELSE DNAME( .SIB );
SIB _ .SIB[N0RSIB];
IF .SIB NEQ 0 THEN OUTPUTC( "," )
END
WHILE .SIB NEQ 0;
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNCHILDREN
! ======= ==========
! THIS ROUTINE DISPLAYS THE CHILDREN OF THE SPECIFIED NODE
GLOBAL ROUTINE DNCHILDREN( NODEPTR ) =
BEGIN
REGISTER
CHILD;
MAP FORMAT NODEPTR;
MAP FORMAT CHILD;
OUTPUT('CHILDREN: ');
IF ( CHILD _ .NODEPTR[N0FIRSTCHILD] ) EQL 0 THEN
BEGIN
OUTPUT('<none>?M?J');
RETURN
END;
DO
BEGIN
DNAME( .CHILD );
IF .CHILD[N0RSIB] NEQ 0 THEN OUTPUTC( "," )
END
WHILE ( CHILD _ .CHILD[N0RSIB] ) NEQ 0;
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNMPP
! ======= =====
! THIS ROUTINE DISPLAYS THE MPP ASSOCIATED WITH THIS NODE
ROUTINE DNMPP( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
OUTPUT('MPP: ');
IF .NODEPTR[N0MPPPTR] NEQ 0 THEN
DMNAME( .NODEPTR[N0MPPPTR] )
ELSE OUTPUT('<none>');
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DNTHRESH
! ======= ========
! THIS ROUTINE DISPLAYS THE STARTING CRITERION ( THRESHOLD ) FOR THE
! SPECIFIED MPP
ROUTINE DNTHRESH( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0MPPPTR] EQL 0 THEN RETURN;
OUTPUT( 'STARTING CRITERION: ');
OUTPUTD( .NODEPTR[N0THRESH] );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLQUOTA
! ======= =======
! THIS ROUTINE DISPLAYS THE TRANSACTION QUOTA OF A LEAF
ROUTINE DLQUOTA( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN RETURN; ! IF NOT LEAF LEAVE NOW
OUTPUT( 'QUOTA: ');
OUTPUTD( .NODEPTR[N0QUOTA] );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLISTAT
! ======= =======
! THIS ROUTINE DISPLAYS THE INITIAL INPUT STATUS OF THE LEAF
ROUTINE DLISTAT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN RETURN; ! IF NOT LEAF LEAVE NOW
OUTPUT('INITIAL INPUT STATUS: ');
XOUTPUT( IF .NODEPTR[N0STATUS] EQL ENABLED THEN PAZ 'ENABLED' ELSE PAZ 'DISABLED' );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLTRCODE
! ======= ========
! THIS ROUTINE DISPLAYS THE TRANSACTION CODE ASSOCIATED WITH THIS LEAF
ROUTINE DLTRCODE( NODEPTR ) =
BEGIN
REGISTER TRCODE;
MAP FORMAT TRCODE;
MAP FORMAT NODEPTR;
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN RETURN; ! IF NOT LEAF LEAVE NOW
OUTPUT('TRCODE: ');
TRCODE _ .NODEPTR[N0TRCODE];
OUTPUTBITS( TRCODE[TR0CODE], .TRCLEN );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLOSTAT
! ======= =======
! THIS ROUTINE DISPLAYS THE INITIAL OUTPUT STATUS OF THIS LEAF
ROUTINE DLOSTAT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN RETURN; ! IF NOT LEAF LEAVE NOW
IF .NODEPTR[N0OPNAME] EQL 0 THEN
OUTPUT('THIS LEAF IS NOT USED FOR OUTPUT')
ELSE
BEGIN
OUTPUT('INITIAL OUTPUT STATUS: ');
XOUTPUT( IF .NODEPTR[N0OPSTATUS] EQL ENABLED THEN PAZ 'ENABLED' ELSE PAZ 'DISABLED' )
END;
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLONAME
! ======= =======
! THIS ROUTINE DISPLAYS THE NAME FOR OUTPUT OF THIS LEAF
ROUTINE DLONAME( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0OPNAME] EQL 0 OR .NODEPTR[N0CHILDREN] NEQ 0 THEN
RETURN
ELSE
BEGIN
OUTPUT('NAME FOR OUTPUT: ');
XOUTPUT( NODEPTR[N0OPNAME] );
END;
OUTPUTCRLF
END;
COMMENT;
! ROUTINE DLCHKPNT
! ======= ========
! THIS ROUTINE DISPLAYS WHETHER TRANSACTIONS TO THIS LEAF ARE CHECKPOINTED
ROUTINE DLCHKPNT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN % IF NOT A LEAF %
RETURN
ELSE
BEGIN
OUTPUT('TRANSACTIONS TO THIS LEAF ARE ');
IF NOT .NODEPTR[ N0CHKPNT ] THEN OUTPUT('NOT ');
OUTPUT('CHECKPOINTED?M?J')
END
END;
! ROUTINE MODINODE
! ======= ===========
! THIS ROUTINE HANDLES THE INDIVIDUAL CASES OF MODIFY NODE:...
! CASE 1: IF AN INDIVIDUAL NODE IS REQUESTED ( BY NAME ), MODNODE IS
! CALLED WITH THE ADDRESS OF THE NODE TABLE ENTRY
! CASE 2: IF /ALL WAS SPECIFIED, MODNODE IS CALLED FOR EACH ENTRY IN
! NODE TABLE
! CASE 3: IF NO NAME OR SWITCH WAS GIVEN, THE USER IS ASKED FOR THE
! NAMES OF THE NODES TO BE MODIFIED
GLOBAL ROUTINE MODINODE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP ROOTFORMAT ROOT;
MAP FORMAT NODEPTR;
IF .ROOT[ N0CHILDREN ] EQL 0 THEN RETURN ERROR( 38 );
IF NULLNODENAME(.NODENAME) AND NOT .ALLSWITCH THEN
BEGIN ! ASK THE USER FOR NODE NAMES
REPEAT ! UNTIL HE INPUTS A <CR> BY
BEGIN ! ITSELF
IF INNODE( PAZ '[NODENAME]?R(<done>,<NAME>?R)[: ??') EQL 0 THEN
IF NOT .ERRORFLG THEN RETURN
ELSE
BEGIN
ERRORFLG _ 0;
ERROR( 88 ); ! TELL THE USER AND ASK AGAIN
WARN( 0 )
END
ELSE IF (NODEPTR _ GETNODEPTR(PRIM)) EQL 0 THEN
RETURN(ERROR(33))
ELSE MODNODE(.NODEPTR);
CRLF
END
END;
IF .ALLSWITCH THEN
BEGIN
ERROR( 8 );
RETURN
END;
IF (NODEPTR _ GETNODEPTR(.NODENAME)) EQL 0 THEN RETURN(ERROR(33))
ELSE MODNODE(.NODEPTR);
END;
FORWARD MNNAME(1), MNPARENT, MNSIBS, MNCHILDREN, MNMPP, MNTHRESH,
MLQUOTA, MLISTAT, MLCHKPNT, MLTRCODE, MLONAME, MLOSTAT, MNALL,
TELLNODECHANGES;
COMMENT;
! ROUTINE MODNODE
! ======= =======
! THIS ROUTINE TYPES THE NAME OF THE NODE TO BE MODIFIED, AND THEN
! ASKS FOR THE CHANGES TO BE MADE. MODNODE DOES ONLY ONE NODE AT A
! TIME.
ROUTINE MODNODE(NODEPTR)=
BEGIN
OWN DONE;
MAP FORMAT NODEPTR;
%LOCAL% ROUTINE SETDONE = DONE _ TRUE;
TYPE( 'FOR [NODE ]' );
DFULL( .NODEPTR );
TYPE( '[:?M?J]' );
IF .NODEPTR[N0TOBEDEFINED] THEN ! IF UNDEFINED THEN
BEGIN
MAKNODE() ! MAKE IT
END
ELSE
BEGIN
DONE _ FALSE;
WHILE NOT .DONE DO ! OTHERWISE, UNTIL THE USER GIVES US A LONE <CR> DO
BEGIN
ASKSTR( '[CHANGE: ??]', ! ASK WHAT CHANGES
PLIT( ASCII '??', TELLNODECHANGES,
ASCII 'NAME', MNNAME,
ASCII 'PAREN', MNPARENT,
ASCII 'SIBS', MNSIBS,
ASCII 'CHILD', MNCHILDREN,
ASCII 'MPP', MNMPP,
ASCII 'START', MNTHRESH,
ASCII 'QUOTA', MLQUOTA,
ASCII 'ISTAT', MLISTAT,
ASCII 'TRCOD', MLTRCODE,
ASCII 'ONAME', MLONAME,
ASCII 'OSTAT', MLOSTAT,
ASCII 'CHKPT', MLCHKPNT,
ASCII 'ALL', MNALL,
0, SETDONE),
.NODEPTR);
CRLF
END
END
END;
COMMENT;
! ROUTINE TELLNODECHANGES
! ======= ===============
! THIS ROUTINE TELLS ( WITH LOTS OF WIND ) WHAT CHANGES CAN BE MADE ON
! A NODE
ROUTINE TELLNODECHANGES =
BEGIN
TYPE( 'TYPE [NAME] TO CHANGE THE NAME OF THE NODE[(,)]?J
?MTYPE [PARENT] TO CHANGE THE PARENT OF THE NODE[(,)]?J
?MTYPE [SIBS] TO CHANGE THE SIBLINGS OF THE NODE[(,)]?J
?MTYPE [CHILDREN] TO CHANGE THE CHILDREN OF THE NODE[(,)]?J
?MTYPE [MPP] TO CHANGE THE MPP TO START FOR THE NODE[(,)]?J
?MTYPE [START] TO CHANGE THE STARTING CRITERION FOR THE NODE[(,)]?J
?MTYPE [QUOTA] TO CHANGE THE IN CORE QUOTA FOR THE LEAF[(,)]?J
?MTYPE [ISTAT] TO CHANGE THE INITIAL INPUT STATUS FOR THE LEAF[(,)]?J
?MTYPE [TRCODE] TO CHANGE THE TRANSACTION CODE FOR THE LEAF[(,)]?J
?MTYPE [ONAME] TO CHANGE THE NAME FOR OUTPUT FOR THE LEAF[(,)]?J
?MTYPE [OSTAT] TO CHANGE THE INITIAL OUTPUT STATUS FOR THE LEAF[(,)]?J
?MTYPE [CHKPT] TO CHANGE CHECKPOINT FLAG FOR THE LEAF[(,)]?J
?MTYPE [ALL] TO CHANGE ALL OF THE ABOVE[(,)]?J
?MTYPE A CARRIAGE RETURN TO FINISH CHANGING THIS NODE[(?R(<CR> WHEN DONE?R))]');
CRLF;
END;
COMMENT;
! ROUTINE MNALL
! ======= ========
! THIS ROUTINE ASKS ALL THE QUESTIONS TO CHANGE A NODE
ROUTINE MNALL(NODEPTR) =
BEGIN
MAP FORMAT NODEPTR;
MNNAME( .NODEPTR);
MNPARENT( .NODEPTR );
MNSIBS( .NODEPTR );
MNCHILDREN( .NODEPTR );
IF NOT MNMPP( .NODEPTR ) THEN ! IF THE STARTING CRITERIA
! QUESTION IS ASKED IN MNMPP
! THEN DON'T DO MNTHRESH
MNTHRESH( .NODEPTR );
IF .NODEPTR[ N0CHILDREN ] EQL 0 THEN
BEGIN
MLQUOTA( .NODEPTR );
MLISTAT( .NODEPTR );
MLTRCODE( .NODEPTR );
MLONAME( .NODEPTR );
MLOSTAT( .NODEPTR );
MLCHKPNT( .NODEPTR )
END
END;
COMMENT;
! ROUTINE MNNAME
! ======= =========
! THIS ROUTINE ASKS THE QUESTION TO CHANGE A NODE'S NAME
ROUTINE MNNAME(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
LABEL LOOP;
IF .SHOW THEN
BEGIN
DNFULLSPEC( .NODEPTR );
DNNAME(.NODEPTR)
END;
LOOP: REPEAT
BEGIN
IF INNODE( PAZ 'NEW [NODENAME]?R(,<NAME>?R)[: ??]') EQL 0 THEN RETURN;
IF SIBSAMENAME( .NODEPTR[ N0PARENT ], PRIM ) THEN ERROR( 84 )
ELSE IF SUBQUEUES( PRIM ) THEN ERROR( 97 )
ELSE LEAVE LOOP;
WARN( 0 )
END;
MOVE(PRIM, NODEPTR[N0NAME], N0NAMELEN)
END;
COMMENT;
! ROUTINE MNPARENT
! ======= ========
! THIS ROUTINE ASKS THE QUESTIONS TO MODIFY THE PARENT OF A NODE
ROUTINE MNPARENT( NODEPTR ) =
BEGIN
OWN PARENT,
NODE,
PARENTUP,
NODEDOWN;
MAP FORMAT NODEPTR;
MAP FORMAT NODE;
LABEL LOOP;
DNLEVEL( .NODEPTR );
DNTYPE( .NODEPTR );
DNPARENT( .NODEPTR );
LOOP: REPEAT
BEGIN
IF ( ASKLINE( '[NEW PARENT]?R(, "<NONE>", <NAME>?R)[: ??]' ) ) THEN RETURN; ! <CR> NO CHANGE
! ELSE !
IF MATCHALINE( NONE ) THEN
BEGIN
PARENT _ ROOT<0,0>;
LEAVE LOOP
END;
! ELSE !
GETNAME( ALINE, ACHAR );
IF NOT .ERRORFLG THEN
BEGIN
IF TOOMUCHINPUT() THEN %CONTINUE%
ELSE
IF ( PARENT _ GETNODEPTR( PRIM ) ) EQL 0 THEN ERROR( 42 )
ELSE
BEGIN
IF .PARENT EQL .NODEPTR THEN ERROR( 121 )
ELSE
BEGIN
NODE _ .PARENT;
WHILE .NODE NEQ ROOT<0,0> DO
BEGIN
IF .NODE EQL .NODEPTR THEN ERROR( 121 );
NODE _ .NODE[ N0PARENT ]
END;
IF NOT .ERRORFLG THEN
IF SIBSAMENAME( .PARENT, NODEPTR[ N0NAME ] ) THEN ERROR( 84 )
! SIB OF SAME NAME
ELSE
BEGIN
PARENTUP _ MPPUP( .PARENT );
NODEDOWN _ MPPDOWN( .NODEPTR );
IF NOT ( .PARENTUP EQL .NODEDOWN
OR
.NODEDOWN EQL 0
OR
.PARENTUP EQL 0 ) THEN ERROR( 99 )
ELSE LEAVE LOOP
END
END
END
END;
WARN( 0 ) ! AND TRY AGAIN
END;
DETACHNODE( .NODEPTR );
ASKSIBS( .NODEPTR, .PARENT ) ! ATTACH NODE TO NEW PARENT
END;
COMMENT;
! ROUTINE MNSIBS
! ======= ======
! THIS ROUTINE ASKS THE QUESTIONS TO MODIFY A NODES SIBLINGS
ROUTINE MNSIBS( NODEPTR ) =
BEGIN
OWN PARENT,
NODE;
%LOCAL% ROUTINE GETSIBNAME =
BEGIN
MAP FORMAT NODE;
LABEL LOOP;
REPEAT
BEGIN
LOOP: REPEAT
BEGIN
IF EOL( ACHAR ) THEN
BEGIN
ASKLINE( '[?I?I?I??]' );
IF EOL( ACHAR ) THEN RETURN TRUE
END;
! IN EITHER CASE !
ZEROARGLIST;
IF MATCHALINE( (PAZ '<SELF>' )<36,7> ) THEN
BEGIN
MOVE( NODE[ N0NAME ], PRIM, N0NAMELEN )
END
ELSE GETNAME( ALINE, ACHAR );
IF NOT ( .ACHAR EQL "," OR EOL( ACHAR ) ) THEN LEAVE LOOP WITH ERROR( 31 );
IF .ACHAR EQL "," THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR ); ! SKIP THE COMMA
IF .ARGTYPE NEQ 0
OR
.SUB1 NEQ 0
OR
.SUB2 NEQ 0
OR
.SUB3 NEQ 0 THEN LEAVE LOOP WITH ERROR( 97 );
IF .PRIM EQL 0 THEN LEAVE LOOP WITH ERROR( 32 );
RETURN FALSE;
END;
ACHAR _ CRCHAR;
WARN( 0 )
END
END;
%LOCAL% ROUTINE ASKEACH( SIB ) =
BEGIN
REGISTER NEXT;
MAP FORMAT SIB;
DO
BEGIN
NEXT _ .SIB[ N0RSIB ];
TYPE( '[DO YOU WISH TO KEEP SIB:]' );
DNAME( .SIB );
IF ( ASKYESORNO( ' ?R(YES, NO?R)[: ??]', YES ) ) THEN
BEGIN
DETACHNODE( .SIB );
ASKSIBS( .SIB, .PARENT )
END
END
WHILE ( SIB _ .NEXT ) NEQ 0
END;
REGISTER
SIB,
FAKENODEPTR,
NEXT;
LOCAL FAKENODE[ N0SIZE ];
LABEL LOOP,
LOOP2,
LOOP3,
LOOP4;
MAP FORMAT NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT FAKENODEPTR;
MAP FORMAT SIB;
! BEGIN !
IF .SHOW THEN DNSIBS( .NODEPTR ); ! SHOW THE SIBS TO THE USER IF HE WANTS THEM
PARENT _ .NODEPTR[ N0PARENT ];
NODE _ .NODEPTR;
LOOP: REPEAT
BEGIN
IF ASKLINE( '[NEW SIBS]?R(, "<NONE>", <NAME>?R)[: ??]' ) THEN RETURN;
! ELSE !
IF MATCHALINE( NONE ) THEN ! IF <NONE> THEN DELETE ALL SIBS
BEGIN
IF CONFIRMED() THEN
BEGIN
SIB _ .PARENT[ N0FIRSTCHILD ];
TYPE( 'NODES DELETED:?M?J' );
DO
BEGIN
NEXT _ .SIB[ N0RSIB ];
IF .SIB NEQ .NODEPTR THEN KILLNODES( .SIB );
END
WHILE ( SIB _ .NEXT );
RETURN
END
END
ELSE LEAVE LOOP;
WARN( 0 )
END;
! ELSE !
! DETACH ALL SIBS !
FAKENODEPTR _ FAKENODE<0,0>;
FAKENODEPTR[ N0CHILDREN ] _ .PARENT[ N0CHILDREN ];
MOVE( PARENT[ N0NAME ], FAKENODEPTR[ N0NAME ], N0NAMELEN ); ! GIVE THE FAKE NODE CHARACTERISTICS OF THE REAL
FAKENODEPTR[ N0PARENT ] _ .PARENT[ N0PARENT ]; ! PARENT FOR KILLNODE TO TYPE NAME
SIB _ .PARENT[ N0FIRSTCHILD ];
DO ! CHANGE THE PARENT OF EACH SIB TO FAKENODE
BEGIN
SIB[ N0PARENT ] _ .FAKENODEPTR
END
WHILE ( SIB _ .SIB[ N0RSIB ] ) NEQ 0;
PARENT[ N0CHILDREN ] _ 0;
LOOP2: REPEAT
BEGIN
IF GETSIBNAME() THEN LEAVE LOOP2;
! ELSE !
IF SIBSAMENAME( .PARENT, PRIM ) THEN ! IF SIB OF THE SAME NAME THEN ERROR
BEGIN
ERROR( 84 );
WARN( 0 )
END
ELSE ! OTHERWIISE
BEGIN
SIB _ .FAKENODEPTR[ N0FIRSTCHILD ]; ! SEE IF THE SIB GIVEN IS AN OLD ONE
LOOP3: WHILE .SIB NEQ 0 DO
BEGIN
IF COMPARE( SIB[ N0NAME ], PRIM, N0NAMELEN ) THEN LEAVE LOOP3;
SIB _ .SIB[ N0RSIB ]
END;
IF .SIB NEQ 0 THEN ! IF WE HAVE AN OLD ONE THEN
BEGIN
DETACHNODE( .SIB ) ! DETACH IT FROM THE FAKE NODE
END
ELSE
BEGIN
SIB _ CREATENODE( PRIM ) ! OTHERWISE MAKE A NEW ONE
END;
ATTACHNODE( .SIB, .PARENT, AFTER, 0 ) ! ATTACH THE SIB TO THE END OF THE LINE
END
END;
IF .FAKENODEPTR[ N0CHILDREN ] NEQ 0 THEN ! ANY SIBS LEFT IN THE FAKE NODE ?
BEGIN ! YES THEN
SIB _ .FAKENODEPTR[ N0FIRSTCHILD ]; ! DON'T LET THE USER
! DELETE THE NODE WE'RE WORKING
! ON!!!
LOOP4: DO
BEGIN
IF .SIB EQL .NODEPTR THEN
BEGIN
WARN( 24 );
DETACHNODE( .SIB );
ASKSIB( .SIB, .PARENT );
LEAVE LOOP4
END
END
WHILE ( SIB _ .SIB[ N0RSIB ] ) NEQ 0;
IF .FAKENODEPTR[ N0CHILDREN ] NEQ 0 THEN ! ANY SIBS LEFT IN THE FAKE NODE ?
BEGIN ! YES THEN
TYPE( '[THE FOLLOWING PREVIOUS SIBS WILL BE DELETED:?M?J]' ); ! INFORM THE USER THAT THEY WILL BE ZAPPED
SIB _ .FAKENODEPTR[ N0FIRSTCHILD ];
DO
BEGIN
DNAME( .SIB );
CRLF
END
WHILE ( SIB _ .SIB[ N0RSIB ] ) NEQ 0;
! THEN ASK IF HE REALLY WANTS THEM ZAPPED
ASKSTR( '[DO YOU WISH TO DELETE THEM OR BE ASKED ABOUT EACH INDIVIDUALLY]?R(ASK, DELETE?R)[: ??]',
PLIT( ASCII 'ASK', ASKEACH,
ASCII 'DELET', IGNORE,
0, ASKEACH ),
.FAKENODEPTR[ N0FIRSTCHILD ] );
SIB _ .FAKENODEPTR[ N0FIRSTCHILD ]; ! IF HE STILL DIDN'T WANT THEM KILL
TYPE( 'NODES DELETED:?M?J' );
WHILE .SIB NEQ 0 DO
BEGIN
NEXT _ .SIB[ N0RSIB ];
DETACHNODE( .SIB ); ! ATTACH NODE TO REAL PARENT
ATTACHNODE( .SIB, .PARENT, BEFORE, 0 ); ! SO WHEN KILLNODE TRYS TO TYPE THE NAME
! IT DOESN'T BARF
KILLNODES( .SIB );
SIB _ .NEXT
END
END
END;
SIB _ .PARENT[ N0FIRSTCHILD ]; ! NOW ASK ALL ABOUT THE NEW ONES
DO
IF .SIB[ N0TOBEDEFINED ] THEN ASKCHILD( .SIB )
WHILE ( SIB _ .SIB[ N0RSIB ] ) NEQ 0
END;
COMMENT;
! ROUTINE MNCHILDREN
! ======= ==========
! THIS ROUTINE ASKS THE QUESTIONS TO MODIFY A NODES CHLDREN
ROUTINE MNCHILDREN( NODEPTR ) =
BEGIN
OWN PARENT;
%LOCAL% ROUTINE GETCHILDNAME =
BEGIN
LABEL LOOP;
REPEAT
BEGIN
LOOP: REPEAT
BEGIN
IF EOL( ACHAR ) THEN
BEGIN
ASKLINE( '[?I?I?I??]' );
IF EOL( ACHAR ) THEN RETURN TRUE
END;
! IN EITHER CASE !
ZEROARGLIST;
GETNAME( ALINE, ACHAR );
IF NOT ( .ACHAR EQL "," OR EOL( ACHAR ) ) THEN LEAVE LOOP WITH ERROR( 31 );
IF .ACHAR EQL "," THEN ADV( ABUFF, ABPTR, ACOUNT, ACHAR ); ! SKIP THE COMMA
IF .ARGTYPE NEQ 0
OR
.SUB1 NEQ 0
OR
.SUB2 NEQ 0
OR
.SUB3 NEQ 0 THEN LEAVE LOOP WITH ERROR( 97 );
IF .PRIM EQL 0 THEN LEAVE LOOP WITH ERROR( 32 );
RETURN FALSE;
END;
ACHAR _ CRCHAR;
WARN( 0 )
END
END;
%LOCAL% ROUTINE ASKEACH( CHILD ) =
BEGIN
REGISTER NEXT;
MAP FORMAT CHILD;
DO
BEGIN
NEXT _ .CHILD[ N0RSIB ];
TYPE( '[DO YOU WISH TO KEEP CHILD:]' );
DNAME( .CHILD );
IF ( ASKYESORNO( ' ?R(YES, NO?R)[: ??]', YES ) ) THEN
BEGIN
DETACHNODE( .CHILD );
ASKSIBS( .CHILD, .PARENT )
END
END
WHILE ( CHILD _ .NEXT ) NEQ 0
END;
REGISTER
CHILD,
FAKENODEPTR,
NEXT;
LOCAL FAKENODE[ N0SIZE ];
LABEL LOOP,
LOOP2,
LOOP3;
MAP FORMAT NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT FAKENODEPTR;
MAP FORMAT CHILD;
! BEGIN !
IF .SHOW THEN DNCHILDREN( .NODEPTR ); ! SHOW THE CHILDREN TO THE USER IF HE WANTS THEM
PARENT _ .NODEPTR;
LOOP: REPEAT
BEGIN
IF ASKLINE( '[NEW CHILDREN]?R(, "<NONE>", <NAME>?R)[: ??]' ) THEN RETURN;
! ELSE !
IF MATCHALINE( NONE ) THEN ! IF <NONE> THEN DELETE ALL CHILDREN
BEGIN
IF CONFIRMED() THEN
BEGIN
CHILD _ .PARENT[ N0FIRSTCHILD ];
TYPE( 'NODES DELETED:?M?J' );
DO
BEGIN
NEXT _ .CHILD[ N0RSIB ];
KILLNODES( .CHILD );
END
WHILE ( CHILD _ .NEXT );
RETURN
END
END
ELSE LEAVE LOOP;
WARN( 0 )
END;
! ELSE !
! DETACH ALL CHILDREN !
FAKENODEPTR _ FAKENODE<0,0>;
FAKENODEPTR[ N0CHILDREN ] _ .PARENT[ N0CHILDREN ];
MOVE( PARENT[ N0NAME ], FAKENODEPTR[ N0NAME ], N0NAMELEN ); ! GIVE THE FAKE NODE CHARACTERISTICS OF THE REAL
FAKENODEPTR[ N0PARENT ] _ .PARENT[ N0PARENT ]; ! PARENT FOR KILLNODE TO TYPE NAME
CHILD _ .PARENT[ N0FIRSTCHILD ];
WHILE .CHILD NEQ 0 DO ! CHANGE THE PARENT OF EACH CHILD TO FAKENODE
BEGIN
CHILD[ N0PARENT ] _ .FAKENODEPTR;
CHILD _ .CHILD[ N0RSIB ]
END;
PARENT[ N0CHILDREN ] _ 0;
LOOP2: REPEAT
BEGIN
IF GETCHILDNAME() THEN LEAVE LOOP2;
! ELSE !
IF SIBSAMENAME( .PARENT, PRIM ) THEN ! IF CHILD OF THE SAME NAME THEN ERROR
BEGIN
ERROR( 96 );
WARN( 0 )
END
ELSE ! OTHERWIISE
BEGIN
CHILD _ .FAKENODEPTR[ N0FIRSTCHILD ]; ! SEE IF THE CHILD GIVEN IS AN OLD ONE
LOOP3: WHILE .CHILD NEQ 0 DO
BEGIN
IF COMPARE( CHILD[ N0NAME ], PRIM, N0NAMELEN ) THEN LEAVE LOOP3;
CHILD _ .CHILD[ N0RSIB ]
END;
IF .CHILD NEQ 0 THEN ! IF WE HAVE AN OLD ONE THEN
BEGIN
DETACHNODE( .CHILD ) ! DETACH IT FROM THE FAKE NODE
END
ELSE
BEGIN
CHILD _ CREATENODE( PRIM ) ! OTHERWISE MAKE A NEW ONE
END;
ATTACHNODE( .CHILD, .PARENT, AFTER, 0 ) ! ATTACH THE CHILD TO THE END OF THE LINE
END
END;
IF .FAKENODEPTR[ N0CHILDREN ] NEQ 0 THEN ! ANY CHILDREN LEFT IN THE FAKE NODE ?
BEGIN ! YES THEN
TYPE( '[THE FOLLOWING PREVIOUS CHILDREN WILL BE DELETED:?M?J]' ); ! INFORM THE USER THAT THEY WILL BE ZAPPED
CHILD _ .FAKENODEPTR[ N0FIRSTCHILD ];
DO
BEGIN
DNAME( .CHILD );
CRLF
END
WHILE ( CHILD _ .CHILD[ N0RSIB ] ) NEQ 0;
! THEN ASK IF HE REALLY WANTS THEM ZAPPED
ASKSTR( '[DO YOU WISH TO DELETE THEM OR BE ASKED ABOUT EACH INDIVIDUALLY]?R(ASK, DELETE?R)[: ??]',
PLIT( ASCII 'ASK', ASKEACH,
ASCII 'DELET', IGNORE ),
.FAKENODEPTR[ N0FIRSTCHILD ] );
CHILD _ .FAKENODEPTR[ N0FIRSTCHILD ]; ! IF HE STILL DIDN'T WANT THEM KILL
TYPE( 'NODES DELETED:?M?J' );
WHILE .CHILD NEQ 0 DO
BEGIN
NEXT _ .CHILD[ N0RSIB ];
DETACHNODE( .CHILD ); ! ATTACH NODE TO REAL PARENT
ATTACHNODE( .CHILD, .PARENT, BEFORE, 0 ); ! SO WHEN KILLNODE TRYS TO TYPE THE NAME
! IT DOESN'T BARF
KILLNODES( .CHILD );
CHILD _ .NEXT
END;
END;
CHILD _ .NODEPTR[ N0FIRSTCHILD ]; ! NOW ASK ALL ABOUT THE NEW ONES
DO
IF .CHILD[ N0TOBEDEFINED ] THEN ASKCHILD( .CHILD )
WHILE ( CHILD _ .CHILD[ N0RSIB ] ) NEQ 0
END;
COMMENT;
! ROUTINE MNMPP
! ======= =====
! THIS ROUTINE ASKS THE QUESTIONS NECESSARY TO MODIFY THE MPP ATTACHED
! TO THIS NODE
ROUTINE MNMPP( NODEPTR ) =
BEGIN
OWN NEWMPP,
MPPPTR;
REGISTER CHILD,
MPP1,
MPP2;
MAP FORMAT NODEPTR;
MAP FORMAT MPPPTR;
MAP FORMAT CHILD;
IF .SHOW THEN DNMPP( .NODEPTR );
MPP1 _ MPPUP( .NODEPTR[ N0PARENT ] ); ! ANY MPPS STARTED ABOVE THIS?
MPP2 _ 0;
CHILD _ .NODEPTR[ N0FIRSTCHILD ];
WHILE .CHILD NEQ 0 DO ! OR BELOW ?
BEGIN
MPPPTR _ MPPDOWN( .CHILD );
IF .MPP1 EQL 0 THEN MPP1 _ .MPPPTR
ELSE IF ( .MPP2 EQL 0 ) AND ( .MPPPTR NEQ .MPP1 ) THEN MPP2 _ .MPPPTR;
CHILD _ .CHILD[ N0RSIB ]
END;
IF .MPP2 NEQ 0 THEN
BEGIN
WARN( 18 );
RETURN FALSE
END;
MPPPTR _ .MPP1;
NEWMPP _ ASKYESORNO( 'DO YOU WISH AN [MPP TO START NOW]?R(, YES, NO?R)[: ??', -1 );
IF .NEWMPP EQL -1 THEN RETURN FALSE; ! NO CHANGE
IF .NEWMPP EQL NO THEN
BEGIN
UNATTACH( MPPPTR[ M0LISTPTRS ], .NODEPTR, N0MPPOFFSETT );
NODEPTR[ N0MPPPTR ] _ 0;
RETURN FALSE
END;
IF .MPPPTR NEQ 0 THEN
BEGIN
ATTACH( MPPPTR[ M0LISTPTRS ], .NODEPTR, N0MPPOFFSETT );
NODEPTR[ N0MPPPTR ] _ .MPPPTR
END
ELSE
BEGIN
IF ( MPPPTR _ MAKUMPP( .NODEPTR, PAZ '[NEW MPP] TO START?R(,<NAME>?R)[: ??]' ) ) NEQ 0 THEN
BEGIN
NODEPTR[ N0MPPPTR ] _ .MPPPTR;
ASKTHRESH( .NODEPTR );
RETURN TRUE
END
END;
FALSE
END;
COMMENT;
! ROUTINE MNTHRESH
! ======= ========
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE STARTING CRITERION ON A
! NODE
ROUTINE MNTHRESH( NODEPTR ) =
BEGIN
OWN NEWTHRESH;
MAP FORMAT NODEPTR;
IF .NODEPTR[ N0MPPPTR ] EQL 0 THEN RETURN(ERROR(131));
IF .SHOW THEN DNTHRESH( .NODEPTR );
NEWTHRESH _ ASKDNUM( '[NEW STARTING CRITERION]?R(, <DECIMAL NUMBER>?R)[: ??]',
DEFAULTOK,
-1,
1,
BIGNUMBER );
IF .NEWTHRESH GEQ 0 THEN NODEPTR[ N0THRESH ] _ .NEWTHRESH
END;
COMMENT;
! ROUTINE MLQUOTA
! ======= =======
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE IN CORE QUOTA ON A LEAF
! ====
ROUTINE MLQUOTA( LEAFPTR ) =
BEGIN
OWN NEWQUOTA;
MAP FORMAT LEAFPTR;
IF .LEAFPTR[ N0CHILDREN ] NEQ 0 THEN
BEGIN
ERROR( 101 ); ! COMPLAIN THAT THIS ISN'T A LEAF
RETURN
END;
! ELSE !
IF .SHOW THEN DLQUOTA( .LEAFPTR ); !OTHERWISE SHOW CURRENT STATUS
NEWQUOTA _ ASKDNUM( '[NEW QUOTA]?R(, <DECIMAL NUMBER>?R)[: ??]',
DEFAULTOK,
-1,
0,
BIGNUMBER );
IF .NEWQUOTA GEQ 0 THEN LEAFPTR[ N0QUOTA ] _ .NEWQUOTA
END;
COMMENT;
! ROUTINE MLISTAT
! ======= =======
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE INITIAL INPUT STATUS ON A LEAF
! ====
ROUTINE MLISTAT( LEAFPTR ) =
BEGIN
OWN NEWISTAT;
MAP FORMAT LEAFPTR;
IF .LEAFPTR[ N0CHILDREN ] NEQ 0 THEN
BEGIN
ERROR( 101 ); ! COMPLAIN THAT THIS ISN'T A LEAF
RETURN
END;
! ELSE !
IF .SHOW THEN DLISTAT( .LEAFPTR ); !OTHERWISE SHOW CURRENT STATUS
NEWISTAT _ ASKSTAT( PAZ '[NEW INITIAL INPUT STATUS]?R(, ENABLED, DISABLED?R)[: ??]', -1 );
IF .NEWISTAT GEQ 0 THEN LEAFPTR[ N0STATUS ] _ .NEWISTAT
END;
FORWARD ZAPTRCODE;
COMMENT;
! ROUTINE MLTRCODE
! ======= ========
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE TRCODE ON A LEAF
! ====
ROUTINE MLTRCODE( LEAFPTR ) =
BEGIN
OWN NEWTRCODE;
LABEL LOOP;
MAP FORMAT NEWTRCODE;
MAP FORMAT LEAFPTR;
IF .LEAFPTR[ N0CHILDREN ] NEQ 0 THEN
BEGIN
ERROR( 101 ); ! COMPLAIN THAT THIS ISN'T A LEAF
RETURN
END;
! ELSE !
IF .SHOW THEN DLTRCODE( .LEAFPTR );
NEWTRCODE _ GMEM( .TRCSIZE );
NEWTRCODE[ TR0SIZE ] _ .TRCSIZE;
NEWTRCODE[ TR0CHAR ] _ .TRCLEN;
LOOP: REPEAT
BEGIN
IF ASKBITS( '[NEW TR]ANSACTION [CODE]?R(, <STRING>?R)[: ??]',
NEWTRCODE[ TR0CODE],
.TRCLEN ) EQL CRONLY THEN RETURN ZAPTRCODE( .NEWTRCODE )
ELSE
BEGIN
IF NOT TRCODESAME( .LEAFPTR, NEWTRCODE[ TR0CODE ] ) THEN
BEGIN
ZAPTRCODE( .LEAFPTR[ N0TRCODE ] );
LEAFPTR[ N0TRCODE ] _ .NEWTRCODE;
RETURN
END
END;
WARN( 0 )
END
END;
COMMENT;
! ROUTINE ZAPTRCODE
! ======= =========
! THIS ROUTINE DELETES A TRCODE ENTRY
GLOBAL ROUTINE ZAPTRCODE( TRCODEPTR ) =
BEGIN
MAP FORMAT TRCODEPTR;
PMEM( .TRCODEPTR, .TRCODEPTR[ TR0SIZE ] )
END;
COMMENT;
! ROUTINE MLONAME
! ======= =======
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE NAME FOR OUTPUT OF A LEAF
! ====
ROUTINE MLONAME( LEAFPTR ) =
BEGIN
OWN NEWNAME;
MAP FORMAT LEAFPTR;
IF .LEAFPTR[ N0CHILDREN ] NEQ 0 THEN
BEGIN
ERROR( 101 ); ! COMPLAIN THAT THIS ISN'T A LEAF
RETURN
END;
IF .SHOW THEN DLONAME( .LEAFPTR );
NEWNAME _ ASKYESORNO( 'IS THIS LEAF TO BE USED FOR OUTPUT NOW?R(, YES, NO?R)[: ??]', -1 );
IF .NEWNAME GEQ 0 THEN LEAFPTR[ N0OPFLAG ] _ .NEWNAME;
IF NOT .LEAFPTR[ N0OPFLAG ] THEN
BEGIN
ZERO( LEAFPTR[ N0OPNAME ], LEAFPTR[ N0OPNAME ] + N0NAMELEN );
RETURN
END;
ASKLINE( '[NEW NAME FOR OUTPUT]?R(, "<LEAF NAME>", <NAME>?R)[: ??]' );
IF EOL( ACHAR ) THEN RETURN; ! NO CHANGE
IF MATCHALINE( ( PAZ '<LEAF NAME>')<36,7> ) THEN NEWNAME _ LEAFPTR[ N0NAME ]
ELSE NEWNAME _ ABUFF;
MOVE( %FROM% .NEWNAME, %TO% LEAFPTR[ N0OPNAME ], N0NAMELEN )
END;
COMMENT;
! ROUTINE MLOSTAT
! ======= =======
! THIS ROUTINE ALLOWS THE USER TO CHANGE THE INITIAL OUTPUT STATUS ON A LEAF
! ====
ROUTINE MLOSTAT( LEAFPTR ) =
BEGIN
OWN NEWOSTAT;
MAP FORMAT LEAFPTR;
IF .LEAFPTR[ N0OPNAME ] EQL 0 THEN RETURN; ! IF NO OPNAME THEN NO OPSTATUS
IF .LEAFPTR[ N0CHILDREN ] NEQ 0 THEN
BEGIN
ERROR( 101 ); ! COMPLAIN THAT THIS ISN'T A LEAF
RETURN
END;
! ELSE !
IF .SHOW THEN DLOSTAT( .LEAFPTR ); !OTHERWISE SHOW CURRENT STATUS
NEWOSTAT _ ASKSTAT( PAZ '[NEW INITIAL OUTPUT STATUS]?R(, ENABLED, DISABLED?R)[: ??]', -1 );
IF .NEWOSTAT GEQ 0 THEN LEAFPTR[ N0OPSTATUS ] _ .NEWOSTAT
END;
COMMENT;
! ROUTINE MLCHKPNT
! ======= ========
! THIS ROUTINE MODIFIES THE VALUE OF THE CHECKPOINT-TRANSACTIONS-TO-THIS-LEAF FLAG
ROUTINE MLCHKPNT( LEAFPTR ) =
BEGIN
MAP FORMAT LEAFPTR;
LOCAL NEWCHKPNT;
IF .LEAFPTR[N0CHILDREN] NEQ 0 THEN RETURN(ERROR(101)); %NOT A LEAF%
IF .SHOW THEN DLCHKPNT( .LEAFPTR );
NEWCHKPNT _ ASKYESORNO('[ARE TRANSACTIONS TO THIS LEAF TO BE CHECKPOINTED NOW ?R(,YES,NO?R): ]',-1);
IF NEWCHKPNT GEQ 0 THEN LEAFPTR[N0CHKPNT] _ NEWCHKPNT
END;
FORWARD DELNODE(1),KILLNODES();
! ROUTINE DELENODE
! ======= ===========
! THIS ROUTINE HANDLES THE INDIVIDUAL CASES OF DELETE NODE:...
! CASE 1: IF AN INDIVIDUAL NODE IS REQUESTED ( BY NAME ), DELNODE IS
! CALLED WITH THE ADDRESS OF THE NODE TABLE ENTRY
! CASE 2: IF /ALL WAS SPECIFIED, DELNODE IS CALLED FOR EACH ENTRY IN
! NODE TABLE
! CASE 3: IF NO NAME OR SWITCH WAS GIVEN, THE USER IS ASKED FOR THE
! NAMES OF THE NODES TO BE DELETED
GLOBAL ROUTINE DELENODE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP ROOTFORMAT ROOT;
MAP FORMAT NODEPTR;
IF .ROOT[ N0CHILDREN ] EQL 0 THEN RETURN ERROR( 38 );
IF NULLNODENAME(.NODENAME) AND NOT .ALLSWITCH THEN
BEGIN ! ASK THE USER FOR NODE NAMES
REPEAT ! UNTIL HE INPUTS A <CR> BY
BEGIN ! ITSELF
IF INNODE( PAZ '[NODENAME]?R(<done>,<NAME>?R)[: ??') EQL 0 THEN
IF NOT .ERRORFLG THEN RETURN
ELSE
BEGIN
ERRORFLG _ 0;
ERROR( 88 ); ! TELL THE USER AND ASK AGAIN
WARN( 0 )
END
ELSE IF (NODEPTR _ GETNODEPTR(PRIM)) EQL 0 THEN
RETURN(ERROR(33))
ELSE DELNODE(.NODEPTR);
CRLF
END
END;
IF .DELTYPEFLAG THEN TYPE( 'NODES DELETED:[?M?J]' );
IF .ALLSWITCH THEN
BEGIN
IF NOT(CONFIRMED()) THEN RETURN;
KILLNODES( ROOT<0,0> );
RETURN
END;
IF (NODEPTR _ GETNODEPTR(.NODENAME)) EQL 0 THEN RETURN(ERROR(33))
ELSE DELNODE(.NODEPTR);
END;
COMMENT;
! ROUTINE KILLNODES
! ======= ===========
! THIS ROUTINE DELETES ALL NODES UNDER ( & INCLUDING ) THE NODE SPECIFIED
! TREE SEARCH KILL --- KILL LOWEST LEVELS ( LEAVES ) FIRST
! UNATTACH MPPLINKS
! PMEM( NODEPTR, N0SIZE ) ******* IF (WHEN) ROOT DON'T KILL ******
GLOBAL ROUTINE KILLNODES( NODEPTR ) =
BEGIN
%LOCAL% ROUTINE KILLER( NODE ) =
BEGIN
REGISTER
MPPADDR,
SIB;
MAP FORMAT NODE;
MAP FORMAT MPPADDR;
IF .NODE[N0CHILDREN] NEQ 0 THEN
BEGIN
KILLER( .NODE[N0FIRSTCHILD] );
NODE[N0CHILDREN] _ 0;
END;
MPPADDR _ .NODE[N0MPPPTR];
IF .MPPADDR NEQ 0 THEN UNATTACH( %FROM% MPPADDR[M0LISTPTRS], .NODE, N0MPPOFFSETT );
SIB _ .NODE[N0RSIB];
IF .MSGLEVEL EQL 0 THEN
BEGIN
DFULL( .NODE );
TYPECRLF
END;
ZAPTRCODE( .NODE[ N0TRCODE ] ); ! FREE UP THE TRCODE'S STORE
PMEM( .NODE, N0SIZE );
IF .SIB NEQ 0 THEN KILLER( .SIB )
END;
REGISTER
SIB,
PARENT;
MAP FORMAT NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT SIB;
IF .NODEPTR NEQ ROOT<0,0> THEN
BEGIN
DETACHNODE( .NODEPTR )
END
ELSE
BEGIN
PARENT _ .NODEPTR;
NODEPTR _ .NODEPTR[ N0FIRSTCHILD ];
PARENT[ N0CHILDREN ] _ 0
END;
IF .NODEPTR EQL 0 THEN RETURN; ! NOTHING TO KILL
KILLER( .NODEPTR )
END;
COMMENT;
! ROUTINE DELNODE
! ======= =======
! THIS ROUTINE DELETES THE NODE SPECIFIED FROM THE NODE TABLE
! RETURNS THE ADDRESS OF THE NEXT NODE IN THE NODE TABLE
ROUTINE DELNODE(NODEPTR)=
BEGIN
REGISTER
OLDMSGLEVEL,
MPPADDR;
OWN
PARENT,
LSIB,
RSIB,
LASTCHILD,
FIRSTCHILD,
NODE;
MAP FORMAT NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT LSIB;
MAP FORMAT RSIB;
MAP FORMAT LASTCHILD;
MAP FORMAT FIRSTCHILD;
MAP FORMAT NODE;
MAP FORMAT MPPADDR;
IF .NODEPTR EQL ROOT<0,0> THEN RETURN ERROR( 102 ); ! CAN'T KILL THE ROOT
IF .MSGLEVEL EQL 0 THEN
BEGIN
DFULL( .NODEPTR );
TYPECRLF;
END;
PARENT _ .NODEPTR[N0PARENT];
LSIB _ .NODEPTR[N0LSIB];
RSIB _ .NODEPTR[N0RSIB];
IF .NODEPTR[N0CHILDREN] NEQ 0 THEN
BEGIN
NODE _ FIRSTCHILD _ .NODEPTR[N0FIRSTCHILD];
WHILE .NODE NEQ 0 DO
BEGIN
NODE[N0PARENT] _ .PARENT;
NODE _ .NODE[N0RSIB]
END;
LASTCHILD _ .NODEPTR[N0LASTCHILD];
IF .LSIB NEQ 0 THEN
LSIB[N0RSIB] _ .FIRSTCHILD
ELSE
PARENT[N0FIRSTCHILD] _ .FIRSTCHILD;
IF .RSIB NEQ 0 THEN
RSIB[N0LSIB] _ .LASTCHILD
ELSE
PARENT[N0LASTCHILD] _ .LASTCHILD;
FIRSTCHILD[N0LSIB] _ .LSIB;
LASTCHILD[N0RSIB] _ .RSIB
END
ELSE
BEGIN
IF .LSIB EQL 0 THEN PARENT[N0FIRSTCHILD] _ .RSIB
ELSE LSIB[N0RSIB] _ .RSIB;
IF .RSIB EQL 0 THEN PARENT[N0LASTCHILD] _ .LSIB
ELSE RSIB[N0LSIB] _ .LSIB
END;
MPPADDR _ .NODEPTR[N0MPPPTR];
IF .MPPADDR NEQ 0 THEN UNATTACH( %FROM% MPPADDR[M0LISTPTRS], .NODEPTR, N0MPPOFFSETT );
IF .MPPADDR[ M0LISTPTRS ] EQL 0 AND .MPPADDR[ M0TOBEDEFINED ] THEN ! QUIETLY DELETE MPP IF NOT REFERENCE
BEGIN
OLDMSGLEVEL _ .MSGLEVEL;
MSGLEVEL _ 1; ! SHORT OUTPUT
DELMPP( .MPPADDR );
MSGLEVEL _ .OLDMSGLEVEL
END;
ZAPTRCODE( .NODEPTR[ N0TRCODE ] ); ! FREE UP THE TRCODE'S STORE
PMEM(.NODEPTR,N0SIZE)
END;
COMMENT;
! ROUTINE NUMNODES
! ======= ========
! THIS ROUTINE NUMBERS THE NODES
GLOBAL ROUTINE NUMNODES =
BEGIN
OWN
II[4];
MAP ROOTFORMAT ROOT;
%LOCAL% ROUTINE NUMALLNODES(ARG, LVL)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
MACRO
NAME = NODEPTR[N0NAME]$,
NEXTTHIS = NODEPTR[N0RSIB]$,
NEXTLEVEL = NODEPTR[N0FIRSTCHILD]$,
LEAF = (.NEXTLEVEL EQL 0)$;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
NODEPTR[N0NO] _ II[.LVL] _ .II[.LVL] + 1;
IF LEAF THEN NODEPTR[N0LEAFNO] _ LL _ .LL + 1
ELSE NUMALLNODES(.NEXTLEVEL, .LVL + 1);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
LL _ II[0] _ II[1] _ II[2] _ II[3] _ -1;
NUMALLNODES( .ROOT[N0FIRSTCHILD] , 1 )
END;
FORWARD WCNNAME(1), WNLVLNO, WCNOTHER;
COMMENT;
! ROUTINE WCNODE
! ======= ======
! THIS ROUTINE WRITES THE NODE SECTION OF THE COMPILE FILE
GLOBAL ROUTINE WCNODE=
BEGIN
REGISTER
NODEPTR;
OWN COUNT;
LABEL
SEL1,
SEL2,
SEL3,
SEL4;
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
MACRO
NAME = NODEPTR[N0NAME]$,
NEXTTHIS = NODEPTR[N0RSIB]$,
NEXTLEVEL = NODEPTR[N0FIRSTCHILD]$,
LEAF = (.NEXTLEVEL EQL 0)$;
%LOCAL% ROUTINE WNODE( NODEPTR, LVL ) =
BEGIN
MAP FORMAT NODEPTR;
IF LEAF THEN ! IF LEAF THEN OUTPUT "Lnnnnn:
BEGIN
OUTPUTC( "L" );
OUTPUTD( .NODEPTR[N0LEAFNO] );
OUTPUT( ':?M?J' )
END;
WNLVLNO( .LVL, .NODEPTR[N0NO] ); ! OUTPUT level.nnn:
OUTPUT( ': ' );
IF LEAF THEN OUTPUT( 'LEAF(' ) ELSE OUTPUT( 'NODE(' ); ! OUTPUT type(
WCNNAME( .NODEPTR ); ! OUTPUT name,
OUTPUTCOMMA;
IF .NODEPTR[N0PARENT] EQL ROOT<0,0> THEN OUTPUTC( "0" )
ELSE WCNOTHER( .LVL - 1, .NODEPTR[N0PARENT] ); ! OUTPUT parent,
OUTPUTCOMMA;
IF .NODEPTR[N0MPPPTR] EQL 0 THEN OUTPUT( '-1,-1' )
ELSE
BEGIN
WCMPPNUMBER( .NODEPTR[N0MPPPTR] ); ! OUTPUT mpp,
OUTPUTCOMMA;
OUTPUTD( .NODEPTR[N0THRESH] ) ! OUTPUT threshold,
END;
OUTPUTCOMMA;
IF LEAF THEN OUTPUTC( "0" )
ELSE WCNOTHER( .LVL + 1, .NODEPTR[N0FIRSTCHILD] ); ! OUTPUT firstchild,
OUTPUTCOMMA;
IF .NODEPTR[N0RSIB] EQL 0 THEN
IF .LVL EQL 1 THEN OUTPUT( 'ERLEAF' ) ELSE OUTPUTC( "0" )
ELSE WCNOTHER( .LVL, .NODEPTR[N0RSIB] ); ! OUTPUT next sib,
OUTPUTCOMMA;
OUTPUTD( .LVL - 1 ); ! OUTPUT level
IF LEAF THEN ! IF LEAF THEN
BEGIN
OUTPUTCOMMA; ! OUTPUT ","
OUTPUTD( .NODEPTR[N0QUOTA] ); ! OUTPUT leaf quota,
OUTPUTCOMMA;
IF .NODEPTR[N0STATUS]THEN OUTPUT( 'ENABLED,' ) ELSE OUTPUT( 'DISABLED,' ); ! OUTPUT status)
IF NOT .NODEPTR[N0CHKPNT] THEN OUTPUT('NO');
OUTPUT('CHKPNT');
END;
OUTPUT( ')?M?J?M?J' ); ! END THE MACRO CALL
END;
%LOCAL% ROUTINE WALLNODES( ARG, LVL )=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
WNODE( .NODEPTR, .LVL );
IF NOT LEAF THEN WALLNODES(.NEXTLEVEL, .LVL + 1 );
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
%LOCAL% ROUTINE OUTPUTTRCODE( TRCODEPTR ) =
BEGIN
MAP FORMAT TRCODEPTR;
REGISTER FILL;
OUTPUT( ' GETSTR(<<' );
OUTPUTSTR( TRCODEPTR[ TR0CODE ], IF .TRCODEPTR[ TR0CHAR ] LEQ .TRCLEN THEN .TRCODEPTR[ TR0CHAR ] ELSE .TRCLEN );
IF ( FILL _ .TRCODEPTR[ TR0CHAR ] - .TRCLEN ) GTR 0 THEN
DECR I FROM .FILL - 1 TO 0 DO
OUTPUT( ',^O0' );
OUTPUT( '>>, TRCSIZ, TRANSACTION CODE)?M?J' )
END;
%LOCAL% ROUTINE WTRCODE( ARG )=
BEGIN
REGISTER
TRCODE,
NODEPTR;
MAP FORMAT NODEPTR;
MAP FORMAT TRCODE;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
IF LEAF THEN
BEGIN
OUTPUTTRCODE( .NODEPTR[ N0TRCODE ] )
END
ELSE WTRCODE( .NEXTLEVEL );
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
%LOCAL% ROUTINE WLEAFNO( ARG )=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
IF LEAF THEN
BEGIN
OUTPUT( ' EXP L' );
OUTPUTD( .NODEPTR[N0LEAFNO] );
OUTPUTCRLF
END
ELSE WLEAFNO( .NEXTLEVEL );
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
%LOCAL% ROUTINE WLFTAB( ARG )=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
IF ( LEAF ) AND ( .NODEPTR[N0OPFLAG] ) THEN
BEGIN
OUTPUT( '?I%LFTAB(' );
XOUTPUT( NODEPTR[N0OPNAME] );
OUTPUT( ', L' );
OUTPUTD( .NODEPTR[N0LEAFNO] );
OUTPUTCOMMA;
IF .NODEPTR[N0OPSTATUS] THEN OUTPUT( 'ENABLED' ) ELSE OUTPUT( 'DISABLED' );
OUTPUT( ')?M?J' )
END;
IF NOT LEAF THEN WLFTAB( .NEXTLEVEL );
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
! OUTPUT MACROS
OUTPUT( '?L SUBTTL TREE?M?J' );
OUTPUT( 'IF1, <LFCNT==0>?M?J' );
OUTPUT( ' LEAFNO=-1?M?J' );
OUTPUTCRLF;
OUTPUT( 'TREE:: .+1 ; NEXT WORD MUST BE # OF LEAVES?M?J');
OUTPUT(' EXP LFCNT ;NUMBER OF LEAVES IN THE TREE?M?J');
OUTPUT( ' ; FIRST NODE OF THE TREE?M?J?M?J?M?J' );
WALLNODES( .ROOT[N0FIRSTCHILD], 1 );
OUTPUT( ' LFCNT=LEAFNO+1 ; DON''T COUNT THE ERROR LEAF?M?J' );
OUTPUT( ' ; OR THE OTHER LOCAL MPP LEAVES?M?J' );
OUTPUTCRLF;
COUNT _ .LL + 5;
OUTPUT('ERLEAF:: LEAF(,0,M.ERR,1,0,SONLEAF,0,-1,ENABLED)?M?J?IERRLN==LEAFNO?M?J?M?J' );
OUTPUT( 'SONLEAF:: LEAF(,0,M.SON,1,0,SOFFLEAF,0,-1,ENABLED)?M?J?ISONLN==LEAFNO?M?J?M?J' );
OUTPUT( 'SOFFLEAF:: LEAF(,0,M.SOFF,1,0,DCRLEAF,0,-1,ENABLED)?M?J?ISOFFLN==LEAFNO?M?J?M?J' );
OUTPUT( 'DCRLEAF:: LEAF(,0,M.RDMC,1,0,DMRLEAF,0,-1,ENABLED)?M?J?IDCRLN==LEAFNO?M?J?M?J' );
OUTPUT( 'DMRLEAF:: LEAF(,0,M.RDM,1,0,0,0,-1,ENABLED)?M?J?IDMRLN==LEAFNO?M?J?M?J');
OUTPUT( 'ALLEAVES=LEAFNO?M?J' );
OUTPUTCRLF;
OUTPUT( 'LEAFDSKADDR:: BLOCK ALLEAVES+1?M?J' );
OUTPUTCRLF;
OUTPUT( 'LFPTRTAB::?M?J' );
WLEAFNO( .ROOT[N0FIRSTCHILD] );
OUTPUT( ' EXP ERLEAF?M?J' );
OUTPUT( ' EXP SONLEAF?M?J' );
OUTPUT( ' EXP SOFFLEAF?M?J' );
OUTPUT( ' EXP DCRLEAF?M?J' );
OUTPUT( ' EXP DMRLEAF?M?J' );
! MAKE TRCODE TABLE
OUTPUT( '?L?ISUBTTL TRCODE & LFADDR TABLES?M?J?M?J' );
OUTPUT( ';TRCODE TABLE::?M?J?I' );
OUTPUTD( .COUNT );
OUTPUT( '?M?JTRCODE::?M?J' );
WTRCODE( .ROOT[N0FIRSTCHILD] );
OUTPUTTRCODE( .SON );
OUTPUTTRCODE( .SOFF );
OUTPUTTRCODE( .RDM );
OUTPUTTRCODE( .RDMC );
OUTPUTCRLF;
OUTPUTCRLF;
OUTPUT( ';LFADDR TABLE?M?J?I' );
OUTPUTD( .COUNT );
OUTPUT( '?M?JLFADDR::?M?J' );
WLEAFNO( .ROOT[N0FIRSTCHILD] );
OUTPUT( ' EXP SONLEAF?M?J' );
OUTPUT( ' EXP SOFFLEAF?M?J' );
OUTPUT( ' EXP DMRLEAF?M?J' );
OUTPUT( ' EXP DCRLEAF?M?J' );
! MAKE LFTAB
OUTPUT( '?L?ISUBTTL LEAF TABLE?M?J?M?J?M?JLFTAB::EXP .?M?J' );
WLFTAB( .ROOT[N0FIRSTCHILD] );
OUTPUT( '?M?J?I%LFTAB() ; THIS MUST BE THE LAST ENTRY IN LFTAB' );
OUTPUTCRLF;
END;
COMMENT;
! ROUTINE WCNNAME
! ======= ========
! THIS ROUTINE WRITES THE NODE NAME TO THE COMPILE FILE
ROUTINE WCNNAME(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
XOUTPUT(NODEPTR[N0NAME])
END;
ROUTINE WNLVLNO( LVL, NO ) =
BEGIN
CASE .LVL - 1 OF
SET
%0% OUTPUT( 'P.' );
%1% OUTPUT( 'S1.' );
%2% OUTPUT( 'S2.' );
%3% OUTPUT( 'S3.' );
TES;
OUTPUTD( .NO )
END;
ROUTINE WCNOTHER( LVL, NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
BIND ENDOFMGNND=1;
WNLVLNO( .LVL, .NODEPTR[N0NO] );
END;
! END OF MGNND.BLI