Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
mgntre.bli
There are no other files named mgntre.bli in the archive.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
! *** LAST MODIFIED BY ILG 1-JUL-76
MODULE TREE(SREG = #17, FREG = #16, VREG = #15,
MLIST,TIMER=EXTERNAL(SIX12),FSAVE)=
BEGIN
GLOBAL BIND TRE = 1;
REQUIRE MGNMAC.BLI;
REQ(MGNEXT);
REQ(MGNMC2);
EXTERNAL
MOVE,
LINK,
UNLINK,
COMPARE,
MAKUMPP,
DMNAME,
TRCLEN,
TRCSIZE,
TRCDL,
TRCDLC,
WCMPPNUMBER,
ERRLEAF,
SON,
SOFF,
RDM,
RDMC,
ASKSIB,
DELMPP;
OWN
MPPS;
GLOBAL
LL;
FORWARD
HASMPP,
ASKMPP,
ASKTHRESH,
ASKQUOTA,
ASKISTAT,
ASKTRCODE,
ASKOPDST,
ASKCHILDREN,
ASKCHILD,
TRCODESAME,
SIBSAMENAME,
MPPUP,
MPPDOWN;
REQ(MGNND);
GLOBAL ROUTINE DISPLEAF =
BEGIN
ERROR( 26 )
END;
GLOBAL ROUTINE MODILEAF =
BEGIN
ERROR( 26 )
END;
GLOBAL ROUTINE DELELEAF =
BEGIN
ERROR( 26 )
END;
GLOBAL ROUTINE MAKELEAF =
BEGIN
ERROR( 26 )
END;
GLOBAL ROUTINE MODITREE =
BEGIN
ERROR( 25 )
END;
COMMENT;
! ROUTINE TRCODESAME
! ======= ==========
! THIS ROUTINE CHECKS A GIVEN TRCODE AGAINST ALL THE PREVIOUSLY
! DEFINED ONES, ISSUES AN ERROR IF IT ALREADY EXISTS, AND RETURNS
! TRUE IF BAD, FALSE IF NO DUPLICATE
GLOBAL ROUTINE TRCODESAME( NODEPTR, TRCODEPTR ) =
BEGIN
OWN NODE,
VALUE,
TRCODE;
MAP ROOTFORMAT ROOT;
%LOCAL% ROUTINE TRCODEBAD =
BEGIN
REGISTER BP, DELM;
IF NOT .TRCDL THEN RETURN FALSE;
BP _ (.TRCODE)<ASCIIPTR>;
DELM _ .TRCDLC<29,7>;
DECR I FROM .TRCLEN - 1 TO 0 DO
IF SCANI( BP ) EQL .DELM THEN RETURN TRUE;
FALSE
END;
%LOCAL% ROUTINE COMTRCODE( ARG )=
BEGIN
MAP FORMAT ARG;
IF COMPARE( ARG[ TR0CODE ], .TRCODE, .TRCSIZE ) THEN
BEGIN
VALUE _ TRUE;
ERROR( 85 );
NOTE - IF THE TRCLEN HAS CHANGED THEN THE USER DESERVES WHAT HE GETS
END
END;
%LOCAL% ROUTINE CHECKTRCODE( ARG )=
BEGIN
MACRO
NAME = NODEPTR[N0NAME]$,
NEXTTHIS = NODEPTR[N0RSIB]$,
NEXTLEVEL = NODEPTR[N0FIRSTCHILD]$,
LEAF = (.NEXTLEVEL EQL 0)$;
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
LABEL B;
NODEPTR_.ARG;
B: REPEAT
BEGIN
IF LEAF THEN
BEGIN
IF .NODEPTR NEQ .NODE THEN COMTRCODE( .NODEPTR[ N0TRCODE ] );
END
ELSE CHECKTRCODE( .NEXTLEVEL );
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
VALUE _ FALSE;
NODE _ .NODEPTR;
TRCODE _ .TRCODEPTR;
IF TRCODEBAD() THEN
BEGIN
ERROR( 124 );
RETURN TRUE
END;
IF .ROOT[ N0FIRSTCHILD ] NEQ 0 THEN CHECKTRCODE( .ROOT[ N0FIRSTCHILD ]);
COMTRCODE(.SON);
COMTRCODE(.SOFF);
COMTRCODE( .RDM );
COMTRCODE( .RDMC );
.VALUE
END;
COMMENT;
! ROUTINE SIBSAMENAME
! ======= ===========
! THIS ROUTINE RETURNS TRUE IF ONE OF THE CHILDREN OF A NODE HAS THE
! SAME NAME AS THE NAME GIVEN
GLOBAL ROUTINE SIBSAMENAME( PARENT, NAME ) =
BEGIN
REGISTER
NODENAME,
NODEPTR;
MAP FORMAT PARENT;
MAP FORMAT NODEPTR;
NODEPTR _ .PARENT[ N0FIRSTCHILD ];
WHILE .NODEPTR NEQ 0 DO
BEGIN
NODENAME _ NODEPTR[ N0NAME ];
IF .NODENAME NEQ .NAME THEN IF COMPARE( .NODENAME, .NAME, N0NAMELEN ) THEN RETURN TRUE;
NODEPTR _ .NODEPTR[ N0RSIB ]
END;
FALSE
END;
FORWARD ACCEPTTREE(1), MAKTREE(1), REPTREE, ADDTOTREE;
COMMENT;
! ROUTINE MAKETREE
! ======= ========
! GIVEN THE ADDRESS OF A SUBTREENAME, THIS ROUTINE CAUSE THE APPROPRIATE
! QUESTIONS TO BE ASKED TO GENERATE A TREE ( IF A NULL NAME IS GIVEN )
! OR ONE SUBTREE
GLOBAL ROUTINE MAKETREE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
IF NULLNODENAME(.NODENAME) THEN ! IF NO TREE SPECIFIED
BEGIN
IF .ROOT[N0CHILDREN] NEQ 0 THEN
BEGIN
ERROR( 40 );
ASKSTR( '[DO YOU WISH TO REPLACE THE TREE, ADDTO IT, OR IGNORE THIS COMMAND]?R(IGNORE, REPLACE, ADDTO?R)[: ??]',
PLIT( ASCII 'REPLA', REPTREE,
ASCII 'ADDTO', ADDTOTREE,
ASCII 'IGNOR', IGNORE,
0, IGNORE ),
0 );
RETURN
END;
MAKTREE( ROOT<0,0> );
RETURN
END;
ACCEPTTREE(.NODENAME) ! IF A TREE WAS SPECIFIED, USE IT
END;
COMMENT;
! ROUTINE REPTREE
! ======= =======
! THIS ROUTINE DELTES THE CURRENT TREE AND MAKES A NEW ONE
ROUTINE REPTREE =
BEGIN
KILLNODES( ROOT<0,0> );
MAKTREE( ROOT<0,0> )
END;
COMMENT;
! ROUTINE ADDTOTREE
! ======= =========
! THIS ROUTINE ADDS A SUBTREE TO THE EXISTING TREE STRUCTURE
ROUTINE ADDTOTREE =
BEGIN
WHILE INNODE( PAZ 'WHAT [SUBTREE] TO ADD?R( <NODE-NAME> ?R)[: ??]' ) EQL 0 DO
BEGIN
ERROR( 72 );
WARN( 0 );
END;
ACCEPTTREE( PRIM )
END;
FORWARD MAKTREE(1);
COMMENT;
! ROUTINE ACCEPTTREE
! ======= ==========
! THIS ROUTINE CREATES A NODE IF ONE DOES NOT EXIST
! THEN CALLS MAKTREE TO ASK THE QUESTIONS TO FILL THE ENTRY AND MAKE A
! SUB TREE
ROUTINE ACCEPTTREE(NODENAME)=
BEGIN
REGISTER
PARENT,
NODEPTR;
LABEL LOOP;
MAP FORMAT NODEPTR;
PRINTNODENAME( .NODENAME );
! SEE IF ALREADY DEFINED
IF GETNODEPTR(.NODENAME) NEQ 0 THEN
RETURN ERROR( 27 ); ! NODE ALREADY EXISTS
NODEPTR _ CREATENODE( .NODENAME ); ! MAKE A NODE
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;
ASKSIBS( .NODEPTR, .PARENT );
MAKTREE(.NODEPTR)
END;
FORWARD ASKNODE, ASKMPP, ASKQUOTA, ASKISTAT, ASKTRCODE,
ASKOPDST, ASKOSTAT,ASKCHKPNT, INTREE;
COMMENT;
! ROUTINE MAKTREE
! ======= =======
! THIS ROUTINE ASKS THE QUESTIONS TO MAKE ONE (AND ONLY ONE) TREE
! AND RECORDS THE RESPONSES IN THE APPROPRIATE TREE TABLE ENTRY
ROUTINE MAKTREE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
%LOCAL% ROUTINE ASKALLNODES(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
ASKNODE(.NODEPTR);
IF NOT LEAF THEN ASKALLNODES(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
IF .TRCSIZE EQL 0 THEN ! MUST HAVE MISC GEN'D FIRST
BEGIN
ERROR( 35 );
RETURN
END;
INTREE( .NODEPTR );
IF .ROOT[N0CHILDREN] EQL 0 THEN RETURN( ERROR( 34 ) );
MPPS _ ASKYESORNO( 'ARE THERE [ANY MPPS TO START] IN THE TREE?R(YES,NO?R)[: ??]', YES );
! STEP DOWN THE NEWLY CREATED NODES AND
! FOR EACH NODE ....
! FOR EACH LEAF ....
IF .NODEPTR NEQ ROOT<0,0> THEN ASKNODE( .NODEPTR );
! IF THERE ARE ANY CHILDREN ASK ABOUT THEM
IF .NODEPTR[ N0FIRSTCHILD ] NEQ 0 THEN ASKALLNODES( .NODEPTR[N0FIRSTCHILD] );
END;
ROUTINE ASKNODE( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
OUTS( 'FOR ');
OUTSA( IF .NODEPTR[N0CHILDREN] EQL 0 THEN PAZ 'LEAF' ELSE PAZ 'NODE' );
OUTC( " " );
DFULL( .NODEPTR );
OUTC( ":" );
CRLF;
IF .MPPS THEN ASKMPP( .NODEPTR );
IF .NODEPTR[N0CHILDREN] EQL 0 THEN ! IF LEAF THEN GET LEAF JUNK
BEGIN
ASKQUOTA( .NODEPTR );
ASKISTAT( .NODEPTR );
ASKTRCODE( .NODEPTR );
ASKOPDST( .NODEPTR );
ASKCHKPNT( .NODEPTR )
END;
CRLF;
NODEPTR[N0TOBEDEFINED] _ FALSE
END;
FORWARD MPPUP, MPPDOWN;
GLOBAL ROUTINE HASMPP( NODEPTR ) =
BEGIN
OWN MPPADDR;
IF ( MPPADDR _ MPPUP( .NODEPTR ) ) NEQ 0
THEN RETURN .MPPADDR
ELSE RETURN MPPDOWN( .NODEPTR )
END;
GLOBAL ROUTINE MPPDOWN( NODEPTR ) =
BEGIN
OWN MPPADDR;
MAP FORMAT NODEPTR;
MAP FORMAT MPPADDR;
%LOCAL% ROUTINE SCANMPP(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
IF .MPPADDR EQL 0 THEN MPPADDR _ .NODEPTR[ N0MPPPTR ];
IF NOT LEAF THEN SCANMPP(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
IF ( MPPADDR _ .NODEPTR[ N0MPPPTR ] ) NEQ 0 THEN RETURN .MPPADDR;
IF .NODEPTR[ N0CHILDREN ] EQL 0 THEN RETURN 0;
! ELSE !
SCANMPP( .NODEPTR[ N0FIRSTCHILD ] );
.MPPADDR
END;
GLOBAL ROUTINE MPPUP( NODEPTR ) =
BEGIN
OWN SCAN,
MPPADDR;
MAP FORMAT SCAN;
SCAN _ .NODEPTR;
WHILE ( MPPADDR _ .SCAN[N0MPPPTR] ) EQL 0 DO
BEGIN
IF .SCAN EQL ROOT<0,0> THEN RETURN 0;
SCAN _ .SCAN[N0PARENT]
END;
.MPPADDR
END;
ROUTINE ASKMPP( NODEPTR ) =
BEGIN
REGISTER
MPPPTR;
MAP FORMAT NODEPTR;
MAP FORMAT MPPPTR;
LABEL LOOP;
MPPPTR _ HASMPP( .NODEPTR ); ! IF MPP SPECIFIED FOR THIS OR HIGHER NODE THEN GET ITS ADDRESS
NODEPTR[N0MPPPTR] _ 0;
IF .MPPPTR NEQ 0 THEN
BEGIN
IF ( ASKYESORNO( '[DO YOU WISH AN MPP TO START] HERE?R(YES,NO?R)[: ??]', YES ) ) THEN
BEGIN
NODEPTR[N0MPPPTR] _ .MPPPTR;
ATTACH( %TO% MPPPTR[M0LISTPTRS], .NODEPTR, N0MPPOFFSETT )
END
END
ELSE
BEGIN
NODEPTR[N0MPPPTR] _ MAKUMPP( .NODEPTR, PAZ '[MPP] TO START?R(<NONE>, <NAME>?R)[: ??]' )
END;
IF .NODEPTR[N0MPPPTR] NEQ 0 THEN
ASKTHRESH( .NODEPTR )
ELSE NODEPTR[ N0THRESH ] _ BIGNUMBER;
END;
ROUTINE ASKTHRESH( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
NODEPTR[N0THRESH] _ ASKDNUM( '[STARTING CRITERION]?R(<DECIMAL NUMBER>?R)[: ??]',
NOT DEFAULTOK,
-1,
1,
BIGNUMBER )
END;
ROUTINE ASKQUOTA( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
NODEPTR[N0QUOTA] _ ASKDNUM( '[QUOTA]?R(1, <DECIMAL NUMBER>?R)[: ??]',
DEFAULTOK,
1,
0,
BIGNUMBER )
END;
ROUTINE ASKISTAT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
NODEPTR[N0STATUS] _ ASKSTAT( PAZ '[INITIAL INPUT STATUS]?R(ENABLED,DISABLED?R)[: ??]', ENABLED )
END;
ROUTINE ASKOSTAT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
NODEPTR[N0OPSTATUS] _ ASKSTAT( PAZ '[INITIAL OUTPUT STATUS]?R(ENABLED,DISABLED?R)[: ??]', ENABLED )
END;
ROUTINE ASKTRCODE( NODEPTR ) =
BEGIN
REGISTER TRCPTR;
LABEL LOOP;
MAP FORMAT TRCPTR;
MAP FORMAT NODEPTR;
NODEPTR[N0TRCODE] _ TRCPTR _ GMEM( .TRCSIZE );
TRCPTR[TR0SIZE] _ .TRCSIZE;
TRCPTR[TR0CHAR] _ .TRCLEN;
LOOP:REPEAT
BEGIN
WHILE ASKBITS( '[TR]ANSACTION [CODE]?R(<STRING>?R)[: ??]',
TRCPTR[TR0CODE],
.TRCLEN ) EQL CRONLY DO
BEGIN
ERROR( 41 ); ! MUST HAVE TRCODE
WARN( 0 )
END;
IF NOT TRCODESAME( .NODEPTR, TRCPTR[ TR0CODE ] ) THEN LEAVE LOOP;
! ELSE !
WARN( 0 ) ! TRY AGAIN
END
END;
ROUTINE ASKOPDST( NODEPTR ) =
BEGIN
REGISTER NAME;
MAP FORMAT NODEPTR;
IF NOT ( NODEPTR[N0OPFLAG] _ ASKYESORNO( 'IS THIS LEAF TO BE [USE]D[ AS] AN[ OUTPUT DEST]INATION?R(NO,YES?R)[: ??]',
NO ) ) THEN RETURN;
ASKNAME( '[NAME FOR OUTPUT]?R(<LEAF NAME>,<NAME>?R)[: ??]',
N0NAMESIZE );
NAME _ IF .PRIM EQL 0 THEN NODEPTR[N0NAME] ELSE PRIM;
MOVE( %FROM% .NAME, %TO% NODEPTR[N0OPNAME], N0NAMELEN );
ASKOSTAT( .NODEPTR )
END;
ROUTINE ASKCHKPNT( NODEPTR ) =
BEGIN
MAP FORMAT NODEPTR;
NODEPTR[N0CHKPNT] _
ASKYESORNO('[ARE TRANSACTIONS TO THIS LEAF TO BE CHECKPOINTED ?R(YES,NO?R): ]',CHKPNT)
END;
FORWARD DTREE, PRINTNAME;
COMMENT;
! ROUTINE INTREE
! ======= ======
! THIS ROUTINE DRAWS THE TREE ON THE TTY AND ACCEPTS NODE NAMES
ROUTINE INTREE(NODEPTR)=
BEGIN
OWN FIRSTFLAG,LASTFLAG,COUNT,BPTR,BUFF[N0NAMELEN],CHAR,PARENT,LOGLEVEL,PHYSLEVEL,STOPLEVEL;
LABEL SEL,IRP;
MAP FORMAT NODEPTR:PARENT;
FORWARD SHIFTLEVEL;
FORWARD INIT();
%LOCAL% ROUTINE TREEERROR( ERRN ) =
BEGIN
ERROR( .ERRN );
WARN( 0 );
CRLF;
INIT();
SHIFTLEVEL()
END;
%LOCAL% ROUTINE HELPTREE=
BEGIN
TYPE( '[?M?JTYPE IN:?J
?M 1?R) A NODE NAME ?R( 12 ALPHANUMERIC OR HYPEN CHARACTERS NOT?J
?M BEGINNING OR ENDING IN A HYPEN ?R) FOLLOWED BY:?J
?M A?R) A SPACE OR TAB WHICH CAUSES THE CURRENT NODE TO BE?J
?M STORED AND THE NEXT LEVEL OF THE TREE TO BE ACCEPTED?J
?M OR B?R) A CARRIAGE RETURN WHICH CAUSES THE CURRENT NODE TO?J
?M BE STORED AND THE NEXT NODE ON THE CURRENT LEVEL TO?J
?M BE ACCEPTED?J
?M OR 2?R) A CARRIAGE RETURN BY ITSELF WILL CAUSE THE NODE LEVEL TO BE?J
?M BACKED UP TOWARD THE PRIMARY LEVEL. IF AT THE PRIMARY LEVEL?J
?M THEN TREE INPUT WILL STOP.?J
?M OR 3?R) A "??" WILL GET YOU THIS TEXT.?J
?M OR 4?R) A "^" WILL REDRAW THE TREE.?J
?M OR 5?R) ANY OTHER CHARACTER WILL GET YOU AN ERROR.?J
?M]' );
SHIFTLEVEL()
END;
OWN TOPNODE;
FORWARD SHIFTLEVEL;
%LOCAL% ROUTINE REDRAWTREE =
BEGIN
CRLF;
DTREE( .TOPNODE );
CRLF;
SHIFTLEVEL()
END;
%LOCAL% ROUTINE INIT =
BEGIN
FIRSTFLAG _ TRUE;
LASTFLAG _ FALSE;
COUNT _ 0;
BPTR _ BUFF<36,7>;
ZERO ( BUFF, BUFF + N0NAMELEN - 1 ); ! CLEAR BUFF
END;
%LOCAL% ROUTINE ZAPQUEUENAME=
BEGIN
OUTS( '^U?M?J' );
IF .FIRSTFLAG THEN RETURN; ! NOTHING TO DELETE
! ELSE !
INIT();
SHIFTLEVEL()
END;
%LOCAL% ROUTINE ACCEPTCHAR=
BEGIN
TTCALL(0,VREG); !INCHRW, INPUT CHARACTER
IF .VREG GEQ #141 %LC "A"% AND .VREG LEQ #172 %LC "Z"%
THEN .VREG-#40 ELSE .VREG
END;
%LOCAL% ROUTINE STOREC=
BEGIN
IF .COUNT GTR N0NAMESIZE THEN OUTC("?G")
ELSE REPLACEI(BPTR,.CHAR);
COUNT _ .COUNT + 1
END;
%LOCAL% ROUTINE UNSTOREC=
BEGIN
REGISTER TEMP;
MACRO
Y = LH$;
IF .COUNT LEQ 0 THEN RETURN OUTC( "?G" ); ! IF NO CHARACTERS LEFT THE RING THE BELL
IF (COUNT _ .COUNT - 1 ) EQL 0 THEN
BEGIN
FIRSTFLAG _ TRUE;
LASTFLAG _ FALSE
END;
IF .COUNT GEQ N0NAMESIZE THEN RETURN;
OUTC(SCANN(BPTR));
REPLACEN( BPTR, 0 );
BPTR<POS> _ IF (TEMP _ .BPTR<POS> + 7) GTR 36 THEN 8 ELSE .TEMP; ! BACK UP THE BYTE POINTER
IF .TEMP GTR 36 THEN BPTR<Y> _ .BPTR<Y> - 1
END;
%LOCAL% ROUTINE STORENODE =
BEGIN
REGISTER SIB,
NODEPTR;
MAP FORMAT NODEPTR;
MAP FORMAT SIB;
IF .COUNT GTR N0NAMESIZE THEN
BEGIN
WARN( 1 );
TRUNCATE( BUFF, N0NAMESIZE, N0NAMELEN * 5 )
END;
IF SIBSAMENAME( .PARENT, BUFF ) THEN
BEGIN
TREEERROR( 84 );
RETURN 0
END;
NODEPTR _ GMEM(N0SIZE); ! GET ROOM TO STORE THE NODE
NODEPTR[N0TOBEDEFINED] _ TRUE; ! MARK NODE TO BE DEFINED
NODEPTR[N0PARENT] _ .PARENT; ! LINK NODE TO PARENT
IF .PARENT[N0CHILDREN] EQL 0 THEN
BEGIN
PARENT[N0FIRSTCHILD] _ PARENT[N0LASTCHILD] _ .NODEPTR;
NODEPTR[N0LSIB] _ NODEPTR[N0RSIB] _ 0
END
ELSE
BEGIN
SIB _ .PARENT[N0LASTCHILD];
PARENT[N0LASTCHILD] _ .NODEPTR;
NODEPTR[N0LSIB] _ .SIB;
NODEPTR[N0RSIB] _ 0;
SIB[N0RSIB] _ .NODEPTR
END;
MOVE(BUFF,NODEPTR[N0NAMEW],N0NAMELEN); ! STORE NAME
NODEPTR[N0LEVEL] _ .LOGLEVEL; ! STORE LEVEL
.NODEPTR
END;
%LOCAL% ROUTINE SHIFTLEVEL=
BEGIN
DECR I FROM .PHYSLEVEL*2-1 TO 0 DO TAB;
IF .LOGLEVEL EQL 0 THEN OUTS( '__*' )
ELSE IF .PARENT[ N0FIRSTCHILD ] EQL 0 THEN OUTS( '__*' )
ELSE OUTS('\_*')
END;
%LOCAL% ROUTINE NEXTLEVEL =
BEGIN
REGISTER NODEPTR;
IF ( NODEPTR _ STORENODE() ) EQL 0 THEN RETURN;
IF .LOGLEVEL GEQ LEVELMAX-1 THEN
BEGIN
CRLF;
SHIFTLEVEL()
END
ELSE
BEGIN
PARENT _ .NODEPTR;
PHYSLEVEL _ .PHYSLEVEL + 1;
LOGLEVEL _ .LOGLEVEL + 1;
SELECT .CHAR OF
NSET
TABCHAR: IF .COUNT LSS 5 THEN TAB;
SPACE:
BEGIN
IF .COUNT LSS 5 THEN TAB;
IF .COUNT LSS N0NAMESIZE THEN TAB
END;
TESN;
OUTS('__*')
END
END;
! PHYSLEVEL IS POSITION ON PAPER
! LOGLEVEL IS LEVEL IN THE TREE
IF .NODEPTR NEQ ROOT<0,0> THEN
BEGIN
STOPLEVEL _ PHYSLEVEL _ 1;
LOGLEVEL _ .NODEPTR[ N0LEVEL ] + 1;
OUTS( '___' );
PRINTNAME( .NODEPTR )
END
ELSE
BEGIN
STOPLEVEL _ PHYSLEVEL _ LOGLEVEL _ 0
END;
OUTS('__*');
TOPNODE _ PARENT _ .NODEPTR;
REPEAT
BEGIN
INIT();
IRP: REPEAT
BEGIN
CHAR _ ACCEPTCHAR();
SEL: SELECT TRUE OF
NSET
ALPHANUMERIC(CHAR):
BEGIN
FIRSTFLAG _ LASTFLAG _ FALSE;
STOREC();
LEAVE SEL
END;
.CHAR EQL HYPEN:
BEGIN
IF .FIRSTFLAG THEN TREEERROR( 28 )
ELSE
BEGIN
LASTFLAG _ TRUE;
STOREC()
END;
LEAVE SEL
END;
BLANK(CHAR):
BEGIN
IF .FIRSTFLAG THEN TREEERROR( 29 )
ELSE
BEGIN
IF .LASTFLAG THEN TREEERROR( 30 )
ELSE
BEGIN
NEXTLEVEL()
END
END;
LEAVE IRP
END;
EOL(CHAR):
BEGIN
IF .CHAR EQL CRCHAR THEN ACCEPTCHAR() ! GET RID OF LF
ELSE CR;
IF .LASTFLAG THEN TREEERROR( 30 )
ELSE
BEGIN
IF NOT .FIRSTFLAG THEN
BEGIN
IF ( STORENODE() ) NEQ 0 THEN SHIFTLEVEL()
END
ELSE
BEGIN
IF (PHYSLEVEL _ .PHYSLEVEL - 1) LSS .STOPLEVEL THEN RETURN;
LOGLEVEL _ .LOGLEVEL - 1;
PARENT _ .PARENT[N0PARENT];
SHIFTLEVEL()
END
END;
LEAVE IRP
END;
.CHAR EQL RUBOUT:
BEGIN
UNSTOREC();
LEAVE SEL
END;
.CHAR EQL DELLINE:
BEGIN
ZAPQUEUENAME();
LEAVE SEL
END;
.CHAR EQL QMARK:
BEGIN
IF NOT .FIRSTFLAG THEN TREEERROR( 31 )
ELSE HELPTREE();
LEAVE SEL
END;
.CHAR EQL UPARROW:
BEGIN
IF NOT .FIRSTFLAG THEN TREEERROR( 31 )
ELSE REDRAWTREE();
LEAVE SEL
END;
OTHERWISE: TREEERROR( 31 )
TESN
END
END
END;
FORWARD DISTREE(1);
COMMENT;
! ROUTINE DISPTREE
! ======= ===========
! THIS ROUTINE HANDLES THE INDIVIDUAL CASES OF DISPLAY TREE:...
! CASE 1: IF AN INDIVIDUAL SUB TREE IS REQUESTED ( BY NAME ), DISTREE IS
! CALLED WITH THE ADDRESS OF THE SUB TREE'S STARTING NODE
! CASE 2: IF NO NAME OR THE ALL SWITCH WAS GIVEN, DISTREE IS CALLED
! WITH THE ADDRESS OF THE ROOT
GLOBAL ROUTINE DISPTREE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
IF NULLNODENAME(.NODENAME) OR .ALLSWITCH THEN
BEGIN
DISTREE( ROOT<0,0> );
RETURN
END;
IF (NODEPTR _ GETNODEPTR(.NODENAME)) EQL 0 THEN RETURN(ERROR(33))
ELSE DISTREE(.NODEPTR)
END;
FORWARD DTREE(1);
COMMENT;
! ROUTINE DISTREE
! ======= =======
! THIS ROUTINE DRAWS THE TREE ON THE TTY
ROUTINE DISTREE(NODEPTR)=
BEGIN
DTREE( .NODEPTR );
OUTPUTCRLF
END;
COMMENT;
! ROUTINE PRINTNAME
! ======= =========
! THIS ROUTINE PRINTS A NODE NAME CONVERTING TRAILING NULLS TO SPACES
ROUTINE PRINTNAME(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
REGISTER J,CHAR;
J _ NODEPTR[N0NAME];
DECR I FROM N0NAMESIZE - 1 TO 0 DO
BEGIN
CHAR _ SCANI(J);
OUTPUTC( IF .CHAR EQL 0 THEN " " ELSE .CHAR)
END;
OUTPUTTAB
END;
COMMENT;
! ROUTINE DTREE
! ======= =======
! THIS ROUTINE DRAWS THE TREE ON THE TTY
ROUTINE DTREE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
%LOCAL% ROUTINE DX(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: WHILE 1 DO
BEGIN
PRINTNAME(.NODEPTR);
IF NOT LEAF THEN (OUTPUT('___'); DX(.NEXTLEVEL,.LVL+1));
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
OUTPUTCRLF;
DECR I FROM (.LVL-1)*2 TO 1 DO OUTPUTTAB;
IF .LVL EQL 1 THEN OUTPUT( '___' ) ELSE OUTPUT('\__')
END
END;
MACRO
NEXTLEVEL = NODEPTR[N0FIRSTCHILD]$;
IF .NODEPTR NEQ ROOT<0,0,0> THEN
BEGIN
OUTPUT('___');
PRINTNAME(.NODEPTR);
IF .NEXTLEVEL EQL 0 THEN RETURN;
OUTPUT('___');
DX(.NEXTLEVEL,2)
END
ELSE
BEGIN
IF .NODEPTR[N0CHILDREN] EQL 0 THEN
ERROR( 68 )
ELSE
BEGIN
OUTPUT('___');
DX(.NEXTLEVEL,1)
END
END
END;
FORWARD DELTREE(1);
! ROUTINE DELETREE
! ======= ===========
! THIS ROUTINE HANDLES THE INDIVIDUAL CASES OF DELETE TREE:...
! CASE 1: IF AN INDIVIDUAL TREE IS REQUESTED ( BY NAME ), DELTREE IS
! CALLED WITH THE ADDRESS OF THE NODE TO DELETE ALL THE NODES
! UNDER THAT ONE
! CASE 2: IF NO NAME OR THE ALL SWITCH WAS GIVEN, THE ENTIRE TREE IS
! DELETED
GLOBAL ROUTINE DELETREE(NODENAME)=
BEGIN
REGISTER NODEPTR;
MAP FORMAT NODEPTR;
MAP ROOTFORMAT ROOT;
IF .ROOT[ N0CHILDREN ] EQL 0 THEN RETURN ERROR( 68 );
IF NULLNODENAME(.NODENAME) OR .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 DELTREE(.NODEPTR);
END;
COMMENT;
! ROUTINE DELTREE
! ======= =======
! THIS ROUTINE DELETES THE SUB TREE SPECIFIED FROM THE TREE
ROUTINE DELTREE(NODEPTR)=
BEGIN
MAP FORMAT NODEPTR;
KILLNODES( .NODEPTR )
END;
COMMENT;
! ROUTINE WHATTREES
! ======= =========
! THIS ROUTINE CHECKS THE TREE FOR UNDEFINED NODES
! WHATTREES RETURNS GOOD IF EVERYTHING IS OK, ELSE BAD
GLOBAL ROUTINE WHATTREES(TELLFLAG)=
BEGIN
OWN
TELL,
STATUS;
REGISTER
NODEPTR;
MAP ROOTFORMAT ROOT;
MAP FORMAT NODEPTR;
%LOCAL% ROUTINE WHATT(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: WHILE 1 DO
BEGIN
IF .TELL THEN
BEGIN
IF .NODEPTR[N0TOBEDEFINED] THEN
BEGIN
ERROR( 66 );
OUTSA(NODEPTR[N0NAME]);
TYPE('[ TO BE DEFINED?M?J]');
STATUS _ BAD
END
END
ELSE
BEGIN
IF .NODEPTR[N0TOBEDEFINED] THEN
BEGIN
ERROR( 66 );
OUTSA(NODEPTR[N0NAME]);
TYPE('[ TO BE DEFINED?M?J]');
MAKTREE(.NODEPTR)
END
END;
IF NOT LEAF THEN WHATT(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
TELL _ .TELLFLAG;
STATUS _ GOOD;
IF ( NODEPTR _ .ROOT[N0FIRSTCHILD] ) EQL 0 THEN
BEGIN
IF .TELL THEN
BEGIN
ERROR( 38 );
RETURN BAD
END
ELSE
BEGIN
MAKTREE( ROOT<0,0> );
RETURN
END;
END;
WHATT( .NODEPTR );
.STATUS
END;
END;
! END OF MGNTRE.BLI