Trailing-Edge
-
PDP-10 Archives
-
AP-D471B-SB_1978
-
mgnprg.bli
There are no other files named mgnprg.bli in the archive.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
! *** LAST MODIFIED ON 27-MAY-76 ILG
! MGNPRG.BLI
! CONTAINS EXECUTION ROUTINES FOR MCSGEN FUNCTIONS
GLOBAL BIND PRG = 1;
ROUTINE BT1=ERROR(11);
ROUTINE BT2=ERROR(12);
EXTERNAL
MAKENULL,
MAKETREE,
MAKENODE,
MAKELEAF,
MAKEMPP,
MAKETERMIN,
MAKEPORT,
MAKENETWORK,
MAKEMISC,
MAKEALL,
MAKECONT,
DISPNULL,
DISPTREE,
DISPNODE,
DISPLEAF,
DISPMPP,
DISPTERMIN,
DISPPORT,
DISPNETWORK,
DISPMISC,
DISPALL,
DISPCONT,
MODINULL,
MODITREE,
MODINODE,
MODILEAF,
MODIMPP,
MODITERMIN,
MODIPORT,
MODINETWORK,
MODIMISC,
MODIALL,
MODICONT,
DELENULL,
DELETREE,
DELENODE,
DELELEAF,
DELEMPP,
DELETM,
DELEPORT,
DELENETWORK,
DELEMISC,
DELEALL,
DELECONT,
WHATTREE,
WHATMPPS,
WHATTERM,
WHATPORTS,
WHATMISC,
WCTERM,
WCPORT,
WCNODE,
WCMPP,
WCMISC,
NUMNODES,
NUMMPPS,
NUMTRM,
NUMPT;
COMMENT;
! ROUTINE MAKE
! ======= ====
! THIS ROUTINE GATHERS THE ARGUMENTS FOR A MAKE COMMAND AND CALLS THE
! APPROPRIATE SUBROUTINE BASED ON THE TYPE (:).
! THIS ROUTINE LOOPS UNTIL A NEW COMMAND, NEW LINE, COMMENT, OR ERROR
! OCCURS.
ROUTINE MAKE=
BEGIN
LOCAL EOC;
BIND MAKELIST = PLIT(
%0% BT1, ! NONE OF THE BELOW
%1% BT2, ! NOT UNIQUELY ONE OF THE BELOW
%2% MAKENULL, ! NULL
%3% MAKETREE, ! TREE:
%4% MAKENODE, ! NODE:
%5% MAKELEAF, ! LEAF:
%6% MAKEMPP, ! MPP:
%7% MAKETERMIN, ! TERMINAL:
%8% MAKEPORT, ! PORT:
%9% MAKENETWORK, ! NETWORK:
%10% MAKEMISC, ! MISC:
%11% MAKEALL, ! ALL:
%12% MAKECONT ! CONT:
);
ZERO(ARGLIST,ARGTYPELENGTH);
DO
BEGIN
EOC _ GETITEM();
MOVE( ARGLIST, SAVEAREA, ARGLISTSIZE ); ! SAVE THE ARGLIST
IF NOT .ERRORFLG THEN
BEGIN
IF ( (IF .CCHAR EQL "," THEN (ADV(CCMDBUFF,CMDBPTR,CMDCOUNT,CCHAR); FALSE) ELSE TRUE) OR .COMMASEEN ) AND
NOT .EOC THEN RETURN(ERROR(7))
ELSE (.MAKELIST[.INDEX])(PRIM);
END;
MOVE( SAVEAREA, ARGLIST, ARGLISTSIZE ); ! UNSAVE THE ARGLIST
END
WHILE NOT( .EOC OR .ERRORFLG);
CRLF
END;
COMMENT;
! ROUTINE DISPLAY
! ======= =======
! THIS ROUTINE GATHERS THE ARGUMENTS FOR A DISPLAY COMMAND AND CALLS THE
! APPROPRIATE SUBROUTINE BASED ON THE TYPE (:).
! THIS ROUTINE LOOPS UNTIL A NEW COMMAND, NEW LINE, COMMENT, OR ERROR
! OCCURS.
ROUTINE DISPLAY=
BEGIN
LOCAL EOC;
BIND DISPLIST = PLIT(
%0% BT1, ! NONE OF THE BELOW
%1% BT2, ! NOT UNIQUELY ONE OF THE BELOW
%2% DISPNULL, ! NULL
%3% DISPTREE, ! TREE:
%4% DISPNODE, ! NODE:
%5% DISPLEAF, ! LEAF:
%6% DISPMPP, ! MPP:
%7% DISPTERMIN, ! TERMINAL:
%8% DISPPORT, ! PORT:
%9% DISPNETWORK, ! NETWORK:
%10% DISPMISC, ! MISC:
%11% DISPALL, ! ALL:
%12% DISPCONT ! CONT:
);
ZERO(ARGLIST,ARGTYPELENGTH);
DCHANNEL _ TTYCHANNEL;
DO
BEGIN
EOC _ GETITEM();
MOVE( ARGLIST, SAVEAREA, ARGLISTSIZE ); ! SAVE THE ARGLIST
IF NOT .ERRORFLG THEN
BEGIN
IF ( (IF .CCHAR EQL "," THEN (ADV(CCMDBUFF,CMDBPTR,CMDCOUNT,CCHAR); FALSE) ELSE TRUE) OR .COMMASEEN ) AND
NOT .EOC THEN RETURN(ERROR(7))
ELSE (.DISPLIST[.INDEX])(PRIM);
END;
MOVE( SAVEAREA, ARGLIST, ARGLISTSIZE ); ! UNSAVE THE ARGLIST
END
WHILE NOT( .EOC OR .ERRORFLG);
CRLF
END;
COMMENT;
! ROUTINE MODIFY
! ======= ======
! THIS ROUTINE GATHERS THE ARGUMENTS FOR A MODIFY COMMAND AND CALLS THE
! APPROPRIATE SUBROUTINE BASED ON THE TYPE (:).
! THIS ROUTINE LOOPS UNTIL A NEW COMMAND, NEW LINE, COMMENT, OR ERROR
! OCCURS.
ROUTINE MODIFY=
BEGIN
LOCAL EOC;
BIND MODILIST = PLIT(
%0% BT1, ! NONE OF THE BELOW
%1% BT2, ! NOT UNIQUELY ONE OF THE BELOW
%2% MODINULL, ! NULL
%3% MODITREE, ! TREE:
%4% MODINODE, ! NODE:
%5% MODILEAF, ! LEAF:
%6% MODIMPP, ! MPP:
%7% MODITERMIN, ! TERMINAL:
%8% MODIPORT, ! PORT:
%9% MODINETWORK, ! NETWORK:
%10% MODIMISC, ! MISC:
%11% MODIALL, ! ALL:
%12% MODICONT ! CONT:
);
ZERO(ARGLIST,ARGTYPELENGTH);
DCHANNEL _ TTYCHANNEL;
DO
BEGIN
EOC _ GETITEM();
MOVE( ARGLIST, SAVEAREA, ARGLISTSIZE ); ! SAVE THE ARGLIST
IF NOT .ERRORFLG THEN
BEGIN
IF ( (IF .CCHAR EQL "," THEN (ADV(CCMDBUFF,CMDBPTR,CMDCOUNT,CCHAR); FALSE) ELSE TRUE) OR .COMMASEEN ) AND
NOT .EOC THEN RETURN(ERROR(7))
ELSE (.MODILIST[.INDEX])(PRIM);
END;
MOVE( SAVEAREA, ARGLIST, ARGLISTSIZE ); ! UNSAVE THE ARGLIST
END
WHILE NOT( .EOC OR .ERRORFLG);
CRLF
END;
COMMENT;
! ROUTINE DELETE
! ======= ======
! THIS ROUTINE GATHERS THE ARGUMENTS FOR A DELETE COMMAND AND CALLS THE
! APPROPRIATE SUBROUTINE BASED ON THE TYPE (:).
! THIS ROUTINE LOOPS UNTIL A NEW COMMAND, NEW LINE, COMMENT, OR ERROR
! OCCURS.
ROUTINE DELETE=
BEGIN
REGISTER
OLDINDEX,
EOC;
BIND DELELIST = PLIT(
%0% BT1, ! NONE OF THE BELOW
%1% BT2, ! NOT UNIQUELY ONE OF THE BELOW
%2% DELENULL, ! NULL
%3% DELETREE, ! TREE:
%4% DELENODE, ! NODE:
%5% DELELEAF, ! LEAF:
%6% DELEMPP, ! MPP:
%7% DELETM, ! TERMINAL:
%8% DELEPORT, ! PORT:
%9% DELENETWORK, ! NETWORK:
%10% DELEMISC, ! MISC:
%11% DELEALL, ! ALL:
%12% DELECONT ! CONT:
);
ZERO(ARGLIST,ARGTYPELENGTH);
OLDINDEX _ -1;
DO
BEGIN
EOC _ GETITEM();
MOVE( ARGLIST, SAVEAREA, ARGLISTSIZE ); ! SAVE THE ARGLIST
IF NOT .ERRORFLG THEN
BEGIN
IF ( (IF .CCHAR EQL "," THEN (ADV(CCMDBUFF,CMDBPTR,CMDCOUNT,CCHAR); FALSE) ELSE TRUE) OR .COMMASEEN ) AND
NOT .EOC THEN RETURN(ERROR(7))
ELSE
BEGIN
IF .OLDINDEX EQL .INDEX THEN DELTYPEFLAG _ FALSE
ELSE DELTYPEFLAG _ TRUE;
OLDINDEX _ .INDEX;
(.DELELIST[.INDEX])(PRIM)
END
END;
MOVE( SAVEAREA, ARGLIST, ARGLISTSIZE ); ! UNSAVE THE ARGLIST
END
WHILE NOT( .EOC OR .ERRORFLG);
CRLF
END;
FORWARD XPRINT, SKIPNOISEWORD;
COMMENT;
! ROUTINE PRINT
! ======= =====
! THIS ROUTINE EXECUTES THE PRINT COMMAND. IT OPENS AN FILE,
! SETS THE DCHANNEL TO LPT, AND DOES A DISPALL.
ROUTINE PRINT=
BEGIN
OWN SPECBLK[4];
MAP ROOTFORMAT SPECBLK;
SKIPBLANKS( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
SKIPNOISEWORD();
IF EOL(CCHAR) OR COMMNT(CCHAR) OR NEWCMD(CCHAR) THEN
BEGIN
SPECBLK[SB0DEVICE] _ SIXBIT 'LPT';
SPECBLK[SB0NAME] _ SIXBIT 'MCSCNF';
SPECBLK[SB0EXT] _ SIXBIT "LST";
SPECBLK[SB0PPN] _ 0
END
ELSE
BEGIN
GETFD( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SPECBLK );
IF .ERRORFLG THEN RETURN
END;
XPRINT( SPECBLK );
CRLF
END;
COMMENT;
! ROUTINE SKIPNOISEWORD
! ======= =============
! THIS ROUTINE SKIPS A NOISE WORD ( WHICH IS ENCLOSED IN APOSTROPHIES )
ROUTINE SKIPNOISEWORD =
BEGIN
IF .CCHAR EQL "'" THEN
BEGIN
DO
BEGIN
ADV( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
IF EOL( CCHAR ) THEN RETURN
END
WHILE .CCHAR NEQ "'";
ADV( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR )
END
END;
COMMENT;
! ROUTINE XPRINT
! ======= ======
! THIS ROUTINE EXECUTES A PRINT REQUEST
ROUTINE XPRINT( SPECBLK ) =
BEGIN
MAP FORMAT SPECBLK;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE], SVBLK[ ARGLISTSIZE ];
MOVE( ARGLIST, SVBLK, ARGLISTSIZE ); ! SAVE AND ZERO ARGLIST SO DISPLAY ROUTINE
ZEROARGLIST; ! DON'T THINK THEY HAVE ARGUEMENTS
OOPENBLK[0] _ 0;
OOPENBLK[1] _ IF .SPECBLK[SB0DEVICE] NEQ 0 THEN .SPECBLK[SB0DEVICE] ELSE SIXBIT 'DSK ';
OOPENBLK[2]<LH> _ OBUF;
IF OPENOUTPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( OBUF, 0<36,7>, BUF1, BUF2, BUF3 );
OENTERBLK[1]<LH> _ IF ( .SPECBLK[SB0NAME] EQL 0 ) AND ( .SPECBLK[SB0EXT] EQL 0 ) THEN SIXBIT "LST" ELSE .SPECBLK[SB0EXT];
OENTERBLK[1]<RH> _ 0; ! MAKE SURE RIGHT HALF IS ZERO
OENTERBLK[0] _ IF .SPECBLK[SB0NAME] EQL 0 THEN SIXBIT 'MCSCNF' ELSE .SPECBLK[SB0NAME];
OENTERBLK[2] _ 0;
OENTERBLK[3] _ .SPECBLK[SB0PPN];
IFSKIP ENTER(OCHAN,OENTERBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 52 );
RETURN
END;
OUTBUF();
DCHANNEL _ LPTCHANNEL;
DISPALL();
DCHANNEL _ TTYCHANNEL;
CLOSE( OCHAN, 0 );
MOVE( ARGLIST, SVBLK, ARGLISTSIZE ) ! RESTORE ARGLIST
END;
FORWARD WHAT, WRITECOREFILE, WRITECOMFILE, WRITECOMPILE, WRITEPRINT;
COMMENT;
! ROUTINE WRITE
! ======= =====
! THIS ROUTINE DECODES AND EXECUTES THE WRITE COMMAND
ROUTINE WRITE =
BEGIN
OWN
FLAG,
EXECUTE,
WHICHBUFF,
SIZE,
SWITCH,
SPECBLK[4];
BIND
BUFFA = 1,
BUFFC = 0;
BIND COREFLAG = 1,
PRINTFLAG = 2,
COMFILEFLAG = 4,
COMPILEFLAG = 8;
LABEL LOOP;
MAP ROOTFORMAT SPECBLK;
%LOCAL% ROUTINE ASKFILE =
BEGIN
WHILE ( ASKFSPEC( 'ON WHAT [FILE: ??]',
SPECBLK ) ) EQL CRONLY DO
BEGIN
ERROR( 77 );
WARN( 0 )
END;
WHICHBUFF _ BUFFA
END;
FLAG _ 0;
SKIPBLANKS( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
SKIPNOISEWORD();
WHICHBUFF _ BUFFC;
IF EOL( CCHAR ) THEN SPECBLK[ SB0NAME ] _ SIXBIT 'MCSCNF'
ELSE
BEGIN
SKIPNOISEWORD();
GETFD( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SPECBLK );
IF .ERRORFLG THEN ASKFILE()
END;
CASE .WHICHBUFF OF
SET
%0% SIZE _ GETSWITCH( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SWITCH );
%1% SIZE _ GETSWITCH( ABUFF, ABPTR, ACOUNT, ACHAR, SWITCH );
TES;
IF .SIZE EQL 0 THEN
BEGIN
SELECT .SPECBLK[ SB0EXT ] OF
NSET
SIXBIT "BIN": SWITCH _ ASCII 'CORE-';
SIXBIT "MAC": SWITCH _ ASCII 'COM-F';
SIXBIT "LPT": SWITCH _ ASCII 'PRINT';
SIXBIT "REL": BEGIN
SWITCH _ ASCII 'COMPI';
SPECBLK[ SB0EXT ] _ SIXBIT "MAC";
END;
OTHERWISE: WHILE .SIZE EQL 0 DO BEGIN
ERROR( 78 );
% ERRORMSG = 'WRITE SWITCH REQUIRED' %
SIZE _ ASKSWITCH( 'WHAT TYPE OF [WRITE-SWITCH: ??]', SWITCH );
END;
TESN;
IF .SIZE EQL 0 THEN SIZE _ 5;
END;
IF .SPECBLK[SB0DEVICE] EQL 0 THEN SPECBLK[SB0DEVICE] _ SIXBIT 'DSK ';
LOOP: REPEAT
BEGIN
IF SEARCHTABLE( PLIT( ASCII 'CORE-', COREFLAG,
ASCII 'COMPI', COMPILEFLAG,
ASCII 'PRINT', PRINTFLAG,
ASCII 'COM-F', COMFILEFLAG ),
SWITCH,
IF .SIZE GTR 5 THEN 5 ELSE .SIZE,
1,
EXECUTE ) THEN
BEGIN
IF ( .FLAG AND .EXECUTE ) NEQ 0 THEN
BEGIN
WARN( 16 );
SELECT .EXECUTE OF
NSET
COREFLAG: OUTS( 'CORE-FILE' );
PRINTFLAG: OUTS( 'PRINT' );
COMFILEFLAG: OUTS( 'COM-FILE' );
COMPILEFLAG: OUTS( 'COMPILE' );
TESN;
OUTS( ' ALREADY GIVEN?M?J' )
END;
FLAG _ .FLAG OR .EXECUTE;
CASE .WHICHBUFF OF
SET
%CBUFF% IF EOL( CCHAR ) THEN LEAVE LOOP;
%ABUFF% IF EOL( ACHAR ) THEN LEAVE LOOP;
TES;
! ELSE !
CASE .WHICHBUFF OF
SET
%0% SIZE _ GETSWITCH( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SWITCH );
%1% SIZE _ GETSWITCH( ABUFF, ABPTR, ACOUNT, ACHAR, SWITCH );
TES;
IF .SIZE EQL 0 THEN LEAVE LOOP WITH ERROR( 105 )
END
ELSE
BEGIN
ERROR( 79 );
WARN( 0 );
WHILE ( SIZE _ ASKSWITCH( 'WHAT TYPE OF [WRITE-SWITCH: ??]', SWITCH ) ) EQL 0 DO
BEGIN
ERROR( 78 );
WARN( 0 )
END;
WHICHBUFF _ BUFFA
END
END;
SELECT TRUE OF
NSET
( .FLAG AND COREFLAG ) NEQ 0: WRITECOREFILE( SPECBLK );
( .FLAG AND PRINTFLAG ) NEQ 0: WRITEPRINT( SPECBLK );
( .FLAG AND COMFILEFLAG ) NEQ 0: WRITECOMFILE( SPECBLK );
( .FLAG AND COMPILEFLAG ) NEQ 0: WRITECOMPILE( SPECBLK );
TESN;
CRLF
END;
FORWARD WRITECMDLINE;
COMMENT;
! ROUTINE WRITECOMPILE
! ======= ============
! THIS ROUTINE SETS UP A COMPILE COMMAND IN TMPCOR AND DOES A RUN UUO
! ON MACRO
! THE TMPCOR COMMAND STRING LOOKS LIKE: "NAME=NAME<CRLF>MCSGEN!"
! IF WRITE OR "NAME=NAME" IF FINISH
ROUTINE WRITECOMPILE( SPECBLK ) =
BEGIN
%LOCAL% ROUTINE COPYFN( NAME, INBP ) =
BEGIN
REGISTER
BP,
CHAR,
NAMEBP;
BP _ .INBP;
NAMEBP _ (.NAME)<36,6>;
DECR I FROM 5 TO 0 DO
BEGIN
CHAR _ SCANI( NAMEBP );
IF .CHAR EQL 0 THEN RETURN .BP;
REPLACEI( BP, .CHAR + #40 )
END;
.BP
END;
REGISTER
JOBNUM,
OUTBP,
AC;
BIND BUFFSIZE = #200 + 3,
?.TCRWF = 3,
BUFFERSIZE = 10;
LOCAL NAME,
SBLK[ SPECBLKLEN ],
BUFFER[ BUFFERSIZE ],
BLOCK[ 2 ];
MAP FORMAT SPECBLK;
MAP ROOTFORMAT SBLK;
BIND MACRO10 = PLIT( SIXBIT 'SYS',
SIXBIT 'MACRO',
0,
0,
0,
0 );
! BEGIN !
IF WRITECOMFILE( .SPECBLK ) EQL BAD THEN RETURN BAD;
ZERO( BUFFER<0,0>, BUFFER<0,0> + BUFFERSIZE );
OUTBP _ BUFFER<36,7>;
OUTBP _ COPYFN( SPECBLK[ SB0NAME ], .OUTBP );
REPLACEI( OUTBP, "=" );
OUTBP _ COPYFN( SPECBLK[ SB0NAME ], .OUTBP );
REPLACEI( OUTBP, CRCHAR );
REPLACEI( OUTBP, LFCHAR );
IF .ENTRYDEVICE NEQ 0 THEN
BEGIN
OUTBP _ CCPY6( ENTRYDEVICE<36,6>, .OUTBP );
REPLACEI( OUTBP, ":" )
END;
OUTBP _ CCPY6( ENTRYNAME<36,6>, .OUTBP );
IF .ENTRYPPN NEQ 0 THEN
BEGIN
REPLACEI( OUTBP, "[" );
INCR I FROM 1 TO 6 DO
REPLACEI( OUTBP, .ENTRYPPN<36-.I*3, 3> + "0" );
REPLACEI( OUTBP, "," );
INCR I FROM 7 TO 12 DO
REPLACEI( OUTBP, .ENTRYPPN<36-.I*3, 3> + "0" );
REPLACEI( OUTBP, "]" )
END;
REPLACEI( OUTBP, "!" );
REPLACEI( OUTBP, CRCHAR );
REPLACEI( OUTBP, LFCHAR );
JOBNUM _ JOBNO();
AC<RH> _ BLOCK<0,0>;
AC<LH> _ ?.TCRWF;
BLOCK[0] _ SIXBIT 'MAC';
BLOCK[1]<LH> _ - BUFFERSIZE - 1;
BLOCK[1]<RH> _ BUFFER<0,0> - 1;
IFSKIP TMPCOR( AC ) THEN
ELSE
BEGIN
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE];
OOPENBLK[0] _ 0;
OOPENBLK[1] _ SIXBIT 'DSK ';
OOPENBLK[2]<LH> _ OBUF;
IF OPENOUTPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( OBUF, 0<36,7>, BUF1, BUF2, BUF3 );
OENTERBLK[0]<LH> _ .JOBNUM;
OENTERBLK[0]<RH> _ SIXBIT "MAC";
OENTERBLK[1]<LH> _ SIXBIT "TMP";
OENTERBLK[1]<RH> _ 0; ! MAKE SURE RIGHT HALF IS ZERO
OENTERBLK[2] _ 0;
OENTERBLK[3] _ 0;
IFSKIP ENTER(OCHAN,OENTERBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 52 );
RETURN
END;
OUTBUF();
DCHANNEL _ LPTCHANNEL;
XOUTPUT( BUFFER );
DCHANNEL _ TTYCHANNEL;
CLOSE( OCHAN, 0 )
END;
NAME<LH> _ .JOBNUM;
NAME<RH> _ IMAGETMPFILENAME;
SBLK[ SB0DEVICE ] _ SIXBIT 'DSK';
SBLK[ SB0NAME ] _ .NAME;
SBLK[ SB0EXT ] _ SIXBIT "TMP";
SBLK[ SB0PPN ] _ 0;
WRITECOREFILE( SBLK<0,0> );
WRITECMDLINE( .JOBNUM );
AC<RH> _ MACRO10;
AC<LH> _ 1;
IFSKIP RUNUUO( AC ) THEN
ELSE
BEGIN
ERROR( 106 );
RETURN
END
END;
COMMENT;
! ROUTINE WRITECMDLINE
! ======= ============
! THIS ROUTINE WRITES WHATS LEFT OF THE COMMAND LINE ON DISK
ROUTINE WRITECMDLINE( JOBNUM ) =
BEGIN
REGISTER CHAR;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE];
OOPENBLK[0] _ 0;
OOPENBLK[1] _ SIXBIT 'DSK ';
OOPENBLK[2]<LH> _ OBUF;
IF OPENOUTPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( OBUF, 0<36,7>, BUF1, BUF2, BUF3 );
OENTERBLK[0]<LH> _ .JOBNUM;
OENTERBLK[0]<RH> _ CMDTMPFILENAME;
OENTERBLK[1]<LH> _ SIXBIT "TMP";
OENTERBLK[1]<RH> _ 0; ! MAKE SURE RIGHT HALF IS ZERO
OENTERBLK[2] _ 0;
OENTERBLK[3] _ 0;
IFSKIP ENTER(OCHAN,OENTERBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 52 );
RETURN
END;
OUTBUF();
DCHANNEL _ LPTCHANNEL;
WHILE ( CHAR _ SCANI( CMDBPTR ) ) NEQ 0 DO
PUTC( .CHAR );
DCHANNEL _ TTYCHANNEL;
CLOSE( OCHAN, 0 )
END;
COMMENT;
! ROUTINE WRITEPRINT
! ======= ==========
! THIS ROUTINE DOES A PRINT WHICH WAS SPECIFIED AS A SWITCH IN A WRITE COMMAND
ROUTINE WRITEPRINT( SPECBLK ) =
BEGIN
MAP FORMAT SPECBLK;
SPECBLK[ SB0EXT ] _ SIXBIT "LPT";
XPRINT( .SPECBLK )
END;
COMMENT;
! ROUTINE WRITECOREFILE
! ======= =============
! THIS ROUTINE WRITES A CORE FILE
ROUTINE WRITECOREFILE( SPECBLK ) =
BEGIN
MAP FORMAT SPECBLK;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE];
OOPENBLK[0] _ #10;
OOPENBLK[1] _ .SPECBLK[SB0DEVICE];
OOPENBLK[2]<LH> _ OBUF<0,0>;
IF OPENOUTPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( OBUF, 0<0,36>, BUF1, BUF2, BUF3 );
OENTERBLK[0] _ .SPECBLK[SB0NAME];
OENTERBLK[1]<LH> _ IF .SPECBLK[ SB0EXT ] EQL 0 THEN SIXBIT "BIN"
ELSE .SPECBLK[ SB0EXT ];
OENTERBLK[1]<RH> _ 0; ! MAKE SURE RIGHT HALF IS ZERO
OENTERBLK[2] _ 0;
OENTERBLK[3] _ .SPECBLK[SB0PPN];
IFSKIP ENTER(OCHAN,OENTERBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 54 );
RETURN
END;
OUTBUF();
PUTWORD( BINFILEID );
PUTWORD( .VER );
PUTWORD( .SA );
PUTWORD( .?.JBFF );
PUTBLK( ROOT<0,0>, ROOT<0,0> + N0SIZE );
PUTWORD( .MPPTAB );
PUTWORD( .TERMTAB );
PUTWORD( .PORTTAB );
WCORMISC(); ! WRITE THE MISCELLANEOUS JUNK
PUTBLK( .SA, .?.JBFF );
CLOSE( OCHAN, 0 )
END;
FORWARD XWHAT;
COMMENT;
! ROUTINE WRITECOMFILE
! ======= =============
! THIS ROUTINE WRITES A COMPILE FILE
ROUTINE WRITECOMFILE( SPECBLK ) =
BEGIN
MAP FORMAT SPECBLK;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE];
IF XWHAT() EQL BAD THEN
BEGIN
WARN( 13 );
RETURN BAD
END;
OOPENBLK[0] _ 0;
OOPENBLK[1] _ .SPECBLK[SB0DEVICE];
OOPENBLK[2]<LH> _ OBUF<0,0>;
IF OPENOUTPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( OBUF, 0<36,7>, BUF1, BUF2, BUF3 );
OENTERBLK[0] _ .SPECBLK[SB0NAME];
OENTERBLK[1]<LH> _ SIXBIT "MAC";
OENTERBLK[1]<RH> _ 0; ! MAKE SURE RIGHT HALF IS ZERO
OENTERBLK[2] _ 0;
OENTERBLK[3] _ .SPECBLK[SB0PPN];
IFSKIP ENTER(OCHAN,OENTERBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 56 );
RETURN
END;
OUTBUF();
DCHANNEL _ DSKCHANNEL;
NUMNODES(); !NUMBER THE NODES
NUMMPPS(); ! & MPPS
NUMPT(); ! & PORTS
NUMTRM(); ! & TERMINALS
WCMISC();
WCNODE();
WCMPP();
WCPORT();
WCTERM();
OUTPUT( '?M?J?M?J?IEND?M?J' );
DCHANNEL _ TTYCHANNEL;
CLOSE( OCHAN, 0 );
GOOD
END;
FORWARD READCOREFILE;
COMMENT;
! ROUTINE READ
! ======= ====
! THIS ROUTINE DECODES AND EXECUTES THE READ COMMAND
ROUTINE READ =
BEGIN
OWN
EXECUTE,
WHICHBUFF,
SIZE,
SWITCH,
SPECBLK[4];
BIND
BUFFA = 1,
BUFFC = 0;
MAP ROOTFORMAT SPECBLK;
%LOCAL% ROUTINE ASKFILE =
BEGIN
WHILE ( ASKFSPEC( 'FROM WHAT [FILE: ??]',
SPECBLK ) ) EQL CRONLY DO
BEGIN
ERROR( 57 );
WARN( 0 )
END;
WHICHBUFF _ BUFFA
END;
SKIPBLANKS( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
SKIPNOISEWORD();
WHICHBUFF _ BUFFC;
IF EOL( CCHAR ) THEN ASKFILE()
ELSE
BEGIN
SKIPNOISEWORD();
GETFD( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SPECBLK );
IF .ERRORFLG THEN ASKFILE()
END;
CASE .WHICHBUFF OF
SET
%0% SIZE _ GETSWITCH( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR, SWITCH );
%1% SIZE _ GETSWITCH( ABUFF, ABPTR, ACOUNT, ACHAR, SWITCH );
TES;
IF .SPECBLK[ SB0EXT ] EQL 0 THEN SPECBLK[SB0EXT] _ SIXBIT "BIN";
! SINCE THERE IS ONLY ONE TYPE OF READ SWITCH IS SUPPORTED,
! AND THIS WILL PROBABLY ALWAYS BE THE CASE, WE WILL DEFAULT TO
! THAT IF NONE ARE SPECIFIED.
IF .SIZE EQL 0 THEN
BEGIN
SIZE _ 5;
SWITCH _ ASCII 'CORE-'
END;
WHILE .SIZE EQL 0 DO
BEGIN
ERROR( 58 );
% ERRORMSG = 'READ SWITCH REQUIRED' %
SIZE _ ASKSWITCH( 'WHAT TYPE OF [READ-SWITCH: ??]', SWITCH );
END;
IF .SPECBLK[SB0DEVICE] EQL 0 THEN SPECBLK[SB0DEVICE] _ SIXBIT 'DSK ';
REPEAT
BEGIN
IF SEARCHTABLE( PLIT( ASCII 'CORE-', READCOREFILE ),
SWITCH,
IF .SIZE GTR 5 THEN 5 ELSE .SIZE,
1,
EXECUTE ) THEN RETURN (.EXECUTE)( SPECBLK);
! ELSE !
ERROR( 59 );
WHILE ( SIZE _ ASKSWITCH( 'WHAT TYPE OF [READ-SWITCH: ??]', SWITCH ) ) EQL 0 DO
BEGIN
ERROR( 58 )
END
END;
CRLF
END;
COMMENT;
! ROUTINE READCOREFILE
! ======= =============
! THIS ROUTINE READS A CORE FILE
ROUTINE READCOREFILE( SPECBLK ) =
BEGIN
REGISTER
NEWSA,
F,
FF;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[BUFFSIZE], BUF2[BUFFSIZE], BUF3[BUFFSIZE];
MAP FORMAT SPECBLK;
MAP ROOTFORMAT ROOT;
IF .ROOT[N0CHILDREN] NEQ 0
OR
.MPPTAB NEQ 0
OR
.TERMTAB NEQ 0
OR
.PORTTAB NEQ 0
OR
.MISCDEFFLAG THEN
BEGIN
ERROR( 60 );
IF ASKYESORNO( 'DO YOU WANT TO [DESTROY THE DEFINITION IN CORE]?R(NO,YES?R)[: ??]',
NO ) EQL NO THEN RETURN
END;
IOPENBLK[0] _ #10;
IOPENBLK[1] _ .SPECBLK[SB0DEVICE];
IOPENBLK[2]<RH> _ IBUF<0,0>;
IF OPENINPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( IBUF, 0<0,36>, BUF1, BUF2, BUF3 );
ILOOKUPBLK[0] _ .SPECBLK[SB0NAME];
ILOOKUPBLK[1]<LH> _ .SPECBLK[SB0EXT];
ILOOKUPBLK[2] _ 0;
ILOOKUPBLK[3] _ .SPECBLK[SB0PPN];
IFSKIP LOOKUP(ICHAN,ILOOKUPBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 62 );
RETURN
END;
INBUF();
IF GETWORD() NEQ BINFILEID THEN RETURN ERROR( 122 );
! SEE IF THIS PROBABLY IS A CONFIG FILE
GETWORD(); ! SKIP THE VERSION NUMBER OF MCSGEN
NEWSA _ GETWORD(); ! READ STARTING ADDRESS OF DATA
IF .NEWSA LSS .SA THEN RETURN ERROR( 92 ); ! SEE IF THE STARTING OF DATA IS ACCEPTABLE TO US
SA _ .NEWSA;
F _ FF _ GETWORD(); ! READ THE HIGHEST ADDRESS USED
IF .FF GTR .?.JBREL THEN !GET MORE CORE IF REQ'D
IFSKIP CORE(FF) THEN
ELSE
BEGIN
ERROR( 63 );
RETURN
END;
?.JBFF _ .?.JBREL;
GETBLK( ROOT<0,0>, ROOT<0,0> + N0SIZE);
MPPTAB _ GETWORD();
TERMTAB _ GETWORD();
PORTTAB _ GETWORD();
RCORMISC(); ! READ THE MISCELLANEOUS JUNK
GETBLK( .SA, .F );
CLOSE( ICHAN, 0 )
END;
ROUTINE XSET=
BEGIN
OWN OLDMSGLEVEL,SWSIZE;
FORWARD SETSHOW(),SETNOSHOW(),SETLONG(),SETSHORT(),SETCURRENT(),SETHELP(), TELLACCEPTEDSWITCHES();
BIND SWITCHTABLE = PLIT(
'SHOW', SETSHOW,
'NO-SH', SETNOSHOW,
'LONG', SETLONG,
'SHORT', SETSHORT,
'CURRE', SETCURRENT,
'??', SETHELP,
'HELP', SETHELP);
OWN SWITCH;
%LOCAL% ROUTINE SETSHOW=(SHOW _ TRUE);
%LOCAL% ROUTINE SETNOSHOW=(SHOW _ FALSE);
%LOCAL% ROUTINE SETLONG=(MSGLEVEL _ 0);
%LOCAL% ROUTINE SETSHORT=(MSGLEVEL _ 1);
%LOCAL% ROUTINE SETCURRENT=
BEGIN
TYPE('THE [CURRENT VALUES] OF THE SWITCHES ARE[: ]');
IF .MSGLEVEL GTR 0 THEN TYPE('[SHORT,]') ELSE TYPE('[LONG,]');
IF .SHOW THEN TYPE('[SHOW?M?J]') ELSE TYPE('[NO-SHOW?M?J]');
TYPECRLF;
END;
%LOCAL% ROUTINE SETHELP=
BEGIN
REGISTER OLDMSGLEVEL;
OLDMSGLEVEL _ .MSGLEVEL;
MSGLEVEL _ 0;
TELLACCEPTEDSWITCHES();
MSGLEVEL _ .OLDMSGLEVEL
END;
%LOCAL% ROUTINE TELLACCEPTEDSWITCHES=
BEGIN
TYPE('THE [ACCEPTED SWITCHES] ARE [: ]?J
?M[SHOW(,)] WHICH CAUSES THE OLD CONTENTS OF EACH ITEM TO BE?J
?M TYPED IN A MODIFY COMMAND.?J
?M[NO-SHOW(,)] WHICH INHIBITS THE TYPING OF THE OLD CONTENTS OF EACH?J
?M ITEM IN THE MODIFY COMMAND.?J
?M[LONG(,)] WHICH CAUSES A LARGE AMOUNT OF TYPING?J
?M[SHORT(,)] WHICH CAUSES LESS TYPING TO BE DONE?J
?M[CURRENT(?M?J)] WHICH TYPES THE CURRENT VALUES OF THE SWITCHES?J
?M');
TYPECRLF;
END;
%LOCAL% ROUTINE ACCEPTNEW=
!RETURNS TRUE IF INPUT = EOL ELSE FALSE
BEGIN
TYPE('PLEASE TYPE IN THE [NEW SWITCHES] OR <CR> IF YOU DON''T WANT TO CONTINUE?M?J');
ACHAR _ INPUT(ALINE,ALINELENGTH);
SKIPBLANKS(ABUFF,ABPTR,ACOUNT,ACHAR);
IF (EOL(ACHAR) OR NEWCMD(ACHAR) OR COMMNT(ACHAR)) THEN RETURN TRUE;
FALSE
END;
%LOCAL% ROUTINE ASKSWITCHES=
BEGIN
OLDMSGLEVEL _ .MSGLEVEL;
MSGLEVEL _ 0;
TELLACCEPTEDSWITCHES();
SETCURRENT();
MSGLEVEL _ .OLDMSGLEVEL;
IF ACCEPTNEW() THEN RETURN;
WHILE NOT (EOL(ACHAR) OR NEWCMD(ACHAR) OR COMMNT(ACHAR)) DO
BEGIN
SKIPBLANKS(ABUFF,ABPTR,ACOUNT,ACHAR);
IF .ACHAR EQL "/" THEN ADV(ABUFF,ABPTR,ACOUNT,ACHAR);
IF(SWSIZE _ GATHER(ALINE,ACHAR,SWITCH,5)) EQL 0 THEN RETURN(ERROR(7));
IF SEARCHTABLE(SWITCHTABLE,SWITCH,IF .SWSIZE GTR 5 THEN 5 ELSE .SWSIZE,1,EXECUTE) THEN (.EXECUTE)()
ELSE
BEGIN
ERROR(IF .EXECUTE EQL 0 THEN 2 ELSE 3);
TELLACCEPTEDSWITCHES();
ACCEPTNEW();
END;
IF .ACHAR EQL "," THEN ADV(ABUFF,ABPTR,ACOUNT,ACHAR)
END
END;
SKIPBLANKS(CMDBUFF,CMDBPTR,CMDCOUNT,CCHAR);
IF (EOL(CCHAR) OR NEWCMD(CCHAR) OR COMMNT(CCHAR)) THEN ASKSWITCHES()
ELSE
BEGIN
WHILE NOT (EOL(CCHAR) OR NEWCMD(CCHAR) OR COMMNT(CCHAR)) DO
BEGIN
SKIPBLANKS(CMDBUFF,CMDBPTR,CMDCOUNT,CCHAR);
IF .CCHAR EQL "/" THEN ADV(CMDBUFF,CMDBPTR,CMDCOUNT,CCHAR);
IF(SWSIZE _ GATHER(CMDLINE,CCHAR,SWITCH,5)) EQL 0 THEN RETURN(ERROR(7));
IF SEARCHTABLE(SWITCHTABLE,SWITCH,IF .SWSIZE GTR 5 THEN 5 ELSE .SWSIZE,1,EXECUTE) THEN (.EXECUTE)()
ELSE
BEGIN
ERROR(IF .EXECUTE EQL 0 THEN 2 ELSE 3);
ASKSWITCHES();
RETURN
END;
IF .CCHAR EQL "," THEN ADV(CMDBUFF,CMDBPTR,CMDCOUNT,CCHAR)
END
END;
CRLF
END;
COMMENT;
! ROUTINE EXCHANGE
! ======= ========
! THIS ROUTINE GATHERS THE ARGUMENTS FOR A EXCHANGE COMMAND AND CALLS THE
! APPROPRIATE SUBROUTINE BASED ON THE TYPE (:).
ROUTINE EXCHANGE=
BEGIN
REGISTER
EXCHANGETYPE;
EXTERNAL
MPPUP,
MPPDOWN,
SIBSAMENAME,
GETNODEPTR;
OWN NODE1,
NODE2;
MAP FORMAT NODE1;
MAP FORMAT NODE2;
%LOCAL% ROUTINE EXCHANGETREE =
BEGIN
LOCAL
NODEPTR,
CHANGE,
LEVELNODE1,
LEVELNODE2,
NODE1UP,
NODE2UP,
NODE1DOWN,
NODE2DOWN,
NODE1SIB,
NODE2SIB,
NODE1PARENT,
NODE2PARENT;
MAP FORMAT NODEPTR;
%LOCAL% ROUTINE LOWEST( NODE ) =
BEGIN
OWN VAL;
%LOCAL% ROUTINE FLOWEST(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 .VAL LSS .NODEPTR[ N0LEVEL ] THEN VAL _ .NODEPTR[ N0LEVEL ];
IF NOT LEAF THEN FLOWEST(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
VAL _ 0;
FLOWEST( .NODE );
.VAL
END;
%LOCAL% ROUTINE FIXLEVEL( NODE, DIFFERENCE ) =
BEGIN
OWN FIXUP;
%LOCAL% ROUTINE DOFIXUP(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
NODEPTR[ N0LEVEL ] _ .NODEPTR[ N0LEVEL ] + .FIXUP;
IF NOT LEAF THEN DOFIXUP(.NEXTLEVEL);
WHILE .NEXTTHIS EQL 0 DO RETURN;
IF(NODEPTR_.NEXTTHIS) EQL 0 THEN LEAVE B;
END
END;
FIXUP _ .DIFFERENCE;
DOFIXUP( .NODE )
END;
!************************** BEGIN EXCHANGETREE *****************************
! 1. CHECK SIB NAMES FOR CONFLICTS (IF NODES TO BE CHANGED HAVE THE SAME NAME THEN NO CONFLICT )
IF NOT COMPARE( NODE1[ N0NAME ], NODE2[ N0NAME ], N0NAMELEN ) THEN
BEGIN
IF SIBSAMENAME( .NODE1[ N0PARENT ], NODE2[ N0NAME ] ) THEN RETURN ERROR( 84 );
IF SIBSAMENAME( .NODE2[ N0PARENT ], NODE1[ N0NAME ] ) THEN RETURN ERROR( 84 );
END;
! 2. CHECK MPP'S FOR CONFLICTS
NODE1UP _ MPPUP( .NODE1 );
NODE2UP _ MPPUP( .NODE2 );
NODE1DOWN _ MPPDOWN( .NODE1 );
NODE2DOWN _ MPPDOWN( .NODE2 );
IF NOT ( ( .NODE1UP EQL .NODE2DOWN
OR
.NODE1UP EQL 0
OR
.NODE2DOWN EQL 0 )
AND
( .NODE2UP EQL .NODE1DOWN
OR
.NODE2UP EQL 0
OR
.NODE1DOWN EQL 0 ) ) THEN RETURN ERROR( 99 );
! 3. CHECK FOR LEVEL VIOLATIONS
LEVELNODE1 _ .NODE1[ N0LEVEL ];
LEVELNODE2 _ .NODE2[ N0LEVEL ];
IF .LEVELNODE1 NEQ .LEVELNODE2 THEN
IF .LEVELNODE1 LSS .LEVELNODE2 THEN
BEGIN
IF (LOWEST( .NODE1 ) - .LEVELNODE1 ) + .LEVELNODE2 GEQ MAXLEVEL THEN RETURN ERROR( 113 );
NODEPTR _ .NODE2;
WHILE .NODEPTR NEQ ROOT<0,0> DO
BEGIN
IF .NODEPTR EQL .NODE1 THEN RETURN ERROR( 114 );
NODEPTR _ .NODEPTR[ N0PARENT ]
END
END
ELSE
BEGIN
IF (LOWEST( .NODE2 ) - .LEVELNODE2 ) + .LEVELNODE1 GEQ MAXLEVEL THEN RETURN ERROR( 113 );
NODEPTR _ .NODE1;
WHILE .NODEPTR NEQ ROOT<0,0> DO
BEGIN
IF .NODEPTR EQL .NODE2 THEN RETURN ERROR( 114 );
NODEPTR _ .NODEPTR[ N0PARENT ]
END
END;
! 4. DETACH NODES
NODE1PARENT _ .NODE1[ N0PARENT ];
NODE1SIB _ .NODE1[ N0RSIB ];
NODE2PARENT _ .NODE2[ N0PARENT ];
NODE2SIB _ .NODE2[ N0RSIB ];
IF .NODE1PARENT EQL .NODE2PARENT THEN
IF .NODE1SIB EQL .NODE2 THEN
NODE1SIB _ .NODE1
ELSE
IF .NODE2SIB EQL .NODE1 THEN NODE2SIB _ .NODE1SIB;
DETACHNODE( .NODE1 );
DETACHNODE( .NODE2 );
! 5. ATTACH NODES
ATTACHNODE( .NODE1, %TO% .NODE2PARENT, IF .NODE2SIB EQL 0 THEN AFTER ELSE BEFORE, .NODE2SIB );
ATTACHNODE( .NODE2, %TO% .NODE1PARENT, IF .NODE1SIB EQL 0 THEN AFTER ELSE BEFORE, .NODE1SIB );
! 6. FIXUP LEVELS IN NODES
IF ( CHANGE _ .LEVELNODE1 - .LEVELNODE2 ) NEQ 0 THEN
BEGIN
NODE1[ N0LEVEL ] _ .NODE1[ N0LEVEL ] + .CHANGE; ! MODIFY NODE 1 'S LEVEL BECAUSE ATTACHNODE ALREADY FIXED IT
FIXLEVEL( .NODE1, - .CHANGE );
NODE2[ N0LEVEL ] _ .NODE2[ N0LEVEL ] - .CHANGE; ! MODIFY NODE 2 'S LEVEL BECAUSE ATTACHNODE ALREADY FIXED IT
FIXLEVEL( .NODE2, .CHANGE )
END;
END;
%LOCAL% ROUTINE EXCHANGENODE =
BEGIN
! CHANGE NAMES
LOCAL TEMPNODE[ N0NAMELEN ];
! 1. CHECK SIB NAMES FOR CONFLICTS (IF NODES TO BE CHANGED HAVE THE SAME NAME THEN NO CONFLICT )
IF NOT COMPARE( NODE1[ N0NAME ], NODE2[ N0NAME ], N0NAMELEN ) THEN
BEGIN
IF SIBSAMENAME( .NODE1[ N0PARENT ], NODE2[ N0NAME ] ) THEN RETURN ERROR( 84 );
IF SIBSAMENAME( .NODE2[ N0PARENT ], NODE1[ N0NAME ] ) THEN RETURN ERROR( 84 );
END;
MOVE( %FROM% NODE1[ N0NAME ], %TO% TEMPNODE, N0NAMELEN );
MOVE( %FROM% NODE2[ N0NAME ], %TO% NODE1[ N0NAME ], N0NAMELEN );
MOVE( %FROM% TEMPNODE, %TO% NODE2[ N0NAME ], N0NAMELEN )
END;
%LOCAL% ROUTINE EXCHANGEERROR =
BEGIN
ERROR( 93 )
END;
BIND EXCHANGELIST = PLIT(
%0% BT1, ! NONE OF THE BELOW
%1% BT2, ! NOT UNIQUELY ONE OF THE BELOW
%2% EXCHANGETREE, ! NULL
%3% EXCHANGETREE, ! TREE:
%4% EXCHANGENODE, ! NODE:
%5% EXCHANGEERROR, ! LEAF:
%6% EXCHANGEERROR, ! MPP:
%7% EXCHANGEERROR, ! TERMINAL:
%8% EXCHANGEERROR, ! PORT:
%9% EXCHANGEERROR, ! NETWORK:
%10% EXCHANGEERROR, ! MISC:
%11% EXCHANGEERROR, ! ALL:
%12% EXCHANGEERROR ! CONT:
);
IF EOL( CCHAR ) THEN RETURN ERROR( 98 );
ZEROARGLIST;
GETITEM();
IF .PRIM EQL 0 THEN RETURN ERROR( 88 );
IF NOT ( .INDEX EQL 2
OR
.INDEX EQL 3
OR
.INDEX EQL 4 ) THEN RETURN ERROR( 93 );
EXCHANGETYPE _ .INDEX;
NODE1 _ GETNODEPTR( PRIM );
IF .NODE1 EQL 0 THEN RETURN ERROR( 33 );
IF EOL( CCHAR ) THEN RETURN ERROR( 98 );
SKIPBLANKS( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
IF .CCHAR NEQ "," THEN RETURN ERROR( 9 )
ELSE ADV( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
GETITEM();
IF .PRIM EQL 0 THEN RETURN ERROR( 88 );
IF NOT EOL( CCHAR ) THEN RETURN ERROR( 9 );
IF .INDEX NEQ .EXCHANGETYPE THEN RETURN ERROR( 93 );
NODE2 _ GETNODEPTR( PRIM );
IF .NODE2 EQL 0 THEN RETURN ERROR( 33 );
( .EXCHANGELIST[ .EXCHANGETYPE ] )();
CRLF
END;
ROUTINE WHAT=
BEGIN
IF NOT (NEWCMD(CCHAR) OR EOL(CCHAR) OR COMMNT(CCHAR)) THEN RETURN (ERROR(9));
XWHAT()
END;
ROUTINE XWHAT =
BEGIN
REGISTER STATUS;
STATUS _ WHATMISC( JUSTTELL )
AND WHATTREE( JUSTTELL )
AND WHATMPPS( JUSTTELL )
NOTE - AN UNNATTACHED MPP DOESN'T CAUSE A FATAL ERROR
AND WHATPORTS( JUSTTELL )
AND WHATTERM( JUSTTELL );
IF .STATUS NEQ GOOD THEN
BEGIN
WARN( 2 );
END
ELSE OUTS( '[MGNCOK CONFIGURATION OK]?M?J' );
CRLF;
.STATUS
END;
COMMENT;
! ROUTINE HELP
! ======= ====
! THIS ROUTINE EXECUTES THE HELP ( AND ? AT COMMAND LEVEL ) COMMAND
ROUTINE HELP =
BEGIN
OWN CCOUNT,
FIRST,
DONE,
ARG[2],
BP,
CRSEEN,
CHAR,
THISCMD[2],
BPTR,
COUNT;
LABEL CMDLOOP,
LOOP,
LOOP2;
%LOCAL% ROUTINE NEXTCHAR( ERR ) =
BEGIN
IF .COUNT LEQ 0 THEN
BEGIN
IF INBUFFER() EQL -1 THEN
BEGIN
ERROR( .ERR );
XOUTPUT( ARG );
RETURN BAD
END;
COUNT _ .IBUF[2];
BPTR _ .IBUF[1]
END;
COUNT _ .COUNT - 1;
CHAR _ SCANI( BPTR );
GOOD
END;
BIND BUFFSIZE = #200 + 3;
LOCAL BUF1[ BUFFSIZE + 1 ], BUF2[ BUFFSIZE + 1 ], BUF3[ BUFFSIZE + 1 ];
%LOCAL% ROUTINE GETARG =
BEGIN
REGISTER
ARG,
BP;
SKIPBLANKS( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR );
IF EOL( CCHAR ) THEN
IF .FIRST THEN RETURN 0
ELSE
BEGIN
ERROR( 120 );
RETURN 0
END;
FIRST _ FALSE;
ARG _ 0;
BP _ ARG<36,7>;
CCOUNT _ 5;
WHILE NOT ( EOL( CCHAR ) OR .CCHAR EQL "," ) DO
BEGIN
IF ( CCOUNT _ .CCOUNT - 1 ) GEQ 0 THEN
IF NOT BLANK( CCHAR ) THEN REPLACEI( BP, .CCHAR );
ADV( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR )
END;
IF .CCHAR EQL "," THEN
ADV( CMDBUFF, CMDBPTR, CMDCOUNT, CCHAR )
ELSE
BEGIN
IF NOT EOL( CCHAR ) THEN
BEGIN
ERROR( 119 );
RETURN 0
END
ELSE DONE _ TRUE
END;
IF .CCOUNT GEQ 0 THEN CCOUNT _ 5 - .CCOUNT
ELSE CCOUNT _ 5;
.ARG
END;
! BEGIN !
FIRST _ TRUE;
DONE _ FALSE;
DO
BEGIN
ARG _ GETARG(); ! GET ANY ARGUMENT NAME IN ARG
THISCMD[1] _ ARG[1] _ 0; ! SO WE CAN TYPE ARG & THISCMD AS ASCIZ
IOPENBLK[0] _ 1;
IOPENBLK[1] _ SIXBIT 'DSK ';
IOPENBLK[2]<RH> _ IBUF<0,0>;
IOPENBLK[2]<LH> _ 0;
IF OPENINPUTDEVICE() FAILED THEN RETURN;
MAKEBUFFERRING( IBUF, 0<36,7>, BUF1, BUF2, BUF3 );
BUF1[ BUFFSIZE ] _ BUF2[ BUFFSIZE ] _ BUF3[ BUFFSIZE ] _ 0;
! MAKE THE BUFFERS ASCIZ
ILOOKUPBLK[0] _ SIXBIT 'MCSGEN';
ILOOKUPBLK[1]<LH> _ SIXBIT "HLP";
ILOOKUPBLK[1]<RH> _ ILOOKUPBLK[2] _ 0;
ILOOKUPBLK[3] _ .ENTRYPPN; ! TRY WHERE MCSGEN CAME FROM FIRST
IFSKIP LOOKUP(ICHAN,ILOOKUPBLK)
THEN %CONTINUE%
ELSE
BEGIN
ILOOKUPBLK[3] _ #2000005; ! NOT IN SYS: THEN TRY HLP:
IFSKIP LOOKUP(ICHAN,ILOOKUPBLK)
THEN %CONTINUE%
ELSE
BEGIN
ILOOKUPBLK[3] _ 0; ! NOT IN HLP: OR WHERE MCSGEN CAME FROM THEN TRY SYS:
IFSKIP LOOKUP(ICHAN,ILOOKUPBLK)
THEN %CONTINUE%
ELSE
BEGIN
ERROR( 117 );
RETURN 0
END
END
END;
IF .ARG EQL 0 THEN
BEGIN
WHILE INBUFFER() NEQ -1 DO ! PRINT ALL
XOUTPUT( .IBUF[1] + 1 );
DONE _ TRUE
END
ELSE
CMDLOOP: BEGIN ! PRINT A COMMAND
CHAR _ COUNT _ 0;
DO
BEGIN
WHILE .CHAR NEQ CRCHAR DO ! FIND THE BEGINNING OF A LINE
IF NEXTCHAR( 115 ) EQL BAD THEN LEAVE CMDLOOP;
IF NEXTCHAR( 115 ) EQL BAD THEN LEAVE CMDLOOP; ! SKIP THE <CR>
IF NEXTCHAR( 115 ) EQL BAD THEN LEAVE CMDLOOP; ! SKIP THE <LF>
THISCMD _ 0; ! GATHER THE FIRST WORD OF THE LINE
BP _ THISCMD<36,7>;
CRSEEN _
LOOP: DECR I FROM .CCOUNT - 1 TO 0 DO
BEGIN
IF .CHAR EQL CRCHAR THEN LEAVE LOOP WITH 0;
REPLACEI( BP, .CHAR );
IF NEXTCHAR( 115 ) EQL BAD THEN LEAVE CMDLOOP
END
END
WHILE .ARG NEQ .THISCMD;
! FOUND THEN MATCH FOR THE REQUESTED CMD
XOUTPUT( THISCMD ); ! TYPE THE COMMAND
IF .CRSEEN EQL 0 THEN
BEGIN
IF NEXTCHAR( 116 ) EQL BAD THEN LEAVE CMDLOOP; ! SKIP THE <CR>
IF NEXTCHAR( 116 ) EQL BAD THEN LEAVE CMDLOOP; ! AND <LF>
OUTPUTCRLF ! THEN TYPE THEM
END;
CRSEEN _ FALSE;
! TYPE THE REST OF THE TEXT ABOUT THE CMD
LOOP2: REPEAT
BEGIN
IF .CHAR EQL CRCHAR THEN
IF .CRSEEN THEN LEAVE LOOP2
ELSE
BEGIN
CRSEEN _ TRUE;
OUTPUTCRLF;
IF NEXTCHAR( 116 ) EQL BAD THEN LEAVE CMDLOOP
END
ELSE
BEGIN
CRSEEN _ FALSE;
OUTPUTC( .CHAR )
END;
IF NEXTCHAR( 116 ) EQL BAD THEN LEAVE CMDLOOP
END
END;
CLOSE( ICHAN, 0 );
OUTPUTCRLF
END
WHILE NOT .DONE
END;
ROUTINE XNULL=;
ROUTINE STOP =
BEGIN
MACHOP CALLI = #47;
CALLI( 1,#12 )
END;
!END OF MGNPRG.BLI