Google
 

Trailing-Edge - PDP-10 Archives - bb-d868b-bm_tops20_v3a_2020_dist - 3a-sources/six12.bli
There are 19 other files named six12.bli in the archive. Click here to see a list.
MODULE SIX12(NOFSAVE,NODEBUG,RESERVE(7,9))=
!  5.200.22 - SIX12 MUST NOT CLOBBER REGISTER 9 WHICH HAS ERRDEV INITIALLY
BEGIN
!  IF DEFAULT REGISTERS ARE CHANGED, MODIFY ROUTINE 'SIXDDT' !!
BIND BREG=?.BREG;

!			DEBUGGING  CONTROL  MODULE
!			--------------------------
!
!	SEE SIX12.MAN FOR INFO		CREDITS:
!	----------------------		C. B. WEINSTOCK		WM. A. WULF
!					T. LANE			R. K. JOHNSSON
!	REVISED:   JULY 1, 1974    RJ14


BIND	SAILSW = 0;			! SET TO 1 FOR USE WITH SAIL


! THESE BINDS CONTROL SIZE OF PROBLEM
! -----------------------------------

BIND	STACKSIZE=50, NMACROS=40, LEVELS=10, EXTRAOPS=20,
	BGOBASE=20, ROUTSCNT=50, MONITCNT=50, ROUTSIZE=4;

MACHOP	TTCALL=#51, CALLI=#47, HLRE=#574, EXCH=#250, IN=#56, OUT=#57,
	OPEN=#50, CLOSE=#70, LOOKUP=#76, ENTER=#77, INBUF=#64, OUTBUF=#65,
	PUSH=#261, POP=#262, JRST=#254, RELEASE=#71;

EXTERNAL ?.JBSYM, ?.JBOPC, ?.JBDDT, DDTEND, DDT, ?.JBUUO, ?.JBFF,
	 ?.JB41, ?.JBREL, ?.JBHRL;


! STORAGE DECLARATIONS
! --------------------

GLOBAL	SIXRP,SIXLP,SIXVP,SIXRC,SIXLC,SIXVC,SIXVREG;

OWN	STARTFLG,ENABFLG,NROUTS,NVALS,SIXTOG,RTNLVL,
	DCNT,CHAR,NCHAR,NPCHAR,LPTFLG,ERRORFLG,SAILUUO,
	GOFLG,TRACEFLG,MODEFLG,QUOTFLG,TRCCNT,OPQCNT,
	TOPSTK,TOPOP,IOBASE,WDBASE,VTEMP,
	LPTHDR[3],DSKHDR[3],ENTERPNT,PTEXT,NEWOPS,NNAMES,
	BUFF[24],PCHAR[LEVELS],TEXTAREA[4*NMACROS],
					! ALLOWING AVG. 20 CHARS/MACRO; CHANGE ROUTINE 'GETTEXT' IF CHANGED
	DEFOPTAB[5*EXTRAOPS],DBGSTK[STACKSIZE],LPTBUF[#203];

STRUCTURE XVECTOR[I,J,K,L]=[I*J] (.XVECTOR+.J+(.I*J))<.K,.L>;

OWN	XVECTOR
	MONVALS[MONITCNT,2]:SIXNAMES[NMACROS,2]:ROUTS[ROUTSCNT,ROUTSIZE];


! SOME USEFUL MACROS
! ------------------

MACRO	RNAME=?.JBUUO<0,18>$,
	RH=0,18$,
	LH=18,18$,
	FW=0,36$,
	ADR=0,0$,
	OPCODE=27,9$,

	BITFLD(N)=N,1$,
	BITVAL(N)=1^(N)$,

	DECRTOG=(SIXTOG_.SIXTOG-BGOBASE)$,
	INCRTOG=(SIXTOG_.SIXTOG+BGOBASE)$,

	SETON(U)=(U_ -1)$,
	SETOFF(U)=(U_ 0)$,
	ISON(U)=(.U NEQ 0)$,
	ISOFF(U)=(.U EQL 0)$,

	SETINTERNAL=(RTNLVL_-1)$,
	SETISEXIT=(RTNLVL_ISEXIT)$,
	OUTFLAG=(CASE .RTNLVL OF SET OUTS('B:'); OUTS('A:') TES)$,

	STOPIT=
	    BEGIN
	    SETON(ENABFLG);
	    IF ISON(TRACEFLG) THEN INCRTOG;
	    LPTOFF(); GOFLG_2
	    END$;


! DECLARATIONS FOR UUO ENTRY TO SIX12
! -----------------------------------

BIND	DEBUGUUO=#037,
	TBLPOS=24,
	EXITPOS=23,
	SETUWP=#36;

MACRO	TBLBIT=BITFLD(TBLPOS)$,
	EXITBIT=BITFLD(EXITPOS)$,

	ISINTBL=.?.JBUUO<TBLBIT>$,
	ISEXIT=.?.JBUUO<EXITBIT>$,

	CHKUWP(ACTION)=
	    BEGIN
	    REGISTER RUWP;
	    RUWP_0; CALLI(RUWP,SETUWP); RUWP_1;
	    (ACTION);
	    CALLI(RUWP,SETUWP); RUWP_0
	    END$;

FORWARD	ERROR;


! TTY AND LPT I/O SUPPORT
! -----------------------

! ITEMS BEGINNING WITH 'TT' ALWAYS WRITE TO THE TTY. OTHERS
! WRITE EITHER TO TTY OR LPT-FILE, OR BOTH, DEPENDING ON STATE OF
! SWITCH 'LPTFLG'  (SET BY LPTON, LPTDUP, AND LPTOFF). ROUTINES
! OPENLPT AND CLOSELPT MUST BE CALLED BEFORE AND AFTER ONE
! COMPLETE SET OF LPT OUTPUT. SEE SIX12.MAN.

BIND	CRLFSTR=PLIT ASCIZ '?M?J',		! STRING FOR CRLF MACRO
	VALSTR=PLIT ASCIZ '?IValue: ';		! FOR OUTVALUE

MACRO 	INC=(TTCALL(4,VREG); .VREG)$,
	TTOUTC(Z)=(VREG_(Z); TTCALL(1,VREG))$,
	OUTS(Z)=OUTSA(PLIT ASCIZ Z)$,
	TTOUTS(Z)=TTCALL(3,PLIT ASCIZ Z)$,
	OUTM(C,N)=(DECR QQ FROM (N)-1 TO 0 DO OUTC(C))$,
	TTOUTM(C,N)=(DECR QQ FROM (N)-1 TO 0 DO TTOUTC(C))$,
	CRLF=OUTSA(CRLFSTR)$,
	TTCRLF=TTCALL(3,CRLFSTR)$,
	TAB=OUTC(#11)$,
	OUTDEFAULT(Z)=OUTN((Z),.IOBASE,1)$,
	OUTRDEF(Z,R)=OUTN((Z),.IOBASE,(R))$,
	OUTD(Z)=OUTN((Z),10,1)$,
	OUTDR(Z,N)=OUTN((Z),10,(N))$,
	OUTVALUE=(OUTSA(VALSTR); OUTDEFAULT(.SIXVREG); TAB;
			PRDISP(.SIXVREG); CRLF)$;


! SUPPORT OF LPT AND SAVE/LOAD I/O
! --------------------------------

BIND	SLCHN=#16,
	LPTCHN=#17;

MACRO	LPTCNT=LPTHDR[2]$,
	LPTPTR=LPTHDR[1]$,
	DSKCNT=DSKHDR[2]$,
	DSKPTR=DSKHDR[1]$,
	STATUS=BLOCK[0]$,
	LDEV=BLOCK[1]$,
	BUFW=BLOCK[2]$,
	FNAME=BLOCK[0]$,
	FEXT=BLOCK[1]$,
	JUNK=BLOCK[2]$,
	PPN=BLOCK[3]$;

ROUTINE OPENLPT=
    BEGIN
    LOCAL SAVFF,BLOCK[4];
    STATUS_1;
    LDEV_SIXBIT 'LPT';
    BUFW_LPTHDR<ADR>^18;
    IFSKIP OPEN(LPTCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);
    FNAME_SIXBIT 'SIX12';
    FEXT_SIXBIT 'LPT';
    JUNK_0;
    PPN_0;
    IFSKIP ENTER(LPTCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);
    SAVFF_.?.JBFF;
    ?.JBFF_LPTBUF<ADR>;
    OUTBUF(LPTCHN,1);
    ?.JBFF_.SAVFF;
    OUT(LPTCHN,0);
    VREG_0
    END;

ROUTINE OUTC(CHAR)=
    BEGIN
    IF .LPTFLG GEQ 0 THEN TTCALL(1,CHAR);
    IF .LPTFLG NEQ 0 THEN
	BEGIN
	IF (LPTCNT_.LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
	REPLACEI(LPTPTR,.CHAR)
	END;
    .VREG
    END;

ROUTINE OUTSA(STR)=
    BEGIN
    IF .LPTFLG GEQ 0 THEN TTCALL(3,STR,0,1);
    IF .LPTFLG NEQ 0 THEN
	BEGIN
	REGISTER PTR,C;
	PTR_(.STR)<36,7>;
	WHILE (C_SCANI(PTR)) NEQ 0 DO
	    (IF (LPTCNT_.LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
	     REPLACEI(LPTPTR,.C))
	END;
    .VREG
    END;

ROUTINE INWORD=
    BEGIN
    IF ISON(ERRORFLG) THEN RETURN -1;
    IF (DSKCNT_.DSKCNT-1) LEQ 0 THEN
	IFSKIP IN(SLCHN,0) THEN (SETON(ERRORFLG); RETURN -1);
    SCANI(DSKPTR)
    END;

ROUTINE OUTWORD(WORD)=
    BEGIN
    IF ISON(ERRORFLG) THEN RETURN .VREG;
    IF (DSKCNT_.DSKCNT-1) LEQ 0 THEN
	IFSKIP OUT(SLCHN,0) THEN (SETON(ERRORFLG); RETURN .VREG);
    REPLACEI(DSKPTR,.WORD);
    .VREG
    END;

ROUTINE CLOSELPT=
    BEGIN
    LPTFLG_0;
    CLOSE(LPTCHN,0);
    RELEASE(LPTCHN,0);
    .VREG
    END;

ROUTINE LPTON= (LPTFLG_-1; .VREG);
ROUTINE LPTDUP= (LPTFLG_1; .VREG);
ROUTINE LPTOFF= (LPTFLG_0; .VREG);



! GENERAL PURPOSE NUMBER OUTPUT ROUTINE
! -------------------------------------

ROUTINE OUTN(N,B,RD)=
    BEGIN OWN NUM,NUMNP,BASE,REQD,COUNT;
    ROUTINE XN=
	BEGIN REGISTER R;
	IF .NUM EQL 0 THEN RETURN
	    (OUTM(" ",.REQD-.COUNT); IF ISON(NUMNP) THEN OUTC("-"); .VREG);
	R_.NUM MOD .BASE; NUM_.NUM/.BASE; COUNT_.COUNT+1; XN(); OUTC(R_.R+"0")
	END;
    NUMNP_ COUNT_ (.N LSS 0);
    BASE_.B; REQD_.RD;
    IF (NUM _ ABS(.N) AND NOT 1^35) NEQ 0 THEN RETURN XN();
    OUTM(" ",.REQD-1-.NUMNP); IF .NUMNP NEQ 0 THEN OUTC("-"); OUTC("0");
    .VREG
    END;



MACRO	PAGE=SWITCHES LIST;$;
PAGE!	INTERACTIVE DEBUGGING INTERFACE AND SUPPORT
!	-------------------------------------------


ROUTINE SDDTFA(X)=
    ! GIVEN A SYMBOL, SEARCH DDT SYMBOL-TABLE FOR ITS VALUE
    BEGIN REGISTER R;
    HLRE(R,?.JBSYM); R_ -.R; R_ .R^18 + .R + .?.JBSYM<RH>;
    WHILE (R_.R-#2000002) GEQ 0 DO
	IF .(.R)<0,32> EQL .X THEN RETURN @(.R+1);
    ERROR(0)
    END;

ROUTINE NSDDTFA(X,V)=
    ! GIVEN A SYMBOL SEARCH FOR THE ADDRESS OF ITS NEXT OCCURRENCE
    BEGIN REGISTER R;
    R_.V;
    WHILE (R_.R-#2000002) GEQ 0 DO
	IF .(.R)<0,32> EQL .X THEN RETURN .R;
    0
    END;

ROUTINE SDDTFS(X)=
    ! GIVEN AN ADDRESS, SEARCH TABLE FOR THE SYMBOL MOST NEARLY MATCHING IT
    BEGIN REGISTER R,N;
    N_ PLIT(0,0)[1]<ADR>; HLRE(R,?.JBSYM); R_ NOT .R;	! -.R -1
    R_ .R^18 + .R + .?.JBSYM<RH>;
    WHILE (R_.R-#2000002) GEQ 0 DO
	(IF @@R LEQ .X THEN
	    IF @@R GTR @@N THEN
		IF @(@R-1) GEQ 0 THEN N_.R<RH>);
    .N-1
    END;

ROUTINE MODDDT(X)=
    ! GIVEN A START ADDRESS X (IN TABLE) FIND MODULE NAME
    BEGIN REGISTER R;
    R_ .X + (.?.JBSYM<LH>^18);
    WHILE (R_.R+#2000002) LSS 0 DO
	IF .(.R)<32,2> EQL 0 THEN RETURN @@R;
    @(.R-2)
    END;

MACRO F50TO7(X)=
    ! CONVERT BASE 50 CHARACTER TO ASCII CHARACTER
    (IF (X) EQL 0 THEN 0 ELSE
    IF (X) LEQ #12 THEN (X)+#57 ELSE
    IF (X) LEQ #44 THEN (X)+#66 ELSE
    IF (X) EQL #45 THEN #56 ELSE (X)-2)$;

MACRO F7TO50(X)=
    ! CONVERT ASCII CHARACTER TO BASE 50 CHARACTER
    (IF (X) EQL 0 THEN 0 ELSE
    IF (X) EQL #56 THEN #45 ELSE
    IF (X) LEQ #45 THEN (X)+2 ELSE
    IF (X) LEQ #71 THEN (X)-#57 ELSE
    IF (X) LEQ #132 THEN (X)-#66 ELSE (X)-#126)$;

ROUTINE PRSYM50(X)=
    ! PRINT NAME GIVEN IN BASE 50
    BEGIN LOCAL R;
    IF (X_.X AND #37777777777) NEQ 0 THEN
	(R_.X MOD #50; PRSYM50(.X /#50); OUTC(F50TO7(.R)));
    .VREG
    END;

ROUTINE PRDISP(X)=
    ! PRINT BOTH HALVES OF .X IN "BASE+DISP" FORM
    BEGIN LOCAL Z,M,L;
    DECR I FROM 1 TO 0 DO
	BEGIN BIND DUMMY=0;
	Z_ IF .I THEN .X<LH> ELSE .X<RH>;
	IF .Z LSS DDTEND<ADR>  THEN
		(IF .I THEN IF .Z EQL 0 THEN EXITBLOCK; OUTDEFAULT(.Z))
		ELSE
		    BEGIN
		    L_SDDTFS(.Z);  M_.Z-@(.L+1);
		    IF (.WDBASE GEQ 0) AND (.M GTR .WDBASE) THEN OUTDEFAULT(.Z)
			ELSE
			BEGIN
			PRSYM50(@@L);
			IF .M NEQ 0 THEN (OUTC("+"); OUTDEFAULT(.M))
			END;
		    END;
	IF .I THEN OUTS(',,');
	END;
    .VREG
    END;

ROUTINE PRXDISP(X)=
    ! PRINT ONLY BASE OF .X<RH>
    PRSYM50( @SDDTFS( .X<RH>));

ROUTINE PRG(B,T)=
    ! PRINT A CONT. SET OF WORDS FOR STACK DISPLAY
    INCR I FROM 1 TO .T DO
	BEGIN 
	OUTDEFAULT(.I); OUTS(': '); PRDISP(@(.B+.I-1));
	IF .I LSS .T THEN   IF .I OR (.I AND 2 AND .LPTFLG) NEQ 0
		THEN OUTS('    ') ELSE OUTS('?M?J?I?I');
	END;

ROUTINE PRCALL(F,CALLED)=
    ! PRINT A SINGLE ROUTINE CALL WITH ITS PARMS
    BEGIN LOCAL NP,CALLER;
    IF (CALLER _ .(.F-1)<RH>-1) LEQ 0 THEN RETURN 0;
    NP_IF .(@(.F-1))<LH> NEQ (#274^9 OR SREG<ADR>^5) THEN 0
	ELSE .(@@(.F-1))<RH>;
    PRXDISP(.CALLED); TAB; OUTC(#50); OUTC("_");
    PRDISP(.CALLER); OUTC(#51); TAB;
    PRG( .F<RH>-1-.NP , .NP);
    .NP^18 + .CALLER
    END;

ROUTINE PSTK(FBACK,TOG,LEVEL)=
    ! DISPLAY CALL STACK TO LEVEL "LEVEL", "TOG" CONTROLS LOCALS DISPLAY
    BEGIN LOCAL F,NAME,NL;
    IF (F_.(@@FBACK-1)<RH> -1) LSS 0 THEN RETURN .VREG;
    NAME_ .(.F)<RH>; F_@@FBACK;
    NL _ IF .RTNLVL LSS 0 THEN .FBACK - .F -3  ELSE 0;
    DO
	BEGIN
	IF (NAME _ PRCALL(.F,.NAME)) EQL 0 THEN RETURN .VREG;
	IF .TOG THEN IF .NL GTR 0 THEN		! PRINT LOCALS
	    (OUTS('?M?J?I?I'); PRG( .F+1, .NL));
	CRLF;
	NL_ .F - @@F - .NAME<LH> -2;
	IF NOT (  ( .(.F)<RH> LSS .F<RH>) AND
	    ( .(.F)<RH> GTR .BREG)  ) THEN RETURN .VREG;
	F_@@F
	END		UNTIL (LEVEL_.LEVEL-1) LEQ 0;
    .VREG
    END;
PAGE!		DEBUG INTEREST ROUTINES
!		-----------------------

!	THE TABLE ROUTS CONTAINS INFORMATION ABOUT EACH ROUTINE
!	IN WHICH THE DEBUG SYSTEM IS 'INTERESTED'.  THE VARIABLE
!	NROUTS (INITIALIZED TO -1) CONTAINS THE INDEX OF THE LAST
!	VALID ENTRY IN ROUTS.  THE STRUCTURE OF EACH ENTRY IN ROUTS
!	IS
!		!------------------+------------------!
!		! INTEREST BITS    !  ROUTINE ADDRESS !
!		!------------------+------------------!
!		! POINTERS TO      ! CONDITIONAL      !
!		!------------------+------------------!
!		! MACRO		   ! TEXTS	      !
!		!------------------+------------------!
!		!		   !		      !
!		!------------------+------------------!
!
!	(A ZERO MACRO POINTER DENOTES UNCONDITIONAL ACTION.)
!	TWO VALUES ARE ASSOCIATED WITH EACH BIT IN THE INTEREST BITS
!	FIELD.  IF BIT (35-N) INDICATES AN ABC TYPE INTEREST, THEN
!	ABCF IS A MACRO FOR THE BIT POSITION IN THE ENTRY, I.E. 0,N,1.
!	ABCV IS A CONSTANT WITH A 1 IN THE CORRESPONDING BIT, I.E. 1^N.
!
!	THE ROUTINE SETBIT(VAL) DOES THE FOLLOWING FOR EACH ROUTINE IN @SIXRP:
!		1) INSERT THE ROUTINE INTO ROUTS IF IT IS NOT ALREADY THERE.
!		2) TURN ON THE INTEREST BITS INDICATED BY VAL.
!		3) PUT IN CONDITIONAL MACRO POINTERS AS REQUIRED.
!
!	THE ROUTINE UNSETBIT(VAL) DOES THE FOLLOWING FOR EACH ROUTINE IN @SIXRP:
!		1) TURN OFF THE INTEREST BITS INDICATED BY VAL.
!		2) FIX UP FLAGS IF ACTIVE TRACE OR OPAQUE IS BEING DELETED.
!		3) IF THE INTEREST BIT FIELD OF ANY ENTRY BECOMES
!		   ZERO, REMOVE THAT ENTRY FROM ROUTS.


MACRO	BREAKF=0,BITFLD(18)$,		ABREAKF=0,BITFLD(19)$,
	OPQATF=0,BITFLD(20)$,		OPQAFTF=0,BITFLD(21)$,
	TRCATF=0,BITFLD(22)$,		TRCAFTF=0,BITFLD(23)$,

	PREVOFFF=0,BITFLD(33)$,		IDIDONF=0,BITFLD(34)$,
	IDIDOFFF=0,BITFLD(35)$;

BIND	BREAKV=BITVAL(18),		ABREAKV=BITVAL(19),
	OPQATV=BITVAL(20),		OPQAFTV=BITVAL(21),
	TRCATV=BITVAL(22),		TRCAFTV=BITVAL(23),

	MAXACTRTN=23,

	PREVOFFV=BITVAL(33),		IDIDONV=BITVAL(34),
	IDIDOFFV=BITVAL(35);

ROUTINE CFINDR(R)=		! CONDITIONAL FIND
    ! RETURN THE INDEX OF ROUTINE R IN ROUTS.  -1 IF NOT FOUND
    DECR I FROM .NROUTS TO 0 DO
	IF .ROUTS[.I,0,RH] EQL .R<RH> THEN RETURN .I;

ROUTINE CINSERT(R)=		! CONDITIONAL INSERT
    ! RETURN THE INDEX OF R IN ROUTS. INSERT IF NECESSARY
    BEGIN   LOCAL L;
    IF (L_CFINDR(.R)) GEQ 0 THEN RETURN .L;
    ROUTS[(NROUTS_.NROUTS+1),0,FW]_.R<RH>;
    .NROUTS
    END;

ROUTINE CREMOVE(R,VAL)=		! CONDITIONAL REMOVE
    ! TURN OFF BITS SPECIFIED BY VAL IN THE ENTRY FOR R. DELETE R IF POSSIBLE.
    BEGIN   LOCAL L;
    IF (L_CFINDR(.R)) LSS 0 THEN RETURN .VREG;
    IF (VAL _ .ROUTS[.L,0,FW] AND .VAL) EQL 0 THEN RETURN .VREG;
    IF (.VAL AND OPQAFTV) NEQ 0 THEN IF .ROUTS[.L,IDIDOFFF] THEN
	(OPQCNT_0; TRACEFLG_-.ROUTS[.L,PREVOFFF]; ROUTS[.L,0,FW]_.ROUTS[.L,0,FW] AND NOT (IDIDOFFV+PREVOFFV));
    IF (.VAL AND TRCAFTV) NEQ 0 THEN IF .ROUTS[.L,IDIDONF] THEN
	(TRCCNT _ TRACEFLG _ ROUTS[.L,IDIDONF] _ 0);
    ROUTS[.L,0,FW] _ .ROUTS[.L,0,FW] AND NOT .VAL;
    WHILE .VAL NEQ 0 DO (INCRTOG; VAL_ .VAL AND NOT (1^35)^(-FIRSTONE(.VAL)));
    IF .ROUTS[.L,0,LH] NEQ 0 THEN RETURN .VREG;
    IF .L LSS .NROUTS THEN   DECR J FROM ROUTSIZE-1 TO 0 DO
				ROUTS[.L,.J,FW] _ .ROUTS[.NROUTS,.J,FW];
    NROUTS_ .NROUTS -1; .VREG
    END;

ROUTINE SETTBLBIT(ROUTN,ISITEXIT)=
    BEGIN   REGISTER PNTR;
    BIND BITS = #777000777777 OR 1^EXITPOS,
	 MATCH = DEBUGUUO^27 OR .ISITEXIT^EXITPOS OR .ROUTN,
	 CORELIM = IF .ROUTN LSS #400000 THEN .?.JBREL<RH> ELSE .?.JBHRL<RH>;
    PNTR _ INCR J FROM .ROUTN TO CORELIM DO
		IF (@@J AND BITS) EQL MATCH THEN EXITLOOP .J;
    IF .PNTR LSS 0	THEN (PRDISP(.ROUTN); ERROR(6))
			ELSE CHKUWP( (.PNTR)<TBLBIT> _ 1 );
    .VREG
    END;

ROUTINE SETBIT(VAL,FBEGIN,FEND)=
    BEGIN   REGISTER L; LOCAL FIELD,BIT;
    IF .SIXLC EQL 0 THEN SIXLP _ PLIT(0)<ADR>;
    WHILE .VAL NEQ 0 DO
	BEGIN
	FIELD _ 17 - FIRSTONE(.VAL); BIT _ (1^18) ^ .FIELD; VAL _ .VAL AND NOT .BIT;
	FIELD _ IF .FIELD THEN ROUTS[0,1+.FIELD^(-1),LH]
		ELSE ROUTS[0,1+.FIELD^(-1),RH];
	DECR I FROM .SIXRC-1 TO 0 DO
	    BEGIN
	    L_CINSERT(@(.SIXRP+.I));
	    IF (.ROUTS[.L,0,FW] AND .BIT) EQL 0 THEN DECRTOG;
	    ROUTS[.L,0,FW]_ .ROUTS[.L,0,FW] OR .BIT;
	    (.FIELD + .L*ROUTSIZE) _ @@SIXLP;
	    IF .FBEGIN NEQ 0 THEN SETTBLBIT(.(.SIXRP+.I)<RH>,0);
	    IF .FEND NEQ 0 THEN SETTBLBIT(.(.SIXRP+.I)<RH>,1);
	    END;
	END;
    .VREG
    END;

ROUTINE UNSETBIT(VAL)=
	DECR I FROM .SIXRC-1 TO 0 DO
		CREMOVE(@(.SIXRP+.I),.VAL);


ROUTINE XBREAK=SETBIT(BREAKV,1,0);

ROUTINE DBREAK=UNSETBIT(BREAKV);

ROUTINE XABREAK=SETBIT(ABREAKV,0,1);

ROUTINE DABREAK=UNSETBIT(ABREAKV);

ROUTINE OPAQUE=
	SETBIT(OPQAFTV+(IF .MODEFLG NEQ 1 THEN OPQATV),1,1);

ROUTINE DOPAQUE=
	UNSETBIT(OPQAFTV+(IF .MODEFLG NEQ 1 THEN OPQATV));

ROUTINE XTRACE=
	SETBIT((CASE .MODEFLG OF
		SET TRCATV; TRCAFTV; TRCAFTV+TRCATV TES),1,1);

ROUTINE DTRACE=
	UNSETBIT(CASE .MODEFLG OF
		SET TRCATV; TRCAFTV; TRCAFTV+TRCATV TES);
PAGE!		MONITORING OF VARIABLES
!		-----------------------

! THE MONITORING ROUTINES USE ANOTHER TABLE WITH TWO-WORD ENTRIES,
! FORMATTED
!
!	!---------------!---------------!
!	!		LOCATION	!
!	!---------------!---------------!
!	!		VALUE		!
!	!---------------!---------------!
!
! WHERE LOCATION IS A *POINTER* TO THE BYTE BEING MONITORED
! (I.E. IT HAS A POSITION, SIZE FIELD),  AND VALUE IS THE
! BYTE'S LAST REPORTED CONTENTS.


MACRO	ADDRESS=0,FW$,
	OLDVAL=1,FW$;

ROUTINE CKVALS(RTN,TOG)=
    BEGIN
    LOCAL X,T;
    DECR I FROM .NVALS TO 0 DO
	BEGIN
	X_.(.MONVALS[.I,ADDRESS]);
	IF .X NEQ .MONVALS[.I,OLDVAL]  THEN
		BEGIN
		IF .TOG GEQ 0  THEN
			BEGIN
			OUTS('*** ');
			IF .TOG THEN OUTS('During ')
				ELSE OUTS('Before ');
			TOG_ -1;
			PRXDISP(.RTN);
			CRLF;
			END;
		PRDISP(.MONVALS[.I,0,RH]);
		IF (T_.MONVALS[.I,0,LH]) NEQ #4400 THEN
		    BEGIN	! OUTPUT <P,S>
		    OUTC(#74); OUTD(.T<12,6>);
		    OUTC(","); OUTD(.T<6,6>);
		    OUTC(#76)
		    END;
		TAB;
		OUTS('Old: ');
		OUTDEFAULT(.MONVALS[.I,OLDVAL]);
		TAB;
		OUTS('New: ');
		OUTDEFAULT(.X);
		CRLF;
		MONVALS[.I,OLDVAL]_.X;
		END;
	END;
    IF .TOG LSS 0 THEN STOPIT; .VREG
    END;

ROUTINE XCHNG=
    DECR I FROM .SIXRC-1 TO 0  DO
	BEGIN BIND DUMMY=0;
	IF .(.SIXRP+.I)<LH> EQL 0 THEN
	    (.SIXRP+.I)<LH> _ #004400;	! INSERT <FW>
	DECR J FROM .NVALS TO 0 DO IF .MONVALS[.J,ADDRESS] EQL @(.SIXRP+.I) THEN EXITBLOCK;
	DECRTOG;
	NVALS_.NVALS+1;
	MONVALS[.NVALS,ADDRESS]_@(.SIXRP+.I);
	MONVALS[.NVALS,OLDVAL]_.@(.SIXRP+.I);
	END;

ROUTINE DCHNG=
    BEGIN
    LOCAL L;
    DECR I FROM .SIXRC-1 TO 0 DO
	BEGIN BIND DUMMY=0;
	IF .(.SIXRP+.I)<LH> EQL 0 THEN
	    (.SIXRP+.I)<LH> _ #004400;	! INSERT <FW>
	L_DECR J FROM .NVALS TO 0 DO IF .MONVALS[.J,ADDRESS] EQL @(.SIXRP+.I) THEN EXITLOOP .J;
	IF .L LSS 0 THEN EXITBLOCK;
	INCRTOG;
	IF .L LSS .NVALS THEN
	    BEGIN
	    MONVALS[.L,ADDRESS]_.MONVALS[.NVALS,ADDRESS];
	    MONVALS[.L,OLDVAL]_.MONVALS[.NVALS,OLDVAL];
	    END;
	NVALS_.NVALS-1;
	END;
    .VREG
    END;
PAGE!		THE DEBUG PROCESSING ROUTINES
!		-----------------------------

ROUTINE DOTVREG=.VREG;

ROUTINE EDDT=(?.JBOPC _ DOTVREG<ADR>; JRST(0,@?.JBDDT); .VREG);

ROUTINE SLASH(N)=
    BEGIN REGISTER A;
    A_.(@SIXLP)<RH>; N_IF .N EQL 3 THEN @@SIXRP -1 ELSE 0;
    DECR I FROM .N TO 0 DO
	BEGIN
	PRDISP(.A); OUTS('/'); TAB; OUTRDEF(@@A,14);
	TAB; PRDISP(@@A); CRLF; A_.A+1
	END;
    .VREG
    END;

ROUTINE GOER=(IF ISON(TRACEFLG) THEN DECRTOG; GOFLG_1; .VREG);

ROUTINE DISAB=(SETOFF(ENABFLG); .VREG);

ROUTINE XSTRACE=
    BEGIN
    IF .OPQCNT GTR 0 THEN
	(OPQCNT_0;
	 DECR J FROM .NROUTS TO 0 DO ROUTS[.J,0,FW] _ .ROUTS[.J,0,FW] AND NOT (IDIDOFFV+PREVOFFV));
    SETON(TRACEFLG); .VREG
    END;

ROUTINE XCLRTRACE=(SETOFF(TRACEFLG); .VREG);

ROUTINE XGOTRACE=(XSTRACE(); GOER());

ROUTINE NOSIX12=(?.JB41_ #255^27; GOER());

ROUTINE SETIT=
    BEGIN
    IF .(@SIXLP)<LH> EQL 0 THEN        		! ADD P,S = <FW>
	(@SIXLP)<LH> _ #004400;
    @@SIXLP _ @@SIXRP; .VREG
    END;

ROUTINE XBASE(K)=
    BEGIN		! SET IOBASE
    IF .K THEN
	IF ((@@SIXRP LSS 2) OR (@@SIXRP GTR 10))
	    THEN  RETURN ERROR(5)
	    ELSE  (IOBASE _ @@SIXRP);
    OUTD(.IOBASE); OUTS(' dec.?M?J'); .VREG
    END;

ROUTINE XWBASE(K)=
    BEGIN		! SET WDBASE
    IF .K THEN WDBASE _ @@SIXRP;
    OUTDEFAULT(.WDBASE); CRLF; .VREG
    END;

ROUTINE CALL1=(OUTFLAG; PSTK( .ENTERPNT, 0, (-1)^(-1) ));

ROUTINE CALL2=(OUTFLAG; PSTK( .ENTERPNT, 1, (-1)^(-1) ));

ROUTINE XCALL(K)=(OUTFLAG; PSTK( .ENTERPNT, 0, (IF .K THEN @@SIXRP ELSE 1) ));

ROUTINE XLCALL(K)=(OUTFLAG; PSTK( .ENTERPNT, 1, (IF .K THEN @@SIXRP ELSE 1) ));

ROUTINE PPSYM(P)=		! COMMON CODE FOR PRS, SEARCH
    BEGIN
    IF @@P LSS 0 THEN OUTC("*"); TAB; OUTRDEF(@(.P+1),12); TAB;
    IF   ( CASE .(.P)<32,2> OF
	SET
	(OUTS('Module'); 0);
	(OUTS('Global'); 1);
	(OUTS('Own');    1);
	TES )	THEN	(TAB; PRSYM50(MODDDT(.P)));
    CRLF; .VREG
    END;

ROUTINE PRS=
    BEGIN  LOCAL NAME,V; REGISTER P;
    HLRE(P,?.JBSYM); P_ -.P; V_ .P^18 + .P + .?.JBSYM<RH>;
    INCR I FROM 0 TO .SIXRC-1 DO
	BEGIN
	P_ .V; NAME_ .(SDDTFS( @(.SIXRP+.I)))<0,32>;
	INCR J FROM 1 DO
	    BEGIN
	    IF (P_NSDDTFA(.NAME,.P)) EQL 0 THEN EXITLOOP;
	    PRSYM50(.NAME); OUTC("%"); OUTDEFAULT(.J); PPSYM(.P)
	    END;
	END;
    .VREG
    END;

ROUTINE XSEARCH=		! ? SEARCH FEATURE
    BEGIN LOCAL NAME[6],TNAME[6],R50NAME,CNT,TCNT; REGISTER P;
    CNT_-1; TCNT_(.SIXRP)<36,7>; (.SIXRP+.SIXRC)<FW> _ 0;	! MAKE ASCIZ STRING
    WHILE (P_SCANI(TCNT)) NEQ 0 DO
	IF .CNT LSS 5 THEN NAME[(CNT_.CNT+1)]_ (IF .P EQL "??" THEN 0 ELSE F7TO50(.P));
    HLRE(P,?.JBSYM); P_ -.P; P_ .P^18 + .P + .?.JBSYM<RH>;
    WHILE (P_.P-#2000002) GEQ 0 DO
	BEGIN BIND DUMMY=0;
	R50NAME_ .(.P)<0,32>;
	TCNT_ DECR X FROM 5 TO 0 DO
	    (TNAME[.X]_ .R50NAME MOD #50;
	     IF (R50NAME_.R50NAME / #50) EQL 0 THEN EXITLOOP .X);
	IF 5-.TCNT GTR .CNT THEN EXITBLOCK;
	INCR X FROM 0 TO .CNT DO
	    (IF .NAME[.X] NEQ 0 THEN
		IF .NAME[.X] NEQ .TNAME[.TCNT] THEN EXITBLOCK;
	     TCNT_.TCNT+1);
	PRSYM50(@@P); PPSYM(.P)
	END;
    .VREG
    END;

ROUTINE XRETURN=
    BEGIN
    IF .RTNLVL EQL 0 THEN		! FIX UP ENTRY...
	BEGIN  REGISTER L;
	MACRO	POPADR=(.ENTERPNT-1)<RH>$;
	BIND	BITS = #777000777777 OR 1^EXITPOS,
		CORELIM = IF .POPADR LSS #400000 THEN .?.JBREL<RH> ELSE .?.JBHRL<RH>;
	L_ DEBUGUUO^27 OR 1^EXITPOS OR .?.JBUUO<RH>;
	L_ INCR J FROM .POPADR TO CORELIM DO
		IF (@@J AND BITS) EQL .L THEN EXITLOOP .J+1;
	IF .L LEQ 0	THEN (PRXDISP(.POPADR); RETURN ERROR(6))
			ELSE POPADR _ .L;
	END;
    SIXVREG_ @@SIXRP; GOER()
    END;

ROUTINE XDEL2=
    BEGIN
    LOCAL PNT;
    DECR J FROM .SIXRC-1 TO 0 DO
	BEGIN
	PNT _ DECR K FROM .NNAMES TO 0 DO
	    IF @(.SIXRP+.J) EQL .SIXNAMES[.K,0,FW] THEN EXITLOOP .K;
	IF .PNT GEQ 0 THEN 
	    (IF .PNT LSS .NNAMES THEN
		(SIXNAMES[.PNT,0,FW] _ .SIXNAMES[.NNAMES,0,FW];
		 SIXNAMES[.PNT,1,FW] _ .SIXNAMES[.NNAMES,1,FW]);
	     NNAMES_.NNAMES-1)
	END;
    .VREG
    END;

FORWARD PUSHOPER;

ROUTINE XDEL1=
    BEGIN
    QUOTFLG _ (-1)^(-1);
    PUSHOPER( 4^18 + PLIT(0, 10^18+XDEL2<ADR>, 0, 0)<ADR>)
    END;

MACRO	APPLY(OP)=
		BEGIN
		SIXVC_.SIXVC+1; SIXVP_ VTEMP<ADR>;
		VTEMP _ @@SIXLP OP @@SIXRP;
		.VREG
		END$,
	ONEAPPLY(OP)=
		BEGIN
		SIXVC_.SIXVC+1; SIXVP_ VTEMP<ADR>;
		VTEMP _ OP @@SIXRP;
		.VREG
		END$;

ROUTINE XADD=APPLY(+);

ROUTINE SUBTRACT(K)=IF .K LSS 2 THEN ONEAPPLY(-) ELSE APPLY(-);

ROUTINE TIMES=APPLY(*);

ROUTINE XDIV=APPLY(/);

ROUTINE XSHIFT=APPLY(^);

ROUTINE ATSIGN=ONEAPPLY(@);

ROUTINE XEQL=APPLY(EQL);
ROUTINE XNEQ=APPLY(NEQ);
ROUTINE XLSS=APPLY(LSS);
ROUTINE XLEQ=APPLY(LEQ);
ROUTINE XGTR=APPLY(GTR);
ROUTINE XGEQ=APPLY(GEQ);

ROUTINE XAND=APPLY(AND);
ROUTINE XEQOR=APPLY(OR);
ROUTINE XNOT=ONEAPPLY(NOT);

ROUTINE CONTENTS=(SIXVC_1; SIXVP_ VTEMP<ADR>;
	VTEMP _ IF .(.SIXRP)<LH> EQL 0 THEN @@@SIXRP ELSE .(@@SIXRP);  .VREG);

ROUTINE DOLSIGN=
    BEGIN  OWN DOLLAR[20];
    SIXVC_1; SIXVP_ VTEMP<ADR>;
    VTEMP_ DOLLAR[@@SIXRP]; .VREG
    END;

ROUTINE JOIN=			! BINARY COMMA (CATENATION)
    BEGIN
    INCR J FROM 0 TO .SIXRC-1 DO  (.SIXLP+.SIXLC +.J)<FW> _ @(.SIXRP+.J);
    SIXVP_.SIXLP; SIXVC_ .SIXLC + .SIXRC; .VREG
    END;

ROUTINE LPAREN=			! ROUTINE CALL
    BEGIN  LOCAL SCOUNT,SAVEGO; OWN COUNT;
    SCOUNT_.COUNT; SAVEGO_.GOFLG; GOFLG_1;	! DON'T STOP IN ROUTINE
    COUNT _ .SIXRC^18 + .SIXRC;			! SAVE # OF PARMS
    INCR I FROM 0 TO .SIXRC-1 DO		! PUSH PARMS
	PUSH(SREG,(.SIXRP+.I));
    (@@SIXLP) ();	 			! THIS IS IT!
    SREG _ .SREG - .COUNT;			! POP PARMS
    VTEMP _ .VREG;
    GOFLG_.SAVEGO; COUNT_.SCOUNT; SIXVC _ 1; SIXVP _ VTEMP<ADR>; .VREG
    END;

ROUTINE FIELDSPEC=		! ADR <POS , SIZE>
    BEGIN  REGISTER R;
    IF .SIXRC NEQ 2 THEN RETURN ERROR(3);
    R _ #77 AND @@SIXRP;	! P FIELD
    R _ ( (.R^6) OR (#77 AND @(.SIXRP +1)) ) ^6;	! S FIELD
    SIXVP_ .SIXLP; SIXVC_1;
    (.SIXVP)<LH> _ .R;
    .VREG
    END;

ROUTINE STRUCT=
    BEGIN
    IF .SIXRC NEQ 1 THEN RETURN ERROR(3);
    SIXVP _ VTEMP<ADR>; SIXVC _ 1;
    VTEMP _ (@@SIXLP + @@SIXRP)<0,36>;
    .VREG
    END;

ROUTINE INTEXT=
    BEGIN
    REGISTER W;
    WHILE ISOFF(ERRORFLG) DO
	BEGIN
	IF (W_INWORD()) EQL 0 THEN RETURN .VREG;
	(.PTEXT)<FW> _ .W; PTEXT _ .PTEXT+1
	END;
    .VREG
    END;

ROUTINE OUTTEXT(POINT)=
    BEGIN
    INCR PTR FROM .POINT<RH> DO
	BEGIN
	OUTWORD(@@PTR);
	IF .(.PTR)<29,7> EQL #177 THEN EXITLOOP;
	IF .(.PTR)<22,7> EQL #177 THEN EXITLOOP;
	IF .(.PTR)<15,7> EQL #177 THEN EXITLOOP;
	IF .(.PTR)<8,7> EQL #177 THEN EXITLOOP;
	IF .(.PTR)<1,7> EQL #177 THEN EXITLOOP;
	END;
    OUTWORD(0)
    END;

ROUTINE FILEOPEN(ISINPUT)=
    BEGIN
    LOCAL BLOCK[4],TPPNBUF[2],BP,PTR;
    REGISTER I,C;
    MACRO ASCIITOSIX(C)=(((C)-#40) AND #77)$,
	  TPPN=I$;
    ROUTINE CMUDEC(PTR)=
	BEGIN
	VREG _ .PTR<RH>;
	CALLI(VREG,-2); VREG_0;
	.VREG
	END;
    ROUTINE XTYP=
	BEGIN
	IF .C EQL 0 THEN RETURN 0;
	IF .C EQL " " THEN RETURN 1;
	IF .C EQL "." THEN RETURN 2;
	IF .C EQL "[" THEN RETURN 3;
	IF .C GEQ "A" THEN IF .C LEQ "Z" THEN RETURN 4;
	IF .C GEQ "a" THEN IF .C LEQ "z" THEN (C_.C-#40; RETURN 4);
	IF .C GEQ "0" THEN IF .C LEQ "9" THEN RETURN 4;
	5
	END;

    STATUS _ #10;
    LDEV _ SIXBIT 'DSK';
    BUFW _ IF ISON(ISINPUT) THEN DSKHDR<ADR> ELSE DSKHDR<ADR>^18;
    IFSKIP OPEN(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);

	BEGIN BIND DUMMY=0;
	FNAME_FEXT_JUNK_PPN_0;
	PTR _ (.SIXRP)<36,7>;
	(.SIXRP+.SIXRC)<FW> _ 0;	! GUARANTEE ASCIZ STRING
	BP _ FNAME<36,6>;  I_6;
	WHILE 1 DO
	    BEGIN			! GET FILENAME
	    C _ SCANI(PTR);
	    CASE XTYP() OF
		SET
		%0% EXITBLOCK;
		%1% 0;
		%2% EXITLOOP;
		%3% EXITLOOP;
		%4% IF (I_.I-1) GEQ 0 THEN REPLACEI(BP,ASCIITOSIX(.C));
		%5% RETURN ERROR(9)
		TES
	    END;
	IF .C EQL "." THEN
	    BEGIN			! GET EXTENSION
	    BP _ FEXT<36,6>;  I_3;
	    WHILE 1 DO
		BEGIN
		C _ SCANI(PTR);
		CASE XTYP() OF 
		    SET
		    %0% EXITBLOCK;
		    %1% 0;
		    %2% RETURN ERROR(9);
		    %3% EXITLOOP;
		    %4% IF (I_.I-1) GEQ 0 THEN REPLACEI(BP,ASCIITOSIX(.C));
		    %5% RETURN ERROR(9)
		    TES
		END
	    END;
	IF .C EQL "[" THEN
	    BEGIN			! GET PPN
	    IF (I_.PTR; SCANI(I)) GTR "7" THEN
		BEGIN			! CMU PPN
		BP _ TPPNBUF<36,7>;
		DECR I FROM 7 TO 0 DO
		    IF COPYII(PTR,BP) EQL "]" THEN RETURN ERROR(9);
		IF SCANI(PTR) NEQ "]" THEN RETURN ERROR(9);
		IF (PPN_CMUDEC(TPPNBUF<ADR>)) EQL 0 THEN RETURN ERROR(9)
		END
	    ELSE
		BEGIN			! OCTAL PPN
		TPPN _ 0;
		WHILE (C_SCANI(PTR)) NEQ "]" DO
		    IF .C EQL "," THEN
			(PPN<LH> _ .TPPN; TPPN_0)
		    ELSE
			IF .C GEQ "0" AND .C LEQ "7"
			    THEN (TPPN_.TPPN^3 + .C - "0")
			    ELSE RETURN ERROR(9);
		PPN<RH> _ .TPPN
		END
	    END
	END;		! OF DUMMY BLOCK

    IF ISON(ISINPUT) THEN
	(IFSKIP LOOKUP(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10))
    ELSE
	(IFSKIP ENTER(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10));
    IF ISON(ISINPUT) THEN INBUF(SLCHN,2) ELSE OUTBUF(SLCHN,2);
    1
    END;


ROUTINE SIXSAVE=
    BEGIN
    LOCAL SAVFF;
    SAVFF _ .?.JBFF;
    IF NOT FILEOPEN(0) THEN RETURN .VREG;
    SETOFF(ERRORFLG);
    OUTWORD(.SIXTOG);
    OUTWORD(.DCNT);
    INCR J FROM 0 TO .NVALS DO
	BEGIN				! OUTPUT A MONITOR ENTRY
	OUTWORD(.MONVALS[.J,ADDRESS]);
	OUTWORD(.MONVALS[.J,OLDVAL])
	END;
    OUTWORD(-1);			! END OF MONITORS
    INCR J FROM 0 TO .NNAMES DO
	BEGIN				! OUTPUT A MACRO
	OUTWORD(.SIXNAMES[.J,0,FW]);
	OUTTEXT(.SIXNAMES[.J,1,FW])
	END;
    OUTWORD(-1);			! END OF MACROS
    INCR J FROM 0 TO .NROUTS DO
	BEGIN				! OUTPUT A ROUTINE ENTRY
	BIND ENTRY = .ROUTS[.J,0,0,MAXACTRTN];
	OUTWORD(ENTRY);
	DECR SUB FROM 17 TO 0 DO
	    BEGIN
	    BIND PTR = IF .SUB THEN ROUTS[.J,1+.SUB/2,LH]
			ELSE ROUTS[.J,1+.SUB/2,RH];
	    IF (ENTRY AND (1^18)^.SUB) NEQ 0 THEN
		(IF .PTR NEQ 0 THEN OUTTEXT(.PTR) ELSE OUTWORD(0))
	    END
	END;
    OUTWORD(-1);
    IF ISON(ERRORFLG) THEN (ERROR(11); CLOSE(SLCHN,#40)) ELSE CLOSE(SLCHN,0);
    RELEASE(SLCHN,0);
    ?.JBFF_.SAVFF;
    .VREG
    END;


ROUTINE SIXLOAD=
    BEGIN  REGISTER W,W2; LOCAL SAVFF;
    SAVFF_.?.JBFF;
    IF NOT FILEOPEN(1) THEN RETURN .VREG;
    SETOFF(ERRORFLG); NVALS _ NNAMES _ NROUTS _ -1; PTEXT _ TEXTAREA<36,7>;
    SIXTOG_INWORD(); DCNT_INWORD();
    WHILE (W_INWORD()) NEQ -1 DO
	BEGIN				! RETRIEVE MONITOR ENTRY
	MONVALS[(NVALS_.NVALS+1),ADDRESS] _ .W;
	MONVALS[.NVALS,OLDVAL] _ INWORD()
	END;
    WHILE (W_INWORD()) NEQ -1 DO
	BEGIN				! RETRIEVE MACRO
	SIXNAMES[(NNAMES_.NNAMES+1),0,FW]_.W;
	SIXNAMES[.NNAMES,1,FW]_.PTEXT<RH>;
	INTEXT()
	END;
    WHILE (W_INWORD()) NEQ -1 DO
	BEGIN				! RETRIEVE ROUTINE ENTRY
	ROUTS[(NROUTS_.NROUTS+1),0,FW]_.W;
	SETTBLBIT(.W<RH>,0); SETTBLBIT(.W<RH>,1);
	DECR SUB FROM 17 TO 0 DO
	    BEGIN BIND PTR = IF .SUB THEN ROUTS[.NROUTS,1+.SUB/2,LH]
				ELSE ROUTS[.NROUTS,1+.SUB/2,RH];
	    IF (.W AND (1^18)^.SUB) NEQ 0 THEN
		BEGIN
		IF (W2_INWORD()) NEQ 0 THEN
		    (PTR _ .PTEXT<RH>; (.PTEXT)<FW> _ .W2; PTEXT_.PTEXT+1; INTEXT())
		ELSE PTR _ 0
		END
	    ELSE
		PTR _ 0
	    END
	END;
    IF ISON(ERRORFLG) THEN (NVALS _ NNAMES _ NROUTS _ -1; ERROR(11));
    CLOSE(SLCHN,0); RELEASE(SLCHN,0); ?.JBFF_.SAVFF;
    .VREG
    END;

ROUTINE BOOBOO=ERROR(4);

ROUTINE COPYR=(SIXVP_ .SIXRP; SIXVC_ .SIXRC; .VREG);

ROUTINE DEFINE=(QUOTFLG_2; MODEFLG_1; .VREG);
ROUTINE XSET1=(QUOTFLG_1; MODEFLG_1; .VREG);
ROUTINE XSET2=(QUOTFLG_1; MODEFLG_2; .VREG);
ROUTINE XSET3=(QUOTFLG_1; MODEFLG_3; .VREG);
ROUTINE SETAFTER=(MODEFLG_1; .VREG);
ROUTINE SETFROM=(MODEFLG_2; .VREG);

FORWARD EQUALS,GETTEXT,XPRINT;
PAGE!	THE PLIT BELOW MAPS PRINT NAME TO ROUTINE
!	-----------------------------------------

! REMEMBER WHILE INSERTING ENTRIES THAT THE PLIT IS SEARCHED *BACKWARDS*.

! THE PLIT CONTAINS A FIVE-WORD ENTRY FOR EACH PREDEFINED
! OPERATOR. OPERATORS DEFINED AT RUN-TIME ARE STORED IN THE
! SAME FORMAT IN 'DEFOPTAB', WHICH IS SEARCHED FIRST. THE FORMAT IS
!
!	!------!----------!------------!-------------!------------!
!	!PRINT ! WORD FOR !  WORD FOR  !  WORD FOR   !  WORD FOR  !
!	! NAME !NULL PARSE!PREFIX PARSE!POSTFIX PARSE!BINARY PARSE!
!	!------!----------!------------!-------------!------------!
!
! WHERE PRINT NAME CONTAINS THE RADIX50 REPRESENTATION OF A SYMBOL,
! OR AN ASCII CHAR. IN ITS LEFT HALF FOR A SPECIAL-CHARACTER PRINT NAME.
! EACH 'WORD FOR...' WORD HAS THE PRIORITY OF OPERATION FOR THAT PARSE
! IN ITS LEFT HALF, AND THE ADDRESS OF THE ROUTINE WHICH IS TO BE CALLED
! TO EXECUTE IT IN ITS RIGHT HALF. A ZERO WORD DENOTES "NO SUCH PARSE".
! A PRIORITY P > BRACEVAL INDICATES A LEFT BRACE; THE CORRESPONDING RIGHT
! BRACE MUST HAVE PRIORITY P-BRACEVAL. THE RIGHT BRACE ROUTINE IS A DUMMY, WHICH
! IS NEVER EXECUTED. THE CALL METHOD FOR OPERATORS IS EXPLAINED IN SIX12.MAN.

! THESE MACROS SIMPLIFY ENTERING OPERATORS...

MACRO ACHAR(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
	OP^18,	(P0)^18+ R0<0,0>,    (P1)^18+ R1<0,0>,
		(P2)^18+ R2<0,0>,    (P3)^18+ R3<0,0>$;

MACRO ANAME(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
  RADIX50 "OP",	(P0)^18+ R0<0,0>,    (P1)^18+ R1<0,0>,
		(P2)^18+ R2<0,0>,    (P3)^18+ R3<0,0>$;


BIND	OPTAB=  PLIT(

ANAME(NODEBU,	50,NOSIX12,	0,0,	0,0,	0,0),
ANAME(IF,	50,DOTVREG,	0,0,	0,0,	0,0),
ANAME(DISABL,	50,DISAB,	0,0,	0,0,	0,0),
ANAME(DDT,	50,EDDT,	0,0,	0,0,	0,0),
ANAME(SAVE,	0,0,	20,SIXSAVE,	0,0,	0,0),
ANAME(LOAD,	0,0,	20,SIXLOAD,	0,0,	0,0),
ANAME(LPTCLO,	50,CLOSELPT,	0,0,	0,0,	0,0),
ANAME(LPTOPE,	50,OPENLPT,	0,0,	0,0,	0,0),
ANAME(LPTOFF,	50,LPTOFF,	0,0,	0,0,	0,0),
ANAME(LPTDUP,	50,LPTDUP,	0,0,	0,0,	0,0),
ANAME(LPTON,	50,LPTON,	0,0,	0,0,	0,0),
ANAME(RETURN,	0,0,	20,XRETURN,	0,0,	0,0),
ANAME(FORGET,	50,XDEL1,	0,0,	0,0,	0,0),
ANAME(PRINT,	0,0,	10,XPRINT,	0,0,	0,0),
ANAME(ACTION,	50,XSET2,	0,0,	0,0,	0,0),
ANAME(OPER,	50,XSET1,	0,0,	0,0,	0,0),
ANAME(DEFINE,	50,DEFINE,	0,0,	0,0,	0,0),
ANAME(MACRO,	50,XSET3,	0,0,	0,0,	0,0),
ANAME(BIND,	50,XSET2,	0,0,	0,0,	0,0),
ANAME(WBASE,	20,XWBASE,	20,XWBASE,	0,0,	0,0),
ANAME(BASE,	20,XBASE,	20,XBASE,	0,0,	0,0),
ANAME(NOT,	0,0,	34,XNOT,	0,0,	0,0),
ANAME(OR,	0,0,	0,0,	0,0,	30,XEQOR),
ANAME(AND,	0,0,	0,0,	0,0,	32,XAND),
ANAME(EQL,	0,0,	0,0,	0,0,	36,XEQL),
ANAME(NEQ,	0,0,	0,0,	0,0,	36,XNEQ),
ANAME(LSS,	0,0,	0,0,	0,0,	36,XLSS),
ANAME(LEQ,	0,0,	0,0,	0,0,	36,XLEQ),
ANAME(GTR,	0,0,	0,0,	0,0,	36,XGTR),
ANAME(GEQ,	0,0,	0,0,	0,0,	36,XGEQ),
ANAME(GOTRAC,	50,XGOTRACE,	0,0,	0,0,	0,0),
ANAME(CLRTRA,	50,XCLRTRACE,	0,0,	0,0,	0,0),
ANAME(SETTRA,	50,XSTRACE,	0,0,	0,0,	0,0),
ANAME(GO,	50,GOER,	0,0,	0,0,	0,0),
ANAME(LCALL,	20,XLCALL,	20,XLCALL,	0,0,	0,0),
ANAME(CALL,	20,XCALL,	20,XCALL,	0,0,	0,0),
ANAME(LCALLS,	50,CALL2,	0,0,	0,0,	0,0),
ANAME(CALLS,	50,CALL1,	0,0,	0,0,	0,0),
ANAME(SEARCH,	0,0,	20,XSEARCH,	0,0,	0,0),
ANAME(PRS,	0,0,	10,PRS,		0,0,	0,0),
ANAME(FROM,	50,SETFROM,	0,0,	0,0,	0,0),
ANAME(AFTER,	50,SETAFTER,	0,0,	0,0,	0,0),
ANAME(DMONIT,	0,0,	10,DCHNG,	0,0,	0,0),
ANAME(MONITO,	0,0,	10,XCHNG,	0,0,	0,0),
ANAME(DTRACE,	0,0,	10,DTRACE,	0,0,	0,0),
ANAME(TRACE,	0,0,	10,XTRACE,	0,0,	10,XTRACE),
ANAME(DOPAQU,	0,0,	10,DOPAQUE,	0,0,	0,0),
ANAME(OPAQUE,	0,0,	10,OPAQUE,	0,0,	10,OPAQUE),
ANAME(DABREA,	0,0,	10,DABREAK,	0,0,	0,0),
ANAME(DBREAK,	0,0,	10,DBREAK,	0,0,	0,0),
ANAME(ABREAK,	0,0,	10,XABREAK,	0,0,	10,XABREAK),
ANAME(BREAK,	0,0,	10,XBREAK,	0,0,	10,XBREAK),
ACHAR(#175,	50,GETTEXT,	0,0,	0,0,	0,0),
ACHAR(#33,	50,GETTEXT,	0,0,	0,0,	0,0),
ACHAR("=",	0,0,	0,0,	0,0,	9,EQUALS),
ACHAR(";",	5,DOTVREG, 5,COPYR, 5,DOTVREG, 5,COPYR),
ACHAR("^",	0,0,	0,0,	0,0,	42,XSHIFT),
ACHAR("*",	0,0,	0,0,	0,0,	40,TIMES),
ACHAR("$",	0,0,	48,DOLSIGN,	0,0,	0,0),
ACHAR("@",	0,0,	44,ATSIGN,	0,0,	0,0),
ACHAR(".",	0,0,	44,CONTENTS,	0,0,	0,0),
ACHAR("-",	0,0,	38,SUBTRACT,	0,0,	38,SUBTRACT),
ACHAR("+",	0,0,	38,COPYR,	0,0,	38,XADD),
ACHAR(#76,	0,0,	0,0,	3,BOOBOO,	0,0),
ACHAR(#135,	0,0,	0,0,	2,BOOBOO,	0,0),
ACHAR(#51,	0,0,	0,0,	1,BOOBOO,	0,0),
ACHAR(#74,	0,0,	10003,COPYR,	0,0,	10003,FIELDSPEC),
ACHAR(#133,	0,0,	10002,COPYR,	0,0,	10002,STRUCT),
ACHAR(#50,	0,0,	10001,COPYR,	0,0,	10001,LPAREN),
ACHAR(",",	0,0,	0,0,	0,0,	15,JOIN),
ACHAR("_",	0,0,	0,0,	0,0,	25,SETIT),
ACHAR("!",	0,0,	0,0,	0,0,	20,SLASH),
ACHAR("/",	0,0,	0,0,	20,SLASH,	40,XDIV),
	0 );
PAGE

BIND	BRACEVAL = 10000;

ROUTINE EQUALS=
CASE .MODEFLG OF
    SET
%0% ERROR(7);
%1% BEGIN  LOCAL OLD,PARSE,ENTRY;	! DEFINE (OPERATOR)
    IF .SIXRC NEQ 2 OR .SIXLC NEQ 2 THEN RETURN ERROR(3);
    PARSE_ @(.SIXLP+1); IF .PARSE LSS 0 OR .PARSE GTR 3 THEN
    PARSE _ SELECT .PARSE OF NSET
	RADIX50 "NULL" : EXITSELECT 0;  RADIX50 "PREFIX" : EXITSELECT 1;
	RADIX50 "POSTFI" : EXITSELECT 2;  RADIX50 "INFIX" : EXITSELECT 3;
	ALWAYS : (TTOUTS('Which parse???M?J'); RETURN .VREG)
	TESN;
    ENTRY_ DECR J FROM .NEWOPS TO 0 BY 5 DO
	IF @@SIXLP EQL .DEFOPTAB[.J] THEN EXITLOOP .J;
    IF .ENTRY LSS 0 THEN		! INSERT NEW ENTRY
	(ENTRY_NEWOPS_ .NEWOPS+5; DEFOPTAB[.NEWOPS]_ @@SIXLP;
	OLD_ DECR J FROM .OPTAB[-1]-6 TO 0 BY 5 DO
	    IF @@SIXLP EQL .OPTAB[.J] THEN EXITLOOP .J;
	DECR J FROM 3 TO 0 DO		! COPY OLD ENTRY
	    DEFOPTAB[.NEWOPS+1+ .J]_ (IF .OLD GEQ 0 THEN
		.OPTAB[.OLD+1 +.J]  ELSE 0) );
    DEFOPTAB[.ENTRY+1+.PARSE]<LH> _ @@SIXRP;
    DEFOPTAB[.ENTRY+1+.PARSE]<RH> _ @(.SIXRP+1);
    .VREG
    END;
%2% BEGIN REGISTER R;			! BIND (CREATE DDT-SYMBOL)
    R_ .?.JBSYM - #2000002;
    (.R)<FW> _ @@SIXLP OR 1^32;  (.R+1)<FW> _ @@SIXRP;
    ?.JBSYM _ .R; .VREG
    END;
%3% BEGIN				! MACRO
    SIXNAMES[(NNAMES_.NNAMES+1),0,FW] _ @@SIXLP; SIXNAMES[.NNAMES,1,FW] _ @@SIXRP;
    .VREG
    END
    TES;

ROUTINE XPRINT=
CASE .MODEFLG OF
    SET
%0% 0;
%1% BEGIN REGISTER PNTR;		! OPERATOR
    PNTR _ DECR J FROM .NEWOPS TO 0 BY 5 DO
	IF @@SIXRP EQL .DEFOPTAB[.J] THEN EXITLOOP DEFOPTAB[.J]<ADR>;
    IF .PNTR LSS 0 THEN
	PNTR _ DECR J FROM .OPTAB[-1]-6 TO 0 BY 5 DO
	    IF @@SIXRP EQL .OPTAB[.J] THEN EXITLOOP OPTAB[.J]<ADR>;
    IF .PNTR LSS 0 THEN (OUTS('No such operator?M?J'); RETURN .VREG);
    IF .(.PNTR)<RH> EQL 0 THEN
	OUTC(.(.PNTR)<LH>)  ELSE  PRSYM50(@@PNTR);
    IF @(.PNTR+1) NEQ 0 THEN   (OUTS('?M?JNull?I'); OUTDR(.(.PNTR+1)<LH>,5);
				TAB; PRXDISP(@(.PNTR+1)));
    IF @(.PNTR+2) NEQ 0 THEN   (OUTS('?M?JPrefix?I'); OUTDR(.(.PNTR+2)<LH>,5);
				TAB; PRXDISP(@(.PNTR+2)));
    IF @(.PNTR+3) NEQ 0 THEN   (OUTS('?M?JPostfix?I'); OUTDR(.(.PNTR+3)<LH>,5);
				TAB; PRXDISP(@(.PNTR+3)));
    IF @(.PNTR+4) NEQ 0 THEN   (OUTS('?M?JInfix?I'); OUTDR(.(.PNTR+4)<LH>,5);
				TAB; PRXDISP(@(.PNTR+4)));
    CRLF; .VREG
    END;
%2% BEGIN LOCAL PNTR,TEMP;		! ACTION
    IF .SIXRC NEQ 2 THEN RETURN ERROR(3);
    TEMP _ SELECT @@SIXRP OF NSET
	RADIX50 "BREAK" : EXITSELECT BREAKV;
	RADIX50 "ABREAK" : EXITSELECT ABREAKV;
	RADIX50 "OPAQ" : EXITSELECT OPQATV;
	RADIX50 "OPAQAF" : EXITSELECT OPQAFTV;
	RADIX50 "TRACE" : EXITSELECT TRCATV;
	RADIX50 "TRACEA" : EXITSELECT TRCAFTV;
	ALWAYS : RETURN ERROR(8)
	TESN;
    IF (PNTR _ CFINDR(@(.SIXRP+1))) GEQ 0 THEN
	IF (.ROUTS[.PNTR,0,FW] AND .TEMP) NEQ 0 THEN
	    BEGIN
	    TEMP _ 17 - FIRSTONE(.TEMP);
	    PNTR _ IF .TEMP THEN .ROUTS[.PNTR,1+.TEMP^(-1),LH]
			    ELSE .ROUTS[.PNTR,1+.TEMP^(-1),RH];
	    IF .PNTR EQL 0 THEN (OUTS('Unconditional?M?J'); RETURN .VREG);
	    PNTR _ (.PNTR)<36,7>;
	    WHILE (TEMP_SCANI(PNTR)) NEQ #177 DO OUTC(.TEMP);
	    CRLF; RETURN .VREG
	    END;
    OUTS('Action not set?M?J'); .VREG
    END;
%3% BEGIN REGISTER PNTR,C;		! MACRO
    PNTR _ DECR J FROM .NNAMES TO 0 DO
	IF @@SIXRP EQL .SIXNAMES[.J,0,FW] THEN EXITLOOP .J;
    IF .PNTR LSS 0 THEN (OUTS('No such macro?M?J'); RETURN .VREG);
    PNTR _ (.SIXNAMES[.PNTR,1,FW])<36,7>;
    WHILE (C_SCANI(PNTR)) NEQ #177 DO OUTC(.C);
    CRLF; .VREG
    END
    TES;
PAGE!		ANALYSIS OF DEBUG INPUT LINES
!		-----------------------------

! THE PARSING ALGORITHM USES A SIMPLE STACK METHOD BASED ON ONE FIRST
! DEVELOPED BY BAUER AND SAMELSON.  IN ORDER TO RETAIN MAXIMUM INFORMATION
! ABOUT CONTEXT (NECESSARY SINCE OPERATOR PARSE IS NOT FIXED),BOTH
! OPERATORS AND OPERANDS ARE KEPT IN ONE STACK. THE OPERAND STACK
! ELEMENTS ARE FORMATTED
!
!		!-------------------------!
!		! NO. OF WORDS IN OPERAND !	<- TOP WORD OF ENTRY
!		!-------------------------!
!		! LAST DATA WORD	  !	^  INCREASING
!		!	! ! !		  !	^    STACK
!		! FIRST DATA WORD	  !	^  SUBSCRIPTS
!		!-------------------------!
!
! WHERE THE COUNT IN THE TOP (LAST) WORD DOES NOT INCLUDE THE COUNT
! WORD ITSELF.  OPERATOR ENTRIES ARE CHAINED TOGETHER:
!
! TOPOP -->	!------------+------------!
!		! #400000    ! POINTER    !	TO IMMEDIATELY PREVIOUS OPERATOR
!		!------------+------------!
!		! PARSE INFO ! POINTER    !	TO TABLE ENTRY FOR THIS OPERATOR
!		!------------+------------!
!
! THUS, OPERATOR AND OPERAND ENTRIES ON THE STACK CAN BE DISTINGUISHED
! BY THE SIGN OF THEIR TOP WORD.  THE 'PARSE INFO' IN THE ENTRY IS CONTAINED
! IN THE LAST 4 BITS OF THE HALFWORD, EACH OF WHICH IS 1 WHEN THE CORRESPONDING
! PARSE (NULL-BIT 14, PREFIX-15, POSTFIX-16, INFIX-17) MIGHT BE VALID.
! THE POINTER TO THE TABLE ENTRY POINTS TO ITS SECOND WORD, THE
! PRINT NAME NOT BEING REQUIRED AT THIS STAGE OF THE GAME.

MACRO	ENDOFLINE=(.CHAR EQL #15)$;

ROUTINE ADVANCE=			! GET NEXT CHARACTER - HANDLES END OF MACRO
    BEGIN
    IF .NPCHAR EQL 0 THEN NCHAR_.NCHAR+1;
    CHAR_ SCANI(PCHAR[.NPCHAR]);
    WHILE .CHAR EQL #177 DO
	CHAR_ SCANN(PCHAR[(NPCHAR_.NPCHAR-1)]);
    .VREG
    END;

ROUTINE TYPE=
    BEGIN
    IF .CHAR GEQ "0" THEN IF .CHAR LEQ "9" THEN RETURN 0;
    IF .CHAR GEQ "A" THEN IF .CHAR LEQ "Z" THEN RETURN 1;
    IF .CHAR GEQ "a" THEN IF .CHAR LEQ "z" THEN RETURN 1;
    SELECT .CHAR OF
	NSET
	"#" : EXITSELECT 2;
	#42 : EXITSELECT 3;	#47 : EXITSELECT 3;
	ALWAYS : 4
	TESN
    END;

ROUTINE ERROR(EN)=
    BEGIN
    SETON(ERRORFLG);
    IF .EN LEQ 4 THEN (TTOUTM(".",.NCHAR); TTOUTC("^"); TTCRLF);
    CASE .EN OF
	SET
	%0% TTOUTS('Unknown symbol');
	%1% TTOUTS('Illegal character');
	%2% TTOUTS('Syntax error');
	%3% TTOUTS('Incorrect number of arguments');
	%4% TTOUTS('Unmatched brace');
	%5% TTOUTS('Base must be from 2 to 10 dec.');
	%6% TTOUTS(': no debug linkage found for this routine');
	%7% TTOUTS('Invalid equals');
	%8% TTOUTS('Name action by BREAK,ABREAK,OPAQ,OPAQAFT,TRACE, or TRACEAFT');
	%9% TTOUTS('Improper file-spec');
	%10% TTOUTS('LOOKUP/ENTER failure');
	%11% TTOUTS('Transmission error');
	%12% TTOUTS('No space for macro text');
	TES;
    TTCRLF;
    0
    END;

ROUTINE PUSHOPER(OPERATOR)=		! PUSH OPERATOR ONTO STACK
    BEGIN
    TOPSTK_.TOPSTK+2;
    DBGSTK[.TOPSTK-1]_.OPERATOR;
    DBGSTK[.TOPSTK]_  1^35 OR .TOPOP<RH>;
    TOPOP_.TOPSTK;
    .VREG
    END;

ROUTINE PUSHITEM(AWORD)=		! PUT 1-WORD OPERAND ON STACK
    BEGIN
    IF .TOPSTK GEQ 0 THEN IF .DBGSTK[.TOPSTK] GEQ 0 THEN RETURN
	BEGIN
	TOPSTK_.TOPSTK+1;
	DBGSTK[.TOPSTK] _ .DBGSTK[.TOPSTK-1] + 1;
	DBGSTK[.TOPSTK-1] _ .AWORD;
	.VREG
	END;
    TOPSTK_.TOPSTK+2;
    DBGSTK[.TOPSTK] _ 1;
    DBGSTK[.TOPSTK-1] _ .AWORD;
    .VREG
    END;

ROUTINE GETNUMBER=			! PICK UP NUMBER
    BEGIN   REGISTER VAL[2]; MACHOP TRNE=#602, MUL=#224;
    VAL[0]_0;
    WHILE TYPE() EQL 0 DO
	( MUL(VAL[0],IOBASE); VAL[1]<35,1>_0;
	TRNE(VAL[0],1); VAL[1]<35,1>_1;
	VAL[0]_ .VAL[1] + .CHAR - "0"; ADVANCE());
    .VAL[0]
    END;

MACRO GETSYMBOL=			! GET BASE 50 REP. OF SYMBOL
    BEGIN   REGISTER Z,N;  Z_0; N_6;
    WHILE 1 DO
    (IF (N_.N-1) GEQ 0 THEN (Z _ #50 * .Z + F7TO50(.CHAR)); ADVANCE();
	IF .CHAR NEQ "." THEN IF TYPE() GTR 1 THEN EXITLOOP);
    .Z
    END$;

ROUTINE GETOP(OPNAME)=			! (SECOND) STACK WORD FOR OPERATOR
    BEGIN REGISTER R;
    R _ DECR I FROM .NEWOPS TO 0 BY 5 DO
	IF .OPNAME EQL .DEFOPTAB[.I] THEN EXITLOOP DEFOPTAB[.I]<ADR>;
    IF .R LSS 0 THEN
	(R _ DECR I FROM .OPTAB[-1]-6 TO 0 BY 5 DO
	    IF .OPNAME EQL .OPTAB[.I] THEN EXITLOOP OPTAB[.I]<ADR> );
    IF .R LSS 0 THEN -1  ELSE
	(  .R + 1
	 + ((((@(.R+1) NEQ 0) ^1
	    + (@(.R+2) NEQ 0))^1
	    + (@(.R+3) NEQ 0))^1
	    + (@(.R+4) NEQ 0))   ^  18)
    END;

ROUTINE GETTEXT=
    BEGIN  VTEMP_.PTEXT<RH>;
    DO	(REPLACEI(PTEXT, .CHAR);
	 IF .PTEXT<RH> GEQ TEXTAREA[4*NMACROS] THEN RETURN ERROR(12);
	 ADVANCE())
	UNTIL ENDOFLINE OR .CHAR EQL #175 OR .CHAR EQL #33;
    REPLACEI(PTEXT, #177); ADVANCE(); PTEXT _ (.PTEXT+1) <36,7>;
    SIXVP_ VTEMP<ADR>; SIXVC_1; .VREG
    END;

MACRO GETSTRING=
    IF .CHAR EQL #47 THEN	! HOLD ALREADY DECLARED OUTSIDE MACRO
	BEGIN
	HOLD_ DBGSTK[.TOPSTK]<1,7>;
	IF .TOPSTK GEQ 0 THEN IF .DBGSTK[.TOPSTK] GEQ 0 THEN
	    (TOPSTK _ .TOPSTK - .DBGSTK[.TOPSTK]; HOLD_.HOLD-1);
	WHILE 1 DO  (ADVANCE(); IF ENDOFLINE THEN EXITLOOP;
		     IF .CHAR EQL #47 THEN (ADVANCE(); IF .CHAR NEQ #47 THEN EXITLOOP);
		     REPLACEI(HOLD, .CHAR));
	(.HOLD<RH>) <0,(.HOLD<30,6>)>  _ 0;
	HOLD_ .HOLD<RH> - DBGSTK<ADR>;
	DBGSTK[.HOLD+1] _ .HOLD - .TOPSTK;
	TOPSTK _ .HOLD+1;
	END
    ELSE
	BEGIN  HOLD_0;
	WHILE 1 DO  (ADVANCE(); IF ENDOFLINE THEN EXITLOOP;
		     IF .CHAR EQL #42 THEN (ADVANCE(); IF .CHAR NEQ #42 THEN EXITLOOP);
		     HOLD _ .HOLD^7 + .CHAR);
	IF (QUOTFLG_.QUOTFLG-1) GEQ 0 THEN HOLD_ .HOLD^18;	! KLUDGE FOR DEFINING CHARACTER OPERATORS
	PUSHITEM(.HOLD);
	END$;

ROUTINE EXECUTE=			! EXECUTE TOP OPERATOR
    BEGIN LOCAL PARSE,ROUTN;
    PARSE _ FIRSTONE( .DBGSTK[.TOPOP-1]<18,4> ) -32;
    SIXLC_ SIXRC_ SIXVC_ 0;
    IF .PARSE AND .DBGSTK[.TOPSTK] GTR 0 THEN
	BEGIN			! RIGHT OPERAND
	SIXRC_ .DBGSTK[.TOPSTK];
	SIXRP_ DBGSTK[.TOPSTK-.SIXRC]<FW>;
	TOPSTK_ .TOPSTK -.SIXRC -1;
	END;
    ROUTN _ .(.DBGSTK[.TOPOP-1]<RH> + .PARSE)<RH> ;	! ROUTINE
    TOPOP _ .DBGSTK[.TOPOP]<RH>;	! POP OPERATOR
    TOPSTK _ .TOPSTK -2;
    IF .PARSE GEQ 2 AND .DBGSTK[.TOPSTK] GTR 0 THEN
	BEGIN			! LEFT OPERAND
	SIXLC_ .DBGSTK[.TOPSTK];
	SIXLP_ DBGSTK[.TOPSTK-.SIXLC]<FW>;
	TOPSTK_ .TOPSTK - .SIXLC -1;
	END;
    ( .ROUTN<RH> )   (.PARSE);	! ROUTINE CALL
    IF ISON(ERRORFLG) THEN RETURN .VREG;
    IF .SIXVC GTR 0 THEN
	BEGIN			! GET RESULT
	INCR J FROM 0 TO .SIXVC-1  DO
	    DBGSTK[.TOPSTK+1 +.J] _ @(.SIXVP +.J);
	TOPSTK _.TOPSTK+ .SIXVC +1;
	DBGSTK[.TOPSTK] _ .SIXVC;
	END;
    .VREG
    END;

ROUTINE OPERATE(CURRNTOP)=		! SCHEDULES OPERATORS
    BEGIN
    MACRO   LASTOP=DBGSTK[.TOPOP-1]$,
	    PRIO(OPWD,N)=(IF .OPWD<21-N,1> THEN
			.(.OPWD<RH> +N)<LH> ELSE 0)$,
	    BRACE(OPWD)=(.(.OPWD<RH>+1)<LH>  GTR BRACEVAL)$,
	    OPERAND=(.TOPSTK GEQ 0 AND .DBGSTK[.TOPSTK] GEQ 0)$,
	    CHKPARSES(OP)=(IF .OP<18,4> EQL 0 THEN
			RETURN ERROR(2))$;
    LOCAL P,PARSE,LBRACE;
    SETOFF(LBRACE);
    P_ PRIO(CURRNTOP,2); IF .P EQL 0 THEN P_ PRIO(CURRNTOP,3);
    UNTIL .TOPOP<17,1> DO	! DO HIGHER-PRIORITY PREVIOUS OPERATORS
    BEGIN
    IF OPERAND THEN		! FOUND OPERAND BETWEEN THIS OP & PREVIOUS ONE
	BEGIN
	LASTOP_.LASTOP AND NOT #12000000; CHKPARSES(LASTOP);
	PARSE_ FIRSTONE( .LASTOP<18,4> ) -32;
	IF PRIO(LASTOP,.PARSE) LSS .P THEN EXITLOOP
	END
    ELSE
	BEGIN
	IF (.P EQL 0) OR BRACE(CURRNTOP)
	    OR ((.LASTOP AND #12000000) EQL 0)   THEN
		(IF BRACE(LASTOP) THEN EXITCOND [3];
		IF .CURRNTOP GEQ 0 THEN EXITLOOP);
	LASTOP_.LASTOP AND NOT #5000000; CHKPARSES(LASTOP)
	END;
    IF BRACE(LASTOP) AND (.CURRNTOP GEQ 0) THEN
	(IF .(.LASTOP<RH>+1)<LH> EQL PRIO(CURRNTOP,2) + BRACEVAL
	    THEN  SETON(LBRACE)  ELSE  EXITLOOP);
    EXECUTE();			! PREVIOUS OPERATOR
    IF .ERRORFLG OR .LBRACE THEN RETURN .VREG;
    END;
				! NOW STACK CURRENT OPERATOR
    IF .CURRNTOP LSS 0 THEN RETURN .VREG;
    CURRNTOP_.CURRNTOP AND NOT (#3000000 ^ (OPERAND ^1));
    CHKPARSES(CURRNTOP);	! ELIMINATE PARSES AND CHECK
    PUSHOPER(.CURRNTOP);
    IF (.CURRNTOP AND #5000000) EQL 0 THEN EXECUTE();	! CAN DO AT ONCE
    .VREG
    END;

ROUTINE XDEBUG(PSWITCH)=		! PARSES INPUT LINE
    BEGIN   REGISTER HOLD; LOCAL T,NAME;
    TOPOP_ TOPSTK_ -1;
    QUOTFLG_ ERRORFLG_ MODEFLG_  0;
    WHILE ISOFF(ERRORFLG) DO
	BEGIN
	WHILE (.CHAR EQL " ") OR (.CHAR EQL "?I") DO ADVANCE();
	IF ENDOFLINE THEN
	    BEGIN  OPERATE(1^35);	! CLEAN UP & STOP
	    IF .ERRORFLG OR (.TOPSTK LEQ 0) THEN RETURN 0;
	    HOLD_.TOPSTK - .DBGSTK[.TOPSTK];
	    IF ISON(PSWITCH) THEN	! PRINT RESULT
		INCR J FROM 0 TO .DBGSTK[.TOPSTK]-1  DO
		    (OUTRDEF(.DBGSTK[.HOLD+.J],14); TAB;
		    PRDISP(.DBGSTK[.HOLD+.J]); CRLF);
	    RETURN .DBGSTK[.HOLD];
	    END;

	CASE TYPE() OF
	    SET
%0 NUMBER%  PUSHITEM(GETNUMBER());
%1 SYMBOL%  (NAME_GETSYMBOL;
	     IF (QUOTFLG_.QUOTFLG-1) GEQ 0 THEN
		EXITCASE  PUSHITEM(.NAME);	% QUOTED  %
	     IF .CHAR EQL "%" THEN EXITCASE
		IF (ADVANCE(); T_GETNUMBER()) LEQ 0 THEN ERROR(0) ELSE
    %SYMBOL %	(  HLRE(HOLD,?.JBSYM); HOLD_ -.HOLD;
    % WITH  %	HOLD_ .HOLD^18 + .HOLD + .?.JBSYM<RH>;
    % COUNT %	DECR J FROM .T-1 TO 0 DO
		    IF (HOLD_NSDDTFA(.NAME,.HOLD)) EQL 0
			THEN EXITLOOP ERROR(0);
		PUSHITEM(@(.HOLD+1))  );
	     DECR N FROM .NNAMES TO 0 DO	! LOOK FOR MACROS
		IF .SIXNAMES[.N,0,FW] EQL .NAME THEN EXITCASE
			( PCHAR[(NPCHAR_.NPCHAR+1)] _ (.SIXNAMES[.N,1,FW])<36,7>; ADVANCE());
	     HOLD_ GETOP(.NAME); IF .HOLD LSS 0
		THEN	PUSHITEM(SDDTFA(.NAME))	%SYMBOL   %
		ELSE	OPERATE(.HOLD) );	%OPERATOR %
%2 # SIGN%  (IOBASE _ IF (HOLD_.IOBASE) EQL 8 THEN 10 ELSE 8;
		ADVANCE(); PUSHITEM(GETNUMBER()); IOBASE_.HOLD);
%3 STRING%  GETSTRING;
%4  OTHER%  (IF .CHAR EQL "=" THEN QUOTFLG_0;
	     HOLD_GETOP(.CHAR^18); ADVANCE(); IF .HOLD LSS 0 THEN
		ERROR(1) ELSE OPERATE(.HOLD)  )
	    TES;
	END;
    CHAR_#15;
    0
    END;

MACRO INPUT=
    BEGIN
    PCHAR[0]_ BUFF<36,7>;
    DO (CHAR_INC; REPLACEI(PCHAR[0], .CHAR)) UNTIL .CHAR EQL #12;
    REPLACEN(PCHAR[0], #15);
    PCHAR[0]_ BUFF<36,7>; NPCHAR_0; ADVANCE(); NCHAR_0
    END$;

ROUTINE ISUB=				! DRIVES SYNTAX ANALYZER
    BEGIN
    IF ((DCNT_.DCNT-1) LEQ 0) OR .TRACEFLG THEN
	BEGIN
	IF .DCNT LEQ 0 THEN (DCNT_BGOBASE; INCRTOG);
	IF ISON(ENABFLG) THEN IFSKIP TTCALL(#13,0) THEN (STOPIT; GOFLG_0);
	END;
    UNTIL .GOFLG DO
	BEGIN
	IF .GOFLG GTR 0 THEN TTOUTC("&");
	INPUT; GOFLG_2;
	XDEBUG(1);
	TOPOP_TOPSTK_ -1;		! FUDGE TO ENSURE PROPER (?) OPERATION
					! IF SIX12 IS ENTERED RECURSIVELY
	END;
    .VREG
    END;
PAGE!	THE FOLLOWING ROUTINES HANDLE ENTRY TO SIX12
!	--------------------------------------------

STRUCTURE XVECTPNT[J,K,L] = [1] (@.XVECTPNT+.J)<.K,.L>;

OWN	XVECTPNT ROUTPNT, CONDPNT;

ROUTINE CHKCOND=			! CHECK CONDITION FOR ACTION
    BEGIN
    IF .CONDPNT EQL 0 THEN RETURN 1;	! UNCONDITIONAL
    NPCHAR _ 1; PCHAR[1] _ (.CONDPNT)<36,7>; PCHAR[0] _ PLIT('?M?M?J')<29,7>;
    ADVANCE(); NCHAR _ 0; VREG _ XDEBUG(0); TOPOP_TOPSTK_ -1; .VREG
    END;

ROUTINE RTRCAFT=
    (IF ISEXIT THEN
	(IF .ROUTPNT[IDIDONF] THEN
	    IF (TRCCNT_.TRCCNT-1) LEQ 0 THEN
		(TRACEFLG _ ROUTPNT[IDIDONF] _ 0) )
     ELSE
	IF .OPQCNT LEQ 0 AND .TRACEFLG GEQ 0 THEN
	    (IF CHKCOND() THEN
		(ROUTPNT[IDIDONF]_1; TRCCNT_1; TRACEFLG<RH>_-1) )
	ELSE IF .ROUTPNT[IDIDONF] THEN TRCCNT_.TRCCNT+1;
     .VREG);

ROUTINE RTRCAT=
    (IF .OPQCNT LEQ 0 AND .TRACEFLG GEQ 0 THEN
	IF CHKCOND() THEN TRACEFLG _ .TRACEFLG OR NOT 1;
     .VREG);

ROUTINE ROPQAFT=
    (IF ISEXIT THEN
	(IF .ROUTPNT[IDIDOFFF] THEN
	    IF (OPQCNT_.OPQCNT-1) LEQ 0 THEN
		(TRACEFLG _ -.ROUTPNT[PREVOFFF] AND NOT 2; ROUTPNT[IDIDOFFF]_ROUTPNT[PREVOFFF]_0) )
     ELSE
	IF .OPQCNT LEQ 0 THEN
	    (IF CHKCOND() THEN
		(ROUTPNT[IDIDOFFF]_1; ROUTPNT[PREVOFFF]_.TRACEFLG; OPQCNT_1; TRACEFLG<RH>_0) )
	ELSE IF .ROUTPNT[IDIDOFFF] THEN OPQCNT_.OPQCNT+1;
     .VREG);

ROUTINE ROPQAT=
    (IF .TRACEFLG LSS 0 THEN IF CHKCOND() THEN TRACEFLG _ .TRACEFLG AND 1;
     .VREG);

ROUTINE RABREAK=
    (IF ISEXIT THEN
	IF CHKCOND() THEN (STOPIT; OUTS('?M?J<=> After: '); PRXDISP(.RNAME); OUTVALUE);
     .VREG);

ROUTINE RBREAK=
    (IF NOT ISEXIT THEN
	IF CHKCOND() THEN (STOPIT; OUTS('?M?J<=> At: '); PRCALL(@@ENTERPNT, .RNAME); CRLF);
     .VREG);

BIND	RTNSPLIT=PLIT(RBREAK,RABREAK,ROPQAT,ROPQAFT,RTRCAT,RTRCAFT, 12:DOTVREG);

ROUTINE CALLEM=
    BEGIN  REGISTER RSAVE; LOCAL SAVE[2],L;
    RSAVE _ .SIXVREG; SIXVREG _ .VREG; SAVE[0] _ .RTNLVL; SETISEXIT;
    SAVE[1] _ .ENTERPNT; ENTERPNT _ .FREG;
    IF .NVALS GEQ 0 THEN CKVALS(.RNAME, .RTNLVL);
    IF ISINTBL THEN
	IF (L _ IF .NROUTS GEQ 0 THEN CFINDR(.RNAME) ELSE -1) GEQ 0 THEN
	    BEGIN
	    ROUTPNT _ ROUTS[.L, 0,0,0];
	    DECR J FROM (MAXACTRTN-18) TO 0 DO
		IF (.ROUTPNT[0,LH] AND 1^.J) NEQ 0 THEN
			(CONDPNT _ IF .J THEN .ROUTPNT[ 1+.J/2, LH]
					ELSE .ROUTPNT[ 1+.J/2, RH];
			 (.RTNSPLIT[.J]) () )
	    END;
    IF .TRACEFLG LSS 0 THEN
	IF ISEXIT
	    THEN (IF .TRACEFLG<1,1> THEN (OUTS('<-- '); PRXDISP(.RNAME)); OUTVALUE)
	    ELSE (OUTS('--> '); PRCALL(@@FREG,.RNAME); IF .TRACEFLG<1,1> THEN CRLF);
    IF .TRACEFLG THEN SETON(TRACEFLG) ELSE SETOFF(TRACEFLG);
    ISUB();
    RTNLVL_ .SAVE[0]; ENTERPNT_ .SAVE[1];
    EXCH(RSAVE,SIXVREG)
    END;

ROUTINE UUOH=
    BEGIN
    MACHOP POPJ=#263, XCT=#256, AOS=#350;
    IF SAILSW THEN IF .?.JBUUO<OPCODE> NEQ DEBUGUUO THEN JRST(0,SAILUUO,0,1);
    DCNT_.DCNT-1;
    IF (SIXTOG_.SIXTOG-1) GTR 0 THEN POPJ(SREG,0);
    DCNT_.DCNT+1;
    IF NOT ISEXIT THEN
	BEGIN
	POP(SREG,VTEMP);	! GET PUSHED ADDRESS BACK
	XCT(0,VTEMP,0,1);	! EXECUTE JSP AFTER DEBUG
	AOS(0,VTEMP);		! PUSH RETURN PAST JSP
	PUSH(SREG,VTEMP);	! AND SAVE
	END;
    JRST(0,CALLEM);
    .VREG
    END;

ROUTINE INITSIX12=
    BEGIN
    IF NOT SAILSW THEN CALLI(0,0);
    TRACEFLG_ LPTFLG_ OPQCNT_ 0;
    ENABFLG_ NROUTS_ NVALS_ NNAMES_ -1;
    DCNT_ SIXTOG_ BGOBASE; GOFLG_ 1;
    NEWOPS_ -5;  PTEXT_ TEXTAREA<36,7>;
   %THIS CHANGE WAS MADE BY SAGE GROUP.THIS CHANGE WAS
     NECESSARY BECAUSE THERE WAS SMALL CHANGE IN MONITORS
    THE OLD LINE
    (.((.DDT<RH>)+1)<RH>)<FW>_ 0;
    IS REPLACED BY THE FOLLOWING THREE LINES (CONDITIONAL).
   %
    IF .((.DDT<RH>)+1)<27,9> EQL #254    %JRST%
        THEN (.((.DDT<RH>)+1)<RH>)<FW,0,1>_0
         ELSE (.((.DDT<RH>)+1)<RH>)<FW>_0;
    IOBASE_ 8; WDBASE_ #1000;			! CHANGE DEFAULT BASE,WBASE HERE
    IF SAILSW THEN SAILUUO_.?.JB41<RH>;
    ?.JB41_ #260^27 OR SREG<ADR>^23 OR UUOH<ADR>;	! PUSHJ $S,UUOH
    .VREG
    END;

GLOBAL ROUTINE SIX12(XP)=
    BEGIN   REGISTER SAVE[3];
    SAVE[0]_ .SIXVREG; SIXVREG_ .VREG; SAVE[1]_ .RTNLVL;
    SAVE[2]_ .ENTERPNT; ENTERPNT_ .FREG;
    SELECT .XP OF
	NSET

	#400000000000:			! MAIN PROGRAM ENTRY
	    BEGIN
	    INITSIX12();
	    IF .STARTFLG EQL 1 THEN (GOFLG_2; EXITSELECT SETINTERNAL)
		 ELSE RETURN .SIXVREG
	    END;

	#377777000000:			! MAIN PROGRAM EXIT
	    RETURN .SIXVREG;

	ALWAYS:				! USER CALL
	    BEGIN
	    STOPIT; CRLF;
	    OUTS('Pause '); OUTDEFAULT(.XP); OUTS(' at ');
	    PRDISP(.(.FREG-1)<RH>-1); CRLF;
	    SETINTERNAL; SIXVREG _ -1
	    END

	TESN;
    SIXTOG_.SIXTOG-1; 		! TO KEEP COUNTERS IN STEP
    ISUB(); RTNLVL_ .SAVE[1]; ENTERPNT_ .SAVE[2];
    EXCH(SAVE[0],SIXVREG)
    END;

ROUTINE SIXDD2=
    BEGIN   REGISTER SAVE[3];
    SAVE[0]_ .SIXVREG; SIXVREG_ .VREG; SAVE[1]_ .RTNLVL; SETINTERNAL;
    SAVE[2]_ .ENTERPNT; ENTERPNT_ .FREG;
    STOPIT; SIXTOG_.SIXTOG-1;
    ISUB();
    SIXVREG _ .SAVE[0]; RTNLVL_ .SAVE[1]; ENTERPNT_ .SAVE[2];
    .VREG
    END;

GLOBAL ROUTINE SIXDDT=
    ! MUST BE CHANGED IF DEFAULT REGISTERS ARE CHANGED !
    BEGIN
    MACRO S(X)=PUSH(SREG,X)$, R(X)=POP(SREG,X)$;
    IF SAILSW THEN (S(1);S(4);S(5);S(6);S(7);S(#10))
	      ELSE (S(1);S(3);S(4);S(5);S(6);S(7);S(#10);S(#11);S(#12));
    SIXDD2();
    IF SAILSW THEN (R(#10);R(7);R(6);R(5);R(4);R(1))
	      ELSE (R(#12);R(#11);R(#10);R(7);R(6);R(5);R(4);R(3);R(1));
    .VREG
    END;

END ELUDOM